Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ABL/abl.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ABL/abl.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ABL/abl.F90	(revision 12928)
@@ -0,0 +1,76 @@
+MODULE abl
+   !!======================================================================
+   !!                      ***  MODULE  abl  ***
+   !! Abl        :  ABL dynamics and active tracers defined in memory 
+   !!======================================================================
+   !! History :  4.0  !  2019-03  (F. Lemarié & G. Samson)  Original code
+   !!----------------------------------------------------------------------
+   USE par_abl        ! abl parameters
+   USE lib_mpp        ! MPP library
+   USE dom_oce, ONLY: glamt, gphit               ! latitude/longitude
+   USE dom_oce, ONLY: e1t, e1u, e1v, e1f         ! scale factors for horizontal grid
+   USE dom_oce, ONLY: e2t, e2u, e2v, e2f         ! 
+   USE dom_oce, ONLY: rn_Dt                      ! oceanic time-step
+   USE sbc_oce, ONLY: ght_abl, ghw_abl, e3t_abl, e3w_abl, jpka   ! scale factors and altitudes of ABL grid points in the vertical 
+  
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC abl_alloc ! routine called by nemo_init in nemogcm.F90
+
+   !! ABL dynamics and tracer fields                            ! 
+   !! --------------------------                            ! 
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:,:)   ::   u_abl        !: i-horizontal velocity   [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:,:)   ::   v_abl        !: j-horizontal velocity   [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:,:,:) ::   tq_abl       !: 4D T-q fields           [Kelvin,kg/kg] 
+   
+   !! ABL TKE closure scheme                            ! 
+   !! --------------------------        
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)     ::   avm_abl      !: turbulent viscosity   [m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)     ::   avt_abl      !: turbulent diffusivity [m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)     ::   mxl_abl      !: mixing length         [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:,:)   ::   tke_abl      !: turbulent kinetic energy [m2/s2]
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)       ::   fft_abl      !: Coriolis parameter    [1/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)       ::   pblh         !: PBL height            [m]
+
+   !! ABL Land/sea mask and restoring term                           ! 
+   !! --------------------------     
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)       ::   msk_abl
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)       ::   rest_eq
+   !
+   INTEGER , PUBLIC :: nt_n, nt_a       !: now / after indices (equal 1 or 2)
+   ! 
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id: abl.F90 4990 2014-12-15 16:42:49Z timgraham $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION abl_alloc()
+      !!----------------------------------------------------------------------
+      !!                   ***  FUNCTION abl_alloc  ***
+      !!----------------------------------------------------------------------
+      INTEGER :: ierr
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( u_abl  (1:jpi,1:jpj,1:jpka,jptime), &
+         &      v_abl  (1:jpi,1:jpj,1:jpka,jptime), &
+         &      tq_abl (1:jpi,1:jpj,1:jpka,jptime,jptq), &
+         &      avm_abl(1:jpi,1:jpj,1:jpka), &
+         &      avt_abl(1:jpi,1:jpj,1:jpka), &
+         &      mxl_abl(1:jpi,1:jpj,1:jpka), &         
+         &      tke_abl(1:jpi,1:jpj,1:jpka,jptime), &
+         &      fft_abl(1:jpi,1:jpj), &
+         &      pblh   (1:jpi,1:jpj), &         
+         &      msk_abl(1:jpi,1:jpj), &
+         &      rest_eq(1:jpi,1:jpj), &         
+         &      e3t_abl(1:jpka), e3w_abl(1:jpka), ght_abl(1:jpka), ghw_abl(1:jpka),                 STAT=ierr )
+         !
+      abl_alloc = ierr
+      IF( abl_alloc /= 0 )   CALL ctl_warn('abl_alloc: failed to allocate arrays')
+      !
+   END FUNCTION abl_alloc
+
+   !!======================================================================
+END MODULE abl
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ABL/ablmod.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ABL/ablmod.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ABL/ablmod.F90	(revision 12928)
@@ -0,0 +1,1037 @@
+MODULE ablmod
+   !!======================================================================
+   !!                       ***  MODULE  ablmod  ***
+   !! Surface module :  ABL computation to provide atmospheric data 
+   !!                   for surface fluxes computation
+   !!======================================================================
+   !! History :  3.6  ! 2019-03  (F. Lemarié & G. Samson)  Original code
+   !!----------------------------------------------------------------------
+   
+   !!----------------------------------------------------------------------
+   !!   abl_stp       : ABL single column model
+   !!   abl_zdf_tke   : atmospheric vertical closure
+   !!----------------------------------------------------------------------
+   USE abl            ! ABL dynamics and tracers
+   USE par_abl        ! ABL constants
+
+   USE phycst         ! physical constants
+   USE dom_oce, ONLY  : tmask  
+   USE sbc_oce, ONLY  : ght_abl, ghw_abl, e3t_abl, e3w_abl, jpka, jpkam1, rhoa
+   USE sbcblk         ! use rn_?fac
+   USE sbcblk_phy     ! use some physical constants for flux computation
+   !
+   USE prtctl         ! Print control                    (prt_ctl routine)
+   USE iom            ! IOM library
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+
+   PUBLIC   abl_stp   ! called by sbcabl.F90
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ustar2
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+
+CONTAINS
+
+
+!===================================================================================================
+   SUBROUTINE abl_stp( kt, psst, pssu, pssv, pssq, &                            ! in
+              &            pu_dta, pv_dta, pt_dta, pq_dta,    & 
+              &            pslp_dta, pgu_dta, pgv_dta,        &
+              &            pcd_du, psen, pevp,                &                            ! in/out
+              &            pwndm, ptaui, ptauj, ptaum         & 
+#if defined key_si3			  
+              &          , ptm_su,pssu_ice,pssv_ice,pssq_ice,pcd_du_ice  & 
+              &          , psen_ice, pevp_ice, pwndm_ice, pfrac_oce      & 
+              &          , ptaui_ice, ptauj_ice                          &
+#endif			  
+			  &   )
+!---------------------------------------------------------------------------------------------------
+
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE abl_stp ***
+      !!
+      !! ** Purpose :   Time-integration of the ABL model 
+      !!
+      !! ** Method  :   Compute atmospheric variables : vertical turbulence 
+      !!                             + Coriolis term + newtonian relaxation
+      !!                
+      !! ** Action  : - Advance TKE to time n+1 and compute Avm_abl, Avt_abl, PBLh
+      !!              - Advance tracers to time n+1 (Euler backward scheme)
+      !!              - Compute Coriolis term with forward-backward scheme (possibly with geostrophic guide)
+      !!              - Advance u,v to time n+1 (Euler backward scheme)
+      !!              - Apply newtonian relaxation on the dynamics and the tracers
+      !!              - Finalize flux computation in psen, pevp, pwndm, ptaui, ptauj, ptaum
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER  , INTENT(in   )                   ::   kt         ! time step index
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   psst       ! sea-surface temperature [Celsius]
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pssu       ! sea-surface u (U-point)
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pssv       ! sea-surface v (V-point) 
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pssq       ! sea-surface humidity
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:,:) ::   pu_dta     ! large-scale windi
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:,:) ::   pv_dta     ! large-scale windj
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:,:) ::   pgu_dta    ! large-scale hpgi
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:,:) ::   pgv_dta    ! large-scale hpgj
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:,:) ::   pt_dta     ! large-scale pot. temp.
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:,:) ::   pq_dta     ! large-scale humidity
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pslp_dta   ! sea-level pressure
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pcd_du     ! Cd x Du (T-point)
+      REAL(wp) , INTENT(inout), DIMENSION(:,:  ) ::   psen       ! Ch x Du
+      REAL(wp) , INTENT(inout), DIMENSION(:,:  ) ::   pevp       ! Ce x Du
+      REAL(wp) , INTENT(inout), DIMENSION(:,:  ) ::   pwndm      ! ||uwnd||      
+      REAL(wp) , INTENT(  out), DIMENSION(:,:  ) ::   ptaui      ! taux
+      REAL(wp) , INTENT(  out), DIMENSION(:,:  ) ::   ptauj      ! tauy
+      REAL(wp) , INTENT(  out), DIMENSION(:,:  ) ::   ptaum      ! ||tau|| 
+      !
+#if defined key_si3	  
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   ptm_su       ! ice-surface temperature [K]
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pssu_ice     ! ice-surface u (U-point)
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pssv_ice     ! ice-surface v (V-point) 	  
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pssq_ice     ! ice-surface humidity 
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pcd_du_ice   ! Cd x Du over ice (T-point)
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   psen_ice     ! Ch x Du over ice (T-point)
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pevp_ice     ! Ce x Du over ice (T-point)
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pwndm_ice    ! ||uwnd - uice||  
+      !REAL(wp) , INTENT(inout), DIMENSION(:,:  ) ::   pfrac_oce	   !!GS: out useless ?
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pfrac_oce	   !
+      REAL(wp) , INTENT(  out), DIMENSION(:,:  ) ::   ptaui_ice    ! ice-surface taux stress (U-point)
+      REAL(wp) , INTENT(  out), DIMENSION(:,:  ) ::   ptauj_ice    ! ice-surface tauy stress (V-point) 	  
+#endif	  
+      !
+      REAL(wp), DIMENSION(1:jpi,1:jpj   )        ::   zwnd_i, zwnd_j
+      REAL(wp), DIMENSION(1:jpi,2:jpka  )        ::   zCF    
+      REAL(wp), DIMENSION(1:jpi,1:jpj,1:jpka)    ::   z_cft      !--FL--to be removed after the test phase   
+      !
+      REAL(wp), DIMENSION(1:jpi,1:jpka  )        ::   z_elem_a
+      REAL(wp), DIMENSION(1:jpi,1:jpka  )        ::   z_elem_b
+      REAL(wp), DIMENSION(1:jpi,1:jpka  )        ::   z_elem_c
+      !
+      INTEGER             ::   ji, jj, jk, jtra, jbak               ! dummy loop indices
+      REAL(wp)            ::   zztmp, zcff, ztemp, zhumi, zcff1, zztmp1, zztmp2
+      REAL(wp)            ::   zcff2, zfcor, zmsk, zsig, zcffu, zcffv, zzice,zzoce
+      !
+      !!---------------------------------------------------------------------      
+      !
+      IF(lwp .AND. kt == nit000) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'abl_stp : ABL time stepping'
+         WRITE(numout,*) '~~~~~~'
+      ENDIF 
+      !
+      IF( kt == nit000 ) ALLOCATE ( ustar2( 1:jpi, 1:jpj ) )
+      !! Compute ustar squared as Cd || Uatm-Uoce ||^2 
+      !! needed for surface boundary condition of TKE 
+      !! pwndm contains | U10m - U_oce | (see blk_oce_1 in sbcblk)
+      DO_2D_11_11
+         zzoce         = pCd_du    (ji,jj) * pwndm    (ji,jj)
+#if defined key_si3
+         zzice         = pCd_du_ice(ji,jj) * pwndm_ice(ji,jj) 
+         ustar2(ji,jj) = zzoce * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * zzice 
+#else
+         ustar2(ji,jj) = zzoce	
+#endif
+      END_2D
+      !
+      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !                            !  1 *** Advance TKE to time n+1 and compute Avm_abl, Avt_abl, PBLh
+      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+      CALL abl_zdf_tke( )                       !--> Avm_abl, Avt_abl, pblh defined on (1,jpi) x (1,jpj) 
+         
+      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !                            !  2 *** Advance tracers to time n+1
+      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      
+      !-------------
+      DO jj = 1, jpj    ! outer loop             !--> tq_abl computed on (1:jpi) x (1:jpj)
+      !-------------    
+         ! Compute matrix elements for interior points 
+         DO jk = 3, jpkam1
+            DO ji = 1, jpi   ! vector opt.
+               z_elem_a( ji,     jk              ) = - rDt_abl * Avt_abl( ji, jj, jk-1 ) / e3w_abl( jk-1 )   ! lower-diagonal
+               z_elem_c( ji,     jk              ) = - rDt_abl * Avt_abl( ji, jj, jk   ) / e3w_abl( jk   )   ! upper-diagonal       
+               z_elem_b( ji,     jk              ) = e3t_abl(jk) - z_elem_a( ji, jk ) - z_elem_c( ji, jk )   !       diagonal           
+            END DO
+         END DO  
+         ! Boundary conditions  
+         DO ji = 1, jpi   ! vector opt. 
+            ! Neumann at the bottom          
+            z_elem_a( ji,     2              ) = 0._wp
+            z_elem_c( ji,     2              ) = - rDt_abl * Avt_abl( ji, jj, 2   ) / e3w_abl( 2   )                                         
+            ! Homogeneous Neumann at the top
+            z_elem_a( ji,     jpka           ) = - rDt_abl * Avt_abl( ji, jj, jpka ) / e3w_abl( jpka ) 
+            z_elem_c( ji,     jpka           ) = 0._wp
+            z_elem_b( ji,     jpka           ) = e3t_abl( jpka ) - z_elem_a( ji,     jpka )
+         END DO            
+
+         DO jtra = 1,jptq  ! loop on active tracers
+               
+            DO jk = 3, jpkam1
+               DO ji = 1,jpi
+                  tq_abl  ( ji, jj, jk, nt_a, jtra ) = e3t_abl(jk) * tq_abl  ( ji, jj, jk, nt_n, jtra )   ! initialize right-hand-side
+               END DO
+            END DO
+
+            IF(jtra == jp_ta) THEN
+               DO ji = 1,jpi  ! boundary conditions for temperature              
+                  zztmp1 = psen(ji, jj) 
+                  zztmp2 = psen(ji, jj) * ( psst(ji, jj) + rt0 )	
+#if defined key_si3				  
+                  zztmp1 = zztmp1 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * psen_ice(ji,jj) 
+                  zztmp2 = zztmp2 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * psen_ice(ji,jj) * ptm_su(ji,jj)
+#endif				  
+                  z_elem_b( ji,     2                ) = e3t_abl( 2 ) - z_elem_c( ji, 2 ) + rDt_abl * zztmp1				  
+                  tq_abl  ( ji, jj, 2   , nt_a, jtra ) = e3t_abl( 2    ) * tq_abl  ( ji, jj, 2   , nt_n, jtra ) + rDt_abl * zztmp2               
+                  tq_abl  ( ji, jj, jpka, nt_a, jtra ) = e3t_abl( jpka ) * tq_abl  ( ji, jj, jpka, nt_n, jtra )
+               END DO 
+            ELSE   
+               DO ji = 1,jpi  ! boundary conditions for humidity              
+                  zztmp1 = pevp(ji, jj) 
+                  zztmp2 = pevp(ji, jj) * pssq(ji, jj)   
+#if defined key_si3				  
+                  zztmp1 = zztmp1 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * pevp_ice(ji,jj) 
+                  zztmp2 = zztmp2 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * pevp_ice(ji, jj) * pssq_ice(ji, jj)    
+#endif	
+                  z_elem_b( ji,     2                ) = e3t_abl( 2 ) - z_elem_c( ji, 2 ) + rDt_abl * zztmp1
+                  tq_abl  ( ji, jj, 2   , nt_a, jtra ) = e3t_abl( 2    ) * tq_abl  ( ji, jj, 2   , nt_n, jtra ) + rDt_abl * zztmp2               
+                  tq_abl  ( ji, jj, jpka, nt_a, jtra ) = e3t_abl( jpka ) * tq_abl  ( ji, jj, jpka, nt_n, jtra )
+               END DO                                     
+            END IF
+            !!
+            !! Matrix inversion
+            !! ----------------------------------------------------------
+            DO ji = 1,jpi            
+               zcff                       =  1._wp / z_elem_b( ji, 2 )
+               zCF   (ji,   2           ) = - zcff * z_elem_c( ji, 2 )
+               tq_abl(ji,jj,2,nt_a,jtra) =    zcff * tq_abl(ji,jj,2,nt_a,jtra)
+            END DO             
+
+            DO jk = 3, jpka            
+               DO ji = 1,jpi            
+                  zcff = 1._wp / ( z_elem_b( ji, jk ) + z_elem_a( ji, jk ) * zCF   (ji, jk-1 ) )
+                  zCF(ji,jk) = - zcff * z_elem_c( ji, jk )
+                  tq_abl(ji,jj,jk,nt_a,jtra) = zcff * ( tq_abl(ji,jj,jk  ,nt_a,jtra)   &
+                  &                - z_elem_a(ji, jk) * tq_abl(ji,jj,jk-1,nt_a,jtra) )
+               END DO
+            END DO
+!!FL at this point we could check positivity of tq_abl(:,:,:,nt_a,jp_qa) ... test to do ...         
+            DO jk = jpkam1,2,-1            
+               DO ji = 1,jpi  
+                  tq_abl(ji,jj,jk,nt_a,jtra) = tq_abl(ji,jj,jk,nt_a,jtra) +    &
+                     &                        zCF(ji,jk) * tq_abl(ji,jj,jk+1,nt_a,jtra)
+               END DO
+            END DO
+         
+         END DO   !<-- loop on tracers                    
+         !! 
+      !-------------
+      END DO             ! end outer loop 
+      !-------------   
+      
+      
+      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !                            !  3 *** Compute Coriolis term with geostrophic guide
+      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<  
+      !-------------        
+      DO jk = 2, jpka    ! outer loop
+      !-------------
+         !             
+         ! Advance u_abl & v_abl to time n+1
+         DO_2D_11_11
+            zcff = ( fft_abl(ji,jj) * rDt_abl )*( fft_abl(ji,jj) * rDt_abl )  ! (f dt)**2
+   
+            u_abl( ji, jj, jk, nt_a ) = e3t_abl(jk) *(  &
+               &        (1._wp-gamma_Cor*(1._wp-gamma_Cor)*zcff)*u_abl( ji, jj, jk, nt_n )    &
+               &                 +  rDt_abl * fft_abl(ji, jj) * v_abl ( ji , jj  , jk, nt_n ) )  &
+               &                               / (1._wp + gamma_Cor*gamma_Cor*zcff)
+               
+            v_abl( ji, jj, jk, nt_a ) =  e3t_abl(jk) *(  &
+               &        (1._wp-gamma_Cor*(1._wp-gamma_Cor)*zcff)*v_abl( ji, jj, jk, nt_n )   &
+               &                 -  rDt_abl * fft_abl(ji, jj) * u_abl ( ji   , jj, jk, nt_n )  ) &
+               &                                / (1._wp + gamma_Cor*gamma_Cor*zcff)                
+         END_2D
+         !                                   
+      !-------------
+      END DO             ! end outer loop  !<-- u_abl and v_abl are properly updated on (1:jpi) x (1:jpj)
+      !-------------                
+      !
+      IF( ln_geos_winds ) THEN
+         DO jj = 1, jpj    ! outer loop       
+            DO jk = 1, jpka
+               DO ji = 1, jpi 
+                  u_abl( ji, jj, jk, nt_a ) = u_abl( ji, jj, jk, nt_a )   &
+                     &                      - rDt_abl * e3t_abl(jk) * fft_abl(ji  , jj) * pgv_dta(ji  ,jj  ,jk)
+                  v_abl( ji, jj, jk, nt_a ) = v_abl( ji, jj, jk, nt_a )   &
+                     &                      + rDt_abl * e3t_abl(jk) * fft_abl(ji, jj  ) * pgu_dta(ji  ,jj  ,jk)
+               END DO
+            END DO
+         END DO      
+      END IF 
+      !-------------            
+      !
+      IF( ln_hpgls_frc ) THEN
+         DO jj = 1, jpj    ! outer loop       
+            DO jk = 1, jpka
+               DO ji = 1, jpi 
+                  u_abl( ji, jj, jk, nt_a ) = u_abl( ji, jj, jk, nt_a ) - rDt_abl * e3t_abl(jk) * pgu_dta(ji,jj,jk)
+                  v_abl( ji, jj, jk, nt_a ) = v_abl( ji, jj, jk, nt_a ) - rDt_abl * e3t_abl(jk) * pgv_dta(ji,jj,jk)  
+               ENDDO
+            ENDDO
+         ENDDO 
+      END IF
+	  
+      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !                            !  4 *** Advance u,v to time n+1 
+      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
+      !
+      !  Vertical diffusion for u_abl     
+      !-------------
+      DO jj = 1, jpj    ! outer loop
+      !-------------    
+
+         DO jk = 3, jpkam1
+            DO ji = 1, jpi  
+               z_elem_a( ji,     jk ) = - rDt_abl * Avm_abl( ji, jj, jk-1 ) / e3w_abl( jk-1 )  ! lower-diagonal
+               z_elem_c( ji,     jk ) = - rDt_abl * Avm_abl( ji, jj, jk   ) / e3w_abl( jk   )  ! upper-diagonal                
+               z_elem_b( ji,     jk ) = e3t_abl(jk) - z_elem_a( ji, jk ) - z_elem_c( ji, jk )                             !       diagonal
+            END DO
+         END DO  
+            
+         DO ji = 2, jpi   ! boundary conditions   (Avm_abl and pcd_du must be available at ji=jpi)            
+            !++ Surface boundary condition
+            z_elem_a( ji,     2    ) = 0._wp
+            z_elem_c( ji,     2    ) = - rDt_abl * Avm_abl( ji, jj, 2   ) / e3w_abl( 2   )                                       
+            !
+			zztmp1  = pcd_du(ji, jj)
+			zztmp2  = 0.5_wp * pcd_du(ji, jj) * ( pssu(ji-1, jj) + pssu(ji,jj) )			
+#if defined key_si3				  
+            zztmp1 = zztmp1 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * pcd_du_ice(ji, jj)
+			zzice  = 0.5_wp * ( pssu_ice(ji-1, jj) + pssu_ice(ji,jj) )
+			zztmp2 = zztmp2 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * pcd_du_ice(ji, jj) * zzice
+#endif           
+			z_elem_b( ji,     2       ) = e3t_abl( 2 ) - z_elem_c( ji, 2 ) + rDt_abl * zztmp1 			
+            u_abl( ji, jj,    2, nt_a ) =      u_abl( ji, jj,    2, nt_a ) + rDt_abl * zztmp2
+			
+            !++ Top Neumann B.C.
+            !z_elem_a( ji,     jpka ) = - 0.5_wp * rDt_abl * ( Avm_abl( ji, jj, jpka )+ Avm_abl( ji+1, jj, jpka ) ) / e3w_abl( jpka ) 
+            !z_elem_c( ji,     jpka ) = 0._wp
+            !z_elem_b( ji,     jpka ) = e3t_abl( jpka ) - z_elem_a( ji,     jpka )                                               
+            !++ Top Dirichlet B.C.
+            z_elem_a( ji,     jpka )       = 0._wp
+            z_elem_c( ji,     jpka )       = 0._wp
+            z_elem_b( ji,     jpka )       = e3t_abl( jpka )
+            u_abl   ( ji, jj, jpka, nt_a ) = e3t_abl( jpka ) * pu_dta(ji,jj,jk)              
+         END DO 
+         !!
+         !! Matrix inversion
+         !! ----------------------------------------------------------
+         DO ji = 2, jpi          
+            zcff                 =   1._wp / z_elem_b( ji, 2 )
+            zCF   (ji,   2     ) =  - zcff * z_elem_c( ji, 2 ) 
+            u_abl (ji,jj,2,nt_a) =    zcff * u_abl(ji,jj,2,nt_a)
+         END DO             
+
+         DO jk = 3, jpka            
+            DO ji = 2, jpi              
+               zcff = 1._wp / ( z_elem_b( ji, jk ) + z_elem_a( ji, jk ) * zCF   (ji, jk-1 ) )
+               zCF(ji,jk) = - zcff * z_elem_c( ji, jk )
+               u_abl(ji,jj,jk,nt_a) = zcff * ( u_abl(ji,jj,jk  ,nt_a)   &
+               &          - z_elem_a(ji, jk) * u_abl(ji,jj,jk-1,nt_a) )
+            END DO
+         END DO
+            
+         DO jk = jpkam1,2,-1            
+            DO ji = 2, jpi
+               u_abl(ji,jj,jk,nt_a) = u_abl(ji,jj,jk,nt_a) + zCF(ji,jk) * u_abl(ji,jj,jk+1,nt_a)
+            END DO
+         END DO
+                                          
+      !-------------
+      END DO             ! end outer loop 
+      !-------------   
+
+      !
+      !  Vertical diffusion for v_abl     
+      !-------------
+      DO jj = 2, jpj   ! outer loop
+      !-------------    
+         !
+         DO jk = 3, jpkam1
+            DO ji = 1, jpi   
+               z_elem_a( ji,     jk ) = -rDt_abl * Avm_abl( ji, jj, jk-1 ) / e3w_abl( jk-1 )   ! lower-diagonal
+               z_elem_c( ji,     jk ) = -rDt_abl * Avm_abl( ji, jj, jk   ) / e3w_abl( jk   )   ! upper-diagonal              
+               z_elem_b( ji,     jk ) = e3t_abl(jk) - z_elem_a( ji, jk ) - z_elem_c( ji, jk )                              !       diagonal
+            END DO
+         END DO
+
+         DO ji = 1, jpi   ! boundary conditions (Avm_abl and pcd_du must be available at jj=jpj)          
+            !++ Surface boundary condition
+            z_elem_a( ji,     2    ) = 0._wp
+            z_elem_c( ji,     2    ) = - rDt_abl * Avm_abl( ji, jj, 2   ) / e3w_abl( 2   )        
+            !
+			zztmp1 = pcd_du(ji, jj)
+			zztmp2 = 0.5_wp * pcd_du(ji, jj) * ( pssv(ji, jj) + pssv(ji, jj-1) )  
+#if defined key_si3				  
+            zztmp1 = zztmp1 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * pcd_du_ice(ji, jj)
+			zzice  = 0.5_wp * ( pssv_ice(ji, jj) + pssv_ice(ji,jj-1) )
+			zztmp2 = zztmp2 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * pcd_du_ice(ji, jj) * zzice
+#endif 			
+            z_elem_b( ji,     2       ) = e3t_abl( 2 ) - z_elem_c( ji, 2 ) + rDt_abl * zztmp1 
+            v_abl( ji, jj,    2, nt_a ) =         v_abl( ji, jj, 2, nt_a ) + rDt_abl * zztmp2
+            !++ Top Neumann B.C.            
+            !z_elem_a( ji,     jpka ) = -rDt_abl * Avm_abl( ji, jj, jpka ) / e3w_abl( jpka ) 
+            !z_elem_c( ji,     jpka ) = 0._wp
+            !z_elem_b( ji,     jpka ) = e3t_abl( jpka ) - z_elem_a( ji,     jpka )                                               
+            !++ Top Dirichlet B.C.
+            z_elem_a( ji,     jpka )       = 0._wp
+            z_elem_c( ji,     jpka )       = 0._wp
+            z_elem_b( ji,     jpka )       = e3t_abl( jpka )
+            v_abl   ( ji, jj, jpka, nt_a ) = e3t_abl( jpka ) * pv_dta(ji,jj,jk)             
+         END DO 
+         !!
+         !! Matrix inversion
+         !! ----------------------------------------------------------
+         DO ji = 1, jpi              
+            zcff                 =  1._wp / z_elem_b( ji, 2 )
+            zCF   (ji,   2     ) =   - zcff * z_elem_c( ji,     2       ) 
+            v_abl (ji,jj,2,nt_a) =     zcff * v_abl   ( ji, jj, 2, nt_a ) 
+         END DO             
+
+         DO jk = 3, jpka            
+            DO ji = 1, jpi                   
+               zcff = 1._wp / ( z_elem_b( ji, jk ) + z_elem_a( ji, jk ) * zCF   (ji, jk-1 ) )
+               zCF(ji,jk) = - zcff * z_elem_c( ji, jk )
+               v_abl(ji,jj,jk,nt_a) = zcff * ( v_abl(ji,jj,jk  ,nt_a)   &
+               &          - z_elem_a(ji, jk) * v_abl(ji,jj,jk-1,nt_a) )
+            END DO
+         END DO
+            
+         DO jk = jpkam1,2,-1            
+            DO ji = 1, jpi    
+               v_abl(ji,jj,jk,nt_a) = v_abl(ji,jj,jk,nt_a) + zCF(ji,jk) * v_abl(ji,jj,jk+1,nt_a)
+            END DO
+         END DO
+         !                                          
+      !-------------
+      END DO             ! end outer loop 
+      !-------------   
+    
+      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !                            !  5 *** Apply nudging on the dynamics and the tracers 
+      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
+      z_cft(:,:,:) = 0._wp      
+      
+      IF( nn_dyn_restore > 0  ) THEN
+         !------------- 
+         DO jk = 2, jpka    ! outer loop
+         !-------------       
+            DO_2D_01_01
+               zcff1 = pblh( ji, jj )
+               zsig  = ght_abl(jk) / MAX( jp_pblh_min,  MIN(  jp_pblh_max, zcff1  ) )                        
+               zsig  =               MIN( jp_bmax    ,  MAX(         zsig, jp_bmin) ) 
+               zmsk  = msk_abl(ji,jj)
+               zcff2 = jp_alp3_dyn * zsig**3 + jp_alp2_dyn * zsig**2   &
+                  &  + jp_alp1_dyn * zsig    + jp_alp0_dyn
+               zcff  = (1._wp-zmsk) + zmsk * zcff2 * rn_Dt   ! zcff = 1 for masked points
+                                                             ! rn_Dt = rDt_abl / nn_fsbc                          
+               zcff  = zcff * rest_eq(ji,jj)
+               z_cft( ji, jj, jk ) = zcff
+               u_abl( ji, jj, jk, nt_a ) = (1._wp - zcff ) *  u_abl( ji, jj, jk, nt_a )   &
+                  &                               + zcff   * pu_dta( ji, jj, jk       )                      
+               v_abl( ji, jj, jk, nt_a ) = (1._wp - zcff ) *  v_abl( ji, jj, jk, nt_a )   &
+                  &                               + zcff   * pv_dta( ji, jj, jk       )
+            END_2D
+         !-------------
+         END DO             ! end outer loop
+         !-------------               
+      END IF
+
+      !------------- 
+      DO jk = 2, jpka    ! outer loop
+      !-------------       
+         DO_2D_11_11
+            zcff1 = pblh( ji, jj )
+            zsig  = ght_abl(jk) / MAX( jp_pblh_min,  MIN(  jp_pblh_max, zcff1  ) )
+            zsig  =               MIN( jp_bmax    ,  MAX(         zsig, jp_bmin) ) 
+            zmsk  = msk_abl(ji,jj)
+            zcff2 = jp_alp3_tra * zsig**3 + jp_alp2_tra * zsig**2   &
+               &  + jp_alp1_tra * zsig    + jp_alp0_tra
+            zcff  = (1._wp-zmsk) + zmsk * zcff2 * rn_Dt   ! zcff = 1 for masked points
+                                                          ! rn_Dt = rDt_abl / nn_fsbc                          
+            !z_cft( ji, jj, jk ) = zcff
+            tq_abl( ji, jj, jk, nt_a, jp_ta ) = (1._wp - zcff ) * tq_abl( ji, jj, jk, nt_a, jp_ta )   &
+               &                                       + zcff   * pt_dta( ji, jj, jk )
+            
+            tq_abl( ji, jj, jk, nt_a, jp_qa ) = (1._wp - zcff ) * tq_abl( ji, jj, jk, nt_a, jp_qa )   &
+               &                                       + zcff   * pq_dta( ji, jj, jk )
+            
+         END_2D
+      !-------------
+      END DO             ! end outer loop
+      !------------- 	  
+      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !                            !  6 *** MPI exchanges  
+      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !
+      CALL lbc_lnk_multi( 'ablmod',  u_abl(:,:,:,nt_a      ), 'T', -1.,  v_abl(:,:,:,nt_a      ), 'T', -1. )
+      CALL lbc_lnk_multi( 'ablmod', tq_abl(:,:,:,nt_a,jp_ta), 'T',  1., tq_abl(:,:,:,nt_a,jp_qa), 'T',  1., kfillmode = jpfillnothing )   ! ++++ this should not be needed...
+      !
+      ! first ABL level
+      IF ( iom_use("uz1_abl") ) CALL iom_put ( "uz1_abl",   u_abl(:,:,2,nt_a      ) )
+      IF ( iom_use("vz1_abl") ) CALL iom_put ( "vz1_abl",   v_abl(:,:,2,nt_a      ) )
+      IF ( iom_use("tz1_abl") ) CALL iom_put ( "tz1_abl",  tq_abl(:,:,2,nt_a,jp_ta) )
+      IF ( iom_use("qz1_abl") ) CALL iom_put ( "qz1_abl",  tq_abl(:,:,2,nt_a,jp_qa) )
+      IF ( iom_use("uz1_dta") ) CALL iom_put ( "uz1_dta",  pu_dta(:,:,2           ) )
+      IF ( iom_use("vz1_dta") ) CALL iom_put ( "vz1_dta",  pv_dta(:,:,2           ) )
+      IF ( iom_use("tz1_dta") ) CALL iom_put ( "tz1_dta",  pt_dta(:,:,2           ) )
+      IF ( iom_use("qz1_dta") ) CALL iom_put ( "qz1_dta",  pq_dta(:,:,2           ) )
+      ! all ABL levels
+      IF ( iom_use("u_abl"  ) ) CALL iom_put ( "u_abl"  ,   u_abl(:,:,2:jpka,nt_a      ) )
+      IF ( iom_use("v_abl"  ) ) CALL iom_put ( "v_abl"  ,   v_abl(:,:,2:jpka,nt_a      ) )
+      IF ( iom_use("t_abl"  ) ) CALL iom_put ( "t_abl"  ,  tq_abl(:,:,2:jpka,nt_a,jp_ta) )
+      IF ( iom_use("q_abl"  ) ) CALL iom_put ( "q_abl"  ,  tq_abl(:,:,2:jpka,nt_a,jp_qa) )
+      IF ( iom_use("tke_abl") ) CALL iom_put ( "tke_abl", tke_abl(:,:,2:jpka,nt_a      ) )
+      IF ( iom_use("avm_abl") ) CALL iom_put ( "avm_abl", avm_abl(:,:,2:jpka           ) )
+      IF ( iom_use("avt_abl") ) CALL iom_put ( "avt_abl", avm_abl(:,:,2:jpka           ) )
+      IF ( iom_use("mxl_abl") ) CALL iom_put ( "mxl_abl", mxl_abl(:,:,2:jpka           ) )
+      IF ( iom_use("pblh"   ) ) CALL iom_put (  "pblh"  ,    pblh(:,:                  ) )
+      ! debug (to be removed)
+      IF ( iom_use("u_dta") ) CALL iom_put ( "u_dta",  pu_dta(:,:,2:jpka) )
+      IF ( iom_use("v_dta") ) CALL iom_put ( "v_dta",  pv_dta(:,:,2:jpka) )
+      IF ( iom_use("t_dta") ) CALL iom_put ( "t_dta",  pt_dta(:,:,2:jpka) )
+      IF ( iom_use("q_dta") ) CALL iom_put ( "q_dta",  pq_dta(:,:,2:jpka) )
+      IF ( iom_use("coeft") ) CALL iom_put ( "coeft",   z_cft(:,:,2:jpka) )
+      IF( ln_geos_winds ) THEN
+         IF ( iom_use("uz1_geo") ) CALL iom_put ( "uz1_geo", pgu_dta(:,:,2           ) )
+         IF ( iom_use("vz1_geo") ) CALL iom_put ( "vz1_geo", pgv_dta(:,:,2           ) )
+      END IF
+      IF( ln_hpgls_frc ) THEN
+         IF ( iom_use("uz1_geo") ) CALL iom_put ( "uz1_geo",  pgu_dta(:,:,2)/MAX(fft_abl(:,:),2.5e-5_wp)   )
+         IF ( iom_use("vz1_geo") ) CALL iom_put ( "vz1_geo", -pgv_dta(:,:,2)/MAX(fft_abl(:,:),2.5e-5_wp)   )
+      END IF
+      !
+      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !                            !  7 *** Finalize flux computation
+      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
+
+      DO_2D_11_11
+         ztemp             = tq_abl  ( ji, jj, 2, nt_a, jp_ta ) 
+         zhumi             = tq_abl  ( ji, jj, 2, nt_a, jp_qa ) 
+         !zcff              = pslp_dta( ji, jj ) /   &              !<-- At this point ztemp and zhumi should not be zero ...
+         !   &                        (  R_dry*ztemp * ( 1._wp + rctv0*zhumi )  )
+         zcff              = rho_air( ztemp, zhumi, pslp_dta( ji, jj ) )
+         psen ( ji, jj )   =      cp_air(zhumi) * zcff * psen(ji,jj) * ( psst(ji,jj) + rt0 - ztemp )
+         pevp ( ji, jj )   = rn_efac*MAX( 0._wp,  zcff * pevp(ji,jj) * ( pssq(ji,jj)       - zhumi ) )
+         rhoa( ji, jj )   = zcff              
+      END_2D
+      
+      DO_2D_01_01
+         zwnd_i(ji,jj) = u_abl(ji  ,jj,2,nt_a) - 0.5_wp * rn_vfac * ( pssu(ji  ,jj) + pssu(ji-1,jj) )  
+         zwnd_j(ji,jj) = v_abl(ji,jj  ,2,nt_a) - 0.5_wp * rn_vfac * ( pssv(ji,jj  ) + pssv(ji,jj-1) ) 
+      END_2D
+      ! 
+      CALL lbc_lnk_multi( 'ablmod', zwnd_i(:,:) , 'T', -1., zwnd_j(:,:) , 'T', -1. )
+      !
+      ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked)
+      DO_2D_11_11
+         zcff          = SQRT(  zwnd_i(ji,jj) * zwnd_i(ji,jj)   &
+            &                 + zwnd_j(ji,jj) * zwnd_j(ji,jj)  )  ! * msk_abl(ji,jj)
+         zztmp         = rhoa(ji,jj) * pcd_du(ji,jj)
+         
+         pwndm (ji,jj) =         zcff
+         ptaum (ji,jj) = zztmp * zcff
+         zwnd_i(ji,jj) = zztmp * zwnd_i(ji,jj)
+         zwnd_j(ji,jj) = zztmp * zwnd_j(ji,jj)
+      END_2D
+      ! ... utau, vtau at U- and V_points, resp.
+      !     Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines
+      !     Note the use of MAX(tmask(i,j),tmask(i+1,j) is to mask tau over ice shelves
+      DO_2D_00_00
+         zcff  = 0.5_wp * ( 2._wp - msk_abl(ji,jj)*msk_abl(ji+1,jj) )
+         zztmp = MAX(msk_abl(ji,jj),msk_abl(ji+1,jj))
+         ptaui(ji,jj) = zcff * zztmp * ( zwnd_i(ji,jj) + zwnd_i(ji+1,jj  ) )
+         zcff  = 0.5_wp * ( 2._wp - msk_abl(ji,jj)*msk_abl(ji,jj+1) )
+         zztmp = MAX(msk_abl(ji,jj),msk_abl(ji,jj+1))
+         ptauj(ji,jj) = zcff * zztmp * ( zwnd_j(ji,jj) + zwnd_j(ji  ,jj+1) )
+      END_2D
+      !
+      CALL lbc_lnk_multi( 'ablmod', ptaui(:,:), 'U', -1., ptauj(:,:), 'V', -1. )
+
+      CALL iom_put( "taum_oce", ptaum )
+
+      IF(sn_cfctl%l_prtctl) THEN
+         CALL prt_ctl( tab2d_1=pwndm  , clinfo1=' abl_stp: wndm   : ' )
+         CALL prt_ctl( tab2d_1=ptaui  , clinfo1=' abl_stp: utau   : ' )
+         CALL prt_ctl( tab2d_2=ptauj  , clinfo2=          'vtau   : ' )
+      ENDIF
+
+#if defined key_si3
+         ! ------------------------------------------------------------ !
+         !    Wind stress relative to the moving ice ( U10m - U_ice )   !
+         ! ------------------------------------------------------------ !
+         DO_2D_00_00
+            
+            zztmp1 = 0.5_wp * ( u_abl(ji+1,jj,2,nt_a) + u_abl(ji,jj,2,nt_a) )
+            zztmp2 = 0.5_wp * ( v_abl(ji,jj+1,2,nt_a) + v_abl(ji,jj,2,nt_a) )
+   
+            ptaui_ice(ji,jj) = 0.5_wp * (  rhoa(ji+1,jj) * pCd_du_ice(ji+1,jj)             &
+               &                      +    rhoa(ji  ,jj) * pCd_du_ice(ji  ,jj)  )          &
+               &         * ( zztmp1 - rn_vfac * pssu_ice(ji,jj) )
+            ptauj_ice(ji,jj) = 0.5_wp * (  rhoa(ji,jj+1) * pCd_du_ice(ji,jj+1)             &
+               &                      +    rhoa(ji,jj  ) * pCd_du_ice(ji,jj  )  )          &
+               &         * ( zztmp2 - rn_vfac * pssv_ice(ji,jj) )
+         END_2D
+         CALL lbc_lnk_multi( 'ablmod', ptaui_ice, 'U', -1., ptauj_ice, 'V', -1. )
+         !
+         IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=ptaui_ice  , clinfo1=' abl_stp: putaui : '   &
+            &                                , tab2d_2=ptauj_ice  , clinfo2='          pvtaui : ' )
+#endif
+      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !                            !  8 *** Swap time indices for the next timestep
+      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      nt_n = 1 + MOD( nt_n, 2)
+      nt_a = 1 + MOD( nt_a, 2)
+      !
+!---------------------------------------------------------------------------------------------------
+   END SUBROUTINE abl_stp
+!===================================================================================================
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+!===================================================================================================
+   SUBROUTINE abl_zdf_tke( )
+!---------------------------------------------------------------------------------------------------
+
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE abl_zdf_tke  ***
+      !!
+      !! ** Purpose :   Time-step Turbulente Kinetic Energy (TKE) equation
+      !!
+      !! ** Method  : - source term due to shear
+      !!              - source term due to stratification
+      !!              - resolution of the TKE equation by inverting
+      !!                a tridiagonal linear system
+      !!
+      !! ** Action  : - en : now turbulent kinetic energy)
+      !!              - avmu, avmv : production of TKE by shear at u and v-points
+      !!                (= Kz dz[Ub] * dz[Un] )
+      !! ---------------------------------------------------------------------
+      INTEGER                                 ::   ji, jj, jk, tind, jbak, jkup, jkdwn 
+      INTEGER, DIMENSION(1:jpi          )     ::   ikbl
+      REAL(wp)                                ::   zcff, zcff2, ztken, zesrf, zetop, ziRic, ztv
+      REAL(wp)                                ::   zdU, zdV, zcff1,zshear,zbuoy,zsig, zustar2
+      REAL(wp)                                ::   zdU2,zdV2      
+      REAL(wp)                                ::   zwndi,zwndj
+      REAL(wp), DIMENSION(1:jpi,      1:jpka) ::   zsh2
+      REAL(wp), DIMENSION(1:jpi,1:jpj,1:jpka) ::   zbn2
+      REAL(wp), DIMENSION(1:jpi,1:jpka  )     ::   zFC, zRH, zCF       
+      REAL(wp), DIMENSION(1:jpi,1:jpka  )     ::   z_elem_a
+      REAL(wp), DIMENSION(1:jpi,1:jpka  )     ::   z_elem_b
+      REAL(wp), DIMENSION(1:jpi,1:jpka  )     ::   z_elem_c
+      LOGICAL                                 ::   ln_Patankar    = .FALSE.
+      LOGICAL                                 ::   ln_dumpvar     = .FALSE.
+      LOGICAL , DIMENSION(1:jpi         )     ::   ln_foundl 
+      !
+      tind  = nt_n
+      ziRic = 1._wp / rn_Ric
+      ! if tind = nt_a it is required to apply lbc_lnk on u_abl(nt_a) and v_abl(nt_a)
+      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !                            !  Advance TKE equation to time n+1
+      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !-------------
+      DO jj = 1, jpj    ! outer loop
+      !-------------
+         !
+         ! Compute vertical shear         
+         DO jk = 2, jpkam1
+            DO ji = 1,jpi  
+               zcff        = 1.0_wp / e3w_abl( jk )**2                
+               zdU         = zcff* Avm_abl(ji,jj,jk) * (u_abl( ji, jj, jk+1, tind)-u_abl( ji, jj, jk  , tind) )**2                           
+               zdV         = zcff* Avm_abl(ji,jj,jk) * (v_abl( ji, jj, jk+1, tind)-v_abl( ji, jj, jk  , tind) )**2
+               zsh2(ji,jk) = zdU+zdV
+            END DO
+         END DO   
+         !
+         ! Compute brunt-vaisala frequency
+         DO jk = 2, jpkam1
+            DO ji = 1,jpi 
+               zcff  = grav * itvref / e3w_abl( jk )  
+               zcff1 =  tq_abl( ji, jj, jk+1, tind, jp_ta) - tq_abl( ji, jj, jk  , tind, jp_ta)
+               zcff2 =  tq_abl( ji, jj, jk+1, tind, jp_ta) * tq_abl( ji, jj, jk+1, tind, jp_qa)        &
+                  &   - tq_abl( ji, jj, jk  , tind, jp_ta) * tq_abl( ji, jj, jk  , tind, jp_qa)
+               zbn2(ji,jj,jk) = zcff * ( zcff1 + rctv0 * zcff2 )  !<-- zbn2 defined on (2,jpi)
+            END DO
+         END DO 
+         !
+         ! Terms for the tridiagonal problem
+         DO jk = 2, jpkam1
+            DO ji = 1,jpi 
+               zshear       =                 zsh2( ji,     jk )   ! zsh2 is already multiplied by Avm_abl at this point
+               zsh2(ji,jk)  = zsh2( ji, jk ) / Avm_abl( ji, jj, jk )   ! reformulate zsh2 as a 'true' vertical shear for PBLH computation          
+               zbuoy        = - Avt_abl( ji, jj, jk ) * zbn2( ji, jj, jk ) 
+               
+               z_elem_a( ji,     jk )   = - 0.5_wp * rDt_abl * rn_Sch * ( Avm_abl( ji, jj, jk   )+Avm_abl( ji, jj, jk-1 ) ) / e3t_abl( jk   ) ! lower-diagonal
+               z_elem_c( ji,     jk )   = - 0.5_wp * rDt_abl * rn_Sch * ( Avm_abl( ji, jj, jk   )+Avm_abl( ji, jj, jk+1 ) ) / e3t_abl( jk+1 ) ! upper-diagonal          
+               IF( (zbuoy + zshear) .gt. 0.) THEN    ! Patankar trick to avoid negative values of TKE
+                  z_elem_b( ji,     jk )   = e3w_abl(jk) - z_elem_a( ji, jk ) - z_elem_c( ji, jk )   &
+                     &                     + e3w_abl(jk) * rDt_abl * rn_Ceps * sqrt(tke_abl( ji, jj, jk, nt_n )) / mxl_abl(ji,jj,jk)     ! diagonal       
+                  tke_abl( ji, jj, jk, nt_a )  = e3w_abl(jk) * ( tke_abl( ji, jj, jk, nt_n ) + rDt_abl * ( zbuoy + zshear ) )             ! right-hand-side
+               ELSE
+                  z_elem_b( ji,     jk )   = e3w_abl(jk) - z_elem_a( ji, jk ) - z_elem_c( ji, jk )   &
+                     &                     + e3w_abl(jk) * rDt_abl * rn_Ceps * sqrt(tke_abl( ji, jj, jk, nt_n )) / mxl_abl(ji,jj,jk)   &  ! diagonal    
+                     &                     - e3w_abl(jk) * rDt_abl * zbuoy   
+                  tke_abl( ji, jj, jk, nt_a )  = e3w_abl(jk) * ( tke_abl( ji, jj, jk, nt_n ) + rDt_abl *  zshear )             ! right-hand-side                     
+               END IF
+            END DO
+         END DO  
+                            
+         DO ji = 1,jpi    ! vector opt.            
+            zesrf   =  MAX( 4.63_wp * ustar2(ji,jj), tke_min )           
+            zetop   = tke_min             
+            z_elem_a ( ji,     1    ) = 0._wp; z_elem_c ( ji,     1    ) = 0._wp; z_elem_b ( ji,     1    ) = 1._wp                                                   
+            z_elem_a ( ji,     jpka ) = 0._wp; z_elem_c ( ji,     jpka ) = 0._wp; z_elem_b ( ji,     jpka ) = 1._wp            
+            tke_abl( ji, jj,    1, nt_a ) = zesrf
+            tke_abl( ji, jj, jpka, nt_a ) = zetop 
+            zbn2(ji,jj,   1) = zbn2( ji,jj,   2) 
+            zsh2(ji,      1) = zsh2( ji,      2)                                      
+            zbn2(ji,jj,jpka) = zbn2( ji,jj,jpkam1) 
+            zsh2(ji,   jpka) = zsh2( ji  , jpkam1)
+         END DO        
+         !!
+         !! Matrix inversion
+         !! ----------------------------------------------------------
+         DO ji = 1,jpi
+            zcff                  =  1._wp / z_elem_b( ji, 1 )
+            zCF    (ji,   1     ) = - zcff * z_elem_c( ji,     1       ) 
+            tke_abl(ji,jj,1,nt_a) =   zcff * tke_abl ( ji, jj, 1, nt_a ) 
+         END DO             
+
+         DO jk = 2, jpka            
+            DO ji = 1,jpi
+               zcff = 1._wp / ( z_elem_b( ji, jk ) + z_elem_a( ji, jk ) * zCF(ji, jk-1 ) )
+               zCF(ji,jk) = - zcff * z_elem_c( ji, jk )
+               tke_abl(ji,jj,jk,nt_a) =   zcff * ( tke_abl(ji,jj,jk  ,nt_a)   &
+               &          - z_elem_a(ji, jk) * tke_abl(ji,jj,jk-1,nt_a) )
+            END DO
+         END DO
+            
+         DO jk = jpkam1,1,-1            
+            DO ji = 1,jpi
+               tke_abl(ji,jj,jk,nt_a) = tke_abl(ji,jj,jk,nt_a) + zCF(ji,jk) * tke_abl(ji,jj,jk+1,nt_a)
+            END DO
+         END DO
+         
+!!FL should not be needed because of Patankar procedure  
+         tke_abl(2:jpi,jj,1:jpka,nt_a) = MAX( tke_abl(2:jpi,jj,1:jpka,nt_a), tke_min )
+
+         !!
+         !! Diagnose PBL height
+         !! ----------------------------------------------------------
+         
+         
+         !                                                       
+         ! arrays zRH, zFC and zCF are available at this point
+         ! and zFC(:, 1 ) = 0.
+         ! diagnose PBL height based on zsh2 and zbn2
+         zFC (  :  ,1) = 0._wp
+         ikbl( 1:jpi ) = 0 
+         
+         DO jk = 2,jpka
+            DO ji = 1, jpi 
+               zcff  = ghw_abl( jk-1 )
+               zcff1 = zcff / ( zcff + rn_epssfc * pblh ( ji, jj ) )
+               zcff  = ghw_abl( jk   )
+               zcff2 = zcff / ( zcff + rn_epssfc * pblh ( ji, jj ) )
+               zFC( ji, jk ) = zFC( ji, jk-1) + 0.5_wp * e3t_abl( jk )*(                 &
+                               zcff2 * ( zsh2( ji, jk  ) - ziRic * zbn2( ji, jj, jk   ) &
+                           - rn_Cek  * ( fft_abl( ji, jj  ) * fft_abl( ji, jj ) ) ) &
+                             + zcff1 * ( zsh2( ji, jk-1) - ziRic * zbn2( ji, jj, jk-1 ) &
+                           - rn_Cek  * ( fft_abl( ji, jj  ) * fft_abl( ji, jj ) ) ) &
+                           &                                                 )
+               IF( ikbl(ji) == 0 .and. zFC( ji, jk ).lt.0._wp ) ikbl(ji)=jk
+            END DO
+         END DO
+         !
+         ! finalize the computation of the PBL height
+         DO ji = 1, jpi
+            jk = ikbl(ji)
+            IF( jk > 2 ) THEN ! linear interpolation to get subgrid value of pblh
+               pblh( ji, jj ) =  (  ghw_abl( jk-1 ) * zFC( ji, jk   )       &
+                  &              -  ghw_abl( jk   ) * zFC( ji, jk-1 )       &
+                  &              ) / ( zFC( ji, jk   ) - zFC( ji, jk-1 ) )
+            ELSE IF( jk==2 ) THEN
+               pblh( ji, jj ) = ghw_abl(2   )
+            ELSE
+               pblh( ji, jj ) = ghw_abl(jpka)
+            END IF 
+         END DO
+      !-------------      
+      END DO      
+      !-------------
+      !
+      ! Optional : could add pblh smoothing if pblh is noisy horizontally ... 
+      IF(ln_smth_pblh) THEN
+         CALL lbc_lnk( 'ablmod', pblh, 'T', 1.)
+         CALL smooth_pblh( pblh, msk_abl )
+         CALL lbc_lnk( 'ablmod', pblh, 'T', 1.)	  
+      ENDIF
+      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !                            !  Diagnostic mixing length computation
+      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !
+      SELECT CASE ( nn_amxl )
+      !
+      CASE ( 0 )           ! Deardroff 80 length-scale bounded by the distance to surface and bottom         
+#   define zlup zRH      
+#   define zldw zFC 
+         DO jj = 1, jpj     ! outer loop
+            !
+            DO ji = 1, jpi
+               mxl_abl ( ji, jj,    1 )  = 0._wp
+               mxl_abl ( ji, jj, jpka )  = mxl_min
+               zldw( ji,        1 )  = 0._wp              
+               zlup( ji,     jpka )  = 0._wp
+            END DO
+            !
+            DO jk = 2, jpkam1   
+               DO ji = 1, jpi  
+                  zbuoy             = MAX( zbn2(ji, jj, jk), rsmall )  
+                  mxl_abl( ji, jj, jk ) = MAX( mxl_min,  &
+                     &               SQRT( 2._wp * tke_abl( ji, jj, jk, nt_a ) / zbuoy )   ) 
+               END DO
+            END DO   
+            !
+            ! Limit mxl
+            DO jk = jpkam1,1,-1   
+               DO ji = 1, jpi 
+                  zlup(ji,jk) = MIN( zlup(ji,jk+1) + (ghw_abl(jk+1)-ghw_abl(jk)) , mxl_abl(ji, jj, jk) )
+               END DO
+            END DO   
+            !
+            DO jk = 2, jpka
+               DO ji = 1, jpi  
+                  zldw(ji,jk) = MIN( zldw(ji,jk-1) + (ghw_abl(jk)-ghw_abl(jk-1)) , mxl_abl(ji, jj, jk) )   
+               END DO
+            END DO 
+            !
+            DO jk = 1, jpka
+               DO ji = 1, jpi
+                  mxl_abl( ji, jj, jk ) = SQRT( zldw( ji, jk ) * zlup( ji, jk ) )   
+               END DO
+            END DO                         
+            !
+         END DO
+#   undef zlup      
+#   undef zldw  
+         !
+         !
+      CASE ( 1 )             ! length-scale computed as the distance to the PBL height
+         DO jj = 1,jpj      ! outer loop
+            !
+            DO ji = 1, jpi   ! vector opt.
+               zcff = 1._wp / pblh( ji, jj )     ! inverse of hbl              
+               DO jk = 1, jpka              
+                  zsig  = MIN( zcff * ghw_abl( jk ), 1. )    
+                  zcff1 = pblh( ji, jj )                 
+                  mxl_abl( ji, jj, jk ) =  mxl_min                           &
+                     &  +  zsig         * (  amx1*zcff1 + bmx1*mxl_min ) &
+                     &  +  zsig *  zsig * (  amx2*zcff1 + bmx2*mxl_min ) &
+                     &  +  zsig**3      * (  amx3*zcff1 + bmx3*mxl_min ) &
+                     &  +  zsig**4      * (  amx4*zcff1 + bmx4*mxl_min ) &
+                     &  +  zsig**5      * (  amx5*zcff1 + bmx5*mxl_min )
+               END DO
+            END DO 
+            !            
+         END DO            
+         !
+      CASE ( 2 )           ! Bougeault & Lacarrere 89 length-scale
+         !
+#   define zlup zRH      
+#   define zldw zFC           
+! zCF is used for matrix inversion
+!             
+       DO jj = 1, jpj      ! outer loop
+         
+         DO ji = 1, jpi           
+            zlup( ji,    1 ) = mxl_min
+            zldw( ji,    1 ) = mxl_min               
+            zlup( ji, jpka ) = mxl_min
+            zldw( ji, jpka ) = mxl_min                
+         END DO            
+         
+         DO jk = 2,jpka-1
+            DO ji = 1, jpi
+               zlup(ji,jk) = ghw_abl(jpka) - ghw_abl(jk)
+               zldw(ji,jk) = ghw_abl(jk  ) - ghw_abl( 1)        
+            END DO
+         END DO         
+         !!
+         !! BL89 search for lup
+         !! ----------------------------------------------------------           
+         DO jk=2,jpka-1 
+            !
+            DO ji = 1, jpi
+               zCF(ji,1:jpka) = 0._wp
+               zCF(ji,  jk  ) = - tke_abl( ji, jj, jk, nt_a )
+               ln_foundl(ji ) = .false.
+            END DO   
+            !           
+            DO jkup=jk+1,jpka-1
+               DO ji = 1, jpi
+                  zCF (ji,jkup) = zCF (ji,jkup-1) + 0.5_wp * e3t_abl(jkup) * &
+                     &               ( zbn2(ji,jj,jkup  )*(ghw_abl(jkup  )-ghw_abl(jk)) &
+                     &               + zbn2(ji,jj,jkup-1)*(ghw_abl(jkup-1)-ghw_abl(jk)) )
+                  IF( zCF (ji,jkup) * zCF (ji,jkup-1) .le. 0._wp .and. .not. ln_foundl(ji) ) THEN
+                     zcff2 = ghw_abl(jkup  ) - ghw_abl(jk)
+                     zcff1 = ghw_abl(jkup-1) - ghw_abl(jk)                   
+                     zcff  = ( zcff1 * zCF(ji,jkup) - zcff2 * zCF(ji,jkup-1) ) /   &
+                        &    (         zCF(ji,jkup) -         zCF(ji,jkup-1) ) 
+                     zlup(ji,jk) = zcff                
+                     ln_foundl(ji) = .true.
+                  END IF
+               END DO
+            END DO
+            !
+         END DO   
+         !!
+         !! BL89 search for ldwn
+         !! ----------------------------------------------------------          
+         DO jk=2,jpka-1         
+            !
+            DO ji = 1, jpi
+               zCF(ji,1:jpka) = 0._wp
+               zCF(ji,  jk  ) = - tke_abl( ji, jj, jk, nt_a )
+               ln_foundl(ji ) = .false.
+            END DO  
+            !   
+            DO jkdwn=jk-1,1,-1
+               DO ji = 1, jpi             
+                  zCF (ji,jkdwn) = zCF (ji,jkdwn+1) + 0.5_wp * e3t_abl(jkdwn+1)  &
+                     &               * ( zbn2(ji,jj,jkdwn+1)*(ghw_abl(jk)-ghw_abl(jkdwn+1)) &
+                                       + zbn2(ji,jj,jkdwn  )*(ghw_abl(jk)-ghw_abl(jkdwn  )) )   
+                  IF(zCF (ji,jkdwn) * zCF (ji,jkdwn+1) .le. 0._wp  .and. .not. ln_foundl(ji) ) THEN 
+                     zcff2 = ghw_abl(jk) - ghw_abl(jkdwn+1)
+                     zcff1 = ghw_abl(jk) - ghw_abl(jkdwn  )              
+                     zcff  = ( zcff1 * zCF(ji,jkdwn+1) - zcff2 * zCF(ji,jkdwn) ) /   &
+                        &    (         zCF(ji,jkdwn+1) -         zCF(ji,jkdwn) ) 
+                     zldw(ji,jk) = zcff 
+                     ln_foundl(ji) = .true.               
+                  END IF                                   
+               END DO
+            END DO
+            !      
+         END DO
+
+         DO jk = 1, jpka
+            DO ji = 1, jpi  
+               mxl_abl( ji, jj, jk ) = MAX( SQRT( zldw( ji, jk ) * zlup( ji, jk ) ), mxl_min )  
+            END DO
+         END DO  
+
+      END DO
+#   undef zlup      
+#   undef zldw           
+         !
+      END SELECT      
+      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !                            !  Finalize the computation of turbulent visc./diff.
+      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      
+      !-------------
+      DO jj = 1, jpj     ! outer loop
+      !-------------
+         DO jk = 1, jpka   
+            DO ji = 1, jpi  ! vector opt.
+               zcff              = MAX( rn_phimax, rn_Ric * mxl_abl( ji, jj, jk ) * mxl_abl( ji, jj, jk )  &
+                  &                                       * zbn2(ji, jj, jk) / tke_abl( ji, jj, jk, nt_a ) ) 
+               zcff2             =  1. / ( 1. + zcff )   !<-- phi_z(z)
+               zcff              = mxl_abl( ji, jj, jk ) * SQRT( tke_abl( ji, jj, jk, nt_a ) )
+!!FL: MAX function probably useless because of the definition of mxl_min             
+               Avm_abl( ji, jj, jk ) = MAX( rn_Cm * zcff         , avm_bak   )
+               Avt_abl( ji, jj, jk ) = MAX( rn_Ct * zcff * zcff2 , avt_bak   )                              
+            END DO
+         END DO
+      !-------------         
+      END DO      
+      !-------------
+
+!---------------------------------------------------------------------------------------------------
+   END SUBROUTINE abl_zdf_tke
+!===================================================================================================
+
+
+!===================================================================================================
+   SUBROUTINE smooth_pblh( pvar2d, msk )
+!---------------------------------------------------------------------------------------------------
+
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE smooth_pblh  ***
+      !!
+      !! ** Purpose :   2D Hanning filter on atmospheric PBL height
+      !!
+      !! ---------------------------------------------------------------------
+	  REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: msk   
+	  REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pvar2d
+      INTEGER                                     :: ji,jj
+	  REAL(wp)                                    :: smth_a, smth_b
+	  REAL(wp), DIMENSION(jpi,jpj)                :: zdX,zdY,zFX,zFY
+	  REAL(wp)                                    :: zumsk,zvmsk
+      !!
+      !!=========================================================
+      !!
+      !! Hanning filter
+      smth_a = 1._wp / 8._wp
+      smth_b = 1._wp / 4._wp
+      !
+      DO_2D_11_10
+         zumsk = msk(ji,jj) * msk(ji+1,jj)
+         zdX ( ji, jj ) = ( pvar2d( ji+1,jj ) - pvar2d( ji  ,jj ) ) * zumsk
+      END_2D
+      
+	  DO_2D_10_11
+         zvmsk = msk(ji,jj) * msk(ji,jj+1)
+         zdY ( ji, jj ) = ( pvar2d( ji, jj+1 ) - pvar2d( ji  ,jj ) ) * zvmsk
+	  END_2D
+      
+	  DO_2D_10_00
+         zFY ( ji, jj  ) =   zdY ( ji, jj   )                        &
+            & +  smth_a*  ( (zdX ( ji, jj+1 ) - zdX( ji-1, jj+1 ))   &
+            &            -  (zdX ( ji, jj   ) - zdX( ji-1, jj   ))  )
+	  END_2D
+
+      DO_2D_00_10
+         zFX( ji, jj  ) =    zdX( ji, jj   )                         &
+           &    + smth_a*(  (zdY( ji+1, jj ) - zdY( ji+1, jj-1))     &
+           &             -  (zdY( ji  , jj ) - zdY( ji  , jj-1)) )
+      END_2D
+
+      DO_2D_00_00
+         pvar2d( ji  ,jj ) = pvar2d( ji  ,jj )              &
+  &         + msk(ji,jj) * smth_b * (                       &
+  &                  zFX( ji, jj ) - zFX( ji-1, jj )        &
+  &                 +zFY( ji, jj ) - zFY( ji, jj-1 )  )
+      END_2D
+	  !!
+!---------------------------------------------------------------------------------------------------
+   END SUBROUTINE smooth_pblh
+!===================================================================================================
+
+!!======================================================================
+END MODULE ablmod
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ABL/ablrst.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ABL/ablrst.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ABL/ablrst.F90	(revision 12928)
@@ -0,0 +1,182 @@
+MODULE ablrst
+   !!======================================================================
+   !!                     ***  MODULE  ablrst  ***
+   !!       abl :  write/read the abl restart file
+   !!======================================================================
+   !! History:   4.0  !  2018     (some people)                         ABL
+   !!----------------------------------------------------------------------
+   !!   abl_rst_opn   : open  restart file
+   !!   abl_rst_write : write restart file 
+   !!   abl_rst_read  : read  restart file 
+   !!----------------------------------------------------------------------
+   USE abl            ! abl variables
+   USE par_abl        ! abl parameters
+   USE dom_oce        ! ocean domain
+   USE sbc_oce , ONLY : nn_fsbc, jpka
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O manager library
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   abl_rst_opn     ! called by ablstp
+   PUBLIC   abl_rst_write   ! called by ablstp
+   PUBLIC   abl_rst_read    ! called by abl_init
+
+   !!----------------------------------------------------------------------
+   !! NEMO/ABL 4.0 , NEMO Consortium (2018)
+   !! $Id: ablrst.F90 11413 2019-08-06 15:59:22Z gsamson $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE abl_rst_opn( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  abl_rst_opn  ***
+      !!
+      !! ** purpose  :   open restart file
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt       ! number of iteration
+      !
+      CHARACTER(len=20)   ::   clkt     ! ocean time-step define as a character
+      CHARACTER(len=50)   ::   clname   ! abl output restart file name
+      CHARACTER(len=256)  ::   clpath   ! full path to abl output restart file 
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 )   lrst_abl = .FALSE.   ! default definition
+
+      IF( ln_rst_list .OR. nn_stock /= -1 ) THEN
+      ! in order to get better performances with NetCDF format, we open and define the abl restart file 
+      ! one abl time step before writing the data (-> at nitrst - 2*nn_fsbc + 1), except if we write abl 
+      ! restart files every abl time step or if an abl restart file was writen at nitend - 2*nn_fsbc + 1
+      IF( kt == nitrst - 2*nn_fsbc + 1 .OR. nn_stock == nn_fsbc    &
+         &                             .OR. ( kt == nitend - nn_fsbc + 1 .AND. .NOT. lrst_abl ) ) THEN
+         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN
+            ! beware of the format used to write kt (default is i8.8, that should be large enough...)
+            IF( nitrst > 99999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
+            ELSE                           ;   WRITE(clkt, '(i8.8)') nitrst
+            ENDIF
+            ! create the file
+            clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_ablrst_out)
+            clpath = TRIM(cn_ablrst_outdir) 
+            IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath)//'/'
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) '             open abl restart NetCDF file: ',TRIM(clpath)//clname
+               IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN
+                  WRITE(numout,*) '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp
+               ELSE
+                  WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp
+               ENDIF
+            ENDIF
+            !
+            CALL iom_open( TRIM(clpath)//TRIM(clname), numraw, ldwrt = .TRUE., kdlev = jpka, cdcomp = 'ABL' )
+            lrst_abl = .TRUE.
+         ENDIF
+      ENDIF
+      ENDIF
+      !
+   END SUBROUTINE abl_rst_opn
+
+
+   SUBROUTINE abl_rst_write( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  abl_rst_write  ***
+      !!
+      !! ** purpose  :   write restart file
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt     ! number of iteration
+      !!
+      INTEGER ::   iter
+      !!----------------------------------------------------------------------
+
+      iter = kt + nn_fsbc - 1   ! abl restarts are written at kt == nitrst - nn_fsbc + 1
+
+      IF( iter == nitrst ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'abl_rst_write : write abl restart file  kt =', kt
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~'         
+      ENDIF
+
+      ! Write in numraw (if iter == nitrst)
+      ! ------------------ 
+      !                                                                        ! calendar control
+      CALL iom_rstput( iter, nitrst, numraw, 'nn_fsbc', REAL( nn_fsbc, wp ) )      ! time-step 
+      CALL iom_rstput( iter, nitrst, numraw, 'kt_abl' , REAL( iter   , wp ) )      ! date
+      CALL iom_delay_rst( 'WRITE', 'ABL', numraw )   ! save only abl delayed global communication variables
+
+      ! Prognostic variables
+      CALL iom_rstput( iter, nitrst, numraw,   'u_abl',   u_abl(:,:,:,nt_n      ) )
+      CALL iom_rstput( iter, nitrst, numraw,   'v_abl',   v_abl(:,:,:,nt_n      ) )
+      CALL iom_rstput( iter, nitrst, numraw,   't_abl',  tq_abl(:,:,:,nt_n,jp_ta) )
+      CALL iom_rstput( iter, nitrst, numraw,   'q_abl',  tq_abl(:,:,:,nt_n,jp_qa) )
+      CALL iom_rstput( iter, nitrst, numraw, 'tke_abl', tke_abl(:,:,:,nt_n      ) )
+      CALL iom_rstput( iter, nitrst, numraw, 'avm_abl', avm_abl(:,:,:           ) )
+      CALL iom_rstput( iter, nitrst, numraw, 'avt_abl', avt_abl(:,:,:           ) )
+      CALL iom_rstput( iter, nitrst, numraw, 'mxl_abl', mxl_abl(:,:,:           ) )
+      CALL iom_rstput( iter, nitrst, numraw,    'pblh',    pblh(:,:             ) )
+      !
+
+      ! close restart file
+      ! ------------------
+      IF( iter == nitrst ) THEN
+         CALL iom_close( numraw )
+         lrst_abl = .FALSE.
+      ENDIF
+      !
+   END SUBROUTINE abl_rst_write
+
+
+   SUBROUTINE abl_rst_read
+      !!----------------------------------------------------------------------
+      !!                    ***  abl_rst_read  ***
+      !!
+      !! ** purpose  :   read restart file
+      !!----------------------------------------------------------------------
+      REAL(wp)          ::   zfabl, ziter
+      !!----------------------------------------------------------------------
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'abl_rst_read: read abl NetCDF restart file'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+      ENDIF
+
+      CALL iom_open ( TRIM(cn_ablrst_indir)//'/'//cn_ablrst_in, numrar )
+
+      ! Time info
+      CALL iom_get( numrar, 'nn_fsbc', zfabl )
+      CALL iom_get( numrar, 'kt_abl' , ziter )    
+      IF(lwp) WRITE(numout,*) '   read abl restart file at time step    : ', ziter
+      IF(lwp) WRITE(numout,*) '   in any case we force it to nit000 - 1 : ', nit000 - 1
+
+      ! Control of date
+      IF( ( nit000 - NINT(ziter) ) /= 1 .AND. ABS( nrstdt ) == 1 )   &
+         &     CALL ctl_stop( 'abl_rst_read ===>>>> : problem with nit000 in abl restart',  &
+         &                   '   verify the file or rerun with the value 0 for the',        &
+         &                   '   control of time parameter  nrstdt' )
+      IF( NINT(zfabl) /= nn_fsbc          .AND. ABS( nrstdt ) == 1 )   &
+         &     CALL ctl_stop( 'abl_rst_read ===>>>> : problem with nn_fsbc in abl restart',  &
+         &                   '   verify the file or rerun with the value 0 for the',         &
+         &                   '   control of time parameter  nrstdt' )
+
+      ! --- mandatory fields --- ! 
+      CALL iom_get( numrar, jpdom_autoglo,   'u_abl',   u_abl(:,:,:,nt_n      ) )
+      CALL iom_get( numrar, jpdom_autoglo,   'v_abl',   v_abl(:,:,:,nt_n      ) )
+      CALL iom_get( numrar, jpdom_autoglo,   't_abl',  tq_abl(:,:,:,nt_n,jp_ta) )
+      CALL iom_get( numrar, jpdom_autoglo,   'q_abl',  tq_abl(:,:,:,nt_n,jp_qa) )
+      CALL iom_get( numrar, jpdom_autoglo, 'tke_abl', tke_abl(:,:,:,nt_n      ) )
+      CALL iom_get( numrar, jpdom_autoglo, 'avm_abl', avm_abl(:,:,:           ) )
+      CALL iom_get( numrar, jpdom_autoglo, 'avt_abl', avt_abl(:,:,:           ) )
+      CALL iom_get( numrar, jpdom_autoglo, 'mxl_abl', mxl_abl(:,:,:           ) )
+      CALL iom_get( numrar, jpdom_autoglo,    'pblh',    pblh(:,:             ) )
+      CALL iom_delay_rst( 'READ', 'ABL', numrar )   ! read only abl delayed global communication variables
+
+   END SUBROUTINE abl_rst_read
+
+
+   !!======================================================================
+END MODULE ablrst
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ABL/par_abl.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ABL/par_abl.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ABL/par_abl.F90	(revision 12928)
@@ -0,0 +1,100 @@
+MODULE par_abl
+   !!======================================================================
+   !!                        ***  par_abl  ***
+   !! ABL :   set the Atmospheric Boundary Layer parameters
+   !!======================================================================
+   !! History :  4.0  !  2019-03  (F. Lemarié & G. Samson)  Original code
+   !!----------------------------------------------------------------------
+   USE par_kind          ! kind parameters
+   USE par_oce           ! to access horizontal domain size & mpp decomposition
+
+   IMPLICIT NONE
+   PUBLIC
+
+   !!---------------------------------------------------------------------
+   !! Active tracer parameters
+   !!---------------------------------------------------------------------
+   INTEGER , PUBLIC, PARAMETER ::   jptq   = 2     !: Number of active tracers (=2, i.e. T & q )
+   INTEGER , PUBLIC, PARAMETER ::   jp_ta  = 1     !: indice for temperature
+   INTEGER , PUBLIC, PARAMETER ::   jp_qa  = 2     !: indice for humidity
+   INTEGER , PUBLIC, PARAMETER ::   jptime = 2     !: number of time indices stored in memory
+
+   !!---------------------------------------------------------------------
+   !! namABL Namelist options  
+   !!---------------------------------------------------------------------   
+   INTEGER , PUBLIC            ::   nn_amxl        !: mixing length option 
+   INTEGER , PUBLIC            ::   nn_dyn_restore !: restoring option for dynamical ABL variables
+   LOGICAL , PUBLIC            ::   ln_geos_winds  !: large-scale restoring of ABL winds toward geostrophic winds
+   LOGICAL , PUBLIC            ::   ln_hpgls_frc   !: forcing of ABL winds by large-scale pressure gradient 
+   LOGICAL , PUBLIC            ::   ln_smth_pblh   !: smoothing of atmospheric PBL height 
+
+   LOGICAL           , PUBLIC ::   ln_rstart_abl    !: (de)activate abl restart
+   CHARACTER(len=256), PUBLIC ::   cn_ablrst_in     !: suffix of abl restart name (input)
+   CHARACTER(len=256), PUBLIC ::   cn_ablrst_out    !: suffix of abl restart name (output)
+   CHARACTER(len=256), PUBLIC ::   cn_ablrst_indir  !: abl restart input directory
+   CHARACTER(len=256), PUBLIC ::   cn_ablrst_outdir !: abl restart output directory
+
+   !!---------------------------------------------------------------------
+   !! ABL parameters for TKE turbulent closure
+   !!---------------------------------------------------------------------
+   REAL(wp), PUBLIC, PARAMETER ::   tke_min   = 1.e-6_wp          !: minimum TKE
+   REAL(wp), PUBLIC, PARAMETER ::   avm_bak   = 1.e-4_wp          !: background viscosity
+   REAL(wp), PUBLIC, PARAMETER ::   avt_bak   = 1.e-5_wp          !: background diffusion
+   REAL(wp), PUBLIC, PARAMETER ::   itvref    = 1.0_wp / 288.0_wp !: inverse of reference virtual temperature     
+   !++ TKE closure parameters
+   REAL(wp), PUBLIC, PARAMETER ::   rn_phimax = (1._wp - 2.2_wp) / 2.2_wp !: maximum value for Ri * mxl^2 * N^2 / tke in phiz computation
+   REAL(wp), PUBLIC, PARAMETER ::   rn_Cek    = 258._wp                   !: Ekman constant for Richardson number 
+   REAL(wp), PUBLIC, PARAMETER ::   rn_epssfc = 1._wp / ( 1._wp + 2.8_wp * 2.8_wp )
+   REAL(wp), PUBLIC            ::   rn_ceps                       !: namelist parameter
+   REAL(wp), PUBLIC            ::   rn_cm                         !: namelist parameter
+   REAL(wp), PUBLIC            ::   rn_ct                         !: namelist parameter
+   REAL(wp), PUBLIC            ::   rn_ce                         !: namelist parameter 
+   REAL(wp), PUBLIC            ::   rn_Rod                        !: namelist parameter   
+   REAL(wp), PUBLIC            ::   rn_Sch    
+   REAL(wp), PUBLIC            ::   mxl_min    
+   REAL(wp), PUBLIC            ::   rn_ldyn_min                   !: namelist parameter
+   REAL(wp), PUBLIC            ::   rn_ldyn_max                   !: namelist parameter  
+   REAL(wp), PUBLIC            ::   rn_ltra_min                   !: namelist parameter
+   REAL(wp), PUBLIC            ::   rn_ltra_max                   !: namelist parameter
+   REAL(wp), PUBLIC            ::   rn_Ric                        !: critical Richardson number 
+
+   !!---------------------------------------------------------------------
+   !! ABL parameters for the vertical profile of the restoring term 
+   !!---------------------------------------------------------------------
+   REAL(wp), PUBLIC, PARAMETER ::   jp_bmin    =   0.5_wp 
+   REAL(wp), PUBLIC, PARAMETER ::   jp_bmax    =   1.5_wp
+   REAL(wp), PUBLIC            ::   jp_alp0_tra
+   REAL(wp), PUBLIC            ::   jp_alp1_tra   
+   REAL(wp), PUBLIC            ::   jp_alp2_tra   
+   REAL(wp), PUBLIC            ::   jp_alp3_tra   
+   REAL(wp), PUBLIC            ::   jp_alp0_dyn
+   REAL(wp), PUBLIC            ::   jp_alp1_dyn   
+   REAL(wp), PUBLIC            ::   jp_alp2_dyn   
+   REAL(wp), PUBLIC            ::   jp_alp3_dyn  
+   REAL(wp), PUBLIC            ::   jp_pblh_min
+   REAL(wp), PUBLIC            ::   jp_pblh_max      
+   ! parameter for the semi-implicit treatment of Coriolis term  
+   REAL(wp), PUBLIC, PARAMETER ::   gamma_Cor  = 0.55_wp
+   ! ABL timestep
+   REAL(wp), PUBLIC            :: rDt_abl
+
+   !!---------------------------------------------------------------------
+   !! ABL parameters for the diagnostic mixing length option nn_amxl = 1 
+   !!---------------------------------------------------------------------   
+   REAL(wp), PUBLIC, PARAMETER ::   amx1 =    4.3995604393911742_wp
+   REAL(wp), PUBLIC, PARAMETER ::   amx2 =  -18.159100102732943_wp
+   REAL(wp), PUBLIC, PARAMETER ::   amx3 =   40.241226956967239_wp
+   REAL(wp), PUBLIC, PARAMETER ::   amx4 =  -43.603409583363678_wp
+   REAL(wp), PUBLIC, PARAMETER ::   amx5 =   17.121715347554314_wp
+   REAL(wp), PUBLIC, PARAMETER ::   bmx1 =  -16.262675447730114_wp
+   REAL(wp), PUBLIC, PARAMETER ::   bmx2 =   85.088728134110781_wp
+   REAL(wp), PUBLIC, PARAMETER ::   bmx3 = -193.46548261141191_wp
+   REAL(wp), PUBLIC, PARAMETER ::   bmx4 =  196.71548261141191_wp
+   REAL(wp), PUBLIC, PARAMETER ::   bmx5 =  -72.076052686380677_wp 
+
+   !!----------------------------------------------------------------------
+   !! NEMO/ABL 4.0 , NEMO Consortium (2018)
+   !! $Id: sbc_oce.F90 10882 2019-04-17 15:40:17Z clem $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!======================================================================
+END MODULE par_abl
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ABL/sbcabl.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ABL/sbcabl.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ABL/sbcabl.F90	(revision 12928)
@@ -0,0 +1,386 @@
+MODULE sbcabl
+   !!======================================================================
+   !!                       ***  MODULE  sbcabl  ***
+   !! Ocean forcing:  momentum, heat and freshwater flux formulation
+   !!                 derived from an ABL model
+   !!=====================================================================
+   !! History :  4.0  !  2019-03  (F. Lemarié & G. Samson)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   sbc_abl_init  : Initialization of ABL model based on namelist options
+   !!   sbc_abl       : driver for the computation of momentum, heat and freshwater
+   !!                   fluxes over ocean via the ABL model
+   !!----------------------------------------------------------------------
+   USE abl            ! ABL
+   USE par_abl        ! abl parameters
+   USE ablmod
+   USE ablrst
+
+   USE phycst         ! physical constants
+   USE fldread        ! read input fields
+   USE sbc_oce        ! Surface boundary condition: ocean fields
+   USE sbcblk         ! Surface boundary condition: bulk formulae
+   USE sbcblk_phy     ! Surface boundary condition: bulk formulae
+   USE dom_oce, ONLY  : tmask
+   !
+   USE iom            ! I/O manager library
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! distribued memory computing library
+   USE lib_fortran    ! to use key_nosignedzero
+   USE timing         ! Timing
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE prtctl         ! Print control
+#if defined key_si3
+   USE ice    , ONLY : u_ice, v_ice, tm_su, ato_i      ! ato_i = total open water fractional area
+   USE sbc_ice, ONLY : wndm_ice, utau_ice, vtau_ice
+#endif
+#if ! defined key_iomput
+   USE diawri    , ONLY : dia_wri_alloc_abl
+#endif
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sbc_abl_init       ! routine called in sbcmod module
+   PUBLIC   sbc_abl            ! routine called in sbcmod module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO-consortium (2014)
+   !! $Id: sbcabl.F90 6416 2016-04-01 12:22:17Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE sbc_abl_init
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE sbc_abl_init  ***
+      !!
+      !! ** Purposes :   - read namelist section namsbc_abl
+      !!                 - initialize and check parameter values
+      !!                 - initialize variables of ABL model
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER            ::   ji, jj, jk, jbak, jbak_dta       ! dummy loop indices
+      INTEGER            ::   ios, ierror, ioptio              ! Local integer
+      INTEGER            ::   inum, indims, idimsz(4), id
+      CHARACTER(len=100) ::   cn_dir, cn_dom                   ! Atmospheric grid directory
+      REAL(wp)           ::   zcff,zcff1
+      LOGICAL            ::   lluldl
+      NAMELIST/namsbc_abl/ cn_dir, cn_dom, cn_ablrst_in, cn_ablrst_out,           &
+         &                 cn_ablrst_indir, cn_ablrst_outdir, ln_rstart_abl,      &
+         &                 ln_hpgls_frc, ln_geos_winds, nn_dyn_restore,           &
+         &                 rn_ldyn_min , rn_ldyn_max, rn_ltra_min, rn_ltra_max,   &
+         &                 nn_amxl, rn_cm, rn_ct, rn_ce, rn_ceps, rn_Rod, rn_Ric, &
+         &                 ln_smth_pblh
+      !!---------------------------------------------------------------------
+
+      ! Namelist namsbc_abl in reference namelist : ABL parameters
+      READ  ( numnam_ref, namsbc_abl, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_abl in reference namelist' )
+      ! Namelist namsbc_abl in configuration namelist : ABL parameters
+      READ  ( numnam_cfg, namsbc_abl, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_abl in configuration namelist' )
+      !
+      IF(lwm) WRITE( numond, namsbc_abl )
+      !
+      ! Check ABL mixing length option
+      IF( nn_amxl  < 0   .OR.  nn_amxl  > 2 )   &
+         &                 CALL ctl_stop( 'abl_init : bad flag, nn_amxl must be  0, 1 or 2 ' )
+      !
+      ! Check ABL dyn restore option
+      IF( nn_dyn_restore  < 0   .OR.  nn_dyn_restore  > 2 )   &
+         &                 CALL ctl_stop( 'abl_init : bad flag, nn_dyn_restore must be  0, 1 or 2 ' )
+
+      !!---------------------------------------------------------------------
+      !! Control prints
+      !!---------------------------------------------------------------------
+      IF(lwp) THEN                              ! Control print (other namelist variable)
+         WRITE(numout,*)
+         WRITE(numout,*) '      ABL -- cn_dir         = ', cn_dir
+         WRITE(numout,*) '      ABL -- cn_dom         = ', cn_dom
+         IF( ln_hpgls_frc ) THEN
+            WRITE(numout,*) '      ABL -- winds forced by large-scale pressure gradient'
+            IF(ln_geos_winds) THEN
+               ln_geos_winds = .FALSE.
+               WRITE(numout,*) '      ABL -- geostrophic guide disabled (not compatible with ln_hpgls_frc = .T.)'
+            END IF
+         ELSE IF( ln_geos_winds ) THEN
+            WRITE(numout,*) '      ABL -- winds forced by geostrophic winds'
+         ELSE
+            WRITE(numout,*) '      ABL -- Geostrophic winds and large-scale pressure gradient are ignored'
+         END IF
+         !
+         SELECT CASE ( nn_dyn_restore )
+         CASE ( 0 )
+            WRITE(numout,*) '      ABL -- No restoring for ABL winds'
+         CASE ( 1 )
+            WRITE(numout,*) '      ABL -- Restoring of ABL winds only in the equatorial region '
+         CASE ( 2 )
+            WRITE(numout,*) '      ABL -- Restoring of ABL winds activated everywhere '
+         END SELECT
+         !
+         IF( ln_smth_pblh )  WRITE(numout,*) '      ABL -- Smoothing of PBL height is activated'
+         !
+      ENDIF
+
+      !!---------------------------------------------------------------------
+      !! Convert nudging coefficient from hours to 1/sec
+      !!---------------------------------------------------------------------
+      zcff        = 1._wp / 3600._wp
+      rn_ldyn_min = zcff / rn_ldyn_min
+      rn_ldyn_max = zcff / rn_ldyn_max
+      rn_ltra_min = zcff / rn_ltra_min
+      rn_ltra_max = zcff / rn_ltra_max
+
+      !!---------------------------------------------------------------------
+      !! ABL grid initialization
+      !!---------------------------------------------------------------------
+      CALL iom_open( TRIM(cn_dir)//TRIM(cn_dom), inum )
+      id     = iom_varid( inum, 'e3t_abl', kdimsz=idimsz, kndims=indims, lduld=lluldl )
+      jpka   = idimsz(indims - COUNT( (/lluldl/) ) )
+      jpkam1 = jpka - 1
+
+      IF( abl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'abl_init : unable to allocate arrays' )
+      CALL iom_get( inum, jpdom_unknown, 'e3t_abl', e3t_abl(:) )
+      CALL iom_get( inum, jpdom_unknown, 'e3w_abl', e3w_abl(:) )
+      CALL iom_get( inum, jpdom_unknown, 'ght_abl', ght_abl(:) )
+      CALL iom_get( inum, jpdom_unknown, 'ghw_abl', ghw_abl(:) )
+      CALL iom_close( inum )
+
+#if ! defined key_iomput
+      IF( dia_wri_alloc_abl()  /= 0 ) CALL ctl_stop( 'STOP', 'abl_init : unable to allocate arrays' )
+#endif
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '    sbc_abl_init   : ABL Reference vertical grid'
+         WRITE(numout,*) '    ~~~~~~~'
+         WRITE(numout, "(9x,'  level ght_abl   ghw_abl   e3t_abl   e3w_abl  ')" )
+         WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, ght_abl(jk), ghw_abl(jk), e3t_abl(jk), e3w_abl(jk), jk = 1, jpka )
+      END IF
+
+      !!---------------------------------------------------------------------
+      !! Check TKE closure parameters
+      !!---------------------------------------------------------------------
+      rn_Sch  = rn_ce / rn_cm
+      mxl_min = (avm_bak / rn_cm) / sqrt( tke_min )
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '    abl_zdf_tke   : ABL TKE turbulent closure'
+         WRITE(numout,*) '    ~~~~~~~~~~~'
+         IF(nn_amxl==0) WRITE(numout,*) 'Deardorff 80 length-scale '
+         IF(nn_amxl==1) WRITE(numout,*) 'length-scale based on the distance to the PBL height '
+         WRITE(numout,*) ' Minimum value of atmospheric TKE           = ',tke_min,' m^2 s^-2'
+         WRITE(numout,*) ' Minimum value of atmospheric mixing length = ',mxl_min,' m'
+         WRITE(numout,*) ' Constant for turbulent viscosity           = ',rn_Cm
+         WRITE(numout,*) ' Constant for turbulent diffusivity         = ',rn_Ct
+         WRITE(numout,*) ' Constant for Schmidt number                = ',rn_Sch
+         WRITE(numout,*) ' Constant for TKE dissipation               = ',rn_Ceps
+      END IF
+
+      !!-------------------------------------------------------------------------------------------
+      !! Compute parameters to build the vertical profile for the nudging term (used in abl_stp())
+      !!-------------------------------------------------------------------------------------------
+      zcff1       = 1._wp / ( jp_bmax - jp_bmin )**3
+      ! for active tracers
+      jp_alp3_tra = -2._wp * zcff1                       * ( rn_ltra_max - rn_ltra_min )
+      jp_alp2_tra =  3._wp * zcff1 * (jp_bmax + jp_bmin) * ( rn_ltra_max - rn_ltra_min )
+      jp_alp1_tra = -6._wp * zcff1 *  jp_bmax * jp_bmin  * ( rn_ltra_max - rn_ltra_min )
+      jp_alp0_tra = zcff1 * (  rn_ltra_max * jp_bmin*jp_bmin * (3._wp*jp_bmax - jp_bmin)      &
+         &                   - rn_ltra_min * jp_bmax*jp_bmax * (3._wp*jp_bmin - jp_bmax) )
+      ! for dynamics
+      jp_alp3_dyn = -2._wp * zcff1                       * ( rn_ldyn_max - rn_ldyn_min )
+      jp_alp2_dyn =  3._wp * zcff1 * (jp_bmax + jp_bmin) * ( rn_ldyn_max - rn_ldyn_min )
+      jp_alp1_dyn = -6._wp * zcff1 *  jp_bmax * jp_bmin  * ( rn_ldyn_max - rn_ldyn_min )
+      jp_alp0_dyn = zcff1 * (  rn_ldyn_max * jp_bmin*jp_bmin * (3._wp*jp_bmax - jp_bmin)      &
+         &                   - rn_ldyn_min * jp_bmax*jp_bmax * (3._wp*jp_bmin - jp_bmax) )
+
+      jp_pblh_min = ghw_abl(     4) / jp_bmin  !<-- at least 3 grid points at the bottom have value rn_ltra_min
+      jp_pblh_max = ghw_abl(jpka-3) / jp_bmax  !<-- at least 3 grid points at the top    have value rn_ltra_max
+
+      ! ABL timestep
+      rDt_abl = nn_fsbc * rn_Dt
+
+      ! Check parameters for dynamics
+      zcff  = ( jp_alp3_dyn * jp_bmin**3 + jp_alp2_dyn * jp_bmin**2   &
+         &    + jp_alp1_dyn * jp_bmin    + jp_alp0_dyn ) * rDt_abl
+      zcff1 = ( jp_alp3_dyn * jp_bmax**3 + jp_alp2_dyn * jp_bmax**2   &
+         &    + jp_alp1_dyn * jp_bmax    + jp_alp0_dyn ) * rDt_abl
+      IF(lwp) THEN
+         IF(nn_dyn_restore > 0) THEN
+            WRITE(numout,*) ' ABL Minimum value for dynamics restoring = ',zcff
+            WRITE(numout,*) ' ABL Maximum value for dynamics restoring = ',zcff1
+            ! Check that restoring coefficients are between 0 and 1
+            IF( zcff1 - nn_fsbc > 0.001_wp .OR. zcff1 < 0._wp )   &
+               &                   CALL ctl_stop( 'abl_init : wrong value for rn_ldyn_max' )
+            IF( zcff  - nn_fsbc > 0.001_wp .OR. zcff  < 0._wp )   &
+               &                   CALL ctl_stop( 'abl_init : wrong value for rn_ldyn_min' )
+            IF( zcff  > zcff1                    )   &
+               &                   CALL ctl_stop( 'abl_init : rn_ldyn_max must be smaller than rn_ldyn_min' )
+         END IF
+      END IF
+
+      ! Check parameters for active tracers
+      zcff  = ( jp_alp3_tra * jp_bmin**3 + jp_alp2_tra * jp_bmin**2   &
+         &    + jp_alp1_tra * jp_bmin    + jp_alp0_tra ) * rDt_abl
+      zcff1 = ( jp_alp3_tra * jp_bmax**3 + jp_alp2_tra * jp_bmax**2   &
+         &    + jp_alp1_tra * jp_bmax    + jp_alp0_tra ) * rDt_abl
+      IF(lwp) THEN
+         WRITE(numout,*) ' ABL Minimum value for tracers restoring = ',zcff
+         WRITE(numout,*) ' ABL Maximum value for tracers restoring = ',zcff1
+         ! Check that restoring coefficients are between 0 and 1
+         IF( zcff1 - nn_fsbc > 0.001_wp .OR. zcff1 < 0._wp )   &
+            &                   CALL ctl_stop( 'abl_init : wrong value for rn_ltra_max' )
+         IF( zcff  - nn_fsbc > 0.001_wp .OR. zcff  < 0._wp )   &
+            &                   CALL ctl_stop( 'abl_init : wrong value for rn_ltra_min' )
+         IF( zcff  > zcff1                    )   &
+            &                   CALL ctl_stop( 'abl_init : rn_ltra_max must be smaller than rn_ltra_min' )
+      END IF
+
+      !!-------------------------------------------------------------------------------------------
+      !! Initialize Coriolis frequency, equatorial restoring and land/sea mask
+      !!-------------------------------------------------------------------------------------------
+      fft_abl(:,:) = 2._wp * omega * SIN( rad * gphit(:,:) )
+
+      ! Equatorial restoring
+      IF( nn_dyn_restore == 1 ) THEN
+         zcff         = 2._wp * omega * SIN( rad * 90._wp )   !++ fmax
+         rest_eq(:,:) = SIN( 0.5_wp*rpi*( (fft_abl(:,:) - zcff) / zcff ) )**8
+         !!GS: alternative shape
+         !rest_eq(:,:) = SIN( 0.5_wp*rpi*(zcff - ABS(ff_t(:,:))) / (zcff - 3.e-5) )**8
+         !WHERE(ABS(ff_t(:,:)).LE.3.e-5) rest_eq(:,:) = 1._wp
+      ELSE
+         rest_eq(:,:) = 1._wp
+      END IF
+      ! T-mask
+      msk_abl(:,:) = tmask(:,:,1)
+
+      !!-------------------------------------------------------------------------------------------
+
+      ! initialize 2D bulk fields AND 3D abl data
+      CALL sbc_blk_init
+
+      ! Initialize the time index for now time (nt_n) and after time (nt_a)
+      nt_n = 1; nt_a = 2
+
+      ! initialize ABL from data or restart
+      IF( ln_rstart_abl ) THEN
+         CALL abl_rst_read
+      ELSE
+         CALL fld_read( nit000, nn_fsbc, sf ) ! input fields provided at the first time-step
+
+         u_abl(:,:,:,nt_n      ) = sf(jp_wndi)%fnow(:,:,:)
+         v_abl(:,:,:,nt_n      ) = sf(jp_wndj)%fnow(:,:,:)
+         tq_abl(:,:,:,nt_n,jp_ta) = sf(jp_tair)%fnow(:,:,:)
+         tq_abl(:,:,:,nt_n,jp_qa) = sf(jp_humi)%fnow(:,:,:)
+
+         tke_abl(:,:,:,nt_n     ) = tke_min
+         avm_abl(:,:,:          ) = avm_bak
+         avt_abl(:,:,:          ) = avt_bak
+         mxl_abl(:,:,:          ) = mxl_min
+         pblh   (:,:            ) = ghw_abl( 3 )  !<-- assume that the pbl contains 3 grid points
+         u_abl  (:,:,:,nt_a     ) = 0._wp
+         v_abl  (:,:,:,nt_a     ) = 0._wp
+         tq_abl (:,:,:,nt_a,:   ) = 0._wp
+         tke_abl(:,:,:,nt_a     ) = 0._wp
+      ENDIF
+
+   END SUBROUTINE sbc_abl_init
+
+
+   SUBROUTINE sbc_abl( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE sbc_abl  ***
+      !!
+      !! ** Purpose :   provide the momentum, heat and freshwater fluxes at
+      !!      the ocean surface from an ABL calculation at each oceanic time step
+      !!
+      !! ** Method  :
+      !!              - Pre-compute part of turbulent fluxes in blk_oce_1
+      !!              - Perform 1 time-step of the ABL model
+      !!              - Finalize flux computation in blk_oce_2
+      !!
+      !! ** Outputs : - utau    : i-component of the stress at U-point  (N/m2)
+      !!              - vtau    : j-component of the stress at V-point  (N/m2)
+      !!              - taum    : Wind stress module at T-point         (N/m2)
+      !!              - wndm    : Wind speed module at T-point          (m/s)
+      !!              - qsr     : Solar heat flux over the ocean        (W/m2)
+      !!              - qns     : Non Solar heat flux over the ocean    (W/m2)
+      !!              - emp     : evaporation minus precipitation       (kg/m2/s)
+      !!
+      !!---------------------------------------------------------------------
+      INTEGER ,         INTENT(in) ::   kt   ! ocean time step
+      !!
+      REAL(wp), DIMENSION(jpi,jpj) ::   zssq, zcd_du, zsen, zevp
+#if defined key_si3
+      REAL(wp), DIMENSION(jpi,jpj) ::   zssqi, zcd_dui, zseni, zevpi
+#endif
+      INTEGER                      ::   jbak, jbak_dta, ji, jj
+      !!---------------------------------------------------------------------
+      !
+      !!-------------------------------------------------------------------------------------------
+      !! 1 - Read Atmospheric 3D data for large-scale forcing
+      !!-------------------------------------------------------------------------------------------
+
+      CALL fld_read( kt, nn_fsbc, sf )             ! input fields provided at the current time-step
+
+      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN
+
+         !!-------------------------------------------------------------------------------------------
+         !! 2 - Compute Cd x ||U||, Ch x ||U||, Ce x ||U||, and SSQ using now fields
+         !!-------------------------------------------------------------------------------------------
+
+         CALL blk_oce_1( kt,  u_abl(:,:,2,nt_n      ),  v_abl(:,:,2,nt_n      ),   &   !   <<= in
+            &                tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa),   &   !   <<= in
+            &                sf(jp_slp )%fnow(:,:,1) , sst_m, ssu_m, ssv_m     ,   &   !   <<= in
+            &                sf(jp_qsr )%fnow(:,:,1) , sf(jp_qlw )%fnow(:,:,1) ,   &   !   <<= in
+            &                tsk_m, zssq, zcd_du, zsen, zevp                       )   !   =>> out
+
+#if defined key_si3
+         CALL blk_ice_1(  u_abl(:,:,2,nt_n      ),  v_abl(:,:,2,nt_n      ),    &   !   <<= in
+            &            tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa),    &   !   <<= in
+            &            sf(jp_slp)%fnow(:,:,1)  ,  u_ice, v_ice, tm_su    ,    &   !   <<= in
+            &            pseni=zseni, pevpi=zevpi, pssqi=zssqi, pcd_dui=zcd_dui )   !   <<= out
+#endif
+
+         !!-------------------------------------------------------------------------------------------
+         !! 3 - Advance ABL variables from now (n) to after (n+1)
+         !!-------------------------------------------------------------------------------------------
+   
+         CALL abl_stp( kt, tsk_m, ssu_m, ssv_m, zssq,                          &   !   <<= in
+            &              sf(jp_wndi)%fnow(:,:,:), sf(jp_wndj)%fnow(:,:,:),   &   !   <<= in
+            &              sf(jp_tair)%fnow(:,:,:), sf(jp_humi)%fnow(:,:,:),   &   !   <<= in
+            &              sf(jp_slp )%fnow(:,:,1),                            &   !   <<= in
+            &              sf(jp_hpgi)%fnow(:,:,:), sf(jp_hpgj)%fnow(:,:,:),   &   !   <<= in
+            &              zcd_du, zsen, zevp,                                 &   !   <=> in/out
+            &              wndm, utau, vtau, taum                              &   !   =>> out
+#if defined key_si3
+            &            , tm_su, u_ice, v_ice, zssqi, zcd_dui                 &   !   <<= in
+            &            , zseni, zevpi, wndm_ice, ato_i                       &   !   <<= in
+            &            , utau_ice, vtau_ice                                  &   !   =>> out
+#endif
+            &                                                                  )
+         !!-------------------------------------------------------------------------------------------
+         !! 4 - Finalize flux computation using ABL variables at (n+1), nt_n corresponds to (n+1) since
+         !!                                                                time swap is done in abl_stp
+         !!-------------------------------------------------------------------------------------------
+
+         CALL blk_oce_2( tq_abl(:,:,2,nt_n,jp_ta),                            &
+            &            sf(jp_qsr )%fnow(:,:,1) , sf(jp_qlw )%fnow(:,:,1),   &
+            &            sf(jp_prec)%fnow(:,:,1) , sf(jp_snow)%fnow(:,:,1),   &
+            &            tsk_m, zsen, zevp                                )
+   
+         CALL abl_rst_opn( kt )                       ! Open abl restart file (if necessary)
+         IF( lrst_abl ) CALL abl_rst_write( kt )      ! -- abl restart file
+
+#if defined key_si3
+         ! Avoid a USE abl in icesbc module
+         sf(jp_tair)%fnow(:,:,1) = tq_abl(:,:,2,nt_n,jp_ta);  sf(jp_humi)%fnow(:,:,1) = tq_abl(:,:,2,nt_n,jp_qa)
+#endif
+      END IF
+
+   END SUBROUTINE sbc_abl
+
+   !!======================================================================
+END MODULE sbcabl
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/ice.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/ice.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/ice.F90	(revision 12928)
@@ -150,5 +150,5 @@
    REAL(wp), PUBLIC ::   rn_ecc           !: eccentricity of the elliptical yield curve
    INTEGER , PUBLIC ::   nn_nevp          !: number of iterations for subcycling
-   REAL(wp), PUBLIC ::   rn_relast        !: ratio => telast/rdt_ice (1/3 or 1/9 depending on nb of subcycling nevp) 
+   REAL(wp), PUBLIC ::   rn_relast        !: ratio => telast/rDt_ice (1/3 or 1/9 depending on nb of subcycling nevp) 
    !
    !                                     !!** ice-advection namelist (namdyn_adv) **
@@ -207,6 +207,6 @@
    !                                     !!** some other parameters 
    INTEGER , PUBLIC ::   kt_ice           !: iteration number
-   REAL(wp), PUBLIC ::   rdt_ice          !: ice time step
-   REAL(wp), PUBLIC ::   r1_rdtice        !: = 1. / rdt_ice
+   REAL(wp), PUBLIC ::   rDt_ice          !: ice time step
+   REAL(wp), PUBLIC ::   r1_Dt_ice        !: = 1. / rDt_ice
    REAL(wp), PUBLIC ::   r1_nlay_i        !: 1 / nlay_i
    REAL(wp), PUBLIC ::   r1_nlay_s        !: 1 / nlay_s 
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icealb.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icealb.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icealb.F90	(revision 12928)
@@ -38,4 +38,6 @@
    REAL(wp) ::   rn_alb_dpnd      ! ponded ice albedo
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/ICE 4.0 , NEMO Consortium (2018)
@@ -117,56 +119,54 @@
       !
       DO jl = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               !                       !--- Specific snow, ice and pond fractions (for now, we prevent melt ponds and snow at the same time)
-               IF( ph_snw(ji,jj,jl) == 0._wp ) THEN
-                  zafrac_snw = 0._wp
-                  IF( ld_pnd_alb ) THEN
-                     zafrac_pnd = pafrac_pnd(ji,jj,jl)
-                  ELSE
-                     zafrac_pnd = 0._wp
-                  ENDIF
-                  zafrac_ice = 1._wp - zafrac_pnd
+         DO_2D_11_11
+            !                       !--- Specific snow, ice and pond fractions (for now, we prevent melt ponds and snow at the same time)
+            IF( ph_snw(ji,jj,jl) == 0._wp ) THEN
+               zafrac_snw = 0._wp
+               IF( ld_pnd_alb ) THEN
+                  zafrac_pnd = pafrac_pnd(ji,jj,jl)
                ELSE
-                  zafrac_snw = 1._wp      ! Snow fully "shades" melt ponds and ice
                   zafrac_pnd = 0._wp
-                  zafrac_ice = 0._wp
                ENDIF
-               !
-               !                       !--- Bare ice albedo (for hi > 150cm)
-               IF( ld_pnd_alb ) THEN
-                  zalb_ice = rn_alb_idry
-               ELSE
-                  IF( ph_snw(ji,jj,jl) == 0._wp .AND. pt_su(ji,jj,jl) >= rt0 ) THEN  ;   zalb_ice = rn_alb_imlt
-                  ELSE                                                               ;   zalb_ice = rn_alb_idry   ;   ENDIF
-               ENDIF
-               !                       !--- Bare ice albedo (for hi < 150cm)
-               IF( 0.05 < ph_ice(ji,jj,jl) .AND. ph_ice(ji,jj,jl) <= 1.5 ) THEN      ! 5cm < hi < 150cm
-                  zalb_ice = zalb_ice    + ( 0.18 - zalb_ice   ) * z1_c1 * ( LOG(1.5) - LOG(ph_ice(ji,jj,jl)) )
-               ELSEIF( ph_ice(ji,jj,jl) <= 0.05 ) THEN                               ! 0cm < hi < 5cm
-                  zalb_ice = rn_alb_oce  + ( 0.18 - rn_alb_oce ) * z1_c2 * ph_ice(ji,jj,jl)
-               ENDIF
-               !
-               !                       !--- Snow-covered ice albedo (freezing, melting cases)
-               IF( pt_su(ji,jj,jl) < rt0 ) THEN
-                  zalb_snw = rn_alb_sdry - ( rn_alb_sdry - zalb_ice ) * EXP( - ph_snw(ji,jj,jl) * z1_c3 )
-               ELSE
-                  zalb_snw = rn_alb_smlt - ( rn_alb_smlt - zalb_ice ) * EXP( - ph_snw(ji,jj,jl) * z1_c4 )
-               ENDIF
-               !                       !--- Ponded ice albedo
-               IF( ld_pnd_alb ) THEN
-                  zalb_pnd = rn_alb_dpnd - ( rn_alb_dpnd - zalb_ice ) * EXP( - ph_pnd(ji,jj,jl) * z1_href_pnd ) 
-               ELSE
-                  zalb_pnd = rn_alb_dpnd
-               ENDIF
-               !                       !--- Surface albedo is weighted mean of snow, ponds and bare ice contributions
-               palb_os(ji,jj,jl) = ( zafrac_snw * zalb_snw + zafrac_pnd * zalb_pnd + zafrac_ice * zalb_ice ) * tmask(ji,jj,1)
-               !
-               palb_cs(ji,jj,jl) = palb_os(ji,jj,jl)  &
-                  &                - ( - 0.1010 * palb_os(ji,jj,jl) * palb_os(ji,jj,jl)  &
-                  &                    + 0.1933 * palb_os(ji,jj,jl) - 0.0148 ) * tmask(ji,jj,1)
-               !
-            END DO
-         END DO
+               zafrac_ice = 1._wp - zafrac_pnd
+            ELSE
+               zafrac_snw = 1._wp      ! Snow fully "shades" melt ponds and ice
+               zafrac_pnd = 0._wp
+               zafrac_ice = 0._wp
+            ENDIF
+            !
+            !                       !--- Bare ice albedo (for hi > 150cm)
+            IF( ld_pnd_alb ) THEN
+               zalb_ice = rn_alb_idry
+            ELSE
+               IF( ph_snw(ji,jj,jl) == 0._wp .AND. pt_su(ji,jj,jl) >= rt0 ) THEN  ;   zalb_ice = rn_alb_imlt
+               ELSE                                                               ;   zalb_ice = rn_alb_idry   ;   ENDIF
+            ENDIF
+            !                       !--- Bare ice albedo (for hi < 150cm)
+            IF( 0.05 < ph_ice(ji,jj,jl) .AND. ph_ice(ji,jj,jl) <= 1.5 ) THEN      ! 5cm < hi < 150cm
+               zalb_ice = zalb_ice    + ( 0.18 - zalb_ice   ) * z1_c1 * ( LOG(1.5) - LOG(ph_ice(ji,jj,jl)) )
+            ELSEIF( ph_ice(ji,jj,jl) <= 0.05 ) THEN                               ! 0cm < hi < 5cm
+               zalb_ice = rn_alb_oce  + ( 0.18 - rn_alb_oce ) * z1_c2 * ph_ice(ji,jj,jl)
+            ENDIF
+            !
+            !                       !--- Snow-covered ice albedo (freezing, melting cases)
+            IF( pt_su(ji,jj,jl) < rt0 ) THEN
+               zalb_snw = rn_alb_sdry - ( rn_alb_sdry - zalb_ice ) * EXP( - ph_snw(ji,jj,jl) * z1_c3 )
+            ELSE
+               zalb_snw = rn_alb_smlt - ( rn_alb_smlt - zalb_ice ) * EXP( - ph_snw(ji,jj,jl) * z1_c4 )
+            ENDIF
+            !                       !--- Ponded ice albedo
+            IF( ld_pnd_alb ) THEN
+               zalb_pnd = rn_alb_dpnd - ( rn_alb_dpnd - zalb_ice ) * EXP( - ph_pnd(ji,jj,jl) * z1_href_pnd ) 
+            ELSE
+               zalb_pnd = rn_alb_dpnd
+            ENDIF
+            !                       !--- Surface albedo is weighted mean of snow, ponds and bare ice contributions
+            palb_os(ji,jj,jl) = ( zafrac_snw * zalb_snw + zafrac_pnd * zalb_pnd + zafrac_ice * zalb_ice ) * tmask(ji,jj,1)
+            !
+            palb_cs(ji,jj,jl) = palb_os(ji,jj,jl)  &
+               &                - ( - 0.1010 * palb_os(ji,jj,jl) * palb_os(ji,jj,jl)  &
+               &                    + 0.1933 * palb_os(ji,jj,jl) - 0.0148 ) * tmask(ji,jj,1)
+            !
+         END_2D
       END DO
       !
@@ -190,8 +190,6 @@
       !!----------------------------------------------------------------------
       !
-      REWIND( numnam_ice_ref )              ! Namelist namalb in reference namelist : Albedo parameters
       READ  ( numnam_ice_ref, namalb, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namalb in reference namelist' )
-      REWIND( numnam_ice_cfg )              ! Namelist namalb in configuration namelist : Albedo parameters
       READ  ( numnam_ice_cfg, namalb, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namalb in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icecor.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icecor.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icecor.F90	(revision 12928)
@@ -35,5 +35,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/ICE 4.0 , NEMO Consortium (2018)
@@ -86,13 +86,11 @@
       IF ( nn_icesal == 2 ) THEN    !  salinity must stay in bounds [Simin,Simax]        !
          !                          !-----------------------------------------------------
-         zzc = rhoi * r1_rdtice
+         zzc = rhoi * r1_Dt_ice
          DO jl = 1, jpl
-            DO jj = 1, jpj 
-               DO ji = 1, jpi
-                  zsal = sv_i(ji,jj,jl)
-                  sv_i(ji,jj,jl) = MIN(  MAX( rn_simin*v_i(ji,jj,jl) , sv_i(ji,jj,jl) ) , rn_simax*v_i(ji,jj,jl)  )
-                  sfx_res(ji,jj) = sfx_res(ji,jj) - ( sv_i(ji,jj,jl) - zsal ) * zzc   ! associated salt flux
-               END DO
-            END DO
+            DO_2D_11_11
+               zsal = sv_i(ji,jj,jl)
+               sv_i(ji,jj,jl) = MIN(  MAX( rn_simin*v_i(ji,jj,jl) , sv_i(ji,jj,jl) ) , rn_simax*v_i(ji,jj,jl)  )
+               sfx_res(ji,jj) = sfx_res(ji,jj) - ( sv_i(ji,jj,jl) - zsal ) * zzc   ! associated salt flux
+            END_2D
          END DO
       ENDIF
@@ -108,14 +106,12 @@
       !                             !-----------------------------------------------------
       IF( kn == 2 ) THEN            !  Ice drift case: Corrections to avoid wrong values !
-         DO jj = 2, jpjm1           !-----------------------------------------------------
-            DO ji = 2, jpim1
-               IF ( at_i(ji,jj) == 0._wp ) THEN    ! what to do if there is no ice
-                  IF ( at_i(ji+1,jj) == 0._wp )   u_ice(ji  ,jj) = 0._wp   ! right side
-                  IF ( at_i(ji-1,jj) == 0._wp )   u_ice(ji-1,jj) = 0._wp   ! left side
-                  IF ( at_i(ji,jj+1) == 0._wp )   v_ice(ji,jj  ) = 0._wp   ! upper side
-                  IF ( at_i(ji,jj-1) == 0._wp )   v_ice(ji,jj-1) = 0._wp   ! bottom side
-               ENDIF
-            END DO
-         END DO
+         DO_2D_00_00
+            IF ( at_i(ji,jj) == 0._wp ) THEN    ! what to do if there is no ice
+               IF ( at_i(ji+1,jj) == 0._wp )   u_ice(ji  ,jj) = 0._wp   ! right side
+               IF ( at_i(ji-1,jj) == 0._wp )   u_ice(ji-1,jj) = 0._wp   ! left side
+               IF ( at_i(ji,jj+1) == 0._wp )   v_ice(ji,jj  ) = 0._wp   ! upper side
+               IF ( at_i(ji,jj-1) == 0._wp )   v_ice(ji,jj-1) = 0._wp   ! bottom side
+            ENDIF
+         END_2D
          CALL lbc_lnk_multi( 'icecor', u_ice, 'U', -1., v_ice, 'V', -1. )
       ENDIF
@@ -127,13 +123,13 @@
          !
          IF( ln_icediachk .OR. iom_use('hfxdhc') ) THEN
-            diag_heat(:,:) = - SUM(SUM( e_i (:,:,1:nlay_i,:) - e_i_b (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_rdtice &      ! W.m-2
-               &             - SUM(SUM( e_s (:,:,1:nlay_s,:) - e_s_b (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_rdtice
-            diag_sice(:,:) =   SUM(     sv_i(:,:,:)          - sv_i_b(:,:,:)                  , dim=3 ) * r1_rdtice * rhoi
-            diag_vice(:,:) =   SUM(     v_i (:,:,:)          - v_i_b (:,:,:)                  , dim=3 ) * r1_rdtice * rhoi
-            diag_vsnw(:,:) =   SUM(     v_s (:,:,:)          - v_s_b (:,:,:)                  , dim=3 ) * r1_rdtice * rhos
+            diag_heat(:,:) = - SUM(SUM( e_i (:,:,1:nlay_i,:) - e_i_b (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_Dt_ice &      ! W.m-2
+               &             - SUM(SUM( e_s (:,:,1:nlay_s,:) - e_s_b (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_Dt_ice
+            diag_sice(:,:) =   SUM(     sv_i(:,:,:)          - sv_i_b(:,:,:)                  , dim=3 ) * r1_Dt_ice * rhoi
+            diag_vice(:,:) =   SUM(     v_i (:,:,:)          - v_i_b (:,:,:)                  , dim=3 ) * r1_Dt_ice * rhoi
+            diag_vsnw(:,:) =   SUM(     v_s (:,:,:)          - v_s_b (:,:,:)                  , dim=3 ) * r1_Dt_ice * rhos
          ENDIF
          !                       ! concentration tendency (dynamics)
          IF( iom_use('afxdyn') .OR. iom_use('afxthd') .OR. iom_use('afxtot') ) THEN 
-            zafx(:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice 
+            zafx(:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_Dt_ice 
             CALL iom_put( 'afxdyn' , zafx )
          ENDIF
@@ -141,22 +137,22 @@
       CASE( 2 )                        !--- thermo trend diagnostics & ice aging
          !
-         oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * rdt_ice   ! ice natural aging incrementation
+         oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * rDt_ice   ! ice natural aging incrementation
          !
          IF( ln_icediachk .OR. iom_use('hfxdhc') ) THEN
             diag_heat(:,:) = diag_heat(:,:) &
-               &             - SUM(SUM( e_i (:,:,1:nlay_i,:) - e_i_b (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_rdtice &
-               &             - SUM(SUM( e_s (:,:,1:nlay_s,:) - e_s_b (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_rdtice
+               &             - SUM(SUM( e_i (:,:,1:nlay_i,:) - e_i_b (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_Dt_ice &
+               &             - SUM(SUM( e_s (:,:,1:nlay_s,:) - e_s_b (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_Dt_ice
             diag_sice(:,:) = diag_sice(:,:) &
-               &             + SUM(     sv_i(:,:,:)          - sv_i_b(:,:,:)                  , dim=3 ) * r1_rdtice * rhoi
+               &             + SUM(     sv_i(:,:,:)          - sv_i_b(:,:,:)                  , dim=3 ) * r1_Dt_ice * rhoi
             diag_vice(:,:) = diag_vice(:,:) &
-               &             + SUM(     v_i (:,:,:)          - v_i_b (:,:,:)                  , dim=3 ) * r1_rdtice * rhoi
+               &             + SUM(     v_i (:,:,:)          - v_i_b (:,:,:)                  , dim=3 ) * r1_Dt_ice * rhoi
             diag_vsnw(:,:) = diag_vsnw(:,:) &
-               &             + SUM(     v_s (:,:,:)          - v_s_b (:,:,:)                  , dim=3 ) * r1_rdtice * rhos
+               &             + SUM(     v_s (:,:,:)          - v_s_b (:,:,:)                  , dim=3 ) * r1_Dt_ice * rhos
             CALL iom_put ( 'hfxdhc' , diag_heat ) 
          ENDIF
          !                       ! concentration tendency (total + thermo)
          IF( iom_use('afxdyn') .OR. iom_use('afxthd') .OR. iom_use('afxtot') ) THEN 
-            zafx(:,:) = zafx(:,:) + SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice
-            CALL iom_put( 'afxthd' , SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice )
+            zafx(:,:) = zafx(:,:) + SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_Dt_ice
+            CALL iom_put( 'afxthd' , SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_Dt_ice )
             CALL iom_put( 'afxtot' , zafx )
          ENDIF
@@ -165,5 +161,6 @@
       !
       ! controls
-      IF( ln_ctl       )   CALL ice_prt3D   ('icecor')                                                             ! prints
+      IF( sn_cfctl%l_prtctl ) &
+         &                 CALL ice_prt3D   ('icecor')                                                             ! prints
       IF( ln_icectl .AND. kn == 2 ) &
          &                 CALL ice_prt     ( kt, iiceprt, jiceprt, 2, ' - Final state - ' )                       ! prints
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icectl.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icectl.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icectl.F90	(revision 12928)
@@ -51,5 +51,5 @@
    
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/ICE 4.0 , NEMO Consortium (2018)
@@ -104,5 +104,5 @@
 
          ! -- mass diag -- !
-         zdiag_mass = ( glob_sum( 'icectl', SUM( v_i * rhoi + v_s * rhos, dim=3 ) * e1e2t ) - pdiag_v ) * r1_rdtice       &
+         zdiag_mass = ( glob_sum( 'icectl', SUM( v_i * rhoi + v_s * rhos, dim=3 ) * e1e2t ) - pdiag_v ) * r1_Dt_ice       &
             &         + glob_sum( 'icectl', ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn +       &
             &                                 wfx_lam + wfx_pnd + wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + &
@@ -111,5 +111,5 @@
          !
          ! -- salt diag -- !
-         zdiag_salt = ( glob_sum( 'icectl', SUM( sv_i * rhoi , dim=3 ) * e1e2t ) - pdiag_s ) * r1_rdtice  &
+         zdiag_salt = ( glob_sum( 'icectl', SUM( sv_i * rhoi , dim=3 ) * e1e2t ) - pdiag_s ) * r1_Dt_ice  &
             &         + glob_sum( 'icectl', ( sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni +           &
             &                                 sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam ) * e1e2t ) &
@@ -118,5 +118,5 @@
          ! -- heat diag -- !
          zdiag_heat = ( glob_sum( 'icectl', ( SUM(SUM(e_i, dim=4), dim=3) + SUM(SUM(e_s, dim=4), dim=3) ) * e1e2t ) - pdiag_t &
-            &         ) * r1_rdtice                                                                                           &
+            &         ) * r1_Dt_ice                                                                                           &
             &         + glob_sum( 'icectl', (  hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw                      &
             &                                - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) * e1e2t )                    &
@@ -141,9 +141,9 @@
             ! check conservation issues
             IF( ABS(zdiag_mass) > zchk_m * rn_icechk_glo * zarea ) &
-               &                   WRITE(numout,*)   cd_routine,' : violation mass cons. [kg] = ',zdiag_mass * rdt_ice
+               &                   WRITE(numout,*)   cd_routine,' : violation mass cons. [kg] = ',zdiag_mass * rDt_ice
             IF( ABS(zdiag_salt) > zchk_s * rn_icechk_glo * zarea ) &
-               &                   WRITE(numout,*)   cd_routine,' : violation salt cons. [g]  = ',zdiag_salt * rdt_ice
+               &                   WRITE(numout,*)   cd_routine,' : violation salt cons. [g]  = ',zdiag_salt * rDt_ice
             IF( ABS(zdiag_heat) > zchk_t * rn_icechk_glo * zarea ) &
-               &                   WRITE(numout,*)   cd_routine,' : violation heat cons. [J]  = ',zdiag_heat * rdt_ice
+               &                   WRITE(numout,*)   cd_routine,' : violation heat cons. [J]  = ',zdiag_heat * rDt_ice
             ! check negative values
             IF( zdiag_vmin  < 0. ) WRITE(numout,*)   cd_routine,' : violation v_i < 0         = ',zdiag_vmin
@@ -160,5 +160,5 @@
             !    it does not mean UM is not conservative (it is checked with above prints) => update (09/2019): same for Prather now
             !IF( ln_adv_Pra .AND. ABS(zvtrp) > zchk_m * rn_icechk_glo * zarea .AND. cd_routine == 'icedyn_adv' ) &
-            !   &                   WRITE(numout,*)   cd_routine,' : violation adv scheme [kg] = ',zvtrp * rdt_ice
+            !   &                   WRITE(numout,*)   cd_routine,' : violation adv scheme [kg] = ',zvtrp * rDt_ice
          ENDIF
          !
@@ -201,8 +201,8 @@
       IF( lwp ) THEN
          IF( ABS(zdiag_mass) > zchk_m * rn_icechk_glo * zarea ) &
-            &                   WRITE(numout,*) cd_routine,' : violation mass cons. [kg] = ',zdiag_mass * rdt_ice
+            &                   WRITE(numout,*) cd_routine,' : violation mass cons. [kg] = ',zdiag_mass * rDt_ice
          IF( ABS(zdiag_salt) > zchk_s * rn_icechk_glo * zarea ) &
-            &                   WRITE(numout,*) cd_routine,' : violation salt cons. [g]  = ',zdiag_salt * rdt_ice
-         !!IF( ABS(zdiag_heat) > zchk_t * rn_icechk_glo * zarea ) WRITE(numout,*) cd_routine,' : violation heat cons. [J]  = ',zdiag_heat * rdt_ice
+            &                   WRITE(numout,*) cd_routine,' : violation salt cons. [g]  = ',zdiag_salt * rDt_ice
+         !!IF( ABS(zdiag_heat) > zchk_t * rn_icechk_glo * zarea ) WRITE(numout,*) cd_routine,' : violation heat cons. [J]  = ',zdiag_heat * rDt_ice
       ENDIF
       !
@@ -250,5 +250,5 @@
 
          ! -- mass diag -- !
-         zdiag_mass =   ( SUM( v_i * rhoi + v_s * rhos, dim=3 ) - pdiag_v ) * r1_rdtice                             &
+         zdiag_mass =   ( SUM( v_i * rhoi + v_s * rhos, dim=3 ) - pdiag_v ) * r1_Dt_ice                             &
             &         + ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + wfx_lam + wfx_pnd + &
             &             wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr )           &
@@ -257,5 +257,5 @@
          !
          ! -- salt diag -- !
-         zdiag_salt =   ( SUM( sv_i * rhoi , dim=3 ) - pdiag_s ) * r1_rdtice                                                  &
+         zdiag_salt =   ( SUM( sv_i * rhoi , dim=3 ) - pdiag_s ) * r1_Dt_ice                                                  &
             &         + ( sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam ) &
             &         - pdiag_fs
@@ -263,5 +263,5 @@
          !
          ! -- heat diag -- !
-         zdiag_heat =   ( SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) - pdiag_t ) * r1_rdtice &
+         zdiag_heat =   ( SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) - pdiag_t ) * r1_Dt_ice &
             &         + (  hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw                                & 
             &            - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr )                                        &
@@ -331,5 +331,5 @@
       IF(lwp) WRITE(numout,*)                
 
-      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl )
+      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' )
       
       CALL iom_rstput( 0, 0, inum, 'cons_mass', pdiag_mass(:,:) , ktype = jp_r8 )    ! ice mass spurious lost/gain
@@ -368,12 +368,10 @@
       cl_alname(ialert_id) = ' Incompat vol and con         '    ! name of the alert
       DO jl = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF(  v_i(ji,jj,jl) /= 0._wp   .AND.   a_i(ji,jj,jl) == 0._wp   ) THEN
-                  WRITE(numout,*) ' ALERTE 2 :   Incompatible volume and concentration '
-                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-               ENDIF
-            END DO
-         END DO
+         DO_2D_11_11
+            IF(  v_i(ji,jj,jl) /= 0._wp   .AND.   a_i(ji,jj,jl) == 0._wp   ) THEN
+               WRITE(numout,*) ' ALERTE 2 :   Incompatible volume and concentration '
+               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+            ENDIF
+         END_2D
       END DO
 
@@ -382,53 +380,45 @@
       cl_alname(ialert_id) = ' Very thick ice               ' ! name of the alert
       jl = jpl 
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF(   h_i(ji,jj,jl)  >  50._wp   ) THEN
-               WRITE(numout,*) ' ALERTE 3 :   Very thick ice'
-               !CALL ice_prt( kt, ji, jj, 2, ' ALERTE 3 :   Very thick ice ' )
-               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-            ENDIF
-         END DO
-      END DO
+      DO_2D_11_11
+         IF(   h_i(ji,jj,jl)  >  50._wp   ) THEN
+            WRITE(numout,*) ' ALERTE 3 :   Very thick ice'
+            !CALL ice_prt( kt, ji, jj, 2, ' ALERTE 3 :   Very thick ice ' )
+            inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+         ENDIF
+      END_2D
 
       ! Alert if very fast ice
       ialert_id = 4 ! reference number of this alert
       cl_alname(ialert_id) = ' Very fast ice               ' ! name of the alert
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF(   MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 2.  .AND.  &
-               &  at_i(ji,jj) > 0._wp   ) THEN
-               WRITE(numout,*) ' ALERTE 4 :   Very fast ice'
-               !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 4 :   Very fast ice ' )
-               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-            ENDIF
-         END DO
-      END DO
+      DO_2D_11_11
+         IF(   MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 2.  .AND.  &
+            &  at_i(ji,jj) > 0._wp   ) THEN
+            WRITE(numout,*) ' ALERTE 4 :   Very fast ice'
+            !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 4 :   Very fast ice ' )
+            inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+         ENDIF
+      END_2D
 
       ! Alert on salt flux
       ialert_id = 5 ! reference number of this alert
       cl_alname(ialert_id) = ' High salt flux               ' ! name of the alert
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF( ABS( sfx (ji,jj) ) > 1.0e-2 ) THEN  ! = 1 psu/day for 1m ocean depth
-               WRITE(numout,*) ' ALERTE 5 :   High salt flux'
-               !CALL ice_prt( kt, ji, jj, 3, ' ALERTE 5 :   High salt flux ' )
-               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-            ENDIF
-         END DO
-      END DO
+      DO_2D_11_11
+         IF( ABS( sfx (ji,jj) ) > 1.0e-2 ) THEN  ! = 1 psu/day for 1m ocean depth
+            WRITE(numout,*) ' ALERTE 5 :   High salt flux'
+            !CALL ice_prt( kt, ji, jj, 3, ' ALERTE 5 :   High salt flux ' )
+            inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+         ENDIF
+      END_2D
 
       ! Alert if there is ice on continents
       ialert_id = 6 ! reference number of this alert
       cl_alname(ialert_id) = ' Ice on continents           ' ! name of the alert
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF(   tmask(ji,jj,1) <= 0._wp   .AND.   at_i(ji,jj) > 0._wp   ) THEN 
-               WRITE(numout,*) ' ALERTE 6 :   Ice on continents'
-               !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 6 :   Ice on continents ' )
-               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-            ENDIF
-         END DO
-      END DO
+      DO_2D_11_11
+         IF(   tmask(ji,jj,1) <= 0._wp   .AND.   at_i(ji,jj) > 0._wp   ) THEN 
+            WRITE(numout,*) ' ALERTE 6 :   Ice on continents'
+            !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 6 :   Ice on continents ' )
+            inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+         ENDIF
+      END_2D
 
 !
@@ -437,13 +427,11 @@
       cl_alname(ialert_id) = ' Very fresh ice               ' ! name of the alert
       DO jl = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( s_i(ji,jj,jl) < 0.1 .AND. a_i(ji,jj,jl) > 0._wp ) THEN
-                  WRITE(numout,*) ' ALERTE 7 :   Very fresh ice'
+         DO_2D_11_11
+            IF( s_i(ji,jj,jl) < 0.1 .AND. a_i(ji,jj,jl) > 0._wp ) THEN
+               WRITE(numout,*) ' ALERTE 7 :   Very fresh ice'
 !                 CALL ice_prt(kt,ji,jj,1, ' ALERTE 7 :   Very fresh ice ' )
-                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-               ENDIF
-            END DO
-         END DO
+               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+            ENDIF
+         END_2D
       END DO
 !
@@ -451,15 +439,13 @@
       ialert_id = 8 ! reference number of this alert
       cl_alname(ialert_id) = ' fnsolar very big             ' ! name of the alert
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN
-               !
-               WRITE(numout,*) ' ALERTE 8 :   Very high non-solar heat flux'
-               !CALL ice_prt( kt, ji, jj, 2, '   ')
-               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-               !
-            ENDIF
-         END DO
-      END DO
+      DO_2D_11_11
+         IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN
+            !
+            WRITE(numout,*) ' ALERTE 8 :   Very high non-solar heat flux'
+            !CALL ice_prt( kt, ji, jj, 2, '   ')
+            inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+            !
+         ENDIF
+      END_2D
       !+++++
 
@@ -468,15 +454,13 @@
       cl_alname(ialert_id) = ' Very old   ice               ' ! name of the alert
       DO jl = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF ( ( ( ABS( o_i(ji,jj,jl) ) > rdt_ice ) .OR. &
-                      ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. &
-                             ( a_i(ji,jj,jl) > 0._wp ) ) THEN
-                  WRITE(numout,*) ' ALERTE 9 :   Wrong ice age'
-                  !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 9 :   Wrong ice age ')
-                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-               ENDIF
-            END DO
-         END DO
+         DO_2D_11_11
+            IF ( ( ( ABS( o_i(ji,jj,jl) ) > rDt_ice ) .OR. &
+                   ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. &
+                          ( a_i(ji,jj,jl) > 0._wp ) ) THEN
+               WRITE(numout,*) ' ALERTE 9 :   Wrong ice age'
+               !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 9 :   Wrong ice age ')
+               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+            ENDIF
+         END_2D
       END DO
   
@@ -486,16 +470,12 @@
       inb_alp(ialert_id) = 0
       DO jl = 1, jpl
-         DO jk = 1, nlay_i
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  ztmelts    =  -rTmlt * sz_i(ji,jj,jk,jl) + rt0
-                  IF( t_i(ji,jj,jk,jl) > ztmelts  .AND.  v_i(ji,jj,jl) > 1.e-10   &
-                     &                            .AND.  a_i(ji,jj,jl) > 0._wp   ) THEN
-                     WRITE(numout,*) ' ALERTE 10 :   Very warm ice'
-                    inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-                  ENDIF
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, nlay_i )
+            ztmelts    =  -rTmlt * sz_i(ji,jj,jk,jl) + rt0
+            IF( t_i(ji,jj,jk,jl) > ztmelts  .AND.  v_i(ji,jj,jl) > 1.e-10   &
+               &                            .AND.  a_i(ji,jj,jl) > 0._wp   ) THEN
+               WRITE(numout,*) ' ALERTE 10 :   Very warm ice'
+              inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+            ENDIF
+         END_3D
       END DO
 
@@ -671,5 +651,5 @@
                WRITE(numout,*) ' hfx_res      : ', hfx_res(ji,jj)
                WRITE(numout,*) ' qsb_ice_bot  : ', qsb_ice_bot(ji,jj) 
-               WRITE(numout,*) ' qlead        : ', qlead(ji,jj) * r1_rdtice
+               WRITE(numout,*) ' qlead        : ', qlead(ji,jj) * r1_Dt_ice
                WRITE(numout,*)
                WRITE(numout,*) ' - Salt fluxes at bottom interface ***'
@@ -695,5 +675,5 @@
       !!                  ***  ROUTINE ice_prt3D ***
       !!
-      !! ** Purpose : CTL prints of ice arrays in case ln_ctl is activated 
+      !! ** Purpose : CTL prints of ice arrays in case sn_cfctl%prtctl is activated 
       !!
       !!-------------------------------------------------------------------
@@ -745,11 +725,4 @@
       
       CALL prt_ctl_info(' ')
-      CALL prt_ctl_info(' - Heat / FW fluxes : ')
-      CALL prt_ctl_info('   ~~~~~~~~~~~~~~~~~~ ')
-      CALL prt_ctl(tab2d_1=sst_m  , clinfo1= ' sst   : ', tab2d_2=sss_m     , clinfo2= ' sss       : ')
-      CALL prt_ctl(tab2d_1=qsr    , clinfo1= ' qsr   : ', tab2d_2=qns       , clinfo2= ' qns       : ')
-      CALL prt_ctl(tab2d_1=emp    , clinfo1= ' emp   : ', tab2d_2=sfx       , clinfo2= ' sfx       : ')
-      
-      CALL prt_ctl_info(' ')
       CALL prt_ctl_info(' - Stresses : ')
       CALL prt_ctl_info('   ~~~~~~~~~~ ')
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icedia.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icedia.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icedia.F90	(revision 12928)
@@ -38,6 +38,4 @@
    REAL(wp)                              ::   frc_sal, frc_voltop, frc_volbot, frc_temtop, frc_tembot  ! global forcing trends
    
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/ICE 4.0 , NEMO Consortium (2018)
@@ -111,15 +109,15 @@
       ! ---------------------------!
       ! they must be kept outside an IF(iom_use) because of the call to dia_rst below
-      z_frc_volbot = r1_rau0 * glob_sum( 'icedia', -( wfx_ice(:,:) + wfx_snw(:,:) + wfx_err_sub(:,:) ) * e1e2t(:,:) ) * 1.e-9   ! freshwater flux ice/snow-ocean 
-      z_frc_voltop = r1_rau0 * glob_sum( 'icedia', -( wfx_sub(:,:) + wfx_spr(:,:) )                    * e1e2t(:,:) ) * 1.e-9   ! freshwater flux ice/snow-atm
-      z_frc_sal    = r1_rau0 * glob_sum( 'icedia', -      sfx(:,:)                                     * e1e2t(:,:) ) * 1.e-9   ! salt fluxes ice/snow-ocean
+      z_frc_volbot = r1_rho0 * glob_sum( 'icedia', -( wfx_ice(:,:) + wfx_snw(:,:) + wfx_err_sub(:,:) ) * e1e2t(:,:) ) * 1.e-9   ! freshwater flux ice/snow-ocean 
+      z_frc_voltop = r1_rho0 * glob_sum( 'icedia', -( wfx_sub(:,:) + wfx_spr(:,:) )                    * e1e2t(:,:) ) * 1.e-9   ! freshwater flux ice/snow-atm
+      z_frc_sal    = r1_rho0 * glob_sum( 'icedia', -      sfx(:,:)                                     * e1e2t(:,:) ) * 1.e-9   ! salt fluxes ice/snow-ocean
       z_frc_tembot =           glob_sum( 'icedia',  qt_oce_ai(:,:)                                     * e1e2t(:,:) ) * 1.e-20  ! heat on top of ocean (and below ice)
       z_frc_temtop =           glob_sum( 'icedia',  qt_atm_oi(:,:)                                     * e1e2t(:,:) ) * 1.e-20  ! heat on top of ice-coean
       !
-      frc_voltop  = frc_voltop  + z_frc_voltop  * rdt_ice ! km3
-      frc_volbot  = frc_volbot  + z_frc_volbot  * rdt_ice ! km3
-      frc_sal     = frc_sal     + z_frc_sal     * rdt_ice ! km3*pss
-      frc_temtop  = frc_temtop  + z_frc_temtop  * rdt_ice ! 1.e20 J
-      frc_tembot  = frc_tembot  + z_frc_tembot  * rdt_ice ! 1.e20 J
+      frc_voltop  = frc_voltop  + z_frc_voltop  * rDt_ice ! km3
+      frc_volbot  = frc_volbot  + z_frc_volbot  * rDt_ice ! km3
+      frc_sal     = frc_sal     + z_frc_sal     * rDt_ice ! km3*pss
+      frc_temtop  = frc_temtop  + z_frc_temtop  * rDt_ice ! 1.e20 J
+      frc_tembot  = frc_tembot  + z_frc_tembot  * rDt_ice ! 1.e20 J
 
       CALL iom_put( 'ibgfrcvoltop' , frc_voltop )   ! vol  forcing ice/snw-atm          (km3 equivalent ocean water) 
@@ -130,6 +128,6 @@
 
       IF(  iom_use('ibgfrchfxtop') .OR. iom_use('ibgfrchfxbot') ) THEN
-         CALL iom_put( 'ibgfrchfxtop' , frc_temtop * z1_e1e2 * 1.e-20 * kt*rdt ) ! heat on top of ice/snw/ocean      (W/m2)
-         CALL iom_put( 'ibgfrchfxbot' , frc_tembot * z1_e1e2 * 1.e-20 * kt*rdt ) ! heat on top of ocean(below ice)   (W/m2) 
+         CALL iom_put( 'ibgfrchfxtop' , frc_temtop * z1_e1e2 * 1.e-20 * kt*rn_Dt ) ! heat on top of ice/snw/ocean      (W/m2)
+         CALL iom_put( 'ibgfrchfxbot' , frc_tembot * z1_e1e2 * 1.e-20 * kt*rn_Dt ) ! heat on top of ocean(below ice)   (W/m2) 
       ENDIF
       
@@ -139,6 +137,6 @@
       IF(  iom_use('ibgvolume') .OR. iom_use('ibgsaltco') .OR. iom_use('ibgheatco') .OR. iom_use('ibgheatfx') ) THEN
             
-         zdiff_vol = r1_rau0 * glob_sum( 'icedia', ( rhoi*vt_i(:,:) + rhos*vt_s(:,:) - vol_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9   ! freshwater trend (km3) 
-         zdiff_sal = r1_rau0 * glob_sum( 'icedia', ( rhoi*st_i(:,:)                  - sal_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9   ! salt content trend (km3*pss)
+         zdiff_vol = r1_rho0 * glob_sum( 'icedia', ( rhoi*vt_i(:,:) + rhos*vt_s(:,:) - vol_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9   ! freshwater trend (km3) 
+         zdiff_sal = r1_rho0 * glob_sum( 'icedia', ( rhoi*st_i(:,:)                  - sal_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9   ! salt content trend (km3*pss)
          zdiff_tem =           glob_sum( 'icedia', ( et_i(:,:) + et_s(:,:)           - tem_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-20  ! heat content trend (1.e20 J)
          !                               + SUM( qevap_ice * a_i_b, dim=3 )       !! clem: I think this term should not be there (but needs a check)
@@ -178,8 +176,6 @@
       !!----------------------------------------------------------------------
       !
-      REWIND( numnam_ice_ref )      ! Namelist namdia in reference namelist : Parameters for ice
       READ  ( numnam_ice_ref, namdia, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdia in reference namelist' )
-      REWIND( numnam_ice_cfg )      ! Namelist namdia in configuration namelist : Parameters for ice
       READ  ( numnam_ice_cfg, namdia, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdia in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icedyn.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icedyn.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icedyn.F90	(revision 12928)
@@ -52,5 +52,5 @@
    
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/ICE 4.0 , NEMO Consortium (2018)
@@ -60,5 +60,5 @@
 CONTAINS
 
-   SUBROUTINE ice_dyn( kt )
+   SUBROUTINE ice_dyn( kt, Kmm )
       !!-------------------------------------------------------------------
       !!               ***  ROUTINE ice_dyn  ***
@@ -73,4 +73,5 @@
       !!--------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt     ! ice time step
+      INTEGER, INTENT(in) ::   Kmm    ! ocean time level index
       !!
       INTEGER  ::   ji, jj        ! dummy loop indices
@@ -108,5 +109,5 @@
       CASE ( np_dynALL )           !==  all dynamical processes  ==!
          !
-         CALL ice_dyn_rhg   ( kt )                                          ! -- rheology  
+         CALL ice_dyn_rhg   ( kt, Kmm )                                     ! -- rheology  
          CALL ice_dyn_adv   ( kt )                                          ! -- advection of ice
          CALL ice_dyn_rdgrft( kt )                                          ! -- ridging/rafting 
@@ -115,5 +116,5 @@
       CASE ( np_dynRHGADV  )       !==  no ridge/raft & no corrections ==!
          !
-         CALL ice_dyn_rhg   ( kt )                                          ! -- rheology  
+         CALL ice_dyn_rhg   ( kt, Kmm )                                     ! -- rheology  
          CALL ice_dyn_adv   ( kt )                                          ! -- advection of ice
          CALL Hpiling                                                       ! -- simple pile-up (replaces ridging/rafting)
@@ -125,12 +126,10 @@
          ! CFL = 0.5 at a distance from the bound of 1/6 of the basin length
          ! Then for dx = 2m and dt = 1s => rn_uice = u (1/6th) = 1m/s 
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zcoefu = ( REAL(jpiglo+1)*0.5 - REAL(ji+nimpp-1) ) / ( REAL(jpiglo+1)*0.5 - 1. )
-               zcoefv = ( REAL(jpjglo+1)*0.5 - REAL(jj+njmpp-1) ) / ( REAL(jpjglo+1)*0.5 - 1. )
-               u_ice(ji,jj) = rn_uice * 1.5 * SIGN( 1., zcoefu ) * ABS( zcoefu ) * umask(ji,jj,1)
-               v_ice(ji,jj) = rn_vice * 1.5 * SIGN( 1., zcoefv ) * ABS( zcoefv ) * vmask(ji,jj,1)
-            END DO
-         END DO
+         DO_2D_11_11
+            zcoefu = ( REAL(jpiglo+1)*0.5 - REAL(ji+nimpp-1) ) / ( REAL(jpiglo+1)*0.5 - 1. )
+            zcoefv = ( REAL(jpjglo+1)*0.5 - REAL(jj+njmpp-1) ) / ( REAL(jpjglo+1)*0.5 - 1. )
+            u_ice(ji,jj) = rn_uice * 1.5 * SIGN( 1., zcoefu ) * ABS( zcoefu ) * umask(ji,jj,1)
+            v_ice(ji,jj) = rn_vice * 1.5 * SIGN( 1., zcoefv ) * ABS( zcoefv ) * vmask(ji,jj,1)
+         END_2D
          ! ---
          CALL ice_dyn_adv   ( kt )                                          ! -- advection of ice
@@ -156,10 +155,8 @@
 
             ALLOCATE( zdivu_i(jpi,jpj) )
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  zdivu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   &
-                     &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) ) * r1_e1e2t(ji,jj)
-               END DO
-            END DO
+            DO_2D_00_00
+               zdivu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   &
+                  &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) ) * r1_e1e2t(ji,jj)
+            END_2D
             CALL lbc_lnk( 'icedyn', zdivu_i, 'T', 1. )
             ! output
@@ -224,8 +221,6 @@
       !!-------------------------------------------------------------------
       !
-      REWIND( numnam_ice_ref )         ! Namelist namdyn in reference namelist : Ice dynamics
       READ  ( numnam_ice_ref, namdyn, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn in reference namelist' )
-      REWIND( numnam_ice_cfg )         ! Namelist namdyn in configuration namelist : Ice dynamics
       READ  ( numnam_ice_cfg, namdyn, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icedyn_adv.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icedyn_adv.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icedyn_adv.F90	(revision 12928)
@@ -42,6 +42,4 @@
    INTEGER         ::   nn_UMx       ! order of the UMx advection scheme   
    !
-   !! * Substitution
-#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/ICE 4.0 , NEMO Consortium (2018)
@@ -88,5 +86,5 @@
       CASE( np_advPRA )                ! PRATHER scheme        !
          !                             !-----------------------!
-         CALL ice_dyn_adv_pra(         kt, u_ice, v_ice, &
+         CALL ice_dyn_adv_pra(         kt, u_ice, v_ice, h_i, h_s, h_ip, &
             &                          ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, e_s, e_i )
       END SELECT
@@ -95,9 +93,9 @@
       ! diagnostics
       !------------
-      diag_trp_ei(:,:) = SUM(SUM( e_i (:,:,1:nlay_i,:) - e_i_b (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_rdtice
-      diag_trp_es(:,:) = SUM(SUM( e_s (:,:,1:nlay_s,:) - e_s_b (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_rdtice
-      diag_trp_sv(:,:) = SUM(     sv_i(:,:,:)          - sv_i_b(:,:,:)                  , dim=3 ) * r1_rdtice
-      diag_trp_vi(:,:) = SUM(     v_i (:,:,:)          - v_i_b (:,:,:)                  , dim=3 ) * r1_rdtice
-      diag_trp_vs(:,:) = SUM(     v_s (:,:,:)          - v_s_b (:,:,:)                  , dim=3 ) * r1_rdtice
+      diag_trp_ei(:,:) = SUM(SUM( e_i (:,:,1:nlay_i,:) - e_i_b (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_Dt_ice
+      diag_trp_es(:,:) = SUM(SUM( e_s (:,:,1:nlay_s,:) - e_s_b (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_Dt_ice
+      diag_trp_sv(:,:) = SUM(     sv_i(:,:,:)          - sv_i_b(:,:,:)                  , dim=3 ) * r1_Dt_ice
+      diag_trp_vi(:,:) = SUM(     v_i (:,:,:)          - v_i_b (:,:,:)                  , dim=3 ) * r1_Dt_ice
+      diag_trp_vs(:,:) = SUM(     v_s (:,:,:)          - v_s_b (:,:,:)                  , dim=3 ) * r1_Dt_ice
       IF( iom_use('icemtrp') )   CALL iom_put( 'icemtrp' ,  diag_trp_vi * rhoi          )   ! ice mass transport
       IF( iom_use('snwmtrp') )   CALL iom_put( 'snwmtrp' ,  diag_trp_vs * rhos          )   ! snw mass transport
@@ -131,8 +129,6 @@
       !!-------------------------------------------------------------------
       !
-      REWIND( numnam_ice_ref )         ! Namelist namdyn_adv in reference namelist : Ice dynamics
       READ  ( numnam_ice_ref, namdyn_adv, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_adv in reference namelist' )
-      REWIND( numnam_ice_cfg )         ! Namelist namdyn_adv in configuration namelist : Ice dynamics
       READ  ( numnam_ice_cfg, namdyn_adv, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_adv in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icedyn_adv_pra.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icedyn_adv_pra.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icedyn_adv_pra.F90	(revision 12928)
@@ -16,4 +16,5 @@
    !!   adv_pra_rst     : read/write Prather field in ice restart file, or initialized to zero
    !!----------------------------------------------------------------------
+   USE phycst         ! physical constant
    USE dom_oce        ! ocean domain
    USE ice            ! sea-ice variables
@@ -39,5 +40,4 @@
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxsal, sysal, sxxsal, syysal, sxysal   ! ice salinity
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxage, syage, sxxage, syyage, sxyage   ! ice age
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxopw, syopw, sxxopw, syyopw, sxyopw   ! open water in sea ice
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   sxc0 , syc0 , sxxc0 , syyc0 , sxyc0    ! snow layers heat content
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   sxe  , sye  , sxxe  , syye  , sxye     ! ice layers heat content
@@ -46,5 +46,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/ICE 4.0 , NEMO Consortium (2018)
@@ -54,5 +54,5 @@
 CONTAINS
 
-   SUBROUTINE ice_dyn_adv_pra( kt, pu_ice, pv_ice,  &
+   SUBROUTINE ice_dyn_adv_pra(         kt, pu_ice, pv_ice, ph_i, ph_s, ph_ip,  &
       &                        pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i )
       !!----------------------------------------------------------------------
@@ -70,4 +70,7 @@
       REAL(wp), DIMENSION(:,:)    , INTENT(in   ) ::   pu_ice     ! ice i-velocity
       REAL(wp), DIMENSION(:,:)    , INTENT(in   ) ::   pv_ice     ! ice j-velocity
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   ph_i       ! ice thickness
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   ph_s       ! snw thickness
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   ph_ip      ! ice pond thickness
       REAL(wp), DIMENSION(:,:)    , INTENT(inout) ::   pato_i     ! open water area
       REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_i       ! ice volume
@@ -81,10 +84,12 @@
       REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_i       ! ice heat content
       !
-      INTEGER  ::   jk, jl, jt              ! dummy loop indices
+      INTEGER  ::   ji,jj, jk, jl, jt       ! dummy loop indices
       INTEGER  ::   icycle                  ! number of sub-timestep for the advection
       REAL(wp) ::   zdt                     !   -      -
       REAL(wp), DIMENSION(1)                  ::   zcflprv, zcflnow   ! for global communication
+      REAL(wp), DIMENSION(jpi,jpj)            ::   zati1, zati2
+      REAL(wp), DIMENSION(jpi,jpj)            ::   zudy, zvdx
+      REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   zhi_max, zhs_max, zhip_max
       REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   zarea
-      REAL(wp), DIMENSION(jpi,jpj,1)          ::   z0opw
       REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   z0ice, z0snw, z0ai, z0smi, z0oi
       REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   z0ap , z0vp
@@ -95,9 +100,28 @@
       IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_dyn_adv_pra: Prather advection scheme'
       !
+      ! --- Record max of the surrounding 9-pts ice thick. (for call Hbig) --- !
+      DO jl = 1, jpl
+         DO_2D_00_00
+            zhip_max(ji,jj,jl) = MAX( epsi20, ph_ip(ji,jj,jl), ph_ip(ji+1,jj  ,jl), ph_ip(ji  ,jj+1,jl), &
+               &                                               ph_ip(ji-1,jj  ,jl), ph_ip(ji  ,jj-1,jl), &
+               &                                               ph_ip(ji+1,jj+1,jl), ph_ip(ji-1,jj-1,jl), &
+               &                                               ph_ip(ji+1,jj-1,jl), ph_ip(ji-1,jj+1,jl) )
+            zhi_max (ji,jj,jl) = MAX( epsi20, ph_i (ji,jj,jl), ph_i (ji+1,jj  ,jl), ph_i (ji  ,jj+1,jl), &
+               &                                               ph_i (ji-1,jj  ,jl), ph_i (ji  ,jj-1,jl), &
+               &                                               ph_i (ji+1,jj+1,jl), ph_i (ji-1,jj-1,jl), &
+               &                                               ph_i (ji+1,jj-1,jl), ph_i (ji-1,jj+1,jl) )
+            zhs_max (ji,jj,jl) = MAX( epsi20, ph_s (ji,jj,jl), ph_s (ji+1,jj  ,jl), ph_s (ji  ,jj+1,jl), &
+               &                                               ph_s (ji-1,jj  ,jl), ph_s (ji  ,jj-1,jl), &
+               &                                               ph_s (ji+1,jj+1,jl), ph_s (ji-1,jj-1,jl), &
+               &                                               ph_s (ji+1,jj-1,jl), ph_s (ji-1,jj+1,jl) )
+         END_2D
+      END DO
+      CALL lbc_lnk_multi( 'icedyn_adv_pra', zhi_max, 'T', 1., zhs_max, 'T', 1., zhip_max, 'T', 1. )
+      !
       ! --- If ice drift is too fast, use  subtime steps for advection (CFL test for stability) --- !
       !        Note: the advection split is applied at the next time-step in order to avoid blocking global comm.
       !              this should not affect too much the stability
-      zcflnow(1) =                  MAXVAL( ABS( pu_ice(:,:) ) * rdt_ice * r1_e1u(:,:) )
-      zcflnow(1) = MAX( zcflnow(1), MAXVAL( ABS( pv_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) )
+      zcflnow(1) =                  MAXVAL( ABS( pu_ice(:,:) ) * rDt_ice * r1_e1u(:,:) )
+      zcflnow(1) = MAX( zcflnow(1), MAXVAL( ABS( pv_ice(:,:) ) * rDt_ice * r1_e2v(:,:) ) )
       
       ! non-blocking global communication send zcflnow and receive zcflprv
@@ -107,132 +131,142 @@
       ELSE                         ;   icycle = 1
       ENDIF
-      zdt = rdt_ice / REAL(icycle)
+      zdt = rDt_ice / REAL(icycle)
       
-      !-------------------------
-      ! transported fields                                        
-      !-------------------------
-      z0opw(:,:,1) = pato_i(:,:) * e1e2t(:,:)              ! Open water area 
-      DO jl = 1, jpl
-         zarea(:,:,jl) = e1e2t(:,:)
-         z0snw(:,:,jl) = pv_s (:,:,jl) * e1e2t(:,:)        ! Snow volume
-         z0ice(:,:,jl) = pv_i (:,:,jl) * e1e2t(:,:)        ! Ice  volume
-         z0ai (:,:,jl) = pa_i (:,:,jl) * e1e2t(:,:)        ! Ice area
-         z0smi(:,:,jl) = psv_i(:,:,jl) * e1e2t(:,:)        ! Salt content
-         z0oi (:,:,jl) = poa_i(:,:,jl) * e1e2t(:,:)        ! Age content
-         DO jk = 1, nlay_s
-            z0es(:,:,jk,jl) = pe_s(:,:,jk,jl) * e1e2t(:,:) ! Snow heat content
-         END DO
-         DO jk = 1, nlay_i
-            z0ei(:,:,jk,jl) = pe_i(:,:,jk,jl) * e1e2t(:,:) ! Ice  heat content
-         END DO
-         IF ( ln_pnd_H12 ) THEN
-            z0ap(:,:,jl)  = pa_ip(:,:,jl) * e1e2t(:,:)     ! Melt pond fraction
-            z0vp(:,:,jl)  = pv_ip(:,:,jl) * e1e2t(:,:)     ! Melt pond volume
-         ENDIF
-      END DO
-
-      !                                                    !--------------------------------------------!
-      IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0 ) THEN       !==  odd ice time step:  adv_x then adv_y  ==!
-         !                                                 !--------------------------------------------!
-         DO jt = 1, icycle
-            CALL adv_x( zdt , pu_ice , 1._wp , zarea , z0opw , sxopw , sxxopw , syopw , syyopw , sxyopw ) !--- open water
-            CALL adv_y( zdt , pv_ice , 0._wp , zarea , z0opw , sxopw , sxxopw , syopw , syyopw , sxyopw )
-            CALL adv_x( zdt , pu_ice , 1._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) !--- ice volume
-            CALL adv_y( zdt , pv_ice , 0._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice )
-            CALL adv_x( zdt , pu_ice , 1._wp , zarea , z0snw , sxsn  , sxxsn  , sysn  , syysn  , sxysn  ) !--- snow volume
-            CALL adv_y( zdt , pv_ice , 0._wp , zarea , z0snw , sxsn  , sxxsn  , sysn  , syysn  , sxysn  )
-            CALL adv_x( zdt , pu_ice , 1._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) !--- ice salinity
-            CALL adv_y( zdt , pv_ice , 0._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal )
-            CALL adv_x( zdt , pu_ice , 1._wp , zarea , z0ai  , sxa   , sxxa   , sya   , syya   , sxya   ) !--- ice concentration
-            CALL adv_y( zdt , pv_ice , 0._wp , zarea , z0ai  , sxa   , sxxa   , sya   , syya   , sxya   )
-            CALL adv_x( zdt , pu_ice , 1._wp , zarea , z0oi  , sxage , sxxage , syage , syyage , sxyage ) !--- ice age
-            CALL adv_y( zdt , pv_ice , 0._wp , zarea , z0oi  , sxage , sxxage , syage , syyage , sxyage )
-            !
-            DO jk = 1, nlay_s                                                                             !--- snow heat content
-               CALL adv_x( zdt, pu_ice, 1._wp, zarea, z0es (:,:,jk,:), sxc0(:,:,jk,:),   &
-                  &                                   sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) )
-               CALL adv_y( zdt, pv_ice, 0._wp, zarea, z0es (:,:,jk,:), sxc0(:,:,jk,:),   &
-                  &                                   sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) )
+      ! --- transport --- !
+      zudy(:,:) = pu_ice(:,:) * e2u(:,:)
+      zvdx(:,:) = pv_ice(:,:) * e1v(:,:)
+
+      DO jt = 1, icycle
+
+         ! record at_i before advection (for open water)
+         zati1(:,:) = SUM( pa_i(:,:,:), dim=3 )
+         
+         ! --- transported fields --- !                                        
+         DO jl = 1, jpl
+            zarea(:,:,jl) = e1e2t(:,:)
+            z0snw(:,:,jl) = pv_s (:,:,jl) * e1e2t(:,:)        ! Snow volume
+            z0ice(:,:,jl) = pv_i (:,:,jl) * e1e2t(:,:)        ! Ice  volume
+            z0ai (:,:,jl) = pa_i (:,:,jl) * e1e2t(:,:)        ! Ice area
+            z0smi(:,:,jl) = psv_i(:,:,jl) * e1e2t(:,:)        ! Salt content
+            z0oi (:,:,jl) = poa_i(:,:,jl) * e1e2t(:,:)        ! Age content
+            DO jk = 1, nlay_s
+               z0es(:,:,jk,jl) = pe_s(:,:,jk,jl) * e1e2t(:,:) ! Snow heat content
             END DO
-            DO jk = 1, nlay_i                                                                             !--- ice heat content
-               CALL adv_x( zdt, pu_ice, 1._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:),   & 
-                  &                                   sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) )
-               CALL adv_y( zdt, pv_ice, 0._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:),   & 
-                  &                                   sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) )
+            DO jk = 1, nlay_i
+               z0ei(:,:,jk,jl) = pe_i(:,:,jk,jl) * e1e2t(:,:) ! Ice  heat content
             END DO
-            !
             IF ( ln_pnd_H12 ) THEN
-               CALL adv_x( zdt , pu_ice , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap )    !--- melt pond fraction
-               CALL adv_y( zdt , pv_ice , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) 
-               CALL adv_x( zdt , pu_ice , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp )    !--- melt pond volume
-               CALL adv_y( zdt , pv_ice , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) 
+               z0ap(:,:,jl)  = pa_ip(:,:,jl) * e1e2t(:,:)     ! Melt pond fraction
+               z0vp(:,:,jl)  = pv_ip(:,:,jl) * e1e2t(:,:)     ! Melt pond volume
             ENDIF
          END DO
-      !                                                    !--------------------------------------------!
-      ELSE                                                 !== even ice time step:  adv_y then adv_x  ==!
-         !                                                 !--------------------------------------------!
-         DO jt = 1, icycle
-            CALL adv_y( zdt , pv_ice , 1._wp , zarea , z0opw , sxopw , sxxopw , syopw , syyopw , sxyopw ) !--- open water
-            CALL adv_x( zdt , pu_ice , 0._wp , zarea , z0opw , sxopw , sxxopw , syopw , syyopw , sxyopw )
-            CALL adv_y( zdt , pv_ice , 1._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) !--- ice volume
-            CALL adv_x( zdt , pu_ice , 0._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice )
-            CALL adv_y( zdt , pv_ice , 1._wp , zarea , z0snw , sxsn  , sxxsn  , sysn  , syysn  , sxysn  ) !--- snow volume
-            CALL adv_x( zdt , pu_ice , 0._wp , zarea , z0snw , sxsn  , sxxsn  , sysn  , syysn  , sxysn  )
-            CALL adv_y( zdt , pv_ice , 1._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) !--- ice salinity
-            CALL adv_x( zdt , pu_ice , 0._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal )
-            CALL adv_y( zdt , pv_ice , 1._wp , zarea , z0ai  , sxa   , sxxa   , sya   , syya   , sxya   ) !--- ice concentration
-            CALL adv_x( zdt , pu_ice , 0._wp , zarea , z0ai  , sxa   , sxxa   , sya   , syya   , sxya   )
-            CALL adv_y( zdt , pv_ice , 1._wp , zarea , z0oi  , sxage , sxxage , syage , syyage , sxyage ) !--- ice age
-            CALL adv_x( zdt , pu_ice , 0._wp , zarea , z0oi  , sxage , sxxage , syage , syyage , sxyage )
-            DO jk = 1, nlay_s                                                                             !--- snow heat content
-               CALL adv_y( zdt, pv_ice, 1._wp, zarea, z0es (:,:,jk,:), sxc0(:,:,jk,:),   &
-                  &                                   sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) )
-               CALL adv_x( zdt, pu_ice, 0._wp, zarea, z0es (:,:,jk,:), sxc0(:,:,jk,:),   &
-                  &                                   sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) )
+         !
+         !                                                                  !--------------------------------------------!
+         IF( MOD( (kt - 1) / nn_fsbc , 2 ) ==  MOD( (jt - 1) , 2 ) ) THEN   !==  odd ice time step:  adv_x then adv_y  ==!
+            !                                                               !--------------------------------------------!
+            CALL adv_x( zdt , zudy , 1._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) !--- ice volume
+            CALL adv_y( zdt , zvdx , 0._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice )
+            CALL adv_x( zdt , zudy , 1._wp , zarea , z0snw , sxsn  , sxxsn  , sysn  , syysn  , sxysn  ) !--- snow volume
+            CALL adv_y( zdt , zvdx , 0._wp , zarea , z0snw , sxsn  , sxxsn  , sysn  , syysn  , sxysn  )
+            CALL adv_x( zdt , zudy , 1._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) !--- ice salinity
+            CALL adv_y( zdt , zvdx , 0._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal )
+            CALL adv_x( zdt , zudy , 1._wp , zarea , z0ai  , sxa   , sxxa   , sya   , syya   , sxya   ) !--- ice concentration
+            CALL adv_y( zdt , zvdx , 0._wp , zarea , z0ai  , sxa   , sxxa   , sya   , syya   , sxya   )
+            CALL adv_x( zdt , zudy , 1._wp , zarea , z0oi  , sxage , sxxage , syage , syyage , sxyage ) !--- ice age
+            CALL adv_y( zdt , zvdx , 0._wp , zarea , z0oi  , sxage , sxxage , syage , syyage , sxyage )
+            !
+            DO jk = 1, nlay_s                                                                           !--- snow heat content
+               CALL adv_x( zdt, zudy, 1._wp, zarea, z0es (:,:,jk,:), sxc0(:,:,jk,:),   &
+                  &                                 sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) )
+               CALL adv_y( zdt, zvdx, 0._wp, zarea, z0es (:,:,jk,:), sxc0(:,:,jk,:),   &
+                  &                                 sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) )
             END DO
-            DO jk = 1, nlay_i                                                                             !--- ice heat content
-               CALL adv_y( zdt, pv_ice, 1._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:),   & 
-                  &                                   sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) )
-               CALL adv_x( zdt, pu_ice, 0._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:),   & 
-                  &                                   sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) )
+            DO jk = 1, nlay_i                                                                           !--- ice heat content
+               CALL adv_x( zdt, zudy, 1._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:),   & 
+                  &                                 sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) )
+               CALL adv_y( zdt, zvdx, 0._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:),   & 
+                  &                                 sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) )
+            END DO
+            !
+            IF ( ln_pnd_H12 ) THEN
+               CALL adv_x( zdt , zudy , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap )    !--- melt pond fraction
+               CALL adv_y( zdt , zvdx , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) 
+               CALL adv_x( zdt , zudy , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp )    !--- melt pond volume
+               CALL adv_y( zdt , zvdx , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) 
+            ENDIF
+            !                                                               !--------------------------------------------!
+         ELSE                                                               !== even ice time step:  adv_y then adv_x  ==!
+            !                                                               !--------------------------------------------!
+            CALL adv_y( zdt , zvdx , 1._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) !--- ice volume
+            CALL adv_x( zdt , zudy , 0._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice )
+            CALL adv_y( zdt , zvdx , 1._wp , zarea , z0snw , sxsn  , sxxsn  , sysn  , syysn  , sxysn  ) !--- snow volume
+            CALL adv_x( zdt , zudy , 0._wp , zarea , z0snw , sxsn  , sxxsn  , sysn  , syysn  , sxysn  )
+            CALL adv_y( zdt , zvdx , 1._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) !--- ice salinity
+            CALL adv_x( zdt , zudy , 0._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal )
+            CALL adv_y( zdt , zvdx , 1._wp , zarea , z0ai  , sxa   , sxxa   , sya   , syya   , sxya   ) !--- ice concentration
+            CALL adv_x( zdt , zudy , 0._wp , zarea , z0ai  , sxa   , sxxa   , sya   , syya   , sxya   )
+            CALL adv_y( zdt , zvdx , 1._wp , zarea , z0oi  , sxage , sxxage , syage , syyage , sxyage ) !--- ice age
+            CALL adv_x( zdt , zudy , 0._wp , zarea , z0oi  , sxage , sxxage , syage , syyage , sxyage )
+            DO jk = 1, nlay_s                                                                           !--- snow heat content
+               CALL adv_y( zdt, zvdx, 1._wp, zarea, z0es (:,:,jk,:), sxc0(:,:,jk,:),   &
+                  &                                 sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) )
+               CALL adv_x( zdt, zudy, 0._wp, zarea, z0es (:,:,jk,:), sxc0(:,:,jk,:),   &
+                  &                                 sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) )
+            END DO
+            DO jk = 1, nlay_i                                                                           !--- ice heat content
+               CALL adv_y( zdt, zvdx, 1._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:),   & 
+                  &                                 sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) )
+               CALL adv_x( zdt, zudy, 0._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:),   & 
+                  &                                 sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) )
             END DO
             IF ( ln_pnd_H12 ) THEN
-               CALL adv_y( zdt , pv_ice , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap )    !--- melt pond fraction
-               CALL adv_x( zdt , pu_ice , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap )
-               CALL adv_y( zdt , pv_ice , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp )    !--- melt pond volume
-               CALL adv_x( zdt , pu_ice , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp )
+               CALL adv_y( zdt , zvdx , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap )    !--- melt pond fraction
+               CALL adv_x( zdt , zudy , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap )
+               CALL adv_y( zdt , zvdx , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp )    !--- melt pond volume
+               CALL adv_x( zdt , zudy , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp )
+            ENDIF
+            !
+         ENDIF
+
+         ! --- Recover the properties from their contents --- !
+         DO jl = 1, jpl
+            pv_i (:,:,jl) = z0ice(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1)
+            pv_s (:,:,jl) = z0snw(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1)
+            psv_i(:,:,jl) = z0smi(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1)
+            poa_i(:,:,jl) = z0oi (:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1)
+            pa_i (:,:,jl) = z0ai (:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1)
+            DO jk = 1, nlay_s
+               pe_s(:,:,jk,jl) = z0es(:,:,jk,jl) * r1_e1e2t(:,:) * tmask(:,:,1)
+            END DO
+            DO jk = 1, nlay_i
+               pe_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e1e2t(:,:) * tmask(:,:,1)
+            END DO
+            IF ( ln_pnd_H12 ) THEN
+               pa_ip(:,:,jl) = z0ap(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1)
+               pv_ip(:,:,jl) = z0vp(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1)
             ENDIF
          END DO
-      ENDIF
-
-      !-------------------------------------------
-      ! Recover the properties from their contents
-      !-------------------------------------------
-      pato_i(:,:) = z0opw(:,:,1) * r1_e1e2t(:,:) * tmask(:,:,1)
-      DO jl = 1, jpl
-         pv_i (:,:,jl) = z0ice(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1)
-         pv_s (:,:,jl) = z0snw(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1)
-         psv_i(:,:,jl) = z0smi(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1)
-         poa_i(:,:,jl) = z0oi (:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1)
-         pa_i (:,:,jl) = z0ai (:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1)
-         DO jk = 1, nlay_s
-            pe_s(:,:,jk,jl) = z0es(:,:,jk,jl) * r1_e1e2t(:,:) * tmask(:,:,1)
-         END DO
-         DO jk = 1, nlay_i
-            pe_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e1e2t(:,:) * tmask(:,:,1)
-         END DO
-         IF ( ln_pnd_H12 ) THEN
-            pa_ip(:,:,jl) = z0ap(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1)
-            pv_ip(:,:,jl) = z0vp(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1)
-         ENDIF
+         !
+         ! derive open water from ice concentration
+         zati2(:,:) = SUM( pa_i(:,:,:), dim=3 )
+         DO_2D_00_00
+            pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) &                        !--- open water
+               &                          - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt
+         END_2D
+         CALL lbc_lnk( 'icedyn_adv_pra', pato_i, 'T',  1. )
+         !
+         ! --- Ensure non-negative fields --- !
+         !     Remove negative values (conservation is ensured)
+         !     (because advected fields are not perfectly bounded and tiny negative values can occur, e.g. -1.e-20)
+         CALL ice_var_zapneg( zdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i )
+         !
+         ! --- Make sure ice thickness is not too big --- !
+         !     (because ice thickness can be too large where ice concentration is very small)
+         CALL Hbig( zdt, zhi_max, zhs_max, zhip_max, pv_i, pv_s, pa_i, pa_ip, pv_ip, pe_s )
+         !
+         ! --- Ensure snow load is not too big --- !
+         CALL Hsnow( zdt, pv_i, pv_s, pa_i, pa_ip, pe_s )
+         !
       END DO
-      !
-      ! --- Ensure non-negative fields --- !
-      !     Remove negative values (conservation is ensured)
-      !     (because advected fields are not perfectly bounded and tiny negative values can occur, e.g. -1.e-20)
-      CALL ice_var_zapneg( zdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i )
-      !
-      ! --- Ensure snow load is not too big --- !
-      CALL Hsnow( zdt, pv_i, pv_s, pa_i, pa_ip, pe_s )
       !
       IF( lrst_ice )   CALL adv_pra_rst( 'WRITE', kt )   !* write Prather fields in the restart file
@@ -271,132 +305,120 @@
          !
          ! Limitation of moments.                                           
-         DO jj = 2, jpjm1
-            DO ji = 1, jpi
-               !  Initialize volumes of boxes  (=area if adv_x first called, =psm otherwise)                                     
-               psm (ji,jj,jl) = MAX( pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20 )
-               !
-               zslpmax = MAX( 0._wp, ps0(ji,jj,jl) )
-               zs1max  = 1.5 * zslpmax
-               zs1new  = MIN( zs1max, MAX( -zs1max, psx(ji,jj,jl) ) )
-               zs2new  = MIN(  2.0 * zslpmax - 0.3334 * ABS( zs1new ),      &
-                  &            MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj,jl) )  )
-               rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask
-
-               ps0 (ji,jj,jl) = zslpmax  
-               psx (ji,jj,jl) = zs1new         * rswitch
-               psxx(ji,jj,jl) = zs2new         * rswitch
-               psy (ji,jj,jl) = psy (ji,jj,jl) * rswitch
-               psyy(ji,jj,jl) = psyy(ji,jj,jl) * rswitch
-               psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch
-            END DO
-         END DO
+         DO_2D_00_11
+            !  Initialize volumes of boxes  (=area if adv_x first called, =psm otherwise)                                     
+            psm (ji,jj,jl) = MAX( pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20 )
+            !
+            zslpmax = MAX( 0._wp, ps0(ji,jj,jl) )
+            zs1max  = 1.5 * zslpmax
+            zs1new  = MIN( zs1max, MAX( -zs1max, psx(ji,jj,jl) ) )
+            zs2new  = MIN(  2.0 * zslpmax - 0.3334 * ABS( zs1new ),      &
+               &            MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj,jl) )  )
+            rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask
+
+            ps0 (ji,jj,jl) = zslpmax  
+            psx (ji,jj,jl) = zs1new         * rswitch
+            psxx(ji,jj,jl) = zs2new         * rswitch
+            psy (ji,jj,jl) = psy (ji,jj,jl) * rswitch
+            psyy(ji,jj,jl) = psyy(ji,jj,jl) * rswitch
+            psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch
+         END_2D
 
          !  Calculate fluxes and moments between boxes i<-->i+1              
-         DO jj = 2, jpjm1                      !  Flux from i to i+1 WHEN u GT 0 
-            DO ji = 1, jpi
-               zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) )
-               zalf         =  MAX( 0._wp, put(ji,jj) ) * pdt * e2u(ji,jj) / psm(ji,jj,jl)
-               zalfq        =  zalf * zalf
-               zalf1        =  1.0 - zalf
-               zalf1q       =  zalf1 * zalf1
-               !
-               zfm (ji,jj)  =  zalf  *   psm (ji,jj,jl)
-               zf0 (ji,jj)  =  zalf  * ( ps0 (ji,jj,jl) + zalf1 * ( psx(ji,jj,jl) + (zalf1 - zalf) * psxx(ji,jj,jl) ) )
-               zfx (ji,jj)  =  zalfq * ( psx (ji,jj,jl) + 3.0 * zalf1 * psxx(ji,jj,jl) )
-               zfxx(ji,jj)  =  zalf  *   psxx(ji,jj,jl) * zalfq
-               zfy (ji,jj)  =  zalf  * ( psy (ji,jj,jl) + zalf1 * psxy(ji,jj,jl) )
-               zfxy(ji,jj)  =  zalfq *   psxy(ji,jj,jl)
-               zfyy(ji,jj)  =  zalf  *   psyy(ji,jj,jl)
-
-               !  Readjust moments remaining in the box.
-               psm (ji,jj,jl)  =  psm (ji,jj,jl) - zfm(ji,jj)
-               ps0 (ji,jj,jl)  =  ps0 (ji,jj,jl) - zf0(ji,jj)
-               psx (ji,jj,jl)  =  zalf1q * ( psx(ji,jj,jl) - 3.0 * zalf * psxx(ji,jj,jl) )
-               psxx(ji,jj,jl)  =  zalf1  * zalf1q * psxx(ji,jj,jl)
-               psy (ji,jj,jl)  =  psy (ji,jj,jl) - zfy(ji,jj)
-               psyy(ji,jj,jl)  =  psyy(ji,jj,jl) - zfyy(ji,jj)
-               psxy(ji,jj,jl)  =  zalf1q * psxy(ji,jj,jl)
-            END DO
-         END DO
-
-         DO jj = 2, jpjm1                      !  Flux from i+1 to i when u LT 0.
-            DO ji = 1, fs_jpim1
-               zalf          = MAX( 0._wp, -put(ji,jj) ) * pdt * e2u(ji,jj) / psm(ji+1,jj,jl) 
-               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,jl)
-               zf0   (ji,jj) = zf0 (ji,jj) + zalf  * (  ps0 (ji+1,jj,jl) &
-                  &                                   - zalf1 * ( psx(ji+1,jj,jl) - (zalf1 - zalf ) * psxx(ji+1,jj,jl) ) )
-               zfx   (ji,jj) = zfx (ji,jj) + zalfq * (  psx (ji+1,jj,jl) - 3.0 * zalf1 * psxx(ji+1,jj,jl) )
-               zfxx  (ji,jj) = zfxx(ji,jj) + zalf  *    psxx(ji+1,jj,jl) * zalfq
-               zfy   (ji,jj) = zfy (ji,jj) + zalf  * (  psy (ji+1,jj,jl) - zalf1 * psxy(ji+1,jj,jl) )
-               zfxy  (ji,jj) = zfxy(ji,jj) + zalfq *    psxy(ji+1,jj,jl)
-               zfyy  (ji,jj) = zfyy(ji,jj) + zalf  *    psyy(ji+1,jj,jl)
-            END DO
-         END DO
-
-         DO jj = 2, jpjm1                     !  Readjust moments remaining in the box. 
-            DO ji = fs_2, fs_jpim1
-               zbt  =       zbet(ji-1,jj)
-               zbt1 = 1.0 - zbet(ji-1,jj)
-               !
-               psm (ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) - zfm(ji-1,jj) )
-               ps0 (ji,jj,jl) = zbt * ps0(ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) - zf0(ji-1,jj) )
-               psx (ji,jj,jl) = zalg1q(ji-1,jj) * ( psx(ji,jj,jl) + 3.0 * zalg(ji-1,jj) * psxx(ji,jj,jl) )
-               psxx(ji,jj,jl) = zalg1 (ji-1,jj) * zalg1q(ji-1,jj) * psxx(ji,jj,jl)
-               psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( psy (ji,jj,jl) - zfy (ji-1,jj) )
-               psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) - zfyy(ji-1,jj) )
-               psxy(ji,jj,jl) = zalg1q(ji-1,jj) * psxy(ji,jj,jl)
-            END DO
-         END DO
+         DO_2D_00_11
+            zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) )
+            zalf         =  MAX( 0._wp, put(ji,jj) ) * pdt / psm(ji,jj,jl)
+            zalfq        =  zalf * zalf
+            zalf1        =  1.0 - zalf
+            zalf1q       =  zalf1 * zalf1
+            !
+            zfm (ji,jj)  =  zalf  *   psm (ji,jj,jl)
+            zf0 (ji,jj)  =  zalf  * ( ps0 (ji,jj,jl) + zalf1 * ( psx(ji,jj,jl) + (zalf1 - zalf) * psxx(ji,jj,jl) ) )
+            zfx (ji,jj)  =  zalfq * ( psx (ji,jj,jl) + 3.0 * zalf1 * psxx(ji,jj,jl) )
+            zfxx(ji,jj)  =  zalf  *   psxx(ji,jj,jl) * zalfq
+            zfy (ji,jj)  =  zalf  * ( psy (ji,jj,jl) + zalf1 * psxy(ji,jj,jl) )
+            zfxy(ji,jj)  =  zalfq *   psxy(ji,jj,jl)
+            zfyy(ji,jj)  =  zalf  *   psyy(ji,jj,jl)
+
+            !  Readjust moments remaining in the box.
+            psm (ji,jj,jl)  =  psm (ji,jj,jl) - zfm(ji,jj)
+            ps0 (ji,jj,jl)  =  ps0 (ji,jj,jl) - zf0(ji,jj)
+            psx (ji,jj,jl)  =  zalf1q * ( psx(ji,jj,jl) - 3.0 * zalf * psxx(ji,jj,jl) )
+            psxx(ji,jj,jl)  =  zalf1  * zalf1q * psxx(ji,jj,jl)
+            psy (ji,jj,jl)  =  psy (ji,jj,jl) - zfy(ji,jj)
+            psyy(ji,jj,jl)  =  psyy(ji,jj,jl) - zfyy(ji,jj)
+            psxy(ji,jj,jl)  =  zalf1q * psxy(ji,jj,jl)
+         END_2D
+
+         DO_2D_00_10
+            zalf          = MAX( 0._wp, -put(ji,jj) ) * pdt / psm(ji+1,jj,jl) 
+            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,jl)
+            zf0   (ji,jj) = zf0 (ji,jj) + zalf  * (  ps0 (ji+1,jj,jl) &
+               &                                   - zalf1 * ( psx(ji+1,jj,jl) - (zalf1 - zalf ) * psxx(ji+1,jj,jl) ) )
+            zfx   (ji,jj) = zfx (ji,jj) + zalfq * (  psx (ji+1,jj,jl) - 3.0 * zalf1 * psxx(ji+1,jj,jl) )
+            zfxx  (ji,jj) = zfxx(ji,jj) + zalf  *    psxx(ji+1,jj,jl) * zalfq
+            zfy   (ji,jj) = zfy (ji,jj) + zalf  * (  psy (ji+1,jj,jl) - zalf1 * psxy(ji+1,jj,jl) )
+            zfxy  (ji,jj) = zfxy(ji,jj) + zalfq *    psxy(ji+1,jj,jl)
+            zfyy  (ji,jj) = zfyy(ji,jj) + zalf  *    psyy(ji+1,jj,jl)
+         END_2D
+
+         DO_2D_00_00
+            zbt  =       zbet(ji-1,jj)
+            zbt1 = 1.0 - zbet(ji-1,jj)
+            !
+            psm (ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) - zfm(ji-1,jj) )
+            ps0 (ji,jj,jl) = zbt * ps0(ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) - zf0(ji-1,jj) )
+            psx (ji,jj,jl) = zalg1q(ji-1,jj) * ( psx(ji,jj,jl) + 3.0 * zalg(ji-1,jj) * psxx(ji,jj,jl) )
+            psxx(ji,jj,jl) = zalg1 (ji-1,jj) * zalg1q(ji-1,jj) * psxx(ji,jj,jl)
+            psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( psy (ji,jj,jl) - zfy (ji-1,jj) )
+            psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) - zfyy(ji-1,jj) )
+            psxy(ji,jj,jl) = zalg1q(ji-1,jj) * psxy(ji,jj,jl)
+         END_2D
 
          !   Put the temporary moments into appropriate neighboring boxes.    
-         DO jj = 2, jpjm1                     !   Flux from i to i+1 IF u GT 0.
-            DO ji = fs_2, fs_jpim1
-               zbt  =       zbet(ji-1,jj)
-               zbt1 = 1.0 - zbet(ji-1,jj)
-               psm(ji,jj,jl) = zbt * ( psm(ji,jj,jl) + zfm(ji-1,jj) ) + zbt1 * psm(ji,jj,jl)
-               zalf          = zbt * zfm(ji-1,jj) / psm(ji,jj,jl)
-               zalf1         = 1.0 - zalf
-               ztemp         = zalf * ps0(ji,jj,jl) - zalf1 * zf0(ji-1,jj)
-               !
-               ps0 (ji,jj,jl) =  zbt  * ( ps0(ji,jj,jl) + zf0(ji-1,jj) ) + zbt1 * ps0(ji,jj,jl)
-               psx (ji,jj,jl) =  zbt  * ( zalf * zfx(ji-1,jj) + zalf1 * psx(ji,jj,jl) + 3.0 * ztemp ) + zbt1 * psx(ji,jj,jl)
-               psxx(ji,jj,jl) =  zbt  * ( zalf * zalf * zfxx(ji-1,jj) + zalf1 * zalf1 * psxx(ji,jj,jl)                             &
-                  &                     + 5.0 * ( zalf * zalf1 * ( psx (ji,jj,jl) - zfx(ji-1,jj) ) - ( zalf1 - zalf ) * ztemp )  ) &
-                  &            + zbt1 * psxx(ji,jj,jl)
-               psxy(ji,jj,jl) =  zbt  * ( zalf * zfxy(ji-1,jj) + zalf1 * psxy(ji,jj,jl)             &
-                  &                     + 3.0 * (- zalf1*zfy(ji-1,jj)  + zalf * psy(ji,jj,jl) ) )   &
-                  &            + zbt1 * psxy(ji,jj,jl)
-               psy (ji,jj,jl) =  zbt  * ( psy (ji,jj,jl) + zfy (ji-1,jj) ) + zbt1 * psy (ji,jj,jl)
-               psyy(ji,jj,jl) =  zbt  * ( psyy(ji,jj,jl) + zfyy(ji-1,jj) ) + zbt1 * psyy(ji,jj,jl)
-            END DO
-         END DO
-
-         DO jj = 2, jpjm1                      !  Flux from i+1 to i IF u LT 0.
-            DO ji = fs_2, fs_jpim1
-               zbt  =       zbet(ji,jj)
-               zbt1 = 1.0 - zbet(ji,jj)
-               psm(ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) + zfm(ji,jj) )
-               zalf          = zbt1 * zfm(ji,jj) / psm(ji,jj,jl)
-               zalf1         = 1.0 - zalf
-               ztemp         = - zalf * ps0(ji,jj,jl) + zalf1 * zf0(ji,jj)
-               !
-               ps0 (ji,jj,jl) = zbt * ps0 (ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) + zf0(ji,jj) )
-               psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( zalf * zfx(ji,jj) + zalf1 * psx(ji,jj,jl) + 3.0 * ztemp )
-               psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( zalf * zalf * zfxx(ji,jj) + zalf1 * zalf1 * psxx(ji,jj,jl) &
-                  &                                           + 5.0 * ( zalf * zalf1 * ( - psx(ji,jj,jl) + zfx(ji,jj) )    &
-                  &                                           + ( zalf1 - zalf ) * ztemp ) )
-               psxy(ji,jj,jl) = zbt * psxy(ji,jj,jl) + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj,jl)  &
-                  &                                           + 3.0 * ( zalf1 * zfy(ji,jj) - zalf * psy(ji,jj,jl) ) )
-               psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( psy (ji,jj,jl) + zfy (ji,jj) )
-               psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) + zfyy(ji,jj) )
-            END DO
-         END DO
+         DO_2D_00_00
+            zbt  =       zbet(ji-1,jj)
+            zbt1 = 1.0 - zbet(ji-1,jj)
+            psm(ji,jj,jl) = zbt * ( psm(ji,jj,jl) + zfm(ji-1,jj) ) + zbt1 * psm(ji,jj,jl)
+            zalf          = zbt * zfm(ji-1,jj) / psm(ji,jj,jl)
+            zalf1         = 1.0 - zalf
+            ztemp         = zalf * ps0(ji,jj,jl) - zalf1 * zf0(ji-1,jj)
+            !
+            ps0 (ji,jj,jl) =  zbt  * ( ps0(ji,jj,jl) + zf0(ji-1,jj) ) + zbt1 * ps0(ji,jj,jl)
+            psx (ji,jj,jl) =  zbt  * ( zalf * zfx(ji-1,jj) + zalf1 * psx(ji,jj,jl) + 3.0 * ztemp ) + zbt1 * psx(ji,jj,jl)
+            psxx(ji,jj,jl) =  zbt  * ( zalf * zalf * zfxx(ji-1,jj) + zalf1 * zalf1 * psxx(ji,jj,jl)                             &
+               &                     + 5.0 * ( zalf * zalf1 * ( psx (ji,jj,jl) - zfx(ji-1,jj) ) - ( zalf1 - zalf ) * ztemp )  ) &
+               &            + zbt1 * psxx(ji,jj,jl)
+            psxy(ji,jj,jl) =  zbt  * ( zalf * zfxy(ji-1,jj) + zalf1 * psxy(ji,jj,jl)             &
+               &                     + 3.0 * (- zalf1*zfy(ji-1,jj)  + zalf * psy(ji,jj,jl) ) )   &
+               &            + zbt1 * psxy(ji,jj,jl)
+            psy (ji,jj,jl) =  zbt  * ( psy (ji,jj,jl) + zfy (ji-1,jj) ) + zbt1 * psy (ji,jj,jl)
+            psyy(ji,jj,jl) =  zbt  * ( psyy(ji,jj,jl) + zfyy(ji-1,jj) ) + zbt1 * psyy(ji,jj,jl)
+         END_2D
+
+         DO_2D_00_00
+            zbt  =       zbet(ji,jj)
+            zbt1 = 1.0 - zbet(ji,jj)
+            psm(ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) + zfm(ji,jj) )
+            zalf          = zbt1 * zfm(ji,jj) / psm(ji,jj,jl)
+            zalf1         = 1.0 - zalf
+            ztemp         = - zalf * ps0(ji,jj,jl) + zalf1 * zf0(ji,jj)
+            !
+            ps0 (ji,jj,jl) = zbt * ps0 (ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) + zf0(ji,jj) )
+            psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( zalf * zfx(ji,jj) + zalf1 * psx(ji,jj,jl) + 3.0 * ztemp )
+            psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( zalf * zalf * zfxx(ji,jj) + zalf1 * zalf1 * psxx(ji,jj,jl) &
+               &                                           + 5.0 * ( zalf * zalf1 * ( - psx(ji,jj,jl) + zfx(ji,jj) )    &
+               &                                           + ( zalf1 - zalf ) * ztemp ) )
+            psxy(ji,jj,jl) = zbt * psxy(ji,jj,jl) + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj,jl)  &
+               &                                           + 3.0 * ( zalf1 * zfy(ji,jj) - zalf * psy(ji,jj,jl) ) )
+            psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( psy (ji,jj,jl) + zfy (ji,jj) )
+            psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) + zfyy(ji,jj) )
+         END_2D
 
       END DO
@@ -440,134 +462,122 @@
          !
          ! Limitation of moments.
-         DO jj = 1, jpj
-            DO ji = fs_2, fs_jpim1
-               !  Initialize volumes of boxes (=area if adv_x first called, =psm otherwise)
-               psm(ji,jj,jl) = MAX(  pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20  )
-               !
-               zslpmax = MAX( 0._wp, ps0(ji,jj,jl) )
-               zs1max  = 1.5 * zslpmax
-               zs1new  = MIN( zs1max, MAX( -zs1max, psy(ji,jj,jl) ) )
-               zs2new  = MIN(  ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ),   &
-                  &             MAX( ABS( zs1new )-zslpmax, psyy(ji,jj,jl) )  )
-               rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask
-               !
-               ps0 (ji,jj,jl) = zslpmax  
-               psx (ji,jj,jl) = psx (ji,jj,jl) * rswitch
-               psxx(ji,jj,jl) = psxx(ji,jj,jl) * rswitch
-               psy (ji,jj,jl) = zs1new         * rswitch
-               psyy(ji,jj,jl) = zs2new         * rswitch
-               psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch
-            END DO
-         END DO
+         DO_2D_11_00
+            !  Initialize volumes of boxes (=area if adv_x first called, =psm otherwise)
+            psm(ji,jj,jl) = MAX(  pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20  )
+            !
+            zslpmax = MAX( 0._wp, ps0(ji,jj,jl) )
+            zs1max  = 1.5 * zslpmax
+            zs1new  = MIN( zs1max, MAX( -zs1max, psy(ji,jj,jl) ) )
+            zs2new  = MIN(  ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ),   &
+               &             MAX( ABS( zs1new )-zslpmax, psyy(ji,jj,jl) )  )
+            rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask
+            !
+            ps0 (ji,jj,jl) = zslpmax  
+            psx (ji,jj,jl) = psx (ji,jj,jl) * rswitch
+            psxx(ji,jj,jl) = psxx(ji,jj,jl) * rswitch
+            psy (ji,jj,jl) = zs1new         * rswitch
+            psyy(ji,jj,jl) = zs2new         * rswitch
+            psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch
+         END_2D
  
          !  Calculate fluxes and moments between boxes j<-->j+1              
-         DO jj = 1, jpj                     !  Flux from j to j+1 WHEN v GT 0   
-            DO ji = fs_2, fs_jpim1
-               zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) )
-               zalf         =  MAX( 0._wp, pvt(ji,jj) ) * pdt * e1v(ji,jj) / psm(ji,jj,jl)
-               zalfq        =  zalf * zalf
-               zalf1        =  1.0 - zalf
-               zalf1q       =  zalf1 * zalf1
-               !
-               zfm (ji,jj)  =  zalf  * psm(ji,jj,jl)
-               zf0 (ji,jj)  =  zalf  * ( ps0(ji,jj,jl) + zalf1 * ( psy(ji,jj,jl)  + (zalf1-zalf) * psyy(ji,jj,jl) ) ) 
-               zfy (ji,jj)  =  zalfq *( psy(ji,jj,jl) + 3.0*zalf1*psyy(ji,jj,jl) )
-               zfyy(ji,jj)  =  zalf  * zalfq * psyy(ji,jj,jl)
-               zfx (ji,jj)  =  zalf  * ( psx(ji,jj,jl) + zalf1 * psxy(ji,jj,jl) )
-               zfxy(ji,jj)  =  zalfq * psxy(ji,jj,jl)
-               zfxx(ji,jj)  =  zalf  * psxx(ji,jj,jl)
-               !
-               !  Readjust moments remaining in the box.
-               psm (ji,jj,jl)  =  psm (ji,jj,jl) - zfm(ji,jj)
-               ps0 (ji,jj,jl)  =  ps0 (ji,jj,jl) - zf0(ji,jj)
-               psy (ji,jj,jl)  =  zalf1q * ( psy(ji,jj,jl) -3.0 * zalf * psyy(ji,jj,jl) )
-               psyy(ji,jj,jl)  =  zalf1 * zalf1q * psyy(ji,jj,jl)
-               psx (ji,jj,jl)  =  psx (ji,jj,jl) - zfx(ji,jj)
-               psxx(ji,jj,jl)  =  psxx(ji,jj,jl) - zfxx(ji,jj)
-               psxy(ji,jj,jl)  =  zalf1q * psxy(ji,jj,jl)
-            END DO
-         END DO
-         !
-         DO jj = 1, jpjm1                   !  Flux from j+1 to j when v LT 0.
-            DO ji = fs_2, fs_jpim1
-               zalf          = ( MAX(0._wp, -pvt(ji,jj) ) * pdt * e1v(ji,jj) ) / psm(ji,jj+1,jl) 
-               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,jl)
-               zf0   (ji,jj) = zf0 (ji,jj) + zalf  * (  ps0 (ji,jj+1,jl) &
-                  &                                   - zalf1 * (psy(ji,jj+1,jl) - (zalf1 - zalf ) * psyy(ji,jj+1,jl) ) )
-               zfy   (ji,jj) = zfy (ji,jj) + zalfq * (  psy (ji,jj+1,jl) - 3.0 * zalf1 * psyy(ji,jj+1,jl) )
-               zfyy  (ji,jj) = zfyy(ji,jj) + zalf  *    psyy(ji,jj+1,jl) * zalfq
-               zfx   (ji,jj) = zfx (ji,jj) + zalf  * (  psx (ji,jj+1,jl) - zalf1 * psxy(ji,jj+1,jl) )
-               zfxy  (ji,jj) = zfxy(ji,jj) + zalfq *    psxy(ji,jj+1,jl)
-               zfxx  (ji,jj) = zfxx(ji,jj) + zalf  *    psxx(ji,jj+1,jl)
-            END DO
-         END DO
+         DO_2D_11_00
+            zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) )
+            zalf         =  MAX( 0._wp, pvt(ji,jj) ) * pdt / psm(ji,jj,jl)
+            zalfq        =  zalf * zalf
+            zalf1        =  1.0 - zalf
+            zalf1q       =  zalf1 * zalf1
+            !
+            zfm (ji,jj)  =  zalf  * psm(ji,jj,jl)
+            zf0 (ji,jj)  =  zalf  * ( ps0(ji,jj,jl) + zalf1 * ( psy(ji,jj,jl)  + (zalf1-zalf) * psyy(ji,jj,jl) ) ) 
+            zfy (ji,jj)  =  zalfq *( psy(ji,jj,jl) + 3.0*zalf1*psyy(ji,jj,jl) )
+            zfyy(ji,jj)  =  zalf  * zalfq * psyy(ji,jj,jl)
+            zfx (ji,jj)  =  zalf  * ( psx(ji,jj,jl) + zalf1 * psxy(ji,jj,jl) )
+            zfxy(ji,jj)  =  zalfq * psxy(ji,jj,jl)
+            zfxx(ji,jj)  =  zalf  * psxx(ji,jj,jl)
+            !
+            !  Readjust moments remaining in the box.
+            psm (ji,jj,jl)  =  psm (ji,jj,jl) - zfm(ji,jj)
+            ps0 (ji,jj,jl)  =  ps0 (ji,jj,jl) - zf0(ji,jj)
+            psy (ji,jj,jl)  =  zalf1q * ( psy(ji,jj,jl) -3.0 * zalf * psyy(ji,jj,jl) )
+            psyy(ji,jj,jl)  =  zalf1 * zalf1q * psyy(ji,jj,jl)
+            psx (ji,jj,jl)  =  psx (ji,jj,jl) - zfx(ji,jj)
+            psxx(ji,jj,jl)  =  psxx(ji,jj,jl) - zfxx(ji,jj)
+            psxy(ji,jj,jl)  =  zalf1q * psxy(ji,jj,jl)
+         END_2D
+         !
+         DO_2D_10_00
+            zalf          = MAX( 0._wp, -pvt(ji,jj) ) * pdt / psm(ji,jj+1,jl) 
+            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,jl)
+            zf0   (ji,jj) = zf0 (ji,jj) + zalf  * (  ps0 (ji,jj+1,jl) &
+               &                                   - zalf1 * (psy(ji,jj+1,jl) - (zalf1 - zalf ) * psyy(ji,jj+1,jl) ) )
+            zfy   (ji,jj) = zfy (ji,jj) + zalfq * (  psy (ji,jj+1,jl) - 3.0 * zalf1 * psyy(ji,jj+1,jl) )
+            zfyy  (ji,jj) = zfyy(ji,jj) + zalf  *    psyy(ji,jj+1,jl) * zalfq
+            zfx   (ji,jj) = zfx (ji,jj) + zalf  * (  psx (ji,jj+1,jl) - zalf1 * psxy(ji,jj+1,jl) )
+            zfxy  (ji,jj) = zfxy(ji,jj) + zalfq *    psxy(ji,jj+1,jl)
+            zfxx  (ji,jj) = zfxx(ji,jj) + zalf  *    psxx(ji,jj+1,jl)
+         END_2D
 
          !  Readjust moments remaining in the box. 
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               zbt  =         zbet(ji,jj-1)
-               zbt1 = ( 1.0 - zbet(ji,jj-1) )
-               !
-               psm (ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) - zfm(ji,jj-1) )
-               ps0 (ji,jj,jl) = zbt * ps0(ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) - zf0(ji,jj-1) )
-               psy (ji,jj,jl) = zalg1q(ji,jj-1) * ( psy(ji,jj,jl) + 3.0 * zalg(ji,jj-1) * psyy(ji,jj,jl) )
-               psyy(ji,jj,jl) = zalg1 (ji,jj-1) * zalg1q(ji,jj-1) * psyy(ji,jj,jl)
-               psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( psx (ji,jj,jl) - zfx (ji,jj-1) )
-               psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( psxx(ji,jj,jl) - zfxx(ji,jj-1) )
-               psxy(ji,jj,jl) = zalg1q(ji,jj-1) * psxy(ji,jj,jl)
-            END DO
-         END DO
+         DO_2D_00_00
+            zbt  =         zbet(ji,jj-1)
+            zbt1 = ( 1.0 - zbet(ji,jj-1) )
+            !
+            psm (ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) - zfm(ji,jj-1) )
+            ps0 (ji,jj,jl) = zbt * ps0(ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) - zf0(ji,jj-1) )
+            psy (ji,jj,jl) = zalg1q(ji,jj-1) * ( psy(ji,jj,jl) + 3.0 * zalg(ji,jj-1) * psyy(ji,jj,jl) )
+            psyy(ji,jj,jl) = zalg1 (ji,jj-1) * zalg1q(ji,jj-1) * psyy(ji,jj,jl)
+            psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( psx (ji,jj,jl) - zfx (ji,jj-1) )
+            psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( psxx(ji,jj,jl) - zfxx(ji,jj-1) )
+            psxy(ji,jj,jl) = zalg1q(ji,jj-1) * psxy(ji,jj,jl)
+         END_2D
 
          !   Put the temporary moments into appropriate neighboring boxes.    
-         DO jj = 2, jpjm1                    !   Flux from j to j+1 IF v GT 0.
-            DO ji = fs_2, fs_jpim1
-               zbt  =       zbet(ji,jj-1)
-               zbt1 = 1.0 - zbet(ji,jj-1)
-               psm(ji,jj,jl) = zbt * ( psm(ji,jj,jl) + zfm(ji,jj-1) ) + zbt1 * psm(ji,jj,jl) 
-               zalf          = zbt * zfm(ji,jj-1) / psm(ji,jj,jl) 
-               zalf1         = 1.0 - zalf
-               ztemp         = zalf * ps0(ji,jj,jl) - zalf1 * zf0(ji,jj-1)
-               !
-               ps0(ji,jj,jl)  =   zbt  * ( ps0(ji,jj,jl) + zf0(ji,jj-1) ) + zbt1 * ps0(ji,jj,jl)
-               psy(ji,jj,jl)  =   zbt  * ( zalf * zfy(ji,jj-1) + zalf1 * psy(ji,jj,jl) + 3.0 * ztemp )  &
-                  &             + zbt1 * psy(ji,jj,jl)  
-               psyy(ji,jj,jl) =   zbt  * ( zalf * zalf * zfyy(ji,jj-1) + zalf1 * zalf1 * psyy(ji,jj,jl)                           &
-                  &                      + 5.0 * ( zalf * zalf1 * ( psy(ji,jj,jl) - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) ) & 
-                  &             + zbt1 * psyy(ji,jj,jl)
-               psxy(ji,jj,jl) =   zbt  * (  zalf * zfxy(ji,jj-1) + zalf1 * psxy(ji,jj,jl)            &
-                  &                      + 3.0 * (- zalf1 * zfx(ji,jj-1) + zalf * psx(ji,jj,jl) ) )  &
-                  &             + zbt1 * psxy(ji,jj,jl)
-               psx (ji,jj,jl) =   zbt * ( psx (ji,jj,jl) + zfx (ji,jj-1) ) + zbt1 * psx (ji,jj,jl)
-               psxx(ji,jj,jl) =   zbt * ( psxx(ji,jj,jl) + zfxx(ji,jj-1) ) + zbt1 * psxx(ji,jj,jl)
-            END DO
-         END DO
-
-         DO jj = 2, jpjm1                      !  Flux from j+1 to j IF v LT 0.
-            DO ji = fs_2, fs_jpim1
-               zbt  =       zbet(ji,jj)
-               zbt1 = 1.0 - zbet(ji,jj)
-               psm(ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) + zfm(ji,jj) )
-               zalf          = zbt1 * zfm(ji,jj) / psm(ji,jj,jl)
-               zalf1         = 1.0 - zalf
-               ztemp         = - zalf * ps0(ji,jj,jl) + zalf1 * zf0(ji,jj)
-               !
-               ps0 (ji,jj,jl) = zbt * ps0 (ji,jj,jl) + zbt1 * (  ps0(ji,jj,jl) + zf0(ji,jj) )
-               psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * (  zalf * zfy(ji,jj) + zalf1 * psy(ji,jj,jl) + 3.0 * ztemp )
-               psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * (  zalf * zalf * zfyy(ji,jj) + zalf1 * zalf1 * psyy(ji,jj,jl) &
-                  &                                            + 5.0 * ( zalf * zalf1 * ( - psy(ji,jj,jl) + zfy(ji,jj) )    &
-                  &                                            + ( zalf1 - zalf ) * ztemp ) )
-               psxy(ji,jj,jl) = zbt * psxy(ji,jj,jl) + zbt1 * (  zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj,jl)  &
-                  &                                            + 3.0 * ( zalf1 * zfx(ji,jj) - zalf * psx(ji,jj,jl) ) )
-               psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( psx (ji,jj,jl) + zfx (ji,jj) )
-               psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( psxx(ji,jj,jl) + zfxx(ji,jj) )
-            END DO
-         END DO
+         DO_2D_00_00
+            zbt  =       zbet(ji,jj-1)
+            zbt1 = 1.0 - zbet(ji,jj-1)
+            psm(ji,jj,jl) = zbt * ( psm(ji,jj,jl) + zfm(ji,jj-1) ) + zbt1 * psm(ji,jj,jl) 
+            zalf          = zbt * zfm(ji,jj-1) / psm(ji,jj,jl) 
+            zalf1         = 1.0 - zalf
+            ztemp         = zalf * ps0(ji,jj,jl) - zalf1 * zf0(ji,jj-1)
+            !
+            ps0(ji,jj,jl)  =   zbt  * ( ps0(ji,jj,jl) + zf0(ji,jj-1) ) + zbt1 * ps0(ji,jj,jl)
+            psy(ji,jj,jl)  =   zbt  * ( zalf * zfy(ji,jj-1) + zalf1 * psy(ji,jj,jl) + 3.0 * ztemp )  &
+               &             + zbt1 * psy(ji,jj,jl)  
+            psyy(ji,jj,jl) =   zbt  * ( zalf * zalf * zfyy(ji,jj-1) + zalf1 * zalf1 * psyy(ji,jj,jl)                           &
+               &                      + 5.0 * ( zalf * zalf1 * ( psy(ji,jj,jl) - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) ) & 
+               &             + zbt1 * psyy(ji,jj,jl)
+            psxy(ji,jj,jl) =   zbt  * (  zalf * zfxy(ji,jj-1) + zalf1 * psxy(ji,jj,jl)            &
+               &                      + 3.0 * (- zalf1 * zfx(ji,jj-1) + zalf * psx(ji,jj,jl) ) )  &
+               &             + zbt1 * psxy(ji,jj,jl)
+            psx (ji,jj,jl) =   zbt * ( psx (ji,jj,jl) + zfx (ji,jj-1) ) + zbt1 * psx (ji,jj,jl)
+            psxx(ji,jj,jl) =   zbt * ( psxx(ji,jj,jl) + zfxx(ji,jj-1) ) + zbt1 * psxx(ji,jj,jl)
+         END_2D
+
+         DO_2D_00_00
+            zbt  =       zbet(ji,jj)
+            zbt1 = 1.0 - zbet(ji,jj)
+            psm(ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) + zfm(ji,jj) )
+            zalf          = zbt1 * zfm(ji,jj) / psm(ji,jj,jl)
+            zalf1         = 1.0 - zalf
+            ztemp         = - zalf * ps0(ji,jj,jl) + zalf1 * zf0(ji,jj)
+            !
+            ps0 (ji,jj,jl) = zbt * ps0 (ji,jj,jl) + zbt1 * (  ps0(ji,jj,jl) + zf0(ji,jj) )
+            psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * (  zalf * zfy(ji,jj) + zalf1 * psy(ji,jj,jl) + 3.0 * ztemp )
+            psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * (  zalf * zalf * zfyy(ji,jj) + zalf1 * zalf1 * psyy(ji,jj,jl) &
+               &                                            + 5.0 * ( zalf * zalf1 * ( - psy(ji,jj,jl) + zfy(ji,jj) )    &
+               &                                            + ( zalf1 - zalf ) * ztemp ) )
+            psxy(ji,jj,jl) = zbt * psxy(ji,jj,jl) + zbt1 * (  zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj,jl)  &
+               &                                            + 3.0 * ( zalf1 * zfx(ji,jj) - zalf * psx(ji,jj,jl) ) )
+            psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( psx (ji,jj,jl) + zfx (ji,jj) )
+            psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( psxx(ji,jj,jl) + zfxx(ji,jj) )
+         END_2D
 
       END DO
@@ -579,4 +589,70 @@
       !
    END SUBROUTINE adv_y
+
+
+   SUBROUTINE Hbig( pdt, phi_max, phs_max, phip_max, pv_i, pv_s, pa_i, pa_ip, pv_ip, pe_s )
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE Hbig  ***
+      !!
+      !! ** Purpose : Thickness correction in case advection scheme creates
+      !!              abnormally tick ice or snow
+      !!
+      !! ** Method  : 1- check whether ice thickness is larger than the surrounding 9-points
+      !!                 (before advection) and reduce it by adapting ice concentration
+      !!              2- check whether snow thickness is larger than the surrounding 9-points
+      !!                 (before advection) and reduce it by sending the excess in the ocean
+      !!
+      !! ** input   : Max thickness of the surrounding 9-points
+      !!-------------------------------------------------------------------
+      REAL(wp)                    , INTENT(in   ) ::   pdt                          ! tracer time-step
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   phi_max, phs_max, phip_max   ! max ice thick from surrounding 9-pts
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_i, pv_s, pa_i, pa_ip, pv_ip
+      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_s
+      !
+      INTEGER  ::   ji, jj, jl         ! dummy loop indices
+      REAL(wp) ::   z1_dt, zhip, zhi, zhs, zfra
+      !!-------------------------------------------------------------------
+      !
+      z1_dt = 1._wp / pdt
+      !
+      DO jl = 1, jpl
+
+         DO_2D_11_11
+            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN
+               !
+               !                               ! -- check h_ip -- !
+               ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip
+               IF( ln_pnd_H12 .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN
+                  zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) )
+                  IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN
+                     pa_ip(ji,jj,jl) = pv_ip(ji,jj,jl) / phip_max(ji,jj,jl)
+                  ENDIF
+               ENDIF
+               !
+               !                               ! -- check h_i -- !
+               ! if h_i is larger than the surrounding 9 pts => reduce h_i and increase a_i
+               zhi = pv_i(ji,jj,jl) / pa_i(ji,jj,jl)
+               IF( zhi > phi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN
+                  pa_i(ji,jj,jl) = pv_i(ji,jj,jl) / MIN( phi_max(ji,jj,jl), hi_max(jpl) )   !-- bound h_i to hi_max (99 m)
+               ENDIF
+               !
+               !                               ! -- check h_s -- !
+               ! if h_s is larger than the surrounding 9 pts => put the snow excess in the ocean
+               zhs = pv_s(ji,jj,jl) / pa_i(ji,jj,jl)
+               IF( pv_s(ji,jj,jl) > 0._wp .AND. zhs > phs_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN
+                  zfra = phs_max(ji,jj,jl) / MAX( zhs, epsi20 )
+                  !
+                  wfx_res(ji,jj) = wfx_res(ji,jj) + ( pv_s(ji,jj,jl) - pa_i(ji,jj,jl) * phs_max(ji,jj,jl) ) * rhos * z1_dt
+                  hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0
+                  !
+                  pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra
+                  pv_s(ji,jj,jl)          = pa_i(ji,jj,jl) * phs_max(ji,jj,jl)
+               ENDIF           
+               !                  
+            ENDIF
+         END_2D
+      END DO 
+      !
+   END SUBROUTINE Hbig
 
 
@@ -608,23 +684,21 @@
       ! -- check snow load -- !
       DO jl = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF ( pv_i(ji,jj,jl) > 0._wp ) THEN
-                  !
-                  zvs_excess = MAX( 0._wp, pv_s(ji,jj,jl) - pv_i(ji,jj,jl) * (rau0-rhoi) * r1_rhos )
-                  !
-                  IF( zvs_excess > 0._wp ) THEN   ! snow-ice interface deplets below the ocean surface
-                     ! put snow excess in the ocean
-                     zfra = ( pv_s(ji,jj,jl) - zvs_excess ) / MAX( pv_s(ji,jj,jl), epsi20 )
-                     wfx_res(ji,jj) = wfx_res(ji,jj) + zvs_excess * rhos * z1_dt
-                     hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0
-                     ! correct snow volume and heat content
-                     pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra
-                     pv_s(ji,jj,jl)          = pv_s(ji,jj,jl) - zvs_excess
-                  ENDIF
-                  !
+         DO_2D_11_11
+            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN
+               !
+               zvs_excess = MAX( 0._wp, pv_s(ji,jj,jl) - pv_i(ji,jj,jl) * (rho0-rhoi) * r1_rhos )
+               !
+               IF( zvs_excess > 0._wp ) THEN   ! snow-ice interface deplets below the ocean surface
+                  ! put snow excess in the ocean
+                  zfra = ( pv_s(ji,jj,jl) - zvs_excess ) / MAX( pv_s(ji,jj,jl), epsi20 )
+                  wfx_res(ji,jj) = wfx_res(ji,jj) + zvs_excess * rhos * z1_dt
+                  hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0
+                  ! correct snow volume and heat content
+                  pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra
+                  pv_s(ji,jj,jl)          = pv_s(ji,jj,jl) - zvs_excess
                ENDIF
-            END DO
-         END DO
+               !
+            ENDIF
+         END_2D
       END DO
       !
@@ -645,6 +719,5 @@
       !
       !                             !* allocate prather fields
-      ALLOCATE( sxopw(jpi,jpj,1)   , syopw(jpi,jpj,1)   , sxxopw(jpi,jpj,1)   , syyopw(jpi,jpj,1)   , sxyopw(jpi,jpj,1)   ,   &
-         &      sxice(jpi,jpj,jpl) , syice(jpi,jpj,jpl) , sxxice(jpi,jpj,jpl) , syyice(jpi,jpj,jpl) , sxyice(jpi,jpj,jpl) ,   &
+      ALLOCATE( sxice(jpi,jpj,jpl) , syice(jpi,jpj,jpl) , sxxice(jpi,jpj,jpl) , syyice(jpi,jpj,jpl) , sxyice(jpi,jpj,jpl) ,   &
          &      sxsn (jpi,jpj,jpl) , sysn (jpi,jpj,jpl) , sxxsn (jpi,jpj,jpl) , syysn (jpi,jpj,jpl) , sxysn (jpi,jpj,jpl) ,   &
          &      sxa  (jpi,jpj,jpl) , sya  (jpi,jpj,jpl) , sxxa  (jpi,jpj,jpl) , syya  (jpi,jpj,jpl) , sxya  (jpi,jpj,jpl) ,   &
@@ -692,5 +765,5 @@
          !                                   !==========================!
          !
-         IF( ln_rstart ) THEN   ;   id1 = iom_varid( numrir, 'sxopw' , ldstop = .FALSE. )    ! file exist: id1>0
+         IF( ln_rstart ) THEN   ;   id1 = iom_varid( numrir, 'sxice' , ldstop = .FALSE. )    ! file exist: id1>0
          ELSE                   ;   id1 = 0                                                  ! no restart: id1=0
          ENDIF
@@ -728,10 +801,4 @@
             CALL iom_get( numrir, jpdom_autoglo, 'syyage', syyage )
             CALL iom_get( numrir, jpdom_autoglo, 'sxyage', sxyage )
-            !                                                        ! open water in sea ice
-            CALL iom_get( numrir, jpdom_autoglo, 'sxopw' , sxopw  )
-            CALL iom_get( numrir, jpdom_autoglo, 'syopw' , syopw  )
-            CALL iom_get( numrir, jpdom_autoglo, 'sxxopw', sxxopw )
-            CALL iom_get( numrir, jpdom_autoglo, 'syyopw', syyopw )
-            CALL iom_get( numrir, jpdom_autoglo, 'sxyopw', sxyopw )
             !                                                        ! snow layers heat content
             DO jk = 1, nlay_s
@@ -776,5 +843,4 @@
             sxsal = 0._wp   ;   sysal = 0._wp   ;   sxxsal = 0._wp   ;   syysal = 0._wp   ;   sxysal = 0._wp      ! ice salinity
             sxage = 0._wp   ;   syage = 0._wp   ;   sxxage = 0._wp   ;   syyage = 0._wp   ;   sxyage = 0._wp      ! ice age
-            sxopw = 0._wp   ;   syopw = 0._wp   ;   sxxopw = 0._wp   ;   syyopw = 0._wp   ;   sxyopw = 0._wp      ! open water in sea ice
             sxc0  = 0._wp   ;   syc0  = 0._wp   ;   sxxc0  = 0._wp   ;   syyc0  = 0._wp   ;   sxyc0  = 0._wp      ! snow layers heat content
             sxe   = 0._wp   ;   sye   = 0._wp   ;   sxxe   = 0._wp   ;   syye   = 0._wp   ;   sxye   = 0._wp      ! ice layers heat content
@@ -825,10 +891,4 @@
          CALL iom_rstput( iter, nitrst, numriw, 'syyage', syyage )
          CALL iom_rstput( iter, nitrst, numriw, 'sxyage', sxyage )
-         !                                                           ! open water in sea ice
-         CALL iom_rstput( iter, nitrst, numriw, 'sxopw' , sxopw  )
-         CALL iom_rstput( iter, nitrst, numriw, 'syopw' , syopw  )
-         CALL iom_rstput( iter, nitrst, numriw, 'sxxopw', sxxopw )
-         CALL iom_rstput( iter, nitrst, numriw, 'syyopw', syyopw )
-         CALL iom_rstput( iter, nitrst, numriw, 'sxyopw', sxyopw )
          !                                                           ! snow layers heat content
          DO jk = 1, nlay_s
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icedyn_adv_umx.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icedyn_adv_umx.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icedyn_adv_umx.F90	(revision 12928)
@@ -51,5 +51,5 @@
    !
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/ICE 4.0 , NEMO Consortium (2018)
@@ -107,20 +107,18 @@
       ! --- Record max of the surrounding 9-pts ice thick. (for call Hbig) --- !
       DO jl = 1, jpl
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               zhip_max(ji,jj,jl) = MAX( epsi20, ph_ip(ji,jj,jl), ph_ip(ji+1,jj  ,jl), ph_ip(ji  ,jj+1,jl), &
-                  &                                               ph_ip(ji-1,jj  ,jl), ph_ip(ji  ,jj-1,jl), &
-                  &                                               ph_ip(ji+1,jj+1,jl), ph_ip(ji-1,jj-1,jl), &
-                  &                                               ph_ip(ji+1,jj-1,jl), ph_ip(ji-1,jj+1,jl) )
-               zhi_max (ji,jj,jl) = MAX( epsi20, ph_i (ji,jj,jl), ph_i (ji+1,jj  ,jl), ph_i (ji  ,jj+1,jl), &
-                  &                                               ph_i (ji-1,jj  ,jl), ph_i (ji  ,jj-1,jl), &
-                  &                                               ph_i (ji+1,jj+1,jl), ph_i (ji-1,jj-1,jl), &
-                  &                                               ph_i (ji+1,jj-1,jl), ph_i (ji-1,jj+1,jl) )
-               zhs_max (ji,jj,jl) = MAX( epsi20, ph_s (ji,jj,jl), ph_s (ji+1,jj  ,jl), ph_s (ji  ,jj+1,jl), &
-                  &                                               ph_s (ji-1,jj  ,jl), ph_s (ji  ,jj-1,jl), &
-                  &                                               ph_s (ji+1,jj+1,jl), ph_s (ji-1,jj-1,jl), &
-                  &                                               ph_s (ji+1,jj-1,jl), ph_s (ji-1,jj+1,jl) )
-            END DO
-         END DO
+         DO_2D_00_00
+            zhip_max(ji,jj,jl) = MAX( epsi20, ph_ip(ji,jj,jl), ph_ip(ji+1,jj  ,jl), ph_ip(ji  ,jj+1,jl), &
+               &                                               ph_ip(ji-1,jj  ,jl), ph_ip(ji  ,jj-1,jl), &
+               &                                               ph_ip(ji+1,jj+1,jl), ph_ip(ji-1,jj-1,jl), &
+               &                                               ph_ip(ji+1,jj-1,jl), ph_ip(ji-1,jj+1,jl) )
+            zhi_max (ji,jj,jl) = MAX( epsi20, ph_i (ji,jj,jl), ph_i (ji+1,jj  ,jl), ph_i (ji  ,jj+1,jl), &
+               &                                               ph_i (ji-1,jj  ,jl), ph_i (ji  ,jj-1,jl), &
+               &                                               ph_i (ji+1,jj+1,jl), ph_i (ji-1,jj-1,jl), &
+               &                                               ph_i (ji+1,jj-1,jl), ph_i (ji-1,jj+1,jl) )
+            zhs_max (ji,jj,jl) = MAX( epsi20, ph_s (ji,jj,jl), ph_s (ji+1,jj  ,jl), ph_s (ji  ,jj+1,jl), &
+               &                                               ph_s (ji-1,jj  ,jl), ph_s (ji  ,jj-1,jl), &
+               &                                               ph_s (ji+1,jj+1,jl), ph_s (ji-1,jj-1,jl), &
+               &                                               ph_s (ji+1,jj-1,jl), ph_s (ji-1,jj+1,jl) )
+         END_2D
       END DO
       CALL lbc_lnk_multi( 'icedyn_adv_umx', zhi_max, 'T', 1., zhs_max, 'T', 1., zhip_max, 'T', 1. )
@@ -130,6 +128,6 @@
       !        Note: the advection split is applied at the next time-step in order to avoid blocking global comm.
       !              this should not affect too much the stability
-      zcflnow(1) =                  MAXVAL( ABS( pu_ice(:,:) ) * rdt_ice * r1_e1u(:,:) )
-      zcflnow(1) = MAX( zcflnow(1), MAXVAL( ABS( pv_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) )
+      zcflnow(1) =                  MAXVAL( ABS( pu_ice(:,:) ) * rDt_ice * r1_e1u(:,:) )
+      zcflnow(1) = MAX( zcflnow(1), MAXVAL( ABS( pv_ice(:,:) ) * rDt_ice * r1_e2v(:,:) ) )
       
       ! non-blocking global communication send zcflnow and receive zcflprv
@@ -139,5 +137,5 @@
       ELSE                         ;   icycle = 1
       ENDIF
-      zdt = rdt_ice / REAL(icycle)
+      zdt = rDt_ice / REAL(icycle)
 
       ! --- transport --- !
@@ -152,17 +150,15 @@
       !
       ! --- define velocity for advection: u*grad(H) --- !
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1
-            IF    ( pu_ice(ji,jj) * pu_ice(ji-1,jj) <= 0._wp ) THEN   ;   zcu_box(ji,jj) = 0._wp
-            ELSEIF( pu_ice(ji,jj)                   >  0._wp ) THEN   ;   zcu_box(ji,jj) = pu_ice(ji-1,jj)
-            ELSE                                                      ;   zcu_box(ji,jj) = pu_ice(ji  ,jj)
-            ENDIF
-
-            IF    ( pv_ice(ji,jj) * pv_ice(ji,jj-1) <= 0._wp ) THEN   ;   zcv_box(ji,jj) = 0._wp
-            ELSEIF( pv_ice(ji,jj)                   >  0._wp ) THEN   ;   zcv_box(ji,jj) = pv_ice(ji,jj-1)
-            ELSE                                                      ;   zcv_box(ji,jj) = pv_ice(ji,jj  )
-            ENDIF
-         END DO
-      END DO
+      DO_2D_00_00
+         IF    ( pu_ice(ji,jj) * pu_ice(ji-1,jj) <= 0._wp ) THEN   ;   zcu_box(ji,jj) = 0._wp
+         ELSEIF( pu_ice(ji,jj)                   >  0._wp ) THEN   ;   zcu_box(ji,jj) = pu_ice(ji-1,jj)
+         ELSE                                                      ;   zcu_box(ji,jj) = pu_ice(ji  ,jj)
+         ENDIF
+
+         IF    ( pv_ice(ji,jj) * pv_ice(ji,jj-1) <= 0._wp ) THEN   ;   zcv_box(ji,jj) = 0._wp
+         ELSEIF( pv_ice(ji,jj)                   >  0._wp ) THEN   ;   zcv_box(ji,jj) = pv_ice(ji,jj-1)
+         ELSE                                                      ;   zcv_box(ji,jj) = pv_ice(ji,jj  )
+         ENDIF
+      END_2D
 
       !---------------!
@@ -187,14 +183,12 @@
             IF( .NOT. ALLOCATED(jmsk_small) )   ALLOCATE( jmsk_small(jpi,jpj,jpl) ) 
             DO jl = 1, jpl
-               DO jj = 1, jpjm1
-                  DO ji = 1, jpim1
-                     zvi_cen = 0.5_wp * ( pv_i(ji+1,jj,jl) + pv_i(ji,jj,jl) )
-                     IF( zvi_cen < epsi06) THEN   ;   imsk_small(ji,jj,jl) = 0
-                     ELSE                         ;   imsk_small(ji,jj,jl) = 1   ;   ENDIF
-                     zvi_cen = 0.5_wp * ( pv_i(ji,jj+1,jl) + pv_i(ji,jj,jl) )
-                     IF( zvi_cen < epsi06) THEN   ;   jmsk_small(ji,jj,jl) = 0
-                     ELSE                         ;   jmsk_small(ji,jj,jl) = 1   ;   ENDIF
-                  END DO
-               END DO
+               DO_2D_10_10
+                  zvi_cen = 0.5_wp * ( pv_i(ji+1,jj,jl) + pv_i(ji,jj,jl) )
+                  IF( zvi_cen < epsi06) THEN   ;   imsk_small(ji,jj,jl) = 0
+                  ELSE                         ;   imsk_small(ji,jj,jl) = 1   ;   ENDIF
+                  zvi_cen = 0.5_wp * ( pv_i(ji,jj+1,jl) + pv_i(ji,jj,jl) )
+                  IF( zvi_cen < epsi06) THEN   ;   jmsk_small(ji,jj,jl) = 0
+                  ELSE                         ;   jmsk_small(ji,jj,jl) = 1   ;   ENDIF
+               END_2D
             END DO
          ENDIF
@@ -338,10 +332,8 @@
          !== Open water area ==!
          zati2(:,:) = SUM( pa_i(:,:,:), dim=3 )
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) & 
-                  &                          - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt
-            END DO
-         END DO
+         DO_2D_00_00
+            pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) & 
+               &                          - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt
+         END_2D
          CALL lbc_lnk( 'icedyn_adv_umx', pato_i, 'T',  1. )
          !
@@ -352,8 +344,11 @@
          CALL ice_var_zapneg( zdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i )
          !
-         ! Make sure ice thickness is not too big
-         !    (because ice thickness can be too large where ice concentration is very small)
-         CALL Hbig( zdt, zhi_max, zhs_max, zhip_max, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i )
-
+         ! --- Make sure ice thickness is not too big --- !
+         !     (because ice thickness can be too large where ice concentration is very small)
+         CALL Hbig( zdt, zhi_max, zhs_max, zhip_max, pv_i, pv_s, pa_i, pa_ip, pv_ip, pe_s )
+         !
+         ! --- Ensure snow load is not too big --- !
+         CALL Hsnow( zdt, pv_i, pv_s, pa_i, pa_ip, pe_s )
+         !
       END DO
       !
@@ -446,23 +441,21 @@
       IF( pamsk == 0._wp ) THEN
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1
-                  IF( ABS( pu(ji,jj) ) > epsi10 ) THEN
-                     zfu_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) * puc    (ji,jj,jl) / pu(ji,jj)
-                     zfu_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) * pua_ups(ji,jj,jl) / pu(ji,jj)
-                  ELSE
-                     zfu_ho (ji,jj,jl) = 0._wp
-                     zfu_ups(ji,jj,jl) = 0._wp
-                  ENDIF
-                  !
-                  IF( ABS( pv(ji,jj) ) > epsi10 ) THEN
-                     zfv_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) * pvc    (ji,jj,jl) / pv(ji,jj)
-                     zfv_ups(ji,jj,jl) = zfv_ups(ji,jj,jl) * pva_ups(ji,jj,jl) / pv(ji,jj)
-                  ELSE
-                     zfv_ho (ji,jj,jl) = 0._wp  
-                     zfv_ups(ji,jj,jl) = 0._wp  
-                  ENDIF
-               END DO
-            END DO
+            DO_2D_10_10
+               IF( ABS( pu(ji,jj) ) > epsi10 ) THEN
+                  zfu_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) * puc    (ji,jj,jl) / pu(ji,jj)
+                  zfu_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) * pua_ups(ji,jj,jl) / pu(ji,jj)
+               ELSE
+                  zfu_ho (ji,jj,jl) = 0._wp
+                  zfu_ups(ji,jj,jl) = 0._wp
+               ENDIF
+               !
+               IF( ABS( pv(ji,jj) ) > epsi10 ) THEN
+                  zfv_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) * pvc    (ji,jj,jl) / pv(ji,jj)
+                  zfv_ups(ji,jj,jl) = zfv_ups(ji,jj,jl) * pva_ups(ji,jj,jl) / pv(ji,jj)
+               ELSE
+                  zfv_ho (ji,jj,jl) = 0._wp  
+                  zfv_ups(ji,jj,jl) = 0._wp  
+               ENDIF
+            END_2D
          END DO
 
@@ -470,11 +463,9 @@
          ! thus we calculate the upstream solution and apply a limiter again
          DO jl = 1, jpl
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  ztra = - ( zfu_ups(ji,jj,jl) - zfu_ups(ji-1,jj,jl) + zfv_ups(ji,jj,jl) - zfv_ups(ji,jj-1,jl) )
-                  !
-                  zt_ups(ji,jj,jl) = ( ptc(ji,jj,jl) + ztra * r1_e1e2t(ji,jj) * pdt ) * tmask(ji,jj,1)
-               END DO
-            END DO
+            DO_2D_00_00
+               ztra = - ( zfu_ups(ji,jj,jl) - zfu_ups(ji-1,jj,jl) + zfv_ups(ji,jj,jl) - zfv_ups(ji,jj-1,jl) )
+               !
+               zt_ups(ji,jj,jl) = ( ptc(ji,jj,jl) + ztra * r1_e1e2t(ji,jj) * pdt ) * tmask(ji,jj,1)
+            END_2D
          END DO
          CALL lbc_lnk( 'icedyn_adv_umx', zt_ups, 'T',  1. )
@@ -493,10 +484,8 @@
       IF( PRESENT( pua_ho ) ) THEN
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1
-                  pua_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) ; pva_ho (ji,jj,jl) = zfv_ho (ji,jj,jl)
-                  pua_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) ; pva_ups(ji,jj,jl) = zfv_ups(ji,jj,jl)
-              END DO
-            END DO
+            DO_2D_10_10
+               pua_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) ; pva_ho (ji,jj,jl) = zfv_ho (ji,jj,jl)
+               pua_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) ; pva_ups(ji,jj,jl) = zfv_ups(ji,jj,jl)
+            END_2D
          END DO
       ENDIF
@@ -505,11 +494,9 @@
       ! ---------------------------------
       DO jl = 1, jpl
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1 
-               ztra = - ( zfu_ho(ji,jj,jl) - zfu_ho(ji-1,jj,jl) + zfv_ho(ji,jj,jl) - zfv_ho(ji,jj-1,jl) )  
-               !
-               ptc(ji,jj,jl) = ( ptc(ji,jj,jl) + ztra * r1_e1e2t(ji,jj) * pdt ) * tmask(ji,jj,1)               
-            END DO
-         END DO
+         DO_2D_00_00
+            ztra = - ( zfu_ho(ji,jj,jl) - zfu_ho(ji-1,jj,jl) + zfv_ho(ji,jj,jl) - zfv_ho(ji,jj-1,jl) )  
+            !
+            ptc(ji,jj,jl) = ( ptc(ji,jj,jl) + ztra * r1_e1e2t(ji,jj) * pdt ) * tmask(ji,jj,1)               
+         END_2D
       END DO
       CALL lbc_lnk( 'icedyn_adv_umx', ptc, 'T',  1. )
@@ -541,72 +528,58 @@
          !
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1
+            DO_2D_10_10
+               pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * pt(ji+1,jj,jl)
+               pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * pt(ji,jj+1,jl)
+            END_2D
+         END DO
+         !
+      ELSE                              !** alternate directions **!
+         !
+         IF( MOD( (kt - 1) / nn_fsbc , 2 ) ==  MOD( (jt - 1) , 2 ) ) THEN   !==  odd ice time step:  adv_x then adv_y  ==!
+            !
+            DO jl = 1, jpl              !-- flux in x-direction
+               DO_2D_10_10
                   pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * pt(ji+1,jj,jl)
+               END_2D
+            END DO
+            !
+            DO jl = 1, jpl              !-- first guess of tracer from u-flux
+               DO_2D_00_00
+                  ztra = - ( pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj,jl) )              &
+                     &   + ( pu     (ji,jj   ) - pu     (ji-1,jj   ) ) * pt(ji,jj,jl) * (1.-pamsk)
+                  !
+                  zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1)
+               END_2D
+            END DO
+            CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. )
+            !
+            DO jl = 1, jpl              !-- flux in y-direction
+               DO_2D_10_10
+                  pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * zpt(ji,jj+1,jl)
+               END_2D
+            END DO
+            !
+         ELSE                                                               !==  even ice time step:  adv_y then adv_x  ==!
+            !
+            DO jl = 1, jpl              !-- flux in y-direction
+               DO_2D_10_10
                   pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * pt(ji,jj+1,jl)
-               END DO
-            END DO
-         END DO
-         !
-      ELSE                              !** alternate directions **!
-         !
-         IF( MOD( (kt - 1) / nn_fsbc , 2 ) ==  MOD( (jt - 1) , 2 ) ) THEN   !==  odd ice time step:  adv_x then adv_y  ==!
+               END_2D
+            END DO
+            !
+            DO jl = 1, jpl              !-- first guess of tracer from v-flux
+               DO_2D_00_00
+                  ztra = - ( pfv_ups(ji,jj,jl) - pfv_ups(ji,jj-1,jl) )  &
+                     &   + ( pv     (ji,jj   ) - pv     (ji,jj-1   ) ) * pt(ji,jj,jl) * (1.-pamsk)
+                  !
+                  zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1)
+               END_2D
+            END DO
+            CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. )
             !
             DO jl = 1, jpl              !-- flux in x-direction
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1
-                     pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * pt(ji+1,jj,jl)
-                  END DO
-               END DO
-            END DO
-            !
-            DO jl = 1, jpl              !-- first guess of tracer from u-flux
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     ztra = - ( pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj,jl) )              &
-                        &   + ( pu     (ji,jj   ) - pu     (ji-1,jj   ) ) * pt(ji,jj,jl) * (1.-pamsk)
-                     !
-                     zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1)
-                  END DO
-               END DO
-            END DO
-            CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. )
-            !
-            DO jl = 1, jpl              !-- flux in y-direction
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1
-                     pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * zpt(ji,jj+1,jl)
-                  END DO
-               END DO
-            END DO
-            !
-         ELSE                                                               !==  even ice time step:  adv_y then adv_x  ==!
-            !
-            DO jl = 1, jpl              !-- flux in y-direction
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1
-                     pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * pt(ji,jj+1,jl)
-                  END DO
-               END DO
-            END DO
-            !
-            DO jl = 1, jpl              !-- first guess of tracer from v-flux
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     ztra = - ( pfv_ups(ji,jj,jl) - pfv_ups(ji,jj-1,jl) )  &
-                        &   + ( pv     (ji,jj   ) - pv     (ji,jj-1   ) ) * pt(ji,jj,jl) * (1.-pamsk)
-                     !
-                     zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1)
-                  END DO
-               END DO
-            END DO
-            CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. )
-            !
-            DO jl = 1, jpl              !-- flux in x-direction
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1
-                     pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * zpt(ji+1,jj,jl)
-                  END DO
-               END DO
+               DO_2D_10_10
+                  pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * zpt(ji+1,jj,jl)
+               END_2D
             END DO
             !
@@ -616,14 +589,12 @@
       !
       DO jl = 1, jpl                    !-- after tracer with upstream scheme
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               ztra = - (   pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj  ,jl)   &
-                  &       + pfv_ups(ji,jj,jl) - pfv_ups(ji  ,jj-1,jl) ) &
-                  &   + (   pu     (ji,jj   ) - pu     (ji-1,jj     )   &
-                  &       + pv     (ji,jj   ) - pv     (ji  ,jj-1   ) ) * pt(ji,jj,jl) * (1.-pamsk)
-               !
-               pt_ups(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1)
-            END DO
-         END DO
+         DO_2D_00_00
+            ztra = - (   pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj  ,jl)   &
+               &       + pfv_ups(ji,jj,jl) - pfv_ups(ji  ,jj-1,jl) ) &
+               &   + (   pu     (ji,jj   ) - pu     (ji-1,jj     )   &
+               &       + pv     (ji,jj   ) - pv     (ji  ,jj-1   ) ) * pt(ji,jj,jl) * (1.-pamsk)
+            !
+            pt_ups(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1)
+         END_2D
       END DO
       CALL lbc_lnk( 'icedyn_adv_umx', pt_ups, 'T', 1. )
@@ -657,10 +628,8 @@
          !
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1
-                  pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj  ,jl) )
-                  pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji  ,jj+1,jl) )
-               END DO
-            END DO
+            DO_2D_10_10
+               pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj  ,jl) )
+               pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji  ,jj+1,jl) )
+            END_2D
          END DO
          !
@@ -677,30 +646,24 @@
             !
             DO jl = 1, jpl              !-- flux in x-direction
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1
-                     pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj,jl) )
-                  END DO
-               END DO
+               DO_2D_10_10
+                  pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj,jl) )
+               END_2D
             END DO
             IF( np_limiter == 2 .OR. np_limiter == 3 )   CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho )
 
             DO jl = 1, jpl              !-- first guess of tracer from u-flux
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     ztra = - ( pfu_ho(ji,jj,jl) - pfu_ho(ji-1,jj,jl) )              &
-                        &   + ( pu    (ji,jj   ) - pu    (ji-1,jj   ) ) * pt(ji,jj,jl) * (1.-pamsk)
-                     !
-                     zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1)
-                  END DO
-               END DO
+               DO_2D_00_00
+                  ztra = - ( pfu_ho(ji,jj,jl) - pfu_ho(ji-1,jj,jl) )              &
+                     &   + ( pu    (ji,jj   ) - pu    (ji-1,jj   ) ) * pt(ji,jj,jl) * (1.-pamsk)
+                  !
+                  zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1)
+               END_2D
             END DO
             CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. )
 
             DO jl = 1, jpl              !-- flux in y-direction
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1
-                     pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji,jj+1,jl) )
-                  END DO
-               END DO
+               DO_2D_10_10
+                  pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji,jj+1,jl) )
+               END_2D
             END DO
             IF( np_limiter == 2 .OR. np_limiter == 3 )   CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho )
@@ -709,30 +672,24 @@
             !
             DO jl = 1, jpl              !-- flux in y-direction
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1
-                     pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji,jj+1,jl) )
-                  END DO
-               END DO
+               DO_2D_10_10
+                  pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji,jj+1,jl) )
+               END_2D
             END DO
             IF( np_limiter == 2 .OR. np_limiter == 3 )   CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho )
             !
             DO jl = 1, jpl              !-- first guess of tracer from v-flux
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     ztra = - ( pfv_ho(ji,jj,jl) - pfv_ho(ji,jj-1,jl) )  &
-                        &   + ( pv    (ji,jj   ) - pv    (ji,jj-1   ) ) * pt(ji,jj,jl) * (1.-pamsk)
-                     !
-                     zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1)
-                  END DO
-               END DO
+               DO_2D_00_00
+                  ztra = - ( pfv_ho(ji,jj,jl) - pfv_ho(ji,jj-1,jl) )  &
+                     &   + ( pv    (ji,jj   ) - pv    (ji,jj-1   ) ) * pt(ji,jj,jl) * (1.-pamsk)
+                  !
+                  zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1)
+               END_2D
             END DO
             CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. )
             !
             DO jl = 1, jpl              !-- flux in x-direction
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1
-                     pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji+1,jj,jl) )
-                  END DO
-               END DO
+               DO_2D_10_10
+                  pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji+1,jj,jl) )
+               END_2D
             END DO
             IF( np_limiter == 2 .OR. np_limiter == 3 )   CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho )
@@ -780,12 +737,10 @@
          !                                                        !--  advective form update in zpt  --!
          DO jl = 1, jpl
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  zpt(ji,jj,jl) = ( pt(ji,jj,jl) - (  pubox(ji,jj   ) * ( zt_u(ji,jj,jl) - zt_u(ji-1,jj,jl) ) * r1_e1t  (ji,jj) &
-                     &                              + pt   (ji,jj,jl) * ( pu  (ji,jj   ) - pu  (ji-1,jj   ) ) * r1_e1e2t(ji,jj) &
-                     &                                                                                        * pamsk           &
-                     &                             ) * pdt ) * tmask(ji,jj,1)
-               END DO
-            END DO
+            DO_2D_00_00
+               zpt(ji,jj,jl) = ( pt(ji,jj,jl) - (  pubox(ji,jj   ) * ( zt_u(ji,jj,jl) - zt_u(ji-1,jj,jl) ) * r1_e1t  (ji,jj) &
+                  &                              + pt   (ji,jj,jl) * ( pu  (ji,jj   ) - pu  (ji-1,jj   ) ) * r1_e1e2t(ji,jj) &
+                  &                                                                                        * pamsk           &
+                  &                             ) * pdt ) * tmask(ji,jj,1)
+            END_2D
          END DO
          CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. )
@@ -809,12 +764,10 @@
          !                                                        !--  advective form update in zpt  --!
          DO jl = 1, jpl
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  zpt(ji,jj,jl) = ( pt(ji,jj,jl) - (  pvbox(ji,jj   ) * ( zt_v(ji,jj,jl) - zt_v(ji,jj-1,jl) ) * r1_e2t  (ji,jj) &
-                     &                              + pt   (ji,jj,jl) * ( pv  (ji,jj   ) - pv  (ji,jj-1   ) ) * r1_e1e2t(ji,jj) &
-                     &                                                                                        * pamsk           &
-                     &                             ) * pdt ) * tmask(ji,jj,1) 
-               END DO
-            END DO
+            DO_2D_00_00
+               zpt(ji,jj,jl) = ( pt(ji,jj,jl) - (  pvbox(ji,jj   ) * ( zt_v(ji,jj,jl) - zt_v(ji,jj-1,jl) ) * r1_e2t  (ji,jj) &
+                  &                              + pt   (ji,jj,jl) * ( pv  (ji,jj   ) - pv  (ji,jj-1   ) ) * r1_e1e2t(ji,jj) &
+                  &                                                                                        * pamsk           &
+                  &                             ) * pdt ) * tmask(ji,jj,1) 
+            END_2D
          END DO
          CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. )
@@ -862,9 +815,9 @@
       DO jl = 1, jpl
          DO jj = 2, jpjm1         ! First derivative (gradient)
-            DO ji = 1, fs_jpim1
+            DO ji = 1, jpim1
                ztu1(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * r1_e1u(ji,jj) * umask(ji,jj,1)
             END DO
             !                     ! Second derivative (Laplacian)
-            DO ji = fs_2, fs_jpim1
+            DO ji = 2, jpim1
                ztu2(ji,jj,jl) = ( ztu1(ji,jj,jl) - ztu1(ji-1,jj,jl) ) * r1_e1t(ji,jj)
             END DO
@@ -876,9 +829,9 @@
       DO jl = 1, jpl
          DO jj = 2, jpjm1         ! Third derivative
-            DO ji = 1, fs_jpim1
+            DO ji = 1, jpim1
                ztu3(ji,jj,jl) = ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) * r1_e1u(ji,jj) * umask(ji,jj,1)
             END DO
             !                     ! Fourth derivative
-            DO ji = fs_2, fs_jpim1
+            DO ji = 2, jpim1
                ztu4(ji,jj,jl) = ( ztu3(ji,jj,jl) - ztu3(ji-1,jj,jl) ) * r1_e1t(ji,jj)
             END DO
@@ -893,10 +846,8 @@
          !        
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   &
-                     &                                         - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) )
-               END DO
-            END DO
+            DO_2D_10_10
+               pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   &
+                  &                                         - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) )
+            END_2D
          END DO
          !
@@ -904,11 +855,9 @@
          !
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
-                  pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   &
-                     &                                                            - zcu   * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 
-               END DO
-            END DO
+            DO_2D_10_10
+               zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
+               pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   &
+                  &                                                            - zcu   * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 
+            END_2D
          END DO
          !  
@@ -916,15 +865,13 @@
          !
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
-                  zdx2 = e1u(ji,jj) * e1u(ji,jj)
+            DO_2D_10_10
+               zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
+               zdx2 = e1u(ji,jj) * e1u(ji,jj)
 !!rachid          zdx2 = e1u(ji,jj) * e1t(ji,jj)
-                  pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (         (                      pt  (ji+1,jj,jl) + pt  (ji,jj,jl)     &
-                     &                                                            - zcu   * ( pt  (ji+1,jj,jl) - pt  (ji,jj,jl) ) ) &
-                     &        + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) *    (                      ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl)     &
-                     &                                               - SIGN( 1._wp, zcu ) * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) )
-               END DO
-            END DO
+               pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (         (                      pt  (ji+1,jj,jl) + pt  (ji,jj,jl)     &
+                  &                                                            - zcu   * ( pt  (ji+1,jj,jl) - pt  (ji,jj,jl) ) ) &
+                  &        + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) *    (                      ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl)     &
+                  &                                               - SIGN( 1._wp, zcu ) * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) )
+            END_2D
          END DO
          !
@@ -932,15 +879,13 @@
          !
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
-                  zdx2 = e1u(ji,jj) * e1u(ji,jj)
+            DO_2D_10_10
+               zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
+               zdx2 = e1u(ji,jj) * e1u(ji,jj)
 !!rachid          zdx2 = e1u(ji,jj) * e1t(ji,jj)
-                  pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (         (                      pt  (ji+1,jj,jl) + pt  (ji,jj,jl)     &
-                     &                                                            - zcu   * ( pt  (ji+1,jj,jl) - pt  (ji,jj,jl) ) ) &
-                     &        + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) *    (                      ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl)     &
-                     &                                                   - 0.5_wp * zcu   * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) )
-               END DO
-            END DO
+               pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (         (                      pt  (ji+1,jj,jl) + pt  (ji,jj,jl)     &
+                  &                                                            - zcu   * ( pt  (ji+1,jj,jl) - pt  (ji,jj,jl) ) ) &
+                  &        + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) *    (                      ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl)     &
+                  &                                                   - 0.5_wp * zcu   * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) )
+            END_2D
          END DO
          !
@@ -948,18 +893,16 @@
          !
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
-                  zdx2 = e1u(ji,jj) * e1u(ji,jj)
+            DO_2D_10_10
+               zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
+               zdx2 = e1u(ji,jj) * e1u(ji,jj)
 !!rachid          zdx2 = e1u(ji,jj) * e1t(ji,jj)
-                  zdx4 = zdx2 * zdx2
-                  pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (        (                       pt  (ji+1,jj,jl) + pt  (ji,jj,jl)     &
-                     &                                                            - zcu   * ( pt  (ji+1,jj,jl) - pt  (ji,jj,jl) ) ) &
-                     &        + z1_6   * zdx2 * ( zcu*zcu - 1._wp ) * (                       ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl)     &
-                     &                                                   - 0.5_wp * zcu   * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) &
-                     &        + z1_120 * zdx4 * ( zcu*zcu - 1._wp ) * ( zcu*zcu - 4._wp ) * ( ztu4(ji+1,jj,jl) + ztu4(ji,jj,jl)     &
-                     &                                               - SIGN( 1._wp, zcu ) * ( ztu4(ji+1,jj,jl) - ztu4(ji,jj,jl) ) ) )
-               END DO
-            END DO
+               zdx4 = zdx2 * zdx2
+               pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (        (                       pt  (ji+1,jj,jl) + pt  (ji,jj,jl)     &
+                  &                                                            - zcu   * ( pt  (ji+1,jj,jl) - pt  (ji,jj,jl) ) ) &
+                  &        + z1_6   * zdx2 * ( zcu*zcu - 1._wp ) * (                       ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl)     &
+                  &                                                   - 0.5_wp * zcu   * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) &
+                  &        + z1_120 * zdx4 * ( zcu*zcu - 1._wp ) * ( zcu*zcu - 4._wp ) * ( ztu4(ji+1,jj,jl) + ztu4(ji,jj,jl)     &
+                  &                                               - SIGN( 1._wp, zcu ) * ( ztu4(ji+1,jj,jl) - ztu4(ji,jj,jl) ) ) )
+            END_2D
          END DO
          !
@@ -971,21 +914,17 @@
       IF( ll_neg ) THEN
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1
-                  IF( pt_u(ji,jj,jl) < 0._wp .OR. ( imsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN
-                     pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   &
-                        &                                         - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) )
-                  ENDIF
-               END DO
-            END DO
+            DO_2D_10_10
+               IF( pt_u(ji,jj,jl) < 0._wp .OR. ( imsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN
+                  pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   &
+                     &                                         - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) )
+               ENDIF
+            END_2D
          END DO
       ENDIF
       !                                                     !-- High order flux in i-direction  --!
       DO jl = 1, jpl
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               pfu_ho(ji,jj,jl) = pu(ji,jj) * pt_u(ji,jj,jl)
-            END DO
-         END DO
+         DO_2D_10_10
+            pfu_ho(ji,jj,jl) = pu(ji,jj) * pt_u(ji,jj,jl)
+         END_2D
       END DO
       !
@@ -1018,14 +957,10 @@
       !                                                     !--  Laplacian in j-direction  --!
       DO jl = 1, jpl
-         DO jj = 1, jpjm1         ! First derivative (gradient)
-            DO ji = fs_2, fs_jpim1
-               ztv1(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1)
-            END DO
-         END DO
-         DO jj = 2, jpjm1         ! Second derivative (Laplacian)
-            DO ji = fs_2, fs_jpim1
-               ztv2(ji,jj,jl) = ( ztv1(ji,jj,jl) - ztv1(ji,jj-1,jl) ) * r1_e2t(ji,jj)
-            END DO
-         END DO
+         DO_2D_10_00
+            ztv1(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1)
+         END_2D
+         DO_2D_00_00
+            ztv2(ji,jj,jl) = ( ztv1(ji,jj,jl) - ztv1(ji,jj-1,jl) ) * r1_e2t(ji,jj)
+         END_2D
       END DO
       CALL lbc_lnk( 'icedyn_adv_umx', ztv2, 'T', 1. )
@@ -1033,14 +968,10 @@
       !                                                     !--  BiLaplacian in j-direction  --!
       DO jl = 1, jpl
-         DO jj = 1, jpjm1         ! First derivative
-            DO ji = fs_2, fs_jpim1
-               ztv3(ji,jj,jl) = ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1)
-            END DO
-         END DO
-         DO jj = 2, jpjm1         ! Second derivative
-            DO ji = fs_2, fs_jpim1
-               ztv4(ji,jj,jl) = ( ztv3(ji,jj,jl) - ztv3(ji,jj-1,jl) ) * r1_e2t(ji,jj)
-            END DO
-         END DO
+         DO_2D_10_00
+            ztv3(ji,jj,jl) = ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1)
+         END_2D
+         DO_2D_00_00
+            ztv4(ji,jj,jl) = ( ztv3(ji,jj,jl) - ztv3(ji,jj-1,jl) ) * r1_e2t(ji,jj)
+         END_2D
       END DO
       CALL lbc_lnk( 'icedyn_adv_umx', ztv4, 'T', 1. )
@@ -1051,69 +982,59 @@
       CASE( 1 )                                                !==  1st order central TIM  ==! (Eq. 21)
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1
-                  pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                                pt(ji,jj+1,jl) + pt(ji,jj,jl)   &
-                     &                                         - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) )
-               END DO
-            END DO
+            DO_2D_10_10
+               pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                                pt(ji,jj+1,jl) + pt(ji,jj,jl)   &
+                  &                                         - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) )
+            END_2D
          END DO
          !
       CASE( 2 )                                                !==  2nd order central TIM  ==! (Eq. 23)
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1
-                  zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
-                  pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                                pt(ji,jj+1,jl) + pt(ji,jj,jl)   &
-                     &                                                            - zcv *   ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) )
-               END DO
-            END DO
+            DO_2D_10_10
+               zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
+               pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                                pt(ji,jj+1,jl) + pt(ji,jj,jl)   &
+                  &                                                            - zcv *   ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) )
+            END_2D
          END DO
          !
       CASE( 3 )                                                !==  3rd order central TIM  ==! (Eq. 24)
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1
-                  zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
-                  zdy2 = e2v(ji,jj) * e2v(ji,jj)
+            DO_2D_10_10
+               zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
+               zdy2 = e2v(ji,jj) * e2v(ji,jj)
 !!rachid          zdy2 = e2v(ji,jj) * e2t(ji,jj)
-                  pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (      (                         pt  (ji,jj+1,jl) + pt  (ji,jj,jl)     &
-                     &                                                            - zcv   * ( pt  (ji,jj+1,jl) - pt  (ji,jj,jl) ) ) &
-                     &        + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * (                         ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl)     &
-                     &                                               - SIGN( 1._wp, zcv ) * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) )
-               END DO
-            END DO
+               pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (      (                         pt  (ji,jj+1,jl) + pt  (ji,jj,jl)     &
+                  &                                                            - zcv   * ( pt  (ji,jj+1,jl) - pt  (ji,jj,jl) ) ) &
+                  &        + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * (                         ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl)     &
+                  &                                               - SIGN( 1._wp, zcv ) * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) )
+            END_2D
          END DO
          !
       CASE( 4 )                                                !==  4th order central TIM  ==! (Eq. 27)
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1
-                  zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
-                  zdy2 = e2v(ji,jj) * e2v(ji,jj)
+            DO_2D_10_10
+               zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
+               zdy2 = e2v(ji,jj) * e2v(ji,jj)
 !!rachid          zdy2 = e2v(ji,jj) * e2t(ji,jj)
-                  pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (      (                         pt  (ji,jj+1,jl) + pt  (ji,jj,jl)     &
-                     &                                                            - zcv   * ( pt  (ji,jj+1,jl) - pt  (ji,jj,jl) ) ) &
-                     &        + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * (                         ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl)     &
-                     &                                                   - 0.5_wp * zcv   * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) )
-               END DO
-            END DO
+               pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (      (                         pt  (ji,jj+1,jl) + pt  (ji,jj,jl)     &
+                  &                                                            - zcv   * ( pt  (ji,jj+1,jl) - pt  (ji,jj,jl) ) ) &
+                  &        + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * (                         ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl)     &
+                  &                                                   - 0.5_wp * zcv   * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) )
+            END_2D
          END DO
          !
       CASE( 5 )                                                !==  5th order central TIM  ==! (Eq. 29)
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1
-                  zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
-                  zdy2 = e2v(ji,jj) * e2v(ji,jj)
+            DO_2D_10_10
+               zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
+               zdy2 = e2v(ji,jj) * e2v(ji,jj)
 !!rachid          zdy2 = e2v(ji,jj) * e2t(ji,jj)
-                  zdy4 = zdy2 * zdy2
-                  pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                              ( pt  (ji,jj+1,jl) + pt  (ji,jj,jl)     &
-                     &                                                            - zcv   * ( pt  (ji,jj+1,jl) - pt  (ji,jj,jl) ) ) &
-                     &        + z1_6   * zdy2 * ( zcv*zcv - 1._wp ) * (                       ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl)     &
-                     &                                                   - 0.5_wp * zcv   * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) &
-                     &        + z1_120 * zdy4 * ( zcv*zcv - 1._wp ) * ( zcv*zcv - 4._wp ) * ( ztv4(ji,jj+1,jl) + ztv4(ji,jj,jl)     &
-                     &                                               - SIGN( 1._wp, zcv ) * ( ztv4(ji,jj+1,jl) - ztv4(ji,jj,jl) ) ) )
-               END DO
-            END DO
+               zdy4 = zdy2 * zdy2
+               pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                              ( pt  (ji,jj+1,jl) + pt  (ji,jj,jl)     &
+                  &                                                            - zcv   * ( pt  (ji,jj+1,jl) - pt  (ji,jj,jl) ) ) &
+                  &        + z1_6   * zdy2 * ( zcv*zcv - 1._wp ) * (                       ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl)     &
+                  &                                                   - 0.5_wp * zcv   * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) &
+                  &        + z1_120 * zdy4 * ( zcv*zcv - 1._wp ) * ( zcv*zcv - 4._wp ) * ( ztv4(ji,jj+1,jl) + ztv4(ji,jj,jl)     &
+                  &                                               - SIGN( 1._wp, zcv ) * ( ztv4(ji,jj+1,jl) - ztv4(ji,jj,jl) ) ) )
+            END_2D
          END DO
          !
@@ -1125,21 +1046,17 @@
       IF( ll_neg ) THEN
          DO jl = 1, jpl
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1
-                  IF( pt_v(ji,jj,jl) < 0._wp .OR. ( jmsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN
-                     pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                              ( pt(ji,jj+1,jl) + pt(ji,jj,jl) )  &
-                        &                                         - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) )
-                  ENDIF
-               END DO
-            END DO
+            DO_2D_10_10
+               IF( pt_v(ji,jj,jl) < 0._wp .OR. ( jmsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN
+                  pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                              ( pt(ji,jj+1,jl) + pt(ji,jj,jl) )  &
+                     &                                         - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) )
+               ENDIF
+            END_2D
          END DO
       ENDIF
       !                                                     !-- High order flux in j-direction  --!
       DO jl = 1, jpl
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               pfv_ho(ji,jj,jl) = pv(ji,jj) * pt_v(ji,jj,jl)
-            END DO
-         END DO
+         DO_2D_10_10
+            pfv_ho(ji,jj,jl) = pv(ji,jj) * pt_v(ji,jj,jl)
+         END_2D
       END DO
       !
@@ -1175,10 +1092,8 @@
       ! --------------------------------------------------
       DO jl = 1, jpl
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl)
-               pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl)
-            END DO
-         END DO
+         DO_2D_10_10
+            pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl)
+            pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl)
+         END_2D
       END DO
 
@@ -1194,34 +1109,30 @@
          
          DO jl = 1, jpl
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1 
-                  zti_ups(ji,jj,jl)= pt_ups(ji+1,jj  ,jl)
-                  ztj_ups(ji,jj,jl)= pt_ups(ji  ,jj+1,jl)
-               END DO
-            END DO
+            DO_2D_00_00
+               zti_ups(ji,jj,jl)= pt_ups(ji+1,jj  ,jl)
+               ztj_ups(ji,jj,jl)= pt_ups(ji  ,jj+1,jl)
+            END_2D
          END DO
          CALL lbc_lnk_multi( 'icedyn_adv_umx', zti_ups, 'T', 1., ztj_ups, 'T', 1. )
 
          DO jl = 1, jpl
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  IF ( pfu_ho(ji,jj,jl) * ( pt_ups(ji+1,jj  ,jl) - pt_ups(ji,jj,jl) ) <= 0._wp .AND.  &
-                     & pfv_ho(ji,jj,jl) * ( pt_ups(ji  ,jj+1,jl) - pt_ups(ji,jj,jl) ) <= 0._wp ) THEN
-                     !
-                     IF(  pfu_ho(ji,jj,jl) * ( zti_ups(ji+1,jj  ,jl) - zti_ups(ji,jj,jl) ) <= 0._wp .AND.  &
-                        & pfv_ho(ji,jj,jl) * ( ztj_ups(ji  ,jj+1,jl) - ztj_ups(ji,jj,jl) ) <= 0._wp ) THEN
-                        pfu_ho(ji,jj,jl)=0._wp
-                        pfv_ho(ji,jj,jl)=0._wp
-                     ENDIF
-                     !
-                     IF(  pfu_ho(ji,jj,jl) * ( pt_ups(ji,jj,jl) - pt_ups(ji-1,jj  ,jl) ) <= 0._wp .AND.  &
-                        & pfv_ho(ji,jj,jl) * ( pt_ups(ji,jj,jl) - pt_ups(ji  ,jj-1,jl) ) <= 0._wp ) THEN
-                        pfu_ho(ji,jj,jl)=0._wp
-                        pfv_ho(ji,jj,jl)=0._wp
-                     ENDIF
-                     !
+            DO_2D_00_00
+               IF ( pfu_ho(ji,jj,jl) * ( pt_ups(ji+1,jj  ,jl) - pt_ups(ji,jj,jl) ) <= 0._wp .AND.  &
+                  & pfv_ho(ji,jj,jl) * ( pt_ups(ji  ,jj+1,jl) - pt_ups(ji,jj,jl) ) <= 0._wp ) THEN
+                  !
+                  IF(  pfu_ho(ji,jj,jl) * ( zti_ups(ji+1,jj  ,jl) - zti_ups(ji,jj,jl) ) <= 0._wp .AND.  &
+                     & pfv_ho(ji,jj,jl) * ( ztj_ups(ji  ,jj+1,jl) - ztj_ups(ji,jj,jl) ) <= 0._wp ) THEN
+                     pfu_ho(ji,jj,jl)=0._wp
+                     pfv_ho(ji,jj,jl)=0._wp
                   ENDIF
-               END DO
-            END DO
+                  !
+                  IF(  pfu_ho(ji,jj,jl) * ( pt_ups(ji,jj,jl) - pt_ups(ji-1,jj  ,jl) ) <= 0._wp .AND.  &
+                     & pfv_ho(ji,jj,jl) * ( pt_ups(ji,jj,jl) - pt_ups(ji  ,jj-1,jl) ) <= 0._wp ) THEN
+                     pfu_ho(ji,jj,jl)=0._wp
+                     pfv_ho(ji,jj,jl)=0._wp
+                  ENDIF
+                  !
+               ENDIF
+            END_2D
          END DO
          CALL lbc_lnk_multi( 'icedyn_adv_umx', pfu_ho, 'U', -1., pfv_ho, 'V', -1. )   ! lateral boundary cond.
@@ -1235,54 +1146,50 @@
       DO jl = 1, jpl
          
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF    ( pt(ji,jj,jl) <= 0._wp .AND. pt_ups(ji,jj,jl) <= 0._wp ) THEN
-                  zbup(ji,jj) = -zbig
-                  zbdo(ji,jj) =  zbig
-               ELSEIF( pt(ji,jj,jl) <= 0._wp .AND. pt_ups(ji,jj,jl) > 0._wp ) THEN
-                  zbup(ji,jj) = pt_ups(ji,jj,jl)
-                  zbdo(ji,jj) = pt_ups(ji,jj,jl)
-               ELSEIF( pt(ji,jj,jl) > 0._wp .AND. pt_ups(ji,jj,jl) <= 0._wp ) THEN
-                  zbup(ji,jj) = pt(ji,jj,jl)
-                  zbdo(ji,jj) = pt(ji,jj,jl)
-               ELSE
-                  zbup(ji,jj) = MAX( pt(ji,jj,jl) , pt_ups(ji,jj,jl) )
-                  zbdo(ji,jj) = MIN( pt(ji,jj,jl) , pt_ups(ji,jj,jl) )
-               ENDIF
-            END DO
-         END DO
-
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               !
-               zup  = MAX( zbup(ji,jj), zbup(ji-1,jj), zbup(ji+1,jj), zbup(ji,jj-1), zbup(ji,jj+1) )  ! search max/min in neighbourhood
-               zdo  = MIN( zbdo(ji,jj), zbdo(ji-1,jj), zbdo(ji+1,jj), zbdo(ji,jj-1), zbdo(ji,jj+1) )
-               !
-               zpos = MAX( 0._wp, pfu_ho(ji-1,jj  ,jl) ) - MIN( 0._wp, pfu_ho(ji  ,jj  ,jl) ) &  ! positive/negative part of the flux
-                  & + MAX( 0._wp, pfv_ho(ji  ,jj-1,jl) ) - MIN( 0._wp, pfv_ho(ji  ,jj  ,jl) )
-               zneg = MAX( 0._wp, pfu_ho(ji  ,jj  ,jl) ) - MIN( 0._wp, pfu_ho(ji-1,jj  ,jl) ) &
-                  & + MAX( 0._wp, pfv_ho(ji  ,jj  ,jl) ) - MIN( 0._wp, pfv_ho(ji  ,jj-1,jl) )
-               !
-               zpos = zpos - (pt(ji,jj,jl) * MIN( 0., pu(ji,jj) - pu(ji-1,jj) ) + pt(ji,jj,jl) * MIN( 0., pv(ji,jj) - pv(ji,jj-1) ) &
-                  &          ) * ( 1. - pamsk )
-               zneg = zneg + (pt(ji,jj,jl) * MAX( 0., pu(ji,jj) - pu(ji-1,jj) ) + pt(ji,jj,jl) * MAX( 0., pv(ji,jj) - pv(ji,jj-1) ) &
-                  &          ) * ( 1. - pamsk )
-               !
-               !                                  ! up & down beta terms
-               ! clem: zbetup and zbetdo must be 0 for zpos>1.e-10 & zneg>1.e-10 (do not put 0 instead of 1.e-10 !!!)
-               IF( zpos > epsi10 ) THEN ; zbetup(ji,jj,jl) = MAX( 0._wp, zup - pt_ups(ji,jj,jl) ) / zpos * e1e2t(ji,jj) * z1_dt
-               ELSE                     ; zbetup(ji,jj,jl) = 0._wp ! zbig
-               ENDIF
-               !
-               IF( zneg > epsi10 ) THEN ; zbetdo(ji,jj,jl) = MAX( 0._wp, pt_ups(ji,jj,jl) - zdo ) / zneg * e1e2t(ji,jj) * z1_dt
-               ELSE                     ; zbetdo(ji,jj,jl) = 0._wp ! zbig
-               ENDIF
-               !
-               ! if all the points are outside ice cover
-               IF( zup == -zbig )   zbetup(ji,jj,jl) = 0._wp ! zbig
-               IF( zdo ==  zbig )   zbetdo(ji,jj,jl) = 0._wp ! zbig            
-               !
-            END DO
-         END DO
+         DO_2D_11_11
+            IF    ( pt(ji,jj,jl) <= 0._wp .AND. pt_ups(ji,jj,jl) <= 0._wp ) THEN
+               zbup(ji,jj) = -zbig
+               zbdo(ji,jj) =  zbig
+            ELSEIF( pt(ji,jj,jl) <= 0._wp .AND. pt_ups(ji,jj,jl) > 0._wp ) THEN
+               zbup(ji,jj) = pt_ups(ji,jj,jl)
+               zbdo(ji,jj) = pt_ups(ji,jj,jl)
+            ELSEIF( pt(ji,jj,jl) > 0._wp .AND. pt_ups(ji,jj,jl) <= 0._wp ) THEN
+               zbup(ji,jj) = pt(ji,jj,jl)
+               zbdo(ji,jj) = pt(ji,jj,jl)
+            ELSE
+               zbup(ji,jj) = MAX( pt(ji,jj,jl) , pt_ups(ji,jj,jl) )
+               zbdo(ji,jj) = MIN( pt(ji,jj,jl) , pt_ups(ji,jj,jl) )
+            ENDIF
+         END_2D
+
+         DO_2D_00_00
+            !
+            zup  = MAX( zbup(ji,jj), zbup(ji-1,jj), zbup(ji+1,jj), zbup(ji,jj-1), zbup(ji,jj+1) )  ! search max/min in neighbourhood
+            zdo  = MIN( zbdo(ji,jj), zbdo(ji-1,jj), zbdo(ji+1,jj), zbdo(ji,jj-1), zbdo(ji,jj+1) )
+            !
+            zpos = MAX( 0._wp, pfu_ho(ji-1,jj  ,jl) ) - MIN( 0._wp, pfu_ho(ji  ,jj  ,jl) ) &  ! positive/negative part of the flux
+               & + MAX( 0._wp, pfv_ho(ji  ,jj-1,jl) ) - MIN( 0._wp, pfv_ho(ji  ,jj  ,jl) )
+            zneg = MAX( 0._wp, pfu_ho(ji  ,jj  ,jl) ) - MIN( 0._wp, pfu_ho(ji-1,jj  ,jl) ) &
+               & + MAX( 0._wp, pfv_ho(ji  ,jj  ,jl) ) - MIN( 0._wp, pfv_ho(ji  ,jj-1,jl) )
+            !
+            zpos = zpos - (pt(ji,jj,jl) * MIN( 0., pu(ji,jj) - pu(ji-1,jj) ) + pt(ji,jj,jl) * MIN( 0., pv(ji,jj) - pv(ji,jj-1) ) &
+               &          ) * ( 1. - pamsk )
+            zneg = zneg + (pt(ji,jj,jl) * MAX( 0., pu(ji,jj) - pu(ji-1,jj) ) + pt(ji,jj,jl) * MAX( 0., pv(ji,jj) - pv(ji,jj-1) ) &
+               &          ) * ( 1. - pamsk )
+            !
+            !                                  ! up & down beta terms
+            ! clem: zbetup and zbetdo must be 0 for zpos>1.e-10 & zneg>1.e-10 (do not put 0 instead of 1.e-10 !!!)
+            IF( zpos > epsi10 ) THEN ; zbetup(ji,jj,jl) = MAX( 0._wp, zup - pt_ups(ji,jj,jl) ) / zpos * e1e2t(ji,jj) * z1_dt
+            ELSE                     ; zbetup(ji,jj,jl) = 0._wp ! zbig
+            ENDIF
+            !
+            IF( zneg > epsi10 ) THEN ; zbetdo(ji,jj,jl) = MAX( 0._wp, pt_ups(ji,jj,jl) - zdo ) / zneg * e1e2t(ji,jj) * z1_dt
+            ELSE                     ; zbetdo(ji,jj,jl) = 0._wp ! zbig
+            ENDIF
+            !
+            ! if all the points are outside ice cover
+            IF( zup == -zbig )   zbetup(ji,jj,jl) = 0._wp ! zbig
+            IF( zdo ==  zbig )   zbetdo(ji,jj,jl) = 0._wp ! zbig            
+            !
+         END_2D
       END DO
       CALL lbc_lnk_multi( 'icedyn_adv_umx', zbetup, 'T', 1., zbetdo, 'T', 1. )   ! lateral boundary cond. (unchanged sign)
@@ -1292,29 +1199,25 @@
       ! ---------------------------------
       DO jl = 1, jpl
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zau = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji+1,jj,jl) )
-               zbu = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji+1,jj,jl) )
-               zcu = 0.5_wp + SIGN( 0.5_wp , pfu_ho(ji,jj,jl) )
-               !
-               zcoef = ( zcu * zau + ( 1._wp - zcu ) * zbu )
-               !
-               pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) * zcoef + pfu_ups(ji,jj,jl)
-               !
-            END DO
-         END DO
-
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zav = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji,jj+1,jl) )
-               zbv = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji,jj+1,jl) )
-               zcv = 0.5_wp + SIGN( 0.5_wp , pfv_ho(ji,jj,jl) )
-               !
-               zcoef = ( zcv * zav + ( 1._wp - zcv ) * zbv )
-               !
-               pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) * zcoef + pfv_ups(ji,jj,jl)
-               !
-            END DO
-         END DO
+         DO_2D_10_10
+            zau = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji+1,jj,jl) )
+            zbu = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji+1,jj,jl) )
+            zcu = 0.5_wp + SIGN( 0.5_wp , pfu_ho(ji,jj,jl) )
+            !
+            zcoef = ( zcu * zau + ( 1._wp - zcu ) * zbu )
+            !
+            pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) * zcoef + pfu_ups(ji,jj,jl)
+            !
+         END_2D
+
+         DO_2D_10_10
+            zav = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji,jj+1,jl) )
+            zbv = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji,jj+1,jl) )
+            zcv = 0.5_wp + SIGN( 0.5_wp , pfv_ho(ji,jj,jl) )
+            !
+            zcoef = ( zcv * zav + ( 1._wp - zcv ) * zbv )
+            !
+            pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) * zcoef + pfv_ups(ji,jj,jl)
+            !
+         END_2D
 
       END DO
@@ -1341,75 +1244,71 @@
       !
       DO jl = 1, jpl
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zslpx(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * umask(ji,jj,1)
-            END DO
-         END DO
+         DO_2D_00_00
+            zslpx(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * umask(ji,jj,1)
+         END_2D
       END DO
       CALL lbc_lnk( 'icedyn_adv_umx', zslpx, 'U', -1.)   ! lateral boundary cond.
       
       DO jl = 1, jpl
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               uCFL = pdt * ABS( pu(ji,jj) ) * r1_e1e2t(ji,jj)
-               
-               Rjm = zslpx(ji-1,jj,jl)
-               Rj  = zslpx(ji  ,jj,jl)
-               Rjp = zslpx(ji+1,jj,jl)
-
-               IF( np_limiter == 3 ) THEN
-
-                  IF( pu(ji,jj) > 0. ) THEN   ;   Rr = Rjm
-                  ELSE                        ;   Rr = Rjp
+         DO_2D_00_00
+            uCFL = pdt * ABS( pu(ji,jj) ) * r1_e1e2t(ji,jj)
+            
+            Rjm = zslpx(ji-1,jj,jl)
+            Rj  = zslpx(ji  ,jj,jl)
+            Rjp = zslpx(ji+1,jj,jl)
+
+            IF( np_limiter == 3 ) THEN
+
+               IF( pu(ji,jj) > 0. ) THEN   ;   Rr = Rjm
+               ELSE                        ;   Rr = Rjp
+               ENDIF
+
+               zh3 = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl)     
+               IF( Rj > 0. ) THEN
+                  zlimiter =  MAX( 0., MIN( zh3, MAX(-Rr * 0.5 * ABS(pu(ji,jj)),  &
+                     &        MIN( 2. * Rr * 0.5 * ABS(pu(ji,jj)),  zh3,  1.5 * Rj * 0.5 * ABS(pu(ji,jj)) ) ) ) )
+               ELSE
+                  zlimiter = -MAX( 0., MIN(-zh3, MAX( Rr * 0.5 * ABS(pu(ji,jj)),  &
+                     &        MIN(-2. * Rr * 0.5 * ABS(pu(ji,jj)), -zh3, -1.5 * Rj * 0.5 * ABS(pu(ji,jj)) ) ) ) )
+               ENDIF
+               pfu_ho(ji,jj,jl) = pfu_ups(ji,jj,jl) + zlimiter
+
+            ELSEIF( np_limiter == 2 ) THEN
+               IF( Rj /= 0. ) THEN
+                  IF( pu(ji,jj) > 0. ) THEN   ;   Cr = Rjm / Rj
+                  ELSE                        ;   Cr = Rjp / Rj
                   ENDIF
-
-                  zh3 = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl)     
-                  IF( Rj > 0. ) THEN
-                     zlimiter =  MAX( 0., MIN( zh3, MAX(-Rr * 0.5 * ABS(pu(ji,jj)),  &
-                        &        MIN( 2. * Rr * 0.5 * ABS(pu(ji,jj)),  zh3,  1.5 * Rj * 0.5 * ABS(pu(ji,jj)) ) ) ) )
-                  ELSE
-                     zlimiter = -MAX( 0., MIN(-zh3, MAX( Rr * 0.5 * ABS(pu(ji,jj)),  &
-                        &        MIN(-2. * Rr * 0.5 * ABS(pu(ji,jj)), -zh3, -1.5 * Rj * 0.5 * ABS(pu(ji,jj)) ) ) ) )
-                  ENDIF
-                  pfu_ho(ji,jj,jl) = pfu_ups(ji,jj,jl) + zlimiter
-
-               ELSEIF( np_limiter == 2 ) THEN
-                  IF( Rj /= 0. ) THEN
-                     IF( pu(ji,jj) > 0. ) THEN   ;   Cr = Rjm / Rj
-                     ELSE                        ;   Cr = Rjp / Rj
-                     ENDIF
-                  ELSE
-                     Cr = 0.
-                  ENDIF
-
-                  ! -- superbee --
-                  zpsi = MAX( 0., MAX( MIN(1.,2.*Cr), MIN(2.,Cr) ) )
-                  ! -- van albada 2 --
-                  !!zpsi = 2.*Cr / (Cr*Cr+1.)
-                  ! -- sweby (with beta=1) --
-                  !!zpsi = MAX( 0., MAX( MIN(1.,1.*Cr), MIN(1.,Cr) ) )
-                  ! -- van Leer --
-                  !!zpsi = ( Cr + ABS(Cr) ) / ( 1. + ABS(Cr) )
-                  ! -- ospre --
-                  !!zpsi = 1.5 * ( Cr*Cr + Cr ) / ( Cr*Cr + Cr + 1. )
-                  ! -- koren --
-                  !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( (1.+2*Cr)/3., 2. ) ) )
-                  ! -- charm --
-                  !IF( Cr > 0. ) THEN   ;   zpsi = Cr * (3.*Cr + 1.) / ( (Cr + 1.) * (Cr + 1.) )
-                  !ELSE                 ;   zpsi = 0.
-                  !ENDIF
-                  ! -- van albada 1 --
-                  !!zpsi = (Cr*Cr + Cr) / (Cr*Cr +1)
-                  ! -- smart --
-                  !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, 4. ) ) )
-                  ! -- umist --
-                  !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, MIN(0.75+0.25*Cr, 2. ) ) ) )
-
-                  ! high order flux corrected by the limiter
-                  pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) - ABS( pu(ji,jj) ) * ( (1.-zpsi) + uCFL*zpsi ) * Rj * 0.5
-
+               ELSE
+                  Cr = 0.
                ENDIF
-            END DO
-         END DO
+
+               ! -- superbee --
+               zpsi = MAX( 0., MAX( MIN(1.,2.*Cr), MIN(2.,Cr) ) )
+               ! -- van albada 2 --
+               !!zpsi = 2.*Cr / (Cr*Cr+1.)
+               ! -- sweby (with beta=1) --
+               !!zpsi = MAX( 0., MAX( MIN(1.,1.*Cr), MIN(1.,Cr) ) )
+               ! -- van Leer --
+               !!zpsi = ( Cr + ABS(Cr) ) / ( 1. + ABS(Cr) )
+               ! -- ospre --
+               !!zpsi = 1.5 * ( Cr*Cr + Cr ) / ( Cr*Cr + Cr + 1. )
+               ! -- koren --
+               !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( (1.+2*Cr)/3., 2. ) ) )
+               ! -- charm --
+               !IF( Cr > 0. ) THEN   ;   zpsi = Cr * (3.*Cr + 1.) / ( (Cr + 1.) * (Cr + 1.) )
+               !ELSE                 ;   zpsi = 0.
+               !ENDIF
+               ! -- van albada 1 --
+               !!zpsi = (Cr*Cr + Cr) / (Cr*Cr +1)
+               ! -- smart --
+               !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, 4. ) ) )
+               ! -- umist --
+               !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, MIN(0.75+0.25*Cr, 2. ) ) ) )
+
+               ! high order flux corrected by the limiter
+               pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) - ABS( pu(ji,jj) ) * ( (1.-zpsi) + uCFL*zpsi ) * Rj * 0.5
+
+            ENDIF
+         END_2D
       END DO
       CALL lbc_lnk( 'icedyn_adv_umx', pfu_ho, 'U', -1.)   ! lateral boundary cond.
@@ -1436,76 +1335,72 @@
       !
       DO jl = 1, jpl
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zslpy(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * vmask(ji,jj,1)
-            END DO
-         END DO
+         DO_2D_00_00
+            zslpy(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * vmask(ji,jj,1)
+         END_2D
       END DO
       CALL lbc_lnk( 'icedyn_adv_umx', zslpy, 'V', -1.)   ! lateral boundary cond.
 
       DO jl = 1, jpl
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               vCFL = pdt * ABS( pv(ji,jj) ) * r1_e1e2t(ji,jj)
-
-               Rjm = zslpy(ji,jj-1,jl)
-               Rj  = zslpy(ji,jj  ,jl)
-               Rjp = zslpy(ji,jj+1,jl)
-
-               IF( np_limiter == 3 ) THEN
-
-                  IF( pv(ji,jj) > 0. ) THEN   ;   Rr = Rjm
-                  ELSE                        ;   Rr = Rjp
+         DO_2D_00_00
+            vCFL = pdt * ABS( pv(ji,jj) ) * r1_e1e2t(ji,jj)
+
+            Rjm = zslpy(ji,jj-1,jl)
+            Rj  = zslpy(ji,jj  ,jl)
+            Rjp = zslpy(ji,jj+1,jl)
+
+            IF( np_limiter == 3 ) THEN
+
+               IF( pv(ji,jj) > 0. ) THEN   ;   Rr = Rjm
+               ELSE                        ;   Rr = Rjp
+               ENDIF
+
+               zh3 = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl)     
+               IF( Rj > 0. ) THEN
+                  zlimiter =  MAX( 0., MIN( zh3, MAX(-Rr * 0.5 * ABS(pv(ji,jj)),  &
+                     &        MIN( 2. * Rr * 0.5 * ABS(pv(ji,jj)),  zh3,  1.5 * Rj * 0.5 * ABS(pv(ji,jj)) ) ) ) )
+               ELSE
+                  zlimiter = -MAX( 0., MIN(-zh3, MAX( Rr * 0.5 * ABS(pv(ji,jj)),  &
+                     &        MIN(-2. * Rr * 0.5 * ABS(pv(ji,jj)), -zh3, -1.5 * Rj * 0.5 * ABS(pv(ji,jj)) ) ) ) )
+               ENDIF
+               pfv_ho(ji,jj,jl) = pfv_ups(ji,jj,jl) + zlimiter
+
+            ELSEIF( np_limiter == 2 ) THEN
+
+               IF( Rj /= 0. ) THEN
+                  IF( pv(ji,jj) > 0. ) THEN   ;   Cr = Rjm / Rj
+                  ELSE                        ;   Cr = Rjp / Rj
                   ENDIF
-
-                  zh3 = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl)     
-                  IF( Rj > 0. ) THEN
-                     zlimiter =  MAX( 0., MIN( zh3, MAX(-Rr * 0.5 * ABS(pv(ji,jj)),  &
-                        &        MIN( 2. * Rr * 0.5 * ABS(pv(ji,jj)),  zh3,  1.5 * Rj * 0.5 * ABS(pv(ji,jj)) ) ) ) )
-                  ELSE
-                     zlimiter = -MAX( 0., MIN(-zh3, MAX( Rr * 0.5 * ABS(pv(ji,jj)),  &
-                        &        MIN(-2. * Rr * 0.5 * ABS(pv(ji,jj)), -zh3, -1.5 * Rj * 0.5 * ABS(pv(ji,jj)) ) ) ) )
-                  ENDIF
-                  pfv_ho(ji,jj,jl) = pfv_ups(ji,jj,jl) + zlimiter
-
-               ELSEIF( np_limiter == 2 ) THEN
-
-                  IF( Rj /= 0. ) THEN
-                     IF( pv(ji,jj) > 0. ) THEN   ;   Cr = Rjm / Rj
-                     ELSE                        ;   Cr = Rjp / Rj
-                     ENDIF
-                  ELSE
-                     Cr = 0.
-                  ENDIF
-
-                  ! -- superbee --
-                  zpsi = MAX( 0., MAX( MIN(1.,2.*Cr), MIN(2.,Cr) ) )
-                  ! -- van albada 2 --
-                  !!zpsi = 2.*Cr / (Cr*Cr+1.)
-                  ! -- sweby (with beta=1) --
-                  !!zpsi = MAX( 0., MAX( MIN(1.,1.*Cr), MIN(1.,Cr) ) )
-                  ! -- van Leer --
-                  !!zpsi = ( Cr + ABS(Cr) ) / ( 1. + ABS(Cr) )
-                  ! -- ospre --
-                  !!zpsi = 1.5 * ( Cr*Cr + Cr ) / ( Cr*Cr + Cr + 1. )
-                  ! -- koren --
-                  !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( (1.+2*Cr)/3., 2. ) ) )
-                  ! -- charm --
-                  !IF( Cr > 0. ) THEN   ;   zpsi = Cr * (3.*Cr + 1.) / ( (Cr + 1.) * (Cr + 1.) )
-                  !ELSE                 ;   zpsi = 0.
-                  !ENDIF
-                  ! -- van albada 1 --
-                  !!zpsi = (Cr*Cr + Cr) / (Cr*Cr +1)
-                  ! -- smart --
-                  !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, 4. ) ) )
-                  ! -- umist --
-                  !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, MIN(0.75+0.25*Cr, 2. ) ) ) )
-
-                  ! high order flux corrected by the limiter
-                  pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) - ABS( pv(ji,jj) ) * ( (1.-zpsi) + vCFL*zpsi ) * Rj * 0.5
-
+               ELSE
+                  Cr = 0.
                ENDIF
-            END DO
-         END DO
+
+               ! -- superbee --
+               zpsi = MAX( 0., MAX( MIN(1.,2.*Cr), MIN(2.,Cr) ) )
+               ! -- van albada 2 --
+               !!zpsi = 2.*Cr / (Cr*Cr+1.)
+               ! -- sweby (with beta=1) --
+               !!zpsi = MAX( 0., MAX( MIN(1.,1.*Cr), MIN(1.,Cr) ) )
+               ! -- van Leer --
+               !!zpsi = ( Cr + ABS(Cr) ) / ( 1. + ABS(Cr) )
+               ! -- ospre --
+               !!zpsi = 1.5 * ( Cr*Cr + Cr ) / ( Cr*Cr + Cr + 1. )
+               ! -- koren --
+               !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( (1.+2*Cr)/3., 2. ) ) )
+               ! -- charm --
+               !IF( Cr > 0. ) THEN   ;   zpsi = Cr * (3.*Cr + 1.) / ( (Cr + 1.) * (Cr + 1.) )
+               !ELSE                 ;   zpsi = 0.
+               !ENDIF
+               ! -- van albada 1 --
+               !!zpsi = (Cr*Cr + Cr) / (Cr*Cr +1)
+               ! -- smart --
+               !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, 4. ) ) )
+               ! -- umist --
+               !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, MIN(0.75+0.25*Cr, 2. ) ) ) )
+
+               ! high order flux corrected by the limiter
+               pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) - ABS( pv(ji,jj) ) * ( (1.-zpsi) + vCFL*zpsi ) * Rj * 0.5
+
+            ENDIF
+         END_2D
       END DO
       CALL lbc_lnk( 'icedyn_adv_umx', pfv_ho, 'V', -1.)   ! lateral boundary cond.
@@ -1514,5 +1409,5 @@
 
 
-   SUBROUTINE Hbig( pdt, phi_max, phs_max, phip_max, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i )
+   SUBROUTINE Hbig( pdt, phi_max, phs_max, phip_max, pv_i, pv_s, pa_i, pa_ip, pv_ip, pe_s )
       !!-------------------------------------------------------------------
       !!                  ***  ROUTINE Hbig  ***
@@ -1525,7 +1420,4 @@
       !!              2- check whether snow thickness is larger than the surrounding 9-points
       !!                 (before advection) and reduce it by sending the excess in the ocean
-      !!              3- check whether snow load deplets the snow-ice interface below sea level$
-      !!                 and reduce it by sending the excess in the ocean
-      !!              4- correct pond concentration to avoid a_ip > a_i
       !!
       !! ** input   : Max thickness of the surrounding 9-points
@@ -1533,11 +1425,9 @@
       REAL(wp)                    , INTENT(in   ) ::   pdt                          ! tracer time-step
       REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   phi_max, phs_max, phip_max   ! max ice thick from surrounding 9-pts
-      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_i, pv_s, pa_i, pa_ip, pv_ip
       REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_s
-      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_i
-      !
-      INTEGER  ::   ji, jj, jk, jl         ! dummy loop indices
-      REAL(wp) ::   z1_dt, zhip, zhi, zhs, zvs_excess, zfra
-      REAL(wp), DIMENSION(jpi,jpj) ::   zswitch
+      !
+      INTEGER  ::   ji, jj, jl         ! dummy loop indices
+      REAL(wp) ::   z1_dt, zhip, zhi, zhs, zfra
       !!-------------------------------------------------------------------
       !
@@ -1546,61 +1436,95 @@
       DO jl = 1, jpl
 
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF ( pv_i(ji,jj,jl) > 0._wp ) THEN
+         DO_2D_11_11
+            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN
+               !
+               !                               ! -- check h_ip -- !
+               ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip
+               IF( ln_pnd_H12 .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN
+                  zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) )
+                  IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN
+                     pa_ip(ji,jj,jl) = pv_ip(ji,jj,jl) / phip_max(ji,jj,jl)
+                  ENDIF
+               ENDIF
+               !
+               !                               ! -- check h_i -- !
+               ! if h_i is larger than the surrounding 9 pts => reduce h_i and increase a_i
+               zhi = pv_i(ji,jj,jl) / pa_i(ji,jj,jl)
+               IF( zhi > phi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN
+                  pa_i(ji,jj,jl) = pv_i(ji,jj,jl) / MIN( phi_max(ji,jj,jl), hi_max(jpl) )   !-- bound h_i to hi_max (99 m)
+               ENDIF
+               !
+               !                               ! -- check h_s -- !
+               ! if h_s is larger than the surrounding 9 pts => put the snow excess in the ocean
+               zhs = pv_s(ji,jj,jl) / pa_i(ji,jj,jl)
+               IF( pv_s(ji,jj,jl) > 0._wp .AND. zhs > phs_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN
+                  zfra = phs_max(ji,jj,jl) / MAX( zhs, epsi20 )
                   !
-                  !                               ! -- check h_ip -- !
-                  ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip
-                  IF( ln_pnd_H12 .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN
-                     zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) )
-                     IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN
-                        pa_ip(ji,jj,jl) = pv_ip(ji,jj,jl) / phip_max(ji,jj,jl)
-                     ENDIF
-                  ENDIF
+                  wfx_res(ji,jj) = wfx_res(ji,jj) + ( pv_s(ji,jj,jl) - pa_i(ji,jj,jl) * phs_max(ji,jj,jl) ) * rhos * z1_dt
+                  hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0
                   !
-                  !                               ! -- check h_i -- !
-                  ! if h_i is larger than the surrounding 9 pts => reduce h_i and increase a_i
-                  zhi = pv_i(ji,jj,jl) / pa_i(ji,jj,jl)
-                  IF( zhi > phi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN
-                     pa_i(ji,jj,jl) = pv_i(ji,jj,jl) / MIN( phi_max(ji,jj,jl), hi_max(jpl) )   !-- bound h_i to hi_max (99 m)
-                  ENDIF
-                  !
-                  !                               ! -- check h_s -- !
-                  ! if h_s is larger than the surrounding 9 pts => put the snow excess in the ocean
-                  zhs = pv_s(ji,jj,jl) / pa_i(ji,jj,jl)
-                  IF( pv_s(ji,jj,jl) > 0._wp .AND. zhs > phs_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN
-                     zfra = phs_max(ji,jj,jl) / MAX( zhs, epsi20 )
-                     !
-                     wfx_res(ji,jj) = wfx_res(ji,jj) + ( pv_s(ji,jj,jl) - pa_i(ji,jj,jl) * phs_max(ji,jj,jl) ) * rhos * z1_dt
-                     hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0
-                     !
-                     pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra
-                     pv_s(ji,jj,jl)          = pa_i(ji,jj,jl) * phs_max(ji,jj,jl)
-                  ENDIF           
-                  !
-                  !                               ! -- check snow load -- !
-                  ! if snow load makes snow-ice interface to deplet below the ocean surface => put the snow excess in the ocean
-                  !    this correction is crucial because of the call to routine icecor afterwards which imposes a mini of ice thick. (rn_himin)
-                  !    this imposed mini can artificially make the snow very thick (if concentration decreases drastically)
-                  zvs_excess = MAX( 0._wp, pv_s(ji,jj,jl) - pv_i(ji,jj,jl) * (rau0-rhoi) * r1_rhos )
-                  IF( zvs_excess > 0._wp ) THEN
-                     zfra = ( pv_s(ji,jj,jl) - zvs_excess ) / MAX( pv_s(ji,jj,jl), epsi20 )
-                     wfx_res(ji,jj) = wfx_res(ji,jj) + zvs_excess * rhos * z1_dt
-                     hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0
-                     !
-                     pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra
-                     pv_s(ji,jj,jl)          = pv_s(ji,jj,jl) - zvs_excess
-                  ENDIF
-                  
+                  pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra
+                  pv_s(ji,jj,jl)          = pa_i(ji,jj,jl) * phs_max(ji,jj,jl)
+               ENDIF           
+               !                  
+            ENDIF
+         END_2D
+      END DO 
+      !
+   END SUBROUTINE Hbig
+
+
+   SUBROUTINE Hsnow( pdt, pv_i, pv_s, pa_i, pa_ip, pe_s )
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE Hsnow  ***
+      !!
+      !! ** Purpose : 1- Check snow load after advection
+      !!              2- Correct pond concentration to avoid a_ip > a_i
+      !!
+      !! ** Method :  If snow load makes snow-ice interface to deplet below the ocean surface
+      !!              then put the snow excess in the ocean
+      !!
+      !! ** Notes :   This correction is crucial because of the call to routine icecor afterwards
+      !!              which imposes a mini of ice thick. (rn_himin). This imposed mini can artificially
+      !!              make the snow very thick (if concentration decreases drastically)
+      !!              This behavior has been seen in Ultimate-Macho and supposedly it can also be true for Prather
+      !!-------------------------------------------------------------------
+      REAL(wp)                    , INTENT(in   ) ::   pdt   ! tracer time-step
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_i, pv_s, pa_i, pa_ip
+      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_s
+      !
+      INTEGER  ::   ji, jj, jl   ! dummy loop indices
+      REAL(wp) ::   z1_dt, zvs_excess, zfra
+      !!-------------------------------------------------------------------
+      !
+      z1_dt = 1._wp / pdt
+      !
+      ! -- check snow load -- !
+      DO jl = 1, jpl
+         DO_2D_11_11
+            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN
+               !
+               zvs_excess = MAX( 0._wp, pv_s(ji,jj,jl) - pv_i(ji,jj,jl) * (rho0-rhoi) * r1_rhos )
+               !
+               IF( zvs_excess > 0._wp ) THEN   ! snow-ice interface deplets below the ocean surface
+                  ! put snow excess in the ocean
+                  zfra = ( pv_s(ji,jj,jl) - zvs_excess ) / MAX( pv_s(ji,jj,jl), epsi20 )
+                  wfx_res(ji,jj) = wfx_res(ji,jj) + zvs_excess * rhos * z1_dt
+                  hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0
+                  ! correct snow volume and heat content
+                  pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra
+                  pv_s(ji,jj,jl)          = pv_s(ji,jj,jl) - zvs_excess
                ENDIF
-            END DO
-         END DO
-      END DO 
-      !                                           !-- correct pond concentration to avoid a_ip > a_i
+               !
+            ENDIF
+         END_2D
+      END DO
+      !
+      !-- correct pond concentration to avoid a_ip > a_i -- !
       WHERE( pa_ip(:,:,:) > pa_i(:,:,:) )   pa_ip(:,:,:) = pa_i(:,:,:)
       !
-      !
-   END SUBROUTINE Hbig
-   
+   END SUBROUTINE Hsnow
+
+
 #else
    !!----------------------------------------------------------------------
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icedyn_rdgrft.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icedyn_rdgrft.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icedyn_rdgrft.F90	(revision 12928)
@@ -75,4 +75,6 @@
    REAL(wp) ::   rn_fpndrft       !    fractional pond loss to the ocean during rafting
    !
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/ICE 4.0 , NEMO Consortium (2018)
@@ -86,7 +88,7 @@
       !!                ***  ROUTINE ice_dyn_rdgrft_alloc ***
       !!-------------------------------------------------------------------
-      ALLOCATE( closing_net(jpij), opning(jpij)   , closing_gross(jpij),   &
-         &      apartf(jpij,0:jpl), hrmin(jpij,jpl), hraft(jpij,jpl)    , aridge(jpij,jpl),   &
-         &      hrmax(jpij,jpl), hi_hrdg(jpij,jpl)  , araft (jpij,jpl),  &
+      ALLOCATE( closing_net(jpij)  , opning(jpij)      , closing_gross(jpij) ,               &
+         &      apartf(jpij,0:jpl) , hrmin  (jpij,jpl) , hraft(jpij,jpl) , aridge(jpij,jpl), &
+         &      hrmax (jpij,jpl)   , hi_hrdg(jpij,jpl) , araft(jpij,jpl) ,                   &
          &      ze_i_2d(jpij,nlay_i,jpl), ze_s_2d(jpij,nlay_s,jpl), STAT=ice_dyn_rdgrft_alloc )
 
@@ -137,5 +139,4 @@
       REAL(wp) ::   zfac                       ! local scalar
       INTEGER , DIMENSION(jpij) ::   iptidx        ! compute ridge/raft or not
-      REAL(wp), DIMENSION(jpij) ::   zdivu_adv     ! divu as implied by transport scheme  (1/s)
       REAL(wp), DIMENSION(jpij) ::   zdivu, zdelt  ! 1D divu_i & delta_i
       !
@@ -160,12 +161,10 @@
       npti = 0   ;   nptidx(:) = 0
       ipti = 0   ;   iptidx(:) = 0
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF ( at_i(ji,jj) > epsi10 ) THEN
-               npti           = npti + 1
-               nptidx( npti ) = (jj - 1) * jpi + ji
-            ENDIF
-         END DO
-      END DO
+      DO_2D_11_11
+         IF ( at_i(ji,jj) > epsi10 ) THEN
+            npti           = npti + 1
+            nptidx( npti ) = (jj - 1) * jpi + ji
+         ENDIF
+      END_2D
       
       !--------------------------------------------------------
@@ -175,7 +174,7 @@
         
          ! just needed here
-         CALL tab_2d_1d( npti, nptidx(1:npti), zdivu   (1:npti)      , divu_i  )
          CALL tab_2d_1d( npti, nptidx(1:npti), zdelt   (1:npti)      , delta_i )
          ! needed here and in the iteration loop
+         CALL tab_2d_1d( npti, nptidx(1:npti), zdivu   (1:npti)      , divu_i) ! zdivu is used as a work array here (no change in divu_i)
          CALL tab_3d_2d( npti, nptidx(1:npti), a_i_2d  (1:npti,1:jpl), a_i   )
          CALL tab_3d_2d( npti, nptidx(1:npti), v_i_2d  (1:npti,1:jpl), v_i   )
@@ -187,16 +186,8 @@
             closing_net(ji) = rn_csrdg * 0.5_wp * ( zdelt(ji) - ABS( zdivu(ji) ) ) - MIN( zdivu(ji), 0._wp )
             !
-            ! divergence given by the advection scheme
-            !   (which may not be equal to divu as computed from the velocity field)
-            IF    ( ln_adv_Pra ) THEN
-               zdivu_adv(ji) = ( 1._wp - ato_i_1d(ji) - SUM( a_i_2d(ji,:) ) ) * r1_rdtice
-            ELSEIF( ln_adv_UMx ) THEN
-               zdivu_adv(ji) = zdivu(ji)
-            ENDIF
-            !
-            IF( zdivu_adv(ji) < 0._wp )   closing_net(ji) = MAX( closing_net(ji), -zdivu_adv(ji) )   ! make sure the closing rate is large enough
-            !                                                                                        ! to give asum = 1.0 after ridging
+            IF( zdivu(ji) < 0._wp )   closing_net(ji) = MAX( closing_net(ji), -zdivu(ji) )   ! make sure the closing rate is large enough
+            !                                                                                ! to give asum = 1.0 after ridging
             ! Opening rate (non-negative) that will give asum = 1.0 after ridging.
-            opning(ji) = closing_net(ji) + zdivu_adv(ji)
+            opning(ji) = closing_net(ji) + zdivu(ji)
          END DO
          !
@@ -215,5 +206,5 @@
                ato_i_1d   (ipti)   = ato_i_1d   (ji)
                closing_net(ipti)   = closing_net(ji)
-               zdivu_adv  (ipti)   = zdivu_adv  (ji)
+               zdivu      (ipti)   = zdivu      (ji)
                opning     (ipti)   = opning     (ji)
             ENDIF
@@ -259,7 +250,7 @@
                ELSE
                   iterate_ridging  = 1
-                  zdivu_adv  (ji) = zfac * r1_rdtice
-                  closing_net(ji) = MAX( 0._wp, -zdivu_adv(ji) )
-                  opning     (ji) = MAX( 0._wp,  zdivu_adv(ji) )
+                  zdivu      (ji) = zfac * r1_Dt_ice
+                  closing_net(ji) = MAX( 0._wp, -zdivu(ji) )
+                  opning     (ji) = MAX( 0._wp,  zdivu(ji) )
                ENDIF
             END DO
@@ -277,5 +268,5 @@
 
       ! controls
-      IF( ln_ctl       )   CALL ice_prt3D   ('icedyn_rdgrft')                                                             ! prints
+      IF( sn_cfctl%l_prtctl )   CALL ice_prt3D   ('icedyn_rdgrft')                                                        ! prints
       IF( ln_icectl    )   CALL ice_prt     (kt, iiceprt, jiceprt,-1, ' - ice dyn rdgrft - ')                             ! prints
       IF( ln_icediachk )   CALL ice_cons_hsm(1, 'icedyn_rdgrft', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation
@@ -309,5 +300,5 @@
 
       !                       ! Ice thickness needed for rafting
-      WHERE( pa_i(1:npti,:) > epsi20 )   ;   zhi(1:npti,:) = pv_i(1:npti,:) / pa_i(1:npti,:)
+      WHERE( pa_i(1:npti,:) > epsi10 )   ;   zhi(1:npti,:) = pv_i(1:npti,:) / pa_i(1:npti,:)
       ELSEWHERE                          ;   zhi(1:npti,:) = 0._wp
       END WHERE
@@ -328,5 +319,5 @@
       zasum(1:npti) = pato_i(1:npti) + SUM( pa_i(1:npti,:), dim=2 )
       !
-      WHERE( zasum(1:npti) > epsi20 )   ;   z1_asum(1:npti) = 1._wp / zasum(1:npti)
+      WHERE( zasum(1:npti) > epsi10 )   ;   z1_asum(1:npti) = 1._wp / zasum(1:npti)
       ELSEWHERE                         ;   z1_asum(1:npti) = 0._wp
       END WHERE
@@ -454,5 +445,5 @@
       ! Based on the ITD of ridging and ridged ice, convert the net closing rate to a gross closing rate.  
       ! NOTE: 0 < aksum <= 1
-      WHERE( zaksum(1:npti) > epsi20 )   ;   closing_gross(1:npti) = pclosing_net(1:npti) / zaksum(1:npti)
+      WHERE( zaksum(1:npti) > epsi10 )   ;   closing_gross(1:npti) = pclosing_net(1:npti) / zaksum(1:npti)
       ELSEWHERE                          ;   closing_gross(1:npti) = 0._wp
       END WHERE
@@ -464,7 +455,7 @@
       DO jl = 1, jpl
          DO ji = 1, npti
-            zfac = apartf(ji,jl) * closing_gross(ji) * rdt_ice
+            zfac = apartf(ji,jl) * closing_gross(ji) * rDt_ice
             IF( zfac > pa_i(ji,jl) .AND. apartf(ji,jl) /= 0._wp ) THEN
-               closing_gross(ji) = pa_i(ji,jl) / apartf(ji,jl) * r1_rdtice
+               closing_gross(ji) = pa_i(ji,jl) / apartf(ji,jl) * r1_Dt_ice
             ENDIF
          END DO
@@ -476,9 +467,9 @@
       ! Reduce the opening rate in proportion
       DO ji = 1, npti  
-         zfac = pato_i(ji) + ( opning(ji) - apartf(ji,0) * closing_gross(ji) ) * rdt_ice
+         zfac = pato_i(ji) + ( opning(ji) - apartf(ji,0) * closing_gross(ji) ) * rDt_ice
          IF( zfac < 0._wp ) THEN           ! would lead to negative ato_i
-            opning(ji) = apartf(ji,0) * closing_gross(ji) - pato_i(ji) * r1_rdtice 
+            opning(ji) = apartf(ji,0) * closing_gross(ji) - pato_i(ji) * r1_Dt_ice 
          ELSEIF( zfac > zasum(ji) ) THEN   ! would lead to ato_i > asum
-            opning(ji) = apartf(ji,0) * closing_gross(ji) + ( zasum(ji) - pato_i(ji) ) * r1_rdtice 
+            opning(ji) = apartf(ji,0) * closing_gross(ji) + ( zasum(ji) - pato_i(ji) ) * r1_Dt_ice 
          ENDIF
       END DO
@@ -524,5 +515,5 @@
       !--------------------------------------------------------
       DO ji = 1, npti
-         ato_i_1d(ji) = MAX( 0._wp, ato_i_1d(ji) + ( opning(ji) - apartf(ji,0) * closing_gross(ji) ) * rdt_ice )
+         ato_i_1d(ji) = MAX( 0._wp, ato_i_1d(ji) + ( opning(ji) - apartf(ji,0) * closing_gross(ji) ) * rDt_ice )
       END DO
       
@@ -537,11 +528,11 @@
             IF( apartf(ji,jl1) > 0._wp .AND. closing_gross(ji) > 0._wp ) THEN   ! only if ice is ridging
 
-               IF( a_i_2d(ji,jl1) > epsi20 ) THEN   ;   z1_ai(ji) = 1._wp / a_i_2d(ji,jl1)
+               IF( a_i_2d(ji,jl1) > epsi10 ) THEN   ;   z1_ai(ji) = 1._wp / a_i_2d(ji,jl1)
                ELSE                                 ;   z1_ai(ji) = 0._wp
                ENDIF
                
                ! area of ridging / rafting ice (airdg1) and of new ridge (airdg2)
-               airdg1 = aridge(ji,jl1) * closing_gross(ji) * rdt_ice
-               airft1 = araft (ji,jl1) * closing_gross(ji) * rdt_ice
+               airdg1 = aridge(ji,jl1) * closing_gross(ji) * rDt_ice
+               airft1 = araft (ji,jl1) * closing_gross(ji) * rDt_ice
 
                airdg2(ji) = airdg1 * hi_hrdg(ji,jl1)
@@ -584,18 +575,18 @@
 
                ! Ice-ocean exchanges associated with ice porosity
-               wfx_dyn_1d(ji) = wfx_dyn_1d(ji) - vsw * rhoi * r1_rdtice   ! increase in ice volume due to seawater frozen in voids
-               sfx_dyn_1d(ji) = sfx_dyn_1d(ji) - vsw * sss_1d(ji) * rhoi * r1_rdtice
-               hfx_dyn_1d(ji) = hfx_dyn_1d(ji) + ersw(ji) * r1_rdtice          ! > 0 [W.m-2] 
+               wfx_dyn_1d(ji) = wfx_dyn_1d(ji) - vsw * rhoi * r1_Dt_ice   ! increase in ice volume due to seawater frozen in voids
+               sfx_dyn_1d(ji) = sfx_dyn_1d(ji) - vsw * sss_1d(ji) * rhoi * r1_Dt_ice
+               hfx_dyn_1d(ji) = hfx_dyn_1d(ji) + ersw(ji) * r1_Dt_ice          ! > 0 [W.m-2] 
 
                ! Put the snow lost by ridging into the ocean
                !  Note that esrdg > 0; the ocean must cool to melt snow. If the ocean temp = Tf already, new ice must grow.
                wfx_snw_dyn_1d(ji) = wfx_snw_dyn_1d(ji) + ( rhos * vsrdg(ji) * ( 1._wp - rn_fsnwrdg )   &   ! fresh water source for ocean
-                  &                                      + rhos * vsrft(ji) * ( 1._wp - rn_fsnwrft ) ) * r1_rdtice
+                  &                                      + rhos * vsrft(ji) * ( 1._wp - rn_fsnwrft ) ) * r1_Dt_ice
 
                ! virtual salt flux to keep salinity constant
                IF( nn_icesal /= 2 )  THEN
-                  sirdg2(ji)     = sirdg2(ji)     - vsw * ( sss_1d(ji) - s_i_1d(ji) )        ! ridge salinity = s_i
-                  sfx_bri_1d(ji) = sfx_bri_1d(ji) + sss_1d(ji) * vsw * rhoi * r1_rdtice  &  ! put back sss_m into the ocean
-                     &                            - s_i_1d(ji) * vsw * rhoi * r1_rdtice     ! and get  s_i  from the ocean 
+                  sirdg2(ji)     = sirdg2(ji)     - vsw * ( sss_1d(ji) - s_i_1d(ji) )       ! ridge salinity = s_i
+                  sfx_bri_1d(ji) = sfx_bri_1d(ji) + sss_1d(ji) * vsw * rhoi * r1_Dt_ice  &  ! put back sss_m into the ocean
+                     &                            - s_i_1d(ji) * vsw * rhoi * r1_Dt_ice     ! and get  s_i  from the ocean 
                ENDIF
 
@@ -620,6 +611,6 @@
                IF( apartf(ji,jl1) > 0._wp .AND. closing_gross(ji) > 0._wp ) THEN
                   ! Compute ridging /rafting fractions
-                  afrdg = aridge(ji,jl1) * closing_gross(ji) * rdt_ice * z1_ai(ji)
-                  afrft = araft (ji,jl1) * closing_gross(ji) * rdt_ice * z1_ai(ji)
+                  afrdg = aridge(ji,jl1) * closing_gross(ji) * rDt_ice * z1_ai(ji)
+                  afrft = araft (ji,jl1) * closing_gross(ji) * rDt_ice * z1_ai(ji)
                   ! Compute ridging /rafting ice and new ridges for es
                   esrdg(ji,jk) = ze_s_2d (ji,jk,jl1) * afrdg
@@ -627,5 +618,5 @@
                   ! Put the snow lost by ridging into the ocean
                   hfx_dyn_1d(ji) = hfx_dyn_1d(ji) + ( - esrdg(ji,jk) * ( 1._wp - rn_fsnwrdg )   &                 ! heat sink for ocean (<0, W.m-2)
-                     &                                - esrft(ji,jk) * ( 1._wp - rn_fsnwrft ) ) * r1_rdtice
+                     &                                - esrft(ji,jk) * ( 1._wp - rn_fsnwrft ) ) * r1_Dt_ice
                   !
                   ! Remove energy of new ridge to each category jl1
@@ -641,6 +632,6 @@
                IF( apartf(ji,jl1) > 0._wp .AND. closing_gross(ji) > 0._wp ) THEN
                   ! Compute ridging /rafting fractions
-                  afrdg = aridge(ji,jl1) * closing_gross(ji) * rdt_ice * z1_ai(ji)
-                  afrft = araft (ji,jl1) * closing_gross(ji) * rdt_ice * z1_ai(ji)
+                  afrdg = aridge(ji,jl1) * closing_gross(ji) * rDt_ice * z1_ai(ji)
+                  afrft = araft (ji,jl1) * closing_gross(ji) * rDt_ice * z1_ai(ji)
                   ! Compute ridging ice and new ridges for ei
                   eirdg(ji,jk) = ze_i_2d (ji,jk,jl1) * afrdg + ersw(ji) * r1_nlay_i
@@ -775,22 +766,18 @@
       !                              !--------------------------------------------------!
       CASE( 1 )               !--- Spatial smoothing
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN 
-                  zworka(ji,jj) = ( 4.0 * strength(ji,jj)              &
-                     &                  + strength(ji-1,jj) * tmask(ji-1,jj,1) + strength(ji+1,jj) * tmask(ji+1,jj,1) &  
-                     &                  + strength(ji,jj-1) * tmask(ji,jj-1,1) + strength(ji,jj+1) * tmask(ji,jj+1,1) &
-                     &            ) / ( 4.0 + tmask(ji-1,jj,1) + tmask(ji+1,jj,1) + tmask(ji,jj-1,1) + tmask(ji,jj+1,1) )
-               ELSE
-                  zworka(ji,jj) = 0._wp
-               ENDIF
-            END DO
-         END DO
+         DO_2D_00_00
+            IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN 
+               zworka(ji,jj) = ( 4.0 * strength(ji,jj)              &
+                  &                  + strength(ji-1,jj) * tmask(ji-1,jj,1) + strength(ji+1,jj) * tmask(ji+1,jj,1) &  
+                  &                  + strength(ji,jj-1) * tmask(ji,jj-1,1) + strength(ji,jj+1) * tmask(ji,jj+1,1) &
+                  &            ) / ( 4.0 + tmask(ji-1,jj,1) + tmask(ji+1,jj,1) + tmask(ji,jj-1,1) + tmask(ji,jj+1,1) )
+            ELSE
+               zworka(ji,jj) = 0._wp
+            ENDIF
+         END_2D
          
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               strength(ji,jj) = zworka(ji,jj)
-            END DO
-         END DO
+         DO_2D_00_00
+            strength(ji,jj) = zworka(ji,jj)
+         END_2D
          CALL lbc_lnk( 'icedyn_rdgrft', strength, 'T', 1. )
          !
@@ -801,17 +788,15 @@
          ENDIF
          !
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN 
-                  itframe = 1 ! number of time steps for the running mean
-                  IF ( zstrp1(ji,jj) > 0._wp ) itframe = itframe + 1
-                  IF ( zstrp2(ji,jj) > 0._wp ) itframe = itframe + 1
-                  zp = ( strength(ji,jj) + zstrp1(ji,jj) + zstrp2(ji,jj) ) / itframe
-                  zstrp2  (ji,jj) = zstrp1  (ji,jj)
-                  zstrp1  (ji,jj) = strength(ji,jj)
-                  strength(ji,jj) = zp
-               ENDIF
-            END DO
-         END DO
+         DO_2D_00_00
+            IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN 
+               itframe = 1 ! number of time steps for the running mean
+               IF ( zstrp1(ji,jj) > 0._wp ) itframe = itframe + 1
+               IF ( zstrp2(ji,jj) > 0._wp ) itframe = itframe + 1
+               zp = ( strength(ji,jj) + zstrp1(ji,jj) + zstrp2(ji,jj) ) / itframe
+               zstrp2  (ji,jj) = zstrp1  (ji,jj)
+               zstrp1  (ji,jj) = strength(ji,jj)
+               strength(ji,jj) = zp
+            ENDIF
+         END_2D
          CALL lbc_lnk( 'icedyn_rdgrft', strength, 'T', 1. )
          !
@@ -917,8 +902,6 @@
       !!-------------------------------------------------------------------
       !
-      REWIND( numnam_ice_ref )              ! Namelist namicetdme in reference namelist : Ice mechanical ice redistribution
       READ  ( numnam_ice_ref, namdyn_rdgrft, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_rdgrft in reference namelist' )
-      REWIND( numnam_ice_cfg )              ! Namelist namdyn_rdgrft in configuration namelist : Ice mechanical ice redistribution
       READ  ( numnam_ice_cfg, namdyn_rdgrft, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_rdgrft in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icedyn_rhg.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icedyn_rhg.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icedyn_rhg.F90	(revision 12928)
@@ -38,6 +38,4 @@
    LOGICAL ::   ln_rhg_EVP       ! EVP rheology
    !
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/ICE 4.0 , NEMO Consortium (2018)
@@ -47,5 +45,5 @@
 CONTAINS
 
-   SUBROUTINE ice_dyn_rhg( kt )
+   SUBROUTINE ice_dyn_rhg( kt, Kmm )
       !!-------------------------------------------------------------------
       !!               ***  ROUTINE ice_dyn_rhg  ***
@@ -58,6 +56,5 @@
       !!--------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt     ! ice time step
-      !
-      INTEGER  ::   jl   ! dummy loop indices
+      INTEGER, INTENT(in) ::   Kmm    ! ocean time level index
       !!--------------------------------------------------------------------
       ! controls
@@ -79,5 +76,5 @@
       CASE( np_rhgEVP )                ! Elasto-Viscous-Plastic !
          !                             !------------------------!
-         CALL ice_dyn_rhg_evp( kt, stress1_i, stress2_i, stress12_i, shear_i, divu_i, delta_i )
+         CALL ice_dyn_rhg_evp( kt, Kmm, stress1_i, stress2_i, stress12_i, shear_i, divu_i, delta_i )
          !         
       END SELECT
@@ -88,5 +85,6 @@
       !
       ! controls
-      IF( ln_ctl       )   CALL ice_prt3D   ('icedyn_rhg')                                                             ! prints
+      IF( sn_cfctl%l_prtctl ) &
+         &                 CALL ice_prt3D   ('icedyn_rhg')                                                             ! prints
       IF( ln_icediachk )   CALL ice_cons_hsm(1, 'icedyn_rhg', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation
       IF( ln_icediachk )   CALL ice_cons2D  (1, 'icedyn_rhg',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft) ! conservation
@@ -113,8 +111,6 @@
       !!-------------------------------------------------------------------
       !
-      REWIND( numnam_ice_ref )         ! Namelist namdyn_rhg in reference namelist : Ice dynamics
       READ  ( numnam_ice_ref, namdyn_rhg, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_rhg in reference namelist' )
-      REWIND( numnam_ice_cfg )         ! Namelist namdyn_rhg in configuration namelist : Ice dynamics
       READ  ( numnam_ice_cfg, namdyn_rhg, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namdyn_rhg in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icedyn_rhg_evp.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icedyn_rhg_evp.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icedyn_rhg_evp.F90	(revision 12928)
@@ -48,5 +48,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/ICE 4.0 , NEMO Consortium (2018)
@@ -56,5 +56,5 @@
 CONTAINS
 
-   SUBROUTINE ice_dyn_rhg_evp( kt, pstress1_i, pstress2_i, pstress12_i, pshear_i, pdivu_i, pdelta_i )
+   SUBROUTINE ice_dyn_rhg_evp( kt, Kmm, pstress1_i, pstress2_i, pstress12_i, pshear_i, pdivu_i, pdelta_i )
       !!-------------------------------------------------------------------
       !!                 ***  SUBROUTINE ice_dyn_rhg_evp  ***
@@ -109,4 +109,5 @@
       !!-------------------------------------------------------------------
       INTEGER                 , INTENT(in   ) ::   kt                                    ! time step
+      INTEGER                 , INTENT(in   ) ::   Kmm                                   ! ocean time level index
       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pstress1_i, pstress2_i, pstress12_i   !
       REAL(wp), DIMENSION(:,:), INTENT(  out) ::   pshear_i  , pdivu_i   , pdelta_i      !
@@ -115,5 +116,5 @@
       INTEGER ::   jter         ! local integers
       !
-      REAL(wp) ::   zrhoco                                              ! rau0 * rn_cio
+      REAL(wp) ::   zrhoco                                              ! rho0 * rn_cio
       REAL(wp) ::   zdtevp, z1_dtevp                                    ! time step for subcycling
       REAL(wp) ::   ecc2, z1_ecc2                                       ! square of yield ellipse eccenticity
@@ -179,20 +180,16 @@
       !------------------------------------------------------------------------------!
       ! ocean/land mask
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1      ! NO vector opt.
-            zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1)
-         END DO
-      END DO
+      DO_2D_10_10
+         zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1)
+      END_2D
       CALL lbc_lnk( 'icedyn_rhg_evp', zfmask, 'F', 1._wp )
 
       ! Lateral boundary conditions on velocity (modify zfmask)
       zwf(:,:) = zfmask(:,:)
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            IF( zfmask(ji,jj) == 0._wp ) THEN
-               zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1), zwf(ji-1,jj), zwf(ji,jj-1) ) )
-            ENDIF
-         END DO
-      END DO
+      DO_2D_00_00
+         IF( zfmask(ji,jj) == 0._wp ) THEN
+            zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1), zwf(ji-1,jj), zwf(ji,jj-1) ) )
+         ENDIF
+      END_2D
       DO jj = 2, jpjm1
          IF( zfmask(1,jj) == 0._wp ) THEN
@@ -216,5 +213,5 @@
       ! 1) define some variables and initialize arrays
       !------------------------------------------------------------------------------!
-      zrhoco = rau0 * rn_cio 
+      zrhoco = rho0 * rn_cio 
 
       ! ecc2: square of yield ellipse eccenticrity
@@ -223,10 +220,10 @@
 
       ! Time step for subcycling
-      zdtevp   = rdt_ice / REAL( nn_nevp )
+      zdtevp   = rDt_ice / REAL( nn_nevp )
       z1_dtevp = 1._wp / zdtevp
 
       ! alpha parameters (Bouillon 2009)
       IF( .NOT. ln_aEVP ) THEN
-         zalph1 = ( 2._wp * rn_relast * rdt_ice ) * z1_dtevp
+         zalph1 = ( 2._wp * rn_relast * rDt_ice ) * z1_dtevp
          zalph2 = zalph1 * z1_ecc2
 
@@ -256,52 +253,50 @@
       zsshdyn(:,:) = ice_var_sshdyn( ssh_m, snwice_mass, snwice_mass_b)
 
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1
-
-            ! ice fraction at U-V points
-            zaU(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
-            zaV(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
-
-            ! Ice/snow mass at U-V points
-            zm1 = ( rhos * vt_s(ji  ,jj  ) + rhoi * vt_i(ji  ,jj  ) )
-            zm2 = ( rhos * vt_s(ji+1,jj  ) + rhoi * vt_i(ji+1,jj  ) )
-            zm3 = ( rhos * vt_s(ji  ,jj+1) + rhoi * vt_i(ji  ,jj+1) )
-            zmassU = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm2 * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
-            zmassV = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm3 * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
-
-            ! Ocean currents at U-V points
-            v_oceU(ji,jj)   = 0.25_wp * ( v_oce(ji,jj) + v_oce(ji,jj-1) + v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * umask(ji,jj,1)
-            u_oceV(ji,jj)   = 0.25_wp * ( u_oce(ji,jj) + u_oce(ji-1,jj) + u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * vmask(ji,jj,1)
-
-            ! Coriolis at T points (m*f)
-            zmf(ji,jj)      = zm1 * ff_t(ji,jj)
-
-            ! dt/m at T points (for alpha and beta coefficients)
-            zdt_m(ji,jj)    = zdtevp / MAX( zm1, zmmin )
-            
-            ! m/dt
-            zmU_t(ji,jj)    = zmassU * z1_dtevp
-            zmV_t(ji,jj)    = zmassV * z1_dtevp
-            
-            ! Drag ice-atm.
-            ztaux_ai(ji,jj) = zaU(ji,jj) * utau_ice(ji,jj)
-            ztauy_ai(ji,jj) = zaV(ji,jj) * vtau_ice(ji,jj)
-
-            ! Surface pressure gradient (- m*g*GRAD(ssh)) at U-V points
-            zspgU(ji,jj)    = - zmassU * grav * ( zsshdyn(ji+1,jj) - zsshdyn(ji,jj) ) * r1_e1u(ji,jj)
-            zspgV(ji,jj)    = - zmassV * grav * ( zsshdyn(ji,jj+1) - zsshdyn(ji,jj) ) * r1_e2v(ji,jj)
-
-            ! masks
-            zmsk00x(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassU ) )  ! 0 if no ice
-            zmsk00y(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassV ) )  ! 0 if no ice
-
-            ! switches
-            IF( zmassU <= zmmin .AND. zaU(ji,jj) <= zamin ) THEN   ;   zmsk01x(ji,jj) = 0._wp
-            ELSE                                                   ;   zmsk01x(ji,jj) = 1._wp   ;   ENDIF
-            IF( zmassV <= zmmin .AND. zaV(ji,jj) <= zamin ) THEN   ;   zmsk01y(ji,jj) = 0._wp
-            ELSE                                                   ;   zmsk01y(ji,jj) = 1._wp   ;   ENDIF
-
-         END DO
-      END DO
+      DO_2D_00_00
+
+         ! ice fraction at U-V points
+         zaU(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
+         zaV(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
+
+         ! Ice/snow mass at U-V points
+         zm1 = ( rhos * vt_s(ji  ,jj  ) + rhoi * vt_i(ji  ,jj  ) )
+         zm2 = ( rhos * vt_s(ji+1,jj  ) + rhoi * vt_i(ji+1,jj  ) )
+         zm3 = ( rhos * vt_s(ji  ,jj+1) + rhoi * vt_i(ji  ,jj+1) )
+         zmassU = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm2 * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
+         zmassV = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm3 * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
+
+         ! Ocean currents at U-V points
+         v_oceU(ji,jj)   = 0.25_wp * ( v_oce(ji,jj) + v_oce(ji,jj-1) + v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * umask(ji,jj,1)
+         u_oceV(ji,jj)   = 0.25_wp * ( u_oce(ji,jj) + u_oce(ji-1,jj) + u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * vmask(ji,jj,1)
+
+         ! Coriolis at T points (m*f)
+         zmf(ji,jj)      = zm1 * ff_t(ji,jj)
+
+         ! dt/m at T points (for alpha and beta coefficients)
+         zdt_m(ji,jj)    = zdtevp / MAX( zm1, zmmin )
+         
+         ! m/dt
+         zmU_t(ji,jj)    = zmassU * z1_dtevp
+         zmV_t(ji,jj)    = zmassV * z1_dtevp
+         
+         ! Drag ice-atm.
+         ztaux_ai(ji,jj) = zaU(ji,jj) * utau_ice(ji,jj)
+         ztauy_ai(ji,jj) = zaV(ji,jj) * vtau_ice(ji,jj)
+
+         ! Surface pressure gradient (- m*g*GRAD(ssh)) at U-V points
+         zspgU(ji,jj)    = - zmassU * grav * ( zsshdyn(ji+1,jj) - zsshdyn(ji,jj) ) * r1_e1u(ji,jj)
+         zspgV(ji,jj)    = - zmassV * grav * ( zsshdyn(ji,jj+1) - zsshdyn(ji,jj) ) * r1_e2v(ji,jj)
+
+         ! masks
+         zmsk00x(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassU ) )  ! 0 if no ice
+         zmsk00y(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassV ) )  ! 0 if no ice
+
+         ! switches
+         IF( zmassU <= zmmin .AND. zaU(ji,jj) <= zamin ) THEN   ;   zmsk01x(ji,jj) = 0._wp
+         ELSE                                                   ;   zmsk01x(ji,jj) = 1._wp   ;   ENDIF
+         IF( zmassV <= zmmin .AND. zaV(ji,jj) <= zamin ) THEN   ;   zmsk01y(ji,jj) = 0._wp
+         ELSE                                                   ;   zmsk01y(ji,jj) = 1._wp   ;   ENDIF
+
+      END_2D
       CALL lbc_lnk_multi( 'icedyn_rhg_evp', zmf, 'T', 1., zdt_m, 'T', 1. )
       !
@@ -309,29 +304,25 @@
       !
       IF( ln_landfast_L16 ) THEN         !-- Lemieux 2016
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               ! ice thickness at U-V points
-               zvU = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
-               zvV = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
-               ! ice-bottom stress at U points
-               zvCr = zaU(ji,jj) * rn_depfra * hu_n(ji,jj)
-               ztaux_base(ji,jj) = - rn_icebfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) )
-               ! ice-bottom stress at V points
-               zvCr = zaV(ji,jj) * rn_depfra * hv_n(ji,jj)
-               ztauy_base(ji,jj) = - rn_icebfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) )
-               ! ice_bottom stress at T points
-               zvCr = at_i(ji,jj) * rn_depfra * ht_n(ji,jj)
-               tau_icebfr(ji,jj) = - rn_icebfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) )
-            END DO
-         END DO
+         DO_2D_00_00
+            ! ice thickness at U-V points
+            zvU = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
+            zvV = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
+            ! ice-bottom stress at U points
+            zvCr = zaU(ji,jj) * rn_depfra * hu(ji,jj,Kmm)
+            ztaux_base(ji,jj) = - rn_icebfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) )
+            ! ice-bottom stress at V points
+            zvCr = zaV(ji,jj) * rn_depfra * hv(ji,jj,Kmm)
+            ztauy_base(ji,jj) = - rn_icebfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) )
+            ! ice_bottom stress at T points
+            zvCr = at_i(ji,jj) * rn_depfra * ht(ji,jj)
+            tau_icebfr(ji,jj) = - rn_icebfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) )
+         END_2D
          CALL lbc_lnk( 'icedyn_rhg_evp', tau_icebfr(:,:), 'T', 1. )
          !
       ELSE                               !-- no landfast
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               ztaux_base(ji,jj) = 0._wp
-               ztauy_base(ji,jj) = 0._wp
-            END DO
-         END DO
+         DO_2D_00_00
+            ztaux_base(ji,jj) = 0._wp
+            ztauy_base(ji,jj) = 0._wp
+         END_2D
       ENDIF
 
@@ -345,5 +336,5 @@
          l_full_nf_update = jter == nn_nevp   ! false: disable full North fold update (performances) for iter = 1 to nn_nevp-1
          !
-!!$         IF(ln_ctl) THEN   ! Convergence test
+!!$         IF(sn_cfctl%l_prtctl) THEN   ! Convergence test
 !!$            DO jj = 1, jpjm1
 !!$               zu_ice(:,jj) = u_ice(:,jj) ! velocity at previous time step
@@ -353,104 +344,96 @@
 
          ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- !
-         DO jj = 1, jpjm1         ! loops start at 1 since there is no boundary condition (lbc_lnk) at i=1 and j=1 for F points
-            DO ji = 1, jpim1
-
-               ! shear at F points
-               zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   &
-                  &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   &
-                  &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj)
-
-            END DO
-         END DO
+         DO_2D_10_10
+
+            ! shear at F points
+            zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   &
+               &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   &
+               &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj)
+
+         END_2D
          CALL lbc_lnk( 'icedyn_rhg_evp', zds, 'F', 1. )
 
-         DO jj = 2, jpj    ! loop to jpi,jpj to avoid making a communication for zs1,zs2,zs12
-            DO ji = 2, jpi ! no vector loop
-
-               ! shear**2 at T points (doc eq. A16)
-               zds2 = ( zds(ji,jj  ) * zds(ji,jj  ) * e1e2f(ji,jj  ) + zds(ji-1,jj  ) * zds(ji-1,jj  ) * e1e2f(ji-1,jj  )  &
-                  &   + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1)  &
-                  &   ) * 0.25_wp * r1_e1e2t(ji,jj)
-              
-               ! divergence at T points
-               zdiv  = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   &
-                  &    + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   &
-                  &    ) * r1_e1e2t(ji,jj)
-               zdiv2 = zdiv * zdiv
-               
-               ! tension at T points
-               zdt  = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   &
-                  &   - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   &
-                  &   ) * r1_e1e2t(ji,jj)
-               zdt2 = zdt * zdt
-               
-               ! delta at T points
-               zdelta = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 )  
-
-               ! P/delta at T points
-               zp_delt(ji,jj) = strength(ji,jj) / ( zdelta + rn_creepl )
-
-               ! alpha & beta for aEVP
-               !   gamma = 0.5*P/(delta+creepl) * (c*pi)**2/Area * dt/m
-               !   alpha = beta = sqrt(4*gamma)
-               IF( ln_aEVP ) THEN
-                  zalph1   = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) )
-                  z1_alph1 = 1._wp / ( zalph1 + 1._wp )
-                  zalph2   = zalph1
-                  z1_alph2 = z1_alph1
-               ENDIF
-               
-               ! stress at T points (zkt/=0 if landfast)
-               zs1(ji,jj) = ( zs1(ji,jj) * zalph1 + zp_delt(ji,jj) * ( zdiv * (1._wp + zkt) - zdelta * (1._wp - zkt) ) ) * z1_alph1
-               zs2(ji,jj) = ( zs2(ji,jj) * zalph2 + zp_delt(ji,jj) * ( zdt * z1_ecc2 * (1._wp + zkt) ) ) * z1_alph2
-             
-            END DO
-         END DO
+         DO_2D_01_01
+
+            ! shear**2 at T points (doc eq. A16)
+            zds2 = ( zds(ji,jj  ) * zds(ji,jj  ) * e1e2f(ji,jj  ) + zds(ji-1,jj  ) * zds(ji-1,jj  ) * e1e2f(ji-1,jj  )  &
+               &   + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1)  &
+               &   ) * 0.25_wp * r1_e1e2t(ji,jj)
+           
+            ! divergence at T points
+            zdiv  = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   &
+               &    + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   &
+               &    ) * r1_e1e2t(ji,jj)
+            zdiv2 = zdiv * zdiv
+            
+            ! tension at T points
+            zdt  = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   &
+               &   - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   &
+               &   ) * r1_e1e2t(ji,jj)
+            zdt2 = zdt * zdt
+            
+            ! delta at T points
+            zdelta = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 )  
+
+            ! P/delta at T points
+            zp_delt(ji,jj) = strength(ji,jj) / ( zdelta + rn_creepl )
+
+            ! alpha & beta for aEVP
+            !   gamma = 0.5*P/(delta+creepl) * (c*pi)**2/Area * dt/m
+            !   alpha = beta = sqrt(4*gamma)
+            IF( ln_aEVP ) THEN
+               zalph1   = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) )
+               z1_alph1 = 1._wp / ( zalph1 + 1._wp )
+               zalph2   = zalph1
+               z1_alph2 = z1_alph1
+            ENDIF
+            
+            ! stress at T points (zkt/=0 if landfast)
+            zs1(ji,jj) = ( zs1(ji,jj) * zalph1 + zp_delt(ji,jj) * ( zdiv * (1._wp + zkt) - zdelta * (1._wp - zkt) ) ) * z1_alph1
+            zs2(ji,jj) = ( zs2(ji,jj) * zalph2 + zp_delt(ji,jj) * ( zdt * z1_ecc2 * (1._wp + zkt) ) ) * z1_alph2
+          
+         END_2D
          CALL lbc_lnk( 'icedyn_rhg_evp', zp_delt, 'T', 1. )
 
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-
-               ! alpha & beta for aEVP
-               IF( ln_aEVP ) THEN
-                  zalph2   = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) )
-                  z1_alph2 = 1._wp / ( zalph2 + 1._wp )
-                  zbeta(ji,jj) = zalph2
-               ENDIF
-               
-               ! P/delta at F points
-               zp_delf = 0.25_wp * ( zp_delt(ji,jj) + zp_delt(ji+1,jj) + zp_delt(ji,jj+1) + zp_delt(ji+1,jj+1) )
-               
-               ! stress at F points (zkt/=0 if landfast)
-               zs12(ji,jj)= ( zs12(ji,jj) * zalph2 + zp_delf * ( zds(ji,jj) * z1_ecc2 * (1._wp + zkt) ) * 0.5_wp ) * z1_alph2
-
-            END DO
-         END DO
+         DO_2D_10_10
+
+            ! alpha & beta for aEVP
+            IF( ln_aEVP ) THEN
+               zalph2   = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) )
+               z1_alph2 = 1._wp / ( zalph2 + 1._wp )
+               zbeta(ji,jj) = zalph2
+            ENDIF
+            
+            ! P/delta at F points
+            zp_delf = 0.25_wp * ( zp_delt(ji,jj) + zp_delt(ji+1,jj) + zp_delt(ji,jj+1) + zp_delt(ji+1,jj+1) )
+            
+            ! stress at F points (zkt/=0 if landfast)
+            zs12(ji,jj)= ( zs12(ji,jj) * zalph2 + zp_delf * ( zds(ji,jj) * z1_ecc2 * (1._wp + zkt) ) * 0.5_wp ) * z1_alph2
+
+         END_2D
 
          ! --- Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) --- !
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1               
-               !                   !--- U points
-               zfU(ji,jj) = 0.5_wp * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj)                                             &
-                  &                  + ( zs2(ji+1,jj) * e2t(ji+1,jj) * e2t(ji+1,jj) - zs2(ji,jj) * e2t(ji,jj) * e2t(ji,jj)    &
-                  &                    ) * r1_e2u(ji,jj)                                                                      &
-                  &                  + ( zs12(ji,jj) * e1f(ji,jj) * e1f(ji,jj) - zs12(ji,jj-1) * e1f(ji,jj-1) * e1f(ji,jj-1)  &
-                  &                    ) * 2._wp * r1_e1u(ji,jj)                                                              &
-                  &                  ) * r1_e1e2u(ji,jj)
-               !
-               !                !--- V points
-               zfV(ji,jj) = 0.5_wp * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj)                                             &
-                  &                  - ( zs2(ji,jj+1) * e1t(ji,jj+1) * e1t(ji,jj+1) - zs2(ji,jj) * e1t(ji,jj) * e1t(ji,jj)    &
-                  &                    ) * r1_e1v(ji,jj)                                                                      &
-                  &                  + ( zs12(ji,jj) * e2f(ji,jj) * e2f(ji,jj) - zs12(ji-1,jj) * e2f(ji-1,jj) * e2f(ji-1,jj)  &
-                  &                    ) * 2._wp * r1_e2v(ji,jj)                                                              &
-                  &                  ) * r1_e1e2v(ji,jj)
-               !
-               !                !--- ice currents at U-V point
-               v_iceU(ji,jj) = 0.25_wp * ( v_ice(ji,jj) + v_ice(ji,jj-1) + v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * umask(ji,jj,1)
-               u_iceV(ji,jj) = 0.25_wp * ( u_ice(ji,jj) + u_ice(ji-1,jj) + u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * vmask(ji,jj,1)
-               !
-            END DO
-         END DO
+         DO_2D_00_00
+            !                   !--- U points
+            zfU(ji,jj) = 0.5_wp * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj)                                             &
+               &                  + ( zs2(ji+1,jj) * e2t(ji+1,jj) * e2t(ji+1,jj) - zs2(ji,jj) * e2t(ji,jj) * e2t(ji,jj)    &
+               &                    ) * r1_e2u(ji,jj)                                                                      &
+               &                  + ( zs12(ji,jj) * e1f(ji,jj) * e1f(ji,jj) - zs12(ji,jj-1) * e1f(ji,jj-1) * e1f(ji,jj-1)  &
+               &                    ) * 2._wp * r1_e1u(ji,jj)                                                              &
+               &                  ) * r1_e1e2u(ji,jj)
+            !
+            !                !--- V points
+            zfV(ji,jj) = 0.5_wp * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj)                                             &
+               &                  - ( zs2(ji,jj+1) * e1t(ji,jj+1) * e1t(ji,jj+1) - zs2(ji,jj) * e1t(ji,jj) * e1t(ji,jj)    &
+               &                    ) * r1_e1v(ji,jj)                                                                      &
+               &                  + ( zs12(ji,jj) * e2f(ji,jj) * e2f(ji,jj) - zs12(ji-1,jj) * e2f(ji-1,jj) * e2f(ji-1,jj)  &
+               &                    ) * 2._wp * r1_e2v(ji,jj)                                                              &
+               &                  ) * r1_e1e2v(ji,jj)
+            !
+            !                !--- ice currents at U-V point
+            v_iceU(ji,jj) = 0.25_wp * ( v_ice(ji,jj) + v_ice(ji,jj-1) + v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * umask(ji,jj,1)
+            u_iceV(ji,jj) = 0.25_wp * ( u_ice(ji,jj) + u_ice(ji-1,jj) + u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * vmask(ji,jj,1)
+            !
+         END_2D
          !
          ! --- Computation of ice velocity --- !
@@ -459,47 +442,45 @@
          IF( MOD(jter,2) == 0 ) THEN ! even iterations
             !
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  !                 !--- tau_io/(v_oce - v_ice)
-                  zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  &
-                     &                              + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) )
-                  !                 !--- Ocean-to-Ice stress
-                  ztauy_oi(ji,jj) = zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) )
-                  !
-                  !                 !--- tau_bottom/v_ice
-                  zvel  = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) )
-                  zTauB = ztauy_base(ji,jj) / zvel
-                  !                 !--- OceanBottom-to-Ice stress
-                  ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj)
-                  !
-                  !                 !--- Coriolis at V-points (energy conserving formulation)
-                  zCorV(ji,jj)  = - 0.25_wp * r1_e2v(ji,jj) *  &
-                     &    ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * u_ice(ji,jj  ) + e2u(ji-1,jj  ) * u_ice(ji-1,jj  ) )  &
-                     &    + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) )
-                  !
-                  !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
-                  zRHS = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj)
-                  !
-                  !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS)
-                  !                                         1 = sliding friction : TauB < RHS
-                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztauy_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) )
-                  !
-                  IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
-                     v_ice(ji,jj) = ( (          rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) )       & ! previous velocity
-                        &                                  + zRHS + zTauO * v_ice(ji,jj) )                                         & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
-                        &                                  / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
-                        &               + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0
-                        &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                     & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
-                        &           )   * zmsk00y(ji,jj)
-                  ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009)
-                     v_ice(ji,jj) = ( (           rswitch   * ( zmV_t(ji,jj)  * v_ice(ji,jj)                                       & ! previous velocity
-                        &                                     + zRHS + zTauO * v_ice(ji,jj) )                                      & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
-                        &                                     / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast
-                        &                + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0
-                        &              ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
-                        &            )   * zmsk00y(ji,jj)
-                  ENDIF
-               END DO
-            END DO
+            DO_2D_00_00
+               !                 !--- tau_io/(v_oce - v_ice)
+               zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  &
+                  &                              + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) )
+               !                 !--- Ocean-to-Ice stress
+               ztauy_oi(ji,jj) = zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) )
+               !
+               !                 !--- tau_bottom/v_ice
+               zvel  = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) )
+               zTauB = ztauy_base(ji,jj) / zvel
+               !                 !--- OceanBottom-to-Ice stress
+               ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj)
+               !
+               !                 !--- Coriolis at V-points (energy conserving formulation)
+               zCorV(ji,jj)  = - 0.25_wp * r1_e2v(ji,jj) *  &
+                  &    ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * u_ice(ji,jj  ) + e2u(ji-1,jj  ) * u_ice(ji-1,jj  ) )  &
+                  &    + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) )
+               !
+               !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
+               zRHS = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj)
+               !
+               !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS)
+               !                                         1 = sliding friction : TauB < RHS
+               rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztauy_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) )
+               !
+               IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
+                  v_ice(ji,jj) = ( (          rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) )       & ! previous velocity
+                     &                                  + zRHS + zTauO * v_ice(ji,jj) )                                         & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                  / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
+                     &               + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0
+                     &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                     & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
+                     &           )   * zmsk00y(ji,jj)
+               ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009)
+                  v_ice(ji,jj) = ( (           rswitch   * ( zmV_t(ji,jj)  * v_ice(ji,jj)                                       & ! previous velocity
+                     &                                     + zRHS + zTauO * v_ice(ji,jj) )                                      & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                     / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast
+                     &                + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0
+                     &              ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
+                     &            )   * zmsk00y(ji,jj)
+               ENDIF
+            END_2D
             CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1. )
             !
@@ -510,47 +491,45 @@
             IF( ln_bdy )   CALL bdy_ice_dyn( 'V' )
             !
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1          
-                  !                 !--- tau_io/(u_oce - u_ice)
-                  zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  &
-                     &                              + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) )
-                  !                 !--- Ocean-to-Ice stress
-                  ztaux_oi(ji,jj) = zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) )
-                  !
-                  !                 !--- tau_bottom/u_ice
-                  zvel  = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) )
-                  zTauB = ztaux_base(ji,jj) / zvel
-                  !                 !--- OceanBottom-to-Ice stress
-                  ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj)
-                  !
-                  !                 !--- Coriolis at U-points (energy conserving formulation)
-                  zCorU(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  &
-                     &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  &
-                     &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) )
-                  !
-                  !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
-                  zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj)
-                  !
-                  !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS)
-                  !                                         1 = sliding friction : TauB < RHS
-                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) )
-                  !
-                  IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
-                     u_ice(ji,jj) = ( (          rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) )       & ! previous velocity
-                        &                                  + zRHS + zTauO * u_ice(ji,jj) )                                         & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
-                        &                                  / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
-                        &               + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0
-                        &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                     & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
-                        &           )   * zmsk00x(ji,jj)
-                  ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009)
-                     u_ice(ji,jj) = ( (           rswitch   * ( zmU_t(ji,jj)  * u_ice(ji,jj)                                       & ! previous velocity
-                        &                                     + zRHS + zTauO * u_ice(ji,jj) )                                      & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
-                        &                                     / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast
-                        &                + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0
-                        &              ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
-                        &            )   * zmsk00x(ji,jj)
-                  ENDIF
-               END DO
-            END DO
+            DO_2D_00_00
+               !                 !--- tau_io/(u_oce - u_ice)
+               zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  &
+                  &                              + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) )
+               !                 !--- Ocean-to-Ice stress
+               ztaux_oi(ji,jj) = zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) )
+               !
+               !                 !--- tau_bottom/u_ice
+               zvel  = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) )
+               zTauB = ztaux_base(ji,jj) / zvel
+               !                 !--- OceanBottom-to-Ice stress
+               ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj)
+               !
+               !                 !--- Coriolis at U-points (energy conserving formulation)
+               zCorU(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  &
+                  &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  &
+                  &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) )
+               !
+               !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
+               zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj)
+               !
+               !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS)
+               !                                         1 = sliding friction : TauB < RHS
+               rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) )
+               !
+               IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
+                  u_ice(ji,jj) = ( (          rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) )       & ! previous velocity
+                     &                                  + zRHS + zTauO * u_ice(ji,jj) )                                         & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                  / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
+                     &               + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0
+                     &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                     & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
+                     &           )   * zmsk00x(ji,jj)
+               ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009)
+                  u_ice(ji,jj) = ( (           rswitch   * ( zmU_t(ji,jj)  * u_ice(ji,jj)                                       & ! previous velocity
+                     &                                     + zRHS + zTauO * u_ice(ji,jj) )                                      & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                     / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast
+                     &                + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0
+                     &              ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
+                     &            )   * zmsk00x(ji,jj)
+               ENDIF
+            END_2D
             CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1. )
             !
@@ -563,47 +542,45 @@
          ELSE ! odd iterations
             !
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  !                 !--- tau_io/(u_oce - u_ice)
-                  zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  &
-                     &                              + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) )
-                  !                 !--- Ocean-to-Ice stress
-                  ztaux_oi(ji,jj) = zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) )
-                  !
-                  !                 !--- tau_bottom/u_ice
-                  zvel  = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) )
-                  zTauB = ztaux_base(ji,jj) / zvel
-                  !                 !--- OceanBottom-to-Ice stress
-                  ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj)
-                  !
-                  !                 !--- Coriolis at U-points (energy conserving formulation)
-                  zCorU(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  &
-                     &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  &
-                     &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) )
-                  !
-                  !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
-                  zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj)
-                  !
-                  !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS)
-                  !                                         1 = sliding friction : TauB < RHS
-                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) )
-                  !
-                  IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
-                     u_ice(ji,jj) = ( (          rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) )       & ! previous velocity
-                        &                                  + zRHS + zTauO * u_ice(ji,jj) )                                         & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
-                        &                                  / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
-                        &               + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0
-                        &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                     & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
-                        &           )   * zmsk00x(ji,jj)
-                  ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009)
-                     u_ice(ji,jj) = ( (           rswitch   * ( zmU_t(ji,jj)  * u_ice(ji,jj)                                       & ! previous velocity
-                        &                                     + zRHS + zTauO * u_ice(ji,jj) )                                      & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
-                        &                                     / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast
-                        &                + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0
-                        &              ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
-                        &            )   * zmsk00x(ji,jj)
-                  ENDIF
-               END DO
-            END DO
+            DO_2D_00_00
+               !                 !--- tau_io/(u_oce - u_ice)
+               zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  &
+                  &                              + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) )
+               !                 !--- Ocean-to-Ice stress
+               ztaux_oi(ji,jj) = zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) )
+               !
+               !                 !--- tau_bottom/u_ice
+               zvel  = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) )
+               zTauB = ztaux_base(ji,jj) / zvel
+               !                 !--- OceanBottom-to-Ice stress
+               ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj)
+               !
+               !                 !--- Coriolis at U-points (energy conserving formulation)
+               zCorU(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  &
+                  &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  &
+                  &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) )
+               !
+               !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
+               zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj)
+               !
+               !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS)
+               !                                         1 = sliding friction : TauB < RHS
+               rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) )
+               !
+               IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
+                  u_ice(ji,jj) = ( (          rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) )       & ! previous velocity
+                     &                                  + zRHS + zTauO * u_ice(ji,jj) )                                         & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                  / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
+                     &               + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0
+                     &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                     & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
+                     &           )   * zmsk00x(ji,jj)
+               ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009)
+                  u_ice(ji,jj) = ( (           rswitch   * ( zmU_t(ji,jj)  * u_ice(ji,jj)                                       & ! previous velocity
+                     &                                     + zRHS + zTauO * u_ice(ji,jj) )                                      & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                     / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast
+                     &                + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0
+                     &              ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
+                     &            )   * zmsk00x(ji,jj)
+               ENDIF
+            END_2D
             CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1. )
             !
@@ -614,47 +591,45 @@
             IF( ln_bdy )   CALL bdy_ice_dyn( 'U' )
             !
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  !                 !--- tau_io/(v_oce - v_ice)
-                  zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  &
-                     &                              + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) )
-                  !                 !--- Ocean-to-Ice stress
-                  ztauy_oi(ji,jj) = zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) )
-                  !
-                  !                 !--- tau_bottom/v_ice
-                  zvel  = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) )
-                  zTauB = ztauy_base(ji,jj) / zvel
-                  !                 !--- OceanBottom-to-Ice stress
-                  ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj)
-                  !
-                  !                 !--- Coriolis at v-points (energy conserving formulation)
-                  zCorV(ji,jj)  = - 0.25_wp * r1_e2v(ji,jj) *  &
-                     &    ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * u_ice(ji,jj  ) + e2u(ji-1,jj  ) * u_ice(ji-1,jj  ) )  &
-                     &    + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) )
-                  !
-                  !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
-                  zRHS = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj)
-                  !
-                  !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS)
-                  !                                         1 = sliding friction : TauB < RHS
-                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztauy_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) )
-                  !
-                  IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
-                     v_ice(ji,jj) = ( (          rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) )       & ! previous velocity
-                        &                                  + zRHS + zTauO * v_ice(ji,jj) )                                         & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
-                        &                                  / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
-                        &               + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0
-                        &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                     & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
-                        &           )   * zmsk00y(ji,jj)
-                  ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009)
-                     v_ice(ji,jj) = ( (           rswitch   * ( zmV_t(ji,jj)  * v_ice(ji,jj)                                       & ! previous velocity
-                        &                                     + zRHS + zTauO * v_ice(ji,jj) )                                      & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
-                        &                                     / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast
-                        &                + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0
-                        &              ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
-                        &            )   * zmsk00y(ji,jj)
-                  ENDIF
-               END DO
-            END DO
+            DO_2D_00_00
+               !                 !--- tau_io/(v_oce - v_ice)
+               zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  &
+                  &                              + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) )
+               !                 !--- Ocean-to-Ice stress
+               ztauy_oi(ji,jj) = zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) )
+               !
+               !                 !--- tau_bottom/v_ice
+               zvel  = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) )
+               zTauB = ztauy_base(ji,jj) / zvel
+               !                 !--- OceanBottom-to-Ice stress
+               ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj)
+               !
+               !                 !--- Coriolis at v-points (energy conserving formulation)
+               zCorV(ji,jj)  = - 0.25_wp * r1_e2v(ji,jj) *  &
+                  &    ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * u_ice(ji,jj  ) + e2u(ji-1,jj  ) * u_ice(ji-1,jj  ) )  &
+                  &    + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) )
+               !
+               !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
+               zRHS = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj)
+               !
+               !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS)
+               !                                         1 = sliding friction : TauB < RHS
+               rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztauy_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) )
+               !
+               IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
+                  v_ice(ji,jj) = ( (          rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) )       & ! previous velocity
+                     &                                  + zRHS + zTauO * v_ice(ji,jj) )                                         & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                  / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
+                     &               + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0
+                     &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                     & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
+                     &           )   * zmsk00y(ji,jj)
+               ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009)
+                  v_ice(ji,jj) = ( (           rswitch   * ( zmV_t(ji,jj)  * v_ice(ji,jj)                                       & ! previous velocity
+                     &                                     + zRHS + zTauO * v_ice(ji,jj) )                                      & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                     / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast
+                     &                + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0
+                     &              ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
+                     &            )   * zmsk00y(ji,jj)
+               ENDIF
+            END_2D
             CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1. )
             !
@@ -667,5 +642,5 @@
          ENDIF
 
-!!$         IF(ln_ctl) THEN   ! Convergence test
+!!$         IF(sn_cfctl%l_prtctl) THEN   ! Convergence test
 !!$            DO jj = 2 , jpjm1
 !!$               zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ), ABS( v_ice(:,jj) - zv_ice(:,jj) ) )
@@ -682,44 +657,40 @@
       ! 4) Recompute delta, shear and div (inputs for mechanical redistribution) 
       !------------------------------------------------------------------------------!
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-
-            ! shear at F points
-            zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   &
-               &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   &
-               &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj)
-
-         END DO
-      END DO           
+      DO_2D_10_10
+
+         ! shear at F points
+         zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   &
+            &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   &
+            &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj)
+
+      END_2D
       
-      DO jj = 2, jpjm1
-         DO ji = 2, jpim1 ! no vector loop
-            
-            ! tension**2 at T points
-            zdt  = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   &
-               &   - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   &
-               &   ) * r1_e1e2t(ji,jj)
-            zdt2 = zdt * zdt
-            
-            ! shear**2 at T points (doc eq. A16)
-            zds2 = ( zds(ji,jj  ) * zds(ji,jj  ) * e1e2f(ji,jj  ) + zds(ji-1,jj  ) * zds(ji-1,jj  ) * e1e2f(ji-1,jj  )  &
-               &   + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1)  &
-               &   ) * 0.25_wp * r1_e1e2t(ji,jj)
-            
-            ! shear at T points
-            pshear_i(ji,jj) = SQRT( zdt2 + zds2 )
-
-            ! divergence at T points
-            pdivu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   &
-               &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   &
-               &             ) * r1_e1e2t(ji,jj)
-            
-            ! delta at T points
-            zdelta         = SQRT( pdivu_i(ji,jj) * pdivu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 )  
-            rswitch        = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zdelta ) ) ! 0 if delta=0
-            pdelta_i(ji,jj) = zdelta + rn_creepl * rswitch
-
-         END DO
-      END DO
+      DO_2D_00_00
+         
+         ! tension**2 at T points
+         zdt  = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   &
+            &   - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   &
+            &   ) * r1_e1e2t(ji,jj)
+         zdt2 = zdt * zdt
+         
+         ! shear**2 at T points (doc eq. A16)
+         zds2 = ( zds(ji,jj  ) * zds(ji,jj  ) * e1e2f(ji,jj  ) + zds(ji-1,jj  ) * zds(ji-1,jj  ) * e1e2f(ji-1,jj  )  &
+            &   + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1)  &
+            &   ) * 0.25_wp * r1_e1e2t(ji,jj)
+         
+         ! shear at T points
+         pshear_i(ji,jj) = SQRT( zdt2 + zds2 )
+
+         ! divergence at T points
+         pdivu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   &
+            &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   &
+            &             ) * r1_e1e2t(ji,jj)
+         
+         ! delta at T points
+         zdelta         = SQRT( pdivu_i(ji,jj) * pdivu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 )  
+         rswitch        = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zdelta ) ) ! 0 if delta=0
+         pdelta_i(ji,jj) = zdelta + rn_creepl * rswitch
+
+      END_2D
       CALL lbc_lnk_multi( 'icedyn_rhg_evp', pshear_i, 'T', 1., pdivu_i, 'T', 1., pdelta_i, 'T', 1. )
       
@@ -734,9 +705,7 @@
       ! 5) diagnostics
       !------------------------------------------------------------------------------!
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice
-         END DO
-      END DO
+      DO_2D_11_11
+         zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice
+      END_2D
 
       ! --- ice-ocean, ice-atm. & ice-oceanbottom(landfast) stresses --- !
@@ -765,13 +734,12 @@
          ALLOCATE( zsig1(jpi,jpj) , zsig2(jpi,jpj) , zsig3(jpi,jpj) )
          !         
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               zdum1 = ( zmsk00(ji-1,jj) * pstress12_i(ji-1,jj) + zmsk00(ji  ,jj-1) * pstress12_i(ji  ,jj-1) +  &  ! stress12_i at T-point
-                  &      zmsk00(ji  ,jj) * pstress12_i(ji  ,jj) + zmsk00(ji-1,jj-1) * pstress12_i(ji-1,jj-1) )  &
-                  &    / MAX( 1._wp, zmsk00(ji-1,jj) + zmsk00(ji,jj-1) + zmsk00(ji,jj) + zmsk00(ji-1,jj-1) )
-
-               zshear = SQRT( pstress2_i(ji,jj) * pstress2_i(ji,jj) + 4._wp * zdum1 * zdum1 ) ! shear stress  
-
-               zdum2 = zmsk00(ji,jj) / MAX( 1._wp, strength(ji,jj) )
+         DO_2D_00_00
+            zdum1 = ( zmsk00(ji-1,jj) * pstress12_i(ji-1,jj) + zmsk00(ji  ,jj-1) * pstress12_i(ji  ,jj-1) +  &  ! stress12_i at T-point
+               &      zmsk00(ji  ,jj) * pstress12_i(ji  ,jj) + zmsk00(ji-1,jj-1) * pstress12_i(ji-1,jj-1) )  &
+               &    / MAX( 1._wp, zmsk00(ji-1,jj) + zmsk00(ji,jj-1) + zmsk00(ji,jj) + zmsk00(ji-1,jj-1) )
+
+            zshear = SQRT( pstress2_i(ji,jj) * pstress2_i(ji,jj) + 4._wp * zdum1 * zdum1 ) ! shear stress  
+
+            zdum2 = zmsk00(ji,jj) / MAX( 1._wp, strength(ji,jj) )
 
 !!               zsig1(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) + zshear ) ! principal stress (y-direction, see Hunke & Dukowicz 2002)
@@ -779,9 +747,8 @@
 !!               zsig3(ji,jj) = zdum2**2 * ( ( pstress1_i(ji,jj) + strength(ji,jj) )**2 + ( rn_ecc * zshear )**2 ) ! quadratic relation linking compressive stress to shear stress
 !!                                                                                                               ! (scheme converges if this value is ~1, see Bouillon et al 2009 (eq. 11))
-               zsig1(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) )          ! compressive stress, see Bouillon et al. 2015
-               zsig2(ji,jj) = 0.5_wp * zdum2 * ( zshear )                     ! shear stress
-               zsig3(ji,jj) = zdum2**2 * ( ( pstress1_i(ji,jj) + strength(ji,jj) )**2 + ( rn_ecc * zshear )**2 )
-            END DO
-         END DO
+            zsig1(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) )          ! compressive stress, see Bouillon et al. 2015
+            zsig2(ji,jj) = 0.5_wp * zdum2 * ( zshear )                     ! shear stress
+            zsig3(ji,jj) = zdum2**2 * ( ( pstress1_i(ji,jj) + strength(ji,jj) )**2 + ( rn_ecc * zshear )**2 )
+         END_2D
          CALL lbc_lnk_multi( 'icedyn_rhg_evp', zsig1, 'T', 1., zsig2, 'T', 1., zsig3, 'T', 1. )
          !
@@ -818,21 +785,19 @@
             &      zdiag_xmtrp_snw(jpi,jpj) , zdiag_ymtrp_snw(jpi,jpj) , zdiag_xatrp(jpi,jpj) , zdiag_yatrp(jpi,jpj) )
          !
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               ! 2D ice mass, snow mass, area transport arrays (X, Y)
-               zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * zmsk00(ji,jj)
-               zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * zmsk00(ji,jj)
-
-               zdiag_xmtrp_ice(ji,jj) = rhoi * zfac_x * ( vt_i(ji+1,jj) + vt_i(ji,jj) ) ! ice mass transport, X-component
-               zdiag_ymtrp_ice(ji,jj) = rhoi * zfac_y * ( vt_i(ji,jj+1) + vt_i(ji,jj) ) !        ''           Y-   ''
-
-               zdiag_xmtrp_snw(ji,jj) = rhos * zfac_x * ( vt_s(ji+1,jj) + vt_s(ji,jj) ) ! snow mass transport, X-component
-               zdiag_ymtrp_snw(ji,jj) = rhos * zfac_y * ( vt_s(ji,jj+1) + vt_s(ji,jj) ) !          ''          Y-   ''
-
-               zdiag_xatrp(ji,jj)     = zfac_x * ( at_i(ji+1,jj) + at_i(ji,jj) )        ! area transport,      X-component
-               zdiag_yatrp(ji,jj)     = zfac_y * ( at_i(ji,jj+1) + at_i(ji,jj) )        !        ''            Y-   ''
-
-            END DO
-         END DO
+         DO_2D_00_00
+            ! 2D ice mass, snow mass, area transport arrays (X, Y)
+            zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * zmsk00(ji,jj)
+            zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * zmsk00(ji,jj)
+
+            zdiag_xmtrp_ice(ji,jj) = rhoi * zfac_x * ( vt_i(ji+1,jj) + vt_i(ji,jj) ) ! ice mass transport, X-component
+            zdiag_ymtrp_ice(ji,jj) = rhoi * zfac_y * ( vt_i(ji,jj+1) + vt_i(ji,jj) ) !        ''           Y-   ''
+
+            zdiag_xmtrp_snw(ji,jj) = rhos * zfac_x * ( vt_s(ji+1,jj) + vt_s(ji,jj) ) ! snow mass transport, X-component
+            zdiag_ymtrp_snw(ji,jj) = rhos * zfac_y * ( vt_s(ji,jj+1) + vt_s(ji,jj) ) !          ''          Y-   ''
+
+            zdiag_xatrp(ji,jj)     = zfac_x * ( at_i(ji+1,jj) + at_i(ji,jj) )        ! area transport,      X-component
+            zdiag_yatrp(ji,jj)     = zfac_y * ( at_i(ji,jj+1) + at_i(ji,jj) )        !        ''            Y-   ''
+
+         END_2D
 
          CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1., zdiag_ymtrp_ice, 'V', -1., &
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/iceistate.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/iceistate.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/iceistate.F90	(revision 12928)
@@ -61,4 +61,6 @@
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   si  ! structure of input fields (file informations, fields read)
    !   
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/ICE 4.0 , NEMO Consortium (2018)
@@ -68,5 +70,5 @@
 CONTAINS
 
-   SUBROUTINE ice_istate( kt )
+   SUBROUTINE ice_istate( kt, Kbb, Kmm, Kaa )
       !!-------------------------------------------------------------------
       !!                    ***  ROUTINE ice_istate  ***
@@ -89,6 +91,7 @@
       !!              where there is no ice
       !!--------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! time step 
-      !!
+      INTEGER, INTENT(in) :: kt            ! time step 
+      INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices
+      !
       INTEGER  ::   ji, jj, jk, jl         ! dummy loop indices
       REAL(wp) ::   ztmelts
@@ -176,7 +179,7 @@
             !
             ! -- mandatory fields -- !
-            zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1)
-            zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1)
-            zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1)
+            zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) * tmask(:,:,1)
+            zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) * tmask(:,:,1)
+            zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1) * tmask(:,:,1)
 
             ! -- optional fields -- !
@@ -186,26 +189,24 @@
             IF( TRIM(si(jp_smi)%clrootname) == 'NOT USED' ) &
                &     si(jp_smi)%fnow(:,:,1) = ( rn_smi_ini_n * zswitch + rn_smi_ini_s * (1._wp - zswitch) ) * tmask(:,:,1)
-            zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1)
-            !
-            ! ice temperature
-            IF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' ) &
-               &     si(jp_tmi)%fnow(:,:,1) = ( rn_tmi_ini_n * zswitch + rn_tmi_ini_s * (1._wp - zswitch) ) * tmask(:,:,1)
-            ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1)
-            !
-            ! surface temperature => set to ice temperature if it exists
-            IF    ( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) == 'NOT USED' ) THEN
-                     si(jp_tsu)%fnow(:,:,1) = ( rn_tsu_ini_n * zswitch + rn_tsu_ini_s * (1._wp - zswitch) ) * tmask(:,:,1)
-            ELSEIF( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) THEN
-                     si(jp_tsu)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1)
+            !
+            ! temperatures
+            IF    ( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. &
+               &    TRIM(si(jp_tms)%clrootname) == 'NOT USED' ) THEN
+               si(jp_tmi)%fnow(:,:,1) = ( rn_tmi_ini_n * zswitch + rn_tmi_ini_s * (1._wp - zswitch) ) * tmask(:,:,1)
+               si(jp_tsu)%fnow(:,:,1) = ( rn_tsu_ini_n * zswitch + rn_tsu_ini_s * (1._wp - zswitch) ) * tmask(:,:,1)
+               si(jp_tms)%fnow(:,:,1) = ( rn_tms_ini_n * zswitch + rn_tms_ini_s * (1._wp - zswitch) ) * tmask(:,:,1)
+            ELSEIF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tms)%clrootname) /= 'NOT USED' ) THEN ! if T_s is read and not T_i, set T_i = (T_s + T_freeze)/2
+               si(jp_tmi)%fnow(:,:,1) = 0.5_wp * ( si(jp_tms)%fnow(:,:,1) + 271.15 )
+            ELSEIF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) /= 'NOT USED' ) THEN ! if T_su is read and not T_i, set T_i = (T_su + T_freeze)/2
+               si(jp_tmi)%fnow(:,:,1) = 0.5_wp * ( si(jp_tsu)%fnow(:,:,1) + 271.15 )
+            ELSEIF( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tms)%clrootname) /= 'NOT USED' ) THEN ! if T_s is read and not T_su, set T_su = T_s
+               si(jp_tsu)%fnow(:,:,1) = si(jp_tms)%fnow(:,:,1)
+            ELSEIF( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) THEN ! if T_i is read and not T_su, set T_su = T_i
+               si(jp_tsu)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1)
+            ELSEIF( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) /= 'NOT USED' ) THEN ! if T_su is read and not T_s, set T_s = T_su
+               si(jp_tms)%fnow(:,:,1) = si(jp_tsu)%fnow(:,:,1)
+            ELSEIF( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) THEN ! if T_i is read and not T_s, set T_s = T_i
+               si(jp_tms)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1)
             ENDIF
-            zt_su_ini(:,:) = si(jp_tsu)%fnow(:,:,1)
-            !
-            ! snow temperature => set to ice temperature if it exists
-            IF    ( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) == 'NOT USED' ) THEN
-                     si(jp_tms)%fnow(:,:,1) = ( rn_tms_ini_n * zswitch + rn_tms_ini_s * (1._wp - zswitch) ) * tmask(:,:,1)
-            ELSEIF( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) THEN
-                     si(jp_tms)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1)
-            ENDIF
-            ztm_s_ini(:,:) = si(jp_tms)%fnow(:,:,1)
             !
             ! pond concentration
@@ -213,10 +214,15 @@
                &     si(jp_apd)%fnow(:,:,1) = ( rn_apd_ini_n * zswitch + rn_apd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) & ! rn_apd = pond fraction => rn_apnd * a_i = pond conc.
                &                              * si(jp_ati)%fnow(:,:,1) 
-            zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1)
             !
             ! pond depth
             IF( TRIM(si(jp_hpd)%clrootname) == 'NOT USED' ) &
                &     si(jp_hpd)%fnow(:,:,1) = ( rn_hpd_ini_n * zswitch + rn_hpd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1)
-            zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1)
+            !
+            zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) * tmask(:,:,1)
+            ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) * tmask(:,:,1)
+            zt_su_ini(:,:) = si(jp_tsu)%fnow(:,:,1) * tmask(:,:,1)
+            ztm_s_ini(:,:) = si(jp_tms)%fnow(:,:,1) * tmask(:,:,1)
+            zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) * tmask(:,:,1)
+            zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) * tmask(:,:,1)
             !
             ! change the switch for the following
@@ -268,12 +274,10 @@
          ! select ice covered grid points
          npti = 0 ; nptidx(:) = 0
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF ( zht_i_ini(ji,jj) > 0._wp ) THEN
-                  npti         = npti  + 1
-                  nptidx(npti) = (jj - 1) * jpi + ji
-               ENDIF
-            END DO
-         END DO
+         DO_2D_11_11
+            IF ( zht_i_ini(ji,jj) > 0._wp ) THEN
+               npti         = npti  + 1
+               nptidx(npti) = (jj - 1) * jpi + ji
+            ENDIF
+         END_2D
 
          ! move to 1D arrays: (jpi,jpj) -> (jpi*jpj)
@@ -320,38 +324,28 @@
          CALL ice_var_salprof ! for sz_i
          DO jl = 1, jpl
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl)
-                  v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl)
-                  sv_i(ji,jj,jl) = MIN( MAX( rn_simin , s_i(ji,jj,jl) ) , rn_simax ) * v_i(ji,jj,jl)
-               END DO
-            END DO
+            DO_2D_11_11
+               v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl)
+               v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl)
+               sv_i(ji,jj,jl) = MIN( MAX( rn_simin , s_i(ji,jj,jl) ) , rn_simax ) * v_i(ji,jj,jl)
+            END_2D
          END DO
          !
          DO jl = 1, jpl
-            DO jk = 1, nlay_s
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     t_s(ji,jj,jk,jl) = zts_3d(ji,jj,jl)
-                     e_s(ji,jj,jk,jl) = zswitch(ji,jj) * v_s(ji,jj,jl) * r1_nlay_s * &
-                        &               rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus )
-                  END DO
-               END DO
-            END DO
+            DO_3D_11_11( 1, nlay_s )
+               t_s(ji,jj,jk,jl) = zts_3d(ji,jj,jl)
+               e_s(ji,jj,jk,jl) = zswitch(ji,jj) * v_s(ji,jj,jl) * r1_nlay_s * &
+                  &               rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus )
+            END_3D
          END DO
          !
          DO jl = 1, jpl
-            DO jk = 1, nlay_i
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl) 
-                     ztmelts          = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K
-                     e_i(ji,jj,jk,jl) = zswitch(ji,jj) * v_i(ji,jj,jl) * r1_nlay_i * &
-                        &               rhoi * (  rcpi  * ( ztmelts - t_i(ji,jj,jk,jl) ) + &
-                        &                         rLfus * ( 1._wp - (ztmelts-rt0) / MIN( (t_i(ji,jj,jk,jl)-rt0), -epsi20 ) ) &
-                        &                       - rcp   * ( ztmelts - rt0 ) )
-                  END DO
-               END DO
-            END DO
+            DO_3D_11_11( 1, nlay_i )
+               t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl) 
+               ztmelts          = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K
+               e_i(ji,jj,jk,jl) = zswitch(ji,jj) * v_i(ji,jj,jl) * r1_nlay_i * &
+                  &               rhoi * (  rcpi  * ( ztmelts - t_i(ji,jj,jk,jl) ) + &
+                  &                         rLfus * ( 1._wp - (ztmelts-rt0) / MIN( (t_i(ji,jj,jk,jl)-rt0), -epsi20 ) ) &
+                  &                       - rcp   * ( ztmelts - rt0 ) )
+            END_3D
          END DO
 
@@ -380,16 +374,16 @@
       IF( ln_ice_embd ) THEN            ! embedded sea-ice: deplete the initial ssh below sea-ice area
          !
-         sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0
-         sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0
+         ssh(:,:,Kmm) = ssh(:,:,Kmm) - snwice_mass(:,:) * r1_rho0
+         ssh(:,:,Kbb) = ssh(:,:,Kbb) - snwice_mass(:,:) * r1_rho0
          !
          IF( .NOT.ln_linssh ) THEN
             !
-            WHERE( ht_0(:,:) > 0 )   ;   z2d(:,:) = 1._wp + sshn(:,:)*tmask(:,:,1) / ht_0(:,:)
+            WHERE( ht_0(:,:) > 0 )   ;   z2d(:,:) = 1._wp + ssh(:,:,Kmm)*tmask(:,:,1) / ht_0(:,:)
             ELSEWHERE                ;   z2d(:,:) = 1._wp   ;   END WHERE
             !
             DO jk = 1,jpkm1                     ! adjust initial vertical scale factors                
-               e3t_n(:,:,jk) = e3t_0(:,:,jk) * z2d(:,:)
-               e3t_b(:,:,jk) = e3t_n(:,:,jk)
-               e3t_a(:,:,jk) = e3t_n(:,:,jk)
+               e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * z2d(:,:)
+               e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm)
+               e3t(:,:,jk,Kaa) = e3t(:,:,jk,Kmm)
             END DO
             !
@@ -398,26 +392,26 @@
             ! Horizontal scale factor interpolations
             ! --------------------------------------
-            CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' )
-            CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' )
-            CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' )
-            CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' )
-            CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' )
+            CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb), 'U' )
+            CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' )
+            CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' )
+            CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' )
+            CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' )
             ! Vertical scale factor interpolations
             ! ------------------------------------
-            CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  )
-            CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' )
-            CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' )
-            CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' )
-            CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' )
+            CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W'  )
+            CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3uw(:,:,:,Kmm), 'UW' )
+            CALL dom_vvl_interpol( e3v(:,:,:,Kmm), e3vw(:,:,:,Kmm), 'VW' )
+            CALL dom_vvl_interpol( e3u(:,:,:,Kbb), e3uw(:,:,:,Kbb), 'UW' )
+            CALL dom_vvl_interpol( e3v(:,:,:,Kbb), e3vw(:,:,:,Kbb), 'VW' )
             ! t- and w- points depth
             ! ----------------------
             !!gm not sure of that....
-            gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)
-            gdepw_n(:,:,1) = 0.0_wp
-            gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)
+            gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm)
+            gdepw(:,:,1,Kmm) = 0.0_wp
+            gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm)
             DO jk = 2, jpk
-               gdept_n(:,:,jk) = gdept_n(:,:,jk-1) + e3w_n(:,:,jk  )
-               gdepw_n(:,:,jk) = gdepw_n(:,:,jk-1) + e3t_n(:,:,jk-1)
-               gde3w_n(:,:,jk) = gdept_n(:,:,jk  ) - sshn (:,:)
+               gdept(:,:,jk,Kmm) = gdept(:,:,jk-1,Kmm) + e3w(:,:,jk  ,Kmm)
+               gdepw(:,:,jk,Kmm) = gdepw(:,:,jk-1,Kmm) + e3t(:,:,jk-1,Kmm)
+               gde3w(:,:,jk) = gdept(:,:,jk  ,Kmm) - ssh (:,:,Kmm)
             END DO
          ENDIF
@@ -442,5 +436,5 @@
 !!clem: output of initial state should be written here but it is impossible because
 !!      the ocean and ice are in the same file
-!!      CALL dia_wri_state( 'output.init' )
+!!      CALL dia_wri_state( Kmm, 'output.init' )
       !
    END SUBROUTINE ice_istate
@@ -474,8 +468,6 @@
       !!-----------------------------------------------------------------------------
       !
-      REWIND( numnam_ice_ref )              ! Namelist namini in reference namelist : Ice initial state
       READ  ( numnam_ice_ref, namini, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namini in reference namelist' )
-      REWIND( numnam_ice_cfg )              ! Namelist namini in configuration namelist : Ice initial state
       READ  ( numnam_ice_cfg, namini, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namini in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/iceitd.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/iceitd.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/iceitd.F90	(revision 12928)
@@ -48,4 +48,6 @@
    REAL(wp), DIMENSION(0:100) ::   rn_catbnd    ! ice categories bounds
    !
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/ICE 4.0 , NEMO Consortium (2018)
@@ -96,12 +98,10 @@
       !
       npti = 0   ;   nptidx(:) = 0
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF ( at_i(ji,jj) > epsi10 ) THEN
-               npti = npti + 1
-               nptidx( npti ) = (jj - 1) * jpi + ji
-            ENDIF
-         END DO
-      END DO
+      DO_2D_11_11
+         IF ( at_i(ji,jj) > epsi10 ) THEN
+            npti = npti + 1
+            nptidx( npti ) = (jj - 1) * jpi + ji
+         ENDIF
+      END_2D
       
       !-----------------------------------------------------------------------------------------------
@@ -211,5 +211,5 @@
                CALL itd_glinear( zhb0(1:npti)  , zhb1(1:npti)  , h_ib_1d(1:npti)  , a_i_1d(1:npti)  ,  &   ! in
                   &              g0  (1:npti,1), g1  (1:npti,1), hL     (1:npti,1), hR    (1:npti,1)   )   ! out
-                  !
+               !
                ! Area lost due to melting of thin ice
                DO ji = 1, npti
@@ -218,5 +218,5 @@
                      !
                      zdh0 =  h_i_1d(ji) - h_ib_1d(ji)                
-                     IF( zdh0 < 0.0 ) THEN      !remove area from category 1
+                     IF( zdh0 < 0.0 ) THEN      ! remove area from category 1
                         zdh0 = MIN( -zdh0, hi_max(1) )
                         !Integrate g(1) from 0 to dh0 to estimate area melted
@@ -226,8 +226,7 @@
                            zx1    = zetamax
                            zx2    = 0.5 * zetamax * zetamax 
-                           zda0   = g1(ji,1) * zx2 + g0(ji,1) * zx1                        ! ice area removed
+                           zda0   = g1(ji,1) * zx2 + g0(ji,1) * zx1                ! ice area removed
                            zdamax = a_i_1d(ji) * (1.0 - h_i_1d(ji) / h_ib_1d(ji) ) ! Constrain new thickness <= h_i                
-                           zda0   = MIN( zda0, zdamax )                                                  ! ice area lost due to melting 
-                           !     of thin ice (zdamax > 0)
+                           zda0   = MIN( zda0, zdamax )                            ! ice area lost due to melting of thin ice (zdamax > 0)
                            ! Remove area, conserving volume
                            h_i_1d(ji) = h_i_1d(ji) * a_i_1d(ji) / ( a_i_1d(ji) - zda0 )
@@ -349,5 +348,5 @@
       DO ji = 1, npti
          !
-         IF( paice(ji) > epsi10  .AND. phice(ji) > 0._wp )  THEN
+         IF( paice(ji) > epsi10  .AND. phice(ji) > epsi10 )  THEN
             !
             ! Initialize hL and hR
@@ -598,12 +597,10 @@
          !                    !---------------------------------------
          npti = 0   ;   nptidx(:) = 0
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( a_i(ji,jj,jl) > 0._wp .AND. v_i(ji,jj,jl) > (a_i(ji,jj,jl) * hi_max(jl)) ) THEN
-                  npti = npti + 1
-                  nptidx( npti ) = (jj - 1) * jpi + ji                  
-               ENDIF
-            END DO
-         END DO
+         DO_2D_11_11
+            IF( a_i(ji,jj,jl) > 0._wp .AND. v_i(ji,jj,jl) > (a_i(ji,jj,jl) * hi_max(jl)) ) THEN
+               npti = npti + 1
+               nptidx( npti ) = (jj - 1) * jpi + ji                  
+            ENDIF
+         END_2D
          !
 !!clem   CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d(1:npti), h_i(:,:,jl) )
@@ -639,12 +636,10 @@
          !                    !-----------------------------------------
          npti = 0 ; nptidx(:) = 0
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( a_i(ji,jj,jl+1) > 0._wp .AND. v_i(ji,jj,jl+1) <= (a_i(ji,jj,jl+1) * hi_max(jl)) ) THEN
-                  npti = npti + 1
-                  nptidx( npti ) = (jj - 1) * jpi + ji                  
-               ENDIF
-            END DO
-         END DO
+         DO_2D_11_11
+            IF( a_i(ji,jj,jl+1) > 0._wp .AND. v_i(ji,jj,jl+1) <= (a_i(ji,jj,jl+1) * hi_max(jl)) ) THEN
+               npti = npti + 1
+               nptidx( npti ) = (jj - 1) * jpi + ji                  
+            ENDIF
+         END_2D
          !
          CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d(1:npti), a_i(:,:,jl+1) ) ! jl+1 is ok
@@ -687,8 +682,6 @@
       !!------------------------------------------------------------------
       !
-      REWIND( numnam_ice_ref )      ! Namelist namitd in reference namelist : Parameters for ice
       READ  ( numnam_ice_ref, namitd, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namitd in reference namelist' )
-      REWIND( numnam_ice_cfg )      ! Namelist namitd in configuration namelist : Parameters for ice
       READ  ( numnam_ice_cfg, namitd, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namitd in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icerst.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icerst.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icerst.F90	(revision 12928)
@@ -80,5 +80,5 @@
             ENDIF
             !
-            CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kdlev = jpl )
+            CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' )
             lrst_ice = .TRUE.
          ENDIF
@@ -163,5 +163,5 @@
 
 
-   SUBROUTINE ice_rst_read
+   SUBROUTINE ice_rst_read( Kbb, Kmm, Kaa )
       !!----------------------------------------------------------------------
       !!                    ***  ice_rst_read  ***
@@ -169,4 +169,5 @@
       !! ** purpose  :   read restart file
       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices
       INTEGER           ::   jk
       LOGICAL           ::   llok
@@ -184,5 +185,5 @@
       ENDIF
 
-      CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir, kdlev = jpl )
+      CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir )
 
       ! test if v_i exists 
@@ -272,5 +273,5 @@
          !
          CALL ice_istate_init
-         CALL ice_istate( nit000 )
+         CALL ice_istate( nit000, Kbb, Kmm, Kaa )
          !
          IF( .NOT.ln_iceini .OR. .NOT.ln_iceini_file ) &
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icesbc.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icesbc.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icesbc.F90	(revision 12928)
@@ -27,4 +27,5 @@
    USE lbclnk         ! lateral boundary conditions (or mpp links)
    USE timing         ! Timing
+   USE fldread        !!GS: needed by agrif
 
    IMPLICIT NONE
@@ -36,5 +37,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/ICE 4.0 , NEMO Consortium (2018)
@@ -71,5 +72,9 @@
       SELECT CASE( ksbc )
          CASE( jp_usr     )   ;    CALL usrdef_sbc_ice_tau( kt )                 ! user defined formulation
-         CASE( jp_blk     )   ;    CALL blk_ice_tau                              ! Bulk         formulation
+         CASE( jp_blk     )   ;    CALL blk_ice_1( sf(jp_wndi)%fnow(:,:,1), sf(jp_wndj)%fnow(:,:,1),   &
+            &                                      sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1),   &
+            &                                      sf(jp_slp )%fnow(:,:,1), u_ice, v_ice, tm_su    ,   &   ! inputs
+            &                                      putaui = utau_ice, pvtaui = vtau_ice            )       ! outputs                             
+ !        CASE( jp_abl     )    utau_ice & vtau_ice are computed in ablmod
          CASE( jp_purecpl )   ;    CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )   ! Coupled      formulation
       END SELECT
@@ -77,10 +82,8 @@
       IF( ln_mixcpl) THEN                                                        ! Case of a mixed Bulk/Coupled formulation
                                    CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice )
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               utau_ice(ji,jj) = utau_ice(ji,jj) * xcplmask(ji,jj,0) + zutau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) )
-               vtau_ice(ji,jj) = vtau_ice(ji,jj) * xcplmask(ji,jj,0) + zvtau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) )
-            END DO
-         END DO
+         DO_2D_00_00
+            utau_ice(ji,jj) = utau_ice(ji,jj) * xcplmask(ji,jj,0) + zutau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) )
+            vtau_ice(ji,jj) = vtau_ice(ji,jj) * xcplmask(ji,jj,0) + zvtau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) )
+         END_2D
          CALL lbc_lnk_multi( 'icesbc', utau_ice, 'U', -1., vtau_ice, 'V', -1. )
       ENDIF
@@ -143,6 +146,7 @@
       CASE( jp_usr )              !--- user defined formulation
                                   CALL usrdef_sbc_ice_flx( kt, h_s, h_i )
-      CASE( jp_blk )              !--- bulk formulation
-                                  CALL blk_ice_flx    ( t_su, h_s, h_i, alb_ice )    ! 
+      CASE( jp_blk, jp_abl )  !--- bulk formulation & ABL formulation
+                                  CALL blk_ice_2    ( t_su, h_s, h_i, alb_ice, sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1),    &
+            &                                           sf(jp_slp)%fnow(:,:,1), sf(jp_qlw)%fnow(:,:,1), sf(jp_prec)%fnow(:,:,1), sf(jp_snow)%fnow(:,:,1) )    ! 
          IF( ln_mixcpl        )   CALL sbc_cpl_ice_flx( picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su, phs=h_s, phi=h_i )
          IF( nn_flxdist /= -1 )   CALL ice_flx_dist   ( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_flxdist )
@@ -284,8 +288,6 @@
       !!-------------------------------------------------------------------
       !
-      REWIND( numnam_ice_ref )         ! Namelist namsbc in reference namelist : Ice dynamics
       READ  ( numnam_ice_ref, namsbc, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc in reference namelist' )
-      REWIND( numnam_ice_cfg )         ! Namelist namsbc in configuration namelist : Ice dynamics
       READ  ( numnam_ice_cfg, namsbc, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icestp.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icestp.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icestp.F90	(revision 12928)
@@ -86,6 +86,4 @@
    PUBLIC   ice_init   ! called by sbcmod.F90
 
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/ICE 4.0 , NEMO Consortium (2018)
@@ -95,5 +93,5 @@
 CONTAINS
 
-   SUBROUTINE ice_stp( kt, ksbc )
+   SUBROUTINE ice_stp( kt, Kbb, Kmm, ksbc )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE ice_stp  ***
@@ -115,6 +113,7 @@
       !!                utau, vtau, taum, wndm, qns , qsr, emp , sfx
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt      ! ocean time step
-      INTEGER, INTENT(in) ::   ksbc    ! flux formulation (user defined, bulk, or Pure Coupled)
+      INTEGER, INTENT(in) ::   kt       ! ocean time step
+      INTEGER, INTENT(in) ::   Kbb, Kmm ! ocean time level indices
+      INTEGER, INTENT(in) ::   ksbc     ! flux formulation (user defined, bulk, or Pure Coupled)
       !
       INTEGER ::   jl   ! dummy loop index
@@ -160,5 +159,5 @@
          !
          IF( ln_icedyn .AND. .NOT.lk_c1d )   &
-            &                           CALL ice_dyn( kt )            ! -- Ice dynamics
+            &                           CALL ice_dyn( kt, Kmm )       ! -- Ice dynamics
          !
          !                          !==  lateral boundary conditions  ==!
@@ -209,5 +208,5 @@
       ! --- Ocean time step --- !
       !-------------------------!
-      IF( ln_icedyn )                   CALL ice_update_tau( kt, ub(:,:,1), vb(:,:,1) )   ! -- update surface ocean stresses
+      IF( ln_icedyn )                   CALL ice_update_tau( kt, uu(:,:,1,Kbb), vv(:,:,1,Kbb) )   ! -- update surface ocean stresses
 !!gm   remark, the ocean-ice stress is not saved in ice diag call above .....  find a solution!!!
       !
@@ -217,5 +216,5 @@
 
 
-   SUBROUTINE ice_init
+   SUBROUTINE ice_init( Kbb, Kmm, Kaa )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE ice_init  ***
@@ -223,4 +222,6 @@
       !! ** purpose :   Initialize sea-ice parameters
       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: Kbb, Kmm, Kaa
+      !
       INTEGER :: ji, jj, ierr
       !!----------------------------------------------------------------------
@@ -232,8 +233,8 @@
       IF(lwp) WRITE(numout,*) '~~~~~~~~'
       !
-      !                                ! Open the reference and configuration namelist files and namelist output file
-      CALL ctl_opn( numnam_ice_ref, 'namelist_ice_ref',    'OLD',     'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
-      CALL ctl_opn( numnam_ice_cfg, 'namelist_ice_cfg',    'OLD',     'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
-      IF(lwm) CALL ctl_opn( numoni, 'output.namelist.ice', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, 1 )
+      !                                ! Load the reference and configuration namelist files and open namelist output file
+      CALL load_nml( numnam_ice_ref, 'namelist_ice_ref',    numout, lwm )
+      CALL load_nml( numnam_ice_cfg, 'namelist_ice_cfg',    numout, lwm )
+      IF(lwm) CALL ctl_opn( numoni , 'output.namelist.ice', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, 1 )
       !
       CALL par_init                ! set some ice run parameters
@@ -254,7 +255,7 @@
       IF( .NOT. ln_rstart ) THEN              ! start from rest: sea-ice deduced from sst
          CALL ice_istate_init
-         CALL ice_istate( nit000 )
+         CALL ice_istate( nit000, Kbb, Kmm, Kaa )
       ELSE                                    ! start from a restart file
-         CALL ice_rst_read
+         CALL ice_rst_read( Kbb, Kmm, Kaa )
       ENDIF
       CALL ice_var_glo2eqv
@@ -301,8 +302,6 @@
       !!-------------------------------------------------------------------
       !
-      REWIND( numnam_ice_ref )      ! Namelist nampar in reference namelist : Parameters for ice
       READ  ( numnam_ice_ref, nampar, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampar in reference namelist' )
-      REWIND( numnam_ice_cfg )      ! Namelist nampar in configuration namelist : Parameters for ice
       READ  ( numnam_ice_cfg, nampar, IOSTAT = ios, ERR = 902 )
 902   IF( ios > 0 )   CALL ctl_nam ( ios , 'nampar in configuration namelist' )
@@ -339,8 +338,8 @@
       IF( ln_bdy .AND. ln_icediachk )   CALL ctl_warn('par_init: online conservation check does not work with BDY')
       !
-      rdt_ice   = REAL(nn_fsbc) * rdt          !--- sea-ice timestep and its inverse
-      r1_rdtice = 1._wp / rdt_ice
+      rDt_ice   = REAL(nn_fsbc) * rn_Dt          !--- sea-ice timestep and its inverse
+      r1_Dt_ice = 1._wp / rDt_ice
       IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) '      ice timestep rdt_ice = nn_fsbc*rdt = ', rdt_ice
+      IF(lwp) WRITE(numout,*) '      ice timestep rDt_ice = nn_fsbc*rn_Dt = ', rDt_ice
       !
       r1_nlay_i = 1._wp / REAL( nlay_i, wp )   !--- inverse of nlay_i and nlay_s
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icethd.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icethd.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icethd.F90	(revision 12928)
@@ -53,5 +53,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/ICE 4.0 , NEMO Consortium (2018)
@@ -109,19 +109,15 @@
          zu_io(:,:) = u_ice(:,:) - ssu_m(:,:)
          zv_io(:,:) = v_ice(:,:) - ssv_m(:,:)
-         DO jj = 2, jpjm1 
-            DO ji = fs_2, fs_jpim1
-               zfric(ji,jj) = rn_cio * ( 0.5_wp *  &
-                  &                    (  zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj)   &
-                  &                     + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) ) * tmask(ji,jj,1)
-            END DO
-         END DO
+         DO_2D_00_00
+            zfric(ji,jj) = rn_cio * ( 0.5_wp *  &
+               &                    (  zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj)   &
+               &                     + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) ) * tmask(ji,jj,1)
+         END_2D
       ELSE      !  if no ice dynamics => transmit directly the atmospheric stress to the ocean
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               zfric(ji,jj) = r1_rau0 * SQRT( 0.5_wp *  &
-                  &                         (  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   &
-                  &                          + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) ) * tmask(ji,jj,1)
-            END DO
-         END DO
+         DO_2D_00_00
+            zfric(ji,jj) = r1_rho0 * SQRT( 0.5_wp *  &
+               &                         (  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   &
+               &                          + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) ) * tmask(ji,jj,1)
+         END_2D
       ENDIF
       CALL lbc_lnk( 'icethd', zfric, 'T',  1. )
@@ -130,49 +126,47 @@
       ! Partial computation of forcing for the thermodynamic sea ice model
       !--------------------------------------------------------------------!
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            rswitch  = tmask(ji,jj,1) * MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) ! 0 if no ice
-            !
-            !           !  solar irradiance transmission at the mixed layer bottom and used in the lead heat budget
-            !           !  practically no "direct lateral ablation"
-            !           
-            !           !  net downward heat flux from the ice to the ocean, expressed as a function of ocean 
-            !           !  temperature and turbulent mixing (McPhee, 1992)
-            !
-            ! --- Energy received in the lead from atm-oce exchanges, zqld is defined everywhere (J.m-2) --- !
-            zqld =  tmask(ji,jj,1) * rdt_ice *  &
-               &    ( ( 1._wp - at_i_b(ji,jj) ) * qsr_oce(ji,jj) * frq_m(ji,jj) +  &
-               &      ( 1._wp - at_i_b(ji,jj) ) * qns_oce(ji,jj) + qemp_oce(ji,jj) )
-
-            ! --- Energy needed to bring ocean surface layer until its freezing (mostly<0 but >0 if supercooling, J.m-2) --- !
-            zqfr     = rau0 * rcp * e3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) * tmask(ji,jj,1)  ! both < 0 (t_bo < sst) and > 0 (t_bo > sst)
-            zqfr_neg = MIN( zqfr , 0._wp )                                                                    ! only < 0
-
-            ! --- Sensible ocean-to-ice heat flux (mostly>0 but <0 if supercooling, W/m2)
-            zfric_u            = MAX( SQRT( zfric(ji,jj) ), zfric_umin ) 
-            qsb_ice_bot(ji,jj) = rswitch * rau0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ! W.m-2
-
-            qsb_ice_bot(ji,jj) = rswitch * MIN( qsb_ice_bot(ji,jj), - zqfr_neg * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) )
-            ! upper bound for qsb_ice_bot: the heat retrieved from the ocean must be smaller than the heat necessary to reach 
-            !                              the freezing point, so that we do not have SST < T_freeze
-            !                              This implies: - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rtdice ) - zqfr >= 0
-
-            !-- Energy Budget of the leads (J.m-2), source of ice growth in open water. Must be < 0 to form ice
-            qlead(ji,jj) = MIN( 0._wp , zqld - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rdt_ice ) - zqfr )
-
-            ! If there is ice and leads are warming => transfer energy from the lead budget and use it for bottom melting 
-            ! If the grid cell is fully covered by ice (no leads) => transfer energy from the lead budget to the ice bottom budget
-            IF( ( zqld >= 0._wp .AND. at_i(ji,jj) > 0._wp ) .OR. at_i(ji,jj) >= (1._wp - epsi10) ) THEN
-               fhld (ji,jj) = rswitch * zqld * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in icethd_dh.F90
-               qlead(ji,jj) = 0._wp
-            ELSE
-               fhld (ji,jj) = 0._wp
-            ENDIF
-            !
-            ! Net heat flux on top of the ice-ocean [W.m-2]
-            ! ---------------------------------------------
-            qt_atm_oi(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj) 
-         END DO
-      END DO
+      DO_2D_11_11
+         rswitch  = tmask(ji,jj,1) * MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) ! 0 if no ice
+         !
+         !           !  solar irradiance transmission at the mixed layer bottom and used in the lead heat budget
+         !           !  practically no "direct lateral ablation"
+         !           
+         !           !  net downward heat flux from the ice to the ocean, expressed as a function of ocean 
+         !           !  temperature and turbulent mixing (McPhee, 1992)
+         !
+         ! --- Energy received in the lead from atm-oce exchanges, zqld is defined everywhere (J.m-2) --- !
+         zqld =  tmask(ji,jj,1) * rDt_ice *  &
+            &    ( ( 1._wp - at_i_b(ji,jj) ) * qsr_oce(ji,jj) * frq_m(ji,jj) +  &
+            &      ( 1._wp - at_i_b(ji,jj) ) * qns_oce(ji,jj) + qemp_oce(ji,jj) )
+
+         ! --- Energy needed to bring ocean surface layer until its freezing (mostly<0 but >0 if supercooling, J.m-2) --- !
+         zqfr     = rho0 * rcp * e3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) * tmask(ji,jj,1)  ! both < 0 (t_bo < sst) and > 0 (t_bo > sst)
+         zqfr_neg = MIN( zqfr , 0._wp )                                                                    ! only < 0
+
+         ! --- Sensible ocean-to-ice heat flux (mostly>0 but <0 if supercooling, W/m2)
+         zfric_u            = MAX( SQRT( zfric(ji,jj) ), zfric_umin ) 
+         qsb_ice_bot(ji,jj) = rswitch * rho0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ! W.m-2
+
+         qsb_ice_bot(ji,jj) = rswitch * MIN( qsb_ice_bot(ji,jj), - zqfr_neg * r1_Dt_ice / MAX( at_i(ji,jj), epsi10 ) )
+         ! upper bound for qsb_ice_bot: the heat retrieved from the ocean must be smaller than the heat necessary to reach 
+         !                              the freezing point, so that we do not have SST < T_freeze
+         !                              This implies: - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rtdice ) - zqfr >= 0
+
+         !-- Energy Budget of the leads (J.m-2), source of ice growth in open water. Must be < 0 to form ice
+         qlead(ji,jj) = MIN( 0._wp , zqld - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rDt_ice ) - zqfr )
+
+         ! If there is ice and leads are warming => transfer energy from the lead budget and use it for bottom melting 
+         ! If the grid cell is fully covered by ice (no leads) => transfer energy from the lead budget to the ice bottom budget
+         IF( ( zqld >= 0._wp .AND. at_i(ji,jj) > 0._wp ) .OR. at_i(ji,jj) >= (1._wp - epsi10) ) THEN
+            fhld (ji,jj) = rswitch * zqld * r1_Dt_ice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in icethd_dh.F90
+            qlead(ji,jj) = 0._wp
+         ELSE
+            fhld (ji,jj) = 0._wp
+         ENDIF
+         !
+         ! Net heat flux on top of the ice-ocean [W.m-2]
+         ! ---------------------------------------------
+         qt_atm_oi(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj) 
+      END_2D
       
       ! In case we bypass open-water ice formation
@@ -191,5 +185,5 @@
       !     Third  step in iceupdate.F90  :  heat from ice-ocean mass exchange (zf_mass) + solar
       qt_oce_ai(:,:) = ( 1._wp - at_i_b(:,:) ) * qns_oce(:,:) + qemp_oce(:,:)  &  ! Non solar heat flux received by the ocean               
-         &             - qlead(:,:) * r1_rdtice                                &  ! heat flux taken from the ocean where there is open water ice formation
+         &             - qlead(:,:) * r1_Dt_ice                                &  ! heat flux taken from the ocean where there is open water ice formation
          &             - at_i (:,:) * qsb_ice_bot(:,:)                         &  ! heat flux taken by sensible flux
          &             - at_i (:,:) * fhld       (:,:)                            ! heat flux taken during bottom growth/melt 
@@ -202,12 +196,10 @@
          ! select ice covered grid points
          npti = 0 ; nptidx(:) = 0
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF ( a_i(ji,jj,jl) > epsi10 ) THEN     
-                  npti         = npti  + 1
-                  nptidx(npti) = (jj - 1) * jpi + ji
-               ENDIF
-            END DO
-         END DO
+         DO_2D_11_11
+            IF ( a_i(ji,jj,jl) > epsi10 ) THEN     
+               npti         = npti  + 1
+               nptidx(npti) = (jj - 1) * jpi + ji
+            ENDIF
+         END_2D
 
          IF( npti > 0 ) THEN  ! If there is no ice, do nothing.
@@ -252,5 +244,6 @@
       ! controls
       IF( ln_icectl )   CALL ice_prt    (kt, iiceprt, jiceprt, 1, ' - ice thermodyn. - ') ! prints
-      IF( ln_ctl    )   CALL ice_prt3D  ('icethd')                                        ! prints
+      IF( sn_cfctl%l_prtctl )   &
+        &               CALL ice_prt3D  ('icethd')                                        ! prints
       IF( ln_timing )   CALL timing_stop('icethd')                                        ! timing
       !
@@ -539,8 +532,6 @@
       !!-------------------------------------------------------------------
       !
-      REWIND( numnam_ice_ref )              ! Namelist namthd in reference namelist : Ice thermodynamics
       READ  ( numnam_ice_ref, namthd, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd in reference namelist' )
-      REWIND( numnam_ice_cfg )              ! Namelist namthd in configuration namelist : Ice thermodynamics
       READ  ( numnam_ice_cfg, namthd, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icethd_da.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icethd_da.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icethd_da.F90	(revision 12928)
@@ -128,5 +128,5 @@
          zwlat  = zm1 * ( MAX( 0._wp, sst_1d(ji) - ( t_bo_1d(ji) - rt0 ) ) )**zm2  ! Melt speed rate [m/s]
          !
-         zda_tot(ji) = MIN( zwlat * zperi * rdt_ice, at_i_1d(ji) )                 ! sea ice concentration decrease (>0)
+         zda_tot(ji) = MIN( zwlat * zperi * rDt_ice, at_i_1d(ji) )                 ! sea ice concentration decrease (>0)
       
          ! --- Distribute reduction among ice categories and calculate associated ice-ocean fluxes --- !
@@ -137,12 +137,12 @@
             
             ! Contribution to salt flux
-            sfx_lam_1d(ji) = sfx_lam_1d(ji) + rhoi *  h_i_1d(ji) * zda * s_i_1d(ji) * r1_rdtice
+            sfx_lam_1d(ji) = sfx_lam_1d(ji) + rhoi *  h_i_1d(ji) * zda * s_i_1d(ji) * r1_Dt_ice
             
             ! Contribution to heat flux into the ocean [W.m-2], (<0)  
-            hfx_thd_1d(ji) = hfx_thd_1d(ji) - zda * r1_rdtice * ( h_i_1d(ji) * r1_nlay_i * SUM( e_i_1d(ji,1:nlay_i) )  &
+            hfx_thd_1d(ji) = hfx_thd_1d(ji) - zda * r1_Dt_ice * ( h_i_1d(ji) * r1_nlay_i * SUM( e_i_1d(ji,1:nlay_i) )  &
                                                                 + h_s_1d(ji) * r1_nlay_s * SUM( e_s_1d(ji,1:nlay_s) ) ) 
             
             ! Contribution to mass flux
-            wfx_lam_1d(ji) =  wfx_lam_1d(ji) + zda * r1_rdtice * ( rhoi * h_i_1d(ji) + rhos * h_s_1d(ji) )
+            wfx_lam_1d(ji) =  wfx_lam_1d(ji) + zda * r1_Dt_ice * ( rhoi * h_i_1d(ji) + rhos * h_s_1d(ji) )
             
             ! new concentration
@@ -177,8 +177,6 @@
       !!-------------------------------------------------------------------
       !
-      REWIND( numnam_ice_ref )              ! Namelist namthd_da in reference namelist : Ice thermodynamics
       READ  ( numnam_ice_ref, namthd_da, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_da in reference namelist' )
-      REWIND( numnam_ice_cfg )              ! Namelist namthd_da in configuration namelist : Ice thermodynamics
       READ  ( numnam_ice_cfg, namthd_da, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_da in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icethd_dh.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icethd_dh.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icethd_dh.F90	(revision 12928)
@@ -76,5 +76,5 @@
       REAL(wp) ::   zgrr         ! bottom growth rate
       REAL(wp) ::   zt_i_new     ! bottom formation temperature
-      REAL(wp) ::   z1_rho       ! 1/(rhos+rau0-rhoi)
+      REAL(wp) ::   z1_rho       ! 1/(rhos+rho0-rhoi)
 
       REAL(wp) ::   zQm          ! enthalpy exchanged with the ocean (J/m2), >0 towards the ocean
@@ -130,5 +130,5 @@
          !
          DO ji = 1, npti
-            zq_top(ji)     = MAX( 0._wp, qml_ice_1d(ji) * rdt_ice )
+            zq_top(ji)     = MAX( 0._wp, qml_ice_1d(ji) * rDt_ice )
          END DO
          !
@@ -138,5 +138,5 @@
             zdum           = qns_ice_1d(ji) + qsr_ice_1d(ji) - qtr_ice_top_1d(ji) - qcn_ice_top_1d(ji)
             qml_ice_1d(ji) = zdum * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - rt0 ) )
-            zq_top(ji)     = MAX( 0._wp, qml_ice_1d(ji) * rdt_ice )
+            zq_top(ji)     = MAX( 0._wp, qml_ice_1d(ji) * rDt_ice )
          END DO
          !
@@ -145,5 +145,5 @@
       DO ji = 1, npti
          zf_tt(ji)         = qcn_ice_bot_1d(ji) + qsb_ice_bot_1d(ji) + fhld_1d(ji) 
-         zq_bot(ji)        = MAX( 0._wp, zf_tt(ji) * rdt_ice )
+         zq_bot(ji)        = MAX( 0._wp, zf_tt(ji) * rDt_ice )
       END DO
 
@@ -172,6 +172,6 @@
          DO ji = 1, npti
             IF( t_s_1d(ji,jk) > rt0 ) THEN
-               hfx_res_1d    (ji) = hfx_res_1d    (ji) + e_s_1d(ji,jk) * zh_s(ji,jk) * a_i_1d(ji) * r1_rdtice   ! heat flux to the ocean [W.m-2], < 0
-               wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) + rhos          * zh_s(ji,jk) * a_i_1d(ji) * r1_rdtice   ! mass flux
+               hfx_res_1d    (ji) = hfx_res_1d    (ji) + e_s_1d(ji,jk) * zh_s(ji,jk) * a_i_1d(ji) * r1_Dt_ice   ! heat flux to the ocean [W.m-2], < 0
+               wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) + rhos          * zh_s(ji,jk) * a_i_1d(ji) * r1_Dt_ice   ! mass flux
                ! updates
                dh_s_mlt(ji)    = dh_s_mlt(ji) - zh_s(ji,jk)
@@ -193,9 +193,9 @@
             !
             ! --- precipitation ---
-            zdh_s_pre (ji) = zsnw(ji) * sprecip_1d(ji) * rdt_ice * r1_rhos / at_i_1d(ji)   ! thickness change
+            zdh_s_pre (ji) = zsnw(ji) * sprecip_1d(ji) * rDt_ice * r1_rhos / at_i_1d(ji)   ! thickness change
             zqprec    (ji) = - qprec_ice_1d(ji)                                             ! enthalpy of the precip (>0, J.m-3)
             !
-            hfx_spr_1d(ji) = hfx_spr_1d(ji) + zdh_s_pre(ji) * a_i_1d(ji) * zqprec(ji)    * r1_rdtice   ! heat flux from snow precip (>0, W.m-2)
-            wfx_spr_1d(ji) = wfx_spr_1d(ji) - rhos          * a_i_1d(ji) * zdh_s_pre(ji) * r1_rdtice   ! mass flux, <0
+            hfx_spr_1d(ji) = hfx_spr_1d(ji) + zdh_s_pre(ji) * a_i_1d(ji) * zqprec(ji)    * r1_Dt_ice   ! heat flux from snow precip (>0, W.m-2)
+            wfx_spr_1d(ji) = wfx_spr_1d(ji) - rhos          * a_i_1d(ji) * zdh_s_pre(ji) * r1_Dt_ice   ! mass flux, <0
             
             ! --- melt of falling snow ---
@@ -203,6 +203,6 @@
             zdeltah       (ji,1) = - rswitch * zq_top(ji) / MAX( zqprec(ji) , epsi20 )   ! thickness change
             zdeltah       (ji,1) = MAX( - zdh_s_pre(ji), zdeltah(ji,1) )                 ! bound melting 
-            hfx_snw_1d    (ji)   = hfx_snw_1d    (ji) - zdeltah(ji,1) * a_i_1d(ji) * zqprec(ji)    * r1_rdtice   ! heat used to melt snow (W.m-2, >0)
-            wfx_snw_sum_1d(ji)   = wfx_snw_sum_1d(ji) - rhos          * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice   ! snow melting only = water into the ocean (then without snow precip), >0
+            hfx_snw_1d    (ji)   = hfx_snw_1d    (ji) - zdeltah(ji,1) * a_i_1d(ji) * zqprec(ji)    * r1_Dt_ice   ! heat used to melt snow (W.m-2, >0)
+            wfx_snw_sum_1d(ji)   = wfx_snw_sum_1d(ji) - rhos          * a_i_1d(ji) * zdeltah(ji,1) * r1_Dt_ice   ! snow melting only = water into the ocean (then without snow precip), >0
             
             ! updates available heat + precipitations after melting
@@ -243,6 +243,6 @@
                zdh_s_mel(ji)    = zdh_s_mel(ji) + zdeltah(ji,jk)
                
-               hfx_snw_1d(ji)     = hfx_snw_1d(ji)     - zdeltah(ji,jk) * a_i_1d(ji) * e_s_1d (ji,jk) * r1_rdtice   ! heat used to melt snow(W.m-2, >0)
-               wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) - rhos           * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice   ! snow melting only = water into the ocean (then without snow precip)
+               hfx_snw_1d(ji)     = hfx_snw_1d(ji)     - zdeltah(ji,jk) * a_i_1d(ji) * e_s_1d (ji,jk) * r1_Dt_ice   ! heat used to melt snow(W.m-2, >0)
+               wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) - rhos           * a_i_1d(ji) * zdeltah(ji,jk) * r1_Dt_ice   ! snow melting only = water into the ocean (then without snow precip)
                
                ! updates available heat + thickness
@@ -264,12 +264,12 @@
          IF( evap_ice_1d(ji) > 0._wp ) THEN
             !
-            zdh_s_sub (ji)   = MAX( - h_s_1d(ji) , - evap_ice_1d(ji) * r1_rhos * rdt_ice )
-            zevap_rema(ji)   = evap_ice_1d(ji) * rdt_ice + zdh_s_sub(ji) * rhos   ! remaining evap in kg.m-2 (used for ice melting later on)
+            zdh_s_sub (ji)   = MAX( - h_s_1d(ji) , - evap_ice_1d(ji) * r1_rhos * rDt_ice )
+            zevap_rema(ji)   = evap_ice_1d(ji) * rDt_ice + zdh_s_sub(ji) * rhos   ! remaining evap in kg.m-2 (used for ice melting later on)
             zdeltah   (ji,1) = MAX( zdh_s_sub(ji), - zdh_s_pre(ji) )
             
             hfx_sub_1d    (ji) = hfx_sub_1d(ji) + &   ! Heat flux by sublimation [W.m-2], < 0 (sublimate snow that had fallen, then pre-existing snow)
                &                 ( zdeltah(ji,1) * zqprec(ji) + ( zdh_s_sub(ji) - zdeltah(ji,1) ) * e_s_1d(ji,1) )  &
-               &                 * a_i_1d(ji) * r1_rdtice
-            wfx_snw_sub_1d(ji) = wfx_snw_sub_1d(ji) - rhos * a_i_1d(ji) * zdh_s_sub(ji) * r1_rdtice   ! Mass flux by sublimation
+               &                 * a_i_1d(ji) * r1_Dt_ice
+            wfx_snw_sub_1d(ji) = wfx_snw_sub_1d(ji) - rhos * a_i_1d(ji) * zdh_s_sub(ji) * r1_Dt_ice   ! Mass flux by sublimation
             
             ! new snow thickness
@@ -328,9 +328,9 @@
                zfmdt          = - rhoi * zdeltah(ji,jk)               ! Recompute mass flux [kg/m2, >0]
 
-               hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_1d(ji) * zEi * r1_rdtice                           ! Heat flux to the ocean [W.m-2], <0
+               hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_1d(ji) * zEi * r1_Dt_ice                           ! Heat flux to the ocean [W.m-2], <0
                !                                                                                                  ice enthalpy zEi is "sent" to the ocean
-               sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_rdtice    ! Salt flux
+               sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_Dt_ice    ! Salt flux
                !                                                                                                  using s_i_1d and not sz_i_1d(jk) is ok
-               wfx_res_1d(ji) = wfx_res_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice                 ! Mass flux
+               wfx_res_1d(ji) = wfx_res_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * r1_Dt_ice                 ! Mass flux
 
             ELSE                                        !-- Surface melting
@@ -354,10 +354,10 @@
                zQm            = zfmdt * zEw                           ! Energy of the melt water sent to the ocean [J/m2, <0]
                
-               sfx_sum_1d(ji) = sfx_sum_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_rdtice    ! Salt flux >0
+               sfx_sum_1d(ji) = sfx_sum_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_Dt_ice    ! Salt flux >0
                !                                                                                                  using s_i_1d and not sz_i_1d(jk) is ok)
-               hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice                           ! Heat flux [W.m-2], < 0
-               hfx_sum_1d(ji) = hfx_sum_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice                           ! Heat flux used in this process [W.m-2], > 0  
+               hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_Dt_ice                           ! Heat flux [W.m-2], < 0
+               hfx_sum_1d(ji) = hfx_sum_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_Dt_ice                           ! Heat flux used in this process [W.m-2], > 0  
                ! 
-               wfx_sum_1d(ji) = wfx_sum_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice                 ! Mass flux
+               wfx_sum_1d(ji) = wfx_sum_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * r1_Dt_ice                 ! Mass flux
                
             END IF
@@ -369,11 +369,11 @@
             dh_i_sub(ji)    = dh_i_sub(ji)    + zdum
             
-            sfx_sub_1d(ji)     = sfx_sub_1d(ji) - rhoi * a_i_1d(ji) * zdum * s_i_1d(ji) * r1_rdtice  ! Salt flux >0
+            sfx_sub_1d(ji)     = sfx_sub_1d(ji) - rhoi * a_i_1d(ji) * zdum * s_i_1d(ji) * r1_Dt_ice  ! Salt flux >0
             !                                                                                          clem: flux is sent to the ocean for simplicity
             !                                                                                                but salt should remain in the ice except
             !                                                                                                if all ice is melted. => must be corrected
-            hfx_sub_1d(ji)     = hfx_sub_1d(ji) + zdum * e_i_1d(ji,jk) * a_i_1d(ji) * r1_rdtice      ! Heat flux [W.m-2], < 0
-
-            wfx_ice_sub_1d(ji) = wfx_ice_sub_1d(ji) - rhoi * a_i_1d(ji) * zdum * r1_rdtice           ! Mass flux > 0
+            hfx_sub_1d(ji)     = hfx_sub_1d(ji) + zdum * e_i_1d(ji,jk) * a_i_1d(ji) * r1_Dt_ice      ! Heat flux [W.m-2], < 0
+
+            wfx_ice_sub_1d(ji) = wfx_ice_sub_1d(ji) - rhoi * a_i_1d(ji) * zdum * r1_Dt_ice           ! Mass flux > 0
 
             ! update remaining mass flux
@@ -400,5 +400,5 @@
       ! remaining "potential" evap is sent to ocean
       DO ji = 1, npti
-         wfx_err_sub_1d(ji) = wfx_err_sub_1d(ji) - zevap_rema(ji) * a_i_1d(ji) * r1_rdtice  ! <=0 (net evap for the ocean in kg.m-2.s-1)
+         wfx_err_sub_1d(ji) = wfx_err_sub_1d(ji) - zevap_rema(ji) * a_i_1d(ji) * r1_Dt_ice  ! <=0 (net evap for the ocean in kg.m-2.s-1)
       END DO
 
@@ -428,5 +428,5 @@
                !--- zswi12 if 2.0e-8 < dh/dt < 3.6e-7 
                !--- zswi2  if dh/dt > 3.6e-7
-               zgrr     = MIN( 1.0e-3, MAX ( dh_i_bog(ji) * r1_rdtice , epsi10 ) )
+               zgrr     = MIN( 1.0e-3, MAX ( dh_i_bog(ji) * r1_Dt_ice , epsi10 ) )
                zswi2    = MAX( 0._wp , SIGN( 1._wp , zgrr - 3.6e-7 ) )
                zswi12   = MAX( 0._wp , SIGN( 1._wp , zgrr - 2.0e-8 ) ) * ( 1.0 - zswi2 )
@@ -448,5 +448,5 @@
                zdE           = zEi - zEw                                                              ! Specific enthalpy difference (J/kg, <0)
 
-               dh_i_bog(ji)  = rdt_ice * MAX( 0._wp , zf_tt(ji) / ( zdE * rhoi ) )
+               dh_i_bog(ji)  = rDt_ice * MAX( 0._wp , zf_tt(ji) / ( zdE * rhoi ) )
                
             END DO
@@ -454,10 +454,10 @@
             zfmdt          = - rhoi * dh_i_bog(ji)                                                   ! Mass flux x time step (kg/m2, < 0)
             
-            hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice                           ! Heat flux to the ocean [W.m-2], >0
-            hfx_bog_1d(ji) = hfx_bog_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice                           ! Heat flux used in this process [W.m-2], <0
-            
-            sfx_bog_1d(ji) = sfx_bog_1d(ji) - rhoi * a_i_1d(ji) * dh_i_bog(ji) * s_i_new(ji) * r1_rdtice     ! Salt flux, <0
-
-            wfx_bog_1d(ji) = wfx_bog_1d(ji) - rhoi * a_i_1d(ji) * dh_i_bog(ji) * r1_rdtice                   ! Mass flux, <0
+            hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_Dt_ice                           ! Heat flux to the ocean [W.m-2], >0
+            hfx_bog_1d(ji) = hfx_bog_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_Dt_ice                           ! Heat flux used in this process [W.m-2], <0
+            
+            sfx_bog_1d(ji) = sfx_bog_1d(ji) - rhoi * a_i_1d(ji) * dh_i_bog(ji) * s_i_new(ji) * r1_Dt_ice     ! Salt flux, <0
+
+            wfx_bog_1d(ji) = wfx_bog_1d(ji) - rhoi * a_i_1d(ji) * dh_i_bog(ji) * r1_Dt_ice                   ! Mass flux, <0
 
             ! update heat content (J.m-2) and layer thickness
@@ -490,9 +490,9 @@
                   zfmdt             = - zdeltah(ji,jk) * rhoi      ! Mass flux x time step > 0
 
-                  hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_1d(ji) * zEi * r1_rdtice                           ! Heat flux to the ocean [W.m-2], <0
+                  hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_1d(ji) * zEi * r1_Dt_ice                           ! Heat flux to the ocean [W.m-2], <0
                   !                                                                                                  ice enthalpy zEi is "sent" to the ocean
-                  sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_rdtice    ! Salt flux
+                  sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_Dt_ice    ! Salt flux
                   !                                                                                                  using s_i_1d and not sz_i_1d(jk) is ok
-                  wfx_res_1d(ji) = wfx_res_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice                 ! Mass flux
+                  wfx_res_1d(ji) = wfx_res_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * r1_Dt_ice                 ! Mass flux
 
                   ! update heat content (J.m-2) and layer thickness
@@ -520,11 +520,11 @@
                   zQm             = zfmdt * zEw                                               ! Heat exchanged with ocean
 
-                  hfx_thd_1d(ji)  = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice                           ! Heat flux to the ocean [W.m-2], <0  
-                  hfx_bom_1d(ji)  = hfx_bom_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice                           ! Heat used in this process [W.m-2], >0  
-
-                  sfx_bom_1d(ji)  = sfx_bom_1d(ji) - rhoi *  a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_rdtice   ! Salt flux
+                  hfx_thd_1d(ji)  = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_Dt_ice                           ! Heat flux to the ocean [W.m-2], <0  
+                  hfx_bom_1d(ji)  = hfx_bom_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_Dt_ice                           ! Heat used in this process [W.m-2], >0  
+
+                  sfx_bom_1d(ji)  = sfx_bom_1d(ji) - rhoi *  a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_Dt_ice   ! Salt flux
                   !                                                                                                   using s_i_1d and not sz_i_1d(jk) is ok
                   
-                  wfx_bom_1d(ji)  = wfx_bom_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice                 ! Mass flux
+                  wfx_bom_1d(ji)  = wfx_bom_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * r1_Dt_ice                 ! Mass flux
 
                   ! update heat content (J.m-2) and layer thickness
@@ -556,10 +556,10 @@
         
          zq_rema(ji)        = zq_rema(ji) + zdeltah(ji,1) * e_s_1d(ji,1)                               ! update available heat (J.m-2)
-         hfx_snw_1d(ji)     = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * e_s_1d(ji,1) * r1_rdtice   ! Heat used to melt snow, W.m-2 (>0)
-         wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) - rhos * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice       ! Mass flux
+         hfx_snw_1d(ji)     = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * e_s_1d(ji,1) * r1_Dt_ice   ! Heat used to melt snow, W.m-2 (>0)
+         wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) - rhos * a_i_1d(ji) * zdeltah(ji,1) * r1_Dt_ice       ! Mass flux
          dh_s_mlt(ji)       = dh_s_mlt(ji) + zdeltah(ji,1)
          !    
          ! Remaining heat flux (W.m-2) is sent to the ocean heat budget
-         qt_oce_ai_1d(ji) = qt_oce_ai_1d(ji) + ( zq_rema(ji) * a_i_1d(ji) ) * r1_rdtice
+         qt_oce_ai_1d(ji) = qt_oce_ai_1d(ji) + ( zq_rema(ji) * a_i_1d(ji) ) * r1_Dt_ice
 
          IF( ln_icectl .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji)
@@ -571,8 +571,8 @@
       ! When snow load excesses Archimede's limit, snow-ice interface goes down under sea-level, 
       ! flooding of seawater transforms snow into ice dh_snowice is positive for the ice
-      z1_rho = 1._wp / ( rhos+rau0-rhoi )
+      z1_rho = 1._wp / ( rhos+rho0-rhoi )
       DO ji = 1, npti
          !
-         dh_snowice(ji) = MAX(  0._wp , ( rhos * h_s_1d(ji) + (rhoi-rau0) * h_i_1d(ji) ) * z1_rho )
+         dh_snowice(ji) = MAX(  0._wp , ( rhos * h_s_1d(ji) + (rhoi-rho0) * h_i_1d(ji) ) * z1_rho )
 
          h_i_1d(ji)    = h_i_1d(ji) + dh_snowice(ji)
@@ -584,17 +584,17 @@
          zQm            = zfmdt * zEw 
          
-         hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice ! Heat flux
-
-         sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_1d(ji) * a_i_1d(ji) * zfmdt * r1_rdtice ! Salt flux
+         hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_Dt_ice ! Heat flux
+
+         sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_1d(ji) * a_i_1d(ji) * zfmdt * r1_Dt_ice ! Salt flux
 
          ! Case constant salinity in time: virtual salt flux to keep salinity constant
          IF( nn_icesal /= 2 )  THEN
-            sfx_bri_1d(ji) = sfx_bri_1d(ji) - sss_1d (ji) * a_i_1d(ji) * zfmdt                  * r1_rdtice  & ! put back sss_m     into the ocean
-               &                            - s_i_1d(ji)  * a_i_1d(ji) * dh_snowice(ji) * rhoi * r1_rdtice     ! and get  rn_icesal from the ocean 
+            sfx_bri_1d(ji) = sfx_bri_1d(ji) - sss_1d (ji) * a_i_1d(ji) * zfmdt                  * r1_Dt_ice  & ! put back sss_m     into the ocean
+               &                            - s_i_1d(ji)  * a_i_1d(ji) * dh_snowice(ji) * rhoi * r1_Dt_ice     ! and get  rn_icesal from the ocean 
          ENDIF
 
          ! Mass flux: All snow is thrown in the ocean, and seawater is taken to replace the volume
-         wfx_sni_1d(ji)     = wfx_sni_1d(ji)     - a_i_1d(ji) * dh_snowice(ji) * rhoi * r1_rdtice
-         wfx_snw_sni_1d(ji) = wfx_snw_sni_1d(ji) + a_i_1d(ji) * dh_snowice(ji) * rhos * r1_rdtice
+         wfx_sni_1d(ji)     = wfx_sni_1d(ji)     - a_i_1d(ji) * dh_snowice(ji) * rhoi * r1_Dt_ice
+         wfx_snw_sni_1d(ji) = wfx_snw_sni_1d(ji) + a_i_1d(ji) * dh_snowice(ji) * rhos * r1_Dt_ice
 
          ! update heat content (J.m-2) and layer thickness
@@ -618,7 +618,7 @@
             ! mass & energy loss to the ocean
             hfx_res_1d(ji) = hfx_res_1d(ji) + ( 1._wp - rswitch ) * &
-               &                              ( e_s_1d(ji,jk) * h_s_1d(ji) * r1_nlay_s * a_i_1d(ji) * r1_rdtice )  ! heat flux to the ocean [W.m-2], < 0
+               &                              ( e_s_1d(ji,jk) * h_s_1d(ji) * r1_nlay_s * a_i_1d(ji) * r1_Dt_ice )  ! heat flux to the ocean [W.m-2], < 0
             wfx_res_1d(ji) = wfx_res_1d(ji) + ( 1._wp - rswitch ) * &
-               &                              ( rhos          * h_s_1d(ji) * r1_nlay_s * a_i_1d(ji) * r1_rdtice )  ! mass flux
+               &                              ( rhos          * h_s_1d(ji) * r1_nlay_s * a_i_1d(ji) * r1_Dt_ice )  ! mass flux
             ! update energy (mass is updated in the next loop)
             e_s_1d(ji,jk) = rswitch * e_s_1d(ji,jk)
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icethd_do.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icethd_do.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icethd_do.F90	(revision 12928)
@@ -44,4 +44,6 @@
    REAL(wp) ::   rn_Cfraz      ! squeezing coefficient for collection of bottom frazil ice
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/ICE 4.0 , NEMO Consortium (2018)
@@ -139,55 +141,53 @@
          ! Physical constants
          zhicrit = 0.04                                          ! frazil ice thickness
-         ztwogp  = 2. * rau0 / ( grav * 0.3 * ( rau0 - rhoi ) )  ! reduced grav
+         ztwogp  = 2. * rho0 / ( grav * 0.3 * ( rho0 - rhoi ) )  ! reduced grav
          zsqcd   = 1.0 / SQRT( 1.3 * zcai )                      ! 1/SQRT(airdensity*drag)
          zgamafr = 0.03
          !
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               IF ( qlead(ji,jj) < 0._wp .AND. tau_icebfr(ji,jj) == 0._wp ) THEN ! activated if cooling and no landfast
-                  ! -- Wind stress -- !
-                  ztaux         = ( utau_ice(ji-1,jj  ) * umask(ji-1,jj  ,1)   &
-                     &          +   utau_ice(ji  ,jj  ) * umask(ji  ,jj  ,1) ) * 0.5_wp
-                  ztauy         = ( vtau_ice(ji  ,jj-1) * vmask(ji  ,jj-1,1)   &
-                     &          +   vtau_ice(ji  ,jj  ) * vmask(ji  ,jj  ,1) ) * 0.5_wp
-                  ! Square root of wind stress
-                  ztenagm       =  SQRT( SQRT( ztaux * ztaux + ztauy * ztauy ) )
-
-                  ! -- Frazil ice velocity -- !
-                  rswitch = MAX( 0._wp, SIGN( 1._wp , ztenagm - epsi10 ) )
-                  zvfrx   = rswitch * zgamafr * zsqcd * ztaux / MAX( ztenagm, epsi10 )
-                  zvfry   = rswitch * zgamafr * zsqcd * ztauy / MAX( ztenagm, epsi10 )
-
-                  ! -- Pack ice velocity -- !
-                  zvgx    = ( u_ice(ji-1,jj  ) * umask(ji-1,jj  ,1)  + u_ice(ji,jj) * umask(ji,jj,1) ) * 0.5_wp
-                  zvgy    = ( v_ice(ji  ,jj-1) * vmask(ji  ,jj-1,1)  + v_ice(ji,jj) * vmask(ji,jj,1) ) * 0.5_wp
-
-                  ! -- Relative frazil/pack ice velocity -- !
-                  rswitch      = MAX( 0._wp, SIGN( 1._wp , at_i(ji,jj) - epsi10 ) )
-                  zvrel2       = MAX(  ( zvfrx - zvgx ) * ( zvfrx - zvgx )   &
-                     &               + ( zvfry - zvgy ) * ( zvfry - zvgy ) , 0.15 * 0.15 ) * rswitch
-                  zvrel(ji,jj) = SQRT( zvrel2 )
-
-                  ! -- new ice thickness (iterative loop) -- !
-                  ht_i_new(ji,jj) = zhicrit +   ( zhicrit + 0.1 )    &
-                     &                   / ( ( zhicrit + 0.1 ) * ( zhicrit + 0.1 ) -  zhicrit * zhicrit ) * ztwogp * zvrel2
-
-                  iter = 1
-                  DO WHILE ( iter < 20 ) 
-                     zf  = ( ht_i_new(ji,jj) - zhicrit ) * ( ht_i_new(ji,jj) * ht_i_new(ji,jj) - zhicrit * zhicrit ) -   &
-                        &    ht_i_new(ji,jj) * zhicrit * ztwogp * zvrel2
-                     zfp = ( ht_i_new(ji,jj) - zhicrit ) * ( 3.0 * ht_i_new(ji,jj) + zhicrit ) - zhicrit * ztwogp * zvrel2
-
-                     ht_i_new(ji,jj) = ht_i_new(ji,jj) - zf / MAX( zfp, epsi20 )
-                     iter = iter + 1
-                  END DO
-                  !
-                  ! bound ht_i_new (though I don't see why it should be necessary)
-                  ht_i_new(ji,jj) = MAX( 0.01_wp, MIN( ht_i_new(ji,jj), hi_max(jpl) ) )
-                  !
-               ENDIF
+         DO_2D_00_00
+            IF ( qlead(ji,jj) < 0._wp .AND. tau_icebfr(ji,jj) == 0._wp ) THEN ! activated if cooling and no landfast
+               ! -- Wind stress -- !
+               ztaux         = ( utau_ice(ji-1,jj  ) * umask(ji-1,jj  ,1)   &
+                  &          +   utau_ice(ji  ,jj  ) * umask(ji  ,jj  ,1) ) * 0.5_wp
+               ztauy         = ( vtau_ice(ji  ,jj-1) * vmask(ji  ,jj-1,1)   &
+                  &          +   vtau_ice(ji  ,jj  ) * vmask(ji  ,jj  ,1) ) * 0.5_wp
+               ! Square root of wind stress
+               ztenagm       =  SQRT( SQRT( ztaux * ztaux + ztauy * ztauy ) )
+
+               ! -- Frazil ice velocity -- !
+               rswitch = MAX( 0._wp, SIGN( 1._wp , ztenagm - epsi10 ) )
+               zvfrx   = rswitch * zgamafr * zsqcd * ztaux / MAX( ztenagm, epsi10 )
+               zvfry   = rswitch * zgamafr * zsqcd * ztauy / MAX( ztenagm, epsi10 )
+
+               ! -- Pack ice velocity -- !
+               zvgx    = ( u_ice(ji-1,jj  ) * umask(ji-1,jj  ,1)  + u_ice(ji,jj) * umask(ji,jj,1) ) * 0.5_wp
+               zvgy    = ( v_ice(ji  ,jj-1) * vmask(ji  ,jj-1,1)  + v_ice(ji,jj) * vmask(ji,jj,1) ) * 0.5_wp
+
+               ! -- Relative frazil/pack ice velocity -- !
+               rswitch      = MAX( 0._wp, SIGN( 1._wp , at_i(ji,jj) - epsi10 ) )
+               zvrel2       = MAX(  ( zvfrx - zvgx ) * ( zvfrx - zvgx )   &
+                  &               + ( zvfry - zvgy ) * ( zvfry - zvgy ) , 0.15 * 0.15 ) * rswitch
+               zvrel(ji,jj) = SQRT( zvrel2 )
+
+               ! -- new ice thickness (iterative loop) -- !
+               ht_i_new(ji,jj) = zhicrit +   ( zhicrit + 0.1 )    &
+                  &                   / ( ( zhicrit + 0.1 ) * ( zhicrit + 0.1 ) -  zhicrit * zhicrit ) * ztwogp * zvrel2
+
+               iter = 1
+               DO WHILE ( iter < 20 ) 
+                  zf  = ( ht_i_new(ji,jj) - zhicrit ) * ( ht_i_new(ji,jj) * ht_i_new(ji,jj) - zhicrit * zhicrit ) -   &
+                     &    ht_i_new(ji,jj) * zhicrit * ztwogp * zvrel2
+                  zfp = ( ht_i_new(ji,jj) - zhicrit ) * ( 3.0 * ht_i_new(ji,jj) + zhicrit ) - zhicrit * ztwogp * zvrel2
+
+                  ht_i_new(ji,jj) = ht_i_new(ji,jj) - zf / MAX( zfp, epsi20 )
+                  iter = iter + 1
+               END DO
                !
-            END DO 
-         END DO 
+               ! bound ht_i_new (though I don't see why it should be necessary)
+               ht_i_new(ji,jj) = MAX( 0.01_wp, MIN( ht_i_new(ji,jj), hi_max(jpl) ) )
+               !
+            ENDIF
+            !
+         END_2D
          ! 
          CALL lbc_lnk_multi( 'icethd_do', zvrel, 'T', 1., ht_i_new, 'T', 1.  )
@@ -202,12 +202,10 @@
       ! Identify grid points where new ice forms
       npti = 0   ;   nptidx(:) = 0
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF ( qlead(ji,jj)  <  0._wp .AND. tau_icebfr(ji,jj) == 0._wp ) THEN
-               npti = npti + 1
-               nptidx( npti ) = (jj - 1) * jpi + ji
-            ENDIF
-         END DO
-      END DO
+      DO_2D_11_11
+         IF ( qlead(ji,jj)  <  0._wp .AND. tau_icebfr(ji,jj) == 0._wp ) THEN
+            npti = npti + 1
+            nptidx( npti ) = (jj - 1) * jpi + ji
+         ENDIF
+      END_2D
 
       ! Move from 2-D to 1-D vectors
@@ -291,11 +289,11 @@
 
             ! Contribution to heat flux to the ocean [W.m-2], >0  
-            hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * zEw * r1_rdtice
+            hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * zEw * r1_Dt_ice
             ! Total heat flux used in this process [W.m-2]  
-            hfx_opw_1d(ji) = hfx_opw_1d(ji) - zfmdt * zdE * r1_rdtice
+            hfx_opw_1d(ji) = hfx_opw_1d(ji) - zfmdt * zdE * r1_Dt_ice
             ! mass flux
-            wfx_opw_1d(ji) = wfx_opw_1d(ji) - zv_newice(ji) * rhoi * r1_rdtice
+            wfx_opw_1d(ji) = wfx_opw_1d(ji) - zv_newice(ji) * rhoi * r1_Dt_ice
             ! salt flux
-            sfx_opw_1d(ji) = sfx_opw_1d(ji) - zv_newice(ji) * rhoi * zs_newice(ji) * r1_rdtice
+            sfx_opw_1d(ji) = sfx_opw_1d(ji) - zv_newice(ji) * rhoi * zs_newice(ji) * r1_Dt_ice
          END DO
          
@@ -443,8 +441,6 @@
       !!-------------------------------------------------------------------
       !
-      REWIND( numnam_ice_ref )              ! Namelist namthd_do in reference namelist : Ice thermodynamics
       READ  ( numnam_ice_ref, namthd_do, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_do in reference namelist' )
-      REWIND( numnam_ice_cfg )              ! Namelist namthd_do in configuration namelist : Ice thermodynamics
       READ  ( numnam_ice_cfg, namthd_do, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_do in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icethd_ent.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icethd_ent.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icethd_ent.F90	(revision 12928)
@@ -129,5 +129,5 @@
       ! then we should not (* a_i) again but not important since this is just to check that remap error is ~0
       DO ji = 1, npti
-         hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + a_i_1d(ji) * r1_rdtice *  &
+         hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + a_i_1d(ji) * r1_Dt_ice *  &
             &               ( SUM( qnew(ji,1:nlay_i) ) * zhnew(ji) - SUM( eh_i_old(ji,0:nlay_i+1) ) ) 
       END DO
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icethd_pnd.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icethd_pnd.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icethd_pnd.F90	(revision 12928)
@@ -38,6 +38,4 @@
    INTEGER, PARAMETER ::   np_pndH12 = 2   ! Evolutive pond scheme (Holland et al. 2012)
 
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/ICE 4.0 , NEMO Consortium (2018)
@@ -167,5 +165,5 @@
             ! melt pond mass flux (<0)
             IF( zdv_mlt > 0._wp ) THEN
-               zfac = zfr_mlt * zdv_mlt * rhow * r1_rdtice
+               zfac = zfr_mlt * zdv_mlt * rhow * r1_Dt_ice
                wfx_pnd_1d(ji) = wfx_pnd_1d(ji) - zfac
                !
@@ -208,8 +206,6 @@
       !!-------------------------------------------------------------------
       !
-      REWIND( numnam_ice_ref )              ! Namelist namthd_pnd  in reference namelist : Melt Ponds  
       READ  ( numnam_ice_ref, namthd_pnd, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_pnd  in reference namelist' )
-      REWIND( numnam_ice_cfg )              ! Namelist namthd_pnd  in configuration namelist : Melt Ponds
       READ  ( numnam_ice_cfg, namthd_pnd, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_pnd in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icethd_sal.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icethd_sal.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icethd_sal.F90	(revision 12928)
@@ -68,6 +68,6 @@
       CASE( 2 )       !  time varying salinity with linear profile  !
          !            !---------------------------------------------!
-         z1_time_gd = 1._wp / rn_time_gd * rdt_ice
-         z1_time_fl = 1._wp / rn_time_fl * rdt_ice
+         z1_time_gd = 1._wp / rn_time_gd * rDt_ice
+         z1_time_fl = 1._wp / rn_time_fl * rDt_ice
          !
          DO ji = 1, npti
@@ -98,5 +98,5 @@
                
                ! Salt flux
-               sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoi * a_i_1d(ji) * h_i_1d(ji) * ( zs_i_fl + zs_i_gd ) * r1_rdtice
+               sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoi * a_i_1d(ji) * h_i_1d(ji) * ( zs_i_fl + zs_i_gd ) * r1_Dt_ice
             ENDIF
          END DO
@@ -132,8 +132,6 @@
       !!-------------------------------------------------------------------
       !
-      REWIND( numnam_ice_ref )              ! Namelist namthd_sal in reference namelist : Ice salinity
       READ  ( numnam_ice_ref, namthd_sal, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_sal in reference namelist' )
-      REWIND( numnam_ice_cfg )              ! Namelist namthd_sal in configuration namelist : Ice salinity
       READ  ( numnam_ice_cfg, namthd_sal, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_sal in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icethd_zdf.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icethd_zdf.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icethd_zdf.F90	(revision 12928)
@@ -88,8 +88,6 @@
       !!-------------------------------------------------------------------
       !
-      REWIND( numnam_ice_ref )              ! Namelist namthd_zdf in reference namelist : Ice thermodynamics
       READ  ( numnam_ice_ref, namthd_zdf, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_zdf in reference namelist' )
-      REWIND( numnam_ice_cfg )              ! Namelist namthd_zdf in configuration namelist : Ice thermodynamics
       READ  ( numnam_ice_cfg, namthd_zdf, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_zdf in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icethd_zdf_bl99.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icethd_zdf_bl99.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icethd_zdf_bl99.F90	(revision 12928)
@@ -320,5 +320,5 @@
             DO ji = 1, npti
                zcpi = rcpi + zgamma * sz_i_1d(ji,jk) / MAX( ( t_i_1d(ji,jk) - rt0 ) * ( ztiold(ji,jk) - rt0 ), epsi10 )
-               zeta_i(ji,jk) = rdt_ice * r1_rhoi * z1_h_i(ji) / MAX( epsi10, zcpi ) 
+               zeta_i(ji,jk) = rDt_ice * r1_rhoi * z1_h_i(ji) / MAX( epsi10, zcpi ) 
             END DO
          END DO
@@ -326,5 +326,5 @@
          DO jk = 1, nlay_s
             DO ji = 1, npti
-               zeta_s(ji,jk) = rdt_ice * r1_rhos * r1_rcpi * z1_h_s(ji)
+               zeta_s(ji,jk) = rDt_ice * r1_rhos * r1_rcpi * z1_h_s(ji)
             END DO
          END DO
@@ -769,13 +769,35 @@
       !
       ! --- calculate conduction fluxes (positive downward)
-
+      !     bottom ice conduction flux
       DO ji = 1, npti
-         !                                ! surface ice conduction flux
-         qcn_ice_top_1d(ji) =  -           isnow(ji)   * zkappa_s(ji,0)      * zg1s * ( t_s_1d(ji,1) - t_su_1d(ji) )  &
-            &                  - ( 1._wp - isnow(ji) ) * zkappa_i(ji,0)      * zg1  * ( t_i_1d(ji,1) - t_su_1d(ji) )
-         !                                ! bottom ice conduction flux
-         qcn_ice_bot_1d(ji) =                          - zkappa_i(ji,nlay_i) * zg1  * ( t_bo_1d(ji ) - t_i_1d (ji,nlay_i) )
+         qcn_ice_bot_1d(ji) = - zkappa_i(ji,nlay_i) * zg1  * ( t_bo_1d(ji ) - t_i_1d (ji,nlay_i) )
       END DO
-      
+      !     surface ice conduction flux
+      IF( k_cnd == np_cnd_OFF .OR. k_cnd == np_cnd_EMU ) THEN
+         !
+         DO ji = 1, npti
+            qcn_ice_top_1d(ji) =  -           isnow(ji)   * zkappa_s(ji,0) * zg1s * ( t_s_1d(ji,1) - t_su_1d(ji) )  &
+               &                  - ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1  * ( t_i_1d(ji,1) - t_su_1d(ji) )
+         END DO
+         !
+      ELSEIF( k_cnd == np_cnd_ON ) THEN
+         !
+         DO ji = 1, npti
+            qcn_ice_top_1d(ji) = qcn_ice_1d(ji)
+         END DO
+         !
+      ENDIF
+      !     surface ice temperature
+      IF( k_cnd == np_cnd_ON .AND. ln_cndemulate ) THEN
+         !
+         DO ji = 1, npti
+            t_su_1d(ji) = (  qcn_ice_top_1d(ji) &            ! calculate surface temperature
+               &           +           isnow(ji)   * zkappa_s(ji,0) * zg1s * t_s_1d(ji,1) &
+               &           + ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1  * t_i_1d(ji,1) &
+               &          ) / MAX( epsi10, isnow(ji) * zkappa_s(ji,0) * zg1s + ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1 )
+            t_su_1d(ji) = MAX( MIN( t_su_1d(ji), rt0 ), rt0 - 100._wp )  ! cap t_su
+         END DO
+         !
+      ENDIF
       !
       ! --- Diagnose the heat loss due to changing non-solar / conduction flux --- !
@@ -787,12 +809,5 @@
          END DO
          !
-      ELSEIF( k_cnd == np_cnd_ON ) THEN
-         !
-         DO ji = 1, npti
-            hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) - ( qcn_ice_top_1d(ji) - qcn_ice_1d(ji) ) * a_i_1d(ji) 
-         END DO
-         !
       ENDIF
-      
       !
       ! --- Diagnose the heat loss due to non-fully converged temperature solution (should not be above 10-4 W-m2) --- !
@@ -811,8 +826,8 @@
                IF( t_su_1d(ji) < rt0 ) THEN  ! case T_su < 0degC
                   zhfx_err = ( qns_ice_1d(ji)     + qsr_ice_1d(ji)     - zradtr_i(ji,nlay_i) - qcn_ice_bot_1d(ji)  &
-                     &       + zdq * r1_rdtice ) * a_i_1d(ji)
+                     &       + zdq * r1_Dt_ice ) * a_i_1d(ji)
                ELSE                          ! case T_su = 0degC
                   zhfx_err = ( qcn_ice_top_1d(ji) + qtr_ice_top_1d(ji) - zradtr_i(ji,nlay_i) - qcn_ice_bot_1d(ji)  &
-                     &       + zdq * r1_rdtice ) * a_i_1d(ji)
+                     &       + zdq * r1_Dt_ice ) * a_i_1d(ji)
                ENDIF
                
@@ -820,5 +835,5 @@
             
                zhfx_err    = ( qcn_ice_top_1d(ji) + qtr_ice_top_1d(ji) - zradtr_i(ji,nlay_i) - qcn_ice_bot_1d(ji)  &
-                  &          + zdq * r1_rdtice ) * a_i_1d(ji)
+                  &          + zdq * r1_Dt_ice ) * a_i_1d(ji)
             
             ENDIF
@@ -828,5 +843,5 @@
             !
             ! hfx_dif = Heat flux diagnostic of sensible heat used to warm/cool ice in W.m-2   
-            hfx_dif_1d(ji) = hfx_dif_1d(ji) - zdq * r1_rdtice * a_i_1d(ji)
+            hfx_dif_1d(ji) = hfx_dif_1d(ji) - zdq * r1_Dt_ice * a_i_1d(ji)
             !
          END DO
@@ -856,8 +871,4 @@
          t_i_1d    (1:npti,:) = ztiold        (1:npti,:)
          qcn_ice_1d(1:npti)   = qcn_ice_top_1d(1:npti)
-
-         !!clem
-         ! remettre t_su_1d, qns_ice_1d et dqns_ice_1d comme avant puisqu'on devrait faire comme si on avant conduction = input
-         !clem
       ENDIF
       !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/iceupdate.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/iceupdate.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/iceupdate.F90	(revision 12928)
@@ -15,5 +15,4 @@
    !!   ice_update_tau   : update i- and j-stresses, and its modulus at the ocean surface
    !!----------------------------------------------------------------------
-   USE oce     , ONLY : sshn, sshb
    USE phycst         ! physical constants
    USE dom_oce        ! ocean domain
@@ -45,5 +44,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/ICE 4.0 , NEMO Consortium (2018)
@@ -114,67 +113,65 @@
       ENDIF
       
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-
-            ! Solar heat flux reaching the ocean = zqsr (W.m-2) 
-            !---------------------------------------------------
-            zqsr = qsr_tot(ji,jj) - SUM( a_i_b(ji,jj,:) * ( qsr_ice(ji,jj,:) - qtr_ice_bot(ji,jj,:) ) )
-
-            ! Total heat flux reaching the ocean = qt_oce_ai (W.m-2) 
-            !---------------------------------------------------
-            zqmass           = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC)
-            qt_oce_ai(ji,jj) = qt_oce_ai(ji,jj) + zqmass + zqsr
-
-            ! Add the residual from heat diffusion equation and sublimation (W.m-2)
-            !----------------------------------------------------------------------
-            qt_oce_ai(ji,jj) = qt_oce_ai(ji,jj) + hfx_err_dif(ji,jj) +   &
-               &             ( hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) )
-
-            ! New qsr and qns used to compute the oceanic heat flux at the next time step
-            !----------------------------------------------------------------------------
-            qsr(ji,jj) = zqsr                                      
-            qns(ji,jj) = qt_oce_ai(ji,jj) - zqsr              
-
-            ! Mass flux at the atm. surface       
-            !-----------------------------------
-            wfx_sub(ji,jj) = wfx_snw_sub(ji,jj) + wfx_ice_sub(ji,jj)
-
-            ! Mass flux at the ocean surface      
-            !------------------------------------
-            !  case of realistic freshwater flux (Tartinville et al., 2001) (presently ACTIVATED)
-            !  ------------------------------------------------------------------------------------- 
-            !  The idea of this approach is that the system that we consider is the ICE-OCEAN system
-            !  Thus  FW  flux  =  External ( E-P+snow melt)
-            !       Salt flux  =  Exchanges in the ice-ocean system then converted into FW
-            !                     Associated to Ice formation AND Ice melting
-            !                     Even if i see Ice melting as a FW and SALT flux
-            !        
-            ! mass flux from ice/ocean
-            wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj)   &
-               &           + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj) + wfx_pnd(ji,jj)
-
-            ! add the snow melt water to snow mass flux to the ocean
-            wfx_snw(ji,jj) = wfx_snw_sni(ji,jj) + wfx_snw_dyn(ji,jj) + wfx_snw_sum(ji,jj)
-
-            ! mass flux at the ocean/ice interface
-            fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) + wfx_err_sub(ji,jj) )              ! F/M mass flux save at least for biogeochemical model
-            emp(ji,jj)    = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj)   ! mass flux + F/M mass flux (always ice/ocean mass exchange)
-
-
-            ! Salt flux at the ocean surface      
-            !------------------------------------------
-            sfx(ji,jj) = sfx_bog(ji,jj) + sfx_bom(ji,jj) + sfx_sum(ji,jj) + sfx_sni(ji,jj) + sfx_opw(ji,jj)   &
-               &       + sfx_res(ji,jj) + sfx_dyn(ji,jj) + sfx_bri(ji,jj) + sfx_sub(ji,jj) + sfx_lam(ji,jj)
-            
-            ! Mass of snow and ice per unit area   
-            !----------------------------------------
-            snwice_mass_b(ji,jj) = snwice_mass(ji,jj)       ! save mass from the previous ice time step
-            !                                               ! new mass per unit area
-            snwice_mass  (ji,jj) = tmask(ji,jj,1) * ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj)  ) 
-            !                                               ! time evolution of snow+ice mass
-            snwice_fmass (ji,jj) = ( snwice_mass(ji,jj) - snwice_mass_b(ji,jj) ) * r1_rdtice
-            
-         END DO
-      END DO
+      DO_2D_11_11
+
+         ! Solar heat flux reaching the ocean = zqsr (W.m-2) 
+         !---------------------------------------------------
+         zqsr = qsr_tot(ji,jj) - SUM( a_i_b(ji,jj,:) * ( qsr_ice(ji,jj,:) - qtr_ice_bot(ji,jj,:) ) )
+
+         ! Total heat flux reaching the ocean = qt_oce_ai (W.m-2) 
+         !---------------------------------------------------
+         zqmass           = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC)
+         qt_oce_ai(ji,jj) = qt_oce_ai(ji,jj) + zqmass + zqsr
+
+         ! Add the residual from heat diffusion equation and sublimation (W.m-2)
+         !----------------------------------------------------------------------
+         qt_oce_ai(ji,jj) = qt_oce_ai(ji,jj) + hfx_err_dif(ji,jj) +   &
+            &             ( hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) )
+
+         ! New qsr and qns used to compute the oceanic heat flux at the next time step
+         !----------------------------------------------------------------------------
+         qsr(ji,jj) = zqsr                                      
+         qns(ji,jj) = qt_oce_ai(ji,jj) - zqsr              
+
+         ! Mass flux at the atm. surface       
+         !-----------------------------------
+         wfx_sub(ji,jj) = wfx_snw_sub(ji,jj) + wfx_ice_sub(ji,jj)
+
+         ! Mass flux at the ocean surface      
+         !------------------------------------
+         !  case of realistic freshwater flux (Tartinville et al., 2001) (presently ACTIVATED)
+         !  ------------------------------------------------------------------------------------- 
+         !  The idea of this approach is that the system that we consider is the ICE-OCEAN system
+         !  Thus  FW  flux  =  External ( E-P+snow melt)
+         !       Salt flux  =  Exchanges in the ice-ocean system then converted into FW
+         !                     Associated to Ice formation AND Ice melting
+         !                     Even if i see Ice melting as a FW and SALT flux
+         !        
+         ! mass flux from ice/ocean
+         wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj)   &
+            &           + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj) + wfx_pnd(ji,jj)
+
+         ! add the snow melt water to snow mass flux to the ocean
+         wfx_snw(ji,jj) = wfx_snw_sni(ji,jj) + wfx_snw_dyn(ji,jj) + wfx_snw_sum(ji,jj)
+
+         ! mass flux at the ocean/ice interface
+         fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) + wfx_err_sub(ji,jj) )              ! F/M mass flux save at least for biogeochemical model
+         emp(ji,jj)    = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj)   ! mass flux + F/M mass flux (always ice/ocean mass exchange)
+
+
+         ! Salt flux at the ocean surface      
+         !------------------------------------------
+         sfx(ji,jj) = sfx_bog(ji,jj) + sfx_bom(ji,jj) + sfx_sum(ji,jj) + sfx_sni(ji,jj) + sfx_opw(ji,jj)   &
+            &       + sfx_res(ji,jj) + sfx_dyn(ji,jj) + sfx_bri(ji,jj) + sfx_sub(ji,jj) + sfx_lam(ji,jj)
+         
+         ! Mass of snow and ice per unit area   
+         !----------------------------------------
+         snwice_mass_b(ji,jj) = snwice_mass(ji,jj)       ! save mass from the previous ice time step
+         !                                               ! new mass per unit area
+         snwice_mass  (ji,jj) = tmask(ji,jj,1) * ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj)  ) 
+         !                                               ! time evolution of snow+ice mass
+         snwice_fmass (ji,jj) = ( snwice_mass(ji,jj) - snwice_mass_b(ji,jj) ) * r1_Dt_ice
+         
+      END_2D
 
       ! Storing the transmitted variables
@@ -286,5 +283,5 @@
 #endif
       IF( ln_icectl                      )   CALL ice_prt       (kt, iiceprt, jiceprt, 3, 'Final state ice_update') ! prints
-      IF( ln_ctl                         )   CALL ice_prt3D     ('iceupdate')                                       ! prints
+      IF( sn_cfctl%l_prtctl              )   CALL ice_prt3D     ('iceupdate')                                       ! prints
       IF( ln_timing                      )   CALL timing_stop   ('ice_update')                                      ! timing
       !
@@ -332,19 +329,17 @@
       ENDIF
 
-      zrhoco = rau0 * rn_cio
+      zrhoco = rho0 * rn_cio
       !
       IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==!   (i.e. surface module time-step)
-         DO jj = 2, jpjm1                             !* update the modulus of stress at ocean surface (T-point)
-            DO ji = fs_2, fs_jpim1
-               !                                               ! 2*(U_ice-U_oce) at T-point
-               zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj)   
-               zv_t = v_ice(ji,jj) + v_ice(ji,jj-1) - v_oce(ji,jj) - v_oce(ji,jj-1) 
-               !                                              ! |U_ice-U_oce|^2
-               zmodt =  0.25_wp * (  zu_t * zu_t + zv_t * zv_t  )
-               !                                               ! update the ocean stress modulus
-               taum(ji,jj) = ( 1._wp - at_i(ji,jj) ) * taum(ji,jj) + at_i(ji,jj) * zrhoco * zmodt
-               tmod_io(ji,jj) = zrhoco * SQRT( zmodt )          ! rhoco * |U_ice-U_oce| at T-point
-            END DO
-         END DO
+         DO_2D_00_00
+            !                                               ! 2*(U_ice-U_oce) at T-point
+            zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj)   
+            zv_t = v_ice(ji,jj) + v_ice(ji,jj-1) - v_oce(ji,jj) - v_oce(ji,jj-1) 
+            !                                              ! |U_ice-U_oce|^2
+            zmodt =  0.25_wp * (  zu_t * zu_t + zv_t * zv_t  )
+            !                                               ! update the ocean stress modulus
+            taum(ji,jj) = ( 1._wp - at_i(ji,jj) ) * taum(ji,jj) + at_i(ji,jj) * zrhoco * zmodt
+            tmod_io(ji,jj) = zrhoco * SQRT( zmodt )          ! rhoco * |U_ice-U_oce| at T-point
+         END_2D
          CALL lbc_lnk_multi( 'iceupdate', taum, 'T', 1., tmod_io, 'T', 1. )
          !
@@ -356,19 +351,17 @@
       !                                      !==  every ocean time-step  ==!
       !
-      DO jj = 2, jpjm1                                !* update the stress WITHOUT an ice-ocean rotation angle
-         DO ji = fs_2, fs_jpim1   ! Vect. Opt.   
-            ! ice area at u and v-points 
-            zat_u  = ( at_i(ji,jj) * tmask(ji,jj,1) + at_i (ji+1,jj    ) * tmask(ji+1,jj  ,1) )  &
-               &     / MAX( 1.0_wp , tmask(ji,jj,1) + tmask(ji+1,jj  ,1) )
-            zat_v  = ( at_i(ji,jj) * tmask(ji,jj,1) + at_i (ji  ,jj+1  ) * tmask(ji  ,jj+1,1) )  &
-               &     / MAX( 1.0_wp , tmask(ji,jj,1) + tmask(ji  ,jj+1,1) )
-            !                                                   ! linearized quadratic drag formulation
-            zutau_ice   = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji+1,jj) ) * ( u_ice(ji,jj) - pu_oce(ji,jj) )
-            zvtau_ice   = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji,jj+1) ) * ( v_ice(ji,jj) - pv_oce(ji,jj) )
-            !                                                   ! stresses at the ocean surface
-            utau(ji,jj) = ( 1._wp - zat_u ) * utau_oce(ji,jj) + zat_u * zutau_ice
-            vtau(ji,jj) = ( 1._wp - zat_v ) * vtau_oce(ji,jj) + zat_v * zvtau_ice
-         END DO
-      END DO
+      DO_2D_00_00
+         ! ice area at u and v-points 
+         zat_u  = ( at_i(ji,jj) * tmask(ji,jj,1) + at_i (ji+1,jj    ) * tmask(ji+1,jj  ,1) )  &
+            &     / MAX( 1.0_wp , tmask(ji,jj,1) + tmask(ji+1,jj  ,1) )
+         zat_v  = ( at_i(ji,jj) * tmask(ji,jj,1) + at_i (ji  ,jj+1  ) * tmask(ji  ,jj+1,1) )  &
+            &     / MAX( 1.0_wp , tmask(ji,jj,1) + tmask(ji  ,jj+1,1) )
+         !                                                   ! linearized quadratic drag formulation
+         zutau_ice   = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji+1,jj) ) * ( u_ice(ji,jj) - pu_oce(ji,jj) )
+         zvtau_ice   = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji,jj+1) ) * ( v_ice(ji,jj) - pv_oce(ji,jj) )
+         !                                                   ! stresses at the ocean surface
+         utau(ji,jj) = ( 1._wp - zat_u ) * utau_oce(ji,jj) + zat_u * zutau_ice
+         vtau(ji,jj) = ( 1._wp - zat_v ) * vtau_oce(ji,jj) + zat_v * zvtau_ice
+      END_2D
       CALL lbc_lnk_multi( 'iceupdate', utau, 'U', -1., vtau, 'V', -1. )   ! lateral boundary condition
       !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icevar.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icevar.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icevar.F90	(revision 12928)
@@ -82,4 +82,6 @@
    END INTERFACE
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/ICE 4.0 , NEMO Consortium (2018)
@@ -115,13 +117,18 @@
       !
       ato_i(:,:) = 1._wp - at_i(:,:)         ! open water fraction  
-
+      !
+      !!GS: tm_su always needed by ABL over sea-ice
+      ALLOCATE( z1_at_i(jpi,jpj) )
+      WHERE( at_i(:,:) > epsi20 )   ;   z1_at_i(:,:) = 1._wp / at_i(:,:)
+      ELSEWHERE                     ;   z1_at_i(:,:) = 0._wp
+      END WHERE
+      tm_su(:,:) = SUM( t_su(:,:,:) * a_i(:,:,:) , dim=3 ) * z1_at_i(:,:)
+      WHERE( at_i(:,:)<=epsi20 ) tm_su(:,:) = rt0
+      !
       ! The following fields are calculated for diagnostics and outputs only
       ! ==> Do not use them for other purposes
       IF( kn > 1 ) THEN
          !
-         ALLOCATE( z1_at_i(jpi,jpj) , z1_vt_i(jpi,jpj) , z1_vt_s(jpi,jpj) )
-         WHERE( at_i(:,:) > epsi20 )   ;   z1_at_i(:,:) = 1._wp / at_i(:,:)
-         ELSEWHERE                     ;   z1_at_i(:,:) = 0._wp
-         END WHERE
+         ALLOCATE( z1_vt_i(jpi,jpj) , z1_vt_s(jpi,jpj) )
          WHERE( vt_i(:,:) > epsi20 )   ;   z1_vt_i(:,:) = 1._wp / vt_i(:,:)
          ELSEWHERE                     ;   z1_vt_i(:,:) = 0._wp
@@ -136,5 +143,4 @@
          !         
          !                          ! mean temperature (K), salinity and age
-         tm_su(:,:) = SUM( t_su(:,:,:) * a_i(:,:,:) , dim=3 ) * z1_at_i(:,:)
          tm_si(:,:) = SUM( t_si(:,:,:) * a_i(:,:,:) , dim=3 ) * z1_at_i(:,:)
          om_i (:,:) = SUM( oa_i(:,:,:)              , dim=3 ) * z1_at_i(:,:)
@@ -154,5 +160,4 @@
          !                           ! put rt0 where there is no ice
          WHERE( at_i(:,:)<=epsi20 )
-            tm_su(:,:) = rt0
             tm_si(:,:) = rt0
             tm_i (:,:) = rt0
@@ -165,7 +170,9 @@
          END WHERE         
          !
-         DEALLOCATE( z1_at_i , z1_vt_i , z1_vt_s )
+         DEALLOCATE( z1_vt_i , z1_vt_s )
          !
       ENDIF
+      !
+      DEALLOCATE( z1_at_i )
       !
    END SUBROUTINE ice_var_agg
@@ -236,22 +243,18 @@
       zlay_i   = REAL( nlay_i , wp )    ! number of layers
       DO jl = 1, jpl
-         DO jk = 1, nlay_i
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  IF ( v_i(ji,jj,jl) > epsi20 ) THEN     !--- icy area 
-                     !
-                     ze_i             =   e_i (ji,jj,jk,jl) * z1_v_i(ji,jj,jl) * zlay_i             ! Energy of melting e(S,T) [J.m-3]
-                     ztmelts          = - sz_i(ji,jj,jk,jl) * rTmlt                                 ! Ice layer melt temperature [C]
-                     ! Conversion q(S,T) -> T (second order equation)
-                     zbbb             = ( rcp - rcpi ) * ztmelts + ze_i * r1_rhoi - rLfus
-                     zccc             = SQRT( MAX( zbbb * zbbb - 4._wp * rcpi * rLfus * ztmelts , 0._wp) )
-                     t_i(ji,jj,jk,jl) = MAX( -100._wp , MIN( -( zbbb + zccc ) * 0.5_wp * r1_rcpi , ztmelts ) ) + rt0   ! [K] with bounds: -100 < t_i < ztmelts
-                     !
-                  ELSE                                   !--- no ice
-                     t_i(ji,jj,jk,jl) = rt0
-                  ENDIF
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, nlay_i )
+            IF ( v_i(ji,jj,jl) > epsi20 ) THEN     !--- icy area 
+               !
+               ze_i             =   e_i (ji,jj,jk,jl) * z1_v_i(ji,jj,jl) * zlay_i             ! Energy of melting e(S,T) [J.m-3]
+               ztmelts          = - sz_i(ji,jj,jk,jl) * rTmlt                                 ! Ice layer melt temperature [C]
+               ! Conversion q(S,T) -> T (second order equation)
+               zbbb             = ( rcp - rcpi ) * ztmelts + ze_i * r1_rhoi - rLfus
+               zccc             = SQRT( MAX( zbbb * zbbb - 4._wp * rcpi * rLfus * ztmelts , 0._wp) )
+               t_i(ji,jj,jk,jl) = MAX( -100._wp , MIN( -( zbbb + zccc ) * 0.5_wp * r1_rcpi , ztmelts ) ) + rt0   ! [K] with bounds: -100 < t_i < ztmelts
+               !
+            ELSE                                   !--- no ice
+               t_i(ji,jj,jk,jl) = rt0
+            ENDIF
+         END_3D
       END DO
 
@@ -344,25 +347,19 @@
          z1_dS = 1._wp / ( zsi1 - zsi0 )
          DO jl = 1, jpl
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zalpha(ji,jj,jl) = MAX(  0._wp , MIN( ( zsi1 - s_i(ji,jj,jl) ) * z1_dS , 1._wp )  )
-                  !                             ! force a constant profile when SSS too low (Baltic Sea)
-                  IF( 2._wp * s_i(ji,jj,jl) >= sss_m(ji,jj) )   zalpha(ji,jj,jl) = 0._wp  
-               END DO
-            END DO
+            DO_2D_11_11
+               zalpha(ji,jj,jl) = MAX(  0._wp , MIN( ( zsi1 - s_i(ji,jj,jl) ) * z1_dS , 1._wp )  )
+               !                             ! force a constant profile when SSS too low (Baltic Sea)
+               IF( 2._wp * s_i(ji,jj,jl) >= sss_m(ji,jj) )   zalpha(ji,jj,jl) = 0._wp  
+            END_2D
          END DO
          !
          ! Computation of the profile
          DO jl = 1, jpl
-            DO jk = 1, nlay_i
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     !                          ! linear profile with 0 surface value
-                     zs0 = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * h_i(ji,jj,jl) * r1_nlay_i
-                     zs  = zalpha(ji,jj,jl) * zs0 + ( 1._wp - zalpha(ji,jj,jl) ) * s_i(ji,jj,jl)     ! weighting the profile
-                     sz_i(ji,jj,jk,jl) = MIN( rn_simax, MAX( zs, rn_simin ) )
-                  END DO
-               END DO
-            END DO
+            DO_3D_11_11( 1, nlay_i )
+               !                          ! linear profile with 0 surface value
+               zs0 = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * h_i(ji,jj,jl) * r1_nlay_i
+               zs  = zalpha(ji,jj,jl) * zs0 + ( 1._wp - zalpha(ji,jj,jl) ) * s_i(ji,jj,jl)     ! weighting the profile
+               sz_i(ji,jj,jk,jl) = MIN( rn_simax, MAX( zs, rn_simin ) )
+            END_3D
          END DO
          !
@@ -489,51 +486,41 @@
          ! Zap ice energy and use ocean heat to melt ice
          !-----------------------------------------------------------------
-         DO jk = 1, nlay_i
-            DO jj = 1 , jpj
-               DO ji = 1 , jpi
-                  ! update exchanges with ocean
-                  hfx_res(ji,jj)   = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_i(ji,jj,jk,jl) * r1_rdtice ! W.m-2 <0
-                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * zswitch(ji,jj)
-                  t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * zswitch(ji,jj) + rt0 * ( 1._wp - zswitch(ji,jj) )
-               END DO
-            END DO
-         END DO
-         !
-         DO jk = 1, nlay_s
-            DO jj = 1 , jpj
-               DO ji = 1 , jpi
-                  ! update exchanges with ocean
-                  hfx_res(ji,jj)   = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_s(ji,jj,jk,jl) * r1_rdtice ! W.m-2 <0
-                  e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * zswitch(ji,jj)
-                  t_s(ji,jj,jk,jl) = t_s(ji,jj,jk,jl) * zswitch(ji,jj) + rt0 * ( 1._wp - zswitch(ji,jj) )
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, nlay_i )
+            ! update exchanges with ocean
+            hfx_res(ji,jj)   = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_i(ji,jj,jk,jl) * r1_Dt_ice ! W.m-2 <0
+            e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * zswitch(ji,jj)
+            t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * zswitch(ji,jj) + rt0 * ( 1._wp - zswitch(ji,jj) )
+         END_3D
+         !
+         DO_3D_11_11( 1, nlay_s )
+            ! update exchanges with ocean
+            hfx_res(ji,jj)   = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_s(ji,jj,jk,jl) * r1_Dt_ice ! W.m-2 <0
+            e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * zswitch(ji,jj)
+            t_s(ji,jj,jk,jl) = t_s(ji,jj,jk,jl) * zswitch(ji,jj) + rt0 * ( 1._wp - zswitch(ji,jj) )
+         END_3D
          !
          !-----------------------------------------------------------------
          ! zap ice and snow volume, add water and salt to ocean
          !-----------------------------------------------------------------
-         DO jj = 1 , jpj
-            DO ji = 1 , jpi
-               ! update exchanges with ocean
-               sfx_res(ji,jj)  = sfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * sv_i(ji,jj,jl)   * rhoi * r1_rdtice
-               wfx_res(ji,jj)  = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_i (ji,jj,jl)   * rhoi * r1_rdtice
-               wfx_res(ji,jj)  = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_s (ji,jj,jl)   * rhos * r1_rdtice
-               !
-               a_i  (ji,jj,jl) = a_i (ji,jj,jl) * zswitch(ji,jj)
-               v_i  (ji,jj,jl) = v_i (ji,jj,jl) * zswitch(ji,jj)
-               v_s  (ji,jj,jl) = v_s (ji,jj,jl) * zswitch(ji,jj)
-               t_su (ji,jj,jl) = t_su(ji,jj,jl) * zswitch(ji,jj) + t_bo(ji,jj) * ( 1._wp - zswitch(ji,jj) )
-               oa_i (ji,jj,jl) = oa_i(ji,jj,jl) * zswitch(ji,jj)
-               sv_i (ji,jj,jl) = sv_i(ji,jj,jl) * zswitch(ji,jj)
-               !
-               h_i (ji,jj,jl) = h_i (ji,jj,jl) * zswitch(ji,jj)
-               h_s (ji,jj,jl) = h_s (ji,jj,jl) * zswitch(ji,jj)
-               !
-               a_ip (ji,jj,jl) = a_ip (ji,jj,jl) * zswitch(ji,jj)
-               v_ip (ji,jj,jl) = v_ip (ji,jj,jl) * zswitch(ji,jj)
-               !
-            END DO
-         END DO
+         DO_2D_11_11
+            ! update exchanges with ocean
+            sfx_res(ji,jj)  = sfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * sv_i(ji,jj,jl)   * rhoi * r1_Dt_ice
+            wfx_res(ji,jj)  = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_i (ji,jj,jl)   * rhoi * r1_Dt_ice
+            wfx_res(ji,jj)  = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_s (ji,jj,jl)   * rhos * r1_Dt_ice
+            !
+            a_i  (ji,jj,jl) = a_i (ji,jj,jl) * zswitch(ji,jj)
+            v_i  (ji,jj,jl) = v_i (ji,jj,jl) * zswitch(ji,jj)
+            v_s  (ji,jj,jl) = v_s (ji,jj,jl) * zswitch(ji,jj)
+            t_su (ji,jj,jl) = t_su(ji,jj,jl) * zswitch(ji,jj) + t_bo(ji,jj) * ( 1._wp - zswitch(ji,jj) )
+            oa_i (ji,jj,jl) = oa_i(ji,jj,jl) * zswitch(ji,jj)
+            sv_i (ji,jj,jl) = sv_i(ji,jj,jl) * zswitch(ji,jj)
+            !
+            h_i (ji,jj,jl) = h_i (ji,jj,jl) * zswitch(ji,jj)
+            h_s (ji,jj,jl) = h_s (ji,jj,jl) * zswitch(ji,jj)
+            !
+            a_ip (ji,jj,jl) = a_ip (ji,jj,jl) * zswitch(ji,jj)
+            v_ip (ji,jj,jl) = v_ip (ji,jj,jl) * zswitch(ji,jj)
+            !
+         END_2D
          !
       END DO 
@@ -587,45 +574,35 @@
          ! zap ice energy and send it to the ocean
          !----------------------------------------
-         DO jk = 1, nlay_i
-            DO jj = 1 , jpj
-               DO ji = 1 , jpi
-                  IF( pe_i(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN
-                     hfx_res(ji,jj)   = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * z1_dt ! W.m-2 >0
-                     pe_i(ji,jj,jk,jl) = 0._wp
-                  ENDIF
-               END DO
-            END DO
-         END DO
-         !
-         DO jk = 1, nlay_s
-            DO jj = 1 , jpj
-               DO ji = 1 , jpi
-                  IF( pe_s(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN
-                     hfx_res(ji,jj)   = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * z1_dt ! W.m-2 <0
-                     pe_s(ji,jj,jk,jl) = 0._wp
-                  ENDIF
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, nlay_i )
+            IF( pe_i(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN
+               hfx_res(ji,jj)   = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * z1_dt ! W.m-2 >0
+               pe_i(ji,jj,jk,jl) = 0._wp
+            ENDIF
+         END_3D
+         !
+         DO_3D_11_11( 1, nlay_s )
+            IF( pe_s(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN
+               hfx_res(ji,jj)   = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * z1_dt ! W.m-2 <0
+               pe_s(ji,jj,jk,jl) = 0._wp
+            ENDIF
+         END_3D
          !
          !-----------------------------------------------------
          ! zap ice and snow volume, add water and salt to ocean
          !-----------------------------------------------------
-         DO jj = 1 , jpj
-            DO ji = 1 , jpi
-               IF( pv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN
-                  wfx_res(ji,jj)    = wfx_res(ji,jj) + pv_i (ji,jj,jl) * rhoi * z1_dt
-                  pv_i   (ji,jj,jl) = 0._wp
-               ENDIF
-               IF( pv_s(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN
-                  wfx_res(ji,jj)    = wfx_res(ji,jj) + pv_s (ji,jj,jl) * rhos * z1_dt
-                  pv_s   (ji,jj,jl) = 0._wp
-               ENDIF
-               IF( psv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN
-                  sfx_res(ji,jj)    = sfx_res(ji,jj) + psv_i(ji,jj,jl) * rhoi * z1_dt
-                  psv_i  (ji,jj,jl) = 0._wp
-               ENDIF
-            END DO
-         END DO
+         DO_2D_11_11
+            IF( pv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN
+               wfx_res(ji,jj)    = wfx_res(ji,jj) + pv_i (ji,jj,jl) * rhoi * z1_dt
+               pv_i   (ji,jj,jl) = 0._wp
+            ENDIF
+            IF( pv_s(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN
+               wfx_res(ji,jj)    = wfx_res(ji,jj) + pv_s (ji,jj,jl) * rhos * z1_dt
+               pv_s   (ji,jj,jl) = 0._wp
+            ENDIF
+            IF( psv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp .OR. pv_i(ji,jj,jl) <= 0._wp ) THEN
+               sfx_res(ji,jj)    = sfx_res(ji,jj) + psv_i(ji,jj,jl) * rhoi * z1_dt
+               psv_i  (ji,jj,jl) = 0._wp
+            ENDIF
+         END_2D
          !
       END DO 
@@ -740,5 +717,5 @@
       !! ** Purpose :  compute the equivalent ssh in lead when sea ice is embedded
       !!
-      !! ** Method  :  ssh_lead = ssh + (Mice + Msnow) / rau0
+      !! ** Method  :  ssh_lead = ssh + (Mice + Msnow) / rho0
       !!
       !! ** Reference : Jean-Michel Campin, John Marshall, David Ferreira,
@@ -770,5 +747,5 @@
          zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp
          !
-         zsnwiceload(:,:) = ( zintn * psnwice_mass(:,:) + zintb * psnwice_mass_b(:,:) ) * r1_rau0
+         zsnwiceload(:,:) = ( zintn * psnwice_mass(:,:) + zintb * psnwice_mass_b(:,:) ) * r1_rho0
          !
       ELSE
@@ -960,5 +937,5 @@
                ! In case snow load is in excess that would lead to transformation from snow to ice
                ! Then, transfer the snow excess into the ice (different from icethd_dh)
-               zdh = MAX( 0._wp, ( rhos * ph_s(ji,jl) + ( rhoi - rau0 ) * ph_i(ji,jl) ) * r1_rau0 ) 
+               zdh = MAX( 0._wp, ( rhos * ph_s(ji,jl) + ( rhoi - rho0 ) * ph_i(ji,jl) ) * r1_rho0 ) 
                ! recompute h_i, h_s avoiding out of bounds values
                ph_i(ji,jl) = MIN( hi_max(jl), ph_i(ji,jl) + zdh )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icewri.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icewri.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icewri.F90	(revision 12928)
@@ -35,4 +35,6 @@
    PUBLIC ice_wri_state  ! called by dia_wri_state 
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/ICE 4.0 , NEMO Consortium (2018)
@@ -69,19 +71,15 @@
 
       ! tresholds for outputs
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice
-            zmsk05(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.05_wp ) ) ! 1 if 5% ice , 0 if less
-            zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less
-            zmsksn(ji,jj) = MAX( 0._wp , SIGN( 1._wp , vt_s(ji,jj) - epsi06  ) ) ! 1 if snow   , 0 if no snow
-         END DO
-      END DO
+      DO_2D_11_11
+         zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice
+         zmsk05(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.05_wp ) ) ! 1 if 5% ice , 0 if less
+         zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less
+         zmsksn(ji,jj) = MAX( 0._wp , SIGN( 1._wp , vt_s(ji,jj) - epsi06  ) ) ! 1 if snow   , 0 if no snow
+      END_2D
       DO jl = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zmsk00l(ji,jj,jl)  = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) )
-               zmsksnl(ji,jj,jl)  = MAX( 0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi06 ) )
-            END DO
-         END DO
+         DO_2D_11_11
+            zmsk00l(ji,jj,jl)  = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) )
+            zmsksnl(ji,jj,jl)  = MAX( 0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi06 ) )
+         END_2D
       END DO
 
@@ -89,5 +87,5 @@
       ! Standard outputs
       !-----------------
-      zrho1 = ( rau0 - rhoi ) * r1_rau0 ; zrho2 = rhos * r1_rau0
+      zrho1 = ( rho0 - rhoi ) * r1_rho0 ; zrho2 = rhos * r1_rho0
       ! masks
       CALL iom_put( 'icemask'  , zmsk00 )   ! ice mask 0%
@@ -132,11 +130,9 @@
       !
       IF( iom_use('icevel') .OR. iom_use('fasticepres') ) THEN                                                              ! module of ice velocity
-         DO jj = 2 , jpjm1
-            DO ji = 2 , jpim1
-               z2da  = u_ice(ji,jj) + u_ice(ji-1,jj)
-               z2db  = v_ice(ji,jj) + v_ice(ji,jj-1)
-               z2d(ji,jj) = 0.5_wp * SQRT( z2da * z2da + z2db * z2db )
-           END DO
-         END DO
+         DO_2D_00_00
+            z2da  = u_ice(ji,jj) + u_ice(ji-1,jj)
+            z2db  = v_ice(ji,jj) + v_ice(ji,jj-1)
+            z2d(ji,jj) = 0.5_wp * SQRT( z2da * z2da + z2db * z2db )
+         END_2D
          CALL lbc_lnk( 'icewri', z2d, 'T', 1. )
          CALL iom_put( 'icevel', z2d )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_all_update.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_all_update.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_all_update.F90	(revision 12928)
@@ -1,5 +1,3 @@
-#define TWO_WAY
-
- MODULE agrif_all_update
+MODULE agrif_all_update
    !!======================================================================
    !!                   ***  MODULE  agrif_all_update  ***
@@ -41,6 +39,5 @@
       !!               Order of update matters here !
       !!----------------------------------------------------------------------
-# if defined TWO_WAY
-      IF (Agrif_Root()) RETURN
+      IF (( .NOT.ln_agrif_2way ).OR.(Agrif_Root())) RETURN
       !
       IF (lwp.AND.lk_agrif_debug) Write(*,*) ' --> START AGRIF UPDATE from grid Number',Agrif_Fixed()
@@ -67,5 +64,4 @@
       !
       Agrif_UseSpecialValueInUpdate = .FALSE.
-#endif
     END SUBROUTINE agrif_Update_All
 
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_ice_update.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_ice_update.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_ice_update.F90	(revision 12928)
@@ -1,4 +1,2 @@
-#define TWO_WAY
-!!#undef TWO_WAY
 #undef DECAL_FEEDBACK  /* SEPARATION of INTERFACES*/
 
@@ -63,5 +61,4 @@
       Agrif_UseSpecialValueInUpdate = .TRUE.
 
-# if defined TWO_WAY
 # if ! defined DECAL_FEEDBACK
       CALL Agrif_Update_Variable( tra_ice_id , procname = update_tra_ice  )
@@ -79,5 +76,4 @@
 !      CALL Agrif_Update_Variable( u_ice_id   , locupdate=(/0,1/), procname = update_u_ice    )
 !      CALL Agrif_Update_Variable( v_ice_id   , locupdate=(/0,1/), procname = update_v_ice    )
-# endif
       Agrif_SpecialValueFineGrid    = 0.
       Agrif_UseSpecialValueInUpdate = .FALSE.
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_oce.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_oce.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_oce.F90	(revision 12928)
@@ -17,18 +17,16 @@
 
    PUBLIC agrif_oce_alloc ! routine called by nemo_init in nemogcm.F90
-#if defined key_vertical
-   PUBLIC reconstructandremap ! remapping routine
-#endif   
+  
    !                                              !!* Namelist namagrif: AGRIF parameters
-   LOGICAL , PUBLIC ::   ln_spc_dyn    = .FALSE.   !:
-   INTEGER , PUBLIC, PARAMETER ::   nn_sponge_len = 2  !: Sponge width (in number of parent grid points)
+   LOGICAL , PUBLIC ::   ln_agrif_2way = .TRUE.    !: activate two way nesting 
+   LOGICAL , PUBLIC ::   ln_spc_dyn    = .FALSE.   !: use zeros (.false.) or not (.true.) in
+                                                   !: bdys dynamical fields interpolation
    REAL(wp), PUBLIC ::   rn_sponge_tra = 2800.     !: sponge coeff. for tracers
    REAL(wp), PUBLIC ::   rn_sponge_dyn = 2800.     !: sponge coeff. for dynamics
+   REAL(wp), PUBLIC ::   rn_trelax_tra = 0.01      !: time relaxation parameter for tracers
+   REAL(wp), PUBLIC ::   rn_trelax_dyn = 0.01      !: time relaxation parameter for momentum
    LOGICAL , PUBLIC ::   ln_chk_bathy  = .FALSE.   !: check of parent bathymetry 
-   LOGICAL , PUBLIC ::   lk_agrif_clp  = .FALSE.   !: Force clamped bcs
-   !                                              !!! OLD namelist names
-   REAL(wp), PUBLIC ::   visc_tra                  !: sponge coeff. for tracers
-   REAL(wp), PUBLIC ::   visc_dyn                  !: sponge coeff. for dynamics
-
+   !
+   INTEGER , PUBLIC, PARAMETER ::   nn_sponge_len = 2  !: Sponge width (in number of parent grid points)
    LOGICAL , PUBLIC :: spongedoneT = .FALSE.       !: tracer   sponge layer indicator
    LOGICAL , PUBLIC :: spongedoneU = .FALSE.       !: dynamics sponge layer indicator
@@ -42,13 +40,17 @@
    LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_u
    LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_v
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fsaht_spu, fsaht_spv !: sponge diffusivities
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fsahm_spt, fsahm_spf !: sponge viscosities
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utint_stage
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vtint_stage
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fspu, fspv !: sponge arrays
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fspt, fspf !:   "      "
 
    ! Barotropic arrays used to store open boundary data during time-splitting loop:
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ubdy_w, vbdy_w, hbdy_w
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ubdy_e, vbdy_e, hbdy_e
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ubdy_n, vbdy_n, hbdy_n
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ubdy_s, vbdy_s, hbdy_s
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ubdy, vbdy, hbdy
+   INTEGER , PUBLIC,              SAVE                 ::  Kbb_a, Kmm_a, Krhs_a   !: AGRIF module-specific copies of time-level indices
 
+# if defined key_vertical
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht0_parent, hu0_parent, hv0_parent
+   INTEGER,  PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbkt_parent, mbku_parent, mbkv_parent
+# endif
 
    INTEGER, PUBLIC :: tsn_id                                                  ! AGRIF profile for tracers interpolation and update
@@ -64,5 +66,5 @@
    INTEGER, PUBLIC :: scales_t_id
    INTEGER, PUBLIC :: avt_id, avm_id, en_id                ! TKE related identificators
-   INTEGER, PUBLIC :: umsk_id, vmsk_id
+   INTEGER, PUBLIC :: mbkt_id, ht0_id
    INTEGER, PUBLIC :: kindic_agr
    
@@ -82,17 +84,20 @@
       ierr(:) = 0
       !
-      ALLOCATE( fsaht_spu(jpi,jpj), fsaht_spv(jpi,jpj),   &
-         &      fsahm_spt(jpi,jpj), fsahm_spf(jpi,jpj),   &
-         &      tabspongedone_tsn(jpi,jpj),           &
+      ALLOCATE( fspu(jpi,jpj), fspv(jpi,jpj),    	    &
+         &      fspt(jpi,jpj), fspf(jpi,jpj),               &
+         &      tabspongedone_tsn(jpi,jpj),                 &
+         &      utint_stage(jpi,jpj), vtint_stage(jpi,jpj), &
 # if defined key_top         
          &      tabspongedone_trn(jpi,jpj),           &
-# endif         
+# endif   
+# if defined key_vertical
+         &      ht0_parent(jpi,jpj), mbkt_parent(jpi,jpj),  &
+         &      hu0_parent(jpi,jpj), mbku_parent(jpi,jpj),  &
+         &      hv0_parent(jpi,jpj), mbkv_parent(jpi,jpj),  &
+# endif      
          &      tabspongedone_u  (jpi,jpj),           &
          &      tabspongedone_v  (jpi,jpj), STAT = ierr(1) )
 
-      ALLOCATE( ubdy_w(nbghostcells,jpj), vbdy_w(nbghostcells,jpj), hbdy_w(nbghostcells,jpj),   &
-         &      ubdy_e(nbghostcells,jpj), vbdy_e(nbghostcells,jpj), hbdy_e(nbghostcells,jpj),   & 
-         &      ubdy_n(jpi,nbghostcells), vbdy_n(jpi,nbghostcells), hbdy_n(jpi,nbghostcells),   & 
-         &      ubdy_s(jpi,nbghostcells), vbdy_s(jpi,nbghostcells), hbdy_s(jpi,nbghostcells), STAT = ierr(2) )
+      ALLOCATE( ubdy(jpi,jpj), vbdy(jpi,jpj), hbdy(jpi,jpj), STAT = ierr(2) )
 
       agrif_oce_alloc = MAXVAL(ierr)
@@ -100,222 +105,4 @@
    END FUNCTION agrif_oce_alloc
 
-#if defined key_vertical
-   SUBROUTINE reconstructandremap(tabin,hin,tabout,hout,N,Nout)      
-      !!----------------------------------------------------------------------
-      !!                ***  FUNCTION reconstructandremap  ***
-      !!----------------------------------------------------------------------
-      IMPLICIT NONE
-      INTEGER N, Nout
-      REAL(wp) tabin(N), tabout(Nout)
-      REAL(wp) hin(N), hout(Nout)
-      REAL(wp) coeffremap(N,3),zwork(N,3)
-      REAL(wp) zwork2(N+1,3)
-      INTEGER jk
-      DOUBLE PRECISION, PARAMETER :: dsmll=1.0d-8  
-      REAL(wp) q,q01,q02,q001,q002,q0
-      REAL(wp) z_win(1:N+1), z_wout(1:Nout+1)
-      REAL(wp),PARAMETER :: dpthin = 1.D-3
-      INTEGER :: k1, kbox, ktop, ka, kbot
-      REAL(wp) :: tsum, qbot, rpsum, zbox, ztop, zthk, zbot, offset, qtop
-
-      z_win(1)=0.; z_wout(1)= 0.
-      DO jk=1,N
-         z_win(jk+1)=z_win(jk)+hin(jk)
-      ENDDO 
-      
-      DO jk=1,Nout
-         z_wout(jk+1)=z_wout(jk)+hout(jk)       
-      ENDDO       
-
-      DO jk=2,N
-         zwork(jk,1)=1./(hin(jk-1)+hin(jk))
-      ENDDO
-        
-      DO jk=2,N-1
-         q0 = 1./(hin(jk-1)+hin(jk)+hin(jk+1))
-         zwork(jk,2)=hin(jk-1)+2.*hin(jk)+hin(jk+1)
-         zwork(jk,3)=q0
-      ENDDO       
-     
-      DO jk= 2,N
-         zwork2(jk,1)=zwork(jk,1)*(tabin(jk)-tabin(jk-1))
-      ENDDO
-        
-      coeffremap(:,1) = tabin(:)
- 
-      DO jk=2,N-1
-         q001 = hin(jk)*zwork2(jk+1,1)
-         q002 = hin(jk)*zwork2(jk,1)        
-         IF (q001*q002 < 0) then
-            q001 = 0.
-            q002 = 0.
-         ENDIF
-         q=zwork(jk,2)
-         q01=q*zwork2(jk+1,1)
-         q02=q*zwork2(jk,1)
-         IF (abs(q001) > abs(q02)) q001 = q02
-         IF (abs(q002) > abs(q01)) q002 = q01
-        
-         q=(q001-q002)*zwork(jk,3)
-         q001=q001-q*hin(jk+1)
-         q002=q002+q*hin(jk-1)
-        
-         coeffremap(jk,3)=coeffremap(jk,1)+q001
-         coeffremap(jk,2)=coeffremap(jk,1)-q002
-        
-         zwork2(jk,1)=(2.*q001-q002)**2
-         zwork2(jk,2)=(2.*q002-q001)**2
-      ENDDO
-        
-      DO jk=1,N
-         IF(jk.EQ.1 .OR. jk.EQ.N .OR. hin(jk).LE.dpthin) THEN
-            coeffremap(jk,3) = coeffremap(jk,1)
-            coeffremap(jk,2) = coeffremap(jk,1)
-            zwork2(jk,1) = 0.
-            zwork2(jk,2) = 0.
-         ENDIF
-      ENDDO
-        
-      DO jk=2,N
-         q002=max(zwork2(jk-1,2),dsmll)
-         q001=max(zwork2(jk,1),dsmll)
-         zwork2(jk,3)=(q001*coeffremap(jk-1,3)+q002*coeffremap(jk,2))/(q001+q002)
-      ENDDO
-        
-      zwork2(1,3) = 2*coeffremap(1,1)-zwork2(2,3)
-      zwork2(N+1,3)=2*coeffremap(N,1)-zwork2(N,3)
- 
-      DO jk=1,N
-         q01=zwork2(jk+1,3)-coeffremap(jk,1)
-         q02=coeffremap(jk,1)-zwork2(jk,3)
-         q001=2.*q01
-         q002=2.*q02
-         IF (q01*q02<0) then
-            q01=0.
-            q02=0.
-         ELSEIF (abs(q01)>abs(q002)) then
-            q01=q002
-         ELSEIF (abs(q02)>abs(q001)) then
-            q02=q001
-         ENDIF
-         coeffremap(jk,2)=coeffremap(jk,1)-q02
-         coeffremap(jk,3)=coeffremap(jk,1)+q01
-      ENDDO
-
-      zbot=0.0
-      kbot=1
-      DO jk=1,Nout
-         ztop=zbot  !top is bottom of previous layer
-         ktop=kbot
-         IF     (ztop.GE.z_win(ktop+1)) then
-            ktop=ktop+1
-         ENDIF
-        
-         zbot=z_wout(jk+1)
-         zthk=zbot-ztop
-
-         IF(zthk.GT.dpthin .AND. ztop.LT.z_wout(Nout+1)) THEN
-
-            kbot=ktop
-            DO while (z_win(kbot+1).lt.zbot.and.kbot.lt.N)
-               kbot=kbot+1
-            ENDDO
-            zbox=zbot
-            DO k1= jk+1,Nout
-               IF     (z_wout(k1+1)-z_wout(k1).GT.dpthin) THEN
-                  exit !thick layer
-               ELSE
-                  zbox=z_wout(k1+1)  !include thin adjacent layers
-                  IF(zbox.EQ.z_wout(Nout+1)) THEN
-                     exit !at bottom
-                  ENDIF
-               ENDIF
-            ENDDO
-            zthk=zbox-ztop
-
-            kbox=ktop
-            DO while (z_win(kbox+1).lt.zbox.and.kbox.lt.N)
-               kbox=kbox+1
-            ENDDO
-          
-            IF(ktop.EQ.kbox) THEN
-               IF(z_wout(jk).NE.z_win(kbox).OR.z_wout(jk+1).NE.z_win(kbox+1)) THEN
-                  IF(hin(kbox).GT.dpthin) THEN
-                     q001 = (zbox-z_win(kbox))/hin(kbox)
-                     q002 = (ztop-z_win(kbox))/hin(kbox)
-                     q01=q001**2+q002**2+q001*q002+1.-2.*(q001+q002)
-                     q02=q01-1.+(q001+q002)
-                     q0=1.-q01-q02
-                  ELSE
-                     q0 = 1.0
-                     q01 = 0.
-                     q02 = 0.
-                  ENDIF
-                  tabout(jk)=q0*coeffremap(kbox,1)+q01*coeffremap(kbox,2)+q02*coeffremap(kbox,3)
-               ELSE
-                  tabout(jk) = tabin(kbox)
-               ENDIF 
-            ELSE
-               IF(ktop.LE.jk .AND. kbox.GE.jk) THEN
-                  ka = jk
-               ELSEIF (kbox-ktop.GE.3) THEN
-                  ka = (kbox+ktop)/2
-               ELSEIF (hin(ktop).GE.hin(kbox)) THEN
-                  ka = ktop
-               ELSE
-                  ka = kbox
-               ENDIF !choose ka
-    
-               offset=coeffremap(ka,1)
-    
-               qtop = z_win(ktop+1)-ztop !partial layer thickness
-               IF(hin(ktop).GT.dpthin) THEN
-                  q=(ztop-z_win(ktop))/hin(ktop)
-                  q01=q*(q-1.)
-                  q02=q01+q
-                  q0=1-q01-q02            
-               ELSE
-                  q0 = 1.
-                  q01 = 0.
-                  q02 = 0.
-               ENDIF
-               
-               tsum =((q0*coeffremap(ktop,1)+q01*coeffremap(ktop,2)+q02*coeffremap(ktop,3))-offset)*qtop
-    
-               DO k1= ktop+1,kbox-1
-                  tsum =tsum +(coeffremap(k1,1)-offset)*hin(k1)
-               ENDDO !k1
-               
-               qbot = zbox-z_win(kbox) !partial layer thickness
-               IF(hin(kbox).GT.dpthin) THEN
-                  q=qbot/hin(kbox)
-                  q01=(q-1.)**2
-                  q02=q01-1.+q
-                  q0=1-q01-q02                            
-               ELSE
-                  q0 = 1.0
-                  q01 = 0.
-                  q02 = 0.
-               ENDIF
-              
-               tsum = tsum +((q0*coeffremap(kbox,1)+q01*coeffremap(kbox,2)+q02*coeffremap(kbox,3))-offset)*qbot
-               
-               rpsum=1.0d0/zthk
-               tabout(jk)=offset+tsum*rpsum
-                 
-            ENDIF !single or multiple layers
-         ELSE
-            IF (jk==1) THEN
-               write(*,'(a7,i4,i4,3f12.5)')'problem = ',N,Nout,zthk,z_wout(jk+1),hout(1)
-            ENDIF
-            tabout(jk) = tabout(jk-1)
-             
-         ENDIF !normal:thin layer
-      ENDDO !jk
-            
-      return
-      end subroutine reconstructandremap
-#endif
-
 #endif
    !!======================================================================
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_oce_interp.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_oce_interp.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_oce_interp.F90	(revision 12928)
@@ -33,18 +33,20 @@
    USE agrif_oce_sponge
    USE lib_mpp
+   USE vremap
  
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts
+   PUBLIC   Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_dyn_ts_flux, Agrif_ssh_ts, Agrif_dta_ts
    PUBLIC   Agrif_tra, Agrif_avm
    PUBLIC   interpun , interpvn
    PUBLIC   interptsn, interpsshn, interpavm
    PUBLIC   interpunb, interpvnb , interpub2b, interpvb2b
-   PUBLIC   interpe3t, interpumsk, interpvmsk
-
+   PUBLIC   interpe3t
+#if defined key_vertical
+   PUBLIC   interpht0, interpmbkt
+# endif
    INTEGER ::   bdy_tinterp = 0
 
-#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/NST 4.0 , NEMO Consortium (2018)
@@ -78,5 +80,4 @@
       !
       INTEGER ::   ji, jj, jk       ! dummy loop indices
-      INTEGER ::   j1, j2, i1, i2
       INTEGER ::   ibdy1, jbdy1, ibdy2, jbdy2
       REAL(wp), DIMENSION(jpi,jpj) ::   zub, zvb
@@ -93,300 +94,246 @@
       Agrif_UseSpecialValue = .FALSE.
       !
-      ! prevent smoothing in ghost cells
-      i1 =  1   ;   i2 = nlci
-      j1 =  1   ;   j2 = nlcj
-      IF( nbondj == -1 .OR. nbondj == 2 )   j1 = 2 + nbghostcells
-      IF( nbondj == +1 .OR. nbondj == 2 )   j2 = nlcj - nbghostcells - 1
-      IF( nbondi == -1 .OR. nbondi == 2 )   i1 = 2 + nbghostcells 
-      IF( nbondi == +1 .OR. nbondi == 2 )   i2 = nlci - nbghostcells - 1
-
       ! --- West --- !
-      IF( nbondi == -1 .OR. nbondi == 2 ) THEN
-         ibdy1 = 2
-         ibdy2 = 1+nbghostcells 
-         !
-         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport
-            ua_b(ibdy1:ibdy2,:) = 0._wp
+      ibdy1 = 2
+      ibdy2 = 1+nbghostcells 
+      !
+      IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport
+         DO ji = mi0(ibdy1), mi1(ibdy2)
+            uu_b(ji,:,Krhs_a) = 0._wp
+
             DO jk = 1, jpkm1
                DO jj = 1, jpj
-                  ua_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) & 
-                      & + e3u_a(ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk) * umask(ibdy1:ibdy2,jj,jk)
-               END DO
-            END DO
+                  uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk)
+               END DO
+            END DO
+
             DO jj = 1, jpj
-               ua_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) * r1_hu_a(ibdy1:ibdy2,jj)
-            END DO
-         ENDIF
-         !
-         IF( .NOT.lk_agrif_clp ) THEN
-            DO jk=1,jpkm1              ! Smooth
-               DO jj=j1,j2
-                  ua(ibdy2,jj,jk) = 0.25_wp*(ua(ibdy2-1,jj,jk)+2._wp*ua(ibdy2,jj,jk)+ua(ibdy2+1,jj,jk))
-               END DO
-            END DO
-         ENDIF
-         !
-         zub(ibdy1:ibdy2,:) = 0._wp    ! Correct transport
+               uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) * r1_hu(ji,jj,Krhs_a)
+            END DO
+         END DO
+      ENDIF
+      !
+      DO ji = mi0(ibdy1), mi1(ibdy2)
+         zub(ji,:) = 0._wp    ! Correct transport
          DO jk = 1, jpkm1
             DO jj = 1, jpj
-               zub(ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) & 
-                  & + e3u_a(ibdy1:ibdy2,jj,jk)  * ua(ibdy1:ibdy2,jj,jk)*umask(ibdy1:ibdy2,jj,jk)
+               zub(ji,jj) = zub(ji,jj) & 
+                  & + e3u(ji,jj,jk,Krhs_a)  * uu(ji,jj,jk,Krhs_a)*umask(ji,jj,jk)
             END DO
          END DO
          DO jj=1,jpj
-            zub(ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) * r1_hu_a(ibdy1:ibdy2,jj)
+            zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a)
          END DO
             
          DO jk = 1, jpkm1
             DO jj = 1, jpj
-               ua(ibdy1:ibdy2,jj,jk) = ( ua(ibdy1:ibdy2,jj,jk) &
-                 & + ua_b(ibdy1:ibdy2,jj)-zub(ibdy1:ibdy2,jj)) * umask(ibdy1:ibdy2,jj,jk)
-            END DO
-         END DO
+               uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a)-zub(ji,jj)) * umask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
             
-         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate
-            zvb(ibdy1:ibdy2,:) = 0._wp
+      IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate
+         DO ji = mi0(ibdy1), mi1(ibdy2)
+            zvb(ji,:) = 0._wp
             DO jk = 1, jpkm1
                DO jj = 1, jpj
-                  zvb(ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) & 
-                     & + e3v_a(ibdy1:ibdy2,jj,jk) * va(ibdy1:ibdy2,jj,jk) * vmask(ibdy1:ibdy2,jj,jk)
+                  zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk)
                END DO
             END DO
             DO jj = 1, jpj
-               zvb(ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) * r1_hv_a(ibdy1:ibdy2,jj)
+               zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a)
             END DO
             DO jk = 1, jpkm1
                DO jj = 1, jpj
-                  va(ibdy1:ibdy2,jj,jk) = ( va(ibdy1:ibdy2,jj,jk) & 
-                    & + va_b(ibdy1:ibdy2,jj)-zvb(ibdy1:ibdy2,jj))*vmask(ibdy1:ibdy2,jj,jk)
-               END DO
-            END DO
-         ENDIF
-         !
-         DO jk = 1, jpkm1              ! Mask domain edges
-            DO jj = 1, jpj
-               ua(1,jj,jk) = 0._wp
-               va(1,jj,jk) = 0._wp
-            END DO
-         END DO 
+                  vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a)-zvb(ji,jj))*vmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
       ENDIF
 
       ! --- East --- !
-      IF( nbondi ==  1 .OR. nbondi == 2 ) THEN
-         ibdy1 = nlci-1-nbghostcells
-         ibdy2 = nlci-2 
-         !
-         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport
-            ua_b(ibdy1:ibdy2,:) = 0._wp
+      ibdy1 = jpiglo-1-nbghostcells
+      ibdy2 = jpiglo-2 
+      !
+      IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport
+         DO ji = mi0(ibdy1), mi1(ibdy2)
+            uu_b(ji,:,Krhs_a) = 0._wp
             DO jk = 1, jpkm1
                DO jj = 1, jpj
-                  ua_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) & 
-                      & + e3u_a(ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk) * umask(ibdy1:ibdy2,jj,jk)
+                  uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) & 
+                      & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk)
                END DO
             END DO
             DO jj = 1, jpj
-               ua_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) * r1_hu_a(ibdy1:ibdy2,jj)
-            END DO
-         ENDIF
-         !
-         IF( .NOT.lk_agrif_clp ) THEN
-            DO jk=1,jpkm1              ! Smooth
-               DO jj=j1,j2
-                  ua(ibdy1,jj,jk) = 0.25_wp*(ua(ibdy1-1,jj,jk)+2._wp*ua(ibdy1,jj,jk)+ua(ibdy1+1,jj,jk))
-               END DO
-            END DO
-         ENDIF
-         !
-         zub(ibdy1:ibdy2,:) = 0._wp    ! Correct transport
+               uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) * r1_hu(ji,jj,Krhs_a)
+            END DO
+         END DO
+      ENDIF
+      !
+      DO ji = mi0(ibdy1), mi1(ibdy2)
+         zub(ji,:) = 0._wp    ! Correct transport
          DO jk = 1, jpkm1
             DO jj = 1, jpj
-               zub(ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) & 
-                  & + e3u_a(ibdy1:ibdy2,jj,jk)  * ua(ibdy1:ibdy2,jj,jk) * umask(ibdy1:ibdy2,jj,jk)
+               zub(ji,jj) = zub(ji,jj) & 
+                  & + e3u(ji,jj,jk,Krhs_a)  * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk)
             END DO
          END DO
          DO jj=1,jpj
-            zub(ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) * r1_hu_a(ibdy1:ibdy2,jj)
+            zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a)
          END DO
             
          DO jk = 1, jpkm1
             DO jj = 1, jpj
-               ua(ibdy1:ibdy2,jj,jk) = ( ua(ibdy1:ibdy2,jj,jk) & 
-                 & + ua_b(ibdy1:ibdy2,jj)-zub(ibdy1:ibdy2,jj))*umask(ibdy1:ibdy2,jj,jk)
-            END DO
-         END DO
+               uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) & 
+                 & + uu_b(ji,jj,Krhs_a)-zub(ji,jj))*umask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
             
-         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate
-            ibdy1 = ibdy1 + 1
-            ibdy2 = ibdy2 + 1 
-            zvb(ibdy1:ibdy2,:) = 0._wp
+      IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate
+         ibdy1 = jpiglo-nbghostcells
+         ibdy2 = jpiglo-1 
+         DO ji = mi0(ibdy1), mi1(ibdy2)
+            zvb(ji,:) = 0._wp
             DO jk = 1, jpkm1
                DO jj = 1, jpj
-                  zvb(ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) &
-                     & + e3v_a(ibdy1:ibdy2,jj,jk) * va(ibdy1:ibdy2,jj,jk) * vmask(ibdy1:ibdy2,jj,jk)
+                  zvb(ji,jj) = zvb(ji,jj) &
+                     & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk)
                END DO
             END DO
             DO jj = 1, jpj
-               zvb(ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) * r1_hv_a(ibdy1:ibdy2,jj)
+               zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a)
             END DO
             DO jk = 1, jpkm1
                DO jj = 1, jpj
-                  va(ibdy1:ibdy2,jj,jk) = ( va(ibdy1:ibdy2,jj,jk) & 
-                      & + va_b(ibdy1:ibdy2,jj)-zvb(ibdy1:ibdy2,jj)) * vmask(ibdy1:ibdy2,jj,jk)
-               END DO
-            END DO
-         ENDIF
-         !
-         DO jk = 1, jpkm1              ! Mask domain edges
-            DO jj = 1, jpj
-               ua(nlci-1,jj,jk) = 0._wp
-               va(nlci  ,jj,jk) = 0._wp
-            END DO
-         END DO 
+                  vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) & 
+                      & + vv_b(ji,jj,Krhs_a)-zvb(ji,jj)) * vmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
       ENDIF
 
       ! --- South --- !
-      IF( nbondj == -1 .OR. nbondj == 2 ) THEN
-         jbdy1 = 2
-         jbdy2 = 1+nbghostcells 
-         !
-         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport
-            va_b(:,jbdy1:jbdy2) = 0._wp
+      jbdy1 = 2
+      jbdy2 = 1+nbghostcells 
+      !
+      IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport
+         DO jj = mj0(jbdy1), mj1(jbdy2)
+            vv_b(:,jj,Krhs_a) = 0._wp
             DO jk = 1, jpkm1
                DO ji = 1, jpi
-                  va_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) & 
-                      & + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk)
+                  vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) & 
+                      & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk)
                END DO
             END DO
             DO ji=1,jpi
-               va_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2)
-            END DO
-         ENDIF
-         !
-         IF ( .NOT.lk_agrif_clp ) THEN
-            DO jk = 1, jpkm1           ! Smooth
-               DO ji = i1, i2
-                  va(ji,jbdy2,jk) = 0.25_wp*(va(ji,jbdy2-1,jk)+2._wp*va(ji,jbdy2,jk)+va(ji,jbdy2+1,jk))
-               END DO
-            END DO
-         ENDIF
-         !
-         zvb(:,jbdy1:jbdy2) = 0._wp    ! Correct transport
+               vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) * r1_hv(ji,jj,Krhs_a)     
+            END DO
+         END DO
+      ENDIF
+      !
+      DO jj = mj0(jbdy1), mj1(jbdy2)
+         zvb(:,jj) = 0._wp    ! Correct transport
          DO jk=1,jpkm1
             DO ji=1,jpi
-               zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) & 
-                  & + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk)
+               zvb(ji,jj) = zvb(ji,jj) & 
+                  & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk)
             END DO
          END DO
          DO ji = 1, jpi
-            zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2)
+            zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a)
          END DO
 
          DO jk = 1, jpkm1
             DO ji = 1, jpi
-               va(ji,jbdy1:jbdy2,jk) = ( va(ji,jbdy1:jbdy2,jk) & 
-                 & + va_b(ji,jbdy1:jbdy2) - zvb(ji,jbdy1:jbdy2) ) * vmask(ji,jbdy1:jbdy2,jk)
-            END DO
-         END DO
+               vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) & 
+                 & + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
             
-         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate
-            zub(:,jbdy1:jbdy2) = 0._wp
+      IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate
+         DO jj = mj0(jbdy1), mj1(jbdy2)
+            zub(:,jj) = 0._wp
             DO jk = 1, jpkm1
                DO ji = 1, jpi
-                  zub(ji,jbdy1:jbdy2) = zub(ji,jbdy1:jbdy2) & 
-                     & + e3u_a(ji,jbdy1:jbdy2,jk) * ua(ji,jbdy1:jbdy2,jk) * umask(ji,jbdy1:jbdy2,jk)
+                  zub(ji,jj) = zub(ji,jj) & 
+                     & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk)
                END DO
             END DO
             DO ji = 1, jpi
-               zub(ji,jbdy1:jbdy2) = zub(ji,jbdy1:jbdy2) * r1_hu_a(ji,jbdy1:jbdy2)
+               zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a)
             END DO
                
             DO jk = 1, jpkm1
                DO ji = 1, jpi
-                  ua(ji,jbdy1:jbdy2,jk) = ( ua(ji,jbdy1:jbdy2,jk) & 
-                    & + ua_b(ji,jbdy1:jbdy2) - zub(ji,jbdy1:jbdy2) ) * umask(ji,jbdy1:jbdy2,jk)
-               END DO
-            END DO
-         ENDIF
-         !
-         DO jk = 1, jpkm1              ! Mask domain edges
-            DO ji = 1, jpi
-               ua(ji,1,jk) = 0._wp
-               va(ji,1,jk) = 0._wp
-            END DO
-         END DO 
+                  uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) & 
+                    & + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
       ENDIF
 
       ! --- North --- !
-      IF( nbondj ==  1 .OR. nbondj == 2 ) THEN
-         jbdy1 = nlcj-1-nbghostcells
-         jbdy2 = nlcj-2 
-         !
-         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport
-            va_b(:,jbdy1:jbdy2) = 0._wp
+      jbdy1 = jpjglo-1-nbghostcells
+      jbdy2 = jpjglo-2 
+      !
+      IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport
+         DO jj = mj0(jbdy1), mj1(jbdy2)
+            vv_b(:,jj,Krhs_a) = 0._wp
             DO jk = 1, jpkm1
                DO ji = 1, jpi
-                  va_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) & 
-                      & + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk)
+                  vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) & 
+                      & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk)
                END DO
             END DO
             DO ji=1,jpi
-               va_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2)
-            END DO
-         ENDIF
-         !
-         IF ( .NOT.lk_agrif_clp ) THEN
-            DO jk = 1, jpkm1           ! Smooth
-               DO ji = i1, i2
-                  va(ji,jbdy1,jk) = 0.25_wp*(va(ji,jbdy1-1,jk)+2._wp*va(ji,jbdy1,jk)+va(ji,jbdy1+1,jk))
-               END DO
-            END DO
-         ENDIF
-         !
-         zvb(:,jbdy1:jbdy2) = 0._wp    ! Correct transport
+               vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) * r1_hv(ji,jj,Krhs_a)
+            END DO
+         END DO
+      ENDIF
+      !
+      DO jj = mj0(jbdy1), mj1(jbdy2)
+         zvb(:,jj) = 0._wp    ! Correct transport
          DO jk=1,jpkm1
             DO ji=1,jpi
-               zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) & 
-                  & + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk)
+               zvb(ji,jj) = zvb(ji,jj) & 
+                  & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk)
             END DO
          END DO
          DO ji = 1, jpi
-            zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2)
+            zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a)
          END DO
 
          DO jk = 1, jpkm1
             DO ji = 1, jpi
-               va(ji,jbdy1:jbdy2,jk) = ( va(ji,jbdy1:jbdy2,jk) & 
-                 & + va_b(ji,jbdy1:jbdy2) - zvb(ji,jbdy1:jbdy2) ) * vmask(ji,jbdy1:jbdy2,jk)
-            END DO
-         END DO
+               vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) & 
+                 & + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
             
-         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate
-            jbdy1 = jbdy1 + 1
-            jbdy2 = jbdy2 + 1 
-            zub(:,jbdy1:jbdy2) = 0._wp
+      IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate
+         jbdy1 = jpjglo-nbghostcells
+         jbdy2 = jpjglo-1
+         DO jj = mj0(jbdy1), mj1(jbdy2)
+            zub(:,jj) = 0._wp
             DO jk = 1, jpkm1
                DO ji = 1, jpi
-                  zub(ji,jbdy1:jbdy2) = zub(ji,jbdy1:jbdy2) & 
-                     & + e3u_a(ji,jbdy1:jbdy2,jk) * ua(ji,jbdy1:jbdy2,jk) * umask(ji,jbdy1:jbdy2,jk)
+                  zub(ji,jj) = zub(ji,jj) & 
+                     & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk)
                END DO
             END DO
             DO ji = 1, jpi
-               zub(ji,jbdy1:jbdy2) = zub(ji,jbdy1:jbdy2) * r1_hu_a(ji,jbdy1:jbdy2)
+               zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a)
             END DO
                
             DO jk = 1, jpkm1
                DO ji = 1, jpi
-                  ua(ji,jbdy1:jbdy2,jk) = ( ua(ji,jbdy1:jbdy2,jk) & 
-                    & + ua_b(ji,jbdy1:jbdy2) - zub(ji,jbdy1:jbdy2) ) * umask(ji,jbdy1:jbdy2,jk)
-               END DO
-            END DO
-         ENDIF
-         !
-         DO jk = 1, jpkm1              ! Mask domain edges
-            DO ji = 1, jpi
-               ua(ji,nlcj  ,jk) = 0._wp
-               va(ji,nlcj-1,jk) = 0._wp
-            END DO
-         END DO 
+                  uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) & 
+                    & + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
       ENDIF
       !
@@ -401,54 +348,129 @@
       !!
       INTEGER :: ji, jj
+      INTEGER :: istart, iend, jstart, jend
       !!----------------------------------------------------------------------  
       !
       IF( Agrif_Root() )   RETURN
       !
-      IF((nbondi == -1).OR.(nbondi == 2)) THEN
+      !--- West ---!
+      istart = 2
+      iend   = nbghostcells+1
+      DO ji = mi0(istart), mi1(iend)
          DO jj=1,jpj
-            va_e(2:nbghostcells+1,jj) = vbdy_w(1:nbghostcells,jj) * hvr_e(2:nbghostcells+1,jj)
-            ! Specified fluxes:
-            ua_e(2:nbghostcells+1,jj) = ubdy_w(1:nbghostcells,jj) * hur_e(2:nbghostcells+1,jj)
-            ! Characteristics method (only if ghostcells=1):
-            !alt            ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) &
-            !alt                       &           - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) )
-         END DO
-      ENDIF
-      !
-      IF((nbondi == 1).OR.(nbondi == 2)) THEN
+            va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj)
+            ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj)
+         END DO
+      END DO
+      !
+      !--- East ---!
+      istart = jpiglo-nbghostcells
+      iend   = jpiglo-1
+      DO ji = mi0(istart), mi1(iend)
          DO jj=1,jpj
-            va_e(nlci-nbghostcells:nlci-1,jj)   = vbdy_e(1:nbghostcells,jj) * hvr_e(nlci-nbghostcells:nlci-1,jj)
-            ! Specified fluxes:
-            ua_e(nlci-nbghostcells-1:nlci-2,jj) = ubdy_e(1:nbghostcells,jj) * hur_e(nlci-nbghostcells-1:nlci-2,jj)
-            ! Characteristics method (only if ghostcells=1):
-            !alt            ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) &
-            !alt                            &           + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) )
-         END DO
-      ENDIF
-      !
-      IF((nbondj == -1).OR.(nbondj == 2)) THEN
+            va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj)
+         END DO
+      END DO
+      istart = jpiglo-nbghostcells-1
+      iend   = jpiglo-2
+      DO ji = mi0(istart), mi1(iend)
+         DO jj=1,jpj
+            ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj)
+         END DO
+      END DO
+      !
+      !--- South ---!
+      jstart = 2
+      jend   = nbghostcells+1
+      DO jj = mj0(jstart), mj1(jend)
          DO ji=1,jpi
-            ua_e(ji,2:nbghostcells+1) = ubdy_s(ji,1:nbghostcells) * hur_e(ji,2:nbghostcells+1)
-            ! Specified fluxes:
-            va_e(ji,2:nbghostcells+1) = vbdy_s(ji,1:nbghostcells) * hvr_e(ji,2:nbghostcells+1)
-            ! Characteristics method (only if ghostcells=1):
-            !alt            va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) &
-            !alt                       &           - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) )
-         END DO
-      ENDIF
-      !
-      IF((nbondj == 1).OR.(nbondj == 2)) THEN
+            ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj)
+            va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj)
+         END DO
+      END DO
+      !
+      !--- North ---!
+      jstart = jpjglo-nbghostcells
+      jend   = jpjglo-1
+      DO jj = mj0(jstart), mj1(jend)
          DO ji=1,jpi
-            ua_e(ji,nlcj-nbghostcells:nlcj-1)   = ubdy_n(ji,1:nbghostcells) * hur_e(ji,nlcj-nbghostcells:nlcj-1)
-            ! Specified fluxes:
-            va_e(ji,nlcj-nbghostcells-1:nlcj-2) = vbdy_n(ji,1:nbghostcells) * hvr_e(ji,nlcj-nbghostcells-1:nlcj-2)
-            ! Characteristics method (only if ghostcells=1):
-            !alt            va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2)  + va_e(ji,nlcj-3) &
-            !alt                            &           + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) )
-         END DO
-      ENDIF
+            ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj)
+         END DO
+      END DO
+      jstart = jpjglo-nbghostcells-1
+      jend   = jpjglo-2
+      DO jj = mj0(jstart), mj1(jend)
+         DO ji=1,jpi
+            va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj)
+         END DO
+      END DO
       !
    END SUBROUTINE Agrif_dyn_ts
 
+   SUBROUTINE Agrif_dyn_ts_flux( jn, zu, zv )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE Agrif_dyn_ts_flux  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) ::   jn
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   zu, zv
+      !!
+      INTEGER :: ji, jj
+      INTEGER :: istart, iend, jstart, jend
+      !!----------------------------------------------------------------------  
+      !
+      IF( Agrif_Root() )   RETURN
+      !
+      !--- West ---!
+      istart = 2
+      iend   = nbghostcells+1
+      DO ji = mi0(istart), mi1(iend)
+         DO jj=1,jpj
+            zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj)
+            zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj)
+         END DO
+      END DO
+      !
+      !--- East ---!
+      istart = jpiglo-nbghostcells
+      iend   = jpiglo-1
+      DO ji = mi0(istart), mi1(iend)
+         DO jj=1,jpj
+            zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj)
+         END DO
+      END DO
+      istart = jpiglo-nbghostcells-1
+      iend   = jpiglo-2
+      DO ji = mi0(istart), mi1(iend)
+         DO jj=1,jpj
+            zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj)
+         END DO
+      END DO
+      !
+      !--- South ---!
+      jstart = 2
+      jend   = nbghostcells+1
+      DO jj = mj0(jstart), mj1(jend)
+         DO ji=1,jpi
+            zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj)
+            zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj)
+         END DO
+      END DO
+      !
+      !--- North ---!
+      jstart = jpjglo-nbghostcells
+      jend   = jpjglo-1
+      DO jj = mj0(jstart), mj1(jend)
+         DO ji=1,jpi
+            zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj)
+         END DO
+      END DO
+      jstart = jpjglo-nbghostcells-1
+      jend   = jpjglo-2
+      DO jj = mj0(jstart), mj1(jend)
+         DO ji=1,jpi
+            zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj)
+         END DO
+      END DO
+      !
+   END SUBROUTINE Agrif_dyn_ts_flux
 
    SUBROUTINE Agrif_dta_ts( kt )
@@ -470,23 +492,26 @@
       !
       ! Interpolate barotropic fluxes
-      Agrif_SpecialValue=0._wp
+      Agrif_SpecialValue = 0._wp
       Agrif_UseSpecialValue = ln_spc_dyn
+      !
+      ! Set bdy time interpolation stage to 0 (latter incremented locally do deal with corners)
+      utint_stage(:,:) = 0
+      vtint_stage(:,:) = 0
       !
       IF( ll_int_cons ) THEN  ! Conservative interpolation
          ! order matters here !!!!!!
          CALL Agrif_Bc_variable( ub2b_interp_id, calledweight=1._wp, procname=interpub2b ) ! Time integrated
-         CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b )
+         CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b ) 
+         !
          bdy_tinterp = 1
          CALL Agrif_Bc_variable( unb_id        , calledweight=1._wp, procname=interpunb  ) ! After
-         CALL Agrif_Bc_variable( vnb_id        , calledweight=1._wp, procname=interpvnb  )
+         CALL Agrif_Bc_variable( vnb_id        , calledweight=1._wp, procname=interpvnb  )  
+         !
          bdy_tinterp = 2
          CALL Agrif_Bc_variable( unb_id        , calledweight=0._wp, procname=interpunb  ) ! Before
-         CALL Agrif_Bc_variable( vnb_id        , calledweight=0._wp, procname=interpvnb  )         
+         CALL Agrif_Bc_variable( vnb_id        , calledweight=0._wp, procname=interpvnb  )   
       ELSE ! Linear interpolation
-         bdy_tinterp = 0
-         ubdy_w(:,:) = 0._wp   ;   vbdy_w(:,:) = 0._wp 
-         ubdy_e(:,:) = 0._wp   ;   vbdy_e(:,:) = 0._wp 
-         ubdy_n(:,:) = 0._wp   ;   vbdy_n(:,:) = 0._wp 
-         ubdy_s(:,:) = 0._wp   ;   vbdy_s(:,:) = 0._wp
+         !
+         ubdy(:,:) = 0._wp   ;   vbdy(:,:) = 0._wp 
          CALL Agrif_Bc_variable( unb_id, procname=interpunb )
          CALL Agrif_Bc_variable( vnb_id, procname=interpvnb )
@@ -503,5 +528,6 @@
       INTEGER, INTENT(in) ::   kt
       !
-      INTEGER  :: ji, jj, indx, indy
+      INTEGER  :: ji, jj
+      INTEGER  :: istart, iend, jstart, jend
       !!----------------------------------------------------------------------  
       !
@@ -516,42 +542,38 @@
       !
       ! --- West --- !
-      IF((nbondi == -1).OR.(nbondi == 2)) THEN
-         indx = 1+nbghostcells
+      istart = 2
+      iend   = 1 + nbghostcells
+      DO ji = mi0(istart), mi1(iend)
          DO jj = 1, jpj
-            DO ji = 2, indx
-               ssha(ji,jj) = hbdy_w(ji-1,jj)
-            ENDDO
+            ssh(ji,jj,Krhs_a) = hbdy(ji,jj)
          ENDDO
-      ENDIF
+      ENDDO
       !
       ! --- East --- !
-      IF((nbondi == 1).OR.(nbondi == 2)) THEN
-         indx = nlci-nbghostcells
+      istart = jpiglo - nbghostcells
+      iend   = jpiglo - 1
+      DO ji = mi0(istart), mi1(iend)
          DO jj = 1, jpj
-            DO ji = indx, nlci-1
-               ssha(ji,jj) = hbdy_e(ji-indx+1,jj)
-            ENDDO
+            ssh(ji,jj,Krhs_a) = hbdy(ji,jj)
          ENDDO
-      ENDIF
+      ENDDO
       !
       ! --- South --- !
-      IF((nbondj == -1).OR.(nbondj == 2)) THEN
-         indy = 1+nbghostcells
-         DO jj = 2, indy
-            DO ji = 1, jpi
-               ssha(ji,jj) = hbdy_s(ji,jj-1)
-            ENDDO
+      jstart = 2
+      jend   = 1 + nbghostcells
+      DO jj = mj0(jstart), mj1(jend)
+         DO ji = 1, jpi
+            ssh(ji,jj,Krhs_a) = hbdy(ji,jj)
          ENDDO
-      ENDIF
+      ENDDO
       !
       ! --- North --- !
-      IF((nbondj == 1).OR.(nbondj == 2)) THEN
-         indy = nlcj-nbghostcells
-         DO jj = indy, nlcj-1
-            DO ji = 1, jpi
-               ssha(ji,jj) = hbdy_n(ji,jj-indy+1)
-            ENDDO
+      jstart = jpjglo - nbghostcells
+      jend   = jpjglo - 1
+      DO jj = mj0(jstart), mj1(jend)
+         DO ji = 1, jpi
+            ssh(ji,jj,Krhs_a) = hbdy(ji,jj)
          ENDDO
-      ENDIF
+      ENDDO
       !
    END SUBROUTINE Agrif_ssh
@@ -564,49 +586,45 @@
       INTEGER, INTENT(in) ::   jn
       !!
-      INTEGER :: ji, jj, indx, indy
-      !!----------------------------------------------------------------------  
-      !! clem ghost (starting at i,j=1 is important I think otherwise you introduce a grad(ssh)/=0 at point 2)
+      INTEGER :: ji, jj
+      INTEGER  :: istart, iend, jstart, jend
+      !!----------------------------------------------------------------------  
       !
       IF( Agrif_Root() )   RETURN
       !
       ! --- West --- !
-      IF((nbondi == -1).OR.(nbondi == 2)) THEN
-         indx = 1+nbghostcells
+      istart = 2
+      iend   = 1+nbghostcells
+      DO ji = mi0(istart), mi1(iend)
          DO jj = 1, jpj
-            DO ji = 2, indx
-               ssha_e(ji,jj) = hbdy_w(ji-1,jj)
-            ENDDO
+            ssha_e(ji,jj) = hbdy(ji,jj)
          ENDDO
-      ENDIF
+      ENDDO
       !
       ! --- East --- !
-      IF((nbondi == 1).OR.(nbondi == 2)) THEN
-         indx = nlci-nbghostcells
+      istart = jpiglo - nbghostcells
+      iend   = jpiglo - 1
+      DO ji = mi0(istart), mi1(iend)
          DO jj = 1, jpj
-            DO ji = indx, nlci-1
-               ssha_e(ji,jj) = hbdy_e(ji-indx+1,jj)
-            ENDDO
+            ssha_e(ji,jj) = hbdy(ji,jj)
          ENDDO
-      ENDIF
+      ENDDO
       !
       ! --- South --- !
-      IF((nbondj == -1).OR.(nbondj == 2)) THEN
-         indy = 1+nbghostcells
-         DO jj = 2, indy
-            DO ji = 1, jpi
-               ssha_e(ji,jj) = hbdy_s(ji,jj-1)
-            ENDDO
+      jstart = 2
+      jend   = 1+nbghostcells
+      DO jj = mj0(jstart), mj1(jend)
+         DO ji = 1, jpi
+            ssha_e(ji,jj) = hbdy(ji,jj)
          ENDDO
-      ENDIF
+      ENDDO
       !
       ! --- North --- !
-      IF((nbondj == 1).OR.(nbondj == 2)) THEN
-         indy = nlcj-nbghostcells
-         DO jj = indy, nlcj-1
-            DO ji = 1, jpi
-               ssha_e(ji,jj) = hbdy_n(ji,jj-indy+1)
-            ENDDO
+      jstart = jpjglo - nbghostcells
+      jend   = jpjglo - 1
+      DO jj = mj0(jstart), mj1(jend)
+         DO ji = 1, jpi
+            ssha_e(ji,jj) = hbdy(ji,jj)
          ENDDO
-      ENDIF
+      ENDDO
       !
    END SUBROUTINE Agrif_ssh_ts
@@ -634,5 +652,5 @@
    
 
-   SUBROUTINE interptsn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before, nb, ndir )
+   SUBROUTINE interptsn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before )
       !!----------------------------------------------------------------------
       !!                  *** ROUTINE interptsn ***
@@ -641,16 +659,13 @@
       INTEGER                                     , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, n1, n2
       LOGICAL                                     , INTENT(in   ) ::   before
-      INTEGER                                     , INTENT(in   ) ::   nb , ndir
-      !
-      INTEGER  ::   ji, jj, jk, jn, iref, jref, ibdy, jbdy   ! dummy loop indices
-      INTEGER  ::   imin, imax, jmin, jmax, N_in, N_out
-      REAL(wp) ::   zrho, z1, z2, z3, z4, z5, z6, z7
-      LOGICAL :: western_side, eastern_side,northern_side,southern_side
+      !
+      INTEGER  ::   ji, jj, jk, jn  ! dummy loop indices
+      INTEGER  ::   N_in, N_out
       ! vertical interpolation:
-      REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,n1:n2) :: ptab_child
-      REAL(wp), DIMENSION(k1:k2,n1:n2-1) :: tabin
+      REAL(wp) :: zhtot
+      REAL(wp), DIMENSION(k1:k2,1:jpts) :: tabin
       REAL(wp), DIMENSION(k1:k2) :: h_in
       REAL(wp), DIMENSION(1:jpk) :: h_out
-      REAL(wp) :: h_diff
+      !!----------------------------------------------------------------------
 
       IF( before ) THEN         
@@ -659,5 +674,5 @@
                DO jj=j1,j2
                  DO ji=i1,i2
-                       ptab(ji,jj,jk,jn) = tsn(ji,jj,jk,jn)
+                       ptab(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kmm_a)
                  END DO
               END DO
@@ -666,187 +681,74 @@
 
 # if defined key_vertical
+        ! Interpolate thicknesses
+        ! Warning: these are masked, hence extrapolated prior interpolation.
         DO jk=k1,k2
            DO jj=j1,j2
               DO ji=i1,i2
-                 ptab(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t_n(ji,jj,jk) 
+                  ptab(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a)
               END DO
            END DO
         END DO
+
+        ! Extrapolate thicknesses in partial bottom cells:
+        ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on
+        IF (ln_zps) THEN
+           DO jj=j1,j2
+              DO ji=i1,i2
+                  jk = mbkt(ji,jj)
+                  ptab(ji,jj,jk,jpts+1) = 0._wp
+              END DO
+           END DO           
+        END IF
+     
+        ! Save ssh at last level:
+        IF (.NOT.ln_linssh) THEN
+           ptab(i1:i2,j1:j2,k2,jpts+1) = ssh(i1:i2,j1:j2,Kmm_a)*tmask(i1:i2,j1:j2,1) 
+        ELSE
+           ptab(i1:i2,j1:j2,k2,jpts+1) = 0._wp
+        END IF      
 # endif
       ELSE 
 
-         western_side  = (nb == 1).AND.(ndir == 1)   ;   eastern_side  = (nb == 1).AND.(ndir == 2)
-         southern_side = (nb == 2).AND.(ndir == 1)   ;   northern_side = (nb == 2).AND.(ndir == 2)
-
-# if defined key_vertical              
+# if defined key_vertical 
+         IF (ln_linssh) ptab(i1:i2,j1:j2,k2,n2) = 0._wp 
+            
          DO jj=j1,j2
             DO ji=i1,i2
-               iref = ji
-               jref = jj
-               if(western_side) iref=MAX(2,ji)
-               if(eastern_side) iref=MIN(nlci-1,ji)
-               if(southern_side) jref=MAX(2,jj)
-               if(northern_side) jref=MIN(nlcj-1,jj)
-               N_in = 0
-               DO jk=k1,k2 !k2 = jpk of parent grid
-                  IF (ptab(ji,jj,jk,n2) == 0) EXIT
-                  N_in = N_in + 1
+               ts(ji,jj,:,:,Krhs_a) = 0._wp
+               N_in = mbkt_parent(ji,jj)
+               zhtot = 0._wp
+               DO jk=1,N_in !k2 = jpk of parent grid
+                  IF (jk==N_in) THEN
+                     h_in(jk) = ht0_parent(ji,jj) + ptab(ji,jj,k2,n2) - zhtot
+                  ELSE
+                     h_in(jk) = ptab(ji,jj,jk,n2)
+                  ENDIF
+                  zhtot = zhtot + h_in(jk)
                   tabin(jk,:) = ptab(ji,jj,jk,n1:n2-1)
-                  h_in(N_in) = ptab(ji,jj,jk,n2)
                END DO
                N_out = 0
                DO jk=1,jpk ! jpk of child grid
-                  IF (tmask(iref,jref,jk) == 0) EXIT 
+                  IF (tmask(ji,jj,jk) == 0._wp) EXIT 
                   N_out = N_out + 1
-                  h_out(jk) = e3t_n(iref,jref,jk)
+                  h_out(jk) = e3t(ji,jj,jk,Krhs_a)
                ENDDO
-               IF (N_in > 0) THEN
-                  DO jn=1,jpts
-                     call reconstructandremap(tabin(1:N_in,jn),h_in,ptab_child(ji,jj,1:N_out,jn),h_out,N_in,N_out)
-                  ENDDO
+               IF (N_in*N_out > 0) THEN
+                  CALL reconstructandremap(tabin(1:N_in,1:jpts),h_in(1:N_in),ts(ji,jj,1:N_out,1:jpts,Krhs_a),h_out(1:N_out),N_in,N_out,jpts)
                ENDIF
             ENDDO
          ENDDO
 # else
-         ptab_child(i1:i2,j1:j2,1:jpk,1:jpts) = ptab(i1:i2,j1:j2,1:jpk,1:jpts)
-# endif
          !
          DO jn=1, jpts
-            tsa(i1:i2,j1:j2,1:jpk,jn)=ptab_child(i1:i2,j1:j2,1:jpk,jn)*tmask(i1:i2,j1:j2,1:jpk) 
-         END DO
-
-         IF ( .NOT.lk_agrif_clp ) THEN 
-            !
-            imin = i1 ; imax = i2
-            jmin = j1 ; jmax = j2
-            ! 
-            ! Remove CORNERS
-            IF((nbondj == -1).OR.(nbondj == 2)) jmin = 2 + nbghostcells
-            IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj - nbghostcells - 1
-            IF((nbondi == -1).OR.(nbondi == 2)) imin = 2 + nbghostcells
-            IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci - nbghostcells - 1      
-            !
-            IF( eastern_side ) THEN
-               zrho = Agrif_Rhox()
-               z1 = ( zrho - 1._wp ) * 0.5_wp                    
-               z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )         
-               z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp )
-               z7 =       - ( zrho - 1._wp ) / ( zrho + 3._wp )
-               z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7
-               !
-               ibdy = nlci-nbghostcells
-               DO jn = 1, jpts
-                  tsa(ibdy+1,jmin:jmax,1:jpkm1,jn) = z1 * ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) + z2 * ptab_child(ibdy,jmin:jmax,1:jpkm1,jn)
-                  DO jk = 1, jpkm1
-                     DO jj = jmin,jmax
-                        IF( umask(ibdy-1,jj,jk) == 0._wp ) THEN
-                           tsa(ibdy,jj,jk,jn) = tsa(ibdy+1,jj,jk,jn) * tmask(ibdy,jj,jk)
-                        ELSE
-                           tsa(ibdy,jj,jk,jn)=(z4*tsa(ibdy+1,jj,jk,jn)+z3*tsa(ibdy-1,jj,jk,jn))*tmask(ibdy,jj,jk)
-                           IF( un(ibdy-1,jj,jk) > 0._wp ) THEN
-                              tsa(ibdy,jj,jk,jn)=( z6*tsa(ibdy-1,jj,jk,jn)+z5*tsa(ibdy+1,jj,jk,jn) & 
-                                                 + z7*tsa(ibdy-2,jj,jk,jn) ) * tmask(ibdy,jj,jk)
-                           ENDIF
-                        ENDIF
-                     END DO
-                  END DO
-                  ! Restore ghost points:
-                  tsa(ibdy+1,jmin:jmax,1:jpkm1,jn) = ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy+1,jmin:jmax,1:jpkm1)
-               END DO
-            ENDIF
-            ! 
-            IF( northern_side ) THEN
-               zrho = Agrif_Rhoy()
-               z1 = ( zrho - 1._wp ) * 0.5_wp                    
-               z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )         
-               z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp )
-               z7 =       - ( zrho - 1._wp ) / ( zrho + 3._wp )
-               z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7
-               !
-               jbdy = nlcj-nbghostcells         
-               DO jn = 1, jpts
-                  tsa(imin:imax,jbdy+1,1:jpkm1,jn) = z1 * ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) + z2 * ptab_child(imin:imax,jbdy,1:jpkm1,jn)
-                  DO jk = 1, jpkm1
-                     DO ji = imin,imax
-                        IF( vmask(ji,jbdy-1,jk) == 0._wp ) THEN
-                           tsa(ji,jbdy,jk,jn) = tsa(ji,jbdy+1,jk,jn) * tmask(ji,jbdy,jk)
-                        ELSE
-                           tsa(ji,jbdy,jk,jn)=(z4*tsa(ji,jbdy+1,jk,jn)+z3*tsa(ji,jbdy-1,jk,jn))*tmask(ji,jbdy,jk)        
-                           IF (vn(ji,jbdy-1,jk) > 0._wp ) THEN
-                              tsa(ji,jbdy,jk,jn)=( z6*tsa(ji,jbdy-1,jk,jn)+z5*tsa(ji,jbdy+1,jk,jn)  &
-                                                 + z7*tsa(ji,jbdy-2,jk,jn) ) * tmask(ji,jbdy,jk)
-                           ENDIF
-                        ENDIF
-                     END DO
-                  END DO
-                  ! Restore ghost points:
-                  tsa(imin:imax,jbdy+1,1:jpkm1,jn) = ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) * tmask(imin:imax,jbdy+1,1:jpkm1)
-               END DO
-            ENDIF
-            !
-            IF( western_side ) THEN
-               zrho = Agrif_Rhox()
-               z1 = ( zrho - 1._wp ) * 0.5_wp                    
-               z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )         
-               z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp )
-               z7 =       - ( zrho - 1._wp ) / ( zrho + 3._wp )
-               z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7
-               !    
-               ibdy = 1+nbghostcells       
-               DO jn = 1, jpts
-                  tsa(ibdy-1,jmin:jmax,1:jpkm1,jn) = z1 * ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) + z2 * ptab_child(ibdy,jmin:jmax,1:jpkm1,jn)
-                  DO jk = 1, jpkm1
-                     DO jj = jmin,jmax
-                        IF( umask(ibdy,jj,jk) == 0._wp ) THEN
-                           tsa(ibdy,jj,jk,jn) = tsa(ibdy-1,jj,jk,jn) * tmask(ibdy,jj,jk)
-                        ELSE
-                           tsa(ibdy,jj,jk,jn)=(z4*tsa(ibdy-1,jj,jk,jn)+z3*tsa(ibdy+1,jj,jk,jn))*tmask(ibdy,jj,jk)        
-                           IF( un(ibdy,jj,jk) < 0._wp ) THEN
-                              tsa(ibdy,jj,jk,jn)=( z6*tsa(ibdy+1,jj,jk,jn)+z5*tsa(ibdy-1,jj,jk,jn) &
-                                                 + z7*tsa(ibdy+2,jj,jk,jn) ) * tmask(ibdy,jj,jk)
-                           ENDIF
-                        ENDIF
-                     END DO
-                  END DO
-                  ! Restore ghost points:
-                  tsa(ibdy-1,jmin:jmax,1:jpkm1,jn) = ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy-1,jmin:jmax,1:jpkm1)
-               END DO
-            ENDIF
-            !
-            IF( southern_side ) THEN
-               zrho = Agrif_Rhoy()
-               z1 = ( zrho - 1._wp ) * 0.5_wp                    
-               z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )         
-               z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp )
-               z7 =       - ( zrho - 1._wp ) / ( zrho + 3._wp )
-               z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7
-               !  
-               jbdy=1+nbghostcells        
-               DO jn = 1, jpts
-                  tsa(imin:imax,jbdy-1,1:jpkm1,jn) = z1 * ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) + z2 * ptab_child(imin:imax,jbdy,1:jpkm1,jn)
-                  DO jk = 1, jpkm1      
-                     DO ji = imin,imax
-                        IF( vmask(ji,jbdy,jk) == 0._wp ) THEN
-                           tsa(ji,jbdy,jk,jn)=tsa(ji,jbdy-1,jk,jn) * tmask(ji,jbdy,jk)
-                        ELSE
-                           tsa(ji,jbdy,jk,jn)=(z4*tsa(ji,jbdy-1,jk,jn)+z3*tsa(ji,jbdy+1,jk,jn))*tmask(ji,jbdy,jk)
-                           IF( vn(ji,jbdy,jk) < 0._wp ) THEN
-                              tsa(ji,jbdy,jk,jn)=( z6*tsa(ji,jbdy+1,jk,jn)+z5*tsa(ji,jbdy-1,jk,jn) & 
-                                                 + z7*tsa(ji,jbdy+2,jk,jn) ) * tmask(ji,jbdy,jk)
-                           ENDIF
-                        ENDIF
-                     END DO
-                  END DO
-                  ! Restore ghost points:
-                  tsa(imin:imax,jbdy-1,1:jpkm1,jn) = ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) * tmask(imin:imax,jbdy-1,1:jpkm1)
-               END DO
-            ENDIF
-            !
-         ENDIF
+            ts(i1:i2,j1:j2,1:jpk,jn,Krhs_a)=ptab(i1:i2,j1:j2,1:jpk,jn)*tmask(i1:i2,j1:j2,1:jpk) 
+         END DO
+# endif
+
       ENDIF
       !
    END SUBROUTINE interptsn
 
-   SUBROUTINE interpsshn( ptab, i1, i2, j1, j2, before, nb, ndir )
+   SUBROUTINE interpsshn( ptab, i1, i2, j1, j2, before )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE interpsshn  ***
@@ -855,26 +757,16 @@
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
       LOGICAL                         , INTENT(in   ) ::   before
-      INTEGER                         , INTENT(in   ) ::   nb , ndir
-      !
-      LOGICAL :: western_side, eastern_side,northern_side,southern_side
+      !
       !!----------------------------------------------------------------------  
       !
       IF( before) THEN
-         ptab(i1:i2,j1:j2) = sshn(i1:i2,j1:j2)
+         ptab(i1:i2,j1:j2) = ssh(i1:i2,j1:j2,Kmm_a)
       ELSE
-         western_side  = (nb == 1).AND.(ndir == 1)
-         eastern_side  = (nb == 1).AND.(ndir == 2)
-         southern_side = (nb == 2).AND.(ndir == 1)
-         northern_side = (nb == 2).AND.(ndir == 2)
-         !! clem ghost
-         IF(western_side)  hbdy_w(1:nbghostcells,j1:j2) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1)
-         IF(eastern_side)  hbdy_e(1:nbghostcells,j1:j2) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1)
-         IF(southern_side) hbdy_s(i1:i2,1:nbghostcells) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1) 
-         IF(northern_side) hbdy_n(i1:i2,1:nbghostcells) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1)
+         hbdy(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1)
       ENDIF
       !
    END SUBROUTINE interpsshn
 
-   SUBROUTINE interpun( ptab, i1, i2, j1, j2, k1, k2, m1, m2, before, nb, ndir )
+   SUBROUTINE interpun( ptab, i1, i2, j1, j2, k1, k2, m1, m2, before )
       !!----------------------------------------------------------------------
       !!                  *** ROUTINE interpun ***
@@ -884,14 +776,12 @@
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,m1:m2), INTENT(inout) :: ptab
       LOGICAL, INTENT(in) :: before
-      INTEGER, INTENT(in) :: nb , ndir
       !!
       INTEGER :: ji,jj,jk
-      REAL(wp) :: zrhoy
+      REAL(wp) :: zrhoy, zhtot
       ! vertical interpolation:
       REAL(wp), DIMENSION(k1:k2) :: tabin, h_in
       REAL(wp), DIMENSION(1:jpk) :: h_out
-      INTEGER  :: N_in, N_out, iref
+      INTEGER  :: N_in, N_out
       REAL(wp) :: h_diff
-      LOGICAL  :: western_side, eastern_side
       !!---------------------------------------------    
       !
@@ -900,57 +790,65 @@
             DO jj=j1,j2
                DO ji=i1,i2
-                  ptab(ji,jj,jk,1) = (e2u(ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk)*umask(ji,jj,jk)) 
+                  ptab(ji,jj,jk,1) = (e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) * uu(ji,jj,jk,Kmm_a)*umask(ji,jj,jk)) 
 # if defined key_vertical
-                  ptab(ji,jj,jk,2) = (umask(ji,jj,jk) * e2u(ji,jj) * e3u_n(ji,jj,jk))
+                  ! Interpolate thicknesses (masked for subsequent extrapolation)
+                  ptab(ji,jj,jk,2) = umask(ji,jj,jk) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a)
 # endif
                END DO
             END DO
          END DO
+# if defined key_vertical
+         ! Extrapolate thicknesses in partial bottom cells:
+         ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on
+         IF (ln_zps) THEN
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  jk = mbku(ji,jj)
+                  ptab(ji,jj,jk,2) = 0._wp
+               END DO
+            END DO           
+         END IF
+        ! Save ssh at last level:
+        ptab(i1:i2,j1:j2,k2,2) = 0._wp
+        IF (.NOT.ln_linssh) THEN
+           ! This vertical sum below should be replaced by the sea-level at U-points (optimization):
+           DO jk=1,jpk
+              ptab(i1:i2,j1:j2,k2,2) = ptab(i1:i2,j1:j2,k2,2) + e3u(i1:i2,j1:j2,jk,Kmm_a) * umask(i1:i2,j1:j2,jk)
+           END DO
+           ptab(i1:i2,j1:j2,k2,2) = ptab(i1:i2,j1:j2,k2,2) - hu_0(i1:i2,j1:j2)
+        END IF 
+# endif
+         !
       ELSE
          zrhoy = Agrif_rhoy()
 # if defined key_vertical
 ! VERTICAL REFINEMENT BEGIN
-         western_side  = (nb == 1).AND.(ndir == 1)
-         eastern_side  = (nb == 1).AND.(ndir == 2)
+
+         IF (ln_linssh) ptab(i1:i2,j1:j2,k2,2) = 0._wp 
 
          DO ji=i1,i2
-            iref = ji
-            IF (western_side) iref = MAX(2,ji)
-            IF (eastern_side) iref = MIN(nlci-2,ji)
             DO jj=j1,j2
-               N_in = 0
-               DO jk=k1,k2
-                  IF (ptab(ji,jj,jk,2) == 0) EXIT
-                  N_in = N_in + 1
-                  tabin(jk) = ptab(ji,jj,jk,1)/ptab(ji,jj,jk,2)
-                  h_in(N_in) = ptab(ji,jj,jk,2)/(e2u(ji,jj)*zrhoy) 
+               uu(ji,jj,:,Krhs_a) = 0._wp
+               N_in = mbku_parent(ji,jj)
+               zhtot = 0._wp
+               DO jk=1,N_in
+                  IF (jk==N_in) THEN
+                     h_in(jk) = hu0_parent(ji,jj) + ptab(ji,jj,k2,2) - zhtot
+                  ELSE
+                     h_in(jk) = ptab(ji,jj,jk,2)/(e2u(ji,jj)*zrhoy) 
+                  ENDIF
+                  zhtot = zhtot + h_in(jk)
+                  tabin(jk) = ptab(ji,jj,jk,1)/(e2u(ji,jj)*zrhoy*h_in(jk))
               ENDDO
-         
-              IF (N_in == 0) THEN
-                 ua(ji,jj,:) = 0._wp
-                 CYCLE
-              ENDIF
-         
+                  
               N_out = 0
               DO jk=1,jpk
-                 if (umask(iref,jj,jk) == 0) EXIT
+                 if (umask(ji,jj,jk) == 0) EXIT
                  N_out = N_out + 1
-                 h_out(N_out) = e3u_a(iref,jj,jk)
+                 h_out(N_out) = e3u(ji,jj,jk,Krhs_a)
               ENDDO
-         
-              IF (N_out == 0) THEN
-                 ua(ji,jj,:) = 0._wp
-                 CYCLE
+              IF (N_in*N_out > 0) THEN
+                 CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),uu(ji,jj,1:N_out,Krhs_a),h_out(1:N_out),N_in,N_out,1)
               ENDIF
-         
-              IF (N_in * N_out > 0) THEN
-                 h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in))
-! Should be able to remove the next IF/ELSEIF statement once scale factors are dealt with properly
-                 if (h_diff < -1.e4) then
-                    print *,'CHECK YOUR BATHY ...', h_diff, sum(h_out(1:N_out)), sum(h_in(1:N_in))
-!                    stop
-                 endif
-              ENDIF
-              call reconstructandremap(tabin(1:N_in),h_in(1:N_in),ua(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out)
             ENDDO
          ENDDO
@@ -959,5 +857,5 @@
          DO jk = 1, jpkm1
             DO jj=j1,j2
-               ua(i1:i2,jj,jk) = ptab(i1:i2,jj,jk,1) / ( zrhoy * e2u(i1:i2,jj) * e3u_a(i1:i2,jj,jk) )
+               uu(i1:i2,jj,jk,Krhs_a) = ptab(i1:i2,jj,jk,1) / ( zrhoy * e2u(i1:i2,jj) * e3u(i1:i2,jj,jk,Krhs_a) )
             END DO
          END DO
@@ -968,5 +866,5 @@
    END SUBROUTINE interpun
 
-   SUBROUTINE interpvn( ptab, i1, i2, j1, j2, k1, k2, m1, m2, before, nb, ndir )
+   SUBROUTINE interpvn( ptab, i1, i2, j1, j2, k1, k2, m1, m2, before )
       !!----------------------------------------------------------------------
       !!                  *** ROUTINE interpvn ***
@@ -976,5 +874,4 @@
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,m1:m2), INTENT(inout) :: ptab
       LOGICAL, INTENT(in) :: before
-      INTEGER, INTENT(in) :: nb , ndir
       !
       INTEGER :: ji,jj,jk
@@ -983,7 +880,6 @@
       REAL(wp), DIMENSION(k1:k2) :: tabin, h_in
       REAL(wp), DIMENSION(1:jpk) :: h_out
-      INTEGER  :: N_in, N_out, jref
-      REAL(wp) :: h_diff
-      LOGICAL  :: northern_side,southern_side
+      INTEGER  :: N_in, N_out
+      REAL(wp) :: h_diff, zhtot
       !!---------------------------------------------    
       !      
@@ -992,51 +888,68 @@
             DO jj=j1,j2
                DO ji=i1,i2
-                  ptab(ji,jj,jk,1) = (e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk)*vmask(ji,jj,jk))
+                  ptab(ji,jj,jk,1) = (e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) * vv(ji,jj,jk,Kmm_a)*vmask(ji,jj,jk))
 # if defined key_vertical
-                  ptab(ji,jj,jk,2) = vmask(ji,jj,jk) * e1v(ji,jj) * e3v_n(ji,jj,jk)
+                  ! Interpolate thicknesses (masked for subsequent extrapolation)
+                  ptab(ji,jj,jk,2) = vmask(ji,jj,jk) * e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a)
 # endif
                END DO
             END DO
          END DO
+# if defined key_vertical
+         ! Extrapolate thicknesses in partial bottom cells:
+         ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on
+         IF (ln_zps) THEN
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  jk = mbkv(ji,jj)
+                  ptab(ji,jj,jk,2) = 0._wp
+               END DO
+            END DO           
+         END IF
+        ! Save ssh at last level:
+        ptab(i1:i2,j1:j2,k2,2) = 0._wp
+        IF (.NOT.ln_linssh) THEN
+           ! This vertical sum below should be replaced by the sea-level at V-points (optimization):
+           DO jk=1,jpk
+              ptab(i1:i2,j1:j2,k2,2) = ptab(i1:i2,j1:j2,k2,2) + e3v(i1:i2,j1:j2,jk,Kmm_a) * vmask(i1:i2,j1:j2,jk)
+           END DO
+           ptab(i1:i2,j1:j2,k2,2) = ptab(i1:i2,j1:j2,k2,2) - hv_0(i1:i2,j1:j2)
+        END IF 
+# endif
       ELSE       
          zrhox = Agrif_rhox()
 # if defined key_vertical
 
-         southern_side = (nb == 2).AND.(ndir == 1)
-         northern_side = (nb == 2).AND.(ndir == 2)
+         IF (ln_linssh) ptab(i1:i2,j1:j2,k2,2) = 0._wp 
 
          DO jj=j1,j2
-            jref = jj
-            IF (southern_side) jref = MAX(2,jj)
-            IF (northern_side) jref = MIN(nlcj-2,jj)
             DO ji=i1,i2
-               N_in = 0
-               DO jk=k1,k2
-                  if (ptab(ji,jj,jk,2) == 0) EXIT
-                  N_in = N_in + 1
-                  tabin(jk) = ptab(ji,jj,jk,1)/ptab(ji,jj,jk,2)
-                  h_in(N_in) = ptab(ji,jj,jk,2)/(e1v(ji,jj)*zrhox)
-               END DO
-               IF (N_in == 0) THEN
-                  va(ji,jj,:) = 0._wp
-                  CYCLE
-               ENDIF
+               vv(ji,jj,:,Krhs_a) = 0._wp
+               N_in = mbkv_parent(ji,jj)
+               zhtot = 0._wp
+               DO jk=1,N_in
+                  IF (jk==N_in) THEN
+                     h_in(jk) = hv0_parent(ji,jj) + ptab(ji,jj,k2,2) - zhtot
+                  ELSE
+                     h_in(jk) = ptab(ji,jj,jk,2)/(e1v(ji,jj)*zrhox) 
+                  ENDIF
+                  zhtot = zhtot + h_in(jk)
+                  tabin(jk) = ptab(ji,jj,jk,1)/(e1v(ji,jj)*zrhox*h_in(jk))
+              ENDDO
          
                N_out = 0
                DO jk=1,jpk
-                  if (vmask(ji,jref,jk) == 0) EXIT
+                  if (vmask(ji,jj,jk) == 0) EXIT
                   N_out = N_out + 1
-                  h_out(N_out) = e3v_a(ji,jref,jk)
-               END DO
-               IF (N_out == 0) THEN
-                 va(ji,jj,:) = 0._wp
-                 CYCLE
+                  h_out(N_out) = e3v(ji,jj,jk,Krhs_a)
+               END DO
+               IF (N_in*N_out > 0) THEN
+                  call reconstructandremap(tabin(1:N_in),h_in(1:N_in),vv(ji,jj,1:N_out,Krhs_a),h_out(1:N_out),N_in,N_out,1)
                ENDIF
-               call reconstructandremap(tabin(1:N_in),h_in(1:N_in),va(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out)
             END DO
          END DO
 # else
          DO jk = 1, jpkm1
-            va(i1:i2,j1:j2,jk) = ptab(i1:i2,j1:j2,jk,1) / ( zrhox * e1v(i1:i2,j1:j2) * e3v_a(i1:i2,j1:j2,jk) )
+            vv(i1:i2,j1:j2,jk,Krhs_a) = ptab(i1:i2,j1:j2,jk,1) / ( zrhox * e1v(i1:i2,j1:j2) * e3v(i1:i2,j1:j2,jk,Krhs_a) )
          END DO
 # endif
@@ -1045,5 +958,5 @@
    END SUBROUTINE interpvn
 
-   SUBROUTINE interpunb( ptab, i1, i2, j1, j2, before, nb, ndir )
+   SUBROUTINE interpunb( ptab, i1, i2, j1, j2, before)
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE interpunb  ***
@@ -1052,18 +965,12 @@
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
       LOGICAL                         , INTENT(in   ) ::   before
-      INTEGER                         , INTENT(in   ) ::   nb , ndir
       !
       INTEGER  ::   ji, jj
       REAL(wp) ::   zrhoy, zrhot, zt0, zt1, ztcoeff
-      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
       !!----------------------------------------------------------------------  
       !
       IF( before ) THEN 
-         ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * hu_n(i1:i2,j1:j2) * un_b(i1:i2,j1:j2)
+         ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * hu(i1:i2,j1:j2,Kmm_a) * uu_b(i1:i2,j1:j2,Kmm_a)
       ELSE
-         western_side  = (nb == 1).AND.(ndir == 1)
-         eastern_side  = (nb == 1).AND.(ndir == 2)
-         southern_side = (nb == 2).AND.(ndir == 1)
-         northern_side = (nb == 2).AND.(ndir == 2)
          zrhoy = Agrif_Rhoy()
          zrhot = Agrif_rhot()
@@ -1071,32 +978,36 @@
          zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot
          zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot      
-         ! Polynomial interpolation coefficients:
-         IF( bdy_tinterp == 1 ) THEN
-            ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        &
-               &               - zt0**2._wp * (       zt0 - 1._wp)        )
-         ELSEIF( bdy_tinterp == 2 ) THEN
-            ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp &
-               &               - zt0        * (       zt0 - 1._wp)**2._wp )
-         ELSE
-            ztcoeff = 1
-         ENDIF
-         !   
-         IF(western_side)   ubdy_w(1:nbghostcells,j1:j2) = ubdy_w(1:nbghostcells,j1:j2) + ztcoeff * ptab(i1:i2,j1:j2)  
-         IF(eastern_side)   ubdy_e(1:nbghostcells,j1:j2) = ubdy_e(1:nbghostcells,j1:j2) + ztcoeff * ptab(i1:i2,j1:j2)  
-         IF(southern_side)  ubdy_s(i1:i2,1:nbghostcells) = ubdy_s(i1:i2,1:nbghostcells) + ztcoeff * ptab(i1:i2,j1:j2)
-         IF(northern_side)  ubdy_n(i1:i2,1:nbghostcells) = ubdy_n(i1:i2,1:nbghostcells) + ztcoeff * ptab(i1:i2,j1:j2) 
-         !            
-         IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN
-            IF(western_side)   ubdy_w(1:nbghostcells,j1:j2) = ubdy_w(1:nbghostcells,j1:j2) / (zrhoy*e2u(i1:i2,j1:j2)) * umask(i1:i2,j1:j2,1)
-            IF(eastern_side)   ubdy_e(1:nbghostcells,j1:j2) = ubdy_e(1:nbghostcells,j1:j2) / (zrhoy*e2u(i1:i2,j1:j2)) * umask(i1:i2,j1:j2,1)
-            IF(southern_side)  ubdy_s(i1:i2,1:nbghostcells) = ubdy_s(i1:i2,1:nbghostcells) / (zrhoy*e2u(i1:i2,j1:j2)) * umask(i1:i2,j1:j2,1)
-            IF(northern_side)  ubdy_n(i1:i2,1:nbghostcells) = ubdy_n(i1:i2,1:nbghostcells) / (zrhoy*e2u(i1:i2,j1:j2)) * umask(i1:i2,j1:j2,1)
-         ENDIF
-      ENDIF
+         ! 
+         DO ji = i1, i2
+            DO jj = j1, j2
+               IF ( utint_stage(ji,jj) < (bdy_tinterp + 1) ) THEN
+                  IF    ( utint_stage(ji,jj) == 1  ) THEN
+                     ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        &
+                        &               - zt0**2._wp * (       zt0 - 1._wp)        )
+                  ELSEIF( utint_stage(ji,jj) == 2  ) THEN
+                     ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp &
+                        &               - zt0        * (       zt0 - 1._wp)**2._wp )
+                  ELSEIF( utint_stage(ji,jj) == 0  ) THEN                
+                     ztcoeff = 1._wp
+                  ELSE
+                     ztcoeff = 0._wp
+                  ENDIF
+                  !   
+                  ubdy(ji,jj) = ubdy(ji,jj) + ztcoeff * ptab(ji,jj)
+                  !            
+                  IF (( utint_stage(ji,jj) == 2 ).OR.( utint_stage(ji,jj) == 0 )) THEN
+                     ubdy(ji,jj) = ubdy(ji,jj) / (zrhoy*e2u(ji,jj)) * umask(ji,jj,1)
+                  ENDIF
+                  !
+                  utint_stage(ji,jj) = utint_stage(ji,jj) + 1
+               ENDIF
+            END DO
+         END DO
+      END IF
       ! 
    END SUBROUTINE interpunb
 
 
-   SUBROUTINE interpvnb( ptab, i1, i2, j1, j2, before, nb, ndir )
+   SUBROUTINE interpvnb( ptab, i1, i2, j1, j2, before )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE interpvnb  ***
@@ -1105,44 +1016,43 @@
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
       LOGICAL                         , INTENT(in   ) ::   before
-      INTEGER                         , INTENT(in   ) ::   nb , ndir
-      !
-      INTEGER  ::   ji,jj
+      !
+      INTEGER  ::   ji, jj
       REAL(wp) ::   zrhox, zrhot, zt0, zt1, ztcoeff   
-      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
       !!----------------------------------------------------------------------  
       ! 
       IF( before ) THEN 
-         ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * hv_n(i1:i2,j1:j2) * vn_b(i1:i2,j1:j2)
+         ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * hv(i1:i2,j1:j2,Kmm_a) * vv_b(i1:i2,j1:j2,Kmm_a)
       ELSE
-         western_side  = (nb == 1).AND.(ndir == 1)
-         eastern_side  = (nb == 1).AND.(ndir == 2)
-         southern_side = (nb == 2).AND.(ndir == 1)
-         northern_side = (nb == 2).AND.(ndir == 2)
          zrhox = Agrif_Rhox()
          zrhot = Agrif_rhot()
          ! Time indexes bounds for integration
          zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot
-         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot      
-         IF( bdy_tinterp == 1 ) THEN
-            ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        &
-               &               - zt0**2._wp * (       zt0 - 1._wp)        )
-         ELSEIF( bdy_tinterp == 2 ) THEN
-            ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp &
-               &               - zt0        * (       zt0 - 1._wp)**2._wp ) 
-         ELSE
-            ztcoeff = 1
-         ENDIF
-         !! clem ghost
-         IF(western_side)   vbdy_w(1:nbghostcells,j1:j2) = vbdy_w(1:nbghostcells,j1:j2) + ztcoeff * ptab(i1:i2,j1:j2)  
-         IF(eastern_side)   vbdy_e(1:nbghostcells,j1:j2) = vbdy_e(1:nbghostcells,j1:j2) + ztcoeff * ptab(i1:i2,j1:j2)   
-         IF(southern_side)  vbdy_s(i1:i2,1:nbghostcells) = vbdy_s(i1:i2,1:nbghostcells) + ztcoeff * ptab(i1:i2,j1:j2)
-         IF(northern_side)  vbdy_n(i1:i2,1:nbghostcells) = vbdy_n(i1:i2,1:nbghostcells) + ztcoeff * ptab(i1:i2,j1:j2) 
-         !            
-         IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN
-            IF(western_side)   vbdy_w(1:nbghostcells,j1:j2) = vbdy_w(1:nbghostcells,j1:j2) / (zrhox*e1v(i1:i2,j1:j2)) * vmask(i1:i2,j1:j2,1)
-            IF(eastern_side)   vbdy_e(1:nbghostcells,j1:j2) = vbdy_e(1:nbghostcells,j1:j2) / (zrhox*e1v(i1:i2,j1:j2)) * vmask(i1:i2,j1:j2,1)
-            IF(southern_side)  vbdy_s(i1:i2,1:nbghostcells) = vbdy_s(i1:i2,1:nbghostcells) / (zrhox*e1v(i1:i2,j1:j2)) * vmask(i1:i2,j1:j2,1)
-            IF(northern_side)  vbdy_n(i1:i2,1:nbghostcells) = vbdy_n(i1:i2,1:nbghostcells) / (zrhox*e1v(i1:i2,j1:j2)) * vmask(i1:i2,j1:j2,1)
-         ENDIF
+         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot 
+         !     
+         DO ji = i1, i2
+            DO jj = j1, j2
+               IF ( vtint_stage(ji,jj) < (bdy_tinterp + 1) ) THEN
+                  IF    ( vtint_stage(ji,jj) == 1  ) THEN
+                     ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        &
+                        &               - zt0**2._wp * (       zt0 - 1._wp)        )
+                  ELSEIF( vtint_stage(ji,jj) == 2  ) THEN
+                     ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp &
+                        &               - zt0        * (       zt0 - 1._wp)**2._wp )
+                  ELSEIF( vtint_stage(ji,jj) == 0  ) THEN                
+                     ztcoeff = 1._wp
+                  ELSE
+                     ztcoeff = 0._wp
+                  ENDIF
+                  !   
+                  vbdy(ji,jj) = vbdy(ji,jj) + ztcoeff * ptab(ji,jj)
+                  !            
+                  IF (( vtint_stage(ji,jj) == 2 ).OR.( vtint_stage(ji,jj) == 0 )) THEN
+                     vbdy(ji,jj) = vbdy(ji,jj) / (zrhox*e1v(ji,jj)) * vmask(ji,jj,1)
+                  ENDIF
+                  !
+                  vtint_stage(ji,jj) = vtint_stage(ji,jj) + 1
+               ENDIF
+            END DO
+         END DO          
       ENDIF
       !
@@ -1150,5 +1060,5 @@
 
 
-   SUBROUTINE interpub2b( ptab, i1, i2, j1, j2, before, nb, ndir )
+   SUBROUTINE interpub2b( ptab, i1, i2, j1, j2, before )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE interpub2b  ***
@@ -1157,9 +1067,7 @@
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
       LOGICAL                         , INTENT(in   ) ::   before
-      INTEGER                         , INTENT(in   ) ::   nb , ndir
       !
       INTEGER  ::   ji,jj
-      REAL(wp) ::   zrhot, zt0, zt1,zat
-      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      REAL(wp) ::   zrhot, zt0, zt1, zat
       !!----------------------------------------------------------------------  
       IF( before ) THEN
@@ -1170,50 +1078,4 @@
          ENDIF
       ELSE
-         western_side  = (nb == 1).AND.(ndir == 1)
-         eastern_side  = (nb == 1).AND.(ndir == 2)
-         southern_side = (nb == 2).AND.(ndir == 1)
-         northern_side = (nb == 2).AND.(ndir == 2)
-         zrhot = Agrif_rhot()
-         ! Time indexes bounds for integration
-         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot
-         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot
-         ! Polynomial interpolation coefficients:
-         zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)    &
-            &           - zt0**2._wp * (-2._wp*zt0 + 3._wp)    ) 
-         !! clem ghost
-         IF(western_side ) ubdy_w(1:nbghostcells,j1:j2) = zat * ptab(i1:i2,j1:j2)  
-         IF(eastern_side ) ubdy_e(1:nbghostcells,j1:j2) = zat * ptab(i1:i2,j1:j2)  
-         IF(southern_side) ubdy_s(i1:i2,1:nbghostcells) = zat * ptab(i1:i2,j1:j2)
-         IF(northern_side) ubdy_n(i1:i2,1:nbghostcells) = zat * ptab(i1:i2,j1:j2) 
-      ENDIF
-      ! 
-   END SUBROUTINE interpub2b
-   
-
-   SUBROUTINE interpvb2b( ptab, i1, i2, j1, j2, before, nb, ndir )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interpvb2b  ***
-      !!----------------------------------------------------------------------  
-      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
-      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
-      LOGICAL                         , INTENT(in   ) ::   before
-      INTEGER                         , INTENT(in   ) ::   nb , ndir
-      !
-      INTEGER ::   ji,jj
-      REAL(wp) ::   zrhot, zt0, zt1,zat
-      LOGICAL ::   western_side, eastern_side,northern_side,southern_side
-      !!----------------------------------------------------------------------  
-      !
-      IF( before ) THEN
-         IF ( ln_bt_fw ) THEN
-            ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vb2_b(i1:i2,j1:j2)
-         ELSE
-            ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vn_adv(i1:i2,j1:j2)
-         ENDIF
-      ELSE      
-         western_side  = (nb == 1).AND.(ndir == 1)
-         eastern_side  = (nb == 1).AND.(ndir == 2)
-         southern_side = (nb == 2).AND.(ndir == 1)
-         northern_side = (nb == 2).AND.(ndir == 2)
          zrhot = Agrif_rhot()
          ! Time indexes bounds for integration
@@ -1224,8 +1086,44 @@
             &           - zt0**2._wp * (-2._wp*zt0 + 3._wp)    ) 
          !
-         IF(western_side )   vbdy_w(1:nbghostcells,j1:j2) = zat * ptab(i1:i2,j1:j2)  
-         IF(eastern_side )   vbdy_e(1:nbghostcells,j1:j2) = zat * ptab(i1:i2,j1:j2)  
-         IF(southern_side)   vbdy_s(i1:i2,1:nbghostcells) = zat * ptab(i1:i2,j1:j2)
-         IF(northern_side)   vbdy_n(i1:i2,1:nbghostcells) = zat * ptab(i1:i2,j1:j2) 
+         ubdy(i1:i2,j1:j2) = zat * ptab(i1:i2,j1:j2) 
+         !
+         ! Update interpolation stage:
+         utint_stage(i1:i2,j1:j2) = 1
+      ENDIF
+      ! 
+   END SUBROUTINE interpub2b
+   
+
+   SUBROUTINE interpvb2b( ptab, i1, i2, j1, j2, before )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpvb2b  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      !
+      INTEGER ::   ji,jj
+      REAL(wp) ::   zrhot, zt0, zt1, zat
+      !!----------------------------------------------------------------------  
+      !
+      IF( before ) THEN
+         IF ( ln_bt_fw ) THEN
+            ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vb2_b(i1:i2,j1:j2)
+         ELSE
+            ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vn_adv(i1:i2,j1:j2)
+         ENDIF
+      ELSE      
+         zrhot = Agrif_rhot()
+         ! Time indexes bounds for integration
+         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot
+         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot
+         ! Polynomial interpolation coefficients:
+         zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)    &
+            &           - zt0**2._wp * (-2._wp*zt0 + 3._wp)    ) 
+         !
+         vbdy(i1:i2,j1:j2) = zat * ptab(i1:i2,j1:j2)
+         !
+         ! update interpolation stage:
+         vtint_stage(i1:i2,j1:j2) = 1
       ENDIF
       !      
@@ -1233,5 +1131,5 @@
 
 
-   SUBROUTINE interpe3t( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir )
+   SUBROUTINE interpe3t( ptab, i1, i2, j1, j2, k1, k2, before )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE interpe3t  ***
@@ -1240,8 +1138,6 @@
       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
       LOGICAL                              , INTENT(in   ) :: before
-      INTEGER                              , INTENT(in   ) :: nb , ndir
       !
       INTEGER :: ji, jj, jk
-      LOGICAL :: western_side, eastern_side, northern_side, southern_side
       !!----------------------------------------------------------------------  
       !    
@@ -1249,31 +1145,13 @@
          ptab(i1:i2,j1:j2,k1:k2) = tmask(i1:i2,j1:j2,k1:k2) * e3t_0(i1:i2,j1:j2,k1:k2)
       ELSE
-         western_side  = (nb == 1).AND.(ndir == 1)
-         eastern_side  = (nb == 1).AND.(ndir == 2)
-         southern_side = (nb == 2).AND.(ndir == 1)
-         northern_side = (nb == 2).AND.(ndir == 2)
          !
          DO jk = k1, k2
             DO jj = j1, j2
                DO ji = i1, i2
-                  !
                   IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) ) > 1.D-2) THEN
-                     IF (western_side.AND.(ptab(i1+nbghostcells-1,jj,jk)>0._wp)) THEN
-                        WRITE(numout,*) 'ERROR bathymetry merge at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
-                        WRITE(numout,*)  ptab(ji,jj,jk), e3t_0(ji,jj,jk) 
-                        kindic_agr = kindic_agr + 1
-                     ELSEIF (eastern_side.AND.(ptab(i2-nbghostcells+1,jj,jk)>0._wp)) THEN
-                        WRITE(numout,*) 'ERROR bathymetry merge at the eastern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
-                        WRITE(numout,*)  ptab(ji,jj,jk), e3t_0(ji,jj,jk)
-                        kindic_agr = kindic_agr + 1
-                     ELSEIF (southern_side.AND.(ptab(ji,j1+nbghostcells-1,jk)>0._wp)) THEN
-                        WRITE(numout,*) 'ERROR bathymetry merge at the southern border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk
-                        WRITE(numout,*)  ptab(ji,jj,jk), e3t_0(ji,jj,jk)
-                        kindic_agr = kindic_agr + 1
-                     ELSEIF (northern_side.AND.(ptab(ji,j2-nbghostcells+1,jk)>0._wp)) THEN
-                        WRITE(numout,*) 'ERROR bathymetry merge at the northen border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk
-                        WRITE(numout,*)  ptab(ji,jj,jk), e3t_0(ji,jj,jk)
-                        kindic_agr = kindic_agr + 1
-                     ENDIF
+                     WRITE(numout,*) ' Agrif error for e3t_0: parent , child, i, j, k ',  & 
+                     &                 ptab(ji,jj,jk), tmask(ji,jj,jk) * e3t_0(ji,jj,jk), &
+                     &                 ji+nimpp-1, jj+njmpp-1, jk
+                     kindic_agr = kindic_agr + 1
                   ENDIF
                END DO
@@ -1284,88 +1162,4 @@
       ! 
    END SUBROUTINE interpe3t
-
-
-   SUBROUTINE interpumsk( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interpumsk  ***
-      !!----------------------------------------------------------------------  
-      INTEGER                              , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2
-      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab
-      LOGICAL                              , INTENT(in   ) ::   before
-      INTEGER                              , INTENT(in   ) ::   nb , ndir
-      !
-      INTEGER ::   ji, jj, jk
-      LOGICAL ::   western_side, eastern_side   
-      !!----------------------------------------------------------------------  
-      !    
-      IF( before ) THEN
-         ptab(i1:i2,j1:j2,k1:k2) = umask(i1:i2,j1:j2,k1:k2)
-      ELSE
-         western_side = (nb == 1).AND.(ndir == 1)
-         eastern_side = (nb == 1).AND.(ndir == 2)
-         DO jk = k1, k2
-            DO jj = j1, j2
-               DO ji = i1, i2
-                   ! Velocity mask at boundary edge points:
-                  IF (ABS(ptab(ji,jj,jk) - umask(ji,jj,jk)) > 1.D-2) THEN
-                     IF (western_side) THEN
-                        WRITE(numout,*) 'ERROR with umask at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
-                        WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), umask(ji,jj,jk)
-                        kindic_agr = kindic_agr + 1
-                     ELSEIF (eastern_side) THEN
-                        WRITE(numout,*) 'ERROR with umask at the eastern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
-                        WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), umask(ji,jj,jk)
-                        kindic_agr = kindic_agr + 1
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         END DO
-         !
-      ENDIF
-      ! 
-   END SUBROUTINE interpumsk
-
-
-   SUBROUTINE interpvmsk( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interpvmsk  ***
-      !!----------------------------------------------------------------------  
-      INTEGER                              , INTENT(in   ) ::   i1,i2,j1,j2,k1,k2
-      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab
-      LOGICAL                              , INTENT(in   ) ::   before
-      INTEGER                              , INTENT(in   ) :: nb , ndir
-      !
-      INTEGER ::   ji, jj, jk
-      LOGICAL ::   northern_side, southern_side     
-      !!----------------------------------------------------------------------  
-      !    
-      IF( before ) THEN
-         ptab(i1:i2,j1:j2,k1:k2) = vmask(i1:i2,j1:j2,k1:k2)
-      ELSE
-         southern_side = (nb == 2).AND.(ndir == 1)
-         northern_side = (nb == 2).AND.(ndir == 2)
-         DO jk = k1, k2
-            DO jj = j1, j2
-               DO ji = i1, i2
-                   ! Velocity mask at boundary edge points:
-                  IF (ABS(ptab(ji,jj,jk) - vmask(ji,jj,jk)) > 1.D-2) THEN
-                     IF (southern_side) THEN
-                        WRITE(numout,*) 'ERROR with vmask at the southern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
-                        WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), vmask(ji,jj,jk)
-                        kindic_agr = kindic_agr + 1
-                     ELSEIF (northern_side) THEN
-                        WRITE(numout,*) 'ERROR with vmask at the northern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
-                        WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), vmask(ji,jj,jk)
-                        kindic_agr = kindic_agr + 1
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         END DO
-         !
-      ENDIF
-      ! 
-   END SUBROUTINE interpvmsk
 
 
@@ -1377,7 +1171,9 @@
       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,m1:m2), INTENT(inout) ::   ptab
       LOGICAL                                    , INTENT(in   ) ::   before
-      REAL(wp), DIMENSION(k1:k2) :: tabin, h_in
-      REAL(wp), DIMENSION(1:jpk) :: h_out
-      INTEGER  :: N_in, N_out, ji, jj, jk
+      !
+      INTEGER  :: ji, jj, jk
+      INTEGER  :: N_in, N_out
+      REAL(wp), DIMENSION(k1:k2) :: tabin, z_in
+      REAL(wp), DIMENSION(1:jpk) :: z_out
       !!----------------------------------------------------------------------  
       !      
@@ -1390,33 +1186,54 @@
            END DO
         END DO
-#ifdef key_vertical         
+
+# if defined key_vertical
+        ! Interpolate thicknesses
+        ! Warning: these are masked, hence extrapolated prior interpolation.
         DO jk=k1,k2
            DO jj=j1,j2
               DO ji=i1,i2
-                 ptab(ji,jj,jk,2) = wmask(ji,jj,jk) * e3w_n(ji,jj,jk) 
+                  ptab(ji,jj,jk,2) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a)
               END DO
            END DO
         END DO
-#endif
+
+        ! Extrapolate thicknesses in partial bottom cells:
+        ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on
+        IF (ln_zps) THEN
+           DO jj=j1,j2
+              DO ji=i1,i2
+                  jk = mbkt(ji,jj)
+                  ptab(ji,jj,jk,2) = 0._wp
+              END DO
+           END DO           
+        END IF
+     
+        ! Save ssh at last level:
+        IF (.NOT.ln_linssh) THEN
+           ptab(i1:i2,j1:j2,k2,2) = ssh(i1:i2,j1:j2,Kmm_a)*tmask(i1:i2,j1:j2,1) 
+        ELSE
+           ptab(i1:i2,j1:j2,k2,2) = 0._wp
+        END IF      
+# endif
       ELSE 
 #ifdef key_vertical         
-         avm_k(i1:i2,j1:j2,1:jpk) = 0.
-         DO jj=j1,j2
-            DO ji=i1,i2
-               N_in = 0
-               DO jk=k1,k2 !k2 = jpk of parent grid
-                  IF (ptab(ji,jj,jk,2) == 0) EXIT
-                  N_in = N_in + 1
-                  tabin(jk) = ptab(ji,jj,jk,1)
-                  h_in(N_in) = ptab(ji,jj,jk,2)
-               END DO
-               N_out = 0
-               DO jk=1,jpk ! jpk of child grid
-                  IF (wmask(ji,jj,jk) == 0) EXIT 
-                  N_out = N_out + 1
-                  h_out(jk) = e3t_n(ji,jj,jk)
+         IF (ln_linssh) ptab(i1:i2,j1:j2,k2,2) = 0._wp 
+         avm_k(i1:i2,j1:j2,k1:k2) = 0._wp
+            
+         DO jj = j1, j2
+            DO ji =i1, i2
+               N_in = mbkt_parent(ji,jj)
+               IF ( tmask(ji,jj,1) == 0._wp) N_in = 0
+               z_in(N_in+1) = ht0_parent(ji,jj) + ptab(ji,jj,k2,2)
+               DO jk = N_in, 1, -1  ! Parent vertical grid               
+                     z_in(jk) = z_in(jk+1) - ptab(ji,jj,jk,2)
+                    tabin(jk) = ptab(ji,jj,jk,1)
+               END DO
+               N_out = mbkt(ji,jj) 
+               DO jk = 1, N_out        ! Child vertical grid
+                  z_out(jk) = gdepw(ji,jj,jk,Kmm_a)
                ENDDO
-               IF (N_in > 0) THEN
-                  CALL reconstructandremap(tabin(1:N_in),h_in,avm_k(ji,jj,1:N_out),h_out,N_in,N_out)
+               IF (N_in*N_out > 0) THEN
+                  CALL remap_linear(tabin(1:N_in),z_in(1:N_in),avm_k(ji,jj,1:N_out),z_out(1:N_out),N_in,N_out,1)
                ENDIF
             ENDDO
@@ -1428,4 +1245,42 @@
       !
    END SUBROUTINE interpavm
+
+# if defined key_vertical
+   SUBROUTINE interpmbkt( ptab, i1, i2, j1, j2, before )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      !
+      !!----------------------------------------------------------------------  
+      !
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = REAL(mbkt(i1:i2,j1:j2),wp)
+      ELSE
+         mbkt_parent(i1:i2,j1:j2) = NINT(ptab(i1:i2,j1:j2))
+      ENDIF
+      !
+   END SUBROUTINE interpmbkt
+
+   SUBROUTINE interpht0( ptab, i1, i2, j1, j2, before )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      !
+      !!----------------------------------------------------------------------  
+      !
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = ht_0(i1:i2,j1:j2)
+      ELSE
+         ht0_parent(i1:i2,j1:j2) = ptab(i1:i2,j1:j2)
+      ENDIF
+      !
+   END SUBROUTINE interpht0
+#endif
 
 #else
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_oce_sponge.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_oce_sponge.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_oce_sponge.F90	(revision 12928)
@@ -22,4 +22,6 @@
    USE agrif_oce
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE iom
+   USE vremap
 
    IMPLICIT NONE
@@ -29,4 +31,6 @@
    PUBLIC interptsn_sponge, interpun_sponge, interpvn_sponge
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/NST 4.0 , NEMO Consortium (2018)
@@ -58,4 +62,7 @@
 #endif
       !
+      CALL iom_put( 'agrif_spu', fspu(:,:))
+      CALL iom_put( 'agrif_spv', fspv(:,:))
+      !
    END SUBROUTINE Agrif_Sponge_Tra
 
@@ -85,4 +92,7 @@
 #endif
       !
+      CALL iom_put( 'agrif_spt', fspt(:,:))
+      CALL iom_put( 'agrif_spf', fspf(:,:))
+      !
    END SUBROUTINE Agrif_Sponge_dyn
 
@@ -93,62 +103,163 @@
       !!----------------------------------------------------------------------
       INTEGER  ::   ji, jj, ind1, ind2
-      INTEGER  ::   ispongearea
-      REAL(wp) ::   z1_spongearea
+      INTEGER  ::   ispongearea, jspongearea
+      REAL(wp) ::   z1_ispongearea, z1_jspongearea
       REAL(wp), DIMENSION(jpi,jpj) :: ztabramp
-      !!----------------------------------------------------------------------
-      !
+      REAL(wp), DIMENSION(jpjmax)  :: zmskwest,  zmskeast
+      REAL(wp), DIMENSION(jpimax)  :: zmsknorth, zmsksouth
+      !!----------------------------------------------------------------------
+      !
+      ! Sponge 1d example with:
+      !      iraf = 3 ; nbghost = 3 ; nn_sponge_len = 2
+      !                        
+      !coarse :     U     T     U     T     U     T     U
+      !|            |           |           |           |
+      !fine :     t u t u t u t u t u t u t u t u t u t u t
+      !sponge val:0   0   0   1  5/6 4/6 3/6 2/6 1/6  0   0
+      !           |   ghost     | <-- sponge area  -- > |
+      !           |   points    |                       |
+      !                         |--> dynamical interface
+
 #if defined SPONGE || defined SPONGE_TOP
       IF (( .NOT. spongedoneT ).OR.( .NOT. spongedoneU )) THEN
+         !
+         ! Retrieve masks at open boundaries:
+
+         ! --- West --- !
+         ztabramp(:,:) = 0._wp
+         ind1 = 1+nbghostcells
+         DO ji = mi0(ind1), mi1(ind1)                
+            ztabramp(ji,:) = ssumask(ji,:)
+         END DO
+         !
+         zmskwest(:) = 0._wp
+         zmskwest(1:jpj) = MAXVAL(ztabramp(:,:), dim=1)
+
+         ! --- East --- !
+         ztabramp(:,:) = 0._wp
+         ind1 = jpiglo - nbghostcells - 1
+         DO ji = mi0(ind1), mi1(ind1)                 
+            ztabramp(ji,:) = ssumask(ji,:)
+         END DO
+         !
+         zmskeast(:) = 0._wp
+         zmskeast(1:jpj) = MAXVAL(ztabramp(:,:), dim=1)
+
+         ! --- South --- !
+         ztabramp(:,:) = 0._wp
+         ind1 = 1+nbghostcells
+         DO jj = mj0(ind1), mj1(ind1)                 
+            ztabramp(:,jj) = ssvmask(:,jj)
+         END DO
+         !
+         zmsksouth(:) = 0._wp
+         zmsksouth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2)
+
+         ! --- North --- !
+         ztabramp(:,:) = 0._wp
+         ind1 = jpjglo - nbghostcells - 1
+         DO jj = mj0(ind1), mj1(ind1)                 
+            ztabramp(:,jj) = ssvmask(:,jj)
+         END DO
+         !
+         zmsknorth(:) = 0._wp
+         zmsknorth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2)
+         ! JC: SPONGE MASKING TO BE SORTED OUT:
+         zmskwest(:)  = 1._wp
+         zmskeast(:)  = 1._wp
+         zmsknorth(:) = 1._wp
+         zmsksouth(:) = 1._wp
+#if defined key_mpp_mpi
+!         CALL mpp_max( 'AGRIF_sponge', zmskwest(:) , jpjmax )
+!         CALL mpp_max( 'AGRIF_Sponge', zmskeast(:) , jpjmax )
+!         CALL mpp_max( 'AGRIF_Sponge', zmsksouth(:), jpimax )
+!         CALL mpp_max( 'AGRIF_Sponge', zmsknorth(:), jpimax )
+#endif
+
          ! Define ramp from boundaries towards domain interior at T-points
          ! Store it in ztabramp
 
-         ispongearea  = 1 + nn_sponge_len * Agrif_irhox()
-         z1_spongearea = 1._wp / REAL( ispongearea )
+         ispongearea  = nn_sponge_len * Agrif_irhox()
+         z1_ispongearea = 1._wp / REAL( ispongearea )
+         jspongearea  = nn_sponge_len * Agrif_irhoy()
+         z1_jspongearea = 1._wp / REAL( jspongearea )
          
          ztabramp(:,:) = 0._wp
 
+         ! Trick to remove sponge in 2DV domains:
+         IF ( nbcellsx <= 3 ) ispongearea = -1
+         IF ( nbcellsy <= 3 ) jspongearea = -1
+
          ! --- West --- !
-         IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN
-            ind1 = 1+nbghostcells
-            ind2 = 1+nbghostcells + ispongearea 
+         ind1 = 1+nbghostcells
+         ind2 = 1+nbghostcells + ispongearea 
+         DO ji = mi0(ind1), mi1(ind2)   
+            DO jj = 1, jpj               
+               ztabramp(ji,jj) = REAL( ind2 - mig(ji) ) * z1_ispongearea * zmskwest(jj)
+            END DO
+         END DO
+
+         ! ghost cells:
+         ind1 = 1
+         ind2 = nbghostcells + 1
+         DO ji = mi0(ind1), mi1(ind2)   
+            DO jj = 1, jpj               
+               ztabramp(ji,jj) = zmskwest(jj)
+            END DO
+         END DO
+
+         ! --- East --- !
+         ind1 = jpiglo - nbghostcells - ispongearea
+         ind2 = jpiglo - nbghostcells
+         DO ji = mi0(ind1), mi1(ind2)
             DO jj = 1, jpj
-               DO ji = ind1, ind2                
-                  ztabramp(ji,jj) = REAL( ind2 - ji ) * z1_spongearea * umask(ind1,jj,1)
-               END DO
+               ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mig(ji) - ind1 ) * z1_ispongearea) * zmskeast(jj)
             ENDDO
-         ENDIF
-
-         ! --- East --- !
-         IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN
-            ind1 = nlci - nbghostcells - ispongearea
-            ind2 = nlci - nbghostcells
+         END DO
+
+         ! ghost cells:
+         ind1 = jpiglo - nbghostcells
+         ind2 = jpiglo
+         DO ji = mi0(ind1), mi1(ind2)
             DO jj = 1, jpj
-               DO ji = ind1, ind2
-                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ji - ind1 ) * z1_spongearea * umask(ind2-1,jj,1) )
-               ENDDO
+               ztabramp(ji,jj) = zmskeast(jj)
             ENDDO
-         ENDIF
+         END DO
 
          ! --- South --- !
-         IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN
-            ind1 = 1+nbghostcells
-            ind2 = 1+nbghostcells + ispongearea
-            DO jj = ind1, ind2 
-               DO ji = 1, jpi
-                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - jj ) * z1_spongearea * vmask(ji,ind1,1) )
-               END DO
-            ENDDO
-         ENDIF
+         ind1 = 1+nbghostcells
+         ind2 = 1+nbghostcells + jspongearea
+         DO jj = mj0(ind1), mj1(ind2) 
+            DO ji = 1, jpi
+               ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - mjg(jj) ) * z1_jspongearea) * zmsksouth(ji)
+            END DO
+         END DO
+
+         ! ghost cells:
+         ind1 = 1
+         ind2 = nbghostcells + 1
+         DO jj = mj0(ind1), mj1(ind2) 
+            DO ji = 1, jpi
+               ztabramp(ji,jj) = zmsksouth(ji)
+            END DO
+         END DO
 
          ! --- North --- !
-         IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN
-            ind1 = nlcj - nbghostcells - ispongearea
-            ind2 = nlcj - nbghostcells
-            DO jj = ind1, ind2
-               DO ji = 1, jpi
-                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( jj - ind1 ) * z1_spongearea * vmask(ji,ind2-1,1) )
-               END DO
-            ENDDO
-         ENDIF
+         ind1 = jpjglo - nbghostcells - jspongearea
+         ind2 = jpjglo - nbghostcells
+         DO jj = mj0(ind1), mj1(ind2)
+            DO ji = 1, jpi
+               ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mjg(jj) - ind1 ) * z1_jspongearea) * zmsknorth(ji)
+            END DO
+         END DO
+
+         ! ghost cells:
+         ind1 = jpjglo - nbghostcells
+         ind2 = jpjglo
+         DO jj = mj0(ind1), mj1(ind2)
+            DO ji = 1, jpi
+               ztabramp(ji,jj) = zmsknorth(ji)
+            END DO
+         END DO
 
       ENDIF
@@ -156,15 +267,13 @@
       ! Tracers
       IF( .NOT. spongedoneT ) THEN
-         fsaht_spu(:,:) = 0._wp
-         fsaht_spv(:,:) = 0._wp
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1   ! vector opt.
-               fsaht_spu(ji,jj) = 0.5_wp * visc_tra * ( ztabramp(ji,jj) + ztabramp(ji+1,jj  ) )
-               fsaht_spv(ji,jj) = 0.5_wp * visc_tra * ( ztabramp(ji,jj) + ztabramp(ji  ,jj+1) )
-            END DO
-         END DO
-         CALL lbc_lnk( 'agrif_oce_sponge', fsaht_spu, 'U', 1. )   ! Lateral boundary conditions
-         CALL lbc_lnk( 'agrif_oce_sponge', fsaht_spv, 'V', 1. )
-         
+         fspu(:,:) = 0._wp
+         fspv(:,:) = 0._wp
+         DO_2D_00_00
+            fspu(ji,jj) = 0.5_wp * ( ztabramp(ji,jj) + ztabramp(ji+1,jj  ) ) * ssumask(ji,jj)
+            fspv(ji,jj) = 0.5_wp * ( ztabramp(ji,jj) + ztabramp(ji  ,jj+1) ) * ssvmask(ji,jj)
+         END_2D
+         CALL lbc_lnk( 'agrif_Sponge', fspu, 'U', 1. )   ! Lateral boundary conditions
+         CALL lbc_lnk( 'agrif_Sponge', fspv, 'V', 1. )
+
          spongedoneT = .TRUE.
       ENDIF
@@ -172,18 +281,42 @@
       ! Dynamics
       IF( .NOT. spongedoneU ) THEN
-         fsahm_spt(:,:) = 0._wp
-         fsahm_spf(:,:) = 0._wp
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1   ! vector opt.
-               fsahm_spt(ji,jj) = visc_dyn * ztabramp(ji,jj)
-               fsahm_spf(ji,jj) = 0.25_wp * visc_dyn * ( ztabramp(ji  ,jj  ) + ztabramp(ji  ,jj+1) &
-                                                     &  +ztabramp(ji+1,jj+1) + ztabramp(ji+1,jj  ) )
-            END DO
-         END DO
-         CALL lbc_lnk( 'agrif_oce_sponge', fsahm_spt, 'T', 1. )   ! Lateral boundary conditions
-         CALL lbc_lnk( 'agrif_oce_sponge', fsahm_spf, 'F', 1. )
+         fspt(:,:) = 0._wp
+         fspf(:,:) = 0._wp
+         DO_2D_00_00
+            fspt(ji,jj) = ztabramp(ji,jj) * ssmask(ji,jj)
+            fspf(ji,jj) = 0.25_wp * ( ztabramp(ji  ,jj  ) + ztabramp(ji  ,jj+1)   &
+                                  &  +ztabramp(ji+1,jj+1) + ztabramp(ji+1,jj  ) ) &
+                                  &  * ssvmask(ji,jj) * ssvmask(ji,jj+1)
+         END_2D
+         CALL lbc_lnk( 'agrif_Sponge', fspt, 'T', 1. )   ! Lateral boundary conditions
+         CALL lbc_lnk( 'agrif_Sponge', fspf, 'F', 1. )
          
          spongedoneU = .TRUE.
       ENDIF
+
+#if defined key_vertical
+      ! Remove vertical interpolation where not needed:
+      DO_2D_00_00
+         IF ((fspu(ji-1,jj)==0._wp).AND.(fspu(ji,jj)==0._wp).AND. &
+         &   (fspv(ji,jj-1)==0._wp).AND.(fspv(ji,jj)==0._wp)) mbkt_parent(ji,jj) = 0
+!
+         IF ((fspt(ji+1,jj)==0._wp).AND.(fspt(ji,jj)==0._wp).AND. &
+         &   (fspf(ji,jj-1)==0._wp).AND.(fspf(ji,jj)==0._wp)) mbku_parent(ji,jj) = 0
+!
+         IF ((fspt(ji,jj+1)==0._wp).AND.(fspt(ji,jj)==0._wp).AND. &
+         &   (fspf(ji-1,jj)==0._wp).AND.(fspf(ji,jj)==0._wp)) mbkv_parent(ji,jj) = 0
+!
+         IF ( ssmask(ji,jj) == 0._wp) mbkt_parent(ji,jj) = 0
+         IF (ssumask(ji,jj) == 0._wp) mbku_parent(ji,jj) = 0
+         IF (ssvmask(ji,jj) == 0._wp) mbkv_parent(ji,jj) = 0
+      END_2D
+      !
+      ztabramp(:,:) = REAL( mbkt_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_Sponge', ztabramp, 'T', 1. )
+      mbkt_parent(:,:) = NINT( ztabramp(:,:) )
+      ztabramp(:,:) = REAL( mbku_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_Sponge', ztabramp, 'U', 1. )
+      mbku_parent(:,:) = NINT( ztabramp(:,:) )
+      ztabramp(:,:) = REAL( mbkv_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_Sponge', ztabramp, 'V', 1. )
+      mbkv_parent(:,:) = NINT( ztabramp(:,:) )
+#endif
       !
 #endif
@@ -201,5 +334,5 @@
       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
       INTEGER  ::   iku, ikv
-      REAL(wp) :: ztsa, zabe1, zabe2, zbtr
+      REAL(wp) :: ztsa, zabe1, zabe2, zbtr, zhtot, ztrelax
       REAL(wp), DIMENSION(i1:i2,j1:j2,jpk) :: ztu, ztv
       REAL(wp), DIMENSION(i1:i2,j1:j2,jpk,n1:n2) ::tsbdiff
@@ -210,5 +343,4 @@
       REAL(wp), DIMENSION(1:jpk) :: h_out
       INTEGER :: N_in, N_out
-      REAL(wp) :: h_diff
       !!----------------------------------------------------------------------
       !
@@ -218,5 +350,5 @@
                DO jj=j1,j2
                   DO ji=i1,i2
-                     tabres(ji,jj,jk,jn) = tsb(ji,jj,jk,jn)
+                     tabres(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kbb_a)
                   END DO
                END DO
@@ -225,11 +357,31 @@
 
 # if defined key_vertical
-         DO jk=k1,k2
-            DO jj=j1,j2
-               DO ji=i1,i2
-                  tabres(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t_n(ji,jj,jk) 
-               END DO
-            END DO
-         END DO
+        ! Interpolate thicknesses
+        ! Warning: these are masked, hence extrapolated prior interpolation.
+        DO jk=k1,k2
+           DO jj=j1,j2
+              DO ji=i1,i2
+                  tabres(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kbb_a)
+              END DO
+           END DO
+        END DO
+
+        ! Extrapolate thicknesses in partial bottom cells:
+        ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on
+        IF (ln_zps) THEN
+           DO jj=j1,j2
+              DO ji=i1,i2
+                  jk = mbkt(ji,jj)
+                  tabres(ji,jj,jk,jpts+1) = 0._wp
+              END DO
+           END DO           
+        END IF
+     
+        ! Save ssh at last level:
+        IF (.NOT.ln_linssh) THEN
+           tabres(i1:i2,j1:j2,k2,jpts+1) = ssh(i1:i2,j1:j2,Kbb_a)*tmask(i1:i2,j1:j2,1) 
+        ELSE
+           tabres(i1:i2,j1:j2,k2,jpts+1) = 0._wp
+        END IF      
 # endif
 
@@ -237,13 +389,20 @@
          !
 # if defined key_vertical
-         tabres_child(:,:,:,:) = 0.
+
+         IF (ln_linssh) tabres(i1:i2,j1:j2,k2,n2) = 0._wp
+
          DO jj=j1,j2
             DO ji=i1,i2
-               N_in = 0
-               DO jk=k1,k2 !k2 = jpk of parent grid
-                  IF (tabres(ji,jj,jk,n2) == 0) EXIT
-                  N_in = N_in + 1
+               tabres_child(ji,jj,:,:) = 0._wp 
+               N_in = mbkt_parent(ji,jj)
+               zhtot = 0._wp
+               DO jk=1,N_in !k2 = jpk of parent grid
+                  IF (jk==N_in) THEN
+                     h_in(jk) = ht0_parent(ji,jj) + tabres(ji,jj,k2,n2) - zhtot
+                  ELSE
+                     h_in(jk) = tabres(ji,jj,jk,n2)
+                  ENDIF
+                  zhtot = zhtot + h_in(jk)
                   tabin(jk,:) = tabres(ji,jj,jk,n1:n2-1)
-                  h_in(N_in) = tabres(ji,jj,jk,n2)
                END DO
                N_out = 0
@@ -251,12 +410,15 @@
                   IF (tmask(ji,jj,jk) == 0) EXIT 
                   N_out = N_out + 1
-                  h_out(jk) = e3t_n(ji,jj,jk) !Child grid scale factors. Could multiply by e1e2t here instead of division above
+                  h_out(jk) = e3t(ji,jj,jk,Kbb_a) !Child grid scale factors. Could multiply by e1e2t here instead of division above
                ENDDO
-               IF (N_in > 0) THEN
-                  h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in))
-                  tabres(ji,jj,k2,:) = tabres(ji,jj,k2-1,:) !what is this line for?????
-                  DO jn=1,jpts
-                     call reconstructandremap(tabin(1:N_in,jn),h_in,tabres_child(ji,jj,1:N_out,jn),h_out,N_in,N_out)
-                  ENDDO
+
+               ! Account for small differences in free-surface
+               IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN
+                  h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) )
+               ELSE
+                  h_in(1)   = h_in(1)   - (sum(h_in(1:N_in))-sum(h_out(1:N_out)) )
+               ENDIF
+               IF (N_in*N_out > 0) THEN
+                  CALL reconstructandremap(tabin(1:N_in,1:jpts),h_in(1:N_in),tabres_child(ji,jj,1:N_out,1:jpts),h_out(1:N_out),N_in,N_out,jpts)
                ENDIF
             ENDDO
@@ -268,11 +430,16 @@
                DO jk=1,jpkm1
 # if defined key_vertical
-                  tsbdiff(ji,jj,jk,1:jpts) = tsb(ji,jj,jk,1:jpts) - tabres_child(ji,jj,jk,1:jpts)
+                  tsbdiff(ji,jj,jk,1:jpts) = (ts(ji,jj,jk,1:jpts,Kbb_a) - tabres_child(ji,jj,jk,1:jpts)) * tmask(ji,jj,jk)
 # else
-                  tsbdiff(ji,jj,jk,1:jpts) = tsb(ji,jj,jk,1:jpts) - tabres(ji,jj,jk,1:jpts)
+                  tsbdiff(ji,jj,jk,1:jpts) = (ts(ji,jj,jk,1:jpts,Kbb_a) - tabres(ji,jj,jk,1:jpts))*tmask(ji,jj,jk)
 # endif
                ENDDO
             ENDDO
          ENDDO
+
+         !* set relaxation time scale
+         IF( l_1st_euler .AND. lk_agrif_fstep ) THEN   ;   ztrelax =   rn_trelax_tra  / (        rn_Dt )
+         ELSE                                          ;   ztrelax =   rn_trelax_tra  / (2._wp * rn_Dt )
+         ENDIF
 
          DO jn = 1, jpts            
@@ -281,5 +448,5 @@
                DO jj = j1,j2
                   DO ji = i1,i2-1
-                     zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk)
+                     zabe1 = rn_sponge_tra * fspu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm_a)
                      ztu(ji,jj,jk) = zabe1 * ( tsbdiff(ji+1,jj  ,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 
                   END DO
@@ -288,5 +455,5 @@
                DO ji = i1,i2
                   DO jj = j1,j2-1
-                     zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk)
+                     zabe2 = rn_sponge_tra * fspv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm_a)
                      ztv(ji,jj,jk) = zabe2 * ( tsbdiff(ji  ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) )
                   END DO
@@ -310,9 +477,10 @@
                   DO ji = i1+1,i2-1
                      IF (.NOT. tabspongedone_tsn(ji,jj)) THEN 
-                        zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+                        zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm_a)
                         ! horizontal diffusive trends
-                        ztsa = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  )
+                        ztsa = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) &
+                             &  - ztrelax * fspt(ji,jj) * tsbdiff(ji,jj,jk,jn) 
                         ! add it to the general tracer trends
-                        tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + ztsa
+                        ts(ji,jj,jk,jn,Krhs_a) = ts(ji,jj,jk,jn,Krhs_a) + ztsa
                      ENDIF
                   END DO
@@ -339,5 +507,5 @@
 
       ! sponge parameters 
-      REAL(wp) :: ze2u, ze1v, zua, zva, zbtr, h_diff
+      REAL(wp) :: ze2u, ze1v, zua, zva, zbtr, zhtot, ztrelax
       REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: ubdiff
       REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: rotdiff, hdivdiff
@@ -346,14 +514,14 @@
       REAL(wp), DIMENSION(k1:k2) :: tabin, h_in
       REAL(wp), DIMENSION(1:jpk) :: h_out
-      INTEGER ::N_in,N_out
+      INTEGER ::N_in, N_out
       !!---------------------------------------------    
       !
       IF( before ) THEN
-         DO jk=1,jpkm1
+         DO jk=k1,k2
             DO jj=j1,j2
                DO ji=i1,i2
-                  tabres(ji,jj,jk,m1) = ub(ji,jj,jk)
+                  tabres(ji,jj,jk,m1) = uu(ji,jj,jk,Kbb_a)
 # if defined key_vertical
-                  tabres(ji,jj,jk,m2) = e3u_n(ji,jj,jk)*umask(ji,jj,jk)
+                  tabres(ji,jj,jk,m2) = e3u(ji,jj,jk,Kbb_a)*umask(ji,jj,jk)
 # endif
                END DO
@@ -361,50 +529,74 @@
          END DO
 
+# if defined key_vertical
+         ! Extrapolate thicknesses in partial bottom cells:
+         ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on
+         IF (ln_zps) THEN
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  jk = mbku(ji,jj)
+                  tabres(ji,jj,jk,m2) = 0._wp
+               END DO
+            END DO           
+         END IF
+        ! Save ssh at last level:
+        tabres(i1:i2,j1:j2,k2,m2) = 0._wp
+        IF (.NOT.ln_linssh) THEN
+           ! This vertical sum below should be replaced by the sea-level at U-points (optimization):
+           DO jk=1,jpk
+              tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) + e3u(i1:i2,j1:j2,jk,Kbb_a) * umask(i1:i2,j1:j2,jk)
+           END DO
+           tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) - hu_0(i1:i2,j1:j2)
+        END IF 
+# endif
+
       ELSE
 
 # if defined key_vertical
-         tabres_child(:,:,:) = 0._wp
+         IF (ln_linssh) tabres(i1:i2,j1:j2,k2,m2) = 0._wp
+
          DO jj=j1,j2
             DO ji=i1,i2
-               N_in = 0
-               DO jk=k1,k2
-                  IF (tabres(ji,jj,jk,m2) == 0) EXIT
-                  N_in = N_in + 1
+               tabres_child(ji,jj,:) = 0._wp
+               N_in = mbku_parent(ji,jj)
+               zhtot = 0._wp
+               DO jk=1,N_in
+                  IF (jk==N_in) THEN
+                     h_in(jk) = hu0_parent(ji,jj) + tabres(ji,jj,k2,m2) - zhtot
+                  ELSE
+                     h_in(jk) = tabres(ji,jj,jk,m2)
+                  ENDIF
+                  zhtot = zhtot + h_in(jk)
                   tabin(jk) = tabres(ji,jj,jk,m1)
-                  h_in(N_in) = tabres(ji,jj,jk,m2)
-              ENDDO
-              !
-              IF (N_in == 0) THEN
-                 tabres_child(ji,jj,:) = 0.
-                 CYCLE
-              ENDIF
-         
-              N_out = 0
-              DO jk=1,jpk
-                 if (umask(ji,jj,jk) == 0) EXIT
-                 N_out = N_out + 1
-                 h_out(N_out) = e3u_n(ji,jj,jk)
-              ENDDO
-         
-              IF (N_out == 0) THEN
-                 tabres_child(ji,jj,:) = 0.
-                 CYCLE
-              ENDIF
-         
-              IF (N_in * N_out > 0) THEN
-                 h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in))
-                 if (h_diff < -1.e4) then
-                    print *,'CHECK YOUR BATHY ...', h_diff, sum(h_out(1:N_out)), sum(h_in(1:N_in))
-                 endif
-              ENDIF
-              call reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out)
-         
+               ENDDO
+               !         
+               N_out = 0
+               DO jk=1,jpk
+                  IF (umask(ji,jj,jk) == 0) EXIT
+                  N_out = N_out + 1
+                  h_out(N_out) = e3u(ji,jj,jk,Kbb_a)
+               ENDDO
+
+               ! Account for small differences in free-surface
+               IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN
+                  h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) )
+               ELSE
+                  h_in(1)   = h_in(1)   - (sum(h_in(1:N_in))-sum(h_out(1:N_out)) )
+               ENDIF
+                  
+               IF (N_in * N_out > 0) THEN
+                  CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1)
+               ENDIF 
             ENDDO
          ENDDO
 
-         ubdiff(i1:i2,j1:j2,:) = (ub(i1:i2,j1:j2,:) - tabres_child(i1:i2,j1:j2,:))*umask(i1:i2,j1:j2,:)
+         ubdiff(i1:i2,j1:j2,:) = (uu(i1:i2,j1:j2,:,Kbb_a) - tabres_child(i1:i2,j1:j2,:))*umask(i1:i2,j1:j2,:)
 #else
-         ubdiff(i1:i2,j1:j2,:) = (ub(i1:i2,j1:j2,:) - tabres(i1:i2,j1:j2,:,1))*umask(i1:i2,j1:j2,:)
+         ubdiff(i1:i2,j1:j2,:) = (uu(i1:i2,j1:j2,:,Kbb_a) - tabres(i1:i2,j1:j2,:,1))*umask(i1:i2,j1:j2,:)
 #endif
+         !* set relaxation time scale
+         IF( l_1st_euler .AND. lk_agrif_fstep ) THEN   ;   ztrelax =   rn_trelax_dyn  / (        rn_Dt )
+         ELSE                                          ;   ztrelax =   rn_trelax_dyn  / (2._wp * rn_Dt )
+         ENDIF
          !
          DO jk = 1, jpkm1                                 ! Horizontal slab
@@ -416,7 +608,7 @@
             DO jj = j1,j2
                DO ji = i1+1,i2   ! vector opt.
-                  zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) * fsahm_spt(ji,jj)
-                  hdivdiff(ji,jj,jk) = (  e2u(ji  ,jj)*e3u_n(ji  ,jj,jk) * ubdiff(ji  ,jj,jk) &
-                                     &   -e2u(ji-1,jj)*e3u_n(ji-1,jj,jk) * ubdiff(ji-1,jj,jk) ) * zbtr
+                  zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kbb_a) * rn_sponge_dyn * fspt(ji,jj)
+                  hdivdiff(ji,jj,jk) = (  e2u(ji  ,jj)*e3u(ji  ,jj,jk,Kbb_a) * ubdiff(ji  ,jj,jk) &
+                                     &   -e2u(ji-1,jj)*e3u(ji-1,jj,jk,Kbb_a) * ubdiff(ji-1,jj,jk) ) * zbtr
                END DO
             END DO
@@ -424,5 +616,5 @@
             DO jj = j1,j2-1
                DO ji = i1,i2   ! vector opt.
-                  zbtr = r1_e1e2f(ji,jj) * e3f_n(ji,jj,jk) * fsahm_spf(ji,jj)
+                  zbtr = r1_e1e2f(ji,jj) * e3f(ji,jj,jk) * rn_sponge_dyn * fspf(ji,jj)
                   rotdiff(ji,jj,jk) = ( -e1u(ji,jj+1) * ubdiff(ji,jj+1,jk)   &
                                     &   +e1u(ji,jj  ) * ubdiff(ji,jj  ,jk) ) * fmask(ji,jj,jk) * zbtr 
@@ -439,10 +631,10 @@
                      ze1v = hdivdiff(ji,jj,jk)
                      ! horizontal diffusive trends
-                     zua = - ( ze2u - rotdiff (ji,jj-1,jk) ) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) )   &
-                           + ( hdivdiff(ji+1,jj,jk) - ze1v ) * r1_e1u(ji,jj)
+                     zua = - ( ze2u - rotdiff (ji,jj-1,jk) ) / ( e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) )   &
+                         & + ( hdivdiff(ji+1,jj,jk) - ze1v ) * r1_e1u(ji,jj) & 
+                         & - ztrelax  * fspu(ji,jj) * ubdiff(ji,jj,jk)
 
                      ! add it to the general momentum trends
-                     ua(ji,jj,jk) = ua(ji,jj,jk) + zua
-
+                     uu(ji,jj,jk,Krhs_a) = uu(ji,jj,jk,Krhs_a) + zua                                 
                   END DO
                ENDIF
@@ -465,9 +657,9 @@
 
                      ! horizontal diffusive trends
-                     zva = + ( ze2u - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) )   &
+                     zva = + ( ze2u - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) )   &
                            + ( hdivdiff(ji,jj+1,jk) - ze1v ) * r1_e2v(ji,jj)
 
                      ! add it to the general momentum trends
-                     va(ji,jj,jk) = va(ji,jj,jk) + zva
+                     vv(ji,jj,jk,Krhs_a) = vv(ji,jj,jk,Krhs_a) + zva
                   END DO
                ENDIF
@@ -492,5 +684,5 @@
       !
       INTEGER  ::   ji, jj, jk, imax
-      REAL(wp) ::   ze2u, ze1v, zua, zva, zbtr, h_diff
+      REAL(wp) ::   ze2u, ze1v, zua, zva, zbtr, zhtot, ztrelax
       REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: vbdiff
       REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: rotdiff, hdivdiff
@@ -503,54 +695,84 @@
       
       IF( before ) THEN 
-         DO jk=1,jpkm1
+         DO jk=k1,k2
             DO jj=j1,j2
                DO ji=i1,i2
-                  tabres(ji,jj,jk,m1) = vb(ji,jj,jk)
+                  tabres(ji,jj,jk,m1) = vv(ji,jj,jk,Kbb_a)
 # if defined key_vertical
-                  tabres(ji,jj,jk,m2) = vmask(ji,jj,jk) * e3v_n(ji,jj,jk)
+                  tabres(ji,jj,jk,m2) = vmask(ji,jj,jk) * e3v(ji,jj,jk,Kbb_a)
 # endif
                END DO
             END DO
          END DO
+
+# if defined key_vertical
+         ! Extrapolate thicknesses in partial bottom cells:
+         ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on
+         IF (ln_zps) THEN
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  jk = mbkv(ji,jj)
+                  tabres(ji,jj,jk,m2) = 0._wp
+               END DO
+            END DO           
+         END IF
+        ! Save ssh at last level:
+        tabres(i1:i2,j1:j2,k2,m2) = 0._wp
+        IF (.NOT.ln_linssh) THEN
+           ! This vertical sum below should be replaced by the sea-level at V-points (optimization):
+           DO jk=1,jpk
+              tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) + e3v(i1:i2,j1:j2,jk,Kbb_a) * vmask(i1:i2,j1:j2,jk)
+           END DO
+           tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) - hv_0(i1:i2,j1:j2)
+        END IF 
+# endif
+
       ELSE
 
 # if defined key_vertical
-         tabres_child(:,:,:) = 0._wp
+         IF (ln_linssh) tabres(i1:i2,j1:j2,k2,m2) = 0._wp
          DO jj=j1,j2
             DO ji=i1,i2
-               N_in = 0
-               DO jk=k1,k2
-                  IF (tabres(ji,jj,jk,m2) == 0) EXIT
-                  N_in = N_in + 1
+               tabres_child(ji,jj,:) = 0._wp
+               N_in = mbkv_parent(ji,jj)
+               zhtot = 0._wp
+               DO jk=1,N_in
+                  IF (jk==N_in) THEN
+                     h_in(jk) = hv0_parent(ji,jj) + tabres(ji,jj,k2,m2) - zhtot
+                  ELSE
+                     h_in(jk) = tabres(ji,jj,jk,m2)
+                  ENDIF
+                  zhtot = zhtot + h_in(jk)
                   tabin(jk) = tabres(ji,jj,jk,m1)
-                  h_in(N_in) = tabres(ji,jj,jk,m2)
-              ENDDO
+               ENDDO
+               !          
+               N_out = 0
+               DO jk=1,jpk
+                  IF (vmask(ji,jj,jk) == 0) EXIT
+                  N_out = N_out + 1
+                  h_out(N_out) = e3v(ji,jj,jk,Kbb_a)
+               ENDDO
+
+               ! Account for small differences in free-surface
+               IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN
+                  h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) )
+               ELSE
+                  h_in(1)   = h_in(1) - (  sum(h_in(1:N_in))-sum(h_out(1:N_out)) )
+               ENDIF
          
-              IF (N_in == 0) THEN
-                 tabres_child(ji,jj,:) = 0.
-                 CYCLE
-              ENDIF
-         
-              N_out = 0
-              DO jk=1,jpk
-                 if (vmask(ji,jj,jk) == 0) EXIT
-                 N_out = N_out + 1
-                 h_out(N_out) = e3v_n(ji,jj,jk)
-              ENDDO
-         
-              IF (N_in * N_out > 0) THEN
-                 h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in))
-                 if (h_diff < -1.e4) then
-                    print *,'CHECK YOUR BATHY ...', h_diff, sum(h_out(1:N_out)), sum(h_in(1:N_in))
-                 endif
-              ENDIF
-              call reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out)
+               IF (N_in * N_out > 0) THEN
+                  CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1)
+               ENDIF
             ENDDO
          ENDDO
 
-         vbdiff(i1:i2,j1:j2,:) = (vb(i1:i2,j1:j2,:) - tabres_child(i1:i2,j1:j2,:))*vmask(i1:i2,j1:j2,:)  
+         vbdiff(i1:i2,j1:j2,:) = (vv(i1:i2,j1:j2,:,Kbb_a) - tabres_child(i1:i2,j1:j2,:))*vmask(i1:i2,j1:j2,:)  
 # else
-         vbdiff(i1:i2,j1:j2,:) = (vb(i1:i2,j1:j2,:) - tabres(i1:i2,j1:j2,:,1))*vmask(i1:i2,j1:j2,:)
+         vbdiff(i1:i2,j1:j2,:) = (vv(i1:i2,j1:j2,:,Kbb_a) - tabres(i1:i2,j1:j2,:,1))*vmask(i1:i2,j1:j2,:)
 # endif
+         !* set relaxation time scale
+         IF( l_1st_euler .AND. lk_agrif_fstep ) THEN   ;   ztrelax =   rn_trelax_dyn  / (        rn_Dt )
+         ELSE                                          ;   ztrelax =   rn_trelax_dyn  / (2._wp * rn_Dt )
+         ENDIF
          !
          DO jk = 1, jpkm1                                 ! Horizontal slab
@@ -562,12 +784,12 @@
             DO jj = j1+1,j2
                DO ji = i1,i2   ! vector opt.
-                  zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) * fsahm_spt(ji,jj)
-                  hdivdiff(ji,jj,jk) = ( e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) * vbdiff(ji,jj  ,jk)  &
-                                     &  -e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * vbdiff(ji,jj-1,jk)  ) * zbtr
+                  zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kbb_a) * rn_sponge_dyn * fspt(ji,jj)
+                  hdivdiff(ji,jj,jk) = ( e1v(ji,jj  ) * e3v(ji,jj  ,jk,Kbb_a) * vbdiff(ji,jj  ,jk)  &
+                                     &  -e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kbb_a) * vbdiff(ji,jj-1,jk)  ) * zbtr
                END DO
             END DO
             DO jj = j1,j2
                DO ji = i1,i2-1   ! vector opt.
-                  zbtr = r1_e1e2f(ji,jj) * e3f_n(ji,jj,jk) * fsahm_spf(ji,jj)
+                  zbtr = r1_e1e2f(ji,jj) * e3f(ji,jj,jk) * rn_sponge_dyn * fspf(ji,jj)
                   rotdiff(ji,jj,jk) = ( e2v(ji+1,jj) * vbdiff(ji+1,jj,jk) & 
                                     &  -e2v(ji  ,jj) * vbdiff(ji  ,jj,jk)  ) * fmask(ji,jj,jk) * zbtr
@@ -586,6 +808,6 @@
                IF( .NOT. tabspongedone_u(ji,jj) ) THEN
                   DO jk = 1, jpkm1
-                     ua(ji,jj,jk) = ua(ji,jj,jk)                                                               &
-                        & - ( rotdiff (ji  ,jj,jk) - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) )  &
+                     uu(ji,jj,jk,Krhs_a) = uu(ji,jj,jk,Krhs_a)                                                               &
+                        & - ( rotdiff (ji  ,jj,jk) - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) )  &
                         & + ( hdivdiff(ji+1,jj,jk) - hdivdiff(ji,jj  ,jk)) * r1_e1u(ji,jj)
                   END DO
@@ -600,7 +822,8 @@
                IF( .NOT. tabspongedone_v(ji,jj) ) THEN
                   DO jk = 1, jpkm1
-                     va(ji,jj,jk) = va(ji,jj,jk)                                                                  &
-                        &  + ( rotdiff (ji,jj  ,jk) - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) )   &
-                        &  + ( hdivdiff(ji,jj+1,jk) - hdivdiff(ji  ,jj,jk) ) * r1_e2v(ji,jj)
+                     vv(ji,jj,jk,Krhs_a) = vv(ji,jj,jk,Krhs_a)                                                                  &
+                        &  + ( rotdiff (ji,jj  ,jk) - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) )   &
+                        &  + ( hdivdiff(ji,jj+1,jk) - hdivdiff(ji  ,jj,jk) ) * r1_e2v(ji,jj)                      &
+                        &  - ztrelax * fspv(ji,jj) * vbdiff(ji,jj,jk)
                   END DO
                ENDIF
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_oce_update.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_oce_update.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_oce_update.F90	(revision 12928)
@@ -1,5 +1,5 @@
-#define TWO_WAY        /* TWO WAY NESTING */
-#undef DECAL_FEEDBACK  /* SEPARATION of INTERFACES*/
-#undef VOL_REFLUX      /* VOLUME REFLUXING*/
+#undef DECAL_FEEDBACK     /* SEPARATION of INTERFACES */
+#undef DECAL_FEEDBACK_2D  /* SEPARATION of INTERFACES (Barotropic mode) */
+#undef VOL_REFLUX         /* VOLUME REFLUXING*/
  
 MODULE agrif_oce_update
@@ -25,4 +25,5 @@
    USE lib_mpp        ! MPP library
    USE domvvl         ! Need interpolation routines 
+   USE vremap         ! Vertical remapping
 
    IMPLICIT NONE
@@ -46,8 +47,14 @@
       IF (Agrif_Root()) RETURN
       !
-#if defined TWO_WAY  
       IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update tracers  from grid Number',Agrif_Fixed()
 
+#if defined key_vertical
+! Effect of this has to be carrefully checked 
+! depending on what the nesting tools ensure for
+! volume conservation:
+      Agrif_UseSpecialValueInUpdate = .FALSE.
+#else
       Agrif_UseSpecialValueInUpdate = .TRUE.
+#endif
       Agrif_SpecialValueFineGrid    = 0._wp
       ! 
@@ -64,5 +71,4 @@
       Agrif_UseSpecialValueInUpdate = .FALSE.
       !
-#endif
       !
    END SUBROUTINE Agrif_Update_Tra
@@ -75,5 +81,4 @@
       IF (Agrif_Root()) RETURN
       !
-#if defined TWO_WAY
       IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update momentum from grid Number',Agrif_Fixed()
 
@@ -95,5 +100,5 @@
 # endif
 
-# if ! defined DECAL_FEEDBACK
+# if ! defined DECAL_FEEDBACK_2D
       CALL Agrif_Update_Variable(e1u_id,procname = updateU2d)
       CALL Agrif_Update_Variable(e2v_id,procname = updateV2d)  
@@ -103,5 +108,5 @@
 # endif
       !
-# if ! defined DECAL_FEEDBACK
+# if ! defined DECAL_FEEDBACK_2D
       ! Account for updated thicknesses at boundary edges
       IF (.NOT.ln_linssh) THEN
@@ -113,5 +118,5 @@
       IF ( ln_dynspg_ts .AND. ln_bt_fw ) THEN
          ! Update time integrated transports
-#  if ! defined DECAL_FEEDBACK
+#  if ! defined DECAL_FEEDBACK_2D
          CALL Agrif_Update_Variable(ub2b_update_id,procname = updateub2b)
          CALL Agrif_Update_Variable(vb2b_update_id,procname = updatevb2b)
@@ -121,5 +126,4 @@
 #  endif
       END IF
-#endif
       !
    END SUBROUTINE Agrif_Update_Dyn
@@ -131,10 +135,8 @@
       ! 
       IF (Agrif_Root()) RETURN
-      !
-#if defined TWO_WAY
       !
       Agrif_UseSpecialValueInUpdate = .TRUE.
       Agrif_SpecialValueFineGrid = 0.
-# if ! defined DECAL_FEEDBACK
+# if ! defined DECAL_FEEDBACK_2D
       CALL Agrif_Update_Variable(sshn_id,procname = updateSSH)
 # else
@@ -147,5 +149,5 @@
       IF ( ln_dynspg_ts.AND.ln_bt_fw ) THEN
          ! Refluxing on ssh:
-#  if defined DECAL_FEEDBACK
+#  if defined DECAL_FEEDBACK_2D
          CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/0, 0/),locupdate2=(/1, 1/),procname = reflux_sshu)
          CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1, 1/),locupdate2=(/0, 0/),procname = reflux_sshv)
@@ -157,6 +159,4 @@
 #  endif
       !
-#endif
-      !
    END SUBROUTINE Agrif_Update_ssh
 
@@ -170,6 +170,4 @@
       IF (Agrif_Root()) RETURN
       !       
-#  if defined TWO_WAY
-
       Agrif_UseSpecialValueInUpdate = .TRUE.
       Agrif_SpecialValueFineGrid = 0.
@@ -180,6 +178,4 @@
 
       Agrif_UseSpecialValueInUpdate = .FALSE.
-
-#  endif
       
    END SUBROUTINE Agrif_Update_Tke
@@ -192,6 +188,4 @@
       !
       IF (Agrif_Root()) RETURN
-      !
-#if defined TWO_WAY  
       !
       IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update e3 from grid Number',Agrif_Fixed(), 'Step', Agrif_Nb_Step()
@@ -210,6 +204,4 @@
       CALL Agrif_ParentGrid_To_ChildGrid()
       !
-#endif
-      !
    END SUBROUTINE Agrif_Update_vvl
 
@@ -230,10 +222,10 @@
       ! -----------------------
       !
-      e3u_a(:,:,:) = e3u_n(:,:,:)
-      e3v_a(:,:,:) = e3v_n(:,:,:)
-!      ua(:,:,:) = e3u_b(:,:,:)
-!      va(:,:,:) = e3v_b(:,:,:)
-      hu_a(:,:) = hu_n(:,:)
-      hv_a(:,:) = hv_n(:,:)
+      e3u(:,:,:,Krhs_a) = e3u(:,:,:,Kmm_a)
+      e3v(:,:,:,Krhs_a) = e3v(:,:,:,Kmm_a)
+!      uu(:,:,:,Krhs_a) = e3u(:,:,:,Kbb_a)
+!      vv(:,:,:,Krhs_a) = e3v(:,:,:,Kbb_a)
+      hu(:,:,Krhs_a) = hu(:,:,Kmm_a)
+      hv(:,:,Krhs_a) = hv(:,:,Kmm_a)
 
       ! 1) NOW fields
@@ -242,47 +234,47 @@
          ! Vertical scale factor interpolations
          ! ------------------------------------
-      CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:) ,  'U' )
-      CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:) ,  'V' )
-      CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:) ,  'F' )
-
-      CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' )
-      CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' )
+      CALL dom_vvl_interpol( e3t(:,:,:,Kmm_a), e3u(:,:,:,Kmm_a) ,  'U' )
+      CALL dom_vvl_interpol( e3t(:,:,:,Kmm_a), e3v(:,:,:,Kmm_a) ,  'V' )
+      CALL dom_vvl_interpol( e3u(:,:,:,Kmm_a), e3f(:,:,:) ,  'F' )
+
+      CALL dom_vvl_interpol( e3u(:,:,:,Kmm_a), e3uw(:,:,:,Kmm_a), 'UW' )
+      CALL dom_vvl_interpol( e3v(:,:,:,Kmm_a), e3vw(:,:,:,Kmm_a), 'VW' )
 
          ! Update total depths:
          ! --------------------
-      hu_n(:,:) = 0._wp                        ! Ocean depth at U-points
-      hv_n(:,:) = 0._wp                        ! Ocean depth at V-points
+      hu(:,:,Kmm_a) = 0._wp                        ! Ocean depth at U-points
+      hv(:,:,Kmm_a) = 0._wp                        ! Ocean depth at V-points
       DO jk = 1, jpkm1
-         hu_n(:,:) = hu_n(:,:) + e3u_n(:,:,jk) * umask(:,:,jk)
-         hv_n(:,:) = hv_n(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk)
+         hu(:,:,Kmm_a) = hu(:,:,Kmm_a) + e3u(:,:,jk,Kmm_a) * umask(:,:,jk)
+         hv(:,:,Kmm_a) = hv(:,:,Kmm_a) + e3v(:,:,jk,Kmm_a) * vmask(:,:,jk)
       END DO
       !                                        ! Inverse of the local depth
-      r1_hu_n(:,:) = ssumask(:,:) / ( hu_n(:,:) + 1._wp - ssumask(:,:) )
-      r1_hv_n(:,:) = ssvmask(:,:) / ( hv_n(:,:) + 1._wp - ssvmask(:,:) )
+      r1_hu(:,:,Kmm_a) = ssumask(:,:) / ( hu(:,:,Kmm_a) + 1._wp - ssumask(:,:) )
+      r1_hv(:,:,Kmm_a) = ssvmask(:,:) / ( hv(:,:,Kmm_a) + 1._wp - ssvmask(:,:) )
 
 
       ! 2) BEFORE fields:
       !------------------
-      IF (.NOT.(lk_agrif_fstep.AND.(neuler==0) )) THEN
+      IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler) )) THEN
          !
          ! Vertical scale factor interpolations
          ! ------------------------------------
-         CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:),  'U'  )
-         CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:),  'V'  )
-
-         CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' )
-         CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' )
+         CALL dom_vvl_interpol( e3t(:,:,:,Kbb_a), e3u(:,:,:,Kbb_a),  'U'  )
+         CALL dom_vvl_interpol( e3t(:,:,:,Kbb_a), e3v(:,:,:,Kbb_a),  'V'  )
+
+         CALL dom_vvl_interpol( e3u(:,:,:,Kbb_a), e3uw(:,:,:,Kbb_a), 'UW' )
+         CALL dom_vvl_interpol( e3v(:,:,:,Kbb_a), e3vw(:,:,:,Kbb_a), 'VW' )
 
          ! Update total depths:
          ! --------------------
-         hu_b(:,:) = 0._wp                     ! Ocean depth at U-points
-         hv_b(:,:) = 0._wp                     ! Ocean depth at V-points
+         hu(:,:,Kbb_a) = 0._wp                     ! Ocean depth at U-points
+         hv(:,:,Kbb_a) = 0._wp                     ! Ocean depth at V-points
          DO jk = 1, jpkm1
-            hu_b(:,:) = hu_b(:,:) + e3u_b(:,:,jk) * umask(:,:,jk)
-            hv_b(:,:) = hv_b(:,:) + e3v_b(:,:,jk) * vmask(:,:,jk)
+            hu(:,:,Kbb_a) = hu(:,:,Kbb_a) + e3u(:,:,jk,Kbb_a) * umask(:,:,jk)
+            hv(:,:,Kbb_a) = hv(:,:,Kbb_a) + e3v(:,:,jk,Kbb_a) * vmask(:,:,jk)
          END DO
          !                                     ! Inverse of the local depth
-         r1_hu_b(:,:) = ssumask(:,:) / ( hu_b(:,:) + 1._wp - ssumask(:,:) )
-         r1_hv_b(:,:) = ssvmask(:,:) / ( hv_b(:,:) + 1._wp - ssvmask(:,:) )
+         r1_hu(:,:,Kbb_a) = ssumask(:,:) / ( hu(:,:,Kbb_a) + 1._wp - ssumask(:,:) )
+         r1_hv(:,:,Kbb_a) = ssvmask(:,:) / ( hv(:,:,Kbb_a) + 1._wp - ssvmask(:,:) )
       ENDIF
       !
@@ -300,21 +292,23 @@
       !!
       INTEGER :: ji,jj,jk,jn
-      REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,n1:n2) :: tabres_child
+      INTEGER  :: N_in, N_out
+      REAL(wp) :: ztb, ztnu, ztno
       REAL(wp) :: h_in(k1:k2)
       REAL(wp) :: h_out(1:jpk)
-      INTEGER  :: N_in, N_out
-      REAL(wp) :: zrho_xy, h_diff
-      REAL(wp) :: tabin(k1:k2,n1:n2)
+      REAL(wp) :: tabin(k1:k2,1:jpts)
+      REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,1:jpts) :: tabres_child
       !!---------------------------------------------
       !
       IF (before) THEN
-         AGRIF_SpecialValue = -999._wp
-         zrho_xy = Agrif_rhox() * Agrif_rhoy() 
+!jc_alt
+!         AGRIF_SpecialValue = -999._wp
          DO jn = n1,n2-1
             DO jk=k1,k2
                DO jj=j1,j2
                   DO ji=i1,i2
-                     tabres(ji,jj,jk,jn) = (tsn(ji,jj,jk,jn) * e3t_n(ji,jj,jk) ) &
-                                           * tmask(ji,jj,jk) + (tmask(ji,jj,jk)-1)*999._wp
+!jc_alt
+!                     tabres(ji,jj,jk,jn) = (ts(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Kmm_a) ) &
+!                                         &  * tmask(ji,jj,jk) + (tmask(ji,jj,jk)-1._wp) * 999._wp
+                     tabres(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Kmm_a)
                   END DO
                END DO
@@ -324,11 +318,13 @@
             DO jj=j1,j2
                DO ji=i1,i2
-                  tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t_n(ji,jj,jk) &
-                                           + (tmask(ji,jj,jk)-1)*999._wp
+!jc_alt
+!                  tabres(ji,jj,jk,n2) =      tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a) &
+!                                      &   + (tmask(ji,jj,jk) - 1._wp) * 999._wp
+                  tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a)
                END DO
             END DO
          END DO
       ELSE
-         tabres_child(:,:,:,:) = 0.
+         tabres_child(:,:,:,:) = 0._wp
          AGRIF_SpecialValue = 0._wp
          DO jj=j1,j2
@@ -336,5 +332,7 @@
                N_in = 0
                DO jk=k1,k2 !k2 = jpk of child grid
-                  IF (tabres(ji,jj,jk,n2) == 0  ) EXIT
+! jc_alt
+!                  IF (tabres(ji,jj,jk,n2) < -900._wp  ) EXIT
+                  IF (tabres(ji,jj,jk,n2) == 0._wp  ) EXIT
                   N_in = N_in + 1
                   tabin(jk,:) = tabres(ji,jj,jk,n1:n2-1)/tabres(ji,jj,jk,n2)
@@ -343,45 +341,38 @@
                N_out = 0
                DO jk=1,jpk ! jpk of parent grid
-                  IF (tmask(ji,jj,jk) < -900) EXIT ! TODO: Will not work with ISF
+                  IF (tmask(ji,jj,jk) == 0 ) EXIT ! TODO: Will not work with ISF
                   N_out = N_out + 1
-                  h_out(N_out) = e3t_n(ji,jj,jk) 
+                  h_out(N_out) = e3t(ji,jj,jk,Kmm_a) 
                ENDDO
-               IF (N_in > 0) THEN !Remove this?
-                  h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in))
-                  IF (h_diff < -1.e-4) THEN
-                     print *,'CHECK YOUR bathy T points ...',ji,jj,h_diff,sum(h_in(1:N_in)),sum(h_out(1:N_out))
-                     print *,h_in(1:N_in)
-                     print *,h_out(1:N_out)
-                     STOP
-                  ENDIF
-                  DO jn=n1,n2-1
-                     CALL reconstructandremap(tabin(1:N_in,jn),h_in(1:N_in),tabres_child(ji,jj,1:N_out,jn),h_out(1:N_out),N_in,N_out)
-                  ENDDO
+               IF (N_in*N_out > 0) THEN !Remove this?
+                  CALL reconstructandremap(tabin(1:N_in,1:jpts),h_in(1:N_in),tabres_child(ji,jj,1:N_out,1:jpts),h_out(1:N_out),N_in,N_out,jpts)
                ENDIF
             ENDDO
          ENDDO
 
-         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN
+         IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN
             ! Add asselin part
-            DO jn = n1,n2-1
-               DO jk=1,jpk
-                  DO jj=j1,j2
-                     DO ji=i1,i2
-                        IF( tabres_child(ji,jj,jk,jn) .NE. 0. ) THEN
-                           tsb(ji,jj,jk,jn) = tsb(ji,jj,jk,jn) & 
-                                 & + atfp * ( tabres_child(ji,jj,jk,jn) &
-                                 &          - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
+            DO jn = 1,jpts
+               DO jk = 1, jpkm1
+                  DO jj = j1, j2
+                     DO ji = i1, i2
+                        IF( tabres_child(ji,jj,jk,jn) /= 0._wp ) THEN
+                           ztb  = ts(ji,jj,jk,jn,Kbb_a) * e3t(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used
+                           ztnu = tabres_child(ji,jj,jk,jn) * e3t(ji,jj,jk,Kmm_a)
+                           ztno = ts(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Krhs_a)
+                           ts(ji,jj,jk,jn,Kbb_a) = ( ztb + rn_atfp * ( ztnu - ztno) )  & 
+                                     &        * tmask(ji,jj,jk) / e3t(ji,jj,jk,Kbb_a)
                         ENDIF
-                     ENDDO
-                  ENDDO
-               ENDDO
-            ENDDO
-         ENDIF
-         DO jn = n1,n2-1
-            DO jk=1,jpk
-               DO jj=j1,j2
-                  DO ji=i1,i2
-                     IF( tabres_child(ji,jj,jk,jn) .NE. 0. ) THEN 
-                        tsn(ji,jj,jk,jn) = tabres_child(ji,jj,jk,jn) * tmask(ji,jj,jk)
+                     END DO
+                  END DO
+               END DO
+            END DO
+         ENDIF
+         DO jn = 1,jpts
+            DO jk = 1, jpkm1
+               DO jj = j1, j2
+                  DO ji = i1, i2
+                     IF( tabres_child(ji,jj,jk,jn) /= 0._wp ) THEN 
+                        ts(ji,jj,jk,jn,Kmm_a) = tabres_child(ji,jj,jk,jn)
                      END IF
                   END DO
@@ -389,4 +380,8 @@
             END DO
          END DO
+         !
+         IF  ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN
+            ts(i1:i2,j1:j2,1:jpkm1,1:jpts,Kbb_a)  = ts(i1:i2,j1:j2,1:jpkm1,1:jpts,Kmm_a)
+         ENDIF
       ENDIF
       ! 
@@ -413,6 +408,6 @@
                   DO ji=i1,i2
 !> jc tmp
-                     tabres(ji,jj,jk,jn) = tsn(ji,jj,jk,jn)  * e3t_n(ji,jj,jk) / e3t_0(ji,jj,jk)
-!                     tabres(ji,jj,jk,jn) = tsn(ji,jj,jk,jn)  * e3t_n(ji,jj,jk)
+                     tabres(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kmm_a)  * e3t(ji,jj,jk,Kmm_a) / e3t_0(ji,jj,jk)
+!                     tabres(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kmm_a)  * e3t(ji,jj,jk,Kmm_a)
 !< jc tmp
                   END DO
@@ -427,5 +422,5 @@
          ENDDO
 !< jc tmp
-         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN
+         IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN
             ! Add asselin part
             DO jn = 1,jpts
@@ -434,9 +429,9 @@
                      DO ji = i1, i2
                         IF( tabres(ji,jj,jk,jn) /= 0._wp ) THEN
-                           ztb  = tsb(ji,jj,jk,jn) * e3t_b(ji,jj,jk) ! fse3t_b prior update should be used
+                           ztb  = ts(ji,jj,jk,jn,Kbb_a) * e3t(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used
                            ztnu = tabres(ji,jj,jk,jn)
-                           ztno = tsn(ji,jj,jk,jn) * e3t_a(ji,jj,jk)
-                           tsb(ji,jj,jk,jn) = ( ztb + atfp * ( ztnu - ztno) )  & 
-                                     &        * tmask(ji,jj,jk) / e3t_b(ji,jj,jk)
+                           ztno = ts(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Krhs_a)
+                           ts(ji,jj,jk,jn,Kbb_a) = ( ztb + rn_atfp * ( ztnu - ztno) )  & 
+                                     &        * tmask(ji,jj,jk) / e3t(ji,jj,jk,Kbb_a)
                         ENDIF
                      END DO
@@ -450,5 +445,5 @@
                   DO ji=i1,i2
                      IF( tabres(ji,jj,jk,jn) /= 0._wp ) THEN 
-                        tsn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) / e3t_n(ji,jj,jk)
+                        ts(ji,jj,jk,jn,Kmm_a) = tabres(ji,jj,jk,jn) / e3t(ji,jj,jk,Kmm_a)
                      END IF
                   END DO
@@ -457,6 +452,6 @@
          END DO
          !
-         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN
-            tsb(i1:i2,j1:j2,k1:k2,1:jpts)  = tsn(i1:i2,j1:j2,k1:k2,1:jpts)
+         IF  ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN
+            ts(i1:i2,j1:j2,k1:k2,1:jpts,Kbb_a)  = ts(i1:i2,j1:j2,k1:k2,1:jpts,Kmm_a)
          ENDIF
          !
@@ -478,5 +473,5 @@
       !
       INTEGER ::   ji, jj, jk
-      REAL(wp)::   zrhoy
+      REAL(wp)::   zrhoy, zub, zunu, zuno
 ! VERTICAL REFINEMENT BEGIN
       REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: tabres_child
@@ -491,12 +486,17 @@
       IF( before ) THEN
          zrhoy = Agrif_Rhoy()
-         AGRIF_SpecialValue = -999._wp
+!jc_alt
+!         AGRIF_SpecialValue = -999._wp
          DO jk=k1,k2
             DO jj=j1,j2
                DO ji=i1,i2
-                  tabres(ji,jj,jk,1) = zrhoy * e2u(ji,jj) * e3u_n(ji,jj,jk) * umask(ji,jj,jk) * un(ji,jj,jk)  &
-                                       + (umask(ji,jj,jk)-1)*999._wp
-                  tabres(ji,jj,jk,2) = zrhoy * umask(ji,jj,jk) * e2u(ji,jj) * e3u_n(ji,jj,jk)  &
-                                       + (umask(ji,jj,jk)-1)*999._wp
+!jc_alt
+!                  tabres(ji,jj,jk,1) = zrhoy * e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) * umask(ji,jj,jk) * uu(ji,jj,jk,Kmm_a)  &
+!                                     &  + (umask(ji,jj,jk)-1._wp)*999._wp
+                  tabres(ji,jj,jk,1) = zrhoy * e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) * umask(ji,jj,jk) * uu(ji,jj,jk,Kmm_a)  
+!jc_alt
+!                  tabres(ji,jj,jk,2) = zrhoy * umask(ji,jj,jk) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a)  &
+!                                     &  + (umask(ji,jj,jk)-1._wp)*999._wp
+                  tabres(ji,jj,jk,2) = zrhoy * umask(ji,jj,jk) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a)
                END DO
             END DO
@@ -511,5 +511,7 @@
                tabin(:) = 0._wp
                DO jk=k1,k2 !k2=jpk of child grid
-                  IF( tabres(ji,jj,jk,2) < -900) EXIT
+!jc_alt
+!                  IF( tabres(ji,jj,jk,2) < -900._wp) EXIT
+                  IF( tabres(ji,jj,jk,2) == 0.) EXIT
                   N_in = N_in + 1
                   tabin(jk) = tabres(ji,jj,jk,1)/tabres(ji,jj,jk,2)
@@ -520,12 +522,12 @@
                   IF (umask(ji,jj,jk) == 0) EXIT
                   N_out = N_out + 1
-                  h_out(N_out) = e3u_n(ji,jj,jk)
+                  h_out(N_out) = e3u(ji,jj,jk,Kmm_a)
                ENDDO
                IF (N_in * N_out > 0) THEN
                   h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in))
+                  excess = 0._wp
                   IF (h_diff < -1.e-4) THEN
 !Even if bathy at T points match it's possible for the U points to be deeper in the child grid. 
 !In this case we need to move transport from the child grid cells below bed of parent grid into the bottom cell.
-                     excess = 0._wp
                      DO jk=N_in,1,-1
                         thick = MIN(-1*h_diff, h_in(jk))
@@ -540,22 +542,30 @@
                      ENDDO
                   ENDIF
-                  CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out)
+                  CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1)
                   tabres_child(ji,jj,N_out) = tabres_child(ji,jj,N_out) + excess/(e2u(ji,jj)*h_out(N_out))
                ENDIF
             ENDDO
          ENDDO
-
+         !
          DO jk=1,jpk
             DO jj=j1,j2
                DO ji=i1,i2
-                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part
-                     ub(ji,jj,jk) = ub(ji,jj,jk) & 
-                           & + atfp * ( tabres_child(ji,jj,jk) - un(ji,jj,jk) ) * umask(ji,jj,jk)
+                  IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN ! Add asselin part
+                     zub  = uu(ji,jj,jk,Kbb_a) * e3u(ji,jj,jk,Kbb_a)  ! fse3t_b prior update should be used
+                     zuno = uu(ji,jj,jk,Kmm_a) * e3u(ji,jj,jk,Krhs_a)
+                     zunu = tabres_child(ji,jj,jk) * e3u(ji,jj,jk,Kmm_a)
+                     uu(ji,jj,jk,Kbb_a) = ( zub + rn_atfp * ( zunu - zuno) ) &      
+                                    & * umask(ji,jj,jk) / e3u(ji,jj,jk,Kbb_a)
                   ENDIF
                   !
-                  un(ji,jj,jk) = tabres_child(ji,jj,jk) * umask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+                  uu(ji,jj,jk,Kmm_a) = tabres_child(ji,jj,jk) * umask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+         IF  ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN
+            uu(i1:i2,j1:j2,1:jpkm1,Kbb_a)  = uu(i1:i2,j1:j2,1:jpkm1,Kmm_a)
+         ENDIF
+         !
       ENDIF
       ! 
@@ -579,5 +589,5 @@
          zrhoy = Agrif_Rhoy()
          DO jk = k1, k2
-            tabres(i1:i2,j1:j2,jk,1) = zrhoy * e2u(i1:i2,j1:j2) * e3u_n(i1:i2,j1:j2,jk) * un(i1:i2,j1:j2,jk)
+            tabres(i1:i2,j1:j2,jk,1) = zrhoy * e2u(i1:i2,j1:j2) * e3u(i1:i2,j1:j2,jk,Kmm_a) * uu(i1:i2,j1:j2,jk,Kmm_a)
          END DO
       ELSE
@@ -587,19 +597,19 @@
                   tabres(ji,jj,jk,1) = tabres(ji,jj,jk,1) * r1_e2u(ji,jj) 
                   !
-                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part
-                     zub  = ub(ji,jj,jk) * e3u_b(ji,jj,jk)  ! fse3t_b prior update should be used
-                     zuno = un(ji,jj,jk) * e3u_a(ji,jj,jk)
+                  IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN ! Add asselin part
+                     zub  = uu(ji,jj,jk,Kbb_a) * e3u(ji,jj,jk,Kbb_a)  ! fse3t_b prior update should be used
+                     zuno = uu(ji,jj,jk,Kmm_a) * e3u(ji,jj,jk,Krhs_a)
                      zunu = tabres(ji,jj,jk,1)
-                     ub(ji,jj,jk) = ( zub + atfp * ( zunu - zuno) ) &      
-                                    & * umask(ji,jj,jk) / e3u_b(ji,jj,jk)
+                     uu(ji,jj,jk,Kbb_a) = ( zub + rn_atfp * ( zunu - zuno) ) &      
+                                    & * umask(ji,jj,jk) / e3u(ji,jj,jk,Kbb_a)
                   ENDIF
                   !
-                  un(ji,jj,jk) = tabres(ji,jj,jk,1) * umask(ji,jj,jk) / e3u_n(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         !
-         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN
-            ub(i1:i2,j1:j2,k1:k2)  = un(i1:i2,j1:j2,k1:k2)
+                  uu(ji,jj,jk,Kmm_a) = tabres(ji,jj,jk,1) * umask(ji,jj,jk) / e3u(ji,jj,jk,Kmm_a)
+               END DO
+            END DO
+         END DO
+         !
+         IF  ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN
+            uu(i1:i2,j1:j2,k1:k2,Kbb_a)  = uu(i1:i2,j1:j2,k1:k2,Kmm_a)
          ENDIF
          !
@@ -632,8 +642,8 @@
          IF (western_side) THEN
             DO jj=j1,j2
-               zcor = un_b(i1-1,jj) * hu_a(i1-1,jj) * r1_hu_n(i1-1,jj) - un_b(i1-1,jj)
-               un_b(i1-1,jj) = un_b(i1-1,jj) + zcor
+               zcor = uu_b(i1-1,jj,Kmm_a) * hu(i1-1,jj,Krhs_a) * r1_hu(i1-1,jj,Kmm_a) - uu_b(i1-1,jj,Kmm_a)
+               uu_b(i1-1,jj,Kmm_a) = uu_b(i1-1,jj,Kmm_a) + zcor
                DO jk=1,jpkm1
-                  un(i1-1,jj,jk) = un(i1-1,jj,jk) + zcor * umask(i1-1,jj,jk)
+                  uu(i1-1,jj,jk,Kmm_a) = uu(i1-1,jj,jk,Kmm_a) + zcor * umask(i1-1,jj,jk)
                END DO 
             END DO
@@ -642,8 +652,8 @@
          IF (eastern_side) THEN
             DO jj=j1,j2
-               zcor = un_b(i2+1,jj) * hu_a(i2+1,jj) * r1_hu_n(i2+1,jj) - un_b(i2+1,jj)
-               un_b(i2+1,jj) = un_b(i2+1,jj) + zcor
+               zcor = uu_b(i2+1,jj,Kmm_a) * hu(i2+1,jj,Krhs_a) * r1_hu(i2+1,jj,Kmm_a) - uu_b(i2+1,jj,Kmm_a)
+               uu_b(i2+1,jj,Kmm_a) = uu_b(i2+1,jj,Kmm_a) + zcor
                DO jk=1,jpkm1
-                  un(i2+1,jj,jk) = un(i2+1,jj,jk) + zcor * umask(i2+1,jj,jk)
+                  uu(i2+1,jj,jk,Kmm_a) = uu(i2+1,jj,jk,Kmm_a) + zcor * umask(i2+1,jj,jk)
                END DO 
             END DO
@@ -665,5 +675,5 @@
       !
       INTEGER  ::   ji, jj, jk
-      REAL(wp) ::   zrhox
+      REAL(wp) ::   zrhox, zvb, zvnu, zvno
 ! VERTICAL REFINEMENT BEGIN
       REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: tabres_child
@@ -678,12 +688,17 @@
       IF( before ) THEN
          zrhox = Agrif_Rhox()
-         AGRIF_SpecialValue = -999._wp
+!jc_alt
+!         AGRIF_SpecialValue = -999._wp
          DO jk=k1,k2
             DO jj=j1,j2
                DO ji=i1,i2
-                  tabres(ji,jj,jk,1) = zrhox * e1v(ji,jj) * e3v_n(ji,jj,jk) * vmask(ji,jj,jk) * vn(ji,jj,jk) &
-                                       + (vmask(ji,jj,jk)-1)*999._wp
-                  tabres(ji,jj,jk,2) = vmask(ji,jj,jk) * zrhox * e1v(ji,jj) * e3v_n(ji,jj,jk) &
-                                       + (vmask(ji,jj,jk)-1)*999._wp
+!jc_alt
+!                  tabres(ji,jj,jk,1) = zrhox * e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) * vmask(ji,jj,jk) * vv(ji,jj,jk,Kmm_a) &
+!                                     & + (vmask(ji,jj,jk)-1._wp) * 999._wp
+                  tabres(ji,jj,jk,1) = zrhox * e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) * vmask(ji,jj,jk) * vv(ji,jj,jk,Kmm_a) 
+!jc_alt
+!                  tabres(ji,jj,jk,2) = zrhox * e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) * vmask(ji,jj,jk) &
+!                                     & + (vmask(ji,jj,jk)-1._wp) * 999._wp
+                  tabres(ji,jj,jk,2) = zrhox * e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) * vmask(ji,jj,jk)
                END DO
             END DO
@@ -696,5 +711,7 @@
                N_in = 0
                DO jk=k1,k2
-                  IF (tabres(ji,jj,jk,2) < -900) EXIT
+!jc_alt
+!                  IF (tabres(ji,jj,jk,2) < -900._wp) EXIT
+                  IF (tabres(ji,jj,jk,2) == 0) EXIT
                   N_in = N_in + 1
                   tabin(jk) = tabres(ji,jj,jk,1)/tabres(ji,jj,jk,2)
@@ -705,12 +722,12 @@
                   IF (vmask(ji,jj,jk) == 0) EXIT
                   N_out = N_out + 1
-                  h_out(N_out) = e3v_n(ji,jj,jk)
+                  h_out(N_out) = e3v(ji,jj,jk,Kmm_a)
                ENDDO
                IF (N_in * N_out > 0) THEN
                   h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in))
+                  excess = 0._wp
                   IF (h_diff < -1.e-4) then
-!Even if bathy at T points match it's possible for the U points to be deeper in the child grid. 
+!Even if bathy at T points match it's possible for the V points to be deeper in the child grid. 
 !In this case we need to move transport from the child grid cells below bed of parent grid into the bottom cell.
-                     excess = 0._wp
                      DO jk=N_in,1,-1
                         thick = MIN(-1*h_diff, h_in(jk))
@@ -725,23 +742,30 @@
                      ENDDO
                   ENDIF
-                  CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out)
+                  CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1)
                   tabres_child(ji,jj,N_out) = tabres_child(ji,jj,N_out) + excess/(e1v(ji,jj)*h_out(N_out))
                ENDIF
             ENDDO
          ENDDO
-
-         DO jk=1,jpk
+         !
+         DO jk=1,jpkm1
             DO jj=j1,j2
                DO ji=i1,i2
-                  !
-                  IF( .NOT.(lk_agrif_fstep.AND.(neuler==0)) ) THEN ! Add asselin part
-                     vb(ji,jj,jk) = vb(ji,jj,jk) & 
-                           & + atfp * ( tabres_child(ji,jj,jk) - vn(ji,jj,jk) ) * vmask(ji,jj,jk)
+                  IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN ! Add asselin part
+                     zvb  = vv(ji,jj,jk,Kbb_a) * e3v(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used
+                     zvno = vv(ji,jj,jk,Kmm_a) * e3v(ji,jj,jk,Krhs_a)
+                     zvnu = tabres_child(ji,jj,jk) * e3v(ji,jj,jk,Kmm_a)
+                     vv(ji,jj,jk,Kbb_a) = ( zvb + rn_atfp * ( zvnu - zvno) ) &      
+                                    & * vmask(ji,jj,jk) / e3v(ji,jj,jk,Kbb_a)
                   ENDIF
                   !
-                  vn(ji,jj,jk) = tabres_child(ji,jj,jk) * vmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+                  vv(ji,jj,jk,Kmm_a) = tabres_child(ji,jj,jk) * vmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+         IF  ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN
+            vv(i1:i2,j1:j2,1:jpkm1,Kbb_a)  = vv(i1:i2,j1:j2,1:jpkm1,Kmm_a)
+         ENDIF
+         !
       ENDIF
       ! 
@@ -767,5 +791,5 @@
             DO jj=j1,j2
                DO ji=i1,i2
-                  tabres(ji,jj,jk,1) = zrhox * e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk)
+                  tabres(ji,jj,jk,1) = zrhox * e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) * vv(ji,jj,jk,Kmm_a)
                END DO
             END DO
@@ -777,19 +801,19 @@
                   tabres(ji,jj,jk,1) = tabres(ji,jj,jk,1) * r1_e1v(ji,jj)
                   !
-                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part
-                     zvb  = vb(ji,jj,jk) * e3v_b(ji,jj,jk) ! fse3t_b prior update should be used
-                     zvno = vn(ji,jj,jk) * e3v_a(ji,jj,jk)
+                  IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN ! Add asselin part
+                     zvb  = vv(ji,jj,jk,Kbb_a) * e3v(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used
+                     zvno = vv(ji,jj,jk,Kmm_a) * e3v(ji,jj,jk,Krhs_a)
                      zvnu = tabres(ji,jj,jk,1)
-                     vb(ji,jj,jk) = ( zvb + atfp * ( zvnu - zvno) ) &      
-                                    & * vmask(ji,jj,jk) / e3v_b(ji,jj,jk)
+                     vv(ji,jj,jk,Kbb_a) = ( zvb + rn_atfp * ( zvnu - zvno) ) &      
+                                    & * vmask(ji,jj,jk) / e3v(ji,jj,jk,Kbb_a)
                   ENDIF
                   !
-                  vn(ji,jj,jk) = tabres(ji,jj,jk,1) * vmask(ji,jj,jk) / e3v_n(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         !
-         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN
-            vb(i1:i2,j1:j2,k1:k2)  = vn(i1:i2,j1:j2,k1:k2)
+                  vv(ji,jj,jk,Kmm_a) = tabres(ji,jj,jk,1) * vmask(ji,jj,jk) / e3v(ji,jj,jk,Kmm_a)
+               END DO
+            END DO
+         END DO
+         !
+         IF  ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN
+            vv(i1:i2,j1:j2,k1:k2,Kbb_a)  = vv(i1:i2,j1:j2,k1:k2,Kmm_a)
          ENDIF
          !
@@ -822,8 +846,8 @@
          IF (southern_side) THEN
             DO ji=i1,i2
-               zcor = vn_b(ji,j1-1) * hv_a(ji,j1-1) * r1_hv_n(ji,j1-1) - vn_b(ji,j1-1)
-               vn_b(ji,j1-1) = vn_b(ji,j1-1) + zcor
+               zcor = vv_b(ji,j1-1,Kmm_a) * hv(ji,j1-1,Krhs_a) * r1_hv(ji,j1-1,Kmm_a) - vv_b(ji,j1-1,Kmm_a)
+               vv_b(ji,j1-1,Kmm_a) = vv_b(ji,j1-1,Kmm_a) + zcor
                DO jk=1,jpkm1
-                  vn(ji,j1-1,jk) = vn(ji,j1-1,jk) + zcor * vmask(ji,j1-1,jk)
+                  vv(ji,j1-1,jk,Kmm_a) = vv(ji,j1-1,jk,Kmm_a) + zcor * vmask(ji,j1-1,jk)
                END DO 
             END DO
@@ -832,8 +856,8 @@
          IF (northern_side) THEN
             DO ji=i1,i2
-               zcor = vn_b(ji,j2+1) * hv_a(ji,j2+1) * r1_hv_n(ji,j2+1) - vn_b(ji,j2+1)
-               vn_b(ji,j2+1) = vn_b(ji,j2+1) + zcor
+               zcor = vv_b(ji,j2+1,Kmm_a) * hv(ji,j2+1,Krhs_a) * r1_hv(ji,j2+1,Kmm_a) - vv_b(ji,j2+1,Kmm_a)
+               vv_b(ji,j2+1,Kmm_a) = vv_b(ji,j2+1,Kmm_a) + zcor
                DO jk=1,jpkm1
-                  vn(ji,j2+1,jk) = vn(ji,j2+1,jk) + zcor * vmask(ji,j2+1,jk)
+                  vv(ji,j2+1,jk,Kmm_a) = vv(ji,j2+1,jk,Kmm_a) + zcor * vmask(ji,j2+1,jk)
                END DO 
             END DO
@@ -862,5 +886,5 @@
          DO jj=j1,j2
             DO ji=i1,i2
-               tabres(ji,jj) = zrhoy * un_b(ji,jj) * hu_n(ji,jj) * e2u(ji,jj)
+               tabres(ji,jj) = zrhoy * uu_b(ji,jj,Kmm_a) * hu(ji,jj,Kmm_a) * e2u(ji,jj)
             END DO
          END DO
@@ -873,30 +897,30 @@
                spgu(ji,jj) = 0._wp
                DO jk=1,jpkm1
-                  spgu(ji,jj) = spgu(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk)
+                  spgu(ji,jj) = spgu(ji,jj) + e3u(ji,jj,jk,Kmm_a) * uu(ji,jj,jk,Kmm_a)
                END DO
                !
-               zcorr = (tabres(ji,jj) - spgu(ji,jj)) * r1_hu_n(ji,jj)
+               zcorr = (tabres(ji,jj) - spgu(ji,jj)) * r1_hu(ji,jj,Kmm_a)
                DO jk=1,jpkm1              
-                  un(ji,jj,jk) = un(ji,jj,jk) + zcorr * umask(ji,jj,jk)           
+                  uu(ji,jj,jk,Kmm_a) = uu(ji,jj,jk,Kmm_a) + zcorr * umask(ji,jj,jk)           
                END DO
                !
                ! Update barotropic velocities:
                IF ( .NOT.ln_dynspg_ts .OR. (ln_dynspg_ts.AND.(.NOT.ln_bt_fw)) ) THEN
-                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part
-                     zcorr = (tabres(ji,jj) - un_b(ji,jj) * hu_a(ji,jj)) * r1_hu_b(ji,jj)
-                     ub_b(ji,jj) = ub_b(ji,jj) + atfp * zcorr * umask(ji,jj,1)
+                  IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN ! Add asselin part
+                     zcorr = (tabres(ji,jj) - uu_b(ji,jj,Kmm_a) * hu(ji,jj,Krhs_a)) * r1_hu(ji,jj,Kbb_a)
+                     uu_b(ji,jj,Kbb_a) = uu_b(ji,jj,Kbb_a) + rn_atfp * zcorr * umask(ji,jj,1)
                   END IF
                ENDIF    
-               un_b(ji,jj) = tabres(ji,jj) * r1_hu_n(ji,jj) * umask(ji,jj,1)
+               uu_b(ji,jj,Kmm_a) = tabres(ji,jj) * r1_hu(ji,jj,Kmm_a) * umask(ji,jj,1)
                !       
                ! Correct "before" velocities to hold correct bt component:
                spgu(ji,jj) = 0.e0
                DO jk=1,jpkm1
-                  spgu(ji,jj) = spgu(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk)
+                  spgu(ji,jj) = spgu(ji,jj) + e3u(ji,jj,jk,Kbb_a) * uu(ji,jj,jk,Kbb_a)
                END DO
                !
-               zcorr = ub_b(ji,jj) - spgu(ji,jj) * r1_hu_b(ji,jj)
+               zcorr = uu_b(ji,jj,Kbb_a) - spgu(ji,jj) * r1_hu(ji,jj,Kbb_a)
                DO jk=1,jpkm1              
-                  ub(ji,jj,jk) = ub(ji,jj,jk) + zcorr * umask(ji,jj,jk)           
+                  uu(ji,jj,jk,Kbb_a) = uu(ji,jj,jk,Kbb_a) + zcorr * umask(ji,jj,jk)           
                END DO
                !
@@ -904,6 +928,6 @@
          END DO
          !
-         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN
-            ub_b(i1:i2,j1:j2)  = un_b(i1:i2,j1:j2)
+         IF  ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN
+            uu_b(i1:i2,j1:j2,Kbb_a)  = uu_b(i1:i2,j1:j2,Kmm_a)
          ENDIF
       ENDIF
@@ -928,5 +952,5 @@
          DO jj=j1,j2
             DO ji=i1,i2
-               tabres(ji,jj) = zrhox * vn_b(ji,jj) * hv_n(ji,jj) * e1v(ji,jj) 
+               tabres(ji,jj) = zrhox * vv_b(ji,jj,Kmm_a) * hv(ji,jj,Kmm_a) * e1v(ji,jj) 
             END DO
          END DO
@@ -939,30 +963,30 @@
                spgv(ji,jj) = 0.e0
                DO jk=1,jpkm1
-                  spgv(ji,jj) = spgv(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk)
+                  spgv(ji,jj) = spgv(ji,jj) + e3v(ji,jj,jk,Kmm_a) * vv(ji,jj,jk,Kmm_a)
                END DO
                !
-               zcorr = (tabres(ji,jj) - spgv(ji,jj)) * r1_hv_n(ji,jj)
+               zcorr = (tabres(ji,jj) - spgv(ji,jj)) * r1_hv(ji,jj,Kmm_a)
                DO jk=1,jpkm1              
-                  vn(ji,jj,jk) = vn(ji,jj,jk) + zcorr * vmask(ji,jj,jk)           
+                  vv(ji,jj,jk,Kmm_a) = vv(ji,jj,jk,Kmm_a) + zcorr * vmask(ji,jj,jk)           
                END DO
                !
                ! Update barotropic velocities:
                IF ( .NOT.ln_dynspg_ts .OR. (ln_dynspg_ts.AND.(.NOT.ln_bt_fw)) ) THEN
-                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part
-                     zcorr = (tabres(ji,jj) - vn_b(ji,jj) * hv_a(ji,jj)) * r1_hv_b(ji,jj)
-                     vb_b(ji,jj) = vb_b(ji,jj) + atfp * zcorr * vmask(ji,jj,1)
+                  IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN ! Add asselin part
+                     zcorr = (tabres(ji,jj) - vv_b(ji,jj,Kmm_a) * hv(ji,jj,Krhs_a)) * r1_hv(ji,jj,Kbb_a)
+                     vv_b(ji,jj,Kbb_a) = vv_b(ji,jj,Kbb_a) + rn_atfp * zcorr * vmask(ji,jj,1)
                   END IF
                ENDIF              
-               vn_b(ji,jj) = tabres(ji,jj) * r1_hv_n(ji,jj) * vmask(ji,jj,1)
+               vv_b(ji,jj,Kmm_a) = tabres(ji,jj) * r1_hv(ji,jj,Kmm_a) * vmask(ji,jj,1)
                !       
                ! Correct "before" velocities to hold correct bt component:
                spgv(ji,jj) = 0.e0
                DO jk=1,jpkm1
-                  spgv(ji,jj) = spgv(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk)
+                  spgv(ji,jj) = spgv(ji,jj) + e3v(ji,jj,jk,Kbb_a) * vv(ji,jj,jk,Kbb_a)
                END DO
                !
-               zcorr = vb_b(ji,jj) - spgv(ji,jj) * r1_hv_b(ji,jj)
+               zcorr = vv_b(ji,jj,Kbb_a) - spgv(ji,jj) * r1_hv(ji,jj,Kbb_a)
                DO jk=1,jpkm1              
-                  vb(ji,jj,jk) = vb(ji,jj,jk) + zcorr * vmask(ji,jj,jk)           
+                  vv(ji,jj,jk,Kbb_a) = vv(ji,jj,jk,Kbb_a) + zcorr * vmask(ji,jj,jk)           
                END DO
                !
@@ -970,6 +994,6 @@
          END DO
          !
-         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN
-            vb_b(i1:i2,j1:j2)  = vn_b(i1:i2,j1:j2)
+         IF  ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN
+            vv_b(i1:i2,j1:j2,Kbb_a)  = vv_b(i1:i2,j1:j2,Kmm_a)
          ENDIF
          !
@@ -993,13 +1017,13 @@
          DO jj=j1,j2
             DO ji=i1,i2
-               tabres(ji,jj) = sshn(ji,jj)
+               tabres(ji,jj) = ssh(ji,jj,Kmm_a)
             END DO
          END DO
       ELSE
-         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN
+         IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN
             DO jj=j1,j2
                DO ji=i1,i2
-                  sshb(ji,jj) =   sshb(ji,jj) &
-                        & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1)
+                  ssh(ji,jj,Kbb_a) =   ssh(ji,jj,Kbb_a) &
+                        & + rn_atfp * ( tabres(ji,jj) - ssh(ji,jj,Kmm_a) ) * tmask(ji,jj,1)
                END DO
             END DO
@@ -1008,10 +1032,10 @@
          DO jj=j1,j2
             DO ji=i1,i2
-               sshn(ji,jj) = tabres(ji,jj) * tmask(ji,jj,1)
-            END DO
-         END DO
-         !
-         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN
-            sshb(i1:i2,j1:j2)  = sshn(i1:i2,j1:j2)
+               ssh(ji,jj,Kmm_a) = tabres(ji,jj) * tmask(ji,jj,1)
+            END DO
+         END DO
+         !
+         IF  ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN
+            ssh(i1:i2,j1:j2,Kbb_a)  = ssh(i1:i2,j1:j2,Kmm_a)
          ENDIF
          !
@@ -1093,14 +1117,14 @@
          IF (western_side) THEN
             DO jj=j1,j2
-               zcor = rdt * r1_e1e2t(i1  ,jj) * e2u(i1,jj) * (ub2_b(i1,jj)-tabres(i1,jj)) 
-               sshn(i1  ,jj) = sshn(i1  ,jj) + zcor
-               IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) sshb(i1  ,jj) = sshb(i1  ,jj) + atfp * zcor
+               zcor = rn_Dt * r1_e1e2t(i1  ,jj) * e2u(i1,jj) * (ub2_b(i1,jj)-tabres(i1,jj)) 
+               ssh(i1  ,jj,Kmm_a) = ssh(i1  ,jj,Kmm_a) + zcor
+               IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) ssh(i1  ,jj,Kbb_a) = ssh(i1  ,jj,Kbb_a) + rn_atfp * zcor
             END DO
          ENDIF
          IF (eastern_side) THEN
             DO jj=j1,j2
-               zcor = - rdt * r1_e1e2t(i2+1,jj) * e2u(i2,jj) * (ub2_b(i2,jj)-tabres(i2,jj))
-               sshn(i2+1,jj) = sshn(i2+1,jj) + zcor
-               IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) sshb(i2+1,jj) = sshb(i2+1,jj) + atfp * zcor
+               zcor = - rn_Dt * r1_e1e2t(i2+1,jj) * e2u(i2,jj) * (ub2_b(i2,jj)-tabres(i2,jj))
+               ssh(i2+1,jj,Kmm_a) = ssh(i2+1,jj,Kmm_a) + zcor
+               IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) ssh(i2+1,jj,Kbb_a) = ssh(i2+1,jj,Kbb_a) + rn_atfp * zcor
             END DO
          ENDIF
@@ -1181,14 +1205,14 @@
          IF (southern_side) THEN
             DO ji=i1,i2
-               zcor = rdt * r1_e1e2t(ji,j1  ) * e1v(ji,j1  ) * (vb2_b(ji,j1)-tabres(ji,j1))
-               sshn(ji,j1  ) = sshn(ji,j1  ) + zcor
-               IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) sshb(ji,j1  ) = sshb(ji,j1) + atfp * zcor
+               zcor = rn_Dt * r1_e1e2t(ji,j1  ) * e1v(ji,j1  ) * (vb2_b(ji,j1)-tabres(ji,j1))
+               ssh(ji,j1  ,Kmm_a) = ssh(ji,j1  ,Kmm_a) + zcor
+               IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) ssh(ji,j1  ,Kbb_a) = ssh(ji,j1,Kbb_a) + rn_atfp * zcor
             END DO
          ENDIF
          IF (northern_side) THEN               
             DO ji=i1,i2
-               zcor = - rdt * r1_e1e2t(ji,j2+1) * e1v(ji,j2  ) * (vb2_b(ji,j2)-tabres(ji,j2))
-               sshn(ji,j2+1) = sshn(ji,j2+1) + zcor
-               IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) sshb(ji,j2+1) = sshb(ji,j2+1) + atfp * zcor
+               zcor = - rn_Dt * r1_e1e2t(ji,j2+1) * e1v(ji,j2  ) * (vb2_b(ji,j2)-tabres(ji,j2))
+               ssh(ji,j2+1,Kmm_a) = ssh(ji,j2+1,Kmm_a) + zcor
+               IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) ssh(ji,j2+1,Kbb_a) = ssh(ji,j2+1,Kbb_a) + rn_atfp * zcor
             END DO
          ENDIF
@@ -1319,5 +1343,5 @@
             DO jj=j1,j2
                DO ji=i1,i2
-                  ptab(ji,jj,jk) = e3t_0(ji,jj,jk) * (1._wp + sshn(ji,jj) &
+                  ptab(ji,jj,jk) = e3t_0(ji,jj,jk) * (1._wp + ssh(ji,jj,Kmm_a) &
                                      & *ssmask(ji,jj)/(ht_0(ji,jj)-1._wp + ssmask(ji,jj)))
                END DO
@@ -1330,22 +1354,22 @@
          ! Save "old" scale factor (prior update) for subsequent asselin correction
          ! of prognostic variables
-         e3t_a(i1:i2,j1:j2,1:jpkm1) = e3t_n(i1:i2,j1:j2,1:jpkm1)
-
-         ! One should also save e3t_b, but lacking of workspace...
-!         hdivn(i1:i2,j1:j2,1:jpkm1)   = e3t_b(i1:i2,j1:j2,1:jpkm1)
-
-         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0) )) THEN
+         e3t(i1:i2,j1:j2,1:jpkm1,Krhs_a) = e3t(i1:i2,j1:j2,1:jpkm1,Kmm_a)
+
+         ! One should also save e3t(:,:,:,Kbb_a), but lacking of workspace...
+!         hdiv(i1:i2,j1:j2,1:jpkm1)   = e3t(i1:i2,j1:j2,1:jpkm1,Kbb_a)
+
+         IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler) )) THEN
             DO jk = 1, jpkm1
                DO jj=j1,j2
                   DO ji=i1,i2
-                     e3t_b(ji,jj,jk) =  e3t_b(ji,jj,jk) &
-                           & + atfp * ( ptab(ji,jj,jk) - e3t_n(ji,jj,jk) )
+                     e3t(ji,jj,jk,Kbb_a) =  e3t(ji,jj,jk,Kbb_a) &
+                           & + rn_atfp * ( ptab(ji,jj,jk) - e3t(ji,jj,jk,Kmm_a) )
                   END DO
                END DO
             END DO
             !
-            e3w_b  (i1:i2,j1:j2,1) = e3w_0(i1:i2,j1:j2,1) + e3t_b(i1:i2,j1:j2,1) - e3t_0(i1:i2,j1:j2,1)
-            gdepw_b(i1:i2,j1:j2,1) = 0.0_wp
-            gdept_b(i1:i2,j1:j2,1) = 0.5_wp * e3w_b(i1:i2,j1:j2,1)
+            e3w  (i1:i2,j1:j2,1,Kbb_a) = e3w_0(i1:i2,j1:j2,1) + e3t(i1:i2,j1:j2,1,Kbb_a) - e3t_0(i1:i2,j1:j2,1)
+            gdepw(i1:i2,j1:j2,1,Kbb_a) = 0.0_wp
+            gdept(i1:i2,j1:j2,1,Kbb_a) = 0.5_wp * e3w(i1:i2,j1:j2,1,Kbb_a)
             !
             DO jk = 2, jpk
@@ -1353,11 +1377,11 @@
                   DO ji = i1,i2            
                      zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))
-                     e3w_b(ji,jj,jk)  = e3w_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * tmask(ji,jj,jk) ) *        & 
-                     &                                        ( e3t_b(ji,jj,jk-1) - e3t_0(ji,jj,jk-1) )  &
+                     e3w(ji,jj,jk,Kbb_a)  = e3w_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * tmask(ji,jj,jk) ) *        & 
+                     &                                        ( e3t(ji,jj,jk-1,Kbb_a) - e3t_0(ji,jj,jk-1) )  &
                      &                                  +            0.5_wp * tmask(ji,jj,jk)   *        &
-                     &                                        ( e3t_b(ji,jj,jk  ) - e3t_0(ji,jj,jk  ) )
-                     gdepw_b(ji,jj,jk) = gdepw_b(ji,jj,jk-1) + e3t_b(ji,jj,jk-1)
-                     gdept_b(ji,jj,jk) =      zcoef  * ( gdepw_b(ji,jj,jk  ) + 0.5 * e3w_b(ji,jj,jk))  &
-                         &               + (1-zcoef) * ( gdept_b(ji,jj,jk-1) +       e3w_b(ji,jj,jk)) 
+                     &                                        ( e3t(ji,jj,jk  ,Kbb_a) - e3t_0(ji,jj,jk  ) )
+                     gdepw(ji,jj,jk,Kbb_a) = gdepw(ji,jj,jk-1,Kbb_a) + e3t(ji,jj,jk-1,Kbb_a)
+                     gdept(ji,jj,jk,Kbb_a) =      zcoef  * ( gdepw(ji,jj,jk  ,Kbb_a) + 0.5 * e3w(ji,jj,jk,Kbb_a))  &
+                         &               + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb_a) +       e3w(ji,jj,jk,Kbb_a)) 
                   END DO
                END DO
@@ -1370,17 +1394,17 @@
          !
          ! Update vertical scale factor at T-points:
-         e3t_n(i1:i2,j1:j2,1:jpkm1) = ptab(i1:i2,j1:j2,1:jpkm1)
+         e3t(i1:i2,j1:j2,1:jpkm1,Kmm_a) = ptab(i1:i2,j1:j2,1:jpkm1)
          !
          ! Update total depth:
-         ht_n(i1:i2,j1:j2) = 0._wp
+         ht(i1:i2,j1:j2) = 0._wp
          DO jk = 1, jpkm1
-            ht_n(i1:i2,j1:j2) = ht_n(i1:i2,j1:j2) + e3t_n(i1:i2,j1:j2,jk) * tmask(i1:i2,j1:j2,jk)
+            ht(i1:i2,j1:j2) = ht(i1:i2,j1:j2) + e3t(i1:i2,j1:j2,jk,Kmm_a) * tmask(i1:i2,j1:j2,jk)
          END DO
          !
          ! Update vertical scale factor at W-points and depths:
-         e3w_n (i1:i2,j1:j2,1) = e3w_0(i1:i2,j1:j2,1) + e3t_n(i1:i2,j1:j2,1) - e3t_0(i1:i2,j1:j2,1)
-         gdept_n(i1:i2,j1:j2,1) = 0.5_wp * e3w_n(i1:i2,j1:j2,1)
-         gdepw_n(i1:i2,j1:j2,1) = 0.0_wp
-         gde3w_n(i1:i2,j1:j2,1) = gdept_n(i1:i2,j1:j2,1) - (ht_n(i1:i2,j1:j2)-ht_0(i1:i2,j1:j2)) ! Last term in the rhs is ssh
+         e3w (i1:i2,j1:j2,1,Kmm_a) = e3w_0(i1:i2,j1:j2,1) + e3t(i1:i2,j1:j2,1,Kmm_a) - e3t_0(i1:i2,j1:j2,1)
+         gdept(i1:i2,j1:j2,1,Kmm_a) = 0.5_wp * e3w(i1:i2,j1:j2,1,Kmm_a)
+         gdepw(i1:i2,j1:j2,1,Kmm_a) = 0.0_wp
+         gde3w(i1:i2,j1:j2,1) = gdept(i1:i2,j1:j2,1,Kmm_a) - (ht(i1:i2,j1:j2)-ht_0(i1:i2,j1:j2)) ! Last term in the rhs is ssh
          !
          DO jk = 2, jpk
@@ -1388,19 +1412,19 @@
                DO ji = i1,i2            
                zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))
-               e3w_n(ji,jj,jk)  = e3w_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * tmask(ji,jj,jk) ) * ( e3t_n(ji,jj,jk-1) - e3t_0(ji,jj,jk-1) )   &
-               &                                  +            0.5_wp * tmask(ji,jj,jk)   * ( e3t_n(ji,jj,jk  ) - e3t_0(ji,jj,jk  ) )
-               gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1)
-               gdept_n(ji,jj,jk) =      zcoef  * ( gdepw_n(ji,jj,jk  ) + 0.5 * e3w_n(ji,jj,jk))  &
-                   &               + (1-zcoef) * ( gdept_n(ji,jj,jk-1) +       e3w_n(ji,jj,jk)) 
-               gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk) - (ht_n(ji,jj)-ht_0(ji,jj)) ! Last term in the rhs is ssh
-               END DO
-            END DO
-         END DO
-         !
-         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN
-            e3t_b (i1:i2,j1:j2,1:jpk)  = e3t_n (i1:i2,j1:j2,1:jpk)
-            e3w_b (i1:i2,j1:j2,1:jpk)  = e3w_n (i1:i2,j1:j2,1:jpk)
-            gdepw_b(i1:i2,j1:j2,1:jpk) = gdepw_n(i1:i2,j1:j2,1:jpk)
-            gdept_b(i1:i2,j1:j2,1:jpk) = gdept_n(i1:i2,j1:j2,1:jpk)
+               e3w(ji,jj,jk,Kmm_a)  = e3w_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * tmask(ji,jj,jk) ) * ( e3t(ji,jj,jk-1,Kmm_a) - e3t_0(ji,jj,jk-1) )   &
+               &                                  +            0.5_wp * tmask(ji,jj,jk)   * ( e3t(ji,jj,jk  ,Kmm_a) - e3t_0(ji,jj,jk  ) )
+               gdepw(ji,jj,jk,Kmm_a) = gdepw(ji,jj,jk-1,Kmm_a) + e3t(ji,jj,jk-1,Kmm_a)
+               gdept(ji,jj,jk,Kmm_a) =      zcoef  * ( gdepw(ji,jj,jk  ,Kmm_a) + 0.5 * e3w(ji,jj,jk,Kmm_a))  &
+                   &               + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm_a) +       e3w(ji,jj,jk,Kmm_a)) 
+               gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm_a) - (ht(ji,jj)-ht_0(ji,jj)) ! Last term in the rhs is ssh
+               END DO
+            END DO
+         END DO
+         !
+         IF  ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN
+            e3t (i1:i2,j1:j2,1:jpk,Kbb_a)  = e3t (i1:i2,j1:j2,1:jpk,Kmm_a)
+            e3w (i1:i2,j1:j2,1:jpk,Kbb_a)  = e3w (i1:i2,j1:j2,1:jpk,Kmm_a)
+            gdepw(i1:i2,j1:j2,1:jpk,Kbb_a) = gdepw(i1:i2,j1:j2,1:jpk,Kmm_a)
+            gdept(i1:i2,j1:j2,1:jpk,Kbb_a) = gdept(i1:i2,j1:j2,1:jpk,Kmm_a)
          ENDIF
          !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_top_interp.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_top_interp.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_top_interp.F90	(revision 12928)
@@ -18,4 +18,5 @@
    USE par_trc
    USE trc
+   USE vremap
    !
    USE lib_mpp     ! MPP library
@@ -48,5 +49,5 @@
    END SUBROUTINE Agrif_trc
 
-   SUBROUTINE interptrn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before, nb, ndir )
+   SUBROUTINE interptrn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before )
       !!----------------------------------------------------------------------
       !!                  *** ROUTINE interptrn ***
@@ -55,16 +56,15 @@
       INTEGER                                     , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, n1, n2
       LOGICAL                                     , INTENT(in   ) ::   before
-      INTEGER                                     , INTENT(in   ) ::   nb , ndir
       !
-      INTEGER  ::   ji, jj, jk, jn, iref, jref, ibdy, jbdy   ! dummy loop indices
+      INTEGER  ::   ji, jj, jk, jn, ibdy, jbdy   ! dummy loop indices
       INTEGER  ::   imin, imax, jmin, jmax, N_in, N_out
       REAL(wp) ::   zrho, z1, z2, z3, z4, z5, z6, z7
-      LOGICAL :: western_side, eastern_side,northern_side,southern_side
+
       ! vertical interpolation:
-      REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,n1:n2) :: ptab_child
-      REAL(wp), DIMENSION(k1:k2,n1:n2-1) :: tabin
+      REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,1:jptra) :: ptab_child
+      REAL(wp), DIMENSION(k1:k2,1:jptra) :: tabin
       REAL(wp), DIMENSION(k1:k2) :: h_in
       REAL(wp), DIMENSION(1:jpk) :: h_out
-      REAL(wp) :: h_diff
+      !!----------------------------------------------------------------------
 
       IF( before ) THEN         
@@ -73,5 +73,5 @@
                DO jj=j1,j2
                  DO ji=i1,i2
-                       ptab(ji,jj,jk,jn) = trn(ji,jj,jk,jn)
+                       ptab(ji,jj,jk,jn) = tr(ji,jj,jk,jn,Kmm_a)
                  END DO
               END DO
@@ -83,5 +83,5 @@
            DO jj=j1,j2
               DO ji=i1,i2
-                 ptab(ji,jj,jk,jptra+1) = tmask(ji,jj,jk) * e3t_n(ji,jj,jk) 
+                 ptab(ji,jj,jk,jptra+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a) 
               END DO
            END DO
@@ -90,16 +90,8 @@
       ELSE 
 
-         western_side  = (nb == 1).AND.(ndir == 1)   ;   eastern_side  = (nb == 1).AND.(ndir == 2)
-         southern_side = (nb == 2).AND.(ndir == 1)   ;   northern_side = (nb == 2).AND.(ndir == 2)
-
-# if defined key_vertical              
+# if defined key_vertical
          DO jj=j1,j2
             DO ji=i1,i2
-               iref = ji
-               jref = jj
-               if(western_side) iref=MAX(2,ji)
-               if(eastern_side) iref=MIN(nlci-1,ji)
-               if(southern_side) jref=MAX(2,jj)
-               if(northern_side) jref=MIN(nlcj-1,jj)
+               ptab_child(ji,jj,:) = 0._wp
                N_in = 0
                DO jk=k1,k2 !k2 = jpk of parent grid
@@ -111,12 +103,10 @@
                N_out = 0
                DO jk=1,jpk ! jpk of child grid
-                  IF (tmask(iref,jref,jk) == 0) EXIT 
+                  IF (tmask(ji,jj,jk) == 0) EXIT 
                   N_out = N_out + 1
-                  h_out(jk) = e3t_n(iref,jref,jk)
+                  h_out(jk) = e3t(ji,jj,jk,Krhs_a)
                ENDDO
                IF (N_in > 0) THEN
-                  DO jn=1,jptra
-                     call reconstructandremap(tabin(1:N_in,jn),h_in,ptab_child(ji,jj,1:N_out,jn),h_out,N_in,N_out)
-                  ENDDO
+                  CALL reconstructandremap(tabin(1:N_in,1:jptra),h_in,ptab_child(ji,jj,1:N_out,1:jptra),h_out,N_in,N_out,jptra)
                ENDIF
             ENDDO
@@ -127,135 +117,6 @@
          !
          DO jn=1, jptra
-            tra(i1:i2,j1:j2,1:jpk,jn)=ptab_child(i1:i2,j1:j2,1:jpk,jn)*tmask(i1:i2,j1:j2,1:jpk) 
+            tr(i1:i2,j1:j2,1:jpk,jn,Krhs_a)=ptab_child(i1:i2,j1:j2,1:jpk,jn)*tmask(i1:i2,j1:j2,1:jpk) 
          END DO
-
-         IF ( .NOT.lk_agrif_clp ) THEN 
-            !
-            imin = i1 ; imax = i2
-            jmin = j1 ; jmax = j2
-            ! 
-            ! Remove CORNERS
-            IF((nbondj == -1).OR.(nbondj == 2)) jmin = 2 + nbghostcells
-            IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj - nbghostcells - 1
-            IF((nbondi == -1).OR.(nbondi == 2)) imin = 2 + nbghostcells
-            IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci - nbghostcells - 1      
-            !
-            IF( eastern_side ) THEN
-               zrho = Agrif_Rhox()
-               z1 = ( zrho - 1._wp ) * 0.5_wp                    
-               z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )         
-               z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp )
-               z7 =       - ( zrho - 1._wp ) / ( zrho + 3._wp )
-               z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7
-               !
-               ibdy = nlci-nbghostcells
-               DO jn = 1, jptra
-                  tra(ibdy+1,jmin:jmax,1:jpkm1,jn) = z1 * ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) + z2 * ptab_child(ibdy,jmin:jmax,1:jpkm1,jn)
-                  DO jk = 1, jpkm1
-                     DO jj = jmin,jmax
-                        IF( umask(ibdy-1,jj,jk) == 0._wp ) THEN
-                           tra(ibdy,jj,jk,jn) = tra(ibdy+1,jj,jk,jn) * tmask(ibdy,jj,jk)
-                        ELSE
-                           tra(ibdy,jj,jk,jn)=(z4*tra(ibdy+1,jj,jk,jn)+z3*tra(ibdy-1,jj,jk,jn))*tmask(ibdy,jj,jk)
-                           IF( un(ibdy-1,jj,jk) > 0._wp ) THEN
-                              tra(ibdy,jj,jk,jn)=( z6*tra(ibdy-1,jj,jk,jn)+z5*tra(ibdy+1,jj,jk,jn) & 
-                                                 + z7*tra(ibdy-2,jj,jk,jn) ) * tmask(ibdy,jj,jk)
-                           ENDIF
-                        ENDIF
-                     END DO
-                  END DO
-                  ! Restore ghost points:
-                  tra(ibdy+1,jmin:jmax,1:jpkm1,jn) = ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy+1,jmin:jmax,1:jpkm1)
-               END DO
-            ENDIF
-            ! 
-            IF( northern_side ) THEN
-               zrho = Agrif_Rhoy()
-               z1 = ( zrho - 1._wp ) * 0.5_wp                    
-               z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )         
-               z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp )
-               z7 =       - ( zrho - 1._wp ) / ( zrho + 3._wp )
-               z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7
-               !
-               jbdy = nlcj-nbghostcells         
-               DO jn = 1, jptra
-                  tra(imin:imax,jbdy+1,1:jpkm1,jn) = z1 * ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) + z2 * ptab_child(imin:imax,jbdy,1:jpkm1,jn)
-                  DO jk = 1, jpkm1
-                     DO ji = imin,imax
-                        IF( vmask(ji,jbdy-1,jk) == 0._wp ) THEN
-                           tra(ji,jbdy,jk,jn) = tra(ji,jbdy+1,jk,jn) * tmask(ji,jbdy,jk)
-                        ELSE
-                           tra(ji,jbdy,jk,jn)=(z4*tra(ji,jbdy+1,jk,jn)+z3*tra(ji,jbdy-1,jk,jn))*tmask(ji,jbdy,jk)        
-                           IF (vn(ji,jbdy-1,jk) > 0._wp ) THEN
-                              tra(ji,jbdy,jk,jn)=( z6*tra(ji,jbdy-1,jk,jn)+z5*tra(ji,jbdy+1,jk,jn)  &
-                                                 + z7*tra(ji,jbdy-2,jk,jn) ) * tmask(ji,jbdy,jk)
-                           ENDIF
-                        ENDIF
-                     END DO
-                  END DO
-                  ! Restore ghost points:
-                  tra(imin:imax,jbdy+1,1:jpkm1,jn) = ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) * tmask(imin:imax,jbdy+1,1:jpkm1)
-               END DO
-            ENDIF
-            !
-            IF( western_side ) THEN
-               zrho = Agrif_Rhox()
-               z1 = ( zrho - 1._wp ) * 0.5_wp                    
-               z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )         
-               z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp )
-               z7 =       - ( zrho - 1._wp ) / ( zrho + 3._wp )
-               z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7
-               !    
-               ibdy = 1+nbghostcells       
-               DO jn = 1, jptra
-                  tra(ibdy-1,jmin:jmax,1:jpkm1,jn) = z1 * ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) + z2 * ptab_child(ibdy,jmin:jmax,1:jpkm1,jn)
-                  DO jk = 1, jpkm1
-                     DO jj = jmin,jmax
-                        IF( umask(ibdy,jj,jk) == 0._wp ) THEN
-                           tra(ibdy,jj,jk,jn) = tra(ibdy-1,jj,jk,jn) * tmask(ibdy,jj,jk)
-                        ELSE
-                           tra(ibdy,jj,jk,jn)=(z4*tra(ibdy-1,jj,jk,jn)+z3*tra(ibdy+1,jj,jk,jn))*tmask(ibdy,jj,jk)        
-                           IF( un(ibdy,jj,jk) < 0._wp ) THEN
-                              tra(ibdy,jj,jk,jn)=( z6*tra(ibdy+1,jj,jk,jn)+z5*tra(ibdy-1,jj,jk,jn) &
-                                                 + z7*tra(ibdy+2,jj,jk,jn) ) * tmask(ibdy,jj,jk)
-                           ENDIF
-                        ENDIF
-                     END DO
-                  END DO
-                  ! Restore ghost points:
-                  tra(ibdy-1,jmin:jmax,1:jpkm1,jn) = ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy-1,jmin:jmax,1:jpkm1)
-               END DO
-            ENDIF
-            !
-            IF( southern_side ) THEN
-               zrho = Agrif_Rhoy()
-               z1 = ( zrho - 1._wp ) * 0.5_wp                    
-               z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )         
-               z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp )
-               z7 =       - ( zrho - 1._wp ) / ( zrho + 3._wp )
-               z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7
-               !  
-               jbdy=1+nbghostcells        
-               DO jn = 1, jptra
-                  tra(imin:imax,jbdy-1,1:jpkm1,jn) = z1 * ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) + z2 * ptab_child(imin:imax,jbdy,1:jpkm1,jn)
-                  DO jk = 1, jpkm1      
-                     DO ji = imin,imax
-                        IF( vmask(ji,jbdy,jk) == 0._wp ) THEN
-                           tra(ji,jbdy,jk,jn)=tra(ji,jbdy-1,jk,jn) * tmask(ji,jbdy,jk)
-                        ELSE
-                           tra(ji,jbdy,jk,jn)=(z4*tra(ji,jbdy-1,jk,jn)+z3*tra(ji,jbdy+1,jk,jn))*tmask(ji,jbdy,jk)
-                           IF( vn(ji,jbdy,jk) < 0._wp ) THEN
-                              tra(ji,jbdy,jk,jn)=( z6*tra(ji,jbdy+1,jk,jn)+z5*tra(ji,jbdy-1,jk,jn) & 
-                                                 + z7*tra(ji,jbdy+2,jk,jn) ) * tmask(ji,jbdy,jk)
-                           ENDIF
-                        ENDIF
-                     END DO
-                  END DO
-                  ! Restore ghost points:
-                  tra(imin:imax,jbdy-1,1:jpkm1,jn) = ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) * tmask(imin:imax,jbdy-1,1:jpkm1)
-               END DO
-            ENDIF
-            !
-         ENDIF
 
       ENDIF
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_top_sponge.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_top_sponge.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_top_sponge.F90	(revision 12928)
@@ -20,4 +20,5 @@
    USE agrif_oce
    USE agrif_oce_sponge
+   USE vremap
    !
    USE in_out_manager
@@ -66,10 +67,10 @@
       !
       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp) ::   zabe1, zabe2
-      REAL(wp), DIMENSION(i1:i2,j1:j2)             ::   ztu, ztv
-      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::   trbdiff
+      REAL(wp) ::   zabe1, zabe2, ztrelax
+      REAL(wp), DIMENSION(i1:i2,j1:j2)               ::   ztu, ztv
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,1:jptra) ::   trbdiff
       ! vertical interpolation:
-      REAL(wp), DIMENSION(i1:i2,j1:j2,jpk,n1:n2) ::tabres_child
-      REAL(wp), DIMENSION(k1:k2,n1:n2-1) :: tabin
+      REAL(wp), DIMENSION(i1:i2,j1:j2,jpk,1:jptra) ::tabres_child
+      REAL(wp), DIMENSION(k1:k2,1:jptra) :: tabin
       REAL(wp), DIMENSION(k1:k2) :: h_in
       REAL(wp), DIMENSION(1:jpk) :: h_out
@@ -83,5 +84,5 @@
                DO jj=j1,j2
                   DO ji=i1,i2
-                     tabres(ji,jj,jk,jn) = trb(ji,jj,jk,jn)
+                     tabres(ji,jj,jk,jn) = tr(ji,jj,jk,jn,Kbb_a)
                   END DO
                END DO
@@ -93,5 +94,5 @@
             DO jj=j1,j2
                DO ji=i1,i2
-                  tabres(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t_n(ji,jj,jk) 
+                  tabres(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kbb_a) 
                END DO
             END DO
@@ -114,12 +115,8 @@
                   IF (tmask(ji,jj,jk) == 0) EXIT 
                   N_out = N_out + 1
-                  h_out(jk) = e3t_n(ji,jj,jk) !Child grid scale factors. Could multiply by e1e2t here instead of division above
+                  h_out(jk) = e3t(ji,jj,jk,Kbb_a) !Child grid scale factors. Could multiply by e1e2t here instead of division above
                ENDDO
                IF (N_in > 0) THEN
-                  h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in))
-                  tabres(ji,jj,k2,:) = tabres(ji,jj,k2-1,:) !what is this line for?????
-                  DO jn=1,jptra
-                     call reconstructandremap(tabin(1:N_in,jn),h_in,tabres_child(ji,jj,1:N_out,jn),h_out,N_in,N_out)
-                  ENDDO
+                  CALL reconstructandremap(tabin(1:N_in,1:jptra),h_in,tabres_child(ji,jj,1:N_out,1:jptra),h_out,N_in,N_out,jptra)
                ENDIF
             ENDDO
@@ -131,7 +128,7 @@
                DO jk=1,jpkm1
 # if defined key_vertical
-                  trbdiff(ji,jj,jk,1:jptra) = trb(ji,jj,jk,1:jptra) - tabres_child(ji,jj,jk,1:jptra)
+                  trbdiff(ji,jj,jk,1:jptra) = tr(ji,jj,jk,1:jptra,Kbb_a) - tabres_child(ji,jj,jk,1:jptra)
 # else
-                  trbdiff(ji,jj,jk,1:jptra) = trb(ji,jj,jk,1:jptra) - tabres(ji,jj,jk,1:jptra)
+                  trbdiff(ji,jj,jk,1:jptra) = tr(ji,jj,jk,1:jptra,Kbb_a) - tabres(ji,jj,jk,1:jptra)
 # endif
                ENDDO
@@ -139,10 +136,15 @@
          ENDDO
 
+         !* set relaxation time scale
+         IF( l_1st_euler .AND. lk_agrif_fstep ) THEN   ;   ztrelax =   rn_trelax_tra  / (        rn_Dt )
+         ELSE                                          ;   ztrelax =   rn_trelax_tra  / (2._wp * rn_Dt )
+         ENDIF
+
          DO jn = 1, jptra
             DO jk = 1, jpkm1
                DO jj = j1,j2-1
                   DO ji = i1,i2-1
-                     zabe1 = fsaht_spu(ji,jj) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk) * umask(ji,jj,jk)
-                     zabe2 = fsaht_spv(ji,jj) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk) * vmask(ji,jj,jk)
+                     zabe1 = rn_sponge_tra * fspu(ji,jj) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm_a) * umask(ji,jj,jk)
+                     zabe2 = rn_sponge_tra * fspv(ji,jj) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm_a) * vmask(ji,jj,jk)
                      ztu(ji,jj) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jn) - trbdiff(ji,jj,jk,jn) )
                      ztv(ji,jj) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) )
@@ -153,7 +155,8 @@
                   DO ji = i1+1,i2-1
                      IF( .NOT. tabspongedone_trn(ji,jj) ) THEN 
-                        tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + (  ztu(ji,jj) - ztu(ji-1,jj  )     &
+                        tr(ji,jj,jk,jn,Krhs_a) = tr(ji,jj,jk,jn,Krhs_a) + (  ztu(ji,jj) - ztu(ji-1,jj  )     &
                            &                                   + ztv(ji,jj) - ztv(ji  ,jj-1)  )  &
-                           &                                * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+                           &                                * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm_a)  &
+                           &                                - ztrelax * fspt(ji,jj) * trbdiff(ji,jj,jk,jn)
                      ENDIF
                   END DO
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_top_update.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_top_update.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_top_update.F90	(revision 12928)
@@ -1,3 +1,2 @@
-#define TWO_WAY
 #undef DECAL_FEEDBACK
 
@@ -20,4 +19,5 @@
    USE par_trc
    USE trc
+   USE vremap
 
    IMPLICIT NONE
@@ -40,5 +40,4 @@
       IF (Agrif_Root()) RETURN 
       !
-#if defined TWO_WAY   
       Agrif_UseSpecialValueInUpdate = .TRUE.
       Agrif_SpecialValueFineGrid    = 0._wp
@@ -53,6 +52,4 @@
       !
       Agrif_UseSpecialValueInUpdate = .FALSE.
-      !
-#endif
       !
    END SUBROUTINE Agrif_Update_Trc
@@ -68,21 +65,20 @@
       !!
       INTEGER :: ji,jj,jk,jn
-      REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,n1:n2) :: tabres_child
+      REAL(wp) :: ztb, ztnu, ztno
       REAL(wp) :: h_in(k1:k2)
       REAL(wp) :: h_out(1:jpk)
       INTEGER  :: N_in, N_out
       REAL(wp) :: h_diff
-      REAL(wp) :: zrho_xy
-      REAL(wp) :: tabin(k1:k2,n1:n2)
+      REAL(wp) :: tabin(k1:k2,1:jptra)
+      REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,1:jptra) :: tabres_child
       !!---------------------------------------------
       !
       IF (before) THEN
          AGRIF_SpecialValue = -999._wp
-         zrho_xy = Agrif_rhox() * Agrif_rhoy() 
          DO jn = n1,n2-1
             DO jk=k1,k2
                DO jj=j1,j2
                   DO ji=i1,i2
-                     tabres(ji,jj,jk,jn) = (trn(ji,jj,jk,jn) * e3t_n(ji,jj,jk) ) &
+                     tabres(ji,jj,jk,jn) = (tr(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Kmm_a) ) &
                                            * tmask(ji,jj,jk) + (tmask(ji,jj,jk)-1)*999._wp
                   END DO
@@ -93,5 +89,5 @@
             DO jj=j1,j2
                DO ji=i1,i2
-                  tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t_n(ji,jj,jk) &
+                  tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a) &
                                            + (tmask(ji,jj,jk)-1)*999._wp
                END DO
@@ -114,5 +110,5 @@
                   IF (tmask(ji,jj,jk) < -900) EXIT ! TODO: Will not work with ISF
                   N_out = N_out + 1
-                  h_out(N_out) = e3t_n(ji,jj,jk) !Parent grid scale factors. Could multiply by e1e2t here instead of division above
+                  h_out(N_out) = e3t(ji,jj,jk,Kmm_a) !Parent grid scale factors. Could multiply by e1e2t here instead of division above
                ENDDO
                IF (N_in > 0) THEN !Remove this?
@@ -124,21 +120,21 @@
                      STOP
                   ENDIF
-                  DO jn=1,jptra
-                     CALL reconstructandremap(tabin(1:N_in,jn),h_in(1:N_in),tabres_child(ji,jj,1:N_out,jn),h_out(1:N_out),N_in,N_out)
-                  ENDDO
+                  CALL reconstructandremap(tabin(1:N_in,1:jptra),h_in(1:N_in),tabres_child(ji,jj,1:N_out,1:jptra),h_out(1:N_out),N_in,N_out,jptra)
                ENDIF
             ENDDO
          ENDDO
-
-         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN
+         !
+         IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN
             ! Add asselin part
             DO jn = 1,jptra
-               DO jk=1,jpk
+               DO jk=1,jpkm1
                   DO jj=j1,j2
                      DO ji=i1,i2
                         IF( tabres_child(ji,jj,jk,jn) .NE. 0. ) THEN
-                           trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) & 
-                                 & + atfp * ( tabres_child(ji,jj,jk,jn) &
-                                 &          - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
+                           ztb  = tr(ji,jj,jk,jn,Kbb_a) * e3t(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used
+                           ztnu = tabres_child(ji,jj,jk,jn) * e3t(ji,jj,jk,Kmm_a)
+                           ztno = tr(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Krhs_a)
+                           tr(ji,jj,jk,jn,Kbb_a) = ( ztb + rn_atfp * ( ztnu - ztno) )  & 
+                                     &        * tmask(ji,jj,jk) / e3t(ji,jj,jk,Kbb_a)
                         ENDIF
                      ENDDO
@@ -148,9 +144,9 @@
          ENDIF
          DO jn = 1,jptra
-            DO jk=1,jpk
+            DO jk=1,jpkm1
                DO jj=j1,j2
                   DO ji=i1,i2
                      IF( tabres_child(ji,jj,jk,jn) .NE. 0. ) THEN 
-                        trn(ji,jj,jk,jn) = tabres_child(ji,jj,jk,jn) * tmask(ji,jj,jk)
+                        tr(ji,jj,jk,jn,Kmm_a) = tabres_child(ji,jj,jk,jn)
                      END IF
                   END DO
@@ -158,4 +154,10 @@
             END DO
          END DO
+         !
+         IF  ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN
+            tr(i1:i2,j1:j2,1:jpkm1,1:jptra,Kbb_a)  = tr(i1:i2,j1:j2,1:jpkm1,1:jptra,Kmm_a)
+         ENDIF
+         !
+
       ENDIF
       ! 
@@ -183,6 +185,6 @@
                   DO ji=i1,i2
 !> jc tmp
-                     tabres(ji,jj,jk,jn) = trn(ji,jj,jk,jn)  * e3t_n(ji,jj,jk) / e3t_0(ji,jj,jk)
-!                     tabres(ji,jj,jk,jn) = trn(ji,jj,jk,jn)  * e3t_n(ji,jj,jk)
+                     tabres(ji,jj,jk,jn) = tr(ji,jj,jk,jn,Kmm_a)  * e3t(ji,jj,jk,Kmm_a) / e3t_0(ji,jj,jk)
+!                     tabres(ji,jj,jk,jn) = tr(ji,jj,jk,jn,Kmm_a)  * e3t(ji,jj,jk,Kmm_a)
 !< jc tmp
                   END DO
@@ -197,5 +199,5 @@
          ENDDO
 !< jc tmp
-         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN
+         IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN
             ! Add asselin part
             DO jn = n1,n2
@@ -204,9 +206,9 @@
                      DO ji=i1,i2
                         IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN
-                           ztb  = trb(ji,jj,jk,jn) * e3t_b(ji,jj,jk) ! fse3t_b prior update should be used
+                           ztb  = tr(ji,jj,jk,jn,Kbb_a) * e3t(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used
                            ztnu = tabres(ji,jj,jk,jn)
-                           ztno = trn(ji,jj,jk,jn) * e3t_a(ji,jj,jk)
-                           trb(ji,jj,jk,jn) = ( ztb + atfp * ( ztnu - ztno) )  & 
-                                     &        * tmask(ji,jj,jk) / e3t_b(ji,jj,jk)
+                           ztno = tr(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Krhs_a)
+                           tr(ji,jj,jk,jn,Kbb_a) = ( ztb + rn_atfp * ( ztnu - ztno) )  & 
+                                     &        * tmask(ji,jj,jk) / e3t(ji,jj,jk,Kbb_a)
                         ENDIF
                      ENDDO
@@ -220,5 +222,5 @@
                   DO ji=i1,i2
                      IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 
-                        trn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) / e3t_n(ji,jj,jk)
+                        tr(ji,jj,jk,jn,Kmm_a) = tabres(ji,jj,jk,jn) / e3t(ji,jj,jk,Kmm_a)
                      END IF
                   END DO
@@ -227,6 +229,6 @@
          END DO
          !
-         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN
-            trb(i1:i2,j1:j2,k1:k2,n1:n2)  = trn(i1:i2,j1:j2,k1:k2,n1:n2)
+         IF  ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN
+            tr(i1:i2,j1:j2,k1:k2,n1:n2,Kbb_a)  = tr(i1:i2,j1:j2,k1:k2,n1:n2,Kmm_a)
          ENDIF
          !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_user.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_user.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_user.F90	(revision 12928)
@@ -1,4 +1,6 @@
 #undef UPD_HIGH   /* MIX HIGH UPDATE */
 #if defined key_agrif
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/NST 4.0 , NEMO Consortium (2018)
@@ -6,446 +8,465 @@
    !! Software governed by the CeCILL license (see ./LICENSE)
    !!----------------------------------------------------------------------
-SUBROUTINE agrif_user
-END SUBROUTINE agrif_user
-
-SUBROUTINE agrif_before_regridding
-END SUBROUTINE agrif_before_regridding
-
-SUBROUTINE Agrif_InitWorkspace
-      !!----------------------------------------------------------------------
-      !!                 *** ROUTINE Agrif_InitWorkspace ***
-      !!----------------------------------------------------------------------
-   USE par_oce
-   USE dom_oce
-   USE nemogcm
-   USE mppini
-      !!
-   IMPLICIT NONE
-      !!----------------------------------------------------------------------
-   !
-   IF( .NOT. Agrif_Root() ) THEN
-      ! no more static variables
-!!$! JC: change to allow for different vertical levels
-!!$!     jpk is already set
-!!$!     keep it jpk possibly different from jpkglo which 
-!!$!     hold parent grid vertical levels number (set earlier)
-!!$!      jpk     = jpkglo 
-   ENDIF
-   !
-END SUBROUTINE Agrif_InitWorkspace
-
-
-SUBROUTINE Agrif_InitValues
+   SUBROUTINE agrif_user
+   END SUBROUTINE agrif_user
+
+   SUBROUTINE agrif_before_regridding
+   END SUBROUTINE agrif_before_regridding
+
+   SUBROUTINE Agrif_InitWorkspace
+   END SUBROUTINE Agrif_InitWorkspace
+
+   SUBROUTINE Agrif_InitValues
       !!----------------------------------------------------------------------
       !!                 *** ROUTINE Agrif_InitValues ***
-      !!
-      !! ** Purpose :: Declaration of variables to be interpolated
-      !!----------------------------------------------------------------------
-   USE Agrif_Util
-   USE oce 
-   USE dom_oce
-   USE nemogcm
-   USE tradmp
-   USE bdy_oce   , ONLY: ln_bdy
-   !!
-   IMPLICIT NONE
-      !!----------------------------------------------------------------------
-   !
-   CALL nemo_init       !* Initializations of each fine grid
-
-   !                    !* Agrif initialization
-   CALL agrif_nemo_init
-   CALL Agrif_InitValues_cont_dom
-   CALL Agrif_InitValues_cont
+      !!----------------------------------------------------------------------
+      USE nemogcm
+      !!----------------------------------------------------------------------
+      !
+      CALL nemo_init       !* Initializations of each fine grid
+      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices
+      !
+      !                    !* Agrif initialization
+      CALL agrif_nemo_init
+      CALL Agrif_InitValues_cont_dom
+      CALL Agrif_InitValues_cont
 # if defined key_top
-   CALL Agrif_InitValues_cont_top
+      CALL Agrif_InitValues_cont_top
 # endif
 # if defined key_si3
-   CALL Agrif_InitValues_cont_ice
-# endif
-   !    
-END SUBROUTINE Agrif_initvalues
-
-
-SUBROUTINE Agrif_InitValues_cont_dom
-      !!----------------------------------------------------------------------
-      !!                 *** ROUTINE Agrif_InitValues_cont ***
-      !!
-      !! ** Purpose ::   Declaration of variables to be interpolated
-      !!----------------------------------------------------------------------
-   USE Agrif_Util
-   USE oce 
-   USE dom_oce
-   USE nemogcm
-   USE in_out_manager
-   USE agrif_oce_update
-   USE agrif_oce_interp
-   USE agrif_oce_sponge
-   !
-   IMPLICIT NONE
-      !!----------------------------------------------------------------------
-   !
-   ! Declaration of the type of variable which have to be interpolated
-   !
-   CALL agrif_declare_var_dom
-   !
-END SUBROUTINE Agrif_InitValues_cont_dom
-
-
-SUBROUTINE agrif_declare_var_dom
-      !!----------------------------------------------------------------------
-      !!                 *** ROUTINE agrif_declare_var ***
-      !!
-      !! ** Purpose :: Declaration of variables to be interpolated
-      !!----------------------------------------------------------------------
-   USE agrif_util
-   USE par_oce       
-   USE oce
-   !
-   IMPLICIT NONE
-   !
-   INTEGER :: ind1, ind2, ind3
+      CALL Agrif_InitValues_cont_ice
+# endif
+      !    
+   END SUBROUTINE Agrif_initvalues
+
+   SUBROUTINE Agrif_InitValues_cont_dom
+      !!----------------------------------------------------------------------
+      !!                 *** ROUTINE Agrif_InitValues_cont_dom ***
+      !!----------------------------------------------------------------------
+      !
+      CALL agrif_declare_var_dom
+      !
+   END SUBROUTINE Agrif_InitValues_cont_dom
+
+   SUBROUTINE agrif_declare_var_dom
+      !!----------------------------------------------------------------------
+      !!                 *** ROUTINE agrif_declare_var_dom ***
+      !!----------------------------------------------------------------------
+      USE par_oce, ONLY:  nbghostcells      
+      !
+      IMPLICIT NONE
+      !
+      INTEGER :: ind1, ind2, ind3
       !!----------------------------------------------------------------------
 
       ! 1. Declaration of the type of variable which have to be interpolated
       !---------------------------------------------------------------------
-   ind1 =     nbghostcells
-   ind2 = 1 + nbghostcells
-   ind3 = 2 + nbghostcells
-   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id)
-   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id)
+      ind1 =     nbghostcells
+      ind2 = 1 + nbghostcells
+      ind3 = 2 + nbghostcells
+      CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id)
+      CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id)
 
       ! 2. Type of interpolation
       !-------------------------
-   CALL Agrif_Set_bcinterp( e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm    )
-   CALL Agrif_Set_bcinterp( e2v_id, interp1=AGRIF_ppm   , interp2=Agrif_linear )
+      CALL Agrif_Set_bcinterp( e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm    )
+      CALL Agrif_Set_bcinterp( e2v_id, interp1=AGRIF_ppm   , interp2=Agrif_linear )
 
       ! 3. Location of interpolation
       !-----------------------------
-   CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/))
-   CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/))
+      CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/))
+      CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/))
 
       ! 4. Update type
       !--------------- 
 # if defined UPD_HIGH
-   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Full_Weighting)
-   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average)
+      CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Full_Weighting)
+      CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average)
 #else
-   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average)
-   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy)
+      CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average)
+      CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy)
 #endif
 
-END SUBROUTINE agrif_declare_var_dom
-
-
-SUBROUTINE Agrif_InitValues_cont
+   END SUBROUTINE agrif_declare_var_dom
+
+   SUBROUTINE Agrif_InitValues_cont
       !!----------------------------------------------------------------------
       !!                 *** ROUTINE Agrif_InitValues_cont ***
-      !!
-      !! ** Purpose ::   Declaration of variables to be interpolated
-      !!----------------------------------------------------------------------
-   USE agrif_oce_update
-   USE agrif_oce_interp
-   USE agrif_oce_sponge
-   USE Agrif_Util
-   USE oce 
-   USE dom_oce
-   USE zdf_oce
-   USE nemogcm
-   !
-   USE lib_mpp
-   USE in_out_manager
-   !
-   IMPLICIT NONE
-   !
-   LOGICAL :: check_namelist
-   CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4 
-      !!----------------------------------------------------------------------
-
-   ! 1. Declaration of the type of variable which have to be interpolated
-   !---------------------------------------------------------------------
-   CALL agrif_declare_var
-
-   ! 2. First interpolations of potentially non zero fields
-   !-------------------------------------------------------
-   Agrif_SpecialValue    = 0._wp
-   Agrif_UseSpecialValue = .TRUE.
-   CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn)
-   CALL Agrif_Sponge
-   tabspongedone_tsn = .FALSE.
-   CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge)
-   ! reset tsa to zero
-   tsa(:,:,:,:) = 0.
-
-   Agrif_UseSpecialValue = ln_spc_dyn
-   CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun)
-   CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn)
-   tabspongedone_u = .FALSE.
-   tabspongedone_v = .FALSE.
-   CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge)
-   tabspongedone_u = .FALSE.
-   tabspongedone_v = .FALSE.
-   CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge)
-
-   Agrif_UseSpecialValue = .TRUE.
-   CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn )
-   hbdy_w(:,:) = 0.e0 ; hbdy_e(:,:) = 0.e0 ; hbdy_n(:,:) = 0.e0 ; hbdy_s(:,:) = 0.e0
-   ssha(:,:) = 0.e0
-
-   IF ( ln_dynspg_ts ) THEN
+      !!----------------------------------------------------------------------
+      USE agrif_oce
+      USE agrif_oce_interp
+      USE agrif_oce_sponge
+      USE dom_oce
+      USE oce
+      USE lib_mpp
+      USE lbclnk
+      !
+      IMPLICIT NONE
+      !
+      INTEGER :: ji, jj
+      LOGICAL :: check_namelist
+      CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4 
+#if defined key_vertical
+      REAL(wp), DIMENSION(jpi,jpj) ::   zk   ! workspace
+#endif
+      !!----------------------------------------------------------------------
+
+      ! 1. Declaration of the type of variable which have to be interpolated
+      !---------------------------------------------------------------------
+      CALL agrif_declare_var
+
+      ! 2. First interpolations of potentially non zero fields
+      !-------------------------------------------------------
+
+#if defined key_vertical
+      ! Build consistent parent bathymetry and number of levels
+      ! on the child grid 
+      Agrif_UseSpecialValue = .FALSE.
+      ht0_parent(:,:) = 0._wp
+      mbkt_parent(:,:) = 0
+      !
+      CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 )
+      CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt)
+      !
+      ! Assume step wise change of bathymetry near interface
+      ! TODO: Switch to linear interpolation of bathymetry in the s-coordinate case
+      !       and no refinement
+      DO_2D_10_10
+         mbku_parent(ji,jj) = MIN(  mbkt_parent(ji+1,jj  ) , mbkt_parent(ji,jj)  )
+         mbkv_parent(ji,jj) = MIN(  mbkt_parent(ji  ,jj+1) , mbkt_parent(ji,jj)  )
+      END_2D
+      IF ( ln_sco.AND.Agrif_Parent(ln_sco) ) THEN 
+         DO_2D_10_10
+            hu0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji+1,jj) )
+            hv0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji,jj+1) )
+         END_2D
+      ELSE
+         DO_2D_10_10
+            hu0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji+1,jj))
+            hv0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji,jj+1))
+         END_2D
+
+      ENDIF
+      !
+      CALL lbc_lnk( 'Agrif_InitValues_cont', hu0_parent, 'U', 1. )
+      CALL lbc_lnk( 'Agrif_InitValues_cont', hv0_parent, 'V', 1. )
+      zk(:,:) = REAL( mbku_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'U', 1. )
+      mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )
+      zk(:,:) = REAL( mbkv_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 1. )
+      mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )   
+#endif
+
+      Agrif_SpecialValue    = 0._wp
+      Agrif_UseSpecialValue = .TRUE.
+      CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn)
+      CALL Agrif_Sponge
+      tabspongedone_tsn = .FALSE.
+      CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge)
+      ! reset ts(:,:,:,:,Krhs_a) to zero
+      ts(:,:,:,:,Krhs_a) = 0._wp
+
       Agrif_UseSpecialValue = ln_spc_dyn
-      CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb)
-      CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb)
-      CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b)
-      CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b)
-      ubdy_w(:,:) = 0.e0 ; vbdy_w(:,:) = 0.e0
-      ubdy_e(:,:) = 0.e0 ; vbdy_e(:,:) = 0.e0
-      ubdy_n(:,:) = 0.e0 ; vbdy_n(:,:) = 0.e0
-      ubdy_s(:,:) = 0.e0 ; vbdy_s(:,:) = 0.e0
-   ENDIF
-
-   Agrif_UseSpecialValue = .FALSE. 
-   ! reset velocities to zero
-   ua(:,:,:) = 0.
-   va(:,:,:) = 0.
-
-   ! 3. Some controls
-   !-----------------
-   check_namelist = .TRUE.
-
-   IF( check_namelist ) THEN 
-
-      ! Check time steps           
-      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
-         WRITE(cl_check1,*)  NINT(Agrif_Parent(rdt))
-         WRITE(cl_check2,*)  NINT(rdt)
-         WRITE(cl_check3,*)  NINT(Agrif_Parent(rdt)/Agrif_Rhot())
-         CALL ctl_stop( 'Incompatible time step between ocean grids',   &
-               &               'parent grid value : '//cl_check1    ,   & 
-               &               'child  grid value : '//cl_check2    ,   & 
-               &               'value on child grid should be changed to : '//cl_check3 )
-      ENDIF
-
-      ! Check run length
-      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
-            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
-         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
-         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
-         CALL ctl_warn( 'Incompatible run length between grids'                      ,   &
-               &               'nit000 on fine grid will be changed to : '//cl_check1,   &
-               &               'nitend on fine grid will be changed to : '//cl_check2    )
-         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
-         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
-      ENDIF
-
-      ! Check free surface scheme
-      IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.&
-         & ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN
-         WRITE(cl_check1,*)  Agrif_Parent( ln_dynspg_ts )
-         WRITE(cl_check2,*)  ln_dynspg_ts
-         WRITE(cl_check3,*)  Agrif_Parent( ln_dynspg_exp )
-         WRITE(cl_check4,*)  ln_dynspg_exp
-         CALL ctl_stop( 'Incompatible free surface scheme between grids' ,  &
-               &               'parent grid ln_dynspg_ts  :'//cl_check1  ,  & 
-               &               'child  grid ln_dynspg_ts  :'//cl_check2  ,  &
-               &               'parent grid ln_dynspg_exp :'//cl_check3  ,  &
-               &               'child  grid ln_dynspg_exp :'//cl_check4  ,  &
-               &               'those logicals should be identical' )                 
-         STOP
-      ENDIF
-
-      ! Check if identical linear free surface option
-      IF ( ( Agrif_Parent(ln_linssh ).AND.(.NOT.ln_linssh )).OR.&
-         & ( (.NOT.Agrif_Parent(ln_linssh)).AND.ln_linssh ) ) THEN
-         WRITE(cl_check1,*)  Agrif_Parent(ln_linssh )
-         WRITE(cl_check2,*)  ln_linssh
-         CALL ctl_stop( 'Incompatible linearized fs option between grids',  &
-               &               'parent grid ln_linssh  :'//cl_check1     ,  &
-               &               'child  grid ln_linssh  :'//cl_check2     ,  &
-               &               'those logicals should be identical' )                  
-         STOP
+      CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun)
+      CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn)
+      tabspongedone_u = .FALSE.
+      tabspongedone_v = .FALSE.
+      CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge)
+      tabspongedone_u = .FALSE.
+      tabspongedone_v = .FALSE.
+      CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge)
+      uu(:,:,:,Krhs_a) = 0._wp
+      vv(:,:,:,Krhs_a) = 0._wp
+
+      Agrif_UseSpecialValue = .TRUE.
+      CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn )
+      hbdy(:,:) = 0._wp
+      ssh(:,:,Krhs_a) = 0._wp
+
+      IF ( ln_dynspg_ts ) THEN
+         Agrif_UseSpecialValue = ln_spc_dyn
+         CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb)
+         CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb)
+         CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b)
+         CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b)
+         ubdy(:,:) = 0._wp
+         vbdy(:,:) = 0._wp
+      ENDIF
+
+      Agrif_UseSpecialValue = .FALSE.
+
+      ! 3. Some controls
+      !-----------------
+      check_namelist = .TRUE.
+
+      IF( check_namelist ) THEN 
+
+         ! Check time steps           
+         IF( NINT(Agrif_Rhot()) * NINT(rn_Dt) .NE. Agrif_Parent(rn_Dt) ) THEN
+            WRITE(cl_check1,*)  NINT(Agrif_Parent(rn_Dt))
+            WRITE(cl_check2,*)  NINT(rn_Dt)
+            WRITE(cl_check3,*)  NINT(Agrif_Parent(rn_Dt)/Agrif_Rhot())
+            CALL ctl_stop( 'Incompatible time step between ocean grids',   &
+                  &               'parent grid value : '//cl_check1    ,   & 
+                  &               'child  grid value : '//cl_check2    ,   & 
+                  &               'value on child grid should be changed to : '//cl_check3 )
+         ENDIF
+
+         ! Check run length
+         IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
+               Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
+            WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
+            WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
+            CALL ctl_warn( 'Incompatible run length between grids'                      ,   &
+                  &               'nit000 on fine grid will be changed to : '//cl_check1,   &
+                  &               'nitend on fine grid will be changed to : '//cl_check2    )
+            nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
+            nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
+         ENDIF
+
+         ! Check free surface scheme
+         IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.&
+            & ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN
+            WRITE(cl_check1,*)  Agrif_Parent( ln_dynspg_ts )
+            WRITE(cl_check2,*)  ln_dynspg_ts
+            WRITE(cl_check3,*)  Agrif_Parent( ln_dynspg_exp )
+            WRITE(cl_check4,*)  ln_dynspg_exp
+            CALL ctl_stop( 'Incompatible free surface scheme between grids' ,  &
+                  &               'parent grid ln_dynspg_ts  :'//cl_check1  ,  & 
+                  &               'child  grid ln_dynspg_ts  :'//cl_check2  ,  &
+                  &               'parent grid ln_dynspg_exp :'//cl_check3  ,  &
+                  &               'child  grid ln_dynspg_exp :'//cl_check4  ,  &
+                  &               'those logicals should be identical' )                 
+            STOP
+         ENDIF
+
+         ! Check if identical linear free surface option
+         IF ( ( Agrif_Parent(ln_linssh ).AND.(.NOT.ln_linssh )).OR.&
+            & ( (.NOT.Agrif_Parent(ln_linssh)).AND.ln_linssh ) ) THEN
+            WRITE(cl_check1,*)  Agrif_Parent(ln_linssh )
+            WRITE(cl_check2,*)  ln_linssh
+            CALL ctl_stop( 'Incompatible linearized fs option between grids',  &
+                  &               'parent grid ln_linssh  :'//cl_check1     ,  &
+                  &               'child  grid ln_linssh  :'//cl_check2     ,  &
+                  &               'those logicals should be identical' )                  
+            STOP
+         ENDIF
+
       ENDIF
 
       ! check if masks and bathymetries match
       IF(ln_chk_bathy) THEN
+         Agrif_UseSpecialValue = .FALSE.
          !
+         IF(lwp) WRITE(numout,*) ' '
          IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level()
          !
          kindic_agr = 0
-         ! check if umask agree with parent along western and eastern boundaries:
-         CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk)
-         ! check if vmask agree with parent along northern and southern boundaries:
-         CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk)
-         ! check if tmask and vertical scale factors agree with parent over first two coarse grid points:
+# if ! defined key_vertical
+         !
+         ! check if tmask and vertical scale factors agree with parent in sponge area:
          CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t)
          !
+# else
+         !
+         ! In case of vertical interpolation, check only that total depths agree between child and parent:
+         DO ji = 1, jpi
+            DO jj = 1, jpj
+               IF ((mbkt_parent(ji,jj)/=0).AND.(ABS(ht0_parent(ji,jj)-ht_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1
+               IF ((mbku_parent(ji,jj)/=0).AND.(ABS(hu0_parent(ji,jj)-hu_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1
+               IF ((mbkv_parent(ji,jj)/=0).AND.(ABS(hv0_parent(ji,jj)-hv_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1
+            END DO
+         END DO
+# endif
          CALL mpp_sum( 'agrif_user', kindic_agr )
          IF( kindic_agr /= 0 ) THEN
-            CALL ctl_stop('Child Bathymetry is not correct near boundaries.')
+            CALL ctl_stop('==> Child Bathymetry is NOT correct near boundaries.')
          ELSE
-            IF(lwp) WRITE(numout,*) 'Child Bathymetry is ok near boundaries.'
-         END IF
-      ENDIF
-      !
-   ENDIF
-   ! 
-END SUBROUTINE Agrif_InitValues_cont
-
-SUBROUTINE agrif_declare_var
-      !!----------------------------------------------------------------------
-      !!                 *** ROUTINE agrif_declarE_var ***
-      !!
-      !! ** Purpose :: Declaration of variables to be interpolated
-      !!----------------------------------------------------------------------
-   USE agrif_util
-   USE agrif_oce
-   USE par_oce       ! ocean parameters
-   USE zdf_oce       ! vertical physics
-   USE oce
-   !
-   IMPLICIT NONE
-   !
-   INTEGER :: ind1, ind2, ind3
-      !!----------------------------------------------------------------------
-
-   ! 1. Declaration of the type of variable which have to be interpolated
-   !---------------------------------------------------------------------
-   ind1 =     nbghostcells
-   ind2 = 1 + nbghostcells
-   ind3 = 2 + nbghostcells
+            IF(lwp) WRITE(numout,*) '==> Child Bathymetry is ok near boundaries.'
+            IF(lwp) WRITE(numout,*) ' '
+         END IF  
+         !    
+      ENDIF
+
 # if defined key_vertical
-   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_id)
-   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_sponge_id)
-
-   CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_interp_id)
-   CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_interp_id)
-   CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_update_id)
-   CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_update_id)
-   CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_sponge_id)
-   CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_sponge_id)
+      ! Additional constrain that should be removed someday:
+      IF ( Agrif_Parent(jpk).GT.jpk ) THEN
+	 CALL ctl_stop( ' With key_vertical, child grids must have jpk greater or equal to the parent value' )
+      ENDIF
+# endif
+      ! 
+   END SUBROUTINE Agrif_InitValues_cont
+
+   SUBROUTINE agrif_declare_var
+      !!----------------------------------------------------------------------
+      !!                 *** ROUTINE agrif_declare_var ***
+      !!----------------------------------------------------------------------
+      USE agrif_util
+      USE agrif_oce
+      USE par_oce
+      USE zdf_oce 
+      USE oce
+      !
+      IMPLICIT NONE
+      !
+      INTEGER :: ind1, ind2, ind3
+      !!----------------------------------------------------------------------
+
+      ! 1. Declaration of the type of variable which have to be interpolated
+      !---------------------------------------------------------------------
+      ind1 =     nbghostcells
+      ind2 = 1 + nbghostcells
+      ind3 = 2 + nbghostcells
+# if defined key_vertical
+      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_id)
+      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_sponge_id)
+
+      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_interp_id)
+      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_interp_id)
+      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_update_id)
+      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_update_id)
+      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_sponge_id)
+      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_sponge_id)
 # else
-   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id)
-   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id)
-
-   CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_interp_id)
-   CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_interp_id)
-   CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_update_id)
-   CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_update_id)
-   CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_sponge_id)
-   CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_sponge_id)
-# endif
-
-   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id)
-   CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id)
-   CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id)
-
-   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id)
-
-   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id)
-   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id)
-   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id)
-   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id)
-   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id)
-   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id)
-
-   CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id)
-
-   IF( ln_zdftke.OR.ln_zdfgls ) THEN
-!      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/), en_id)
-!      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),avt_id)
+      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id)
+      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id)
+
+      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_interp_id)
+      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_interp_id)
+      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_update_id)
+      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_update_id)
+      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_sponge_id)
+      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_sponge_id)
+# endif
+
+      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id)
+
 # if defined key_vertical
-      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),avm_id)
+      CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),mbkt_id)
+      CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ht0_id)
+# endif
+
+      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id)
+
+      CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id)
+      CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id)
+      CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id)
+      CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id)
+      CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id)
+      CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id)
+
+      CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id)
+
+      IF( ln_zdftke.OR.ln_zdfgls ) THEN
+!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/), en_id)
+!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),avt_id)
+# if defined key_vertical
+         CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),avm_id)
 # else
-      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),avm_id)
-# endif
-   ENDIF
-
-   ! 2. Type of interpolation
-   !-------------------------
-   CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)
-
-   CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
-   CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
-
-   CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear)
-
-   CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear)
-   CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
-   CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
-   CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
-   CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
-
-
-   CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
-   CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
-
-   CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant)
-   CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant)
-   CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant)
-
-   IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear )
-
-   ! 3. Location of interpolation
-   !-----------------------------
-   CALL Agrif_Set_bc(       tsn_id, (/0,ind1/) )
-   CALL Agrif_Set_bc( un_interp_id, (/0,ind1/) )
-   CALL Agrif_Set_bc( vn_interp_id, (/0,ind1/) )
-
-   CALL Agrif_Set_bc( tsn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )  ! if west and rhox=3 and sponge=2 and ghost=1: columns 2 to 9 
-   CALL Agrif_Set_bc(  un_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )
-   CALL Agrif_Set_bc(  vn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )
-
-   CALL Agrif_Set_bc(        sshn_id, (/0,ind1-1/) )
-   CALL Agrif_Set_bc(         unb_id, (/0,ind1-1/) )
-   CALL Agrif_Set_bc(         vnb_id, (/0,ind1-1/) )
-   CALL Agrif_Set_bc( ub2b_interp_id, (/0,ind1-1/) )
-   CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) )
-
-   CALL Agrif_Set_bc(  e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) )   ! if west and rhox=3 and ghost=1: column 2 to 6 
-   CALL Agrif_Set_bc( umsk_id, (/0,0/) )
-   CALL Agrif_Set_bc( vmsk_id, (/0,0/) )
-
-
-   IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bc( avm_id, (/0,ind1/) )
-
-   ! 4. Update type
-   !--------------- 
-   CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average)
+         CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),avm_id)
+# endif
+      ENDIF
+
+      ! 2. Type of interpolation
+      !-------------------------
+      CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)
+
+      CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+      CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+
+      CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear)
+
+      CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear)
+      CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+      CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+      CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+      CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+!
+! > Divergence conserving alternative:
+!      CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_constant)
+!      CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_constant)
+!      CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_constant,interp2=Agrif_linear)
+!      CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_constant)
+!      CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_constant,interp2=Agrif_linear)
+!<
+
+      CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+      CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+
+      CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant)
+
+# if defined key_vertical
+      CALL Agrif_Set_bcinterp(mbkt_id,interp=AGRIF_constant)
+      CALL Agrif_Set_bcinterp(ht0_id ,interp=AGRIF_constant)
+# endif
+
+      IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear )
+
+      ! 3. Location of interpolation
+      !-----------------------------
+      CALL Agrif_Set_bc(       tsn_id, (/0,ind1-1/) ) ! if west,  rhox=3 and nbghost=3: columns 2 to 4
+      CALL Agrif_Set_bc( un_interp_id, (/0,ind1-1/) ) 
+      CALL Agrif_Set_bc( vn_interp_id, (/0,ind1-1/) )
+
+      CALL Agrif_Set_bc( tsn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )  ! if west,  rhox=3, nn_sponge_len=2 
+      CALL Agrif_Set_bc(  un_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )  ! and nbghost=3: 
+      CALL Agrif_Set_bc(  vn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )  ! columns 4 to 11
+
+      CALL Agrif_Set_bc(        sshn_id, (/0,ind1-1/) )
+      CALL Agrif_Set_bc(         unb_id, (/0,ind1-1/) )
+      CALL Agrif_Set_bc(         vnb_id, (/0,ind1-1/) )
+      CALL Agrif_Set_bc( ub2b_interp_id, (/0,ind1-1/) )
+      CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) )
+
+!      CALL Agrif_Set_bc(  e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) )  
+! JC: check near the boundary only until matching in sponge has been sorted out:
+      CALL Agrif_Set_bc(  e3t_id, (/0,ind1-1/) )  
+
+# if defined key_vertical 
+      ! extend the interpolation zone by 1 more point than necessary:
+      CALL Agrif_Set_bc(  mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) )
+      CALL Agrif_Set_bc(  ht0_id,  (/-nn_sponge_len*Agrif_irhox()-2,ind1/) )
+# endif
+
+      IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bc( avm_id, (/0,ind1/) )
+
+      ! 4. Update type
+      !--------------- 
+      CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average)
 
 # if defined UPD_HIGH
-   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
-   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
-   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
-
-   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
-   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
-   CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting)
-   CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting)
-
-   IF( ln_zdftke.OR.ln_zdfgls ) THEN
-!      CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting)
-!      CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting)
-!      CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting)
-   ENDIF
+      CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
+      CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
+      CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
+
+      CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
+      CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
+      CALL Agrif_Set_Updatetype(sshn_id,update = Agrif_Update_Full_Weighting)
+      CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting)
+
+      IF( ln_zdftke.OR.ln_zdfgls ) THEN
+!         CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting)
+!         CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting)
+!         CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting)
+      ENDIF
 
 #else
-   CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
-   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
-   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
-
-   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
-   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
-   CALL Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average)
-   CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average)
-
-   IF( ln_zdftke.OR.ln_zdfgls ) THEN
-!      CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
-!      CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)
-!      CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)
-   ENDIF
+      CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
+      CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
+      CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
+
+      CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
+      CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
+      CALL Agrif_Set_Updatetype(sshn_id,update = AGRIF_Update_Average)
+      CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average)
+
+      IF( ln_zdftke.OR.ln_zdfgls ) THEN
+!         CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
+!         CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)
+!         CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)
+      ENDIF
 
 #endif
-   !
-END SUBROUTINE agrif_declare_var
+      !
+   END SUBROUTINE agrif_declare_var
 
 #if defined key_si3
@@ -453,156 +474,147 @@
       !!----------------------------------------------------------------------
       !!                 *** ROUTINE Agrif_InitValues_cont_ice ***
+      !!----------------------------------------------------------------------
+      USE Agrif_Util
+      USE sbc_oce, ONLY : nn_fsbc  ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc
+      USE ice
+      USE agrif_ice
+      USE in_out_manager
+      USE agrif_ice_interp
+      USE lib_mpp
+      !
+      IMPLICIT NONE
+      !!----------------------------------------------------------------------
+      !
+      ! Declaration of the type of variable which have to be interpolated (parent=>child)
+      !----------------------------------------------------------------------------------
+      CALL agrif_declare_var_ice
+
+      ! Controls
+
+      ! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal can be largely degraded by the agrif zoom)
+      !          the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child)
+      !          therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable
+      !       If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account
+      IF( nn_fsbc > 1 )  CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and sea-ice may not work properly')
+
+      ! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer
+      IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 )  THEN
+         CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)')
+      ENDIF
+      ! First Interpolations (using "after" ice subtime step => nbstep_ice=1)
+      !----------------------------------------------------------------------
+      nbstep_ice = ( Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) ! clem: to have calledweight=1 in interp (otherwise the western border of the zoom is wrong)
+      CALL agrif_interp_ice('U') ! interpolation of ice velocities
+      CALL agrif_interp_ice('V') ! interpolation of ice velocities
+      CALL agrif_interp_ice('T') ! interpolation of ice tracers 
+      nbstep_ice = 0   
+      !
+   END SUBROUTINE Agrif_InitValues_cont_ice
+
+   SUBROUTINE agrif_declare_var_ice
+      !!----------------------------------------------------------------------
+      !!                 *** ROUTINE agrif_declare_var_ice ***
+      !!----------------------------------------------------------------------
+      USE Agrif_Util
+      USE ice
+      USE par_oce, ONLY : nbghostcells
+      !
+      IMPLICIT NONE
+      !
+      INTEGER :: ind1, ind2, ind3
+      !!----------------------------------------------------------------------
+      !
+      ! 1. Declaration of the type of variable which have to be interpolated (parent=>child)
+      !       agrif_declare_variable(position,1st point index,--,--,dimensions,name)
+      !           ex.:  position=> 1,1 = not-centered (in i and j)
+      !                            2,2 =     centered (    -     )
+      !                 index   => 1,1 = one ghost line
+      !                            2,2 = two ghost lines
+      !-------------------------------------------------------------------------------------
+      ind1 =     nbghostcells
+      ind2 = 1 + nbghostcells
+      ind3 = 2 + nbghostcells
+      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(8+nlay_s+nlay_i)/),tra_ice_id)
+      CALL agrif_declare_variable((/1,2/)  ,(/ind2,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_ice_id  )
+      CALL agrif_declare_variable((/2,1/)  ,(/ind3,ind2/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_ice_id  )
+
+      ! 2. Set interpolations (normal & tangent to the grid cell for velocities)
+      !-----------------------------------
+      CALL Agrif_Set_bcinterp(tra_ice_id, interp  = AGRIF_linear)
+      CALL Agrif_Set_bcinterp(u_ice_id  , interp1 = Agrif_linear,interp2 = AGRIF_ppm   )
+      CALL Agrif_Set_bcinterp(v_ice_id  , interp1 = AGRIF_ppm   ,interp2 = Agrif_linear)
+
+      ! 3. Set location of interpolations
+      !----------------------------------
+      CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/))
+      CALL Agrif_Set_bc(u_ice_id  ,(/0,ind1/))
+      CALL Agrif_Set_bc(v_ice_id  ,(/0,ind1/))
+
+      ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities)
+      !--------------------------------------------------
+# if defined UPD_HIGH
+      CALL Agrif_Set_Updatetype(tra_ice_id, update  = Agrif_Update_Full_Weighting)
+      CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Average       , update2 = Agrif_Update_Full_Weighting)
+      CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average       )
+#else
+      CALL Agrif_Set_Updatetype(tra_ice_id, update  = AGRIF_Update_Average)
+      CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average)
+      CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   )
+#endif
+
+   END SUBROUTINE agrif_declare_var_ice
+#endif
+
+
+# if defined key_top
+   SUBROUTINE Agrif_InitValues_cont_top
+      !!----------------------------------------------------------------------
+      !!                 *** ROUTINE Agrif_InitValues_cont_top ***
+      !!----------------------------------------------------------------------
+      USE Agrif_Util
+      USE oce 
+      USE dom_oce
+      USE nemogcm
+      USE par_trc
+      USE lib_mpp
+      USE trc
+      USE in_out_manager
+      USE agrif_oce_sponge
+      USE agrif_top_update
+      USE agrif_top_interp
+      USE agrif_top_sponge
       !!
-      !! ** Purpose :: Initialisation of variables to be interpolated for ice
-      !!----------------------------------------------------------------------
-   USE Agrif_Util
-   USE sbc_oce, ONLY : nn_fsbc  ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc
-   USE ice
-   USE agrif_ice
-   USE in_out_manager
-   USE agrif_ice_interp
-   USE lib_mpp
-   !
-   IMPLICIT NONE
-      !!----------------------------------------------------------------------
-   !
-   ! Declaration of the type of variable which have to be interpolated (parent=>child)
-   !----------------------------------------------------------------------------------
-   CALL agrif_declare_var_ice
-
-   ! Controls
-
-   ! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal can be largely degraded by the agrif zoom)
-   !          the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child)
-   !          therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable
-   !       If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account
-   IF( nn_fsbc > 1 )  CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and sea-ice may not work properly')
-
-   ! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer
-   IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 )  THEN
-      CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)')
-   ENDIF
-   ! First Interpolations (using "after" ice subtime step => nbstep_ice=1)
-   !----------------------------------------------------------------------
-   nbstep_ice = ( Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) ! clem: to have calledweight=1 in interp (otherwise the western border of the zoom is wrong)
-   CALL agrif_interp_ice('U') ! interpolation of ice velocities
-   CALL agrif_interp_ice('V') ! interpolation of ice velocities
-   CALL agrif_interp_ice('T') ! interpolation of ice tracers 
-   nbstep_ice = 0
-   
-   !
-END SUBROUTINE Agrif_InitValues_cont_ice
-
-SUBROUTINE agrif_declare_var_ice
-      !!----------------------------------------------------------------------
-      !!                 *** ROUTINE agrif_declare_var_ice ***
-      !!
-      !! ** Purpose :: Declaration of variables to be interpolated for ice
-      !!----------------------------------------------------------------------
-   USE Agrif_Util
-   USE ice
-   USE par_oce, ONLY : nbghostcells
-   !
-   IMPLICIT NONE
-   !
-   INTEGER :: ind1, ind2, ind3
-      !!----------------------------------------------------------------------
-   !
-   ! 1. Declaration of the type of variable which have to be interpolated (parent=>child)
-   !       agrif_declare_variable(position,1st point index,--,--,dimensions,name)
-   !           ex.:  position=> 1,1 = not-centered (in i and j)
-   !                            2,2 =     centered (    -     )
-   !                 index   => 1,1 = one ghost line
-   !                            2,2 = two ghost lines
-   !-------------------------------------------------------------------------------------
-   ind1 =     nbghostcells
-   ind2 = 1 + nbghostcells
-   ind3 = 2 + nbghostcells
-   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(8+nlay_s+nlay_i)/),tra_ice_id)
-   CALL agrif_declare_variable((/1,2/)  ,(/ind2,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_ice_id  )
-   CALL agrif_declare_variable((/2,1/)  ,(/ind3,ind2/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_ice_id  )
-
-   ! 2. Set interpolations (normal & tangent to the grid cell for velocities)
-   !-----------------------------------
-   CALL Agrif_Set_bcinterp(tra_ice_id, interp  = AGRIF_linear)
-   CALL Agrif_Set_bcinterp(u_ice_id  , interp1 = Agrif_linear,interp2 = AGRIF_ppm   )
-   CALL Agrif_Set_bcinterp(v_ice_id  , interp1 = AGRIF_ppm   ,interp2 = Agrif_linear)
-
-   ! 3. Set location of interpolations
-   !----------------------------------
-   CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/))
-   CALL Agrif_Set_bc(u_ice_id  ,(/0,ind1/))
-   CALL Agrif_Set_bc(v_ice_id  ,(/0,ind1/))
-
-   ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities)
-   !--------------------------------------------------
-# if defined UPD_HIGH
-   CALL Agrif_Set_Updatetype(tra_ice_id, update  = Agrif_Update_Full_Weighting)
-   CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Average       , update2 = Agrif_Update_Full_Weighting)
-   CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average       )
-#else
-   CALL Agrif_Set_Updatetype(tra_ice_id, update  = AGRIF_Update_Average)
-   CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average)
-   CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   )
-#endif
-
-END SUBROUTINE agrif_declare_var_ice
-#endif
-
-
-# if defined key_top
-SUBROUTINE Agrif_InitValues_cont_top
-      !!----------------------------------------------------------------------
-      !!                 *** ROUTINE Agrif_InitValues_cont_top ***
-      !!
-      !! ** Purpose :: Declaration of variables to be interpolated
-      !!----------------------------------------------------------------------
-   USE Agrif_Util
-   USE oce 
-   USE dom_oce
-   USE nemogcm
-   USE par_trc
-   USE lib_mpp
-   USE trc
-   USE in_out_manager
-   USE agrif_oce_sponge
-   USE agrif_top_update
-   USE agrif_top_interp
-   USE agrif_top_sponge
-   !!
-   IMPLICIT NONE
-   !
-   CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3
-   LOGICAL :: check_namelist
-      !!----------------------------------------------------------------------
-
-
-   ! 1. Declaration of the type of variable which have to be interpolated
-   !---------------------------------------------------------------------
-   CALL agrif_declare_var_top
-
-   ! 2. First interpolations of potentially non zero fields
-   !-------------------------------------------------------
-   Agrif_SpecialValue=0.
-   Agrif_UseSpecialValue = .TRUE.
-   CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn)
-   Agrif_UseSpecialValue = .FALSE.
-   CALL Agrif_Sponge
-   tabspongedone_trn = .FALSE.
-   CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge)
-   ! reset tsa to zero
-   tra(:,:,:,:) = 0.
-
-
-   ! 3. Some controls
-   !-----------------
-   check_namelist = .TRUE.
-
-   IF( check_namelist ) THEN
-      ! Check time steps
-      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
-         WRITE(cl_check1,*)  Agrif_Parent(rdt)
-         WRITE(cl_check2,*)  rdt
-         WRITE(cl_check3,*)  rdt*Agrif_Rhot()
+      IMPLICIT NONE
+      !
+      CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3
+      LOGICAL :: check_namelist
+      !!----------------------------------------------------------------------
+
+      ! 1. Declaration of the type of variable which have to be interpolated
+      !---------------------------------------------------------------------
+      CALL agrif_declare_var_top
+
+      ! 2. First interpolations of potentially non zero fields
+      !-------------------------------------------------------
+      Agrif_SpecialValue=0._wp
+      Agrif_UseSpecialValue = .TRUE.
+      CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn)
+      Agrif_UseSpecialValue = .FALSE.
+      CALL Agrif_Sponge
+      tabspongedone_trn = .FALSE.
+      CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge)
+      ! reset ts(:,:,:,:,Krhs_a) to zero
+      tr(:,:,:,:,Krhs_a) = 0._wp
+
+      ! 3. Some controls
+      !-----------------
+      check_namelist = .TRUE.
+
+      IF( check_namelist ) THEN
+         ! Check time steps
+      IF( NINT(Agrif_Rhot()) * NINT(rn_Dt) .NE. Agrif_Parent(rn_Dt) ) THEN
+         WRITE(cl_check1,*)  Agrif_Parent(rn_Dt)
+         WRITE(cl_check2,*)  rn_Dt
+         WRITE(cl_check3,*)  rn_Dt*Agrif_Rhot()
          CALL ctl_stop( 'incompatible time step between grids',   &
                &               'parent grid value : '//cl_check1    ,   & 
@@ -624,193 +636,177 @@
       ENDIF
 
-      ! Check passive tracer cell
-      IF( nn_dttrc .NE. 1 ) THEN
-         WRITE(*,*) 'nn_dttrc should be equal to 1'
-      ENDIF
    ENDIF
    !
-END SUBROUTINE Agrif_InitValues_cont_top
-
-
-SUBROUTINE agrif_declare_var_top
+   END SUBROUTINE Agrif_InitValues_cont_top
+
+
+   SUBROUTINE agrif_declare_var_top
       !!----------------------------------------------------------------------
       !!                 *** ROUTINE agrif_declare_var_top ***
+      !!----------------------------------------------------------------------
+      USE agrif_util
+      USE agrif_oce
+      USE dom_oce
+      USE trc
       !!
-      !! ** Purpose :: Declaration of TOP variables to be interpolated
-      !!----------------------------------------------------------------------
-   USE agrif_util
-   USE agrif_oce
-   USE dom_oce
-   USE trc
-   !!
-   IMPLICIT NONE
-   !
-   INTEGER :: ind1, ind2, ind3
-      !!----------------------------------------------------------------------
-
-   ! 1. Declaration of the type of variable which have to be interpolated
-   !---------------------------------------------------------------------
-   ind1 =     nbghostcells
-   ind2 = 1 + nbghostcells
-   ind3 = 2 + nbghostcells
+      IMPLICIT NONE
+      !
+      INTEGER :: ind1, ind2, ind3
+      !!----------------------------------------------------------------------
+
+      ! 1. Declaration of the type of variable which have to be interpolated
+      !---------------------------------------------------------------------
+      ind1 =     nbghostcells
+      ind2 = 1 + nbghostcells
+      ind3 = 2 + nbghostcells
 # if defined key_vertical
-   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_id)
-   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_sponge_id)
+      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_id)
+      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_sponge_id)
 # else
-   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id)
-   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id)
-# endif
-
-   ! 2. Type of interpolation
-   !-------------------------
-   CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
-   CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
-
-   ! 3. Location of interpolation
-   !-----------------------------
-   CALL Agrif_Set_bc(trn_id,(/0,ind1/))
-   CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
-
-   ! 4. Update type
-   !--------------- 
+      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id)
+      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id)
+# endif
+
+      ! 2. Type of interpolation
+      !-------------------------
+      CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
+      CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
+
+      ! 3. Location of interpolation
+      !-----------------------------
+      CALL Agrif_Set_bc(trn_id,(/0,ind1-1/))
+      CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
+
+      ! 4. Update type
+      !--------------- 
 # if defined UPD_HIGH
-   CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting)
+      CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting)
 #else
-   CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
+      CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
 #endif
    !
-END SUBROUTINE agrif_declare_var_top
-# endif
-
-SUBROUTINE Agrif_detect( kg, ksizex )
+   END SUBROUTINE agrif_declare_var_top
+# endif
+
+   SUBROUTINE Agrif_detect( kg, ksizex )
       !!----------------------------------------------------------------------
       !!                      *** ROUTINE Agrif_detect ***
       !!----------------------------------------------------------------------
-   INTEGER, DIMENSION(2) :: ksizex
-   INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 
-      !!----------------------------------------------------------------------
-   !
-   RETURN
-   !
-END SUBROUTINE Agrif_detect
-
-
-SUBROUTINE agrif_nemo_init
+      INTEGER, DIMENSION(2) :: ksizex
+      INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 
+      !!----------------------------------------------------------------------
+      !
+      RETURN
+      !
+   END SUBROUTINE Agrif_detect
+
+   SUBROUTINE agrif_nemo_init
       !!----------------------------------------------------------------------
       !!                     *** ROUTINE agrif_init ***
       !!----------------------------------------------------------------------
-   USE agrif_oce 
-   USE agrif_ice
-   USE in_out_manager
-   USE lib_mpp
-   !!
-   IMPLICIT NONE
-   !
-   INTEGER  ::   ios                 ! Local integer output status for namelist read
-   INTEGER  ::   iminspon
-   NAMELIST/namagrif/ rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy
+      USE agrif_oce 
+      USE agrif_ice
+      USE in_out_manager
+      USE lib_mpp
+      !!
+      IMPLICIT NONE
+      !
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      NAMELIST/namagrif/ ln_agrif_2way, rn_sponge_tra, rn_sponge_dyn, rn_trelax_tra, rn_trelax_dyn, &
+                       & ln_spc_dyn, ln_chk_bathy
       !!--------------------------------------------------------------------------------------
-   !
-   REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom
-   READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
+      !
+      READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
 901 IF( ios /= 0 )   CALL ctl_nam ( ios , 'namagrif in reference namelist' )
-   REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom
-   READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
+      READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
 902 IF( ios >  0 )   CALL ctl_nam ( ios , 'namagrif in configuration namelist' )
-   IF(lwm) WRITE ( numond, namagrif )
-   !
-   IF(lwp) THEN                    ! control print
-      WRITE(numout,*)
-      WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
-      WRITE(numout,*) '~~~~~~~~~~~~~~~'
-      WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters'
-      WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' s'
-      WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s'
-      WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn
-      WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy
-   ENDIF
-   !
-   ! convert DOCTOR namelist name into OLD names
-   visc_tra      = rn_sponge_tra
-   visc_dyn      = rn_sponge_dyn
-   !
-   ! Check sponge length:
-   iminspon = MIN(FLOOR(REAL(jpiglo-4)/REAL(2*Agrif_irhox())), FLOOR(REAL(jpjglo-4)/REAL(2*Agrif_irhox())) )
-   IF (lk_mpp) iminspon = MIN(iminspon,FLOOR(REAL(jpi-2)/REAL(Agrif_irhox())), FLOOR(REAL(jpj-2)/REAL(Agrif_irhox())) )
-   IF (nn_sponge_len > iminspon)  CALL ctl_stop('agrif sponge length is too large')
-   !
-   IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
-   !
-END SUBROUTINE agrif_nemo_init
+      IF(lwm) WRITE ( numond, namagrif )
+      !
+      IF(lwp) THEN                    ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
+         WRITE(numout,*) '~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters'
+         WRITE(numout,*) '      Two way nesting activated ln_agrif_2way         = ', ln_agrif_2way
+         WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' m^2/s'
+         WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' m^2/s'
+         WRITE(numout,*) '      time relaxation for tracers       rn_trelax_tra = ', rn_trelax_tra, ' ad.'
+         WRITE(numout,*) '      time relaxation for dynamics      rn_trelax_dyn = ', rn_trelax_dyn, ' ad.'
+         WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn
+         WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy
+      ENDIF
+      !
+      !
+      IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
+      !
+   END SUBROUTINE agrif_nemo_init
 
 # if defined key_mpp_mpi
 
-SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
+   SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
       !!----------------------------------------------------------------------
       !!                     *** ROUTINE Agrif_InvLoc ***
       !!----------------------------------------------------------------------
-   USE dom_oce
-   !!
-   IMPLICIT NONE
-   !
-   INTEGER :: indglob, indloc, nprocloc, i
-      !!----------------------------------------------------------------------
-   !
-   SELECT CASE( i )
-   CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1
-   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1
-   CASE DEFAULT
-      indglob = indloc
-   END SELECT
-   !
-END SUBROUTINE Agrif_InvLoc
-
-
-SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
+      USE dom_oce
+      !!
+      IMPLICIT NONE
+      !
+      INTEGER :: indglob, indloc, nprocloc, i
+      !!----------------------------------------------------------------------
+      !
+      SELECT CASE( i )
+      CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1
+      CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1
+      CASE DEFAULT
+         indglob = indloc
+      END SELECT
+      !
+   END SUBROUTINE Agrif_InvLoc
+
+   SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
       !!----------------------------------------------------------------------
       !!                 *** ROUTINE Agrif_get_proc_info ***
       !!----------------------------------------------------------------------
-   USE par_oce
-   !!
-   IMPLICIT NONE
-   !
-   INTEGER, INTENT(out) :: imin, imax
-   INTEGER, INTENT(out) :: jmin, jmax
-      !!----------------------------------------------------------------------
-   !
-   imin = nimppt(Agrif_Procrank+1)  ! ?????
-   jmin = njmppt(Agrif_Procrank+1)  ! ?????
-   imax = imin + jpi - 1
-   jmax = jmin + jpj - 1
-   ! 
-END SUBROUTINE Agrif_get_proc_info
-
-
-SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
+      USE par_oce
+      !!
+      IMPLICIT NONE
+      !
+      INTEGER, INTENT(out) :: imin, imax
+      INTEGER, INTENT(out) :: jmin, jmax
+      !!----------------------------------------------------------------------
+      !
+      imin = nimppt(Agrif_Procrank+1)  ! ?????
+      jmin = njmppt(Agrif_Procrank+1)  ! ?????
+      imax = imin + jpi - 1
+      jmax = jmin + jpj - 1
+      ! 
+   END SUBROUTINE Agrif_get_proc_info
+
+   SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
       !!----------------------------------------------------------------------
       !!                 *** ROUTINE Agrif_estimate_parallel_cost ***
       !!----------------------------------------------------------------------
-   USE par_oce
-   !!
-   IMPLICIT NONE
-   !
-   INTEGER,  INTENT(in)  :: imin, imax
-   INTEGER,  INTENT(in)  :: jmin, jmax
-   INTEGER,  INTENT(in)  :: nbprocs
-   REAL(wp), INTENT(out) :: grid_cost
-      !!----------------------------------------------------------------------
-   !
-   grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
-   !
-END SUBROUTINE Agrif_estimate_parallel_cost
+      USE par_oce
+      !!
+      IMPLICIT NONE
+      !
+      INTEGER,  INTENT(in)  :: imin, imax
+      INTEGER,  INTENT(in)  :: jmin, jmax
+      INTEGER,  INTENT(in)  :: nbprocs
+      REAL(wp), INTENT(out) :: grid_cost
+      !!----------------------------------------------------------------------
+      !
+      grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
+      !
+   END SUBROUTINE Agrif_estimate_parallel_cost
 
 # endif
 
 #else
-SUBROUTINE Subcalledbyagrif
+   SUBROUTINE Subcalledbyagrif
       !!----------------------------------------------------------------------
       !!                   *** ROUTINE Subcalledbyagrif ***
       !!----------------------------------------------------------------------
-   WRITE(*,*) 'Impossible to be here'
-END SUBROUTINE Subcalledbyagrif
+      WRITE(*,*) 'Impossible to be here'
+   END SUBROUTINE Subcalledbyagrif
 #endif
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/vremap.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/vremap.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/vremap.F90	(revision 12928)
@@ -0,0 +1,399 @@
+#undef PPR_LIB      /* USE PPR library */
+MODULE vremap
+!$AGRIF_DO_NOT_TREAT
+   !!======================================================================
+   !!                       ***  MODULE  vremap  ***
+   !! Ocean physics:  Vertical remapping routines
+   !!
+   !!======================================================================
+   !! History : 4.0  !  2019-09  (Jérôme Chanut)  Original code
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!
+   !!----------------------------------------------------------------------
+   USE par_oce
+#if defined PPR_LIB
+   USE ppr_1d   ! D. Engwirda piecewise polynomial reconstruction library
+#endif
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   reconstructandremap, remap_linear
+
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: vremap 11573 2019-09-19 09:18:03Z jchanut $ 
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+#if ! defined PPR_LIB
+   SUBROUTINE reconstructandremap(ptin, phin, ptout, phout, kjpk_in, kjpk_out, kn_var)      
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE  reconstructandremap ***
+      !!
+      !! ** 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 :   Author et al., Short_name_review, Year
+      !!                Give references if exist otherwise suppress these lines
+      !!-----------------------------------------------------------------------
+      INTEGER , INTENT(in   )                      ::   kjpk_in    ! Number of input levels
+      INTEGER , INTENT(in   )                      ::   kjpk_out   ! Number of output levels
+      INTEGER , INTENT(in   )                      ::   kn_var     ! Number of variables
+      REAL(wp), INTENT(in   ), DIMENSION(kjpk_in)  ::   phin       ! Input thicknesses
+      REAL(wp), INTENT(in   ), DIMENSION(kjpk_out) ::   phout      ! Output thicknesses
+      REAL(wp), INTENT(in   ), DIMENSION(kjpk_in , kn_var) ::   ptin       ! Input data
+      REAL(wp), INTENT(inout), DIMENSION(kjpk_out, kn_var) ::   ptout      ! Remapped data
+      !
+      INTEGER             :: jk, jn, k1, kbox, ktop, ka, kbot
+      REAL(wp), PARAMETER :: dpthin = 1.D-3, dsmll = 1.0D-8
+      REAL(wp)            :: q, q01, q02, q001, q002, q0
+      REAL(wp)            :: tsum, qbot, rpsum, zbox, ztop, zthk, zbot, offset, qtop
+      REAL(wp)            :: coeffremap(kjpk_in,3), zwork(kjpk_in,3), zwork2(kjpk_in+1,3)
+      REAL(wp)            :: z_win(1:kjpk_in+1), z_wout(1:kjpk_out+1)
+      !!-----------------------------------------------------------------------
+
+      z_win(1)=0._wp ; z_wout(1)= 0._wp
+      DO jk = 1, kjpk_in
+         z_win(jk+1)=z_win(jk)+phin(jk)
+      END DO 
+      
+      DO jk = 1, kjpk_out
+         z_wout(jk+1)=z_wout(jk)+phout(jk)       
+      END DO       
+
+      DO jk = 2, kjpk_in
+         zwork(jk,1)=1._wp/(phin(jk-1)+phin(jk))
+      END DO
+        
+      DO jk = 2, kjpk_in-1
+         q0 = 1._wp / (phin(jk-1)+phin(jk)+phin(jk+1))
+         zwork(jk,2) = phin(jk-1) + 2._wp*phin(jk) + phin(jk+1)
+         zwork(jk,3) = q0
+      END DO       
+     
+      DO jn = 1, kn_var
+
+         DO jk = 2,kjpk_in
+            zwork2(jk,1) = zwork(jk,1)*(ptin(jk,jn)-ptin(jk-1,jn))
+         END DO
+        
+         coeffremap(:,1) = ptin(:,jn)
+ 
+         DO jk = 2, kjpk_in-1
+            q001 = phin(jk)*zwork2(jk+1,1)
+            q002 = phin(jk)*zwork2(jk,1)        
+            IF (q001*q002 < 0._wp) then
+               q001 = 0._wp
+               q002 = 0._wp
+            ENDIF
+            q=zwork(jk,2)
+            q01=q*zwork2(jk+1,1)
+            q02=q*zwork2(jk,1)
+            IF (abs(q001) > abs(q02)) q001 = q02
+            IF (abs(q002) > abs(q01)) q002 = q01
+        
+            q=(q001-q002)*zwork(jk,3)
+            q001=q001-q*phin(jk+1)
+            q002=q002+q*phin(jk-1)
+        
+            coeffremap(jk,3)=coeffremap(jk,1)+q001
+            coeffremap(jk,2)=coeffremap(jk,1)-q002
+        
+            zwork2(jk,1)=(2._wp*q001-q002)**2
+            zwork2(jk,2)=(2._wp*q002-q001)**2
+         ENDDO
+        
+         DO jk = 1, kjpk_in
+            IF(jk.EQ.1 .OR. jk.EQ.kjpk_in .OR. phin(jk).LE.dpthin) THEN
+               coeffremap(jk,3) = coeffremap(jk,1)
+               coeffremap(jk,2) = coeffremap(jk,1)
+               zwork2(jk,1) = 0._wp
+               zwork2(jk,2) = 0._wp
+            ENDIF
+         END DO
+        
+         DO jk = 2, kjpk_in
+            q002 = max(zwork2(jk-1,2),dsmll)
+            q001 = max(zwork2(jk,1)  ,dsmll)
+            zwork2(jk,3) = (q001*coeffremap(jk-1,3)+q002*coeffremap(jk,2))/(q001+q002)
+         END DO
+        
+         zwork2(1,3) = 2._wp*coeffremap(1,1)-zwork2(2,3)
+         zwork2(kjpk_in+1,3)=2._wp*coeffremap(kjpk_in,1)-zwork2(kjpk_in,3)
+ 
+         DO jk = 1, kjpk_in
+            q01=zwork2(jk+1,3)-coeffremap(jk,1)
+            q02=coeffremap(jk,1)-zwork2(jk,3)
+            q001=2._wp*q01
+            q002=2._wp*q02
+            IF (q01*q02<0._wp) then
+               q01=0._wp
+               q02=0._wp
+            ELSEIF (abs(q01)>abs(q002)) then
+               q01=q002
+            ELSEIF (abs(q02)>abs(q001)) then
+               q02=q001
+            ENDIF
+            coeffremap(jk,2)=coeffremap(jk,1)-q02
+            coeffremap(jk,3)=coeffremap(jk,1)+q01
+         ENDDO
+
+         zbot=0._wp
+         kbot=1
+         DO jk=1,kjpk_out
+            ztop=zbot  !top is bottom of previous layer
+            ktop=kbot
+            IF     (ztop.GE.z_win(ktop+1)) then
+               ktop=ktop+1
+            ENDIF
+        
+            zbot=z_wout(jk+1)
+            zthk=zbot-ztop
+
+            IF(zthk.GT.dpthin .AND. ztop.LT.z_wout(kjpk_out+1)) THEN
+ 
+               kbot=ktop
+               DO while (z_win(kbot+1).lt.zbot.and.kbot.lt.kjpk_in)
+                  kbot=kbot+1
+               ENDDO
+               zbox=zbot
+               DO k1= jk+1,kjpk_out
+                  IF     (z_wout(k1+1)-z_wout(k1).GT.dpthin) THEN
+                     exit !thick layer
+                  ELSE
+                     zbox=z_wout(k1+1)  !include thin adjacent layers
+                     IF(zbox.EQ.z_wout(kjpk_out+1)) THEN
+                        exit !at bottom
+                     ENDIF
+                  ENDIF
+               ENDDO
+               zthk=zbox-ztop
+
+               kbox=ktop
+               DO while (z_win(kbox+1).lt.zbox.and.kbox.lt.kjpk_in)
+                  kbox=kbox+1
+               ENDDO
+          
+               IF(ktop.EQ.kbox) THEN
+                  IF(z_wout(jk).NE.z_win(kbox).OR.z_wout(jk+1).NE.z_win(kbox+1)) THEN
+                     IF(phin(kbox).GT.dpthin) THEN
+                        q001 = (zbox-z_win(kbox))/phin(kbox)
+                        q002 = (ztop-z_win(kbox))/phin(kbox)
+                        q01=q001**2+q002**2+q001*q002+1._wp-2._wp*(q001+q002)
+                        q02=q01-1._wp+(q001+q002)
+                        q0=1._wp-q01-q02
+                     ELSE
+                        q0  = 1._wp
+                        q01 = 0._wp
+                        q02 = 0._wp
+                     ENDIF
+                     ptout(jk,jn)=q0*coeffremap(kbox,1)+q01*coeffremap(kbox,2)+q02*coeffremap(kbox,3)
+                  ELSE
+                     ptout(jk,jn) = ptin(kbox,jn)
+                  ENDIF 
+               ELSE
+                  IF(ktop.LE.jk .AND. kbox.GE.jk) THEN
+                     ka = jk
+                  ELSEIF (kbox-ktop.GE.3) THEN
+                     ka = (kbox+ktop)/2
+                  ELSEIF (phin(ktop).GE.phin(kbox)) THEN
+                     ka = ktop
+                  ELSE
+                     ka = kbox
+                  ENDIF !choose ka
+    
+                  offset=coeffremap(ka,1)
+    
+                  qtop = z_win(ktop+1)-ztop !partial layer thickness
+                  IF(phin(ktop).GT.dpthin) THEN
+                     q=(ztop-z_win(ktop))/phin(ktop)
+                     q01=q*(q-1._wp)
+                     q02=q01+q
+                     q0=1._wp-q01-q02            
+                  ELSE
+                     q0  = 1._wp
+                     q01 = 0._wp
+                     q02 = 0._wp
+                  ENDIF
+               
+                  tsum =((q0*coeffremap(ktop,1)+q01*coeffremap(ktop,2)+q02*coeffremap(ktop,3))-offset)*qtop
+    
+                  DO k1= ktop+1,kbox-1
+                     tsum =tsum +(coeffremap(k1,1)-offset)*phin(k1)
+                  ENDDO !k1
+               
+                  qbot = zbox-z_win(kbox) !partial layer thickness
+                  IF(phin(kbox).GT.dpthin) THEN
+                     q=qbot/phin(kbox)
+                     q01=(q-1._wp)**2
+                     q02=q01-1._wp+q
+                     q0=1_wp-q01-q02                            
+                  ELSE
+                     q0  = 1._wp
+                     q01 = 0._wp
+                     q02 = 0._wp
+                  ENDIF
+              
+                  tsum = tsum +((q0*coeffremap(kbox,1)+q01*coeffremap(kbox,2)+q02*coeffremap(kbox,3))-offset)*qbot
+               
+                  rpsum=1._wp / zthk
+                  ptout(jk,jn)=offset+tsum*rpsum
+                 
+               ENDIF !single or multiple layers
+            ELSE
+               IF (jk==1) THEN
+                  write(*,'(a7,i4,i4,3f12.5)')'problem = ',kjpk_in,kjpk_out,zthk,z_wout(jk+1),phout(1)
+               ENDIF
+               ptout(jk,jn) = ptout(jk-1,jn)
+             
+            ENDIF !normal:thin layer
+         ENDDO !jk
+
+      END DO ! loop over variables
+            
+   END SUBROUTINE reconstructandremap
+
+#else
+
+   SUBROUTINE reconstructandremap(ptin, phin, ptout, phout, kjpk_in, kjpk_out, kn_var)
+      !!----------------------------------------------------------------------
+      !!                    *** ROUTINE  reconstructandremap ***
+      !!
+      !! ** Purpose :   Conservative remapping of a vertical column 
+      !!                from one set of layers to an other one.
+      !!
+      !! ** Method  :   Uses D. Engwirda Piecewise Polynomial Reconstruction library.
+      !!                https://github.com/dengwirda/PPR
+      !!                
+      !!
+      !! References :   Engwirda, Darren & Kelley, Maxwell. (2015). A WENO-type 
+      !!                slope-limiter for a family of piecewise polynomial methods. 
+      !!                https://arxiv.org/abs/1606.08188
+      !!-----------------------------------------------------------------------
+      INTEGER , INTENT(in   )                      ::   kjpk_in    ! Number of input levels
+      INTEGER , INTENT(in   )                      ::   kjpk_out   ! Number of output levels
+      INTEGER , INTENT(in   )                      ::   kn_var     ! Number of variables
+      REAL(wp), INTENT(in   ), DIMENSION(kjpk_in)  ::   phin       ! Input thicknesses
+      REAL(wp), INTENT(in   ), DIMENSION(kjpk_out) ::   phout      ! Output thicknesses
+      REAL(wp), INTENT(in   ), DIMENSION(kjpk_in , kn_var) ::   ptin       ! Input data
+      REAL(wp), INTENT(inout), DIMENSION(kjpk_out, kn_var) ::   ptout      ! Remapped data
+      !
+      INTEGER, PARAMETER :: ndof = 1
+      INTEGER  :: jk, jn
+      REAL(wp) ::  zwin(kjpk_in+1) ,  ztin(ndof, kn_var, kjpk_in)
+      REAL(wp) :: zwout(kjpk_out+1), ztout(ndof, kn_var, kjpk_out)
+      TYPE(rmap_work) :: work
+      TYPE(rmap_opts) :: opts
+      TYPE(rcon_ends) :: bc_l(kn_var)
+      TYPE(rcon_ends) :: bc_r(kn_var)
+      !!--------------------------------------------------------------------
+     
+      ! Set interfaces and input data:
+      zwin(1) = 0._wp
+      DO jk = 2, kjpk_in + 1
+         zwin(jk) = zwin(jk-1) + phin(jk-1) 
+      END DO
+      
+      DO jn = 1, kn_var 
+         DO jk = 1, kjpk_in
+            ztin(ndof, jn, jk) =  ptin(jk, jn)
+         END DO
+      END DO
+
+      zwout(1) = 0._wp
+      DO jk = 2, kjpk_out + 1
+         zwout(jk) = zwout(jk-1) + phout(jk-1) 
+      END DO
+
+      ! specify methods
+!      opts%edge_meth = p1e_method     ! 1st-order edge interp.
+!      opts%cell_meth = plm_method     ! PLM method in cells
+      opts%edge_meth = p3e_method     ! 3rd-order edge interp.
+      opts%cell_meth = ppm_method     ! PPM method in cells    
+!      opts%edge_meth = p5e_method     ! 5th-order edge interp.
+!      opts%cell_meth = pqm_method     ! PQM method in cells
+
+      ! limiter
+!      opts%cell_lims = null_limit     ! no lim.
+      opts%cell_lims = mono_limit     ! monotone limiter   
+ 
+      ! set boundary conditions
+      bc_l%bcopt = bcon_loose         ! "loose" = extrapolate
+      bc_r%bcopt = bcon_loose
+!      bc_l%bcopt = bcon_slope        
+!      bc_r%bcopt = bcon_slope
+
+      ! init. method workspace
+      CALL work%init(kjpk_in+1, kn_var, opts)
+
+      ! remap
+      CALL rmap1d(kjpk_in+1, kjpk_out+1, kn_var, ndof, &
+      &           zwin, zwout, ztin, ztout,            &
+      &           bc_l, bc_r, work, opts)
+
+      ! clear method workspace
+      CALL work%free()
+
+      DO jn = 1, kn_var 
+         DO jk = 1, kjpk_out
+            ptout(jk, jn) = ztout(1, jn, jk)
+         END DO
+      END DO
+            
+   END SUBROUTINE reconstructandremap
+#endif
+
+   SUBROUTINE remap_linear(ptin, pzin, ptout, pzout, kjpk_in, kjpk_out, kn_var)
+      !!----------------------------------------------------------------------
+      !!                    *** ROUTINE  remap_linear ***
+      !!
+      !! ** Purpose :   Linear interpolation based on input/ouputs depths
+      !!
+      !!-----------------------------------------------------------------------
+      INTEGER , INTENT(in   )                      ::   kjpk_in    ! Number of input levels
+      INTEGER , INTENT(in   )                      ::   kjpk_out   ! Number of output levels
+      INTEGER , INTENT(in   )                      ::   kn_var     ! Number of variables
+      REAL(wp), INTENT(in   ), DIMENSION(kjpk_in)  ::   pzin       ! Input depths
+      REAL(wp), INTENT(in   ), DIMENSION(kjpk_out) ::   pzout      ! Output depths
+      REAL(wp), INTENT(in   ), DIMENSION(kjpk_in , kn_var) ::   ptin       ! Input data
+      REAL(wp), INTENT(inout), DIMENSION(kjpk_out, kn_var) ::   ptout      ! Interpolated data
+      !
+      INTEGER  :: jkin, jkout, jn
+      !!--------------------------------------------------------------------
+      !      
+      DO jkout = 1, kjpk_out !  Loop over destination grid
+         !
+         IF     ( pzout(jkout) <=  pzin(  1    ) ) THEN 	; ptout(jkout,1:kn_var) = ptin(    1    ,1:kn_var)         
+         ELSEIF ( pzout(jkout) >= pzin(kjpk_in) ) THEN 	; ptout(jkout,1:kn_var) = ptin( kjpk_in ,1:kn_var)
+         ELSEIF ( ( pzout(jkout) > pzin(1) ).AND.( pzout(jkout) < pzin(kjpk_in) )) THEN
+            DO jkin = 1, kjpk_in - 1 !  Loop over source grid
+               IF ( pzout(jkout) < pzin(jkin+1) ) THEN
+                  DO jn = 1, kn_var
+                     ptout(jkout,jn) =  ptin(jkin,jn) + &
+                                     & (pzout(jkout) - pzin(jkin)) / (pzin(jkin+1)    - pzin(jkin)) &
+                                     &                             * (ptin(jkin+1,jn) - ptin(jkin,jn))
+                  END DO  
+                  EXIT
+               ENDIF  
+            END DO
+         ENDIF
+         !
+      END DO
+
+   END SUBROUTINE remap_linear
+
+   !!======================================================================
+!$AGRIF_END_DO_NOT_TREAT
+END MODULE vremap
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ASM/asmbkg.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ASM/asmbkg.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ASM/asmbkg.F90	(revision 12928)
@@ -52,5 +52,5 @@
 CONTAINS
 
-   SUBROUTINE asm_bkg_wri( kt )
+   SUBROUTINE asm_bkg_wri( kt, Kmm )
       !!-----------------------------------------------------------------------
       !!                  ***  ROUTINE asm_bkg_wri ***
@@ -65,4 +65,5 @@
       !!-----------------------------------------------------------------------
       INTEGER, INTENT( IN ) :: kt               ! Current time-step
+      INTEGER, INTENT( IN ) :: Kmm              ! time level index
       !
       CHARACTER (LEN=50) :: cl_asmbkg
@@ -98,11 +99,11 @@
             !
             !                                      ! Write the information
-            CALL iom_rstput( kt, nitbkg_r, inum, 'rdastp' , zdate             )
-            CALL iom_rstput( kt, nitbkg_r, inum, 'un'     , un                )
-            CALL iom_rstput( kt, nitbkg_r, inum, 'vn'     , vn                )
-            CALL iom_rstput( kt, nitbkg_r, inum, 'tn'     , tsn(:,:,:,jp_tem) )
-            CALL iom_rstput( kt, nitbkg_r, inum, 'sn'     , tsn(:,:,:,jp_sal) )
-            CALL iom_rstput( kt, nitbkg_r, inum, 'sshn'   , sshn              )
-            IF( ln_zdftke )   CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en                )
+            CALL iom_rstput( kt, nitbkg_r, inum, 'rdastp' , zdate                )
+            CALL iom_rstput( kt, nitbkg_r, inum, 'un'     , uu(:,:,:,Kmm)        )
+            CALL iom_rstput( kt, nitbkg_r, inum, 'vn'     , vv(:,:,:,Kmm)        )
+            CALL iom_rstput( kt, nitbkg_r, inum, 'tn'     , ts(:,:,:,jp_tem,Kmm) )
+            CALL iom_rstput( kt, nitbkg_r, inum, 'sn'     , ts(:,:,:,jp_sal,Kmm) )
+            CALL iom_rstput( kt, nitbkg_r, inum, 'sshn'   , ssh(:,:,Kmm)         )
+            IF( ln_zdftke )   CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en )
             !
             CALL iom_close( inum )
@@ -133,10 +134,10 @@
             !
             !                                      ! Write the information
-            CALL iom_rstput( kt, nitdin_r, inum, 'rdastp' , zdate             )
-            CALL iom_rstput( kt, nitdin_r, inum, 'un'     , un                )
-            CALL iom_rstput( kt, nitdin_r, inum, 'vn'     , vn                )
-            CALL iom_rstput( kt, nitdin_r, inum, 'tn'     , tsn(:,:,:,jp_tem) )
-            CALL iom_rstput( kt, nitdin_r, inum, 'sn'     , tsn(:,:,:,jp_sal) )
-            CALL iom_rstput( kt, nitdin_r, inum, 'sshn'   , sshn              )
+            CALL iom_rstput( kt, nitdin_r, inum, 'rdastp' , zdate                )
+            CALL iom_rstput( kt, nitdin_r, inum, 'un'     , uu(:,:,:,Kmm)        )
+            CALL iom_rstput( kt, nitdin_r, inum, 'vn'     , vv(:,:,:,Kmm)        )
+            CALL iom_rstput( kt, nitdin_r, inum, 'tn'     , ts(:,:,:,jp_tem,Kmm) )
+            CALL iom_rstput( kt, nitdin_r, inum, 'sn'     , ts(:,:,:,jp_sal,Kmm) )
+            CALL iom_rstput( kt, nitdin_r, inum, 'sshn'   , ssh(:,:,Kmm)         )
 #if defined key_si3
             IF( nn_ice == 2 ) THEN
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ASM/asminc.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ASM/asminc.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ASM/asminc.F90	(revision 12928)
@@ -94,5 +94,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -102,5 +102,5 @@
 CONTAINS
 
-   SUBROUTINE asm_inc_init
+   SUBROUTINE asm_inc_init( Kbb, Kmm, Krhs )
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE asm_inc_init  ***
@@ -112,4 +112,6 @@
       !! ** Action  : 
       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::  Kbb, Kmm, Krhs  ! time level indices
+      !
       INTEGER :: ji, jj, jk, jt  ! dummy loop indices
       INTEGER :: imid, inum      ! local integers
@@ -145,8 +147,6 @@
       ln_temnofreeze = .FALSE.
 
-      REWIND( numnam_ref )              ! Namelist nam_asminc in reference namelist : Assimilation increment
       READ  ( numnam_ref, nam_asminc, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_asminc in reference namelist' )
-      REWIND( numnam_cfg )              ! Namelist nam_asminc in configuration namelist : Assimilation increment
       READ  ( numnam_cfg, nam_asminc, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nam_asminc in configuration namelist' )
@@ -413,22 +413,18 @@
             DO jk = 1, jpkm1           ! zhdiv = e1e1 * div
                zhdiv(:,:) = 0._wp
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     zhdiv(ji,jj) = (  e2u(ji  ,jj) * e3u_n(ji  ,jj,jk) * u_bkginc(ji  ,jj,jk)    &
-                        &            - e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) * u_bkginc(ji-1,jj,jk)    &
-                        &            + e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) * v_bkginc(ji,jj  ,jk)    &
-                        &            - e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * v_bkginc(ji,jj-1,jk)  ) / e3t_n(ji,jj,jk)
-                  END DO
-               END DO
+               DO_2D_00_00
+                  zhdiv(ji,jj) = (  e2u(ji  ,jj) * e3u(ji  ,jj,jk,Kmm) * u_bkginc(ji  ,jj,jk)    &
+                     &            - e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * u_bkginc(ji-1,jj,jk)    &
+                     &            + e1v(ji,jj  ) * e3v(ji,jj  ,jk,Kmm) * v_bkginc(ji,jj  ,jk)    &
+                     &            - e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) * v_bkginc(ji,jj-1,jk)  ) / e3t(ji,jj,jk,Kmm)
+               END_2D
                CALL lbc_lnk( 'asminc', zhdiv, 'T', 1. )   ! lateral boundary cond. (no sign change)
                !
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk)                         &
-                        &               + 0.2_wp * ( zhdiv(ji+1,jj) - zhdiv(ji  ,jj) ) * r1_e1u(ji,jj) * umask(ji,jj,jk)
-                     v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk)                         &
-                        &               + 0.2_wp * ( zhdiv(ji,jj+1) - zhdiv(ji,jj  ) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 
-                  END DO
-               END DO
+               DO_2D_00_00
+                  u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk)                         &
+                     &               + 0.2_wp * ( zhdiv(ji+1,jj) - zhdiv(ji  ,jj) ) * r1_e1u(ji,jj) * umask(ji,jj,jk)
+                  v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk)                         &
+                     &               + 0.2_wp * ( zhdiv(ji,jj+1) - zhdiv(ji,jj  ) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 
+               END_2D
             END DO
             !
@@ -491,12 +487,12 @@
       ENDIF
       !
-      IF(lwp) WRITE(numout,*) '   ==>>>   Euler time step switch is ', neuler
+      IF(lwp) WRITE(numout,*) '   ==>>>   Euler time step switch is ', l_1st_euler
       !
       IF( lk_asminc ) THEN                            !==  data assimilation  ==!
-         IF( ln_bkgwri )   CALL asm_bkg_wri( nit000 - 1 )      ! Output background fields
+         IF( ln_bkgwri )   CALL asm_bkg_wri( nit000 - 1, Kmm )      ! Output background fields
          IF( ln_asmdin ) THEN                                  ! Direct initialization
-            IF( ln_trainc )   CALL tra_asm_inc( nit000 - 1 )      ! Tracers
-            IF( ln_dyninc )   CALL dyn_asm_inc( nit000 - 1 )      ! Dynamics
-            IF( ln_sshinc )   CALL ssh_asm_inc( nit000 - 1 )      ! SSH
+            IF( ln_trainc )   CALL tra_asm_inc( nit000 - 1, Kbb, Kmm, ts    , Krhs )      ! Tracers
+            IF( ln_dyninc )   CALL dyn_asm_inc( nit000 - 1, Kbb, Kmm, uu, vv, Krhs )      ! Dynamics
+            IF( ln_sshinc )   CALL ssh_asm_inc( nit000 - 1, Kbb, Kmm )                    ! SSH
          ENDIF
       ENDIF
@@ -505,5 +501,5 @@
    
    
-   SUBROUTINE tra_asm_inc( kt )
+   SUBROUTINE tra_asm_inc( kt, Kbb, Kmm, pts, Krhs )
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE tra_asm_inc  ***
@@ -515,5 +511,7 @@
       !! ** Action  : 
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(IN) ::   kt   ! Current time step
+      INTEGER                                  , INTENT(in   ) :: kt             ! Current time step
+      INTEGER                                  , INTENT(in   ) :: Kbb, Kmm, Krhs ! Time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts            ! active tracers and RHS of tracer equation
       !
       INTEGER  :: ji, jj, jk
@@ -526,5 +524,5 @@
       ! used to prevent the applied increments taking the temperature below the local freezing point 
       DO jk = 1, jpkm1
-        CALL eos_fzp( tsn(:,:,jk,jp_sal), fzptnz(:,:,jk), gdept_n(:,:,jk) )
+        CALL eos_fzp( pts(:,:,jk,jp_sal,Kmm), fzptnz(:,:,jk), gdept(:,:,jk,Kmm) )
       END DO
          !
@@ -536,5 +534,5 @@
             !
             it = kt - nit000 + 1
-            zincwgt = wgtiau(it) / rdt   ! IAU weight for the current time step
+            zincwgt = wgtiau(it) / rn_Dt   ! IAU weight for the current time step
             !
             IF(lwp) THEN
@@ -549,9 +547,9 @@
                   ! Do not apply negative increments if the temperature will fall below freezing
                   WHERE(t_bkginc(:,:,jk) > 0.0_wp .OR. &
-                     &   tsn(:,:,jk,jp_tem) + tsa(:,:,jk,jp_tem) + t_bkginc(:,:,jk) * wgtiau(it) > fzptnz(:,:,jk) ) 
-                     tsa(:,:,jk,jp_tem) = tsa(:,:,jk,jp_tem) + t_bkginc(:,:,jk) * zincwgt  
+                     &   pts(:,:,jk,jp_tem,Kmm) + pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * wgtiau(it) > fzptnz(:,:,jk) ) 
+                     pts(:,:,jk,jp_tem,Krhs) = pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * zincwgt  
                   END WHERE
                ELSE
-                  tsa(:,:,jk,jp_tem) = tsa(:,:,jk,jp_tem) + t_bkginc(:,:,jk) * zincwgt  
+                  pts(:,:,jk,jp_tem,Krhs) = pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * zincwgt  
                ENDIF
                IF (ln_salfix) THEN
@@ -559,9 +557,9 @@
                   ! minimum value salfixmin
                   WHERE(s_bkginc(:,:,jk) > 0.0_wp .OR. &
-                     &   tsn(:,:,jk,jp_sal) + tsa(:,:,jk,jp_sal) + s_bkginc(:,:,jk) * wgtiau(it) > salfixmin ) 
-                     tsa(:,:,jk,jp_sal) = tsa(:,:,jk,jp_sal) + s_bkginc(:,:,jk) * zincwgt
+                     &   pts(:,:,jk,jp_sal,Kmm) + pts(:,:,jk,jp_sal,Krhs) + s_bkginc(:,:,jk) * wgtiau(it) > salfixmin ) 
+                     pts(:,:,jk,jp_sal,Krhs) = pts(:,:,jk,jp_sal,Krhs) + s_bkginc(:,:,jk) * zincwgt
                   END WHERE
                ELSE
-                  tsa(:,:,jk,jp_sal) = tsa(:,:,jk,jp_sal) + s_bkginc(:,:,jk) * zincwgt
+                  pts(:,:,jk,jp_sal,Krhs) = pts(:,:,jk,jp_sal,Krhs) + s_bkginc(:,:,jk) * zincwgt
                ENDIF
             END DO
@@ -579,38 +577,38 @@
          IF ( kt == nitdin_r ) THEN
             !
-            neuler = 0  ! Force Euler forward step
+            l_1st_euler = .TRUE.  ! Force Euler forward step
             !
             ! Initialize the now fields with the background + increment
             IF (ln_temnofreeze) THEN
                ! Do not apply negative increments if the temperature will fall below freezing
-               WHERE( t_bkginc(:,:,:) > 0.0_wp .OR. tsn(:,:,:,jp_tem) + t_bkginc(:,:,:) > fzptnz(:,:,:) ) 
-                  tsn(:,:,:,jp_tem) = t_bkg(:,:,:) + t_bkginc(:,:,:)   
+               WHERE( t_bkginc(:,:,:) > 0.0_wp .OR. pts(:,:,:,jp_tem,Kmm) + t_bkginc(:,:,:) > fzptnz(:,:,:) ) 
+                  pts(:,:,:,jp_tem,Kmm) = t_bkg(:,:,:) + t_bkginc(:,:,:)   
                END WHERE
             ELSE
-               tsn(:,:,:,jp_tem) = t_bkg(:,:,:) + t_bkginc(:,:,:)   
+               pts(:,:,:,jp_tem,Kmm) = t_bkg(:,:,:) + t_bkginc(:,:,:)   
             ENDIF
             IF (ln_salfix) THEN
                ! Do not apply negative increments if the salinity will fall below a specified
                ! minimum value salfixmin
-               WHERE( s_bkginc(:,:,:) > 0.0_wp .OR. tsn(:,:,:,jp_sal) + s_bkginc(:,:,:) > salfixmin ) 
-                  tsn(:,:,:,jp_sal) = s_bkg(:,:,:) + s_bkginc(:,:,:)   
+               WHERE( s_bkginc(:,:,:) > 0.0_wp .OR. pts(:,:,:,jp_sal,Kmm) + s_bkginc(:,:,:) > salfixmin ) 
+                  pts(:,:,:,jp_sal,Kmm) = s_bkg(:,:,:) + s_bkginc(:,:,:)   
                END WHERE
             ELSE
-               tsn(:,:,:,jp_sal) = s_bkg(:,:,:) + s_bkginc(:,:,:)   
+               pts(:,:,:,jp_sal,Kmm) = s_bkg(:,:,:) + s_bkginc(:,:,:)   
             ENDIF
 
-            tsb(:,:,:,:) = tsn(:,:,:,:)                 ! Update before fields
-
-            CALL eos( tsb, rhd, rhop, gdept_0(:,:,:) )  ! Before potential and in situ densities
+            pts(:,:,:,:,Kbb) = pts(:,:,:,:,Kmm)                 ! Update before fields
+
+            CALL eos( pts(:,:,:,:,Kbb), rhd, rhop, gdept_0(:,:,:) )  ! Before potential and in situ densities
 !!gm  fabien
-!            CALL eos( tsb, rhd, rhop )                ! Before potential and in situ densities
+!            CALL eos( pts(:,:,:,:,Kbb), rhd, rhop )                ! Before potential and in situ densities
 !!gm
 
-            IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav)      &
-               &  CALL zps_hde    ( kt, jpts, tsb, gtsu, gtsv,        &  ! Partial steps: before horizontal gradient
-               &                              rhd, gru , grv          )  ! of t, s, rd at the last ocean level
-            IF( ln_zps .AND. .NOT. lk_c1d .AND.       ln_isfcav)      &
-               &  CALL zps_hde_isf( nit000, jpts, tsb, gtsu, gtsv, gtui, gtvi,    &    ! Partial steps for top cell (ISF)
-               &                                  rhd, gru , grv , grui, grvi     )    ! of t, s, rd at the last ocean level
+            IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav)           &
+               &  CALL zps_hde    ( kt, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv,        &  ! Partial steps: before horizontal gradient
+               &                              rhd, gru , grv               )  ! of t, s, rd at the last ocean level
+            IF( ln_zps .AND. .NOT. lk_c1d .AND.       ln_isfcav)                       &
+               &  CALL zps_hde_isf( nit000, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv, gtui, gtvi,    &  ! Partial steps for top cell (ISF)
+               &                                  rhd, gru , grv , grui, grvi          )  ! of t, s, rd at the last ocean level
 
             DEALLOCATE( t_bkginc )
@@ -627,5 +625,5 @@
 
 
-   SUBROUTINE dyn_asm_inc( kt )
+   SUBROUTINE dyn_asm_inc( kt, Kbb, Kmm, puu, pvv, Krhs )
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE dyn_asm_inc  ***
@@ -637,5 +635,7 @@
       !! ** Action  : 
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(IN) :: kt   ! Current time step
+      INTEGER                             , INTENT( in )  ::  kt             ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kbb, Kmm, Krhs ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv       ! ocean velocities and RHS of momentum equation
       !
       INTEGER :: jk
@@ -651,5 +651,5 @@
             !
             it = kt - nit000 + 1
-            zincwgt = wgtiau(it) / rdt   ! IAU weight for the current time step
+            zincwgt = wgtiau(it) / rn_Dt   ! IAU weight for the current time step
             !
             IF(lwp) THEN
@@ -661,6 +661,6 @@
             ! Update the dynamic tendencies
             DO jk = 1, jpkm1
-               ua(:,:,jk) = ua(:,:,jk) + u_bkginc(:,:,jk) * zincwgt
-               va(:,:,jk) = va(:,:,jk) + v_bkginc(:,:,jk) * zincwgt
+               puu(:,:,jk,Krhs) = puu(:,:,jk,Krhs) + u_bkginc(:,:,jk) * zincwgt
+               pvv(:,:,jk,Krhs) = pvv(:,:,jk,Krhs) + v_bkginc(:,:,jk) * zincwgt
             END DO
             !
@@ -677,12 +677,12 @@
          IF ( kt == nitdin_r ) THEN
             !
-            neuler = 0                    ! Force Euler forward step
+            l_1st_euler = .TRUE.                    ! Force Euler forward step
             !
             ! Initialize the now fields with the background + increment
-            un(:,:,:) = u_bkg(:,:,:) + u_bkginc(:,:,:)
-            vn(:,:,:) = v_bkg(:,:,:) + v_bkginc(:,:,:)  
-            !
-            ub(:,:,:) = un(:,:,:)         ! Update before fields
-            vb(:,:,:) = vn(:,:,:)
+            puu(:,:,:,Kmm) = u_bkg(:,:,:) + u_bkginc(:,:,:)
+            pvv(:,:,:,Kmm) = v_bkg(:,:,:) + v_bkginc(:,:,:)  
+            !
+            puu(:,:,:,Kbb) = puu(:,:,:,Kmm)         ! Update before fields
+            pvv(:,:,:,Kbb) = pvv(:,:,:,Kmm)
             !
             DEALLOCATE( u_bkg    )
@@ -697,5 +697,5 @@
 
 
-   SUBROUTINE ssh_asm_inc( kt )
+   SUBROUTINE ssh_asm_inc( kt, Kbb, Kmm )
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE ssh_asm_inc  ***
@@ -707,5 +707,6 @@
       !! ** Action  : 
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(IN) :: kt   ! Current time step
+      INTEGER, INTENT(IN) :: kt         ! Current time step
+      INTEGER, INTENT(IN) :: Kbb, Kmm   ! Current time step
       !
       INTEGER :: it
@@ -721,5 +722,5 @@
             !
             it = kt - nit000 + 1
-            zincwgt = wgtiau(it) / rdt   ! IAU weight for the current time step
+            zincwgt = wgtiau(it) / rn_Dt   ! IAU weight for the current time step
             !
             IF(lwp) THEN
@@ -752,11 +753,11 @@
          IF ( kt == nitdin_r ) THEN
             !
-            neuler = 0                                   ! Force Euler forward step
-            !
-            sshn(:,:) = ssh_bkg(:,:) + ssh_bkginc(:,:)   ! Initialize the now fields the background + increment
-            !
-            sshb(:,:) = sshn(:,:)                        ! Update before fields
-            e3t_b(:,:,:) = e3t_n(:,:,:)
-!!gm why not e3u_b, e3v_b, gdept_b ????
+            l_1st_euler = .TRUE.                            ! Force Euler forward step
+            !
+            ssh(:,:,Kmm) = ssh_bkg(:,:) + ssh_bkginc(:,:)   ! Initialize the now fields the background + increment
+            !
+            ssh(:,:,Kbb) = ssh(:,:,Kmm)                        ! Update before fields
+            e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm)
+!!gm why not e3u(:,:,:,Kbb), e3v(:,:,:,Kbb), gdept(:,:,:,Kbb) ????
             !
             DEALLOCATE( ssh_bkg    )
@@ -770,5 +771,5 @@
 
 
-   SUBROUTINE ssh_asm_div( kt, phdivn )
+   SUBROUTINE ssh_asm_div( kt, Kbb, Kmm, phdivn )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE ssh_asm_div  ***
@@ -784,4 +785,5 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(IN) :: kt                               ! ocean time-step index
+      INTEGER, INTENT(IN) :: Kbb, Kmm                         ! time level indices
       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   phdivn   ! horizontal divergence
       !!
@@ -791,11 +793,11 @@
       ! 
 #if defined key_asminc
-      CALL ssh_asm_inc( kt ) !==   (calculate increments)
+      CALL ssh_asm_inc( kt, Kbb, Kmm ) !==   (calculate increments)
       !
       IF( ln_linssh ) THEN 
-         phdivn(:,:,1) = phdivn(:,:,1) - ssh_iau(:,:) / e3t_n(:,:,1) * tmask(:,:,1)
+         phdivn(:,:,1) = phdivn(:,:,1) - ssh_iau(:,:) / e3t(:,:,1,Kmm) * tmask(:,:,1)
       ELSE 
          ALLOCATE( ztim(jpi,jpj) )
-         ztim(:,:) = ssh_iau(:,:) / ( ht_n(:,:) + 1.0 - ssmask(:,:) )
+         ztim(:,:) = ssh_iau(:,:) / ( ht(:,:) + 1.0 - ssmask(:,:) )
          DO jk = 1, jpkm1                                 
             phdivn(:,:,jk) = phdivn(:,:,jk) - ztim(:,:) * tmask(:,:,jk) 
@@ -839,5 +841,5 @@
             it = kt - nit000 + 1
             zincwgt = wgtiau(it)      ! IAU weight for the current time step 
-            ! note this is not a tendency so should not be divided by rdt (as with the tracer and other increments)
+            ! note this is not a tendency so should not be divided by rn_Dt (as with the tracer and other increments)
             !
             IF(lwp) THEN
@@ -874,5 +876,5 @@
 #if defined key_cice && defined key_asminc
             ! Sea-ice : CICE case. Pass ice increment tendency into CICE
-            ndaice_da(:,:) = seaice_bkginc(:,:) * zincwgt / rdt
+            ndaice_da(:,:) = seaice_bkginc(:,:) * zincwgt / rn_Dt
 #endif
             !
@@ -894,5 +896,5 @@
          IF ( kt == nitdin_r ) THEN
             !
-            neuler = 0                    ! Force Euler forward step
+            l_1st_euler = .TRUE.              ! Force Euler forward step
             !
             ! Sea-ice : SI3 case
@@ -924,5 +926,5 @@
 #if defined key_cice && defined key_asminc
             ! Sea-ice : CICE case. Pass ice increment tendency into CICE
-           ndaice_da(:,:) = seaice_bkginc(:,:) / rdt
+           ndaice_da(:,:) = seaice_bkginc(:,:) / rn_Dt
 #endif
             IF ( .NOT. PRESENT(kindic) ) THEN
@@ -957,5 +959,5 @@
 !           ! fwf : ice formation and melting
 !
-!                 zfons = ( -nfresh_da(ji,jj)*soce + nfsalt_da(ji,jj) )*rdt
+!                 zfons = ( -nfresh_da(ji,jj)*soce + nfsalt_da(ji,jj) )*rn_Dt
 !
 !           ! change salinity down to mixed layer depth
@@ -998,5 +1000,5 @@
 !
 !      !            !  salt exchanges at the ice/ocean interface
-!      !            zpmess         = zfons / rdt_ice    ! rdt_ice is ice timestep
+!      !            zpmess         = zfons / rDt_ice    ! rDt_ice is ice timestep
 !      !
 !      !! Adjust fsalt. A +ve fsalt means adding salt to ocean
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/BDY/bdy_oce.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/BDY/bdy_oce.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/BDY/bdy_oce.F90	(revision 12928)
@@ -141,4 +141,6 @@
    LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lsend_bdyext   !: mark needed communication for given boundary, grid and neighbour
    LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lrecv_bdyext   !:  when searching towards the exterior of the computational domain
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/BDY/bdydta.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/BDY/bdydta.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/BDY/bdydta.F90	(revision 12928)
@@ -23,5 +23,5 @@
    USE phycst         ! physical constants
    USE sbcapr         ! atmospheric pressure forcing
-   USE sbctide        ! Tidal forcing or not
+   USE tide_mod, ONLY: ln_tide ! tidal forcing
    USE bdy_oce        ! ocean open boundary conditions  
    USE bdytides       ! tidal forcing at boundaries
@@ -68,4 +68,6 @@
 !$AGRIF_END_DO_NOT_TREAT
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -75,5 +77,5 @@
 CONTAINS
 
-   SUBROUTINE bdy_dta( kt, kit, kt_offset )
+   SUBROUTINE bdy_dta( kt, Kmm )
       !!----------------------------------------------------------------------
       !!                   ***  SUBROUTINE bdy_dta  ***
@@ -85,16 +87,8 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in)           ::   kt           ! ocean time-step index 
-      INTEGER, INTENT(in), OPTIONAL ::   kit          ! subcycle time-step index (for timesplitting option)
-      INTEGER, INTENT(in), OPTIONAL ::   kt_offset    ! time offset in units of timesteps. NB. if kit
-      !                                               ! is present then units = subcycle timesteps.
-      !                                               ! kt_offset = 0 => get data at "now" time level
-      !                                               ! kt_offset = -1 => get data at "before" time level
-      !                                               ! kt_offset = +1 => get data at "after" time level
-      !                                               ! etc.
+      INTEGER, INTENT(in)           ::   Kmm          ! ocean time level index
       !
       INTEGER ::  jbdy, jfld, jstart, jend, ib, jl    ! dummy loop indices
       INTEGER ::  ii, ij, ik, igrd, ipl               ! local integers
-      INTEGER,   DIMENSION(jpbgrd)     ::   ilen1 
-      INTEGER,   DIMENSION(:), POINTER ::   nblen, nblenrim  ! short cuts
       TYPE(OBC_DATA)         , POINTER ::   dta_alias        ! short cut
       TYPE(FLD), DIMENSION(:), POINTER ::   bf_alias
@@ -105,5 +99,5 @@
       ! Initialise data arrays once for all from initial conditions where required
       !---------------------------------------------------------------------------
-      IF( kt == nit000 .AND. .NOT.PRESENT(kit) ) THEN
+      IF( kt == nit000 ) THEN
 
          ! Calculate depth-mean currents
@@ -112,29 +106,27 @@
          DO jbdy = 1, nb_bdy
             !
-            nblen    => idx_bdy(jbdy)%nblen
-            nblenrim => idx_bdy(jbdy)%nblenrim
-            !
             IF( nn_dyn2d_dta(jbdy) == 0 ) THEN 
-               ilen1(:) = nblen(:)
                IF( dta_bdy(jbdy)%lneed_ssh ) THEN 
                   igrd = 1
-                  DO ib = 1, ilen1(igrd)
+                  DO ib = 1, idx_bdy(jbdy)%nblenrim(igrd)   ! ssh is allocated and used only on the rim
                      ii = idx_bdy(jbdy)%nbi(ib,igrd)
                      ij = idx_bdy(jbdy)%nbj(ib,igrd)
-                     dta_bdy(jbdy)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1)         
+                     dta_bdy(jbdy)%ssh(ib) = ssh(ii,ij,Kmm) * tmask(ii,ij,1)         
                   END DO
                ENDIF
-               IF( dta_bdy(jbdy)%lneed_dyn2d) THEN 
+               IF( ASSOCIATED(dta_bdy(jbdy)%u2d) ) THEN   ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain
                   igrd = 2
-                  DO ib = 1, ilen1(igrd)
+                  DO ib = 1, SIZE(dta_bdy(jbdy)%u2d)      ! u2d is used either over the whole bdy or only on the rim
                      ii = idx_bdy(jbdy)%nbi(ib,igrd)
                      ij = idx_bdy(jbdy)%nbj(ib,igrd)
-                     dta_bdy(jbdy)%u2d(ib) = un_b(ii,ij) * umask(ii,ij,1)         
+                     dta_bdy(jbdy)%u2d(ib) = uu_b(ii,ij,Kmm) * umask(ii,ij,1)         
                   END DO
+               ENDIF
+               IF( ASSOCIATED(dta_bdy(jbdy)%v2d) ) THEN   ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain
                   igrd = 3
-                  DO ib = 1, ilen1(igrd)
+                  DO ib = 1, SIZE(dta_bdy(jbdy)%v2d)      ! v2d is used either over the whole bdy or only on the rim
                      ii = idx_bdy(jbdy)%nbi(ib,igrd)
                      ij = idx_bdy(jbdy)%nbj(ib,igrd)
-                     dta_bdy(jbdy)%v2d(ib) = vn_b(ii,ij) * vmask(ii,ij,1)         
+                     dta_bdy(jbdy)%v2d(ib) = vv_b(ii,ij,Kmm) * vmask(ii,ij,1)         
                   END DO
                ENDIF
@@ -142,20 +134,19 @@
             !
             IF( nn_dyn3d_dta(jbdy) == 0 ) THEN 
-               ilen1(:) = nblen(:)
                IF( dta_bdy(jbdy)%lneed_dyn3d ) THEN 
                   igrd = 2 
-                  DO ib = 1, ilen1(igrd)
+                  DO ib = 1, idx_bdy(jbdy)%nblen(igrd)
                      DO ik = 1, jpkm1
                         ii = idx_bdy(jbdy)%nbi(ib,igrd)
                         ij = idx_bdy(jbdy)%nbj(ib,igrd)
-                        dta_bdy(jbdy)%u3d(ib,ik) =  ( un(ii,ij,ik) - un_b(ii,ij) ) * umask(ii,ij,ik)         
+                        dta_bdy(jbdy)%u3d(ib,ik) =  ( uu(ii,ij,ik,Kmm) - uu_b(ii,ij,Kmm) ) * umask(ii,ij,ik)         
                      END DO
                   END DO
                   igrd = 3 
-                  DO ib = 1, ilen1(igrd)
+                  DO ib = 1, idx_bdy(jbdy)%nblen(igrd)
                      DO ik = 1, jpkm1
                         ii = idx_bdy(jbdy)%nbi(ib,igrd)
                         ij = idx_bdy(jbdy)%nbj(ib,igrd)
-                        dta_bdy(jbdy)%v3d(ib,ik) =  ( vn(ii,ij,ik) - vn_b(ii,ij) ) * vmask(ii,ij,ik)         
+                        dta_bdy(jbdy)%v3d(ib,ik) =  ( vv(ii,ij,ik,Kmm) - vv_b(ii,ij,Kmm) ) * vmask(ii,ij,ik)         
                      END DO
                   END DO
@@ -164,13 +155,12 @@
 
             IF( nn_tra_dta(jbdy) == 0 ) THEN 
-               ilen1(:) = nblen(:)
                IF( dta_bdy(jbdy)%lneed_tra ) THEN
                   igrd = 1 
-                  DO ib = 1, ilen1(igrd)
+                  DO ib = 1, idx_bdy(jbdy)%nblen(igrd)
                      DO ik = 1, jpkm1
                         ii = idx_bdy(jbdy)%nbi(ib,igrd)
                         ij = idx_bdy(jbdy)%nbj(ib,igrd)
-                        dta_bdy(jbdy)%tem(ib,ik) = tsn(ii,ij,ik,jp_bdytem) * tmask(ii,ij,ik)         
-                        dta_bdy(jbdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_bdysal) * tmask(ii,ij,ik)         
+                        dta_bdy(jbdy)%tem(ib,ik) = ts(ii,ij,ik,jp_tem,Kmm) * tmask(ii,ij,ik)         
+                        dta_bdy(jbdy)%sal(ib,ik) = ts(ii,ij,ik,jp_sal,Kmm) * tmask(ii,ij,ik)         
                      END DO
                   END DO
@@ -180,9 +170,8 @@
 #if defined key_si3
             IF( nn_ice_dta(jbdy) == 0 ) THEN    ! set ice to initial values
-               ilen1(:) = nblen(:)
                IF( dta_bdy(jbdy)%lneed_ice ) THEN
                   igrd = 1   
                   DO jl = 1, jpl
-                     DO ib = 1, ilen1(igrd)
+                     DO ib = 1, idx_bdy(jbdy)%nblen(igrd)
                         ii = idx_bdy(jbdy)%nbi(ib,igrd)
                         ij = idx_bdy(jbdy)%nbj(ib,igrd)
@@ -216,31 +205,35 @@
          ! read/update all bdy data
          ! ------------------------
-         CALL fld_read( kt, 1, bf_alias, kit = kit, kt_offset = kt_offset )
-
+         ! BDY: use pt_offset=0.5 as applied at the end of the step and fldread is referenced at the middle of the step
+         CALL fld_read( kt, 1, bf_alias, pt_offset = 0.5_wp, Kmm = Kmm )
          ! apply some corrections in some specific cases...
          ! --------------------------------------------------
          !
          ! if runoff condition: change river flow we read (in m3/s) into barotropic velocity (m/s)
-         IF( cn_tra(jbdy) == 'runoff' .AND. TRIM(bf_alias(jp_bdyu2d)%clrootname) /= 'NOT USED' ) THEN   ! runoff and we read u/v2d
+         IF( cn_tra(jbdy) == 'runoff' ) THEN   ! runoff
             !
-            igrd = 2                      ! zonal flow (m3/s) to barotropic zonal velocity (m/s)
-            DO ib = 1, idx_bdy(jbdy)%nblen(igrd)
-               ii   = idx_bdy(jbdy)%nbi(ib,igrd)
-               ij   = idx_bdy(jbdy)%nbj(ib,igrd)
-               dta_alias%u2d(ib) = dta_alias%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) )
-            END DO
-            igrd = 3                      ! meridional flow (m3/s) to barotropic meridional velocity (m/s)
-            DO ib = 1, idx_bdy(jbdy)%nblen(igrd)
-               ii   = idx_bdy(jbdy)%nbi(ib,igrd)
-               ij   = idx_bdy(jbdy)%nbj(ib,igrd)
-               dta_alias%v2d(ib) = dta_alias%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) )
-            END DO
+            IF( ASSOCIATED(dta_bdy(jbdy)%u2d) ) THEN   ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain
+               igrd = 2                         ! zonal flow (m3/s) to barotropic zonal velocity (m/s)
+               DO ib = 1, SIZE(dta_alias%u2d)   ! u2d is used either over the whole bdy or only on the rim
+                  ii   = idx_bdy(jbdy)%nbi(ib,igrd)
+                  ij   = idx_bdy(jbdy)%nbj(ib,igrd)
+                  dta_alias%u2d(ib) = dta_alias%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) )
+               END DO
+            ENDIF
+            IF( ASSOCIATED(dta_bdy(jbdy)%v2d) ) THEN   ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain
+               igrd = 3                         ! meridional flow (m3/s) to barotropic meridional velocity (m/s)
+               DO ib = 1, SIZE(dta_alias%v2d)   ! v2d is used either over the whole bdy or only on the rim
+                  ii   = idx_bdy(jbdy)%nbi(ib,igrd)
+                  ij   = idx_bdy(jbdy)%nbj(ib,igrd)
+                  dta_alias%v2d(ib) = dta_alias%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) )
+               END DO
+            ENDIF
          ENDIF
 
          ! tidal harmonic forcing ONLY: initialise arrays
          IF( nn_dyn2d_dta(jbdy) == 2 ) THEN   ! we did not read ssh, u/v2d 
-            IF( dta_alias%lneed_ssh   ) dta_alias%ssh(:) = 0._wp
-            IF( dta_alias%lneed_dyn2d ) dta_alias%u2d(:) = 0._wp
-            IF( dta_alias%lneed_dyn2d ) dta_alias%v2d(:) = 0._wp
+            IF( ASSOCIATED(dta_alias%ssh) ) dta_alias%ssh(:) = 0._wp
+            IF( ASSOCIATED(dta_alias%u2d) ) dta_alias%u2d(:) = 0._wp
+            IF( ASSOCIATED(dta_alias%v2d) ) dta_alias%v2d(:) = 0._wp
          ENDIF
 
@@ -249,12 +242,12 @@
             !
             igrd = 2                       ! zonal velocity
-            dta_alias%u2d(:) = 0._wp       ! compute barotrope zonal velocity and put it in u2d
             DO ib = 1, idx_bdy(jbdy)%nblen(igrd)
                ii   = idx_bdy(jbdy)%nbi(ib,igrd)
                ij   = idx_bdy(jbdy)%nbj(ib,igrd)
+               dta_alias%u2d(ib) = 0._wp   ! compute barotrope zonal velocity and put it in u2d
                DO ik = 1, jpkm1
-                  dta_alias%u2d(ib) = dta_alias%u2d(ib) + e3u_n(ii,ij,ik) * umask(ii,ij,ik) * dta_alias%u3d(ib,ik)
+                  dta_alias%u2d(ib) = dta_alias%u2d(ib) + e3u(ii,ij,ik,Kmm) * umask(ii,ij,ik) * dta_alias%u3d(ib,ik)
                END DO
-               dta_alias%u2d(ib) =  dta_alias%u2d(ib) * r1_hu_n(ii,ij)
+               dta_alias%u2d(ib) =  dta_alias%u2d(ib) * r1_hu(ii,ij,Kmm)
                DO ik = 1, jpkm1            ! compute barocline zonal velocity and put it in u3d
                   dta_alias%u3d(ib,ik) = dta_alias%u3d(ib,ik) - dta_alias%u2d(ib)
@@ -262,12 +255,12 @@
             END DO
             igrd = 3                       ! meridional velocity
-            dta_alias%v2d(:) = 0._wp       ! compute barotrope meridional velocity and put it in v2d
             DO ib = 1, idx_bdy(jbdy)%nblen(igrd)
                ii   = idx_bdy(jbdy)%nbi(ib,igrd)
                ij   = idx_bdy(jbdy)%nbj(ib,igrd)
+               dta_alias%v2d(ib) = 0._wp   ! compute barotrope meridional velocity and put it in v2d
                DO ik = 1, jpkm1
-                  dta_alias%v2d(ib) = dta_alias%v2d(ib) + e3v_n(ii,ij,ik) * vmask(ii,ij,ik) * dta_alias%v3d(ib,ik)
+                  dta_alias%v2d(ib) = dta_alias%v2d(ib) + e3v(ii,ij,ik,Kmm) * vmask(ii,ij,ik) * dta_alias%v3d(ib,ik)
                END DO
-               dta_alias%v2d(ib) =  dta_alias%v2d(ib) * r1_hv_n(ii,ij)
+               dta_alias%v2d(ib) =  dta_alias%v2d(ib) * r1_hv(ii,ij,Kmm)
                DO ik = 1, jpkm1            ! compute barocline meridional velocity and put it in v3d
                   dta_alias%v3d(ib,ik) = dta_alias%v3d(ib,ik) - dta_alias%v2d(ib)
@@ -275,10 +268,4 @@
             END DO
          ENDIF   ! ltotvel
-
-         ! update tidal harmonic forcing
-         IF( PRESENT(kit) .AND. nn_dyn2d_dta(jbdy) .GE. 2 ) THEN
-            CALL bdytide_update( kt = kt, idx = idx_bdy(jbdy), dta = dta_alias, td = tides(jbdy),   & 
-               &                 kit = kit, kt_offset = kt_offset )
-         ENDIF
 
          !  atm surface pressure : add inverted barometer effect to ssh if it was read
@@ -293,5 +280,5 @@
 
 #if defined key_si3
-         IF( dta_alias%lneed_ice ) THEN
+         IF( dta_alias%lneed_ice .AND. idx_bdy(jbdy)%nblen(1) > 0 ) THEN
             ! fill temperature and salinity arrays
             IF( TRIM(bf_alias(jp_bdyt_i)%clrootname) == 'NOT USED' )   bf_alias(jp_bdyt_i)%fnow(:,1,:) = rice_tem (jbdy)
@@ -302,13 +289,20 @@
                &                                                                         bf_alias(jp_bdya_i)%fnow(:,1,:)     !   ( a_ip = rice_apnd * a_i )
             IF( TRIM(bf_alias(jp_bdyhip)%clrootname) == 'NOT USED' )   bf_alias(jp_bdyhip)%fnow(:,1,:) = rice_hpnd(jbdy)
+            
+            ! if T_i is read and not T_su, set T_su = T_i
+            IF( TRIM(bf_alias(jp_bdyt_i)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdytsu)%clrootname) == 'NOT USED' ) &
+               &   bf_alias(jp_bdytsu)%fnow(:,1,:) = bf_alias(jp_bdyt_i)%fnow(:,1,:)
+            ! if T_s is read and not T_su, set T_su = T_s
+            IF( TRIM(bf_alias(jp_bdyt_s)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdytsu)%clrootname) == 'NOT USED' ) &
+               &   bf_alias(jp_bdytsu)%fnow(:,1,:) = bf_alias(jp_bdyt_s)%fnow(:,1,:)
+            ! if T_i is read and not T_s, set T_s = T_i
+            IF( TRIM(bf_alias(jp_bdyt_i)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdyt_s)%clrootname) == 'NOT USED' ) &
+               &   bf_alias(jp_bdyt_s)%fnow(:,1,:) = bf_alias(jp_bdyt_i)%fnow(:,1,:)
+            ! if T_su is read and not T_s, set T_s = T_su
+            IF( TRIM(bf_alias(jp_bdytsu)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdyt_s)%clrootname) == 'NOT USED' ) &
+               &   bf_alias(jp_bdyt_s)%fnow(:,1,:) = bf_alias(jp_bdytsu)%fnow(:,1,:)
             ! if T_su is read and not T_i, set T_i = (T_su + T_freeze)/2
             IF( TRIM(bf_alias(jp_bdytsu)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdyt_i)%clrootname) == 'NOT USED' ) &
                &   bf_alias(jp_bdyt_i)%fnow(:,1,:) = 0.5_wp * ( bf_alias(jp_bdytsu)%fnow(:,1,:) + 271.15 )
-            ! if T_su is read and not T_s, set T_s = T_su
-            IF( TRIM(bf_alias(jp_bdytsu)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdyt_s)%clrootname) == 'NOT USED' ) &
-               &   bf_alias(jp_bdyt_s)%fnow(:,1,:) = bf_alias(jp_bdytsu)%fnow(:,1,:)
-            ! if T_s is read and not T_su, set T_su = T_s
-            IF( TRIM(bf_alias(jp_bdyt_s)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdytsu)%clrootname) == 'NOT USED' ) &
-               &   bf_alias(jp_bdytsu)%fnow(:,1,:) = bf_alias(jp_bdyt_s)%fnow(:,1,:)
             ! if T_s is read and not T_i, set T_i = (T_s + T_freeze)/2
             IF( TRIM(bf_alias(jp_bdyt_s)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdyt_i)%clrootname) == 'NOT USED' ) &
@@ -341,22 +335,19 @@
             DO jbdy = 1, nb_bdy      ! Tidal component added in ts loop
                IF ( nn_dyn2d_dta(jbdy) .GE. 2 ) THEN
-                  nblen => idx_bdy(jbdy)%nblen
-                  nblenrim => idx_bdy(jbdy)%nblenrim
-                  IF( cn_dyn2d(jbdy) == 'frs' ) THEN ; ilen1(:)=nblen(:) ; ELSE ; ilen1(:)=nblenrim(:) ; ENDIF 
-                     IF ( dta_bdy(jbdy)%lneed_ssh   ) dta_bdy_s(jbdy)%ssh(1:ilen1(1)) = dta_bdy(jbdy)%ssh(1:ilen1(1))
-                     IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%u2d(1:ilen1(2)) = dta_bdy(jbdy)%u2d(1:ilen1(2))
-                     IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%v2d(1:ilen1(3)) = dta_bdy(jbdy)%v2d(1:ilen1(3))
-                  ENDIF
-               END DO
-            ELSE ! Add tides if not split-explicit free surface else this is done in ts loop
-               !
-               CALL bdy_dta_tides( kt=kt, kt_offset=kt_offset )
-            ENDIF
+                  IF( ASSOCIATED(dta_bdy(jbdy)%ssh) ) dta_bdy_s(jbdy)%ssh(:) = dta_bdy(jbdy)%ssh(:)
+                  IF( ASSOCIATED(dta_bdy(jbdy)%u2d) ) dta_bdy_s(jbdy)%u2d(:) = dta_bdy(jbdy)%u2d(:)
+                  IF( ASSOCIATED(dta_bdy(jbdy)%v2d) ) dta_bdy_s(jbdy)%v2d(:) = dta_bdy(jbdy)%v2d(:)
+               ENDIF
+            END DO
+         ELSE ! Add tides if not split-explicit free surface else this is done in ts loop
+            !
+            CALL bdy_dta_tides( kt=kt, pt_offset = 1._wp )
          ENDIF
-         !
-         IF( ln_timing )   CALL timing_stop('bdy_dta')
-         !
-      END SUBROUTINE bdy_dta
-
+      ENDIF
+      !
+      IF( ln_timing )   CALL timing_stop('bdy_dta')
+      !
+   END SUBROUTINE bdy_dta
+   
 
    SUBROUTINE bdy_dta_init
@@ -373,4 +364,6 @@
       INTEGER ::   ierror, ios     ! 
       !
+      INTEGER ::   nbdy_rdstart, nbdy_loc
+      CHARACTER(LEN=50)                      ::   cerrmsg       ! error string
       CHARACTER(len=3)                       ::   cl3           ! 
       CHARACTER(len=100)                     ::   cn_dir        ! Root directory for location of data files
@@ -388,4 +381,5 @@
       LOGICAL                                ::   llneed        !
       LOGICAL                                ::   llread        !
+      LOGICAL                                ::   llfullbdy     !
       TYPE(FLD_N), DIMENSION(1), TARGET  ::   bn_tem, bn_sal, bn_u3d, bn_v3d   ! must be an array to be used with fld_fill
       TYPE(FLD_N), DIMENSION(1), TARGET  ::   bn_ssh, bn_u2d, bn_v2d           ! informations about the fields to be read
@@ -415,5 +409,5 @@
       ! Read namelists
       ! --------------
-      REWIND(numnam_cfg)
+      nbdy_rdstart = 1
       DO jbdy = 1, nb_bdy
 
@@ -421,6 +415,5 @@
          WRITE(ctmp2, '(a,i2)') 'block nambdy_dta number ', jbdy
 
-         ! There is only one nambdy_dta block in namelist_ref -> use it for each bdy so we do a rewind 
-         REWIND(numnam_ref)
+         ! There is only one nambdy_dta block in namelist_ref -> use it for each bdy so we read from the beginning
          READ  ( numnam_ref, nambdy_dta, IOSTAT = ios, ERR = 901)
 901      IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_dta in reference namelist' )
@@ -431,6 +424,19 @@
             & .OR. ( dta_bdy(jbdy)%lneed_tra   .AND.       nn_tra_dta(jbdy)    == 1 )   &
             & .OR. ( dta_bdy(jbdy)%lneed_ice   .AND.       nn_ice_dta(jbdy)    == 1 )   )   THEN
-            ! WARNING: we don't do a rewind here, each bdy reads its own nambdy_dta block one after another
-            READ  ( numnam_cfg, nambdy_dta, IOSTAT = ios, ERR = 902 )
+            !
+            ! Need to support possibility of reading more than one
+            ! nambdy_dta from the namelist_cfg internal file.
+            ! Do this by finding the jbdy'th occurence of nambdy_dta in the
+            ! character buffer as the starting point.
+            !
+            nbdy_loc = INDEX( numnam_cfg( nbdy_rdstart: ), 'nambdy_dta' )
+            IF( nbdy_loc .GT. 0 ) THEN
+               nbdy_rdstart = nbdy_rdstart + nbdy_loc
+            ELSE
+               WRITE(cerrmsg,'(A,I4,A)') 'Error: entry number ',jbdy,' of nambdy_dta not found'
+               ios = -1
+               CALL ctl_nam ( ios , cerrmsg )
+            ENDIF
+            READ  ( numnam_cfg( MAX( 1, nbdy_rdstart - 2 ): ), nambdy_dta, IOSTAT = ios, ERR = 902)
 902         IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist' )
             IF(lwm) WRITE( numond, nambdy_dta )           
@@ -442,9 +448,12 @@
             IF( nn_ice_dta(jbdy) == 1 ) THEN   ! if we get ice bdy data from netcdf file
                CALL fld_fill(  bf(jp_bdya_i,jbdy:jbdy), bn_a_i, cn_dir, 'bdy_dta', 'a_i'//' '//ctmp1, ctmp2 )   ! use namelist info
-               CALL fld_clopn( bf(jp_bdya_i,jbdy), nyear, nmonth, nday )   ! not a problem when we call it again after
+               CALL fld_def( bf(jp_bdya_i,jbdy) )
+               CALL iom_open( bf(jp_bdya_i,jbdy)%clname, bf(jp_bdya_i,jbdy)%num )
                idvar = iom_varid( bf(jp_bdya_i,jbdy)%num, bf(jp_bdya_i,jbdy)%clvar, kndims=indims, kdimsz=i4dimsz, lduld=lluld )
                IF( indims == 4 .OR. ( indims == 3 .AND. .NOT. lluld ) ) THEN   ;   ipl = i4dimsz(3)   ! xylt or xyl
                ELSE                                                            ;   ipl = 1            ! xy or xyt
                ENDIF
+               CALL iom_close( bf(jp_bdya_i,jbdy)%num )
+               bf(jp_bdya_i,jbdy)%clrootname = 'NOT USED'   ! reset to default value as this subdomain may not need to read this bdy
             ENDIF
          ENDIF
@@ -487,10 +496,11 @@
                igrd = 2                                                    ! U point
                ipk = 1                                                     ! surface data
-               llneed = dta_bdy(jbdy)%lneed_dyn2d                          ! dta_bdy(jbdy)%ssh will be needed
+               llneed = dta_bdy(jbdy)%lneed_dyn2d                          ! dta_bdy(jbdy)%u2d will be needed
                llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1   ! don't get u2d from u3d and read NetCDF file
                bf_alias => bf(jp_bdyu2d,jbdy:jbdy)                         ! alias for u2d structure of bdy number jbdy
                bn_alias => bn_u2d                                          ! alias for u2d structure of nambdy_dta
-               IF( ln_full_vel ) THEN  ;   iszdim = idx_bdy(jbdy)%nblen(igrd)      ! will be computed from u3d -> need on the full bdy
-               ELSE                    ;   iszdim = idx_bdy(jbdy)%nblenrim(igrd)   ! used only on the rim
+               llfullbdy = ln_full_vel .OR. cn_dyn2d(jbdy) == 'frs'        ! need u2d over the whole bdy or only over the rim?
+               IF( llfullbdy ) THEN  ;   iszdim = idx_bdy(jbdy)%nblen(igrd)
+               ELSE                  ;   iszdim = idx_bdy(jbdy)%nblenrim(igrd)
                ENDIF
             ENDIF
@@ -499,10 +509,11 @@
                igrd = 3                                                    ! V point
                ipk = 1                                                     ! surface data
-               llneed = dta_bdy(jbdy)%lneed_dyn2d                          ! dta_bdy(jbdy)%ssh will be needed
+               llneed = dta_bdy(jbdy)%lneed_dyn2d                          ! dta_bdy(jbdy)%v2d will be needed
                llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1   ! don't get v2d from v3d and read NetCDF file
                bf_alias => bf(jp_bdyv2d,jbdy:jbdy)                         ! alias for v2d structure of bdy number jbdy
                bn_alias => bn_v2d                                          ! alias for v2d structure of nambdy_dta 
-               IF( ln_full_vel ) THEN  ;   iszdim = idx_bdy(jbdy)%nblen(igrd)      ! will be computed from v3d -> need on the full bdy
-               ELSE                    ;   iszdim = idx_bdy(jbdy)%nblenrim(igrd)   ! used only on the rim
+               llfullbdy = ln_full_vel .OR. cn_dyn2d(jbdy) == 'frs'        ! need v2d over the whole bdy or only over the rim?
+               IF( llfullbdy ) THEN  ;   iszdim = idx_bdy(jbdy)%nblen(igrd)
+               ELSE                  ;   iszdim = idx_bdy(jbdy)%nblenrim(igrd)
                ENDIF
             ENDIF
@@ -615,5 +626,5 @@
             ENDIF
 
-            IF( llneed ) THEN                                              ! dta_bdy(jbdy)%xxx will be needed
+            IF( llneed .AND. iszdim > 0 ) THEN                             ! dta_bdy(jbdy)%xxx will be needed
                !                                                           !   -> must be associated with an allocated target
                ALLOCATE( bf_alias(1)%fnow( iszdim, 1, ipk ) )              ! allocate the target
@@ -624,4 +635,5 @@
                   bf_alias(1)%imap    => idx_bdy(jbdy)%nbmap(1:iszdim,igrd)   ! associate the mapping used for this bdy
                   bf_alias(1)%igrd    = igrd                                  ! used only for vertical integration of 3D arrays
+                  bf_alias(1)%ibdy    = jbdy                                  !  "    "    "     "          "      "  "    "    
                   bf_alias(1)%ltotvel = ln_full_vel                           ! T if u3d is full velocity
                   bf_alias(1)%lzint   = ln_zinterp                            ! T if it requires a vertical interpolation
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/BDY/bdydyn.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/BDY/bdydyn.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/BDY/bdydyn.F90	(revision 12928)
@@ -37,5 +37,5 @@
 CONTAINS
 
-   SUBROUTINE bdy_dyn( kt, dyn3d_only )
+   SUBROUTINE bdy_dyn( kt, Kbb, puu, pvv, Kaa, dyn3d_only )
       !!----------------------------------------------------------------------
       !!                  ***  SUBROUTINE bdy_dyn  ***
@@ -44,10 +44,12 @@
       !!
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in)           ::   kt           ! Main time step counter
-      LOGICAL, INTENT(in), OPTIONAL ::   dyn3d_only   ! T => only update baroclinic velocities
+      INTEGER                             , INTENT(in)    ::   kt           ! Main time step counter
+      INTEGER                             , INTENT(in)    ::   Kbb, Kaa     ! Ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::   puu, pvv     ! Ocean velocities (to be updated at open boundaries)
+      LOGICAL, OPTIONAL                   , INTENT(in)    ::   dyn3d_only   ! T => only update baroclinic velocities
       !
       INTEGER ::   jk, ii, ij, ib_bdy, ib, igrd     ! Loop counter
       LOGICAL ::   ll_dyn2d, ll_dyn3d, ll_orlanski
-      REAL(wp), DIMENSION(jpi,jpj) :: pua2d, pva2d     ! after barotropic velocities
+      REAL(wp), DIMENSION(jpi,jpj) :: zua2d, zva2d     ! after barotropic velocities
       !!----------------------------------------------------------------------
       !
@@ -70,16 +72,16 @@
 
       !                          ! "After" velocities: 
-      pua2d(:,:) = 0._wp
-      pva2d(:,:) = 0._wp     
+      zua2d(:,:) = 0._wp
+      zva2d(:,:) = 0._wp     
       DO jk = 1, jpkm1
-         pua2d(:,:) = pua2d(:,:) + e3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk)
-         pva2d(:,:) = pva2d(:,:) + e3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk)
+         zua2d(:,:) = zua2d(:,:) + e3u(:,:,jk,Kaa) * puu(:,:,jk,Kaa) * umask(:,:,jk)
+         zva2d(:,:) = zva2d(:,:) + e3v(:,:,jk,Kaa) * pvv(:,:,jk,Kaa) * vmask(:,:,jk)
       END DO
-      pua2d(:,:) = pua2d(:,:) * r1_hu_a(:,:)
-      pva2d(:,:) = pva2d(:,:) * r1_hv_a(:,:)
+      zua2d(:,:) = zua2d(:,:) * r1_hu(:,:,Kaa)
+      zva2d(:,:) = zva2d(:,:) * r1_hv(:,:,Kaa)
 
       DO jk = 1 , jpkm1
-         ua(:,:,jk) = ( ua(:,:,jk) - pua2d(:,:) ) * umask(:,:,jk)
-         va(:,:,jk) = ( va(:,:,jk) - pva2d(:,:) ) * vmask(:,:,jk)
+         puu(:,:,jk,Kaa) = ( puu(:,:,jk,Kaa) - zua2d(:,:) ) * umask(:,:,jk)
+         pvv(:,:,jk,Kaa) = ( pvv(:,:,jk,Kaa) - zva2d(:,:) ) * vmask(:,:,jk)
       END DO
 
@@ -87,6 +89,6 @@
       IF( ll_orlanski ) THEN     ! "Before" velocities (Orlanski condition only) 
          DO jk = 1 , jpkm1
-            ub(:,:,jk) = ( ub(:,:,jk) - ub_b(:,:) ) * umask(:,:,jk)
-            vb(:,:,jk) = ( vb(:,:,jk) - vb_b(:,:) ) * vmask(:,:,jk)
+            puu(:,:,jk,Kbb) = ( puu(:,:,jk,Kbb) - uu_b(:,:,Kbb) ) * umask(:,:,jk)
+            pvv(:,:,jk,Kbb) = ( pvv(:,:,jk,Kbb) - vv_b(:,:,Kbb) ) * vmask(:,:,jk)
          END DO
       ENDIF
@@ -97,7 +99,7 @@
       !-------------------------------------------------------
 
-      IF( ll_dyn2d )   CALL bdy_dyn2d( kt, pua2d, pva2d, ub_b, vb_b, r1_hu_a(:,:), r1_hv_a(:,:), ssha )
+      IF( ll_dyn2d )   CALL bdy_dyn2d( kt, zua2d, zva2d, uu_b(:,:,Kbb), vv_b(:,:,Kbb), r1_hu(:,:,Kaa), r1_hv(:,:,Kaa), ssh(:,:,Kaa) )
 
-      IF( ll_dyn3d )   CALL bdy_dyn3d( kt )
+      IF( ll_dyn3d )   CALL bdy_dyn3d( kt, Kbb, puu, pvv, Kaa )
 
       !-------------------------------------------------------
@@ -106,12 +108,12 @@
       !
       DO jk = 1 , jpkm1
-         ua(:,:,jk) = ( ua(:,:,jk) + pua2d(:,:) ) * umask(:,:,jk)
-         va(:,:,jk) = ( va(:,:,jk) + pva2d(:,:) ) * vmask(:,:,jk)
+         puu(:,:,jk,Kaa) = ( puu(:,:,jk,Kaa) + zua2d(:,:) ) * umask(:,:,jk)
+         pvv(:,:,jk,Kaa) = ( pvv(:,:,jk,Kaa) + zva2d(:,:) ) * vmask(:,:,jk)
       END DO
       !
       IF ( ll_orlanski ) THEN
          DO jk = 1 , jpkm1
-            ub(:,:,jk) = ( ub(:,:,jk) + ub_b(:,:) ) * umask(:,:,jk)
-            vb(:,:,jk) = ( vb(:,:,jk) + vb_b(:,:) ) * vmask(:,:,jk)
+            puu(:,:,jk,Kbb) = ( puu(:,:,jk,Kbb) + uu_b(:,:,Kbb) ) * umask(:,:,jk)
+            pvv(:,:,jk,Kbb) = ( pvv(:,:,jk,Kbb) + vv_b(:,:,Kbb) ) * vmask(:,:,jk)
          END DO
       END IF
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/BDY/bdydyn3d.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/BDY/bdydyn3d.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/BDY/bdydyn3d.F90	(revision 12928)
@@ -33,5 +33,5 @@
 CONTAINS
 
-   SUBROUTINE bdy_dyn3d( kt )
+   SUBROUTINE bdy_dyn3d( kt, Kbb, puu, pvv, Kaa )
       !!----------------------------------------------------------------------
       !!                  ***  SUBROUTINE bdy_dyn3d  ***
@@ -40,5 +40,7 @@
       !!
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! Main time step counter
+      INTEGER                             , INTENT( in    ) ::   kt        ! Main time step counter
+      INTEGER                             , INTENT( in    ) ::   Kbb, Kaa  ! Time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries)
       !
       INTEGER  ::   ib_bdy, ir     ! BDY set index, rim index
@@ -58,13 +60,13 @@
             CASE('none')        ;   CYCLE
             CASE('frs' )        ! treat the whole boundary at once
-               IF( ir == 0) CALL bdy_dyn3d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )
+                       IF( ir == 0) CALL bdy_dyn3d_frs( puu, pvv, Kaa, idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )
             CASE('specified')   ! treat the whole rim      at once
-               IF( ir == 0) CALL bdy_dyn3d_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )
+                       IF( ir == 0) CALL bdy_dyn3d_spe( puu, pvv, Kaa, idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )
             CASE('zero')        ! treat the whole rim      at once
-               IF( ir == 0) CALL bdy_dyn3d_zro( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )
-            CASE('orlanski' )   ;   CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, llrim0, ll_npo=.false. )
-            CASE('orlanski_npo');   CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, llrim0, ll_npo=.true.  )
-            CASE('zerograd')    ;   CALL bdy_dyn3d_zgrad( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy, llrim0 )
-            CASE('neumann')     ;   CALL bdy_dyn3d_nmn( idx_bdy(ib_bdy), ib_bdy, llrim0 )
+                       IF( ir == 0) CALL bdy_dyn3d_zro( puu, pvv, Kaa, idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )
+            CASE('orlanski' )   ;   CALL bdy_dyn3d_orlanski( Kbb, puu, pvv, Kaa, idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, llrim0, ll_npo=.false. )
+            CASE('orlanski_npo');   CALL bdy_dyn3d_orlanski( Kbb, puu, pvv, Kaa, idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, llrim0, ll_npo=.true.  )
+            CASE('zerograd')    ;   CALL bdy_dyn3d_zgrad( puu, pvv, Kaa, idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy, llrim0 )
+            CASE('neumann')     ;   CALL bdy_dyn3d_nmn( puu, pvv, Kaa, idx_bdy(ib_bdy), ib_bdy, llrim0 )
             CASE DEFAULT        ;   CALL ctl_stop( 'bdy_dyn3d : unrecognised option for open boundaries for baroclinic velocities' )
             END SELECT
@@ -97,8 +99,8 @@
          !
          IF( ANY(llsend2) .OR. ANY(llrecv2) ) THEN   ! if need to send/recv in at least one direction
-            CALL lbc_lnk( 'bdydyn2d', ua, 'U', -1., kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 )
+            CALL lbc_lnk( 'bdydyn2d', puu(:,:,:,Kaa), 'U', -1., kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 )
          END IF
          IF( ANY(llsend3) .OR. ANY(llrecv3) ) THEN   ! if need to send/recv in at least one direction
-            CALL lbc_lnk( 'bdydyn2d', va, 'V', -1., kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 )
+            CALL lbc_lnk( 'bdydyn2d', pvv(:,:,:,Kaa), 'V', -1., kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 )
          END IF
       END DO   ! ir
@@ -107,5 +109,5 @@
 
 
-   SUBROUTINE bdy_dyn3d_spe( idx, dta, kt , ib_bdy )
+   SUBROUTINE bdy_dyn3d_spe( puu, pvv, Kaa, idx, dta, kt, ib_bdy )
       !!----------------------------------------------------------------------
       !!                  ***  SUBROUTINE bdy_dyn3d_spe  ***
@@ -115,8 +117,10 @@
       !!
       !!----------------------------------------------------------------------
-      INTEGER        , INTENT(in) ::   kt      ! time step index
-      TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices
-      TYPE(OBC_DATA) , INTENT(in) ::   dta     ! OBC external data
-      INTEGER        , INTENT(in) ::   ib_bdy  ! BDY set index
+      INTEGER                             , INTENT( in    ) ::   Kaa       ! Time level index
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries)
+      TYPE(OBC_INDEX)                     , INTENT( in    ) ::   idx       ! OBC indices
+      TYPE(OBC_DATA)                      , INTENT( in    ) ::   dta       ! OBC external data
+      INTEGER                             , INTENT( in    ) ::   kt        ! Time step
+      INTEGER                             , INTENT( in    ) ::   ib_bdy    ! BDY set index
       !
       INTEGER  ::   jb, jk         ! dummy loop indices
@@ -129,5 +133,5 @@
             ii   = idx%nbi(jb,igrd)
             ij   = idx%nbj(jb,igrd)
-            ua(ii,ij,jk) = dta%u3d(jb,jk) * umask(ii,ij,jk)
+            puu(ii,ij,jk,Kaa) = dta%u3d(jb,jk) * umask(ii,ij,jk)
          END DO
       END DO
@@ -138,5 +142,5 @@
             ii   = idx%nbi(jb,igrd)
             ij   = idx%nbj(jb,igrd)
-            va(ii,ij,jk) = dta%v3d(jb,jk) * vmask(ii,ij,jk)
+            pvv(ii,ij,jk,Kaa) = dta%v3d(jb,jk) * vmask(ii,ij,jk)
          END DO
       END DO
@@ -145,5 +149,5 @@
 
 
-   SUBROUTINE bdy_dyn3d_zgrad( idx, dta, kt, ib_bdy, llrim0 )
+   SUBROUTINE bdy_dyn3d_zgrad( puu, pvv, Kaa, idx, dta, kt, ib_bdy, llrim0 )
       !!----------------------------------------------------------------------
       !!                  ***  SUBROUTINE bdy_dyn3d_zgrad  ***
@@ -152,9 +156,11 @@
       !!
       !!----------------------------------------------------------------------
-      INTEGER                     ::   kt
-      TYPE(OBC_INDEX), INTENT(in) ::   idx      ! OBC indices
-      TYPE(OBC_DATA),  INTENT(in) ::   dta      ! OBC external data
-      INTEGER,         INTENT(in) ::   ib_bdy   ! BDY set index
-      LOGICAL,         INTENT(in) ::   llrim0   ! indicate if rim 0 is treated
+      INTEGER                             , INTENT( in    ) ::   Kaa       ! Time level index
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries)
+      TYPE(OBC_INDEX)                     , INTENT( in    ) ::   idx       ! OBC indices
+      TYPE(OBC_DATA)                      , INTENT( in    ) ::   dta       ! OBC external data
+      INTEGER                             , INTENT( in    ) ::   kt
+      INTEGER                             , INTENT( in    ) ::   ib_bdy    ! BDY set index
+      LOGICAL                             , INTENT( in    ) ::   llrim0   ! indicate if rim 0 is treated
       !!
       INTEGER  ::   jb, jk         ! dummy loop indices
@@ -178,5 +184,5 @@
             !
             DO jk = 1, jpkm1
-               ua(ii,ij,jk) = ua(ii,ij+flagv,jk) * umask(ii,ij+flagv,jk)
+               puu(ii,ij,jk,Kaa) = puu(ii,ij+flagv,jk,Kaa) * umask(ii,ij+flagv,jk)
             END DO
             !
@@ -198,5 +204,5 @@
             !
             DO jk = 1, jpkm1
-               va(ii,ij,jk) = va(ii+flagu,ij,jk) * vmask(ii+flagu,ij,jk)
+               pvv(ii,ij,jk,Kaa) = pvv(ii+flagu,ij,jk,Kaa) * vmask(ii+flagu,ij,jk)
             END DO
             !
@@ -207,5 +213,5 @@
 
 
-   SUBROUTINE bdy_dyn3d_zro( idx, dta, kt, ib_bdy )
+   SUBROUTINE bdy_dyn3d_zro( puu, pvv, Kaa, idx, dta, kt, ib_bdy )
       !!----------------------------------------------------------------------
       !!                  ***  SUBROUTINE bdy_dyn3d_zro  ***
@@ -214,8 +220,10 @@
       !!
       !!----------------------------------------------------------------------
-      INTEGER        , INTENT(in) ::   kt      ! time step index
-      TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices
-      TYPE(OBC_DATA) , INTENT(in) ::   dta     ! OBC external data
-      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index
+      INTEGER                             , INTENT( in    ) ::   kt        ! time step index
+      INTEGER                             , INTENT( in    ) ::   Kaa       ! Time level index
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries)
+      TYPE(OBC_INDEX)                     , INTENT( in    ) ::   idx       ! OBC indices
+      TYPE(OBC_DATA)                      , INTENT( in    ) ::   dta       ! OBC external data
+      INTEGER                             , INTENT( in    ) ::   ib_bdy    ! BDY set index
       !
       INTEGER  ::   ib, ik         ! dummy loop indices
@@ -228,5 +236,5 @@
          ij = idx%nbj(ib,igrd)
          DO ik = 1, jpkm1
-            ua(ii,ij,ik) = 0._wp
+            puu(ii,ij,ik,Kaa) = 0._wp
          END DO
       END DO
@@ -237,5 +245,5 @@
          ij = idx%nbj(ib,igrd)
          DO ik = 1, jpkm1
-            va(ii,ij,ik) = 0._wp
+            pvv(ii,ij,ik,Kaa) = 0._wp
          END DO
       END DO
@@ -244,5 +252,5 @@
 
 
-   SUBROUTINE bdy_dyn3d_frs( idx, dta, kt, ib_bdy )
+   SUBROUTINE bdy_dyn3d_frs( puu, pvv, Kaa, idx, dta, kt, ib_bdy )
       !!----------------------------------------------------------------------
       !!                  ***  SUBROUTINE bdy_dyn3d_frs  ***
@@ -255,8 +263,10 @@
       !!               topography. Tellus, 365-382.
       !!----------------------------------------------------------------------
-      INTEGER        , INTENT(in) ::   kt      ! time step index
-      TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices
-      TYPE(OBC_DATA) , INTENT(in) ::   dta     ! OBC external data
-      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index
+      INTEGER                             , INTENT( in    ) ::   kt        ! time step index
+      INTEGER                             , INTENT( in    ) ::   Kaa       ! Time level index
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries)
+      TYPE(OBC_INDEX)                     , INTENT( in    ) ::   idx       ! OBC indices
+      TYPE(OBC_DATA)                      , INTENT( in    ) ::   dta       ! OBC external data
+      INTEGER                             , INTENT( in    ) ::   ib_bdy    ! BDY set index
       !
       INTEGER  ::   jb, jk         ! dummy loop indices
@@ -271,5 +281,5 @@
             ij   = idx%nbj(jb,igrd)
             zwgt = idx%nbw(jb,igrd)
-            ua(ii,ij,jk) = ( ua(ii,ij,jk) + zwgt * ( dta%u3d(jb,jk) - ua(ii,ij,jk) ) ) * umask(ii,ij,jk)
+            puu(ii,ij,jk,Kaa) = ( puu(ii,ij,jk,Kaa) + zwgt * ( dta%u3d(jb,jk) - puu(ii,ij,jk,Kaa) ) ) * umask(ii,ij,jk)
          END DO
       END DO
@@ -281,5 +291,5 @@
             ij   = idx%nbj(jb,igrd)
             zwgt = idx%nbw(jb,igrd)
-            va(ii,ij,jk) = ( va(ii,ij,jk) + zwgt * ( dta%v3d(jb,jk) - va(ii,ij,jk) ) ) * vmask(ii,ij,jk)
+            pvv(ii,ij,jk,Kaa) = ( pvv(ii,ij,jk,Kaa) + zwgt * ( dta%v3d(jb,jk) - pvv(ii,ij,jk,Kaa) ) ) * vmask(ii,ij,jk)
          END DO
       END DO   
@@ -288,5 +298,5 @@
 
 
-   SUBROUTINE bdy_dyn3d_orlanski( idx, dta, ib_bdy, llrim0, ll_npo )
+   SUBROUTINE bdy_dyn3d_orlanski( Kbb, puu, pvv, Kaa, idx, dta, ib_bdy, llrim0, ll_npo )
       !!----------------------------------------------------------------------
       !!                 ***  SUBROUTINE bdy_dyn3d_orlanski  ***
@@ -298,27 +308,29 @@
       !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)    
       !!----------------------------------------------------------------------
-      TYPE(OBC_INDEX),              INTENT(in) ::   idx  ! OBC indices
-      TYPE(OBC_DATA),               INTENT(in) ::   dta  ! OBC external data
-      INTEGER,                      INTENT(in) ::   ib_bdy   ! BDY set index
-      LOGICAL,                      INTENT(in) ::   llrim0   ! indicate if rim 0 is treated
-      LOGICAL,                      INTENT(in) ::   ll_npo   ! switch for NPO version
+      INTEGER                             , INTENT( in    ) ::   Kbb, Kaa  ! Time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries)
+      TYPE(OBC_INDEX)                     , INTENT( in    ) ::   idx       ! OBC indices
+      TYPE(OBC_DATA)                      , INTENT( in    ) ::   dta       ! OBC external data
+      INTEGER                             , INTENT( in    ) ::   ib_bdy    ! BDY set index
+      LOGICAL                             , INTENT( in    ) ::   llrim0    ! indicate if rim 0 is treated
+      LOGICAL                             , INTENT( in    ) ::   ll_npo    ! switch for NPO version
 
       INTEGER  ::   jb, igrd                               ! dummy loop indices
       !!----------------------------------------------------------------------
       !
-      !! Note that at this stage the ub and ua arrays contain the baroclinic velocities. 
+      !! Note that at this stage the puu(:,:,:,Kbb) and puu(:,:,:,Kaa) arrays contain the baroclinic velocities. 
       !
       igrd = 2      ! Orlanski bc on u-velocity; 
       !            
-      CALL bdy_orlanski_3d( idx, igrd, ub, ua, dta%u3d, ll_npo, llrim0 )
+      CALL bdy_orlanski_3d( idx, igrd, puu(:,:,:,Kbb), puu(:,:,:,Kaa), dta%u3d, ll_npo, llrim0 )
 
       igrd = 3      ! Orlanski bc on v-velocity
       !  
-      CALL bdy_orlanski_3d( idx, igrd, vb, va, dta%v3d, ll_npo, llrim0 )
+      CALL bdy_orlanski_3d( idx, igrd, pvv(:,:,:,Kbb), pvv(:,:,:,Kaa), dta%v3d, ll_npo, llrim0 )
       !
    END SUBROUTINE bdy_dyn3d_orlanski
 
 
-   SUBROUTINE bdy_dyn3d_dmp( kt )
+   SUBROUTINE bdy_dyn3d_dmp( kt, Kbb, puu, pvv, Krhs )
       !!----------------------------------------------------------------------
       !!                  ***  SUBROUTINE bdy_dyn3d_dmp  ***
@@ -327,5 +339,7 @@
       !!
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! time step index
+      INTEGER                             , INTENT( in    ) ::   kt        ! time step
+      INTEGER                             , INTENT( in    ) ::   Kbb, Krhs ! Time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities and trends (to be updated at open boundaries)
       !
       INTEGER  ::   jb, jk         ! dummy loop indices
@@ -345,6 +359,6 @@
                zwgt = idx_bdy(ib_bdy)%nbd(jb,igrd)
                DO jk = 1, jpkm1
-                  ua(ii,ij,jk) = ( ua(ii,ij,jk) + zwgt * ( dta_bdy(ib_bdy)%u3d(jb,jk) - &
-                                   ub(ii,ij,jk) + ub_b(ii,ij)) ) * umask(ii,ij,jk)
+                  puu(ii,ij,jk,Krhs) = ( puu(ii,ij,jk,Krhs) + zwgt * ( dta_bdy(ib_bdy)%u3d(jb,jk) - &
+                                   puu(ii,ij,jk,Kbb) + uu_b(ii,ij,Kbb)) ) * umask(ii,ij,jk)
                END DO
             END DO
@@ -356,6 +370,6 @@
                zwgt = idx_bdy(ib_bdy)%nbd(jb,igrd)
                DO jk = 1, jpkm1
-                  va(ii,ij,jk) = ( va(ii,ij,jk) + zwgt * ( dta_bdy(ib_bdy)%v3d(jb,jk) -  &
-                                   vb(ii,ij,jk) + vb_b(ii,ij)) ) * vmask(ii,ij,jk)
+                  pvv(ii,ij,jk,Krhs) = ( pvv(ii,ij,jk,Krhs) + zwgt * ( dta_bdy(ib_bdy)%v3d(jb,jk) -  &
+                                   pvv(ii,ij,jk,Kbb) + vv_b(ii,ij,Kbb)) ) * vmask(ii,ij,jk)
                END DO
             END DO
@@ -368,5 +382,5 @@
 
 
-   SUBROUTINE bdy_dyn3d_nmn( idx, ib_bdy, llrim0 )
+   SUBROUTINE bdy_dyn3d_nmn( puu, pvv, Kaa, idx, ib_bdy, llrim0 )
       !!----------------------------------------------------------------------
       !!                 ***  SUBROUTINE bdy_dyn3d_nmn  ***
@@ -377,19 +391,21 @@
       !!
       !!----------------------------------------------------------------------
-      TYPE(OBC_INDEX), INTENT(in) ::   idx      ! OBC indices
-      INTEGER,         INTENT(in) ::   ib_bdy   ! BDY set index
-      LOGICAL,         INTENT(in) ::   llrim0   ! indicate if rim 0 is treated
+      INTEGER                             , INTENT( in    ) ::   Kaa       ! Time level index
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries)
+      TYPE(OBC_INDEX)                     , INTENT( in    ) ::   idx       ! OBC indices
+      INTEGER                             , INTENT( in    ) ::   ib_bdy    ! BDY set index
+      LOGICAL                             , INTENT( in    ) ::   llrim0    ! indicate if rim 0 is treated
       INTEGER  ::   igrd                        ! dummy indice
       !!----------------------------------------------------------------------
       !
-      !! Note that at this stage the ub and ua arrays contain the baroclinic velocities. 
+      !! Note that at this stage the puu(:,:,:,Kbb) and puu(:,:,:,Kaa) arrays contain the baroclinic velocities. 
       !
       igrd = 2      ! Neumann bc on u-velocity; 
       !            
-      CALL bdy_nmn( idx, igrd, ua, llrim0 )   ! ua is masked
+      CALL bdy_nmn( idx, igrd, puu(:,:,:,Kaa), llrim0 )
 
       igrd = 3      ! Neumann bc on v-velocity
       !  
-      CALL bdy_nmn( idx, igrd, va, llrim0 )   ! va is masked
+      CALL bdy_nmn( idx, igrd, pvv(:,:,:,Kaa), llrim0 )
       !
    END SUBROUTINE bdy_dyn3d_nmn
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/BDY/bdyice.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/BDY/bdyice.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/BDY/bdyice.F90	(revision 12928)
@@ -179,5 +179,5 @@
 
             ! Then, a) transfer the snow excess into the ice (different from icethd_dh)
-            zdh = MAX( 0._wp, ( rhos * h_s(ji,jj,jl) + ( rhoi - rau0 ) * h_i(ji,jj,jl) ) * r1_rau0 )
+            zdh = MAX( 0._wp, ( rhos * h_s(ji,jj,jl) + ( rhoi - rho0 ) * h_i(ji,jj,jl) ) * r1_rho0 )
             ! Or, b) transfer all the snow into ice (if incoming ice is likely to melt as it comes into a warmer environment)
             !zdh = MAX( 0._wp, h_s(ji,jj,jl) * rhos / rhoi )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/BDY/bdyini.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/BDY/bdyini.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/BDY/bdyini.F90	(revision 12928)
@@ -19,9 +19,10 @@
    USE oce            ! ocean dynamics and tracers variables
    USE dom_oce        ! ocean space and time domain
+   USE sbc_oce , ONLY: nn_ice
    USE bdy_oce        ! unstructured open boundary conditions
    USE bdydta         ! open boundary cond. setting   (bdy_dta_init routine)
    USE bdytides       ! open boundary cond. setting   (bdytide_init routine)
-   USE sbctide        ! Tidal forcing or not
-   USE phycst   , ONLY: rday
+   USE tide_mod, ONLY: ln_tide ! tidal forcing
+   USE phycst  , ONLY: rday
    !
    USE in_out_manager ! I/O units
@@ -75,5 +76,4 @@
       ! Read namelist parameters
       ! ------------------------
-      REWIND( numnam_ref )              ! Namelist nambdy in reference namelist :Unstructured open boundaries
       READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist' )
@@ -93,5 +93,4 @@
       cn_ice         (2:jp_bdy) = cn_ice         (1)
       nn_ice_dta     (2:jp_bdy) = nn_ice_dta     (1)
-      REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist :Unstructured open boundaries
       READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist' )
@@ -317,4 +316,9 @@
 
          dta_bdy(ib_bdy)%lneed_ice = cn_ice(ib_bdy) /= 'none'
+
+         IF( dta_bdy(ib_bdy)%lneed_ice .AND. nn_ice /= 2 ) THEN
+            WRITE(ctmp1,*) 'bdy number ', ib_bdy,', needs ice model but nn_ice = ', nn_ice
+            CALL ctl_stop( ctmp1 )
+         ENDIF
 
          IF( lwp .AND. dta_bdy(ib_bdy)%lneed_ice ) THEN 
@@ -364,5 +368,4 @@
       ! -------------------------------------------------
 
-      REWIND( numnam_cfg )     
       nblendta(:,:) = 0
       nbdysege = 0
@@ -398,5 +401,6 @@
       jpbdta = MAXVAL(nblendta(1:jpbgrd,1:nb_bdy))
       ALLOCATE( nbidta(jpbdta, jpbgrd, nb_bdy), nbjdta(jpbdta, jpbgrd, nb_bdy), nbrdta(jpbdta, jpbgrd, nb_bdy) )
-    
+      nbrdta(:,:,:) = 0   ! initialize nbrdta as it may not be completely defined for each bdy
+      
       ! Calculate global boundary index arrays or read in from file
       !------------------------------------------------------------               
@@ -1079,12 +1083,26 @@
       INTEGER          ::   ios                 ! Local integer output status for namelist read
       INTEGER          ::   nbdyind, nbdybeg, nbdyend
+      INTEGER          ::   nbdy_count, nbdy_rdstart, nbdy_loc
       CHARACTER(LEN=1) ::   ctypebdy   !     -        - 
+      CHARACTER(LEN=50)::   cerrmsg    !     -        - 
       NAMELIST/nambdy_index/ ctypebdy, nbdyind, nbdybeg, nbdyend
       !!----------------------------------------------------------------------
-
-      ! No REWIND here because may need to read more than one nambdy_index namelist.
-      ! Read only namelist_cfg to avoid unseccessfull overwrite 
-      ! keep full control of the configuration namelist
-      READ  ( numnam_cfg, nambdy_index, IOSTAT = ios, ERR = 904 )
+      ! Need to support possibility of reading more than one nambdy_index from
+      ! the namelist_cfg internal file.
+      ! Do this by finding the kb_bdy'th occurence of nambdy_index in the
+      ! character buffer as the starting point.
+      nbdy_rdstart = 1
+      DO nbdy_count = 1, kb_bdy
+       nbdy_loc = INDEX( numnam_cfg( nbdy_rdstart: ), 'nambdy_index' )
+       IF( nbdy_loc .GT. 0 ) THEN
+          nbdy_rdstart = nbdy_rdstart + nbdy_loc
+       ELSE
+          WRITE(cerrmsg,'(A,I4,A)') 'Error: entry number ',kb_bdy,' of nambdy_index not found'
+          ios = -1
+          CALL ctl_nam ( ios , cerrmsg )
+       ENDIF
+      END DO
+      nbdy_rdstart = MAX( 1, nbdy_rdstart - 2 )
+      READ  ( numnam_cfg( nbdy_rdstart: ), nambdy_index, IOSTAT = ios, ERR = 904)
 904   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_index in configuration namelist' )
       IF(lwm) WRITE ( numond, nambdy_index )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/BDY/bdylib.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/BDY/bdylib.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/BDY/bdylib.F90	(revision 12928)
@@ -35,5 +35,5 @@
 CONTAINS
 
-   SUBROUTINE bdy_frs( idx, pta, dta )
+   SUBROUTINE bdy_frs( idx, phia, dta )
       !!----------------------------------------------------------------------
       !!                 ***  SUBROUTINE bdy_frs  ***
@@ -45,5 +45,5 @@
       TYPE(OBC_INDEX),                     INTENT(in) ::   idx  ! OBC indices
       REAL(wp), DIMENSION(:,:),            INTENT(in) ::   dta  ! OBC external data
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pta  ! tracer trend
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   phia  ! tracer trend
       !!
       REAL(wp) ::   zwgt           ! boundary weight
@@ -58,5 +58,5 @@
             ij = idx%nbj(ib,igrd)
             zwgt = idx%nbw(ib,igrd)
-            pta(ii,ij,ik) = ( pta(ii,ij,ik) + zwgt * (dta(ib,ik) - pta(ii,ij,ik) ) ) * tmask(ii,ij,ik)
+            phia(ii,ij,ik) = ( phia(ii,ij,ik) + zwgt * (dta(ib,ik) - phia(ii,ij,ik) ) ) * tmask(ii,ij,ik)
          END DO
       END DO
@@ -65,5 +65,5 @@
 
 
-   SUBROUTINE bdy_spe( idx, pta, dta )
+   SUBROUTINE bdy_spe( idx, phia, dta )
       !!----------------------------------------------------------------------
       !!                 ***  SUBROUTINE bdy_spe  ***
@@ -74,5 +74,5 @@
       TYPE(OBC_INDEX),                     INTENT(in) ::   idx  ! OBC indices
       REAL(wp), DIMENSION(:,:),            INTENT(in) ::   dta  ! OBC external data
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pta  ! tracer trend
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   phia  ! tracer trend
       !!
       INTEGER  ::   ib, ik, igrd   ! dummy loop indices
@@ -85,5 +85,5 @@
          ij = idx%nbj(ib,igrd)
          DO ik = 1, jpkm1
-            pta(ii,ij,ik) = dta(ib,ik) * tmask(ii,ij,ik)
+            phia(ii,ij,ik) = dta(ib,ik) * tmask(ii,ij,ik)
          END DO
       END DO
@@ -92,5 +92,5 @@
 
 
-   SUBROUTINE bdy_orl( idx, ptb, pta, dta, lrim0, ll_npo )
+   SUBROUTINE bdy_orl( idx, phib, phia, dta, lrim0, ll_npo )
       !!----------------------------------------------------------------------
       !!                 ***  SUBROUTINE bdy_orl  ***
@@ -102,6 +102,6 @@
       TYPE(OBC_INDEX),                     INTENT(in) ::   idx  ! OBC indices
       REAL(wp), DIMENSION(:,:),            INTENT(in) ::   dta  ! OBC external data
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptb  ! before tracer field
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pta  ! tracer trend
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   phib  ! before tracer field
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   phia  ! tracer trend
       LOGICAL                 , OPTIONAL,  INTENT(in) ::   lrim0   ! indicate if rim 0 is treated
       LOGICAL,                             INTENT(in) ::   ll_npo  ! switch for NPO version
@@ -112,5 +112,5 @@
       igrd = 1                       ! Everything is at T-points here
       !
-      CALL bdy_orlanski_3d( idx, igrd, ptb(:,:,:), pta(:,:,:), dta, lrim0, ll_npo )
+      CALL bdy_orlanski_3d( idx, igrd, phib(:,:,:), phia(:,:,:), dta, lrim0, ll_npo )
       !
    END SUBROUTINE bdy_orl
@@ -240,5 +240,5 @@
          ! Centred derivative is calculated as average of "left" and "right" derivatives for 
          ! this reason. 
-         ! Note no rdt factor in expression for zdt because it cancels in the expressions for 
+         ! Note no rn_Dt factor in expression for zdt because it cancels in the expressions for 
          ! zrx and zry.
          zdt   =     phia(iibm1   ,ijbm1   ) - phib(iibm1   ,ijbm1   )
@@ -259,5 +259,5 @@
          zout = sign( 1., zrx )
          zout = 0.5*( zout + abs(zout) )
-         zwgt = 2.*rdt*( (1.-zout) * idx%nbd(jb,igrd) + zout * idx%nbdout(jb,igrd) )
+         zwgt = 2.*rn_Dt*( (1.-zout) * idx%nbd(jb,igrd) + zout * idx%nbdout(jb,igrd) )
          ! only apply radiation on outflow points 
          if( ll_npo ) then     !! NPO version !!
@@ -425,5 +425,5 @@
             zout = sign( 1., zrx )
             zout = 0.5*( zout + abs(zout) )
-            zwgt = 2.*rdt*( (1.-zout) * idx%nbd(jb,igrd) + zout * idx%nbdout(jb,igrd) )
+            zwgt = 2.*rn_Dt*( (1.-zout) * idx%nbd(jb,igrd) + zout * idx%nbdout(jb,igrd) )
             ! only apply radiation on outflow points 
             if( ll_npo ) then     !! NPO version !!
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/BDY/bdytides.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/BDY/bdytides.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/BDY/bdytides.F90	(revision 12928)
@@ -18,5 +18,5 @@
    USE phycst         ! physical constants
    USE bdy_oce        ! ocean open boundary conditions
-   USE tideini        ! 
+   USE tide_mod       ! 
    USE daymod         ! calendar
    !
@@ -30,5 +30,4 @@
 
    PUBLIC   bdytide_init     ! routine called in bdy_init
-   PUBLIC   bdytide_update   ! routine called in bdy_dta
    PUBLIC   bdy_dta_tides    ! routine called in dyn_spg_ts
 
@@ -45,4 +44,8 @@
    TYPE(OBC_DATA)  , PUBLIC, DIMENSION(jp_bdy) :: dta_bdy_s  !: bdy external data (slow component)
 
+   INTEGER ::   kt_tide
+
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -62,20 +65,22 @@
       !! namelist variables
       !!-------------------
-      CHARACTER(len=80)                         ::   filtide             !: Filename root for tidal input files
-      LOGICAL                                   ::   ln_bdytide_2ddta    !: If true, read 2d harmonic data
-      LOGICAL                                   ::   ln_bdytide_conj     !: If true, assume complex conjugate tidal data
+      CHARACTER(len=80)                         ::   filtide             ! Filename root for tidal input files
+      LOGICAL                                   ::   ln_bdytide_2ddta    ! If true, read 2d harmonic data
       !!
-      INTEGER                                   ::   ib_bdy, itide, ib   !: dummy loop indices
-      INTEGER                                   ::   ii, ij              !: dummy loop indices
+      INTEGER                                   ::   ib_bdy, itide, ib   ! dummy loop indices
+      INTEGER                                   ::   ii, ij              ! dummy loop indices
       INTEGER                                   ::   inum, igrd
-      INTEGER, DIMENSION(3)                     ::   ilen0       !: length of boundary data (from OBC arrays)
+      INTEGER                                   ::   isz                 ! bdy data size
       INTEGER                                   ::   ios                 ! Local integer output status for namelist read
-      CHARACTER(len=80)                         ::   clfile              !: full file name for tidal input file 
-      REAL(wp),ALLOCATABLE, DIMENSION(:,:,:)    ::   dta_read            !: work space to read in tidal harmonics data
-      REAL(wp),ALLOCATABLE, DIMENSION(:,:)      ::   ztr, zti            !:  "     "    "   "   "   "        "      " 
+      INTEGER                                   ::   nbdy_rdstart, nbdy_loc
+      CHARACTER(LEN=50)                         ::   cerrmsg             ! error string
+      CHARACTER(len=80)                         ::   clfile              ! full file name for tidal input file 
+      REAL(wp),ALLOCATABLE, DIMENSION(:,:,:)    ::   dta_read            ! work space to read in tidal harmonics data
+      REAL(wp),ALLOCATABLE, DIMENSION(:,:)      ::   ztr, zti            !  "     "    "   "   "   "        "      " 
       !!
-      TYPE(TIDES_DATA),  POINTER                ::   td                  !: local short cut   
+      TYPE(TIDES_DATA), POINTER                 ::   td                  ! local short cut   
+      TYPE(  OBC_DATA), POINTER                 ::   dta                 ! local short cut
       !!
-      NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta, ln_bdytide_conj
+      NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta
       !!----------------------------------------------------------------------
       !
@@ -84,19 +89,32 @@
       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
 
-      REWIND(numnam_cfg)
-
+
+      nbdy_rdstart = 1
       DO ib_bdy = 1, nb_bdy
          IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN
             !
-            td => tides(ib_bdy)
-
+            td  => tides(ib_bdy)
+            dta => dta_bdy(ib_bdy)
+         
             ! Namelist nambdy_tide : tidal harmonic forcing at open boundaries
             filtide(:) = ''
 
-            REWIND( numnam_ref )
             READ  ( numnam_ref, nambdy_tide, IOSTAT = ios, ERR = 901)
 901         IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_tide in reference namelist' )
-            ! Don't REWIND here - may need to read more than one of these namelists. 
-            READ  ( numnam_cfg, nambdy_tide, IOSTAT = ios, ERR = 902 )
+            !
+            ! Need to support possibility of reading more than one
+            ! nambdy_tide from the namelist_cfg internal file.
+            ! Do this by finding the ib_bdy'th occurence of nambdy_tide in the
+            ! character buffer as the starting point.
+            !
+            nbdy_loc = INDEX( numnam_cfg( nbdy_rdstart: ), 'nambdy_tide' )
+            IF( nbdy_loc .GT. 0 ) THEN
+               nbdy_rdstart = nbdy_rdstart + nbdy_loc
+            ELSE
+               WRITE(cerrmsg,'(A,I4,A)') 'Error: entry number ',ib_bdy,' of nambdy_tide not found'
+               ios = -1
+               CALL ctl_nam ( ios , cerrmsg )
+            ENDIF
+            READ  ( numnam_cfg( MAX( 1, nbdy_rdstart - 2 ): ), nambdy_tide, IOSTAT = ios, ERR = 902)
 902         IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy_tide in configuration namelist' )
             IF(lwm) WRITE ( numond, nambdy_tide )
@@ -105,40 +123,37 @@
             IF(lwp) WRITE(numout,*) '          Namelist nambdy_tide : tidal harmonic forcing at open boundaries'
             IF(lwp) WRITE(numout,*) '             read tidal data in 2d files: ', ln_bdytide_2ddta
-            IF(lwp) WRITE(numout,*) '             assume complex conjugate   : ', ln_bdytide_conj
             IF(lwp) WRITE(numout,*) '             Number of tidal components to read: ', nb_harmo
             IF(lwp) THEN 
                     WRITE(numout,*) '             Tidal components: ' 
                DO itide = 1, nb_harmo
-                  WRITE(numout,*)  '                 ', Wave(ntide(itide))%cname_tide 
+                  WRITE(numout,*)  '                 ', tide_harmonics(itide)%cname_tide 
                END DO
             ENDIF 
             IF(lwp) WRITE(numout,*) ' '
 
-            ! Allocate space for tidal harmonics data - get size from OBC data arrays
+            ! Allocate space for tidal harmonics data - get size from BDY data arrays
+            ! Allocate also slow varying data in the case of time splitting:
+            ! Do it anyway because at this stage knowledge of free surface scheme is unknown
             ! -----------------------------------------------------------------------
-
-            ! JC: If FRS scheme is used, we assume that tidal is needed over the whole
-            ! relaxation area      
-            IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN   ;   ilen0(:) = idx_bdy(ib_bdy)%nblen   (:)
-            ELSE                                   ;   ilen0(:) = idx_bdy(ib_bdy)%nblenrim(:)
-            ENDIF
-
-            ALLOCATE( td%ssh0( ilen0(1), nb_harmo, 2 ) )
-            ALLOCATE( td%ssh ( ilen0(1), nb_harmo, 2 ) )
-
-            ALLOCATE( td%u0( ilen0(2), nb_harmo, 2 ) )
-            ALLOCATE( td%u ( ilen0(2), nb_harmo, 2 ) )
-
-            ALLOCATE( td%v0( ilen0(3), nb_harmo, 2 ) )
-            ALLOCATE( td%v ( ilen0(3), nb_harmo, 2 ) )
-
-            td%ssh0(:,:,:) = 0._wp
-            td%ssh (:,:,:) = 0._wp
-            td%u0  (:,:,:) = 0._wp
-            td%u   (:,:,:) = 0._wp
-            td%v0  (:,:,:) = 0._wp
-            td%v   (:,:,:) = 0._wp
-
+            IF( ASSOCIATED(dta%ssh) ) THEN   ! we use bdy ssh on this mpi subdomain
+               isz = SIZE(dta%ssh)
+               ALLOCATE( td%ssh0( isz, nb_harmo, 2 ), td%ssh( isz, nb_harmo, 2 ), dta_bdy_s(ib_bdy)%ssh( isz ) )
+               dta_bdy_s(ib_bdy)%ssh(:) = 0._wp   ! needed?
+            ENDIF
+            IF( ASSOCIATED(dta%u2d) ) THEN   ! we use bdy u2d on this mpi subdomain
+               isz = SIZE(dta%u2d)
+               ALLOCATE( td%u0  ( isz, nb_harmo, 2 ), td%u  ( isz, nb_harmo, 2 ), dta_bdy_s(ib_bdy)%u2d( isz ) )
+               dta_bdy_s(ib_bdy)%u2d(:) = 0._wp   ! needed?
+            ENDIF
+            IF( ASSOCIATED(dta%v2d) ) THEN   ! we use bdy v2d on this mpi subdomain
+               isz = SIZE(dta%v2d)
+               ALLOCATE( td%v0  ( isz, nb_harmo, 2 ), td%v  ( isz, nb_harmo, 2 ), dta_bdy_s(ib_bdy)%v2d( isz ) )
+               dta_bdy_s(ib_bdy)%v2d(:) = 0._wp   ! needed?
+            ENDIF
+
+            ! fill td%ssh0, td%u0, td%v0
+            ! -----------------------------------------------------------------------
             IF( ln_bdytide_2ddta ) THEN
+               !
                ! It is assumed that each data file contains all complex harmonic amplitudes
                ! given on the global domain (ie global, jpiglo x jpjglo)
@@ -147,53 +162,56 @@
                !
                ! SSH fields
-               clfile = TRIM(filtide)//'_grid_T.nc'
-               CALL iom_open( clfile , inum ) 
-               igrd = 1                       ! Everything is at T-points here
-               DO itide = 1, nb_harmo
-                  CALL iom_get( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_z1', ztr(:,:) )
-                  CALL iom_get( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_z2', zti(:,:) ) 
-                  DO ib = 1, ilen0(igrd)
-                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
-                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
-                     IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove?
-                     td%ssh0(ib,itide,1) = ztr(ii,ij)
-                     td%ssh0(ib,itide,2) = zti(ii,ij)
-                  END DO
-               END DO 
-               CALL iom_close( inum )
+               IF( ASSOCIATED(dta%ssh) ) THEN   ! we use bdy ssh on this mpi subdomain
+                  clfile = TRIM(filtide)//'_grid_T.nc'
+                  CALL iom_open( clfile , inum ) 
+                  igrd = 1                       ! Everything is at T-points here
+                  DO itide = 1, nb_harmo
+                     CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z1', ztr(:,:) )
+                     CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z2', zti(:,:) ) 
+                     DO ib = 1, SIZE(dta%ssh)
+                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                        td%ssh0(ib,itide,1) = ztr(ii,ij)
+                        td%ssh0(ib,itide,2) = zti(ii,ij)
+                     END DO
+                  END DO
+                  CALL iom_close( inum )
+               ENDIF
                !
                ! U fields
-               clfile = TRIM(filtide)//'_grid_U.nc'
-               CALL iom_open( clfile , inum ) 
-               igrd = 2                       ! Everything is at U-points here
-               DO itide = 1, nb_harmo
-                  CALL iom_get  ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_u1', ztr(:,:) )
-                  CALL iom_get  ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_u2', zti(:,:) )
-                  DO ib = 1, ilen0(igrd)
-                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
-                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
-                     IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove?
-                     td%u0(ib,itide,1) = ztr(ii,ij)
-                     td%u0(ib,itide,2) = zti(ii,ij)
-                  END DO
-               END DO
-               CALL iom_close( inum )
+               IF( ASSOCIATED(dta%u2d) ) THEN   ! we use bdy u2d on this mpi subdomain
+                  clfile = TRIM(filtide)//'_grid_U.nc'
+                  CALL iom_open( clfile , inum ) 
+                  igrd = 2                       ! Everything is at U-points here
+                  DO itide = 1, nb_harmo
+                     CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u1', ztr(:,:) )
+                     CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u2', zti(:,:) )
+                     DO ib = 1, SIZE(dta%u2d)
+                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                        td%u0(ib,itide,1) = ztr(ii,ij)
+                        td%u0(ib,itide,2) = zti(ii,ij)
+                     END DO
+                  END DO
+                  CALL iom_close( inum )
+               ENDIF
                !
                ! V fields
-               clfile = TRIM(filtide)//'_grid_V.nc'
-               CALL iom_open( clfile , inum ) 
-               igrd = 3                       ! Everything is at V-points here
-               DO itide = 1, nb_harmo
-                  CALL iom_get  ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_v1', ztr(:,:) )
-                  CALL iom_get  ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_v2', zti(:,:) )
-                  DO ib = 1, ilen0(igrd)
-                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
-                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
-                     IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove?
-                     td%v0(ib,itide,1) = ztr(ii,ij)
-                     td%v0(ib,itide,2) = zti(ii,ij)
-                  END DO
-               END DO  
-               CALL iom_close( inum )
+               IF( ASSOCIATED(dta%v2d) ) THEN   ! we use bdy v2d on this mpi subdomain
+                  clfile = TRIM(filtide)//'_grid_V.nc'
+                  CALL iom_open( clfile , inum ) 
+                  igrd = 3                       ! Everything is at V-points here
+                  DO itide = 1, nb_harmo
+                     CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v1', ztr(:,:) )
+                     CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v2', zti(:,:) )
+                     DO ib = 1, SIZE(dta%v2d)
+                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                        td%v0(ib,itide,1) = ztr(ii,ij)
+                        td%v0(ib,itide,2) = zti(ii,ij)
+                     END DO
+                  END DO
+                  CALL iom_close( inum )
+               ENDIF
                !
                DEALLOCATE( ztr, zti ) 
@@ -203,5 +221,5 @@
                ! Read tidal data only on bdy segments
                ! 
-               ALLOCATE( dta_read( MAXVAL(ilen0(1:3)), 1, 1 ) )
+               ALLOCATE( dta_read( MAXVAL( idx_bdy(ib_bdy)%nblen(:) ), 1, 1 ) )
                !
                ! Open files and read in tidal forcing data
@@ -210,27 +228,36 @@
                DO itide = 1, nb_harmo
                   !                                                              ! SSH fields
-                  clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_T.nc'
-                  CALL iom_open( clfile, inum )
-                  CALL fld_map( inum, 'z1' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) )
-                  td%ssh0(:,itide,1) = dta_read(1:ilen0(1),1,1)
-                  CALL fld_map( inum, 'z2' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) )
-                  td%ssh0(:,itide,2) = dta_read(1:ilen0(1),1,1)
-                  CALL iom_close( inum )
+                  IF( ASSOCIATED(dta%ssh) ) THEN   ! we use bdy ssh on this mpi subdomain
+                     isz = SIZE(dta%ssh)
+                     clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_T.nc'
+                     CALL iom_open( clfile, inum )
+                     CALL fld_map( inum, 'z1', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) )
+                     td%ssh0(:,itide,1) = dta_read(1:isz,1,1)
+                     CALL fld_map( inum, 'z2', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) )
+                     td%ssh0(:,itide,2) = dta_read(1:isz,1,1)
+                     CALL iom_close( inum )
+                  ENDIF
                   !                                                              ! U fields
-                  clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_U.nc'
-                  CALL iom_open( clfile, inum )
-                  CALL fld_map( inum, 'u1' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) )
-                  td%u0(:,itide,1) = dta_read(1:ilen0(2),1,1)
-                  CALL fld_map( inum, 'u2' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) )
-                  td%u0(:,itide,2) = dta_read(1:ilen0(2),1,1)
-                  CALL iom_close( inum )
+                  IF( ASSOCIATED(dta%u2d) ) THEN   ! we use bdy u2d on this mpi subdomain
+                     isz = SIZE(dta%u2d)
+                     clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_U.nc'
+                     CALL iom_open( clfile, inum )
+                     CALL fld_map( inum, 'u1', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) )
+                     td%u0(:,itide,1) = dta_read(1:isz,1,1)
+                     CALL fld_map( inum, 'u2', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) )
+                     td%u0(:,itide,2) = dta_read(1:isz,1,1)
+                     CALL iom_close( inum )
+                  ENDIF
                   !                                                              ! V fields
-                  clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_V.nc'
-                  CALL iom_open( clfile, inum )
-                  CALL fld_map( inum, 'v1' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) )
-                  td%v0(:,itide,1) = dta_read(1:ilen0(3),1,1)
-                  CALL fld_map( inum, 'v2' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) )
-                  td%v0(:,itide,2) = dta_read(1:ilen0(3),1,1)
-                  CALL iom_close( inum )
+                  IF( ASSOCIATED(dta%v2d) ) THEN   ! we use bdy v2d on this mpi subdomain
+                     isz = SIZE(dta%v2d)
+                     clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_V.nc'
+                     CALL iom_open( clfile, inum )
+                     CALL fld_map( inum, 'v1', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) )
+                     td%v0(:,itide,1) = dta_read(1:isz,1,1)
+                     CALL fld_map( inum, 'v2', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) )
+                     td%v0(:,itide,2) = dta_read(1:isz,1,1)
+                     CALL iom_close( inum )
+                  ENDIF
                   !
                END DO ! end loop on tidal components
@@ -240,19 +267,4 @@
             ENDIF ! ln_bdytide_2ddta=.true.
             !
-            IF( ln_bdytide_conj ) THEN    ! assume complex conjugate in data files
-               td%ssh0(:,:,2) = - td%ssh0(:,:,2)
-               td%u0  (:,:,2) = - td%u0  (:,:,2)
-               td%v0  (:,:,2) = - td%v0  (:,:,2)
-            ENDIF
-            !
-            ! Allocate slow varying data in the case of time splitting:
-            ! Do it anyway because at this stage knowledge of free surface scheme is unknown
-            ALLOCATE( dta_bdy_s(ib_bdy)%ssh ( ilen0(1) ) )
-            ALLOCATE( dta_bdy_s(ib_bdy)%u2d ( ilen0(2) ) )
-            ALLOCATE( dta_bdy_s(ib_bdy)%v2d ( ilen0(3) ) )
-            dta_bdy_s(ib_bdy)%ssh(:) = 0._wp
-            dta_bdy_s(ib_bdy)%u2d(:) = 0._wp
-            dta_bdy_s(ib_bdy)%v2d(:) = 0._wp
-            !
          ENDIF ! nn_dyn2d_dta(ib_bdy) >= 2
          !
@@ -262,94 +274,5 @@
 
 
-   SUBROUTINE bdytide_update( kt, idx, dta, td, kit, kt_offset )
-      !!----------------------------------------------------------------------
-      !!                 ***  SUBROUTINE bdytide_update  ***
-      !!                
-      !! ** Purpose : - Add tidal forcing to ssh, u2d and v2d OBC data arrays. 
-      !!                
-      !!----------------------------------------------------------------------
-      INTEGER          , INTENT(in   ) ::   kt          ! Main timestep counter
-      TYPE(OBC_INDEX)  , INTENT(in   ) ::   idx         ! OBC indices
-      TYPE(OBC_DATA)   , INTENT(inout) ::   dta         ! OBC external data
-      TYPE(TIDES_DATA) , INTENT(inout) ::   td          ! tidal harmonics data
-      INTEGER, OPTIONAL, INTENT(in   ) ::   kit         ! Barotropic timestep counter (for timesplitting option)
-      INTEGER, OPTIONAL, INTENT(in   ) ::   kt_offset   ! time offset in units of timesteps. NB. if kit
-      !                                                 ! is present then units = subcycle timesteps.
-      !                                                 ! kt_offset = 0  => get data at "now"    time level
-      !                                                 ! kt_offset = -1 => get data at "before" time level
-      !                                                 ! kt_offset = +1 => get data at "after"  time level
-      !                                                 ! etc.
-      !
-      INTEGER  ::   itide, igrd, ib       ! dummy loop indices
-      INTEGER  ::   time_add              ! time offset in units of timesteps
-      INTEGER, DIMENSION(3) ::   ilen0    ! length of boundary data (from OBC arrays)
-      REAL(wp) ::   z_arg, z_sarg, zflag, zramp   ! local scalars    
-      REAL(wp), DIMENSION(jpmax_harmo) :: z_sist, z_cost
-      !!----------------------------------------------------------------------
-      !
-      ilen0(1) =  SIZE(td%ssh(:,1,1))
-      ilen0(2) =  SIZE(td%u(:,1,1))
-      ilen0(3) =  SIZE(td%v(:,1,1))
-
-      zflag=1
-      IF ( PRESENT(kit) ) THEN
-        IF ( kit /= 1 ) zflag=0
-      ENDIF
-
-      IF ( (nsec_day == NINT(0.5_wp * rdt) .OR. kt==nit000) .AND. zflag==1 ) THEN
-        !
-        kt_tide = kt - (nsec_day - 0.5_wp * rdt)/rdt
-        !
-        IF(lwp) THEN
-           WRITE(numout,*)
-           WRITE(numout,*) 'bdytide_update : (re)Initialization of the tidal bdy forcing at kt=',kt
-           WRITE(numout,*) '~~~~~~~~~~~~~~ '
-        ENDIF
-        !
-        CALL tide_init_elevation ( idx, td )
-        CALL tide_init_velocities( idx, td )
-        !
-      ENDIF 
-
-      time_add = 0
-      IF( PRESENT(kt_offset) ) THEN
-         time_add = kt_offset
-      ENDIF
-         
-      IF( PRESENT(kit) ) THEN  
-         z_arg = ((kt-kt_tide) * rdt + (kit+0.5_wp*(time_add-1)) * rdt / REAL(nn_baro,wp) )
-      ELSE                              
-         z_arg = ((kt-kt_tide)+time_add) * rdt
-      ENDIF
-
-      ! Linear ramp on tidal component at open boundaries 
-      zramp = 1._wp
-      IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg + (kt_tide-nit000)*rdt)/(rdttideramp*rday),0._wp),1._wp)
-
-      DO itide = 1, nb_harmo
-         z_sarg = z_arg * omega_tide(itide)
-         z_cost(itide) = COS( z_sarg )
-         z_sist(itide) = SIN( z_sarg )
-      END DO
-
-      DO itide = 1, nb_harmo
-         igrd=1                              ! SSH on tracer grid
-         DO ib = 1, ilen0(igrd)
-            dta%ssh(ib) = dta%ssh(ib) + zramp*(td%ssh(ib,itide,1)*z_cost(itide) + td%ssh(ib,itide,2)*z_sist(itide))
-         END DO
-         igrd=2                              ! U grid
-         DO ib = 1, ilen0(igrd)
-            dta%u2d(ib) = dta%u2d(ib) + zramp*(td%u  (ib,itide,1)*z_cost(itide) + td%u  (ib,itide,2)*z_sist(itide))
-         END DO
-         igrd=3                              ! V grid
-         DO ib = 1, ilen0(igrd) 
-            dta%v2d(ib) = dta%v2d(ib) + zramp*(td%v  (ib,itide,1)*z_cost(itide) + td%v  (ib,itide,2)*z_sist(itide))
-         END DO
-      END DO
-      !
-   END SUBROUTINE bdytide_update
-
-
-   SUBROUTINE bdy_dta_tides( kt, kit, kt_offset )
+   SUBROUTINE bdy_dta_tides( kt, kit, pt_offset )
       !!----------------------------------------------------------------------
       !!                 ***  SUBROUTINE bdy_dta_tides  ***
@@ -360,17 +283,9 @@
       INTEGER,           INTENT(in) ::   kt          ! Main timestep counter
       INTEGER, OPTIONAL, INTENT(in) ::   kit         ! Barotropic timestep counter (for timesplitting option)
-      INTEGER, OPTIONAL, INTENT(in) ::   kt_offset   ! time offset in units of timesteps. NB. if kit
-      !                                              ! is present then units = subcycle timesteps.
-      !                                              ! kt_offset = 0  => get data at "now"    time level
-      !                                              ! kt_offset = -1 => get data at "before" time level
-      !                                              ! kt_offset = +1 => get data at "after"  time level
-      !                                              ! etc.
+      REAL(wp),OPTIONAL, INTENT(in) ::   pt_offset   ! time offset in units of timesteps
       !
       LOGICAL  ::   lk_first_btstp            ! =.TRUE. if time splitting and first barotropic step
-      INTEGER  ::   itide, ib_bdy, ib, igrd   ! loop indices
-      INTEGER  ::   time_add                  ! time offset in units of timesteps
-      INTEGER, DIMENSION(jpbgrd)   ::   ilen0 
-      INTEGER, DIMENSION(1:jpbgrd) ::   nblen, nblenrim  ! short cuts
-      REAL(wp) ::   z_arg, z_sarg, zramp, zoff, z_cost, z_sist      
+      INTEGER  ::   itide, ib_bdy, ib         ! loop indices
+      REAL(wp) ::   z_arg, z_sarg, zramp, zoff, z_cost, z_sist, zt_offset   
       !!----------------------------------------------------------------------
       !
@@ -378,36 +293,27 @@
       IF ( PRESENT(kit).AND.( kit /= 1 ) ) THEN ; lk_first_btstp=.FALSE. ; ENDIF
 
-      time_add = 0
-      IF( PRESENT(kt_offset) ) THEN
-         time_add = kt_offset
-      ENDIF
+      zt_offset = 0._wp
+      IF( PRESENT(pt_offset) )   zt_offset = pt_offset
       
       ! Absolute time from model initialization:   
       IF( PRESENT(kit) ) THEN  
-         z_arg = ( kt + (kit+time_add-1) / REAL(nn_baro,wp) ) * rdt
+         z_arg = ( REAL(kt, wp) + ( REAL(kit, wp) + zt_offset - 1. ) / REAL(nn_e, wp) ) * rn_Dt
       ELSE                              
-         z_arg = ( kt + time_add ) * rdt
+         z_arg = ( REAL(kt, wp) + zt_offset ) * rn_Dt
       ENDIF
 
       ! Linear ramp on tidal component at open boundaries 
       zramp = 1.
-      IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg - nit000*rdt)/(rdttideramp*rday),0.),1.)
+      IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg - REAL(nit000,wp)*rn_Dt)/(rn_tide_ramp_dt*rday),0.),1.)
 
       DO ib_bdy = 1,nb_bdy
          !
          IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN
-            !
-            nblen(1:jpbgrd) = idx_bdy(ib_bdy)%nblen(1:jpbgrd)
-            nblenrim(1:jpbgrd) = idx_bdy(ib_bdy)%nblenrim(1:jpbgrd)
-            !
-            IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN   ;   ilen0(:) = nblen   (:)
-            ELSE                                   ;   ilen0(:) = nblenrim(:)
-            ENDIF     
             !
             ! We refresh nodal factors every day below
             ! This should be done somewhere else
-            IF ( ( nsec_day == NINT(0.5_wp * rdt) .OR. kt==nit000 ) .AND. lk_first_btstp ) THEN
-               !
-               kt_tide = kt - (nsec_day - 0.5_wp * rdt)/rdt
+            IF ( ( nsec_day == NINT(0.5_wp * rn_Dt) .OR. kt==nit000 ) .AND. lk_first_btstp ) THEN
+               !
+               kt_tide = kt - NINT((REAL(nsec_day,wp) - 0.5_wp * rn_Dt)/rn_Dt)
                !
                IF(lwp) THEN
@@ -421,11 +327,11 @@
                !
             ENDIF
-            zoff = -kt_tide * rdt ! time offset relative to nodal factor computation time
+            zoff = REAL(-kt_tide,wp) * rn_Dt ! time offset relative to nodal factor computation time
             !
             ! If time splitting, initialize arrays from slow varying open boundary data:
             IF ( PRESENT(kit) ) THEN           
-               IF ( dta_bdy(ib_bdy)%lneed_ssh   ) dta_bdy(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy_s(ib_bdy)%ssh(1:ilen0(1))
-               IF ( dta_bdy(ib_bdy)%lneed_dyn2d ) dta_bdy(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy_s(ib_bdy)%u2d(1:ilen0(2))
-               IF ( dta_bdy(ib_bdy)%lneed_dyn2d ) dta_bdy(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy_s(ib_bdy)%v2d(1:ilen0(3))
+               IF ( ASSOCIATED(dta_bdy(ib_bdy)%ssh) ) dta_bdy(ib_bdy)%ssh(:) = dta_bdy_s(ib_bdy)%ssh(:)
+               IF ( ASSOCIATED(dta_bdy(ib_bdy)%u2d) ) dta_bdy(ib_bdy)%u2d(:) = dta_bdy_s(ib_bdy)%u2d(:)
+               IF ( ASSOCIATED(dta_bdy(ib_bdy)%v2d) ) dta_bdy(ib_bdy)%v2d(:) = dta_bdy_s(ib_bdy)%v2d(:)
             ENDIF
             !
@@ -433,11 +339,10 @@
             DO itide = 1, nb_harmo
                !
-               z_sarg = (z_arg + zoff) * omega_tide(itide)
+               z_sarg = (z_arg + zoff) * tide_harmonics(itide)%omega
                z_cost = zramp * COS( z_sarg )
                z_sist = zramp * SIN( z_sarg )
                !
-               IF ( dta_bdy(ib_bdy)%lneed_ssh ) THEN
-                  igrd=1                              ! SSH on tracer grid
-                  DO ib = 1, ilen0(igrd)
+               IF ( ASSOCIATED(dta_bdy(ib_bdy)%ssh) ) THEN   ! SSH on tracer grid
+                  DO ib = 1, SIZE(dta_bdy(ib_bdy)%ssh)
                      dta_bdy(ib_bdy)%ssh(ib) = dta_bdy(ib_bdy)%ssh(ib) + &
                         &                      ( tides(ib_bdy)%ssh(ib,itide,1)*z_cost + &
@@ -446,13 +351,14 @@
                ENDIF
                !
-               IF ( dta_bdy(ib_bdy)%lneed_dyn2d ) THEN
-                  igrd=2                              ! U grid
-                  DO ib = 1, ilen0(igrd)
+               IF ( ASSOCIATED(dta_bdy(ib_bdy)%u2d) ) THEN  ! U grid
+                  DO ib = 1, SIZE(dta_bdy(ib_bdy)%u2d)
                      dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) + &
                         &                      ( tides(ib_bdy)%u(ib,itide,1)*z_cost + &
                         &                        tides(ib_bdy)%u(ib,itide,2)*z_sist )
                   END DO
-                  igrd=3                              ! V grid
-                  DO ib = 1, ilen0(igrd) 
+               ENDIF
+               !
+               IF ( ASSOCIATED(dta_bdy(ib_bdy)%v2d) ) THEN   ! V grid
+                  DO ib = 1, SIZE(dta_bdy(ib_bdy)%v2d)
                      dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) + &
                         &                      ( tides(ib_bdy)%v(ib,itide,1)*z_cost + &
@@ -460,6 +366,7 @@
                   END DO
                ENDIF
+               !
             END DO             
-         END IF
+         ENDIF
       END DO
       !
@@ -474,31 +381,31 @@
       TYPE(TIDES_DATA), INTENT(inout) ::   td    ! tidal harmonics data
       !
-      INTEGER ::   itide, igrd, ib       ! dummy loop indices
-      INTEGER, DIMENSION(1) ::   ilen0   ! length of boundary data (from OBC arrays)
+      INTEGER ::   itide, isz, ib       ! dummy loop indices
       REAL(wp),ALLOCATABLE, DIMENSION(:) ::   mod_tide, phi_tide
       !!----------------------------------------------------------------------
       !
-      igrd=1   
-                              ! SSH on tracer grid.
-      ilen0(1) =  SIZE(td%ssh0(:,1,1))
-      !
-      ALLOCATE( mod_tide(ilen0(igrd)), phi_tide(ilen0(igrd)) )
-      !
-      DO itide = 1, nb_harmo
-         DO ib = 1, ilen0(igrd)
-            mod_tide(ib)=SQRT(td%ssh0(ib,itide,1)**2.+td%ssh0(ib,itide,2)**2.)
-            phi_tide(ib)=ATAN2(-td%ssh0(ib,itide,2),td%ssh0(ib,itide,1))
+      IF( ASSOCIATED(td%ssh0) ) THEN   ! SSH on tracer grid.
+         !
+         isz = SIZE( td%ssh0, dim = 1 )
+         ALLOCATE( mod_tide(isz), phi_tide(isz) )
+         !
+         DO itide = 1, nb_harmo
+            DO ib = 1, isz
+               mod_tide(ib)=SQRT( td%ssh0(ib,itide,1)*td%ssh0(ib,itide,1) + td%ssh0(ib,itide,2)*td%ssh0(ib,itide,2) )
+               phi_tide(ib)=ATAN2(-td%ssh0(ib,itide,2),td%ssh0(ib,itide,1))
+            END DO
+            DO ib = 1, isz
+               mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f
+               phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0+tide_harmonics(itide)%u
+            END DO
+            DO ib = 1, isz
+               td%ssh(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
+               td%ssh(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
+            END DO
          END DO
-         DO ib = 1 , ilen0(igrd)
-            mod_tide(ib)=mod_tide(ib)*ftide(itide)
-            phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide)
-         ENDDO
-         DO ib = 1 , ilen0(igrd)
-            td%ssh(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
-            td%ssh(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
-         ENDDO
-      END DO
-      !
-      DEALLOCATE( mod_tide, phi_tide )
+         !
+         DEALLOCATE( mod_tide, phi_tide )
+         !
+      ENDIF
       !
    END SUBROUTINE tide_init_elevation
@@ -512,55 +419,57 @@
       TYPE(TIDES_DATA), INTENT(inout) ::   td    ! tidal harmonics data
       !
-      INTEGER ::   itide, igrd, ib       ! dummy loop indices
-      INTEGER, DIMENSION(3) ::   ilen0   ! length of boundary data (from OBC arrays)
+      INTEGER ::   itide, isz, ib        ! dummy loop indices
       REAL(wp),ALLOCATABLE, DIMENSION(:) ::   mod_tide, phi_tide
       !!----------------------------------------------------------------------
       !
-      ilen0(2) =  SIZE(td%u0(:,1,1))
-      ilen0(3) =  SIZE(td%v0(:,1,1))
-      !
-      igrd=2                                 ! U grid.
-      !
-      ALLOCATE( mod_tide(ilen0(igrd)) , phi_tide(ilen0(igrd)) )
-      !
-      DO itide = 1, nb_harmo
-         DO ib = 1, ilen0(igrd)
-            mod_tide(ib)=SQRT(td%u0(ib,itide,1)**2.+td%u0(ib,itide,2)**2.)
-            phi_tide(ib)=ATAN2(-td%u0(ib,itide,2),td%u0(ib,itide,1))
+      IF( ASSOCIATED(td%u0) ) THEN   ! U grid. we use bdy u2d on this mpi subdomain
+         !
+         isz = SIZE( td%u0, dim = 1 )
+         ALLOCATE( mod_tide(isz), phi_tide(isz) )
+         !
+         DO itide = 1, nb_harmo
+            DO ib = 1, isz
+               mod_tide(ib)=SQRT( td%u0(ib,itide,1)*td%u0(ib,itide,1) + td%u0(ib,itide,2)*td%u0(ib,itide,2) )
+               phi_tide(ib)=ATAN2(-td%u0(ib,itide,2),td%u0(ib,itide,1))
+            END DO
+            DO ib = 1, isz
+               mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f
+               phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u
+            END DO
+            DO ib = 1, isz
+               td%u(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
+               td%u(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
+            END DO
          END DO
-         DO ib = 1, ilen0(igrd)
-            mod_tide(ib)=mod_tide(ib)*ftide(itide)
-            phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide)
-         ENDDO
-         DO ib = 1, ilen0(igrd)
-            td%u(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
-            td%u(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
-         ENDDO
-      END DO
-      !
-      DEALLOCATE( mod_tide , phi_tide )
-      !
-      igrd=3                                 ! V grid.
-      !
-      ALLOCATE( mod_tide(ilen0(igrd)) , phi_tide(ilen0(igrd)) )
-
-      DO itide = 1, nb_harmo
-         DO ib = 1, ilen0(igrd)
-            mod_tide(ib)=SQRT(td%v0(ib,itide,1)**2.+td%v0(ib,itide,2)**2.)
-            phi_tide(ib)=ATAN2(-td%v0(ib,itide,2),td%v0(ib,itide,1))
+         !
+         DEALLOCATE( mod_tide, phi_tide )
+         !
+      ENDIF
+      !
+      IF( ASSOCIATED(td%v0) ) THEN   ! V grid. we use bdy u2d on this mpi subdomain
+         !
+         isz = SIZE( td%v0, dim = 1 )
+         ALLOCATE( mod_tide(isz), phi_tide(isz) )
+         !
+         DO itide = 1, nb_harmo
+            DO ib = 1, isz
+               mod_tide(ib)=SQRT( td%v0(ib,itide,1)*td%v0(ib,itide,1) + td%v0(ib,itide,2)*td%v0(ib,itide,2) )
+               phi_tide(ib)=ATAN2(-td%v0(ib,itide,2),td%v0(ib,itide,1))
+            END DO
+            DO ib = 1, isz
+               mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f
+               phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u
+            END DO
+            DO ib = 1, isz
+               td%v(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
+               td%v(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
+            END DO
          END DO
-         DO ib = 1, ilen0(igrd)
-            mod_tide(ib)=mod_tide(ib)*ftide(itide)
-            phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide)
-         ENDDO
-         DO ib = 1, ilen0(igrd)
-            td%v(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
-            td%v(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
-         ENDDO
-      END DO
-      !
-      DEALLOCATE( mod_tide, phi_tide )
-      !
-  END SUBROUTINE tide_init_velocities
+         !
+         DEALLOCATE( mod_tide, phi_tide )
+         !
+      ENDIF
+      !
+   END SUBROUTINE tide_init_velocities
 
    !!======================================================================
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/BDY/bdytra.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/BDY/bdytra.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/BDY/bdytra.F90	(revision 12928)
@@ -40,5 +40,5 @@
 CONTAINS
 
-   SUBROUTINE bdy_tra( kt )
+   SUBROUTINE bdy_tra( kt, Kbb, pts, Kaa )
       !!----------------------------------------------------------------------
       !!                  ***  SUBROUTINE bdy_tra  ***
@@ -47,5 +47,7 @@
       !!
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! Main time step counter
+      INTEGER                                  , INTENT(in)    :: kt        ! Main time step counter
+      INTEGER                                  , INTENT(in)    :: Kbb, Kaa  ! time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts       ! tracer fields
       !
       INTEGER                        :: ib_bdy, jn, igrd, ir   ! Loop indeces
@@ -70,13 +72,13 @@
                CASE('none'        )   ;   CYCLE
                CASE('frs'         )   ! treat the whole boundary at once
-                  IF( ir == 0 ) CALL bdy_frs ( idx_bdy(ib_bdy),                tsa(:,:,:,jn), zdta(jn)%tra )
+                  IF( ir == 0 ) CALL bdy_frs ( idx_bdy(ib_bdy),                pts(:,:,:,jn,Kaa), zdta(jn)%tra )
                CASE('specified'   )   ! treat the whole rim      at once
-                  IF( ir == 0 ) CALL bdy_spe ( idx_bdy(ib_bdy),                tsa(:,:,:,jn), zdta(jn)%tra )
-               CASE('neumann'     )   ;   CALL bdy_nmn ( idx_bdy(ib_bdy), igrd         , tsa(:,:,:,jn), llrim0 )   ! tsa masked
-               CASE('orlanski'    )   ;   CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), &
+                  IF( ir == 0 ) CALL bdy_spe ( idx_bdy(ib_bdy),                pts(:,:,:,jn,Kaa), zdta(jn)%tra )
+               CASE('neumann'     )   ;   CALL bdy_nmn ( idx_bdy(ib_bdy), igrd         , pts(:,:,:,jn,Kaa), llrim0 )   ! tsa masked
+               CASE('orlanski'    )   ;   CALL bdy_orl ( idx_bdy(ib_bdy), pts(:,:,:,jn,Kbb), pts(:,:,:,jn,Kaa), &
                     & zdta(jn)%tra, llrim0, ll_npo=.false. )
-               CASE('orlanski_npo')   ;   CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), &
+               CASE('orlanski_npo')   ;   CALL bdy_orl ( idx_bdy(ib_bdy), pts(:,:,:,jn,Kbb), pts(:,:,:,jn,Kaa), &
                     & zdta(jn)%tra, llrim0, ll_npo=.true.  )
-               CASE('runoff'      )   ;   CALL bdy_rnf ( idx_bdy(ib_bdy),                tsa(:,:,:,jn), jn, llrim0 )
+               CASE('runoff'      )   ;   CALL bdy_rnf ( idx_bdy(ib_bdy),                pts(:,:,:,jn,Kaa), jn, llrim0 )
                CASE DEFAULT           ;   CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' )
                END SELECT
@@ -98,5 +100,5 @@
          END DO
          IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction
-            CALL lbc_lnk( 'bdytra', tsa, 'T',  1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 )
+            CALL lbc_lnk( 'bdytra', pts(:,:,:,jn,Kaa), 'T',  1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 )
          END IF
          !
@@ -106,5 +108,5 @@
 
 
-   SUBROUTINE bdy_rnf( idx, pta, jpa, llrim0 )
+   SUBROUTINE bdy_rnf( idx, pt, jpa, llrim0 )
       !!----------------------------------------------------------------------
       !!                 ***  SUBROUTINE bdy_rnf  ***
@@ -116,15 +118,14 @@
       !!----------------------------------------------------------------------
       TYPE(OBC_INDEX),                     INTENT(in) ::   idx      ! OBC indices
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pta      ! tracer trend
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt       ! tracer trend
       INTEGER,                             INTENT(in) ::   jpa      ! TRA index
       LOGICAL,                             INTENT(in) ::   llrim0   ! indicate if rim 0 is treated
       !
       INTEGER  ::   ib, ii, ij, igrd   ! dummy loop indices
-      INTEGER  ::   ik, ip, jp ! 2D addresses
       !!----------------------------------------------------------------------
       !
       igrd = 1                       ! Everything is at T-points here
       IF(      jpa == jp_tem ) THEN
-         CALL bdy_nmn( idx, igrd, pta, llrim0 )
+         CALL bdy_nmn( idx, igrd, pt, llrim0 )
       ELSE IF( jpa == jp_sal ) THEN
          IF( .NOT. llrim0 )   RETURN
@@ -132,5 +133,5 @@
             ii = idx%nbi(ib,igrd)
             ij = idx%nbj(ib,igrd)
-            pta(ii,ij,1:jpkm1) = 0.1 * tmask(ii,ij,1:jpkm1)
+            pt(ii,ij,1:jpkm1) = 0.1 * tmask(ii,ij,1:jpkm1)
          END DO
       END IF
@@ -139,5 +140,5 @@
 
 
-   SUBROUTINE bdy_tra_dmp( kt )
+   SUBROUTINE bdy_tra_dmp( kt, Kbb, pts, Krhs )
       !!----------------------------------------------------------------------
       !!                 ***  SUBROUTINE bdy_tra_dmp  ***
@@ -146,5 +147,7 @@
       !! 
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   !
+      INTEGER                                  , INTENT(in)    :: kt        ! time step
+      INTEGER                                  , INTENT(in)    :: Kbb, Krhs ! time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts       ! active tracers and RHS of tracer equation
       !
       REAL(wp) ::   zwgt           ! boundary weight
@@ -165,8 +168,8 @@
                zwgt = idx_bdy(ib_bdy)%nbd(ib,igrd)
                DO ik = 1, jpkm1
-                  zta = zwgt * ( dta_bdy(ib_bdy)%tem(ib,ik) - tsb(ii,ij,ik,jp_tem) ) * tmask(ii,ij,ik)
-                  zsa = zwgt * ( dta_bdy(ib_bdy)%sal(ib,ik) - tsb(ii,ij,ik,jp_sal) ) * tmask(ii,ij,ik)
-                  tsa(ii,ij,ik,jp_tem) = tsa(ii,ij,ik,jp_tem) + zta
-                  tsa(ii,ij,ik,jp_sal) = tsa(ii,ij,ik,jp_sal) + zsa
+                  zta = zwgt * ( dta_bdy(ib_bdy)%tem(ib,ik) - pts(ii,ij,ik,jp_tem,Kbb) ) * tmask(ii,ij,ik)
+                  zsa = zwgt * ( dta_bdy(ib_bdy)%sal(ib,ik) - pts(ii,ij,ik,jp_sal,Kbb) ) * tmask(ii,ij,ik)
+                  pts(ii,ij,ik,jp_tem,Krhs) = pts(ii,ij,ik,jp_tem,Krhs) + zta
+                  pts(ii,ij,ik,jp_sal,Krhs) = pts(ii,ij,ik,jp_sal,Krhs) + zsa
                END DO
             END DO
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/BDY/bdyvol.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/BDY/bdyvol.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/BDY/bdyvol.F90	(revision 12928)
@@ -14,7 +14,7 @@
    USE bdy_oce        ! ocean open boundary conditions
    USE sbc_oce        ! ocean surface boundary conditions
+   USE isf_oce, ONLY : fwfisf_cav, fwfisf_par  ! ice shelf
    USE dom_oce        ! ocean space and time domain 
    USE phycst         ! physical constants
-   USE sbcisf         ! ice shelf
    !
    USE in_out_manager ! I/O manager
@@ -77,5 +77,5 @@
       ! Calculate the cumulate surface Flux z_cflxemp (m3/s) over all the domain
       ! -----------------------------------------------------------------------
-      IF ( kc == 1 ) z_cflxemp = glob_sum( 'bdyvol', ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:)  ) / rau0
+      IF ( kc == 1 ) z_cflxemp = glob_sum( 'bdyvol', ( emp(:,:) - rnf(:,:) + fwfisf_cav(:,:) + fwfisf_par(:,:) ) * bdytmask(:,:) * e1e2t(:,:)  ) / rho0
 
       ! Compute bdy surface each cycle if non linear free surface
@@ -143,5 +143,5 @@
       ! Check the cumulated transport through unstructured OBC once barotropic velocities corrected
       ! ------------------------------------------------------
-      IF( MOD( kt, nn_write ) == 0 .AND. ( kc == 1 ) ) THEN
+      IF( MOD( kt, MAX(nn_write,1) ) == 0 .AND. ( kc == 1 ) ) THEN
          !
          ! compute residual transport across boundary
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/C1D/c1d.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/C1D/c1d.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/C1D/c1d.F90	(revision 12928)
@@ -50,9 +50,7 @@
       !!----------------------------------------------------------------------
       !
-      REWIND( numnam_ref )              ! Namelist namc1d in reference namelist : Tracer advection scheme
       READ  ( numnam_ref, namc1d, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d in reference namelist' )
       !
-      REWIND( numnam_cfg )              ! Namelist namtra_adv in configuration namelist : Tracer advection scheme
       READ  ( numnam_cfg, namc1d, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namc1d in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/C1D/dtauvd.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/C1D/dtauvd.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/C1D/dtauvd.F90	(revision 12928)
@@ -31,4 +31,6 @@
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_uvd   ! structure for input U & V current (file information and data)
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -60,9 +62,7 @@
       ierr0 = 0   ;   ierr1 = 0   ;   ierr2 = 0  ;   ierr3 = 0
 
-      REWIND( numnam_ref )              ! Namelist namc1d_uvd in reference namelist : 
       READ  ( numnam_ref, namc1d_uvd, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d_uvd in reference namelist' )
       !
-      REWIND( numnam_cfg )              ! Namelist namc1d_uvd in configuration namelist : Parameters of the run
       READ  ( numnam_cfg, namc1d_uvd, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namc1d_uvd in configuration namelist' )
@@ -117,5 +117,5 @@
 
 
-   SUBROUTINE dta_uvd( kt, puvd )
+   SUBROUTINE dta_uvd( kt, Kmm, puvd )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE dta_uvd  ***
@@ -133,4 +133,5 @@
       !!----------------------------------------------------------------------
       INTEGER                           , INTENT(in   ) ::   kt     ! ocean time-step
+      INTEGER                           , INTENT(in   ) ::   Kmm    ! time level index
       REAL(wp), DIMENSION(jpi,jpj,jpk,2), INTENT(  out) ::   puvd   ! U & V current data
       !
@@ -157,32 +158,30 @@
          ENDIF
          !
-         DO jj = 1, jpj                   ! vertical interpolation of U & V current:
-            DO ji = 1, jpi                ! determines the interpolated U & V current profiles at each (i,j) point
-               DO jk = 1, jpk
-                  zl = gdept_n(ji,jj,jk)
-                  IF    ( zl < gdept_1d(1  ) ) THEN          ! extrapolate above the first level of data
-                     zup(jk) =  puvd(ji,jj,1    ,1)
-                     zvp(jk) =  puvd(ji,jj,1    ,2)
-                  ELSEIF( zl > gdept_1d(jpk) ) THEN          ! extrapolate below the last level of data
-                     zup(jk) =  puvd(ji,jj,jpkm1,1)
-                     zvp(jk) =  puvd(ji,jj,jpkm1,2)
-                  ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1
-                     DO jkk = 1, jpkm1                      ! when  gdept(jkk) < zl < gdept(jkk+1)
-                        IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN
-                           zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk))
-                           zup(jk) = puvd(ji,jj,jkk,1) + ( puvd(ji,jj,jkk+1,1 ) - puvd(ji,jj,jkk,1) ) * zi 
-                           zvp(jk) = puvd(ji,jj,jkk,2) + ( puvd(ji,jj,jkk+1,2 ) - puvd(ji,jj,jkk,2) ) * zi
-                        ENDIF
-                     END DO
-                  ENDIF
-               END DO
-               DO jk = 1, jpkm1           ! apply mask
-                  puvd(ji,jj,jk,1) = zup(jk) * umask(ji,jj,jk)
-                  puvd(ji,jj,jk,2) = zvp(jk) * vmask(ji,jj,jk)
-               END DO
-               puvd(ji,jj,jpk,1) = 0._wp
-               puvd(ji,jj,jpk,2) = 0._wp
+         DO_2D_11_11
+            DO jk = 1, jpk
+               zl = gdept(ji,jj,jk,Kmm)
+               IF    ( zl < gdept_1d(1  ) ) THEN          ! extrapolate above the first level of data
+                  zup(jk) =  puvd(ji,jj,1    ,1)
+                  zvp(jk) =  puvd(ji,jj,1    ,2)
+               ELSEIF( zl > gdept_1d(jpk) ) THEN          ! extrapolate below the last level of data
+                  zup(jk) =  puvd(ji,jj,jpkm1,1)
+                  zvp(jk) =  puvd(ji,jj,jpkm1,2)
+               ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1
+                  DO jkk = 1, jpkm1                      ! when  gdept(jkk) < zl < gdept(jkk+1)
+                     IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN
+                        zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk))
+                        zup(jk) = puvd(ji,jj,jkk,1) + ( puvd(ji,jj,jkk+1,1 ) - puvd(ji,jj,jkk,1) ) * zi 
+                        zvp(jk) = puvd(ji,jj,jkk,2) + ( puvd(ji,jj,jkk+1,2 ) - puvd(ji,jj,jkk,2) ) * zi
+                     ENDIF
+                  END DO
+               ENDIF
             END DO
-         END DO
+            DO jk = 1, jpkm1           ! apply mask
+               puvd(ji,jj,jk,1) = zup(jk) * umask(ji,jj,jk)
+               puvd(ji,jj,jk,2) = zvp(jk) * vmask(ji,jj,jk)
+            END DO
+            puvd(ji,jj,jpk,1) = 0._wp
+            puvd(ji,jj,jpk,2) = 0._wp
+         END_2D
          ! 
          DEALLOCATE( zup, zvp )
@@ -194,14 +193,12 @@
          !
          IF( ln_zps ) THEN                ! zps-coordinate (partial steps) interpolation at the last ocean level
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  ik = mbkt(ji,jj) 
-                  IF( ik > 1 ) THEN
-                     zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
-                     puvd(ji,jj,ik,1) = (1.-zl) * puvd(ji,jj,ik,1) + zl * puvd(ji,jj,ik-1,1)
-                     puvd(ji,jj,ik,2) = (1.-zl) * puvd(ji,jj,ik,2) + zl * puvd(ji,jj,ik-1,2)
-                  ENDIF
-               END DO
-            END DO
+            DO_2D_11_11
+               ik = mbkt(ji,jj) 
+               IF( ik > 1 ) THEN
+                  zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
+                  puvd(ji,jj,ik,1) = (1.-zl) * puvd(ji,jj,ik,1) + zl * puvd(ji,jj,ik-1,1)
+                  puvd(ji,jj,ik,2) = (1.-zl) * puvd(ji,jj,ik,2) + zl * puvd(ji,jj,ik-1,2)
+               ENDIF
+            END_2D
          ENDIF
          !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/C1D/dyncor_c1d.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/C1D/dyncor_c1d.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/C1D/dyncor_c1d.F90	(revision 12928)
@@ -31,5 +31,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -56,5 +56,5 @@
 
 
-   SUBROUTINE dyn_cor_c1d( kt )
+   SUBROUTINE dyn_cor_c1d( kt, Kmm, puu, pvv, Krhs )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE dyn_cor_c1d  ***
@@ -63,5 +63,7 @@
       !!               the general trend of the momentum equation in 1D case.
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      INTEGER                             , INTENT(in   ) ::   kt        ! ocean time-step index
+      INTEGER                             , INTENT(in   ) ::   Kmm, Krhs ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::   puu, pvv  ! ocean velocities and RHS of momentum equation
       !!
       INTEGER ::   ji, jj, jk   ! dummy loop indices
@@ -75,26 +77,18 @@
       !
       IF( ln_stcor ) THEN
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ua(ji,jj,jk) = ua(ji,jj,jk) + ff_t(ji,jj) * (vn(ji,jj,jk) + vsd(ji,jj,jk))
-                  va(ji,jj,jk) = va(ji,jj,jk) - ff_t(ji,jj) * (un(ji,jj,jk) + usd(ji,jj,jk))
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + ff_t(ji,jj) * (pvv(ji,jj,jk,Kmm) + vsd(ji,jj,jk))
+            pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ff_t(ji,jj) * (puu(ji,jj,jk,Kmm) + usd(ji,jj,jk))
+         END_3D
       ELSE
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ua(ji,jj,jk) = ua(ji,jj,jk) + ff_t(ji,jj) * vn(ji,jj,jk)
-                  va(ji,jj,jk) = va(ji,jj,jk) - ff_t(ji,jj) * un(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + ff_t(ji,jj) * pvv(ji,jj,jk,Kmm)
+            pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ff_t(ji,jj) * puu(ji,jj,jk,Kmm)
+         END_3D
       END IF
       
       !
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' cor  - Ua: ', mask1=umask,  &
-         &                       tab3d_2=va, clinfo2=' Va: '       , mask2=vmask )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' cor  - Ua: ', mask1=umask,  &
+         &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=' Va: '       , mask2=vmask )
       !
    END SUBROUTINE dyn_cor_c1d
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/C1D/dyndmp.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/C1D/dyndmp.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/C1D/dyndmp.F90	(revision 12928)
@@ -43,5 +43,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -79,8 +79,6 @@
       !!----------------------------------------------------------------------
       !
-      REWIND( numnam_ref )              ! Namelist namc1d_dyndmp in reference namelist : 
       READ  ( numnam_ref, namc1d_dyndmp, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d_dyndmp in reference namelist' )
-      REWIND( numnam_cfg )              ! Namelist namc1d_dyndmp in configuration namelist : Parameters of the run
       READ  ( numnam_cfg, namc1d_dyndmp, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namc1d_dyndmp in configuration namelist' )
@@ -130,5 +128,5 @@
 
 
-   SUBROUTINE dyn_dmp( kt )
+   SUBROUTINE dyn_dmp( kt, Kbb, Kmm, puu, pvv, Krhs )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE dyn_dmp  ***
@@ -140,13 +138,15 @@
       !! ** Method  :   Compute Newtonian damping towards u_dta and v_dta 
       !!      and add to the general momentum trends:
-      !!                     ua = ua + resto_uv * (u_dta - ub)
-      !!                     va = va + resto_uv * (v_dta - vb)
+      !!                     puu(Krhs) = puu(Krhs) + resto_uv * (u_dta - puu(Kbb))
+      !!                     pvv(Krhs) = pvv(Krhs) + resto_uv * (v_dta - pvv(Kbb))
       !!      The trend is computed either throughout the water column
       !!      (nn_zdmp=0), where the vertical mixing is weak (nn_zdmp=1) or
       !!      below the well mixed layer (nn_zdmp=2)
       !!
-      !! ** Action  : - (ua,va)   momentum trends updated with the damping trend
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !! ** Action  : - (puu(:,:,:,Krhs),pvv(:,:,:,Krhs))   momentum trends updated with the damping trend
+      !!----------------------------------------------------------------------
+      INTEGER                             , INTENT(in   ) ::   kt             ! ocean time-step index
+      INTEGER                             , INTENT(in   ) ::   Kbb, Kmm, Krhs ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::   puu, pvv       ! ocean velocities and RHS of momentum equation
       !!
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -159,5 +159,5 @@
       !
       !                           !==   read and interpolate U & V current data at kt   ==!
-      CALL dta_uvd( kt, zuv_dta ) !!! NOTE: This subroutine must be altered for use outside
+      CALL dta_uvd( kt, Kmm, zuv_dta ) !!! NOTE: This subroutine must be altered for use outside
                                   !!!       the C1D context (use of U,V grid variables)
       !
@@ -165,60 +165,48 @@
       !
       CASE( 0 )                   ! Newtonian damping throughout the water column
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zua = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,1) - ub(ji,jj,jk) )
-                  zva = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,2) - vb(ji,jj,jk) )
-                  ua(ji,jj,jk) = ua(ji,jj,jk) + zua
-                  va(ji,jj,jk) = va(ji,jj,jk) + zva
-                  utrdmp(ji,jj,jk) = zua           ! save the trends
-                  vtrdmp(ji,jj,jk) = zva      
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            zua = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,1) - puu(ji,jj,jk,Kbb) )
+            zva = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,2) - pvv(ji,jj,jk,Kbb) )
+            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + zua
+            pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + zva
+            utrdmp(ji,jj,jk) = zua           ! save the trends
+            vtrdmp(ji,jj,jk) = zva      
+         END_3D
          !
       CASE ( 1 )                  ! no damping above the turbocline (avt > 5 cm2/s)
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  IF( avt(ji,jj,jk) <= avt_c ) THEN
-                     zua = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,1) - ub(ji,jj,jk) )
-                     zva = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,2) - vb(ji,jj,jk) )
-                  ELSE
-                     zua = 0._wp
-                     zva = 0._wp  
-                  ENDIF
-                  ua(ji,jj,jk) = ua(ji,jj,jk) + zua
-                  va(ji,jj,jk) = va(ji,jj,jk) + zva
-                  utrdmp(ji,jj,jk) = zua           ! save the trends
-                  vtrdmp(ji,jj,jk) = zva
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            IF( avt(ji,jj,jk) <= avt_c ) THEN
+               zua = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,1) - puu(ji,jj,jk,Kbb) )
+               zva = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,2) - pvv(ji,jj,jk,Kbb) )
+            ELSE
+               zua = 0._wp
+               zva = 0._wp  
+            ENDIF
+            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + zua
+            pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + zva
+            utrdmp(ji,jj,jk) = zua           ! save the trends
+            vtrdmp(ji,jj,jk) = zva
+         END_3D
          !
       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( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN
-                     zua = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,1) - ub(ji,jj,jk) )
-                     zva = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,2) - vb(ji,jj,jk) )
-                  ELSE
-                     zua = 0._wp
-                     zva = 0._wp  
-                  ENDIF
-                  ua(ji,jj,jk) = ua(ji,jj,jk) + zua
-                  va(ji,jj,jk) = va(ji,jj,jk) + zva
-                  utrdmp(ji,jj,jk) = zua           ! save the trends
-                  vtrdmp(ji,jj,jk) = zva
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN
+               zua = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,1) - puu(ji,jj,jk,Kbb) )
+               zva = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,2) - pvv(ji,jj,jk,Kbb) )
+            ELSE
+               zua = 0._wp
+               zva = 0._wp  
+            ENDIF
+            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + zua
+            pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + zva
+            utrdmp(ji,jj,jk) = zua           ! save the trends
+            vtrdmp(ji,jj,jk) = zva
+         END_3D
          !
       END SELECT
       !
       !                           ! Control print
-      IF( ln_ctl   )   CALL prt_ctl( tab3d_1=ua(:,:,:), clinfo1=' dmp  - Ua: ', mask1=umask,   &
-         &                           tab3d_2=va(:,:,:), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      IF( sn_cfctl%l_prtctl   )   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' dmp  - Ua: ', mask1=umask,   &
+         &                                      tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
       !
       !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/C1D/step_c1d.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/C1D/step_c1d.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/C1D/step_c1d.F90	(revision 12928)
@@ -6,4 +6,5 @@
    !! History :   2.0  !  2004-04  (C. Ethe)  adapted from step.F90 for C1D
    !!             3.0  !  2008-04  (G. Madec)  redo the adaptation to include SBC
+   !!             4.1  !  2019-08  (A. Coward, D. Storkey) rewrite in preparation for new timestepping scheme
    !!----------------------------------------------------------------------
 #if defined key_c1d
@@ -14,9 +15,10 @@
    !!----------------------------------------------------------------------
    USE step_oce        ! time stepping definition modules 
+   USE step, ONLY : Nbb, Nnn, Naa, Nrhs ! time level indices
 #if defined key_top
    USE trcstp          ! passive tracer time-stepping      (trc_stp routine)
 #endif
    USE dyncor_c1d      ! Coriolis term (c1d case)         (dyn_cor_1d     )
-   USE dynnxt          ! time-stepping                    (dyn_nxt routine)
+   USE dynatf          ! time filtering                   (dyn_atf routine)
    USE dyndmp          ! U & V momentum damping           (dyn_dmp routine)
    USE restart         ! restart 
@@ -25,5 +27,5 @@
    PRIVATE
 
-   PUBLIC stp_c1d      ! called by opa.F90
+   PUBLIC stp_c1d      ! called by nemogcm.F90
 
    !!----------------------------------------------------------------------
@@ -68,26 +70,26 @@
       ! Update data, open boundaries, surface boundary condition (including sea-ice)
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-                         CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice)
+                         CALL sbc    ( kstp, Nbb, Nnn )  ! Sea Boundary Condition (including sea-ice)
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! Ocean physics update                (ua, va, ta, sa used as workspace)
+      ! Ocean physics update        
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-                         CALL eos_rab( tsb, rab_b )   ! before local thermal/haline expension ratio at T-points
-                         CALL eos_rab( tsn, rab_n )   ! now    local thermal/haline expension ratio at T-points
-                         CALL bn2( tsb, rab_b, rn2b ) ! before Brunt-Vaisala frequency
-                         CALL bn2( tsn, rab_n, rn2  ) ! now    Brunt-Vaisala frequency
+                         CALL eos_rab( ts(:,:,:,:,Nbb), rab_b, Nnn )  ! before local thermal/haline expension ratio at T-points
+                         CALL eos_rab( ts(:,:,:,:,Nnn), rab_n, Nnn )  ! now    local thermal/haline expension ratio at T-points
+                         CALL bn2( ts(:,:,:,:,Nbb), rab_b, rn2b, Nnn ) ! before Brunt-Vaisala frequency
+                         CALL bn2( ts(:,:,:,:,Nnn), rab_n, rn2 , Nnn ) ! now    Brunt-Vaisala frequency
       
       !  VERTICAL PHYSICS
-                         CALL zdf_phy( kstp )         ! vertical physics update (bfr, avt, avs, avm + MLD)
+                         CALL zdf_phy( kstp, Nbb, Nnn, Nrhs  )    ! vertical physics update (bfr, avt, avs, avm + MLD)
 
-      IF(.NOT.ln_linssh )   CALL ssh_nxt       ( kstp )  ! after ssh (includes call to div_hor)
-      IF(.NOT.ln_linssh )   CALL dom_vvl_sf_nxt( kstp )  ! after vertical scale factors 
+      IF(.NOT.ln_linssh )   CALL ssh_nxt       ( kstp, Nbb, Nnn, ssh, Naa )  ! after ssh (includes call to div_hor)
+      IF(.NOT.ln_linssh )   CALL dom_vvl_sf_nxt( kstp, Nbb, Nnn,      Naa )  ! after vertical scale factors 
 
-      IF(.NOT.ln_linssh )   CALL wzv           ( kstp )  ! now cross-level velocity 
+      IF(.NOT.ln_linssh )   CALL wzv           ( kstp, Nbb, Nnn, ww,  Naa )  ! now cross-level velocity 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! diagnostics and outputs             (ua, va, ta, sa used as workspace)
+      ! diagnostics and outputs       
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-                         CALL dia_wri( kstp )       ! ocean model: outputs
-      IF( ll_diahth  )   CALL dia_hth( kstp )       ! Thermocline depth (20°C)
+                         CALL dia_wri( kstp, Nnn )  ! ocean model: outputs
+                         CALL dia_hth( kstp, Nnn )  ! Thermocline depth (20°C)
 
 
@@ -96,45 +98,49 @@
       ! Passive Tracer Model
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-                        CALL trc_stp( kstp )       ! time-stepping
+                        CALL trc_stp( kstp, Nbb, Nnn, Nrhs, Naa  )   ! time-stepping
 #endif
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! Active tracers                              (ua, va used as workspace)
+      ! Active tracers                              (uu(:,:,:,Nrhs), vv(:,:,:,Nrhs) used as workspace)
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-                        tsa(:,:,:,:) = 0._wp       ! set tracer trends to zero
+                        ts(:,:,:,:,Nrhs) = 0._wp       ! set tracer trends to zero
 
-                        CALL tra_sbc( kstp )       ! surface boundary condition
-      IF( ln_traqsr )   CALL tra_qsr( kstp )       ! penetrative solar radiation qsr
-      IF( ln_tradmp )   CALL tra_dmp( kstp )       ! internal damping trends- tracers
-      IF(.NOT.ln_linssh)CALL tra_adv( kstp )       ! horizontal & vertical advection
-      IF( ln_zdfosm  )  CALL tra_osm( kstp )       ! OSMOSIS non-local tracer fluxes
-                        CALL tra_zdf( kstp )       ! vertical mixing
-                        CALL eos( tsn, rhd, rhop, gdept_0(:,:,:) )   ! now potential density for zdfmxl
-      IF( ln_zdfnpc )   CALL tra_npc( kstp )       ! applied non penetrative convective adjustment on (t,s)
-                        CALL tra_nxt( kstp )       ! tracer fields at next time step
-
-
+                        CALL tra_sbc( kstp,      Nnn, ts, Nrhs  )  ! surface boundary condition
+      IF( ln_traqsr )   CALL tra_qsr( kstp,      Nnn, ts, Nrhs  )  ! penetrative solar radiation qsr
+      IF( ln_tradmp )   CALL tra_dmp( kstp, Nbb, Nnn, ts, Nrhs  )  ! internal damping trends- tracers
+      IF(.NOT.ln_linssh)CALL tra_adv( kstp, Nbb, Nnn, ts, Nrhs  )  ! horizontal & vertical advection
+      IF( ln_zdfosm  )  CALL tra_osm( kstp, Nnn     , ts, Nrhs  )  ! OSMOSIS non-local tracer fluxes
+                        CALL tra_zdf( kstp, Nbb, Nnn, Nrhs, ts, Naa   )         ! vertical mixing
+                        CALL eos( ts(:,:,:,:,Nnn), rhd, rhop, gdept_0(:,:,:) )  ! now potential density for zdfmxl
+      IF( ln_zdfnpc )   CALL tra_npc( kstp,      Nnn, Nrhs, ts, Naa   )         ! applied non penetrative convective adjustment on (t,s)
+                        CALL tra_atf( kstp, Nbb, Nnn, Naa, ts )                 ! time filtering of "now" tracer arrays
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
       ! Dynamics                                    (ta, sa used as workspace)
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-                        ua(:,:,:) = 0._wp          ! set dynamics trends to zero
-                        va(:,:,:) = 0._wp
+                        uu(:,:,:,Nrhs) = 0._wp          ! set dynamics trends to zero
+                        vv(:,:,:,Nrhs) = 0._wp
 
-      IF( ln_dyndmp )   CALL dyn_dmp    ( kstp )   ! internal damping trends- momentum
-                        CALL dyn_cor_c1d( kstp )   ! vorticity term including Coriolis
-      IF( ln_zdfosm  )  CALL dyn_osm    ( kstp )   ! OSMOSIS non-local velocity fluxes
-                        CALL dyn_zdf    ( kstp )   ! vertical diffusion
-                        CALL dyn_nxt    ( kstp )   ! lateral velocity at next time step
-      IF(.NOT.ln_linssh)CALL ssh_swp    ( kstp )   ! swap of sea surface height
-
-      IF(.NOT.ln_linssh)CALL dom_vvl_sf_swp( kstp )! swap of vertical scale factors
+      IF( ln_dyndmp )   CALL dyn_dmp    ( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! internal damping trends- momentum
+                        CALL dyn_cor_c1d( kstp,      Nnn      , uu, vv, Nrhs )  ! vorticity term including Coriolis
+      IF( ln_zdfosm  )  CALL dyn_osm    ( kstp,      Nnn      , uu, vv, Nrhs )  ! OSMOSIS non-local velocity fluxes
+                        CALL dyn_zdf    ( kstp, Nbb, Nnn, Nrhs, uu, vv, Naa  )  ! vertical diffusion
+                        CALL dyn_atf    ( kstp, Nbb, Nnn, Naa , uu, vv, e3t, e3u, e3v )  ! time filtering of "now" fields
+      IF(.NOT.ln_linssh)CALL ssh_atf    ( kstp, Nbb, Nnn, Naa , ssh )                    ! time filtering of "now" sea surface height
+      !
+      ! Swap time levels
+      Nrhs = Nbb
+      Nbb = Nnn
+      Nnn = Naa
+      Naa = Nrhs
+      !
+      IF(.NOT.ln_linssh)CALL dom_vvl_sf_update( kstp, Nbb, Nnn, Naa )                    ! update of vertical scale factors
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
       ! Control and restarts
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-                             CALL stp_ctl( kstp, indic )
-      IF( kstp == nit000 )   CALL iom_close( numror )      ! close input  ocean restart file
-      IF( lrst_oce       )   CALL rst_write( kstp )        ! write output ocean restart file
+                             CALL stp_ctl( kstp, Nbb, Nnn, indic )
+      IF( kstp == nit000 )   CALL iom_close( numror )          ! close input  ocean restart file
+      IF( lrst_oce       )   CALL rst_write( kstp, Nbb, Nnn )  ! write output ocean restart file
       !
 #if defined key_iomput
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/CRS/README.rst
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/CRS/README.rst	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/CRS/README.rst	(revision 12928)
@@ -2,4 +2,8 @@
 On line biogeochemistry coarsening
 **********************************
+
+.. todo::
+
+
 
 .. contents::
@@ -63,6 +67,6 @@
 	                           ! 1, MAX of KZ
 	                           ! 2, MIN of KZ
-	                           ! 3, 10^(MEAN(LOG(KZ)) 
-	                           ! 4, MEDIANE of KZ 
+	                           ! 3, 10^(MEAN(LOG(KZ))
+	                           ! 4, MEDIANE of KZ
 	   ln_crs_wn   = .false.   ! wn coarsened (T) or computed using horizontal divergence ( F )
 	                           !                           !
@@ -73,5 +77,5 @@
   the north-fold lateral boundary condition (ORCA025, ORCA12, ORCA36, ...).
 - ``nn_msh_crs = 1`` will activate the generation of the coarsened grid meshmask.
-- ``nn_crs_kz`` is the operator to coarsen the vertical mixing coefficient. 
+- ``nn_crs_kz`` is the operator to coarsen the vertical mixing coefficient.
 - ``ln_crs_wn``
 
@@ -80,5 +84,5 @@
   - when ``key_vvl`` is not activated,
 
-    - coarsened vertical velocities are computed using horizontal divergence (``ln_crs_wn = .false.``) 
+    - coarsened vertical velocities are computed using horizontal divergence (``ln_crs_wn = .false.``)
     - or coarsened vertical velocities are computed with an average operator (``ln_crs_wn = .true.``)
 - ``ln_crs_top = .true.``: should be activated to run BCG model in coarsened space;
@@ -97,5 +101,5 @@
 
 In the [attachment:iodef.xml iodef.xml]  file, a "nemo" context is defined and
-some variable defined in [attachment:file_def.xml file_def.xml] are writted on the ocean-dynamic grid.  
+some variable defined in [attachment:file_def.xml file_def.xml] are writted on the ocean-dynamic grid.
 To write variables on the coarsened grid, and in particular the passive tracers,
 a "nemo_crs" context should be defined in [attachment:iodef.xml iodef.xml] and
@@ -111,5 +115,5 @@
   interpolated `on-the-fly <http://forge.ipsl.jussieu.fr/nemo/wiki/Users/SetupNewConfiguration/Weight-creator>`_.
   Example of namelist for PISCES :
-  
+
 	.. code-block:: fortran
 
@@ -134,5 +138,5 @@
 	   	rn_trfac(14)  =   1.0e-06  !  -      -      -     -
 		   rn_trfac(23)  =   7.6e-06  !  -      -      -     -
-		
+
 	   	cn_dir        =  './'      !  root directory for the location of the data files
 
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/CRS/crsdomwri.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/CRS/crsdomwri.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/CRS/crsdomwri.F90	(revision 12928)
@@ -155,5 +155,5 @@
       DO jk = 1,jpk   
          DO jj = 1, jpj_crsm1   
-            DO ji = 1, jpi_crsm1  ! jes what to do for fs_jpim1??vector opt.
+            DO ji = 1, jpi_crsm1  ! jes what to do for jpim1??vector opt.
                zdepu(ji,jj,jk) = MIN( gdept_crs(ji,jj,jk) , gdept_crs(ji+1,jj  ,jk) ) * umask_crs(ji,jj,jk)
                zdepv(ji,jj,jk) = MIN( gdept_crs(ji,jj,jk) , gdept_crs(ji  ,jj+1,jk) ) * vmask_crs(ji,jj,jk)
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/CRS/crsfld.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/CRS/crsfld.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/CRS/crsfld.F90	(revision 12928)
@@ -32,5 +32,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -40,5 +40,5 @@
 CONTAINS
 
-   SUBROUTINE crs_fld( kt )
+   SUBROUTINE crs_fld( kt, Kmm )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE crs_fld  ***
@@ -54,4 +54,5 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER, INTENT(in) ::   Kmm  ! time level index
       !
       INTEGER  ::   ji, jj, jk        ! dummy loop indices
@@ -67,8 +68,8 @@
 
       ! Depth work arrrays
-      ze3t(:,:,:) = e3t_n(:,:,:)
-      ze3u(:,:,:) = e3u_n(:,:,:)
-      ze3v(:,:,:) = e3v_n(:,:,:)
-      ze3w(:,:,:) = e3w_n(:,:,:)
+      ze3t(:,:,:) = e3t(:,:,:,Kmm)
+      ze3u(:,:,:) = e3u(:,:,:,Kmm)
+      ze3v(:,:,:) = e3v(:,:,:,Kmm)
+      ze3w(:,:,:) = e3w(:,:,:,Kmm)
 
       IF( kt == nit000  ) THEN
@@ -96,5 +97,5 @@
 
       !  Temperature
-      zt(:,:,:) = tsn(:,:,:,jp_tem)  ;      zt_crs(:,:,:) = 0._wp
+      zt(:,:,:) = ts(:,:,:,jp_tem,Kmm)  ;      zt_crs(:,:,:) = 0._wp
       CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 )
       tsn_crs(:,:,:,jp_tem) = zt_crs(:,:,:)
@@ -105,5 +106,5 @@
       
       !  Salinity
-      zs(:,:,:) = tsn(:,:,:,jp_sal)  ;      zs_crs(:,:,:) = 0._wp
+      zs(:,:,:) = ts(:,:,:,jp_sal,Kmm)  ;      zs_crs(:,:,:) = 0._wp
       CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 )
       tsn_crs(:,:,:,jp_sal) = zt_crs(:,:,:)
@@ -113,15 +114,11 @@
 
       !  U-velocity
-      CALL crs_dom_ope( un, 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
+      CALL crs_dom_ope( uu(:,:,:,Kmm), 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
       !
       zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1   
-               zt(ji,jj,jk)  = un(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
-               zs(ji,jj,jk)  = un(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 1, jpkm1 )
+         zt(ji,jj,jk)  = uu(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji+1,jj,jk,jp_tem,Kmm) ) 
+         zs(ji,jj,jk)  = uu(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji+1,jj,jk,jp_sal,Kmm) ) 
+      END_3D
       CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
       CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
@@ -132,15 +129,11 @@
 
       !  V-velocity
-      CALL crs_dom_ope( vn, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
+      CALL crs_dom_ope( vv(:,:,:,Kmm), 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
       !                                                                                 
       zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1   
-               zt(ji,jj,jk)  = vn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 
-               zs(ji,jj,jk)  = vn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 1, jpkm1 )
+         zt(ji,jj,jk)  = vv(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji,jj+1,jk,jp_tem,Kmm) ) 
+         zs(ji,jj,jk)  = vv(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji,jj+1,jk,jp_sal,Kmm) ) 
+      END_3D
       CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
       CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
@@ -152,16 +145,12 @@
       IF( iom_use( "eken") ) THEN     !      kinetic energy
          z3d(:,:,jk) = 0._wp 
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zztmp  = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
-                  z3d(ji,jj,jk) = 0.25_wp * zztmp * (                                    &
-                     &            un(ji-1,jj,jk)**2 * e2u(ji-1,jj) * e3u_n(ji-1,jj,jk)   &
-                     &          + un(ji  ,jj,jk)**2 * e2u(ji  ,jj) * e3u_n(ji  ,jj,jk)   &
-                     &          + vn(ji,jj-1,jk)**2 * e1v(ji,jj-1) * e3v_n(ji,jj-1,jk)   &
-                     &          + vn(ji,jj  ,jk)**2 * e1v(ji,jj  ) * e3v_n(ji,jj  ,jk)   )
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            zztmp  = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+            z3d(ji,jj,jk) = 0.25_wp * zztmp * (                                    &
+               &            uu(ji-1,jj,jk,Kmm)**2 * e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm)   &
+               &          + uu(ji  ,jj,jk,Kmm)**2 * e2u(ji  ,jj) * e3u(ji  ,jj,jk,Kmm)   &
+               &          + vv(ji,jj-1,jk,Kmm)**2 * e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm)   &
+               &          + vv(ji,jj  ,jk,Kmm)**2 * e1v(ji,jj  ) * e3v(ji,jj  ,jk,Kmm)   )
+         END_3D
          CALL lbc_lnk( 'crsfld', z3d, 'T', 1. )
          !
@@ -191,6 +180,6 @@
       !  W-velocity
       IF( ln_crs_wn ) THEN
-         CALL crs_dom_ope( wn, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0 )
-       !  CALL crs_dom_ope( wn, 'VOL', 'W', tmask, wn_crs, p_e12=e1e2t, p_e3=ze3w )
+         CALL crs_dom_ope( ww, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0 )
+       !  CALL crs_dom_ope( ww, 'VOL', 'W', tmask, wn_crs, p_e12=e1e2t, p_e3=ze3w )
       ELSE
         wn_crs(:,:,jpk) = 0._wp
@@ -219,5 +208,5 @@
       
       !  sbc fields  
-      CALL crs_dom_ope( sshn , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=ze3t           , psgn=1.0 )  
+      CALL crs_dom_ope( ssh(:,:,Kmm) , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=ze3t           , psgn=1.0 )  
       CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u  , p_surf_crs=e2u_crs  , psgn=1.0 )
       CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v  , p_surf_crs=e1v_crs  , psgn=1.0 )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/CRS/crsini.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/CRS/crsini.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/CRS/crsini.F90	(revision 12928)
@@ -35,5 +35,5 @@
 CONTAINS
    
-   SUBROUTINE crs_init 
+   SUBROUTINE crs_init( Kmm )
       !!-------------------------------------------------------------------
       !!                     *** SUBROUTINE crs_init
@@ -68,4 +68,6 @@
       !!               - Read in pertinent data ?
       !!-------------------------------------------------------------------
+      INTEGER, INTENT(in) :: Kmm   ! time level index
+      !
       INTEGER  :: ji,jj,jk      ! dummy indices
       INTEGER  :: ierr                                ! allocation error status
@@ -80,8 +82,6 @@
      !---------------------------------------------------------
      !
-      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
       READ  ( numnam_ref, namcrs, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcrs in reference namelist' )
-      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
       READ  ( numnam_cfg, namcrs, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcrs in configuration namelist' )
@@ -98,5 +98,5 @@
         WRITE(numout,*) '      create a mesh file (=T)               ln_msh_crs = ', ln_msh_crs
         WRITE(numout,*) '      type of Kz coarsening (0,1,2)         nn_crs_kz  = ', nn_crs_kz
-        WRITE(numout,*) '      wn coarsened or computed using hdivn  ln_crs_wn  = ', ln_crs_wn
+        WRITE(numout,*) '      ww coarsened or computed using hdiv  ln_crs_wn  = ', ln_crs_wn
      ENDIF
               
@@ -174,8 +174,8 @@
      
      !
-     ze3t(:,:,:) = e3t_n(:,:,:)
-     ze3u(:,:,:) = e3u_n(:,:,:)
-     ze3v(:,:,:) = e3v_n(:,:,:)
-     ze3w(:,:,:) = e3w_n(:,:,:)
+     ze3t(:,:,:) = e3t(:,:,:,Kmm)
+     ze3u(:,:,:) = e3u(:,:,:,Kmm)
+     ze3v(:,:,:) = e3v(:,:,:,Kmm)
+     ze3w(:,:,:) = e3w(:,:,:,Kmm)
 
      !    3.d.2   Surfaces 
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/dia25h.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/dia25h.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/dia25h.F90	(revision 12928)
@@ -39,5 +39,5 @@
 CONTAINS
 
-   SUBROUTINE dia_25h_init 
+   SUBROUTINE dia_25h_init( Kbb )
       !!---------------------------------------------------------------------------
       !!                  ***  ROUTINE dia_25h_init  ***
@@ -47,4 +47,6 @@
       !! ** Method : Read namelist
       !!---------------------------------------------------------------------------
+      INTEGER, INTENT(in) :: Kbb       ! Time level index
+      !
       INTEGER ::   ios                 ! Local integer output status for namelist read
       INTEGER ::   ierror              ! Local integer for memory allocation
@@ -53,8 +55,6 @@
       !!----------------------------------------------------------------------
       !
-      REWIND ( numnam_ref )              ! Read Namelist nam_dia25h in reference namelist : 25hour mean diagnostics
       READ   ( numnam_ref, nam_dia25h, IOSTAT=ios, ERR= 901 )
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_dia25h in reference namelist' )
-      REWIND( numnam_cfg )              ! Namelist nam_dia25h in configuration namelist  25hour diagnostics
       READ  ( numnam_cfg, nam_dia25h, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nam_dia25h in configuration namelist' )
@@ -95,9 +95,9 @@
       ! ------------------------- !
       cnt_25h = 1  ! sets the first value of sum at timestep 1 (note - should strictly be at timestep zero so before values used where possible) 
-      tn_25h  (:,:,:) = tsb (:,:,:,jp_tem)
-      sn_25h  (:,:,:) = tsb (:,:,:,jp_sal)
-      sshn_25h(:,:)   = sshb(:,:)
-      un_25h  (:,:,:) = ub  (:,:,:)
-      vn_25h  (:,:,:) = vb  (:,:,:)
+      tn_25h  (:,:,:) = ts (:,:,:,jp_tem,Kbb)
+      sn_25h  (:,:,:) = ts (:,:,:,jp_sal,Kbb)
+      sshn_25h(:,:)   = ssh(:,:,Kbb)
+      un_25h  (:,:,:) = uu  (:,:,:,Kbb)
+      vn_25h  (:,:,:) = vv  (:,:,:,Kbb)
       avt_25h (:,:,:) = avt (:,:,:)
       avm_25h (:,:,:) = avm (:,:,:)
@@ -116,5 +116,5 @@
 
 
-   SUBROUTINE dia_25h( kt )  
+   SUBROUTINE dia_25h( kt, Kmm )  
       !!----------------------------------------------------------------------
       !!                 ***  ROUTINE dia_25h  ***
@@ -125,4 +125,5 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER, INTENT(in) ::   Kmm  ! ocean time level index
       !!
       INTEGER ::   ji, jj, jk
@@ -139,8 +140,8 @@
       ! -----------------
       ! Define frequency of summing to create 25 h mean
-      IF( MOD( 3600,NINT(rdt) ) == 0 ) THEN
-         i_steps = 3600/NINT(rdt)
+      IF( MOD( 3600,NINT(rn_Dt) ) == 0 ) THEN
+         i_steps = 3600/NINT(rn_Dt)
       ELSE
-         CALL ctl_stop('STOP', 'dia_wri_tide: timestep must give MOD(3600,rdt) = 0 otherwise no hourly values are possible')
+         CALL ctl_stop('STOP', 'dia_wri_tide: timestep must give MOD(3600,rn_Dt) = 0 otherwise no hourly values are possible')
       ENDIF
 
@@ -150,5 +151,5 @@
       ! wn_25h could not be initialised in dia_25h_init, so we do it here instead
       IF( kt == nn_it000 ) THEN
-         wn_25h(:,:,:) = wn(:,:,:)
+         wn_25h(:,:,:) = ww(:,:,:)
       ENDIF
 
@@ -161,10 +162,10 @@
          ENDIF
 
-         tn_25h  (:,:,:)     = tn_25h  (:,:,:) + tsn (:,:,:,jp_tem)
-         sn_25h  (:,:,:)     = sn_25h  (:,:,:) + tsn (:,:,:,jp_sal)
-         sshn_25h(:,:)       = sshn_25h(:,:)   + sshn(:,:)
-         un_25h  (:,:,:)     = un_25h  (:,:,:) + un  (:,:,:)
-         vn_25h  (:,:,:)     = vn_25h  (:,:,:) + vn  (:,:,:)
-         wn_25h  (:,:,:)     = wn_25h  (:,:,:) + wn  (:,:,:)
+         tn_25h  (:,:,:)     = tn_25h  (:,:,:) + ts (:,:,:,jp_tem,Kmm)
+         sn_25h  (:,:,:)     = sn_25h  (:,:,:) + ts (:,:,:,jp_sal,Kmm)
+         sshn_25h(:,:)       = sshn_25h(:,:)   + ssh(:,:,Kmm)
+         un_25h  (:,:,:)     = un_25h  (:,:,:) + uu  (:,:,:,Kmm)
+         vn_25h  (:,:,:)     = vn_25h  (:,:,:) + vv  (:,:,:,Kmm)
+         wn_25h  (:,:,:)     = wn_25h  (:,:,:) + ww  (:,:,:)
          avt_25h (:,:,:)     = avt_25h (:,:,:) + avt (:,:,:)
          avm_25h (:,:,:)     = avm_25h (:,:,:) + avm (:,:,:)
@@ -245,10 +246,10 @@
          !
          ! After the write reset the values to cnt=1 and sum values equal current value 
-         tn_25h  (:,:,:) = tsn (:,:,:,jp_tem)
-         sn_25h  (:,:,:) = tsn (:,:,:,jp_sal)
-         sshn_25h(:,:)   = sshn(:,:)
-         un_25h  (:,:,:) = un  (:,:,:)
-         vn_25h  (:,:,:) = vn  (:,:,:)
-         wn_25h  (:,:,:) = wn  (:,:,:)
+         tn_25h  (:,:,:) = ts (:,:,:,jp_tem,Kmm)
+         sn_25h  (:,:,:) = ts (:,:,:,jp_sal,Kmm)
+         sshn_25h(:,:)   = ssh(:,:,Kmm)
+         un_25h  (:,:,:) = uu  (:,:,:,Kmm)
+         vn_25h  (:,:,:) = vv  (:,:,:,Kmm)
+         wn_25h  (:,:,:) = ww  (:,:,:)
          avt_25h (:,:,:) = avt (:,:,:)
          avm_25h (:,:,:) = avm (:,:,:)
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/diaar5.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/diaar5.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/diaar5.F90	(revision 12928)
@@ -32,5 +32,4 @@
    REAL(wp)                         ::   vol0         ! ocean volume (interior domain)
    REAL(wp)                         ::   area_tot     ! total ocean surface (interior domain)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   area         ! cell surface (interior domain)
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   thick0       ! ocean thickness (interior domain)
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sn0          ! initial salinity
@@ -39,5 +38,5 @@
       
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -54,5 +53,5 @@
       !!----------------------------------------------------------------------
       !
-      ALLOCATE( area(jpi,jpj), thick0(jpi,jpj) , sn0(jpi,jpj,jpk) , STAT=dia_ar5_alloc )
+      ALLOCATE( thick0(jpi,jpj) , sn0(jpi,jpj,jpk) , STAT=dia_ar5_alloc )
       !
       CALL mpp_sum ( 'diaar5', dia_ar5_alloc )
@@ -62,5 +61,5 @@
 
 
-   SUBROUTINE dia_ar5( kt )
+   SUBROUTINE dia_ar5( kt, Kmm )
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE dia_ar5  ***
@@ -70,12 +69,13 @@
       !
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
-      !
-      INTEGER  ::   ji, jj, jk                      ! dummy loop arguments
-      REAL(wp) ::   zvolssh, zvol, zssh_steric, zztmp, zarho, ztemp, zsal, zmass
+      INTEGER, INTENT( in ) ::   Kmm  ! ocean time level index
+      !
+      INTEGER  ::   ji, jj, jk, iks, ikb                      ! dummy loop arguments
+      REAL(wp) ::   zvolssh, zvol, zssh_steric, zztmp, zarho, ztemp, zsal, zmass, zsst
       REAL(wp) ::   zaw, zbw, zrw
       !
       REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: zarea_ssh , zbotpres       ! 2D workspace 
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: zpe                         ! 2D workspace 
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   :: zrhd , zrhop               ! 3D workspace
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: zpe, z2d                   ! 2D workspace 
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   :: zrhd , zrhop, ztpot   ! 3D workspace
       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztsn                       ! 4D workspace
 
@@ -86,19 +86,39 @@
 
       IF( l_ar5 ) THEN 
-         ALLOCATE( zarea_ssh(jpi,jpj) , zbotpres(jpi,jpj) )
+         ALLOCATE( zarea_ssh(jpi,jpj), zbotpres(jpi,jpj), z2d(jpi,jpj) )
          ALLOCATE( zrhd(jpi,jpj,jpk) , zrhop(jpi,jpj,jpk) )
          ALLOCATE( ztsn(jpi,jpj,jpk,jpts) )
-         zarea_ssh(:,:) = area(:,:) * sshn(:,:)
-      ENDIF
+         zarea_ssh(:,:) = e1e2t(:,:) * ssh(:,:,Kmm)
+      ENDIF
+      !
+      CALL iom_put( 'e2u'      , e2u  (:,:) )
+      CALL iom_put( 'e1v'      , e1v  (:,:) )
+      CALL iom_put( 'areacello', e1e2t(:,:) )
+      !
+      IF( iom_use( 'volcello' ) .OR. iom_use( 'masscello' )  ) THEN  
+         zrhd(:,:,jpk) = 0._wp        ! ocean volume ; rhd is used as workspace
+         DO jk = 1, jpkm1
+            zrhd(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk)
+         END DO
+         CALL iom_put( 'volcello'  , zrhd(:,:,:)  )  ! WARNING not consistent with CMIP DR where volcello is at ca. 2000
+         CALL iom_put( 'masscello' , rho0 * e3t(:,:,:,Kmm) * tmask(:,:,:) )  ! ocean mass
+      ENDIF 
+      !
+      IF( iom_use( 'e3tb' ) )  THEN    ! bottom layer thickness
+         DO_2D_11_11
+            ikb = mbkt(ji,jj)
+            z2d(ji,jj) = e3t(ji,jj,ikb,Kmm)
+         END_2D
+         CALL iom_put( 'e3tb', z2d )
+      ENDIF 
       !
       IF( iom_use( 'voltot' ) .OR. iom_use( 'sshtot' )  .OR. iom_use( 'sshdyn' )  ) THEN    
          !                                         ! total volume of liquid seawater
-         zvolssh = SUM( zarea_ssh(:,:) ) 
-         CALL mpp_sum( 'diaar5', zvolssh )
-         zvol = vol0 + zvolssh
+         zvolssh = glob_sum( 'diaar5', zarea_ssh(:,:) ) 
+         zvol    = vol0 + zvolssh
       
          CALL iom_put( 'voltot', zvol               )
          CALL iom_put( 'sshtot', zvolssh / area_tot )
-         CALL iom_put( 'sshdyn', sshn(:,:) - (zvolssh / area_tot) )
+         CALL iom_put( 'sshdyn', ssh(:,:,Kmm) - (zvolssh / area_tot) )
          !
       ENDIF
@@ -106,11 +126,11 @@
       IF( iom_use( 'botpres' ) .OR. iom_use( 'sshthster' )  .OR. iom_use( 'sshsteric' )  ) THEN    
          !                     
-         ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem)                    ! thermosteric ssh
+         ztsn(:,:,:,jp_tem) = ts(:,:,:,jp_tem,Kmm)                    ! thermosteric ssh
          ztsn(:,:,:,jp_sal) = sn0(:,:,:)
-         CALL eos( ztsn, zrhd, gdept_n(:,:,:) )                       ! now in situ density using initial salinity
+         CALL eos( ztsn, zrhd, gdept(:,:,:,Kmm) )                       ! now in situ density using initial salinity
          !
          zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice
          DO jk = 1, jpkm1
-            zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk)
+            zbotpres(:,:) = zbotpres(:,:) + e3t(:,:,jk,Kmm) * zrhd(:,:,jk)
          END DO
          IF( ln_linssh ) THEN
@@ -118,9 +138,10 @@
                DO ji = 1, jpi
                   DO jj = 1, jpj
-                     zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj)
+                     iks = mikt(ji,jj)
+                     zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * zrhd(ji,jj,iks) + riceload(ji,jj)
                   END DO
                END DO
             ELSE
-               zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1)
+               zbotpres(:,:) = zbotpres(:,:) + ssh(:,:,Kmm) * zrhd(:,:,1)
             END IF
 !!gm
@@ -129,11 +150,10 @@
          END IF
          !                                         
-         zarho = SUM( area(:,:) * zbotpres(:,:) ) 
-         CALL mpp_sum( 'diaar5', zarho )
+         zarho = glob_sum( 'diaar5', e1e2t(:,:) * zbotpres(:,:) ) 
          zssh_steric = - zarho / area_tot
          CALL iom_put( 'sshthster', zssh_steric )
       
          !                                         ! steric sea surface height
-         CALL eos( tsn, zrhd, zrhop, gdept_n(:,:,:) )                 ! now in situ and potential density
+         CALL eos( ts(:,:,:,:,Kmm), zrhd, zrhop, gdept(:,:,:,Kmm) )                 ! now in situ and potential density
          zrhop(:,:,jpk) = 0._wp
          CALL iom_put( 'rhop', zrhop )
@@ -141,5 +161,5 @@
          zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice
          DO jk = 1, jpkm1
-            zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk)
+            zbotpres(:,:) = zbotpres(:,:) + e3t(:,:,jk,Kmm) * zrhd(:,:,jk)
          END DO
          IF( ln_linssh ) THEN
@@ -147,20 +167,19 @@
                DO ji = 1,jpi
                   DO jj = 1,jpj
-                     zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj)
+                     iks = mikt(ji,jj)
+                     zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * zrhd(ji,jj,iks) + riceload(ji,jj)
                   END DO
                END DO
             ELSE
-               zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1)
+               zbotpres(:,:) = zbotpres(:,:) + ssh(:,:,Kmm) * zrhd(:,:,1)
             END IF
          END IF
          !    
-         zarho = SUM( area(:,:) * zbotpres(:,:) ) 
-         CALL mpp_sum( 'diaar5', zarho )
+         zarho = glob_sum( 'diaar5', e1e2t(:,:) * zbotpres(:,:) ) 
          zssh_steric = - zarho / area_tot
          CALL iom_put( 'sshsteric', zssh_steric )
-      
          !                                         ! ocean bottom pressure
-         zztmp = rau0 * grav * 1.e-4_wp               ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa
-         zbotpres(:,:) = zztmp * ( zbotpres(:,:) + sshn(:,:) + thick0(:,:) )
+         zztmp = rho0 * grav * 1.e-4_wp               ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa
+         zbotpres(:,:) = zztmp * ( zbotpres(:,:) + ssh(:,:,Kmm) + thick0(:,:) )
          CALL iom_put( 'botpres', zbotpres )
          !
@@ -168,82 +187,104 @@
 
       IF( iom_use( 'masstot' ) .OR. iom_use( 'temptot' )  .OR. iom_use( 'saltot' )  ) THEN    
-         !                                         ! Mean density anomalie, temperature and salinity
-         ztemp = 0._wp
-         zsal  = 0._wp
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zztmp = area(ji,jj) * e3t_n(ji,jj,jk)
-                  ztemp = ztemp + zztmp * tsn(ji,jj,jk,jp_tem)
-                  zsal  = zsal  + zztmp * tsn(ji,jj,jk,jp_sal)
-               END DO
-            END DO
-         END DO
-         IF( ln_linssh ) THEN
+          !                                         ! Mean density anomalie, temperature and salinity
+          ztsn(:,:,:,:) = 0._wp                    ! ztsn(:,:,1,jp_tem/sal) is used here as 2D Workspace for temperature & salinity
+          DO_3D_11_11( 1, jpkm1 )
+             zztmp = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm)
+             ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zztmp * ts(ji,jj,jk,jp_tem,Kmm)
+             ztsn(ji,jj,1,jp_sal) = ztsn(ji,jj,1,jp_sal) + zztmp * ts(ji,jj,jk,jp_sal,Kmm)
+          END_3D
+
+          IF( ln_linssh ) THEN
             IF( ln_isfcav ) THEN
                DO ji = 1, jpi
                   DO jj = 1, jpj
-                     ztemp = ztemp + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_tem) 
-                     zsal  = zsal  + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_sal) 
+                     iks = mikt(ji,jj)
+                     ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zarea_ssh(ji,jj) * ts(ji,jj,iks,jp_tem,Kmm) 
+                     ztsn(ji,jj,1,jp_sal) = ztsn(ji,jj,1,jp_sal) + zarea_ssh(ji,jj) * ts(ji,jj,iks,jp_sal,Kmm) 
                   END DO
                END DO
             ELSE
-               ztemp = ztemp + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_tem) )
-               zsal  = zsal  + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_sal) )
+               ztsn(:,:,1,jp_tem) = ztsn(:,:,1,jp_tem) + zarea_ssh(:,:) * ts(:,:,1,jp_tem,Kmm) 
+               ztsn(:,:,1,jp_sal) = ztsn(:,:,1,jp_sal) + zarea_ssh(:,:) * ts(:,:,1,jp_sal,Kmm) 
             END IF
          ENDIF
-         IF( lk_mpp ) THEN  
-            CALL mpp_sum( 'diaar5', ztemp )
-            CALL mpp_sum( 'diaar5', zsal  )
-         END IF
-         !
-         zmass = rau0 * ( zarho + zvol )                 ! total mass of liquid seawater
-         ztemp = ztemp / zvol                            ! potential temperature in liquid seawater
-         zsal  = zsal  / zvol                            ! Salinity of liquid seawater
+         !
+         ztemp = glob_sum( 'diaar5', ztsn(:,:,1,jp_tem) )
+         zsal  = glob_sum( 'diaar5', ztsn(:,:,1,jp_sal) )
+         zmass = rho0 * ( zarho + zvol )      
          !
          CALL iom_put( 'masstot', zmass )
-         CALL iom_put( 'temptot', ztemp )
-         CALL iom_put( 'saltot' , zsal  )
-         !
+         CALL iom_put( 'temptot', ztemp / zvol )
+         CALL iom_put( 'saltot' , zsal  / zvol )
+         !
+      ENDIF     
+
+      IF( ln_teos10 ) THEN        ! ! potential temperature (TEOS-10 case)
+         IF( iom_use( 'toce_pot') .OR. iom_use( 'temptot_pot' ) .OR. iom_use( 'sst_pot' )  &
+                                  .OR. iom_use( 'ssttot' ) .OR.  iom_use( 'tosmint_pot' ) ) THEN
+            !
+            ALLOCATE( ztpot(jpi,jpj,jpk) )
+            ztpot(:,:,jpk) = 0._wp
+            DO jk = 1, jpkm1
+               ztpot(:,:,jk) = eos_pt_from_ct( ts(:,:,jk,jp_tem,Kmm), ts(:,:,jk,jp_sal,Kmm) )
+            END DO
+            !
+            CALL iom_put( 'toce_pot', ztpot(:,:,:) )  ! potential temperature (TEOS-10 case)
+            CALL iom_put( 'sst_pot' , ztpot(:,:,1) )  ! surface temperature
+            !
+            IF( iom_use( 'temptot_pot' ) ) THEN   ! Output potential temperature in case we use TEOS-10
+               z2d(:,:) = 0._wp
+               DO jk = 1, jpkm1
+                 z2d(:,:) = z2d(:,:) + e1e2t(:,:) * e3t(:,:,jk,Kmm) * ztpot(:,:,jk)
+               END DO
+               ztemp = glob_sum( 'diaar5', z2d(:,:)  ) 
+               CALL iom_put( 'temptot_pot', ztemp / zvol )
+             ENDIF
+             !
+             IF( iom_use( 'ssttot' ) ) THEN   ! Output potential temperature in case we use TEOS-10
+               zsst = glob_sum( 'diaar5',  e1e2t(:,:) * ztpot(:,:,1)  ) 
+               CALL iom_put( 'ssttot', zsst / area_tot )
+             ENDIF
+             ! Vertical integral of temperature
+             IF( iom_use( 'tosmint_pot') ) THEN
+               z2d(:,:) = 0._wp
+               DO_3D_11_11( 1, jpkm1 )
+                  z2d(ji,jj) = z2d(ji,jj) + rho0 * e3t(ji,jj,jk,Kmm) *  ztpot(ji,jj,jk)
+               END_3D
+               CALL iom_put( 'tosmint_pot', z2d ) 
+            ENDIF
+            DEALLOCATE( ztpot )
+        ENDIF
+      ELSE       
+         IF( iom_use('ssttot') ) THEN   ! Output sst in case we use EOS-80
+            zsst  = glob_sum( 'diaar5', e1e2t(:,:) * ts(:,:,1,jp_tem,Kmm) )
+            CALL iom_put('ssttot', zsst / area_tot )
+         ENDIF
       ENDIF
 
       IF( iom_use( 'tnpeo' )) THEN    
-      ! Work done against stratification by vertical mixing
-      ! Exclude points where rn2 is negative as convection kicks in here and
-      ! work is not being done against stratification
+        ! Work done against stratification by vertical mixing
+        ! Exclude points where rn2 is negative as convection kicks in here and
+        ! work is not being done against stratification
          ALLOCATE( zpe(jpi,jpj) )
          zpe(:,:) = 0._wp
          IF( ln_zdfddm ) THEN
-            DO jk = 2, jpk
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     IF( rn2(ji,jj,jk) > 0._wp ) THEN
-                        zrw =   ( gdepw_n(ji,jj,jk  ) - gdept_n(ji,jj,jk) )   &
-                           &  / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) )
-!!gm  this can be reduced to :  (depw-dept) / e3w   (NB idem dans bn2 !)
-!                        zrw =   ( gdept_n(ji,jj,jk) - gdepw_n(ji,jj,jk) ) / e3w_n(ji,jj,jk)
-!!gm end
-                        !
-                        zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw
-                        zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw
-                        !
-                        zpe(ji, jj) = zpe(ji, jj)            &
-                           &        -  grav * (  avt(ji,jj,jk) * zaw * (tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) )  &
-                           &                   - avs(ji,jj,jk) * zbw * (tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) )
-                     ENDIF
-                  END DO
-               END DO
-             END DO
+            DO_3D_11_11( 2, jpk )
+               IF( rn2(ji,jj,jk) > 0._wp ) THEN
+                  zrw = ( gdept(ji,jj,jk,Kmm) - gdepw(ji,jj,jk,Kmm) ) / e3w(ji,jj,jk,Kmm)
+                  !
+                  zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw
+                  zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw
+                  !
+                  zpe(ji, jj) = zpe(ji,jj)   &
+                     &        -  grav * (  avt(ji,jj,jk) * zaw * (ts(ji,jj,jk-1,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm) )  &
+                     &                   - avs(ji,jj,jk) * zbw * (ts(ji,jj,jk-1,jp_sal,Kmm) - ts(ji,jj,jk,jp_sal,Kmm) ) )
+               ENDIF
+            END_3D
           ELSE
-            DO jk = 1, jpk
-               DO ji = 1, jpi
-                  DO jj = 1, jpj
-                     zpe(ji,jj) = zpe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rau0 * e3w_n(ji, jj, jk)
-                  END DO
-               END DO
-            END DO
+            DO_3D_11_11( 1, jpk )
+               zpe(ji,jj) = zpe(ji,jj) + avt(ji,jj,jk) * MIN(0._wp,rn2(ji,jj,jk)) * rho0 * e3w(ji,jj,jk,Kmm)
+            END_3D
          ENDIF
-!!gm useless lbc_lnk since the computation above is performed over 1:jpi & 1:jpj
-!!gm           CALL lbc_lnk( 'diaar5', zpe, 'T', 1._wp)         
           CALL iom_put( 'tnpeo', zpe )
           DEALLOCATE( zpe )
@@ -251,5 +292,5 @@
 
       IF( l_ar5 ) THEN
-        DEALLOCATE( zarea_ssh , zbotpres )
+        DEALLOCATE( zarea_ssh , zbotpres, z2d )
         DEALLOCATE( zrhd      , zrhop    )
         DEALLOCATE( ztsn                 )
@@ -261,5 +302,5 @@
 
 
-   SUBROUTINE dia_ar5_hst( ktra, cptr, pua, pva ) 
+   SUBROUTINE dia_ar5_hst( ktra, cptr, puflx, pvflx ) 
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE dia_ar5_htr ***
@@ -270,6 +311,6 @@
       INTEGER                         , INTENT(in )  :: ktra  ! tracer index
       CHARACTER(len=3)                , INTENT(in)   :: cptr  ! transport type  'adv'/'ldf'
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: pua   ! 3D input array of advection/diffusion
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: pva   ! 3D input array of advection/diffusion
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: puflx  ! u-flux of advection/diffusion
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: pvflx  ! v-flux of advection/diffusion
       !
       INTEGER    ::  ji, jj, jk
@@ -277,38 +318,30 @@
 
     
-      z2d(:,:) = pua(:,:,1) 
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               z2d(ji,jj) = z2d(ji,jj) + pua(ji,jj,jk) 
-            END DO
-         END DO
-       END DO
+      z2d(:,:) = puflx(:,:,1) 
+      DO_3D_00_00( 1, jpkm1 )
+         z2d(ji,jj) = z2d(ji,jj) + puflx(ji,jj,jk) 
+      END_3D
        CALL lbc_lnk( 'diaar5', z2d, 'U', -1. )
        IF( cptr == 'adv' ) THEN
-          IF( ktra == jp_tem ) CALL iom_put( "uadv_heattr" , rau0_rcp * z2d )  ! advective heat transport in i-direction
-          IF( ktra == jp_sal ) CALL iom_put( "uadv_salttr" , rau0     * z2d )  ! advective salt transport in i-direction
+          IF( ktra == jp_tem ) CALL iom_put( 'uadv_heattr' , rho0_rcp * z2d )  ! advective heat transport in i-direction
+          IF( ktra == jp_sal ) CALL iom_put( 'uadv_salttr' , rho0     * z2d )  ! advective salt transport in i-direction
        ENDIF
        IF( cptr == 'ldf' ) THEN
-          IF( ktra == jp_tem ) CALL iom_put( "udiff_heattr" , rau0_rcp * z2d ) ! diffusive heat transport in i-direction
-          IF( ktra == jp_sal ) CALL iom_put( "udiff_salttr" , rau0     * z2d ) ! diffusive salt transport in i-direction
+          IF( ktra == jp_tem ) CALL iom_put( 'udiff_heattr' , rho0_rcp * z2d ) ! diffusive heat transport in i-direction
+          IF( ktra == jp_sal ) CALL iom_put( 'udiff_salttr' , rho0     * z2d ) ! diffusive salt transport in i-direction
        ENDIF
        !
-       z2d(:,:) = pva(:,:,1) 
-       DO jk = 1, jpkm1
-          DO jj = 2, jpjm1
-             DO ji = fs_2, fs_jpim1   ! vector opt.
-                z2d(ji,jj) = z2d(ji,jj) + pva(ji,jj,jk) 
-             END DO
-          END DO
-       END DO
+       z2d(:,:) = pvflx(:,:,1) 
+       DO_3D_00_00( 1, jpkm1 )
+          z2d(ji,jj) = z2d(ji,jj) + pvflx(ji,jj,jk) 
+       END_3D
        CALL lbc_lnk( 'diaar5', z2d, 'V', -1. )
        IF( cptr == 'adv' ) THEN
-          IF( ktra == jp_tem ) CALL iom_put( "vadv_heattr" , rau0_rcp * z2d )  ! advective heat transport in j-direction
-          IF( ktra == jp_sal ) CALL iom_put( "vadv_salttr" , rau0     * z2d )  ! advective salt transport in j-direction
+          IF( ktra == jp_tem ) CALL iom_put( 'vadv_heattr' , rho0_rcp * z2d )  ! advective heat transport in j-direction
+          IF( ktra == jp_sal ) CALL iom_put( 'vadv_salttr' , rho0     * z2d )  ! advective salt transport in j-direction
        ENDIF
        IF( cptr == 'ldf' ) THEN
-          IF( ktra == jp_tem ) CALL iom_put( "vdiff_heattr" , rau0_rcp * z2d ) ! diffusive heat transport in j-direction
-          IF( ktra == jp_sal ) CALL iom_put( "vdiff_salttr" , rau0     * z2d ) ! diffusive salt transport in j-direction
+          IF( ktra == jp_tem ) CALL iom_put( 'vdiff_heattr' , rho0_rcp * z2d ) ! diffusive heat transport in j-direction
+          IF( ktra == jp_sal ) CALL iom_put( 'vdiff_salttr' , rho0     * z2d ) ! diffusive salt transport in j-direction
        ENDIF
           
@@ -323,8 +356,9 @@
       !!----------------------------------------------------------------------
       INTEGER  ::   inum
-      INTEGER  ::   ik
+      INTEGER  ::   ik, idep
       INTEGER  ::   ji, jj, jk  ! dummy loop indices
       REAL(wp) ::   zztmp  
       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   zsaldta   ! Jan/Dec levitus salinity
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     ::   zvol0     
       !
       !!----------------------------------------------------------------------
@@ -340,18 +374,19 @@
          IF( dia_ar5_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' )
 
-         area(:,:) = e1e2t(:,:) * tmask_i(:,:)
-
-         area_tot = SUM( area(:,:) )   ;   CALL mpp_sum( 'diaar5', area_tot )
-
-         vol0        = 0._wp
+         area_tot  = glob_sum( 'diaar5', e1e2t(:,:) )
+
+         ALLOCATE( zvol0(jpi,jpj) )
+         zvol0 (:,:) = 0._wp
          thick0(:,:) = 0._wp
-         DO jk = 1, jpkm1
-            vol0        = vol0        + SUM( area (:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) )
-            thick0(:,:) = thick0(:,:) +    tmask_i(:,:) * tmask(:,:,jk) * e3t_0(:,:,jk)
-         END DO
-         CALL mpp_sum( 'diaar5', vol0 )
+         DO_3D_11_11( 1, jpkm1 )
+            idep = tmask(ji,jj,jk) * e3t_0(ji,jj,jk)
+            zvol0 (ji,jj) = zvol0 (ji,jj) +  idep * e1e2t(ji,jj)
+            thick0(ji,jj) = thick0(ji,jj) +  idep    
+         END_3D
+         vol0 = glob_sum( 'diaar5', zvol0 )
+         DEALLOCATE( zvol0 )
 
          IF( iom_use( 'sshthster' ) ) THEN
-            ALLOCATE( zsaldta(jpi,jpj,jpj,jpts) )
+            ALLOCATE( zsaldta(jpi,jpj,jpk,jpts) )
             CALL iom_open ( 'sali_ref_clim_monthly', inum )
             CALL iom_get  ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1  )
@@ -362,13 +397,11 @@
             sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:)
             IF( ln_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 = mbkt(ji,jj)
-                     IF( ik > 1 ) THEN
-                        zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
-                        sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1)
-                     ENDIF
-                  END DO
-               END DO
+               DO_2D_11_11
+                  ik = mbkt(ji,jj)
+                  IF( ik > 1 ) THEN
+                     zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
+                     sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1)
+                  ENDIF
+               END_2D
             ENDIF
             !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/diacfl.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/diacfl.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/diacfl.F90	(revision 12928)
@@ -33,5 +33,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -41,5 +41,5 @@
 CONTAINS
 
-   SUBROUTINE dia_cfl ( kt )
+   SUBROUTINE dia_cfl ( kt, Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dia_cfl  ***
@@ -49,7 +49,8 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER, INTENT(in) ::   Kmm  ! ocean time level index
       !
       INTEGER                          ::   ji, jj, jk                       ! dummy loop indices
-      REAL(wp)                         ::   z2dt, zCu_max, zCv_max, zCw_max  ! local scalars
+      REAL(wp)                         ::   zCu_max, zCv_max, zCw_max        ! local scalars
       INTEGER , DIMENSION(3)           ::   iloc_u , iloc_v , iloc_w , iloc  ! workspace
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zCu_cfl, zCv_cfl, zCw_cfl        ! workspace
@@ -58,19 +59,9 @@
       IF( ln_timing )   CALL timing_start('dia_cfl')
       !
-      !                       ! setup timestep multiplier to account for initial Eulerian timestep
-      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;    z2dt = rdt
-      ELSE                                        ;    z2dt = rdt * 2._wp
-      ENDIF
-      !
-      !                
-      DO jk = 1, jpk       ! calculate Courant numbers
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zCu_cfl(ji,jj,jk) = ABS( un(ji,jj,jk) ) * z2dt / e1u  (ji,jj)      ! for i-direction
-               zCv_cfl(ji,jj,jk) = ABS( vn(ji,jj,jk) ) * z2dt / e2v  (ji,jj)      ! for j-direction
-               zCw_cfl(ji,jj,jk) = ABS( wn(ji,jj,jk) ) * z2dt / e3w_n(ji,jj,jk)   ! for k-direction
-            END DO
-         END DO         
-      END DO
+      DO_3D_11_11( 1, jpk )
+         zCu_cfl(ji,jj,jk) = ABS( uu(ji,jj,jk,Kmm) ) * rDt / e1u  (ji,jj)      ! for i-direction
+         zCv_cfl(ji,jj,jk) = ABS( vv(ji,jj,jk,Kmm) ) * rDt / e2v  (ji,jj)      ! for j-direction
+         zCw_cfl(ji,jj,jk) = ABS( ww(ji,jj,jk) ) * rDt / e3w(ji,jj,jk,Kmm)   ! for k-direction
+      END_3D
       !
       ! write outputs
@@ -121,11 +112,11 @@
          WRITE(numcfl,*) '******************************************'
          WRITE(numcfl,FMT='(3x,a12,6x,f7.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cu', rCu_max, nCu_loc(1), nCu_loc(2), nCu_loc(3)
-         WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', z2dt/rCu_max
+         WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', rDt/rCu_max
          WRITE(numcfl,*) '******************************************'
          WRITE(numcfl,FMT='(3x,a12,6x,f7.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cv', rCv_max, nCv_loc(1), nCv_loc(2), nCv_loc(3)
-         WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', z2dt/rCv_max
+         WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', rDt/rCv_max
          WRITE(numcfl,*) '******************************************'
          WRITE(numcfl,FMT='(3x,a12,6x,f7.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cw', rCw_max, nCw_loc(1), nCw_loc(2), nCw_loc(3)
-         WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', z2dt/rCw_max
+         WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', rDt/rCw_max
          CLOSE( numcfl ) 
          !
@@ -134,7 +125,7 @@
          WRITE(numout,*) 'dia_cfl : Maximum Courant number information for the run '
          WRITE(numout,*) '~~~~~~~'
-         WRITE(numout,*) '   Max Cu = ', rCu_max, ' at (i,j,k) = (',nCu_loc(1),nCu_loc(2),nCu_loc(3),') => dt/C = ', z2dt/rCu_max
-         WRITE(numout,*) '   Max Cv = ', rCv_max, ' at (i,j,k) = (',nCv_loc(1),nCv_loc(2),nCv_loc(3),') => dt/C = ', z2dt/rCv_max
-         WRITE(numout,*) '   Max Cw = ', rCw_max, ' at (i,j,k) = (',nCw_loc(1),nCw_loc(2),nCw_loc(3),') => dt/C = ', z2dt/rCw_max
+         WRITE(numout,*) '   Max Cu = ', rCu_max, ' at (i,j,k) = (',nCu_loc(1),nCu_loc(2),nCu_loc(3),') => dt/C = ', rDt/rCu_max
+         WRITE(numout,*) '   Max Cv = ', rCv_max, ' at (i,j,k) = (',nCv_loc(1),nCv_loc(2),nCv_loc(3),') => dt/C = ', rDt/rCv_max
+         WRITE(numout,*) '   Max Cw = ', rCw_max, ' at (i,j,k) = (',nCw_loc(1),nCw_loc(2),nCw_loc(3),') => dt/C = ', rDt/rCw_max
       ENDIF
       !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/diadct.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/diadct.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/diadct.F90	(revision 12928)
@@ -123,9 +123,7 @@
       !!---------------------------------------------------------------------
 
-     REWIND( numnam_ref )              ! Namelist nam_diadct in reference namelist : Diagnostic: transport through sections
      READ  ( numnam_ref, nam_diadct, IOSTAT = ios, ERR = 901)
 901  IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diadct in reference namelist' )
 
-     REWIND( numnam_cfg )              ! Namelist nam_diadct in configuration namelist : Diagnostic: transport through sections
      READ  ( numnam_cfg, nam_diadct, IOSTAT = ios, ERR = 902 )
 902  IF( ios >  0 ) CALL ctl_nam ( ios , 'nam_diadct in configuration namelist' )
@@ -175,5 +173,5 @@
  
  
-  SUBROUTINE dia_dct( kt )
+  SUBROUTINE dia_dct( kt, Kmm )
      !!---------------------------------------------------------------------
      !!               ***  ROUTINE diadct  ***  
@@ -192,5 +190,6 @@
      !!               Reinitialise all relevant arrays to zero 
      !!---------------------------------------------------------------------
-     INTEGER, INTENT(in) ::   kt
+     INTEGER, INTENT(in) ::   kt    ! ocean time step
+     INTEGER, INTENT(in) ::   Kmm   ! time level index
      !
      INTEGER ::   jsec              ! loop on sections
@@ -232,5 +231,5 @@
 
            !Compute transport through section  
-           CALL transport(secs(jsec),lldebug,jsec) 
+           CALL transport(Kmm,secs(jsec),lldebug,jsec) 
 
         ENDDO
@@ -246,5 +245,5 @@
            ! Sum over each class 
            DO jsec=1,nb_sec 
-              CALL dia_dct_sum(secs(jsec),jsec) 
+              CALL dia_dct_sum(Kmm,secs(jsec),jsec) 
            ENDDO 
 
@@ -558,5 +557,5 @@
 
 
-   SUBROUTINE transport(sec,ld_debug,jsec)
+   SUBROUTINE transport(Kmm,sec,ld_debug,jsec)
      !!-------------------------------------------------------------------------------------------
      !!                     ***  ROUTINE transport  ***
@@ -578,4 +577,5 @@
      !!
      !!-------------------------------------------------------------------------------------------
+     INTEGER      ,INTENT(IN)    :: Kmm         ! time level index
      TYPE(SECTION),INTENT(INOUT) :: sec
      LOGICAL      ,INTENT(IN)    :: ld_debug
@@ -673,25 +673,25 @@
             SELECT CASE( sec%direction(jseg) )
                CASE(0,1) 
-                  ztn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_tem) ) 
-                  zsn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_sal) ) 
-                  zrhop = interp(k%I,k%J,jk,'V',rhop) 
-                  zrhoi = interp(k%I,k%J,jk,'V',rhd*rau0+rau0) 
-                  zsshn =  0.5*( sshn(k%I,k%J) + sshn(k%I,k%J+1)    ) * vmask(k%I,k%J,1) 
+                  ztn   = interp(Kmm,k%I,k%J,jk,'V',ts(:,:,:,jp_tem,Kmm) ) 
+                  zsn   = interp(Kmm,k%I,k%J,jk,'V',ts(:,:,:,jp_sal,Kmm) ) 
+                  zrhop = interp(Kmm,k%I,k%J,jk,'V',rhop) 
+                  zrhoi = interp(Kmm,k%I,k%J,jk,'V',rhd*rho0+rho0) 
+                  zsshn =  0.5*( ssh(k%I,k%J,Kmm) + ssh(k%I,k%J+1,Kmm)    ) * vmask(k%I,k%J,1) 
                CASE(2,3) 
-                  ztn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_tem) ) 
-                  zsn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_sal) ) 
-                  zrhop = interp(k%I,k%J,jk,'U',rhop) 
-                  zrhoi = interp(k%I,k%J,jk,'U',rhd*rau0+rau0) 
-                  zsshn =  0.5*( sshn(k%I,k%J) + sshn(k%I+1,k%J)    ) * umask(k%I,k%J,1)  
+                  ztn   = interp(Kmm,k%I,k%J,jk,'U',ts(:,:,:,jp_tem,Kmm) ) 
+                  zsn   = interp(Kmm,k%I,k%J,jk,'U',ts(:,:,:,jp_sal,Kmm) ) 
+                  zrhop = interp(Kmm,k%I,k%J,jk,'U',rhop) 
+                  zrhoi = interp(Kmm,k%I,k%J,jk,'U',rhd*rho0+rho0) 
+                  zsshn =  0.5*( ssh(k%I,k%J,Kmm) + ssh(k%I+1,k%J,Kmm)    ) * umask(k%I,k%J,1)  
                END SELECT 
                !
-               zdep= gdept_n(k%I,k%J,jk) 
+               zdep= gdept(k%I,k%J,jk,Kmm) 
   
                SELECT CASE( sec%direction(jseg) )                !compute velocity with the correct direction 
                CASE(0,1)   
                   zumid=0._wp
-                  zvmid=isgnv*vn(k%I,k%J,jk)*vmask(k%I,k%J,jk) 
+                  zvmid=isgnv*vv(k%I,k%J,jk,Kmm)*vmask(k%I,k%J,jk) 
                CASE(2,3) 
-                  zumid=isgnu*un(k%I,k%J,jk)*umask(k%I,k%J,jk) 
+                  zumid=isgnu*uu(k%I,k%J,jk,Kmm)*umask(k%I,k%J,jk) 
                   zvmid=0._wp
                END SELECT 
@@ -699,6 +699,6 @@
                !zTnorm=transport through one cell; 
                !velocity* cell's length * cell's thickness 
-               zTnorm = zumid*e2u(k%I,k%J) * e3u_n(k%I,k%J,jk)     & 
-                  &   + zvmid*e1v(k%I,k%J) * e3v_n(k%I,k%J,jk) 
+               zTnorm = zumid*e2u(k%I,k%J) * e3u(k%I,k%J,jk,Kmm)     & 
+                  &   + zvmid*e1v(k%I,k%J) * e3v(k%I,k%J,jk,Kmm) 
 
 !!gm  THIS is WRONG  no transport due to ssh in linear free surface case !!!!!
@@ -765,5 +765,5 @@
 
 
-  SUBROUTINE dia_dct_sum(sec,jsec) 
+  SUBROUTINE dia_dct_sum(Kmm,sec,jsec) 
      !!------------------------------------------------------------- 
      !! Purpose: Average the transport over nn_dctwri time steps  
@@ -784,4 +784,5 @@
      !! 
      !!------------------------------------------------------------- 
+     INTEGER      ,INTENT(IN)    :: Kmm         ! time level index
      TYPE(SECTION),INTENT(INOUT) :: sec 
      INTEGER      ,INTENT(IN)    :: jsec        ! numeric identifier of section 
@@ -845,18 +846,18 @@
               SELECT CASE( sec%direction(jseg) ) 
               CASE(0,1) 
-                 ztn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_tem) ) 
-                 zsn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_sal) ) 
-                 zrhop = interp(k%I,k%J,jk,'V',rhop) 
-                 zrhoi = interp(k%I,k%J,jk,'V',rhd*rau0+rau0) 
+                 ztn   = interp(Kmm,k%I,k%J,jk,'V',ts(:,:,:,jp_tem,Kmm) ) 
+                 zsn   = interp(Kmm,k%I,k%J,jk,'V',ts(:,:,:,jp_sal,Kmm) ) 
+                 zrhop = interp(Kmm,k%I,k%J,jk,'V',rhop) 
+                 zrhoi = interp(Kmm,k%I,k%J,jk,'V',rhd*rho0+rho0) 
 
               CASE(2,3) 
-                 ztn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_tem) ) 
-                 zsn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_sal) ) 
-                 zrhop = interp(k%I,k%J,jk,'U',rhop) 
-                 zrhoi = interp(k%I,k%J,jk,'U',rhd*rau0+rau0) 
-                 zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I+1,k%J)    ) * umask(k%I,k%J,1)  
+                 ztn   = interp(Kmm,k%I,k%J,jk,'U',ts(:,:,:,jp_tem,Kmm) ) 
+                 zsn   = interp(Kmm,k%I,k%J,jk,'U',ts(:,:,:,jp_sal,Kmm) ) 
+                 zrhop = interp(Kmm,k%I,k%J,jk,'U',rhop) 
+                 zrhoi = interp(Kmm,k%I,k%J,jk,'U',rhd*rho0+rho0) 
+                 zsshn =  0.5*( ssh(k%I,k%J,Kmm)    + ssh(k%I+1,k%J,Kmm)    ) * umask(k%I,k%J,1)  
               END SELECT 
  
-              zdep= gdept_n(k%I,k%J,jk) 
+              zdep= gdept(k%I,k%J,jk,Kmm) 
   
               !------------------------------- 
@@ -1101,5 +1102,5 @@
 
 
-   FUNCTION interp(ki, kj, kk, cd_point, ptab)
+   FUNCTION interp(Kmm, ki, kj, kk, cd_point, ptab)
   !!----------------------------------------------------------------------
   !!
@@ -1162,4 +1163,5 @@
   !!----------------------------------------------------------------------
   !*arguments
+  INTEGER, INTENT(IN)                          :: Kmm          ! time level index
   INTEGER, INTENT(IN)                          :: ki, kj, kk   ! coordinate of point
   CHARACTER(len=1), INTENT(IN)                 :: cd_point     ! type of point (U, V)
@@ -1196,7 +1198,7 @@
   IF( ln_sco )THEN   ! s-coordinate case
 
-     zdepu = ( gdept_n(ii1,ij1,kk) +  gdept_n(ii2,ij2,kk) ) * 0.5_wp 
-     zdep1 = gdept_n(ii1,ij1,kk) - zdepu
-     zdep2 = gdept_n(ii2,ij2,kk) - zdepu
+     zdepu = ( gdept(ii1,ij1,kk,Kmm) +  gdept(ii2,ij2,kk,Kmm) ) * 0.5_wp 
+     zdep1 = gdept(ii1,ij1,kk,Kmm) - zdepu
+     zdep2 = gdept(ii2,ij2,kk,Kmm) - zdepu
 
      ! weights
@@ -1210,7 +1212,7 @@
   ELSE       ! full step or partial step case 
 
-     ze3t  = e3t_n(ii2,ij2,kk) - e3t_n(ii1,ij1,kk) 
-     zwgt1 = ( e3w_n(ii2,ij2,kk) - e3w_n(ii1,ij1,kk) ) / e3w_n(ii2,ij2,kk)
-     zwgt2 = ( e3w_n(ii1,ij1,kk) - e3w_n(ii2,ij2,kk) ) / e3w_n(ii1,ij1,kk)
+     ze3t  = e3t(ii2,ij2,kk,Kmm) - e3t(ii1,ij1,kk,Kmm) 
+     zwgt1 = ( e3w(ii2,ij2,kk,Kmm) - e3w(ii1,ij1,kk,Kmm) ) / e3w(ii2,ij2,kk,Kmm)
+     zwgt2 = ( e3w(ii1,ij1,kk,Kmm) - e3w(ii2,ij2,kk,Kmm) ) / e3w(ii1,ij1,kk,Kmm)
 
      IF(kk .NE. 1)THEN
@@ -1245,7 +1247,10 @@
       IMPLICIT NONE
    END SUBROUTINE dia_dct_init
-   SUBROUTINE dia_dct( kt )
+
+   SUBROUTINE dia_dct( kt, Kmm )         ! Dummy routine
       IMPLICIT NONE
-      INTEGER, INTENT(in) ::   kt
+      INTEGER, INTENT( in ) :: kt   ! ocean time-step index
+      INTEGER, INTENT( in ) :: Kmm  ! ocean time level index
+      WRITE(*,*) 'dia_dct: You should not have seen this print! error?', kt
    END SUBROUTINE dia_dct
    !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/diadetide.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/diadetide.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/diadetide.F90	(revision 12928)
@@ -0,0 +1,112 @@
+MODULE diadetide
+   !!======================================================================
+   !!                      ***  MODULE diadetide  ***
+   !! Computation of weights for daily detided model diagnostics
+   !!======================================================================
+   !! History :       !  2019  (S. Mueller)
+   !!----------------------------------------------------------------------
+   USE par_oce        , ONLY :   wp, jpi, jpj
+   USE in_out_manager , ONLY :   lwp, numout
+   USE iom            , ONLY :   iom_put
+   USE dom_oce        , ONLY :   rn_Dt, nsec_day
+   USE phycst         , ONLY :   rpi
+   USE tide_mod
+#if defined key_iomput
+   USE xios
+#endif
+
+   IMPLICIT NONE
+   PRIVATE
+
+   LOGICAL, PUBLIC                               ::   lk_diadetide
+   INTEGER                                       ::   ndiadetide
+   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::   tdiadetide
+
+   PUBLIC ::   dia_detide_init, dia_detide
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2019)
+   !! $Id$
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dia_detide_init
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE dia_detide_init  ***
+      !!
+      !! ** Purpose : initialisation of the weight computation for daily
+      !!              detided diagnostics (currently M2-detiding only)
+      !!
+      !!----------------------------------------------------------------------
+
+      REAL(wp)                                   ::   zdt
+      INTEGER                                    ::   jn
+      CHARACTER (LEN=4), DIMENSION(jpmax_harmo)  ::   ctide_selected = ' n/a '
+      TYPE(tide_harmonic), DIMENSION(:), POINTER ::   stideconst
+
+      lk_diadetide = .FALSE.
+#if defined key_iomput
+      ! Enquire detiding activation state (test for presence of detiding-related
+      ! weights field and output file group)
+      IF ( xios_is_valid_field( "diadetide_weight" ).AND.xios_is_valid_filegroup( "diadetide_files" ).AND.ln_tide ) THEN
+         lk_diadetide = .TRUE.
+      END IF
+#endif
+
+      IF (lwp) THEN
+         WRITE (numout, *)
+         WRITE (numout, *) 'dia_detide_init : weight computation for daily detided model diagnostics'
+         WRITE (numout, *) '~~~~~~~~~~~~~~~'
+         WRITE (numout, *) '                  lk_diadetide = ', lk_diadetide
+      END IF
+
+      IF (lk_diadetide) THEN
+         ! Retrieve information about M2 tidal constituent
+         ctide_selected(1) = 'M2'
+         CALL tide_init_harmonics(ctide_selected, stideconst) 
+
+         ! For M2, twice the tidal period spans slightly more than one full
+         ! day. Compute the maximum number of equal intervals that span exactly
+         ! twice the tidal period *and* whose mid-points fall within a 24-hour
+         ! period from midnight to midnight.
+         zdt = 2.0_wp * 2.0_wp * rpi / stideconst(1)%omega
+         ndiadetide = FLOOR( zdt / ( zdt - 86400.0_wp ) )
+         ! Compute mid-points of the intervals to be included in the detided
+         ! average
+         ALLOCATE ( tdiadetide(ndiadetide) )
+         DO jn = 1, ndiadetide
+            tdiadetide(jn) = ( REAL( jn, KIND=wp) - 0.5_wp ) * zdt / REAL( ndiadetide, KIND=wp ) - ( zdt - 86400.0_wp ) * 0.5_wp
+         END DO
+      END IF
+
+   END SUBROUTINE dia_detide_init
+
+   SUBROUTINE dia_detide( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_detide  ***
+      !!
+      !! ** Purpose : weight computation for daily detided model diagnostics
+      !!----------------------------------------------------------------------
+
+      INTEGER, INTENT(in)          ::   kt
+      REAL(wp), DIMENSION(jpi,jpj) ::   zwght_2D
+      REAL(wp)                     ::   zwght, ztmp
+      INTEGER                      ::   jn
+
+      ! Compute detiding weight at the current time-step; the daily total weight
+      ! is one, and the daily summation of a diagnosed field multiplied by this
+      ! weight should provide daily detided averages
+      zwght = 0.0_wp
+      DO jn = 1, ndiadetide
+         ztmp = ( tdiadetide(jn) - REAL( nsec_day, KIND=wp ) ) / rn_Dt
+         IF ( ( ztmp < 0.5_wp ).AND.( ztmp >= -0.5_wp ) ) THEN
+            zwght = zwght + 1.0_wp / REAL( ndiadetide, KIND=wp )
+         END IF
+      END DO
+      zwght_2D(:,:) = zwght
+      CALL iom_put( "diadetide_weight", zwght_2D)
+
+   END SUBROUTINE dia_detide
+
+END MODULE diadetide
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/diaharm.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/diaharm.F90	(revision 12384)
+++ 	(revision )
@@ -1,517 +1,0 @@
-MODULE diaharm 
-   !!======================================================================
-   !!                       ***  MODULE  diaharm  ***
-   !! Harmonic analysis of tidal constituents 
-   !!======================================================================
-   !! History :  3.1  !  2007  (O. Le Galloudec, J. Chanut)  Original code
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers variables
-   USE dom_oce         ! ocean space and time domain
-   USE phycst
-   USE daymod
-   USE tide_mod
-   USE sbctide         ! Tidal forcing or not
-   !
-   USE in_out_manager  ! I/O units
-   USE iom             ! I/0 library
-   USE ioipsl          ! NetCDF IPSL library
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE timing          ! preformance summary
-   USE lib_mpp           ! MPP library
-
-   IMPLICIT NONE
-   PRIVATE
-   
-   INTEGER, PARAMETER :: jpincomax    = 2.*jpmax_harmo
-   INTEGER, PARAMETER :: jpdimsparse  = jpincomax*300*24
-
-   !                         !!** namelist variables **
-   LOGICAL, PUBLIC ::   ln_diaharm    ! Choose tidal harmonic output or not
-   INTEGER         ::   nit000_han    ! First time step used for harmonic analysis
-   INTEGER         ::   nitend_han    ! Last time step used for harmonic analysis
-   INTEGER         ::   nstep_han     ! Time step frequency for harmonic analysis
-   INTEGER         ::   nb_ana        ! Number of harmonics to analyse
-
-   INTEGER , ALLOCATABLE, DIMENSION(:)       ::   name
-   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   ana_temp
-   REAL(wp), ALLOCATABLE, DIMENSION(:)       ::   ana_freq, ut   , vt   , ft
-   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   ::   out_eta , out_u, out_v
-
-   INTEGER ::   ninco, nsparse
-   INTEGER ,       DIMENSION(jpdimsparse)         ::   njsparse, nisparse
-   INTEGER , SAVE, DIMENSION(jpincomax)           ::   ipos1
-   REAL(wp),       DIMENSION(jpdimsparse)         ::   valuesparse
-   REAL(wp),       DIMENSION(jpincomax)           ::   ztmp4 , ztmp7
-   REAL(wp), SAVE, DIMENSION(jpincomax,jpincomax) ::   ztmp3 , zpilier
-   REAL(wp), SAVE, DIMENSION(jpincomax)           ::   zpivot
-
-   CHARACTER (LEN=4), DIMENSION(jpmax_harmo) ::   tname   ! Names of tidal constituents ('M2', 'K1',...)
-
-   PUBLIC   dia_harm        ! routine called by step.F90
-   PUBLIC   dia_harm_init   ! routine called by nemogcm.F90
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id$
-   !! Software governed by the CeCILL license (see ./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE dia_harm_init 
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE dia_harm_init  ***
-      !!         
-      !! ** Purpose :   Initialization of tidal harmonic analysis
-      !!
-      !! ** Method  :   Initialize frequency array and  nodal factor for nit000_han
-      !!
-      !!--------------------------------------------------------------------
-      INTEGER ::   jh, nhan, ji
-      INTEGER ::   ios                 ! Local integer output status for namelist read
-
-      NAMELIST/nam_diaharm/ ln_diaharm, nit000_han, nitend_han, nstep_han, tname
-      !!----------------------------------------------------------------------
-
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'dia_harm_init: Tidal harmonic analysis initialization'
-         WRITE(numout,*) '~~~~~~~ '
-      ENDIF
-      !
-      REWIND( numnam_ref )              ! Namelist nam_diaharm in reference namelist : Tidal harmonic analysis
-      READ  ( numnam_ref, nam_diaharm, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_diaharm in reference namelist' )
-      REWIND( numnam_cfg )              ! Namelist nam_diaharm in configuration namelist : Tidal harmonic analysis
-      READ  ( numnam_cfg, nam_diaharm, IOSTAT = ios, ERR = 902 )
-902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nam_diaharm in configuration namelist' )
-      IF(lwm) WRITE ( numond, nam_diaharm )
-      !
-      IF(lwp) THEN
-         WRITE(numout,*) 'Tidal diagnostics = ', ln_diaharm
-         WRITE(numout,*) '   First time step used for analysis:         nit000_han= ', nit000_han
-         WRITE(numout,*) '   Last  time step used for analysis:         nitend_han= ', nitend_han
-         WRITE(numout,*) '   Time step frequency for harmonic analysis: nstep_han = ', nstep_han
-      ENDIF
-
-      IF( ln_diaharm .AND. .NOT.ln_tide )   CALL ctl_stop( 'dia_harm_init : ln_tide must be true for harmonic analysis')
-
-      IF( ln_diaharm ) THEN
-
-         CALL tide_init_Wave
-         !
-         ! Basic checks on harmonic analysis time window:
-         ! ----------------------------------------------
-         IF( nit000 > nit000_han )   CALL ctl_stop( 'dia_harm_init : nit000_han must be greater than nit000',   &
-            &                                       ' restart capability not implemented' )
-         IF( nitend < nitend_han )   CALL ctl_stop( 'dia_harm_init : nitend_han must be lower than nitend',   &
-            &                                       'restart capability not implemented' )
-
-         IF( MOD( nitend_han-nit000_han+1 , nstep_han ) /= 0 )   &
-            &                        CALL ctl_stop( 'dia_harm_init : analysis time span must be a multiple of nstep_han' )
-         !
-         nb_ana = 0
-         DO jh=1,jpmax_harmo
-            DO ji=1,jpmax_harmo
-               IF(TRIM(tname(jh)) == Wave(ji)%cname_tide) THEN
-                  nb_ana=nb_ana+1
-               ENDIF
-            END DO
-         END DO
-         !
-         IF(lwp) THEN
-            WRITE(numout,*) '        Namelist nam_diaharm'
-            WRITE(numout,*) '        nb_ana    = ', nb_ana
-            CALL flush(numout)
-         ENDIF
-         !
-         IF (nb_ana > jpmax_harmo) THEN
-            WRITE(ctmp1,*) ' nb_ana must be lower than jpmax_harmo'
-            WRITE(ctmp2,*) ' jpmax_harmo= ', jpmax_harmo
-            CALL ctl_stop( 'dia_harm_init', ctmp1, ctmp2 )
-         ENDIF
-
-         ALLOCATE(name    (nb_ana))
-         DO jh=1,nb_ana
-            DO ji=1,jpmax_harmo
-               IF (TRIM(tname(jh)) ==  Wave(ji)%cname_tide) THEN
-                  name(jh) = ji
-                  EXIT
-               END IF
-            END DO
-         END DO
-
-         ! Initialize frequency array:
-         ! ---------------------------
-         ALLOCATE( ana_freq(nb_ana), ut(nb_ana), vt(nb_ana), ft(nb_ana) )
-
-         CALL tide_harmo( ana_freq, vt, ut, ft, name, nb_ana )
-
-         IF(lwp) WRITE(numout,*) 'Analysed frequency  : ',nb_ana ,'Frequency '
-
-         DO jh = 1, nb_ana
-            IF(lwp) WRITE(numout,*) '                    : ',tname(jh),' ',ana_freq(jh)
-         END DO
-
-         ! Initialize temporary arrays:
-         ! ----------------------------
-         ALLOCATE( ana_temp(jpi,jpj,2*nb_ana,3) )
-         ana_temp(:,:,:,:) = 0._wp
-
-      ENDIF
-
-   END SUBROUTINE dia_harm_init
-
-
-   SUBROUTINE dia_harm ( kt )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE dia_harm  ***
-      !!         
-      !! ** Purpose :   Tidal harmonic analysis main routine
-      !!
-      !! ** Action  :   Sums ssh/u/v over time analysis [nit000_han,nitend_han]
-      !!
-      !!--------------------------------------------------------------------
-      INTEGER, INTENT( IN ) :: kt
-      !
-      INTEGER  :: ji, jj, jh, jc, nhc
-      REAL(wp) :: ztime, ztemp
-      !!--------------------------------------------------------------------
-      IF( ln_timing )   CALL timing_start('dia_harm')
-      !
-      IF( kt >= nit000_han .AND. kt <= nitend_han .AND. MOD(kt,nstep_han) == 0 ) THEN
-         !
-         ztime = (kt-nit000+1) * rdt 
-         !
-         nhc = 0
-         DO jh = 1, nb_ana
-            DO jc = 1, 2
-               nhc = nhc+1
-               ztemp =(     MOD(jc,2) * ft(jh) *COS(ana_freq(jh)*ztime + vt(jh) + ut(jh))  &
-                  &    +(1.-MOD(jc,2))* ft(jh) *SIN(ana_freq(jh)*ztime + vt(jh) + ut(jh)))
-                  !
-               DO jj = 1,jpj
-                  DO ji = 1,jpi
-                     ! Elevation
-                     ana_temp(ji,jj,nhc,1) = ana_temp(ji,jj,nhc,1) + ztemp*sshn(ji,jj)*ssmask (ji,jj)        
-                     ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2) + ztemp*un_b(ji,jj)*ssumask(ji,jj)
-                     ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3) + ztemp*vn_b(ji,jj)*ssvmask(ji,jj)
-                  END DO
-               END DO
-               !
-            END DO
-         END DO
-         !       
-      END IF
-      !
-      IF( kt == nitend_han )   CALL dia_harm_end
-      !
-      IF( ln_timing )   CALL timing_stop('dia_harm')
-      !
-   END SUBROUTINE dia_harm
-
-
-   SUBROUTINE dia_harm_end
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE diaharm_end  ***
-      !!         
-      !! ** Purpose :  Compute the Real and Imaginary part of tidal constituents
-      !!
-      !! ** Action  :  Decompose the signal on the harmonic constituents 
-      !!
-      !!--------------------------------------------------------------------
-      INTEGER :: ji, jj, jh, jc, jn, nhan, jl
-      INTEGER :: ksp, kun, keq
-      REAL(wp) :: ztime, ztime_ini, ztime_end
-      REAL(wp) :: X1, X2
-      REAL(wp), DIMENSION(jpi,jpj,jpmax_harmo,2) ::   ana_amp   ! workspace
-      !!--------------------------------------------------------------------
-      !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'anharmo_end: kt=nitend_han: Perform harmonic analysis'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
-
-      ztime_ini = nit000_han*rdt                 ! Initial time in seconds at the beginning of analysis
-      ztime_end = nitend_han*rdt                 ! Final time in seconds at the end of analysis
-      nhan = (nitend_han-nit000_han+1)/nstep_han ! Number of dumps used for analysis
-
-      ninco = 2*nb_ana
-
-      ksp = 0
-      keq = 0        
-      DO jn = 1, nhan
-         ztime=( (nhan-jn)*ztime_ini + (jn-1)*ztime_end )/FLOAT(nhan-1)
-         keq = keq + 1
-         kun = 0
-         DO jh = 1, nb_ana
-            DO jc = 1, 2
-               kun = kun + 1
-               ksp = ksp + 1
-               nisparse(ksp) = keq
-               njsparse(ksp) = kun
-               valuesparse(ksp) = (   MOD(jc,2) * ft(jh) * COS(ana_freq(jh)*ztime + vt(jh) + ut(jh))   &
-                  &             + (1.-MOD(jc,2))* ft(jh) * SIN(ana_freq(jh)*ztime + vt(jh) + ut(jh)) )
-            END DO
-         END DO
-      END DO
-
-      nsparse = ksp
-
-      ! Elevation:
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            ! Fill input array
-            kun = 0
-            DO jh = 1, nb_ana
-               DO jc = 1, 2
-                  kun = kun + 1
-                  ztmp4(kun)=ana_temp(ji,jj,kun,1)
-               END DO
-            END DO
-
-            CALL SUR_DETERMINE(jj)
-
-            ! Fill output array
-            DO jh = 1, nb_ana
-               ana_amp(ji,jj,jh,1)=ztmp7((jh-1)*2+1)
-               ana_amp(ji,jj,jh,2)=ztmp7((jh-1)*2+2)
-            END DO
-         END DO
-      END DO
-
-      ALLOCATE( out_eta(jpi,jpj,2*nb_ana),   & 
-         &      out_u  (jpi,jpj,2*nb_ana),   &
-         &      out_v  (jpi,jpj,2*nb_ana)  )
-
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            DO jh = 1, nb_ana 
-               X1 = ana_amp(ji,jj,jh,1)
-               X2 =-ana_amp(ji,jj,jh,2)
-               out_eta(ji,jj,jh       ) = X1 * tmask_i(ji,jj)
-               out_eta(ji,jj,jh+nb_ana) = X2 * tmask_i(ji,jj)
-            END DO
-         END DO
-      END DO
-
-      ! ubar:
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            ! Fill input array
-            kun=0
-            DO jh = 1,nb_ana
-               DO jc = 1,2
-                  kun = kun + 1
-                  ztmp4(kun)=ana_temp(ji,jj,kun,2)
-               END DO
-            END DO
-
-            CALL SUR_DETERMINE(jj+1)
-
-            ! Fill output array
-            DO jh = 1, nb_ana
-               ana_amp(ji,jj,jh,1) = ztmp7((jh-1)*2+1)
-               ana_amp(ji,jj,jh,2) = ztmp7((jh-1)*2+2)
-            END DO
-
-         END DO
-      END DO
-
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            DO jh = 1, nb_ana 
-               X1= ana_amp(ji,jj,jh,1)
-               X2=-ana_amp(ji,jj,jh,2)
-               out_u(ji,jj,       jh) = X1 * ssumask(ji,jj)
-               out_u(ji,jj,nb_ana+jh) = X2 * ssumask(ji,jj)
-            ENDDO
-         ENDDO
-      ENDDO
-
-      ! vbar:
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            ! Fill input array
-            kun=0
-            DO jh = 1,nb_ana
-               DO jc = 1,2
-                  kun = kun + 1
-                  ztmp4(kun)=ana_temp(ji,jj,kun,3)
-               END DO
-            END DO
-
-            CALL SUR_DETERMINE(jj+1)
-
-            ! Fill output array
-            DO jh = 1, nb_ana
-               ana_amp(ji,jj,jh,1)=ztmp7((jh-1)*2+1)
-               ana_amp(ji,jj,jh,2)=ztmp7((jh-1)*2+2)
-            END DO
-
-         END DO
-      END DO
-
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            DO jh = 1, nb_ana 
-               X1=ana_amp(ji,jj,jh,1)
-               X2=-ana_amp(ji,jj,jh,2)
-               out_v(ji,jj,       jh)=X1 * ssvmask(ji,jj)
-               out_v(ji,jj,nb_ana+jh)=X2 * ssvmask(ji,jj)
-            END DO
-         END DO
-      END DO
-      !
-      CALL dia_wri_harm ! Write results in files
-      !
-   END SUBROUTINE dia_harm_end
-
-
-   SUBROUTINE dia_wri_harm
-      !!--------------------------------------------------------------------
-      !!                 ***  ROUTINE dia_wri_harm  ***
-      !!         
-      !! ** Purpose : Write tidal harmonic analysis results in a netcdf file
-      !!--------------------------------------------------------------------
-      CHARACTER(LEN=lc) :: cltext
-      CHARACTER(LEN=lc) ::   &
-         cdfile_name_T   ,   & ! name of the file created (T-points)
-         cdfile_name_U   ,   & ! name of the file created (U-points)
-         cdfile_name_V         ! name of the file created (V-points)
-      INTEGER  ::   jh
-      !!----------------------------------------------------------------------
-
-      IF(lwp) WRITE(numout,*) '  '
-      IF(lwp) WRITE(numout,*) 'dia_wri_harm : Write harmonic analysis results'
-      IF(lwp) WRITE(numout,*) '  '
-
-      ! A) Elevation
-      !/////////////
-      !
-      DO jh = 1, nb_ana
-      CALL iom_put( TRIM(tname(jh))//'x', out_eta(:,:,jh) )
-      CALL iom_put( TRIM(tname(jh))//'y', out_eta(:,:,nb_ana+jh) )
-      END DO
-
-      ! B) ubar
-      !/////////
-      !
-      DO jh = 1, nb_ana
-      CALL iom_put( TRIM(tname(jh))//'x_u', out_u(:,:,jh) )
-      CALL iom_put( TRIM(tname(jh))//'y_u', out_u(:,:,nb_ana+jh) )
-      END DO
-
-      ! C) vbar
-      !/////////
-      !
-      DO jh = 1, nb_ana
-         CALL iom_put( TRIM(tname(jh))//'x_v', out_v(:,:,jh       ) )
-         CALL iom_put( TRIM(tname(jh))//'y_v', out_v(:,:,jh+nb_ana) )
-      END DO
-      !
-   END SUBROUTINE dia_wri_harm
-
-
-   SUBROUTINE SUR_DETERMINE(init)
-      !!---------------------------------------------------------------------------------
-      !!                      *** ROUTINE SUR_DETERMINE ***
-      !!    
-      !!    
-      !!       
-      !!---------------------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   init 
-      !
-      INTEGER                         :: ji_sd, jj_sd, ji1_sd, ji2_sd, jh1_sd, jh2_sd
-      REAL(wp)                        :: zval1, zval2, zx1
-      REAL(wp), DIMENSION(jpincomax) :: ztmpx, zcol1, zcol2
-      INTEGER , DIMENSION(jpincomax) :: ipos2, ipivot
-      !---------------------------------------------------------------------------------
-      !            
-      IF( init == 1 ) THEN
-         IF( nsparse > jpdimsparse )   CALL ctl_stop( 'STOP', 'SUR_DETERMINE : nsparse .GT. jpdimsparse')
-         IF( ninco   > jpincomax   )   CALL ctl_stop( 'STOP', 'SUR_DETERMINE : ninco .GT. jpincomax')
-         !
-         ztmp3(:,:) = 0._wp
-         !
-         DO jh1_sd = 1, nsparse
-            DO jh2_sd = 1, nsparse
-               nisparse(jh2_sd) = nisparse(jh2_sd)
-               njsparse(jh2_sd) = njsparse(jh2_sd)
-               IF( nisparse(jh2_sd) == nisparse(jh1_sd) ) THEN
-                  ztmp3(njsparse(jh1_sd),njsparse(jh2_sd)) = ztmp3(njsparse(jh1_sd),njsparse(jh2_sd))  &
-                     &                                     + valuesparse(jh1_sd)*valuesparse(jh2_sd)
-               ENDIF
-            END DO
-         END DO
-         !
-         DO jj_sd = 1 ,ninco
-            ipos1(jj_sd) = jj_sd
-            ipos2(jj_sd) = jj_sd
-         END DO
-         !
-         DO ji_sd = 1 , ninco
-            !
-            !find greatest non-zero pivot:
-            zval1 = ABS(ztmp3(ji_sd,ji_sd))
-            !
-            ipivot(ji_sd) = ji_sd
-            DO jj_sd = ji_sd, ninco
-               zval2 = ABS(ztmp3(ji_sd,jj_sd))
-               IF( zval2 >= zval1 )THEN
-                  ipivot(ji_sd) = jj_sd
-                  zval1         = zval2
-               ENDIF
-            END DO
-            !
-            DO ji1_sd = 1, ninco
-               zcol1(ji1_sd)               = ztmp3(ji1_sd,ji_sd)
-               zcol2(ji1_sd)               = ztmp3(ji1_sd,ipivot(ji_sd))
-               ztmp3(ji1_sd,ji_sd)         = zcol2(ji1_sd)
-               ztmp3(ji1_sd,ipivot(ji_sd)) = zcol1(ji1_sd)
-            END DO
-            !
-            ipos2(ji_sd)         = ipos1(ipivot(ji_sd))
-            ipos2(ipivot(ji_sd)) = ipos1(ji_sd)
-            ipos1(ji_sd)         = ipos2(ji_sd)
-            ipos1(ipivot(ji_sd)) = ipos2(ipivot(ji_sd))
-            zpivot(ji_sd)        = ztmp3(ji_sd,ji_sd)
-            DO jj_sd = 1, ninco
-               ztmp3(ji_sd,jj_sd) = ztmp3(ji_sd,jj_sd) / zpivot(ji_sd)
-            END DO
-            !
-            DO ji2_sd = ji_sd+1, ninco
-               zpilier(ji2_sd,ji_sd)=ztmp3(ji2_sd,ji_sd)
-               DO jj_sd=1,ninco
-                  ztmp3(ji2_sd,jj_sd)=  ztmp3(ji2_sd,jj_sd) - ztmp3(ji_sd,jj_sd) * zpilier(ji2_sd,ji_sd)
-               END DO
-            END DO
-            !
-         END DO
-         !
-      ENDIF ! End init==1
-
-      DO ji_sd = 1, ninco
-         ztmp4(ji_sd) = ztmp4(ji_sd) / zpivot(ji_sd)
-         DO ji2_sd = ji_sd+1, ninco
-            ztmp4(ji2_sd) = ztmp4(ji2_sd) - ztmp4(ji_sd) * zpilier(ji2_sd,ji_sd)
-         END DO
-      END DO
-
-      !system solving: 
-      ztmpx(ninco) = ztmp4(ninco) / ztmp3(ninco,ninco)
-      ji_sd = ninco
-      DO ji_sd = ninco-1, 1, -1
-         zx1 = 0._wp
-         DO jj_sd = ji_sd+1, ninco
-            zx1 = zx1 + ztmpx(jj_sd) * ztmp3(ji_sd,jj_sd)
-         END DO
-         ztmpx(ji_sd) = ztmp4(ji_sd)-zx1
-      END DO
-
-      DO jj_sd =1, ninco
-         ztmp7(ipos1(jj_sd))=ztmpx(jj_sd)
-      END DO
-      !
-   END SUBROUTINE SUR_DETERMINE
-
-   !!======================================================================
-END MODULE diaharm
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/diahsb.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/diahsb.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/diahsb.F90	(revision 12928)
@@ -17,6 +17,6 @@
    USE phycst         ! physical constants
    USE sbc_oce        ! surface thermohaline fluxes
+   USE isf_oce        ! ice shelf fluxes
    USE sbcrnf         ! river runoff
-   USE sbcisf         ! ice shelves
    USE domvvl         ! vertical scale factors
    USE traqsr         ! penetrative solar radiation
@@ -48,7 +48,6 @@
    REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   ssh_hc_loc_ini, ssh_sc_loc_ini   !
    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   hc_loc_ini, sc_loc_ini, e3t_ini  !
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   tmask_ini
+
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -58,5 +57,5 @@
 CONTAINS
 
-   SUBROUTINE dia_hsb( kt )
+   SUBROUTINE dia_hsb( kt, Kbb, Kmm )
       !!---------------------------------------------------------------------------
       !!                  ***  ROUTINE dia_hsb  ***
@@ -69,5 +68,6 @@
       !!
       !!---------------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER, INTENT(in) ::   kt         ! ocean time-step index
+      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices
       !
       INTEGER    ::   ji, jj, jk                  ! dummy loop indice
@@ -86,10 +86,10 @@
       IF( ln_timing )   CALL timing_start('dia_hsb')      
       !
-      tsn(:,:,:,1) = tsn(:,:,:,1) * tmask(:,:,:) ; tsb(:,:,:,1) = tsb(:,:,:,1) * tmask(:,:,:) ;
-      tsn(:,:,:,2) = tsn(:,:,:,2) * tmask(:,:,:) ; tsb(:,:,:,2) = tsb(:,:,:,2) * tmask(:,:,:) ;
+      ts(:,:,:,1,Kmm) = ts(:,:,:,1,Kmm) * tmask(:,:,:) ; ts(:,:,:,1,Kbb) = ts(:,:,:,1,Kbb) * tmask(:,:,:) ;
+      ts(:,:,:,2,Kmm) = ts(:,:,:,2,Kmm) * tmask(:,:,:) ; ts(:,:,:,2,Kbb) = ts(:,:,:,2,Kbb) * tmask(:,:,:) ;
       ! ------------------------- !
       ! 1 - Trends due to forcing !
       ! ------------------------- !
-      z_frc_trd_v = r1_rau0 * glob_sum( 'diahsb', - ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * surf(:,:) )   ! volume fluxes
+      z_frc_trd_v = r1_rho0 * glob_sum( 'diahsb', - ( emp(:,:) - rnf(:,:) + fwfisf_cav(:,:) + fwfisf_par(:,:) ) * surf(:,:) )   ! volume fluxes
       z_frc_trd_t =           glob_sum( 'diahsb', sbc_tsc(:,:,jp_tem) * surf(:,:) )                       ! heat fluxes
       z_frc_trd_s =           glob_sum( 'diahsb', sbc_tsc(:,:,jp_sal) * surf(:,:) )                       ! salt fluxes
@@ -98,7 +98,8 @@
       IF( ln_rnf_sal)   z_frc_trd_s = z_frc_trd_s + glob_sum( 'diahsb', rnf_tsc(:,:,jp_sal) * surf(:,:) )
       !                    ! Add ice shelf heat & salt input
-      IF( ln_isf    )   z_frc_trd_t = z_frc_trd_t + glob_sum( 'diahsb', risf_tsc(:,:,jp_tem) * surf(:,:) )
+      IF( ln_isf    )   z_frc_trd_t = z_frc_trd_t &
+         &                          + glob_sum( 'diahsb', ( risf_cav_tsc(:,:,jp_tem) + risf_par_tsc(:,:,jp_tem) ) * surf(:,:) )
       !                    ! Add penetrative solar radiation
-      IF( ln_traqsr )   z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * glob_sum( 'diahsb', qsr     (:,:) * surf(:,:) )
+      IF( ln_traqsr )   z_frc_trd_t = z_frc_trd_t + r1_rho0_rcp * glob_sum( 'diahsb', qsr     (:,:) * surf(:,:) )
       !                    ! Add geothermal heat flux
       IF( ln_trabbc )   z_frc_trd_t = z_frc_trd_t +               glob_sum( 'diahsb', qgh_trd0(:,:) * surf(:,:) )
@@ -108,11 +109,11 @@
             DO ji=1,jpi
                DO jj=1,jpj
-                  z2d0(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_tem)
-                  z2d1(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_sal)
+                  z2d0(ji,jj) = surf(ji,jj) * ww(ji,jj,mikt(ji,jj)) * ts(ji,jj,mikt(ji,jj),jp_tem,Kbb)
+                  z2d1(ji,jj) = surf(ji,jj) * ww(ji,jj,mikt(ji,jj)) * ts(ji,jj,mikt(ji,jj),jp_sal,Kbb)
                END DO
             END DO
          ELSE
-            z2d0(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_tem)
-            z2d1(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_sal)
+            z2d0(:,:) = surf(:,:) * ww(:,:,1) * ts(:,:,1,jp_tem,Kbb)
+            z2d1(:,:) = surf(:,:) * ww(:,:,1) * ts(:,:,1,jp_sal,Kbb)
          END IF
          z_wn_trd_t = - glob_sum( 'diahsb', z2d0 ) 
@@ -120,11 +121,11 @@
       ENDIF
 
-      frc_v = frc_v + z_frc_trd_v * rdt
-      frc_t = frc_t + z_frc_trd_t * rdt
-      frc_s = frc_s + z_frc_trd_s * rdt
+      frc_v = frc_v + z_frc_trd_v * rn_Dt
+      frc_t = frc_t + z_frc_trd_t * rn_Dt
+      frc_s = frc_s + z_frc_trd_s * rn_Dt
       !                                          ! Advection flux through fixed surface (z=0)
       IF( ln_linssh ) THEN
-         frc_wn_t = frc_wn_t + z_wn_trd_t * rdt
-         frc_wn_s = frc_wn_s + z_wn_trd_s * rdt
+         frc_wn_t = frc_wn_t + z_wn_trd_t * rn_Dt
+         frc_wn_s = frc_wn_s + z_wn_trd_s * rn_Dt
       ENDIF
 
@@ -135,5 +136,5 @@
 
       !                    ! volume variation (calculated with ssh)
-      zdiff_v1 = glob_sum_full( 'diahsb', surf(:,:)*sshn(:,:) - surf_ini(:,:)*ssh_ini(:,:) )
+      zdiff_v1 = glob_sum_full( 'diahsb', surf(:,:)*ssh(:,:,Kmm) - surf_ini(:,:)*ssh_ini(:,:) )
 
       !                    ! heat & salt content variation (associated with ssh)
@@ -142,11 +143,11 @@
             DO ji = 1, jpi
                DO jj = 1, jpj
-                  z2d0(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj) - ssh_hc_loc_ini(ji,jj) ) 
-                  z2d1(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj) - ssh_sc_loc_ini(ji,jj) ) 
+                  z2d0(ji,jj) = surf(ji,jj) * ( ts(ji,jj,mikt(ji,jj),jp_tem,Kmm) * ssh(ji,jj,Kmm) - ssh_hc_loc_ini(ji,jj) ) 
+                  z2d1(ji,jj) = surf(ji,jj) * ( ts(ji,jj,mikt(ji,jj),jp_sal,Kmm) * ssh(ji,jj,Kmm) - ssh_sc_loc_ini(ji,jj) ) 
                END DO
             END DO
          ELSE                          ! no under ice-shelf seas
-            z2d0(:,:) = surf(:,:) * ( tsn(:,:,1,jp_tem) * sshn(:,:) - ssh_hc_loc_ini(:,:) ) 
-            z2d1(:,:) = surf(:,:) * ( tsn(:,:,1,jp_sal) * sshn(:,:) - ssh_sc_loc_ini(:,:) ) 
+            z2d0(:,:) = surf(:,:) * ( ts(:,:,1,jp_tem,Kmm) * ssh(:,:,Kmm) - ssh_hc_loc_ini(:,:) ) 
+            z2d1(:,:) = surf(:,:) * ( ts(:,:,1,jp_sal,Kmm) * ssh(:,:,Kmm) - ssh_sc_loc_ini(:,:) ) 
          END IF
          z_ssh_hc = glob_sum_full( 'diahsb', z2d0 ) 
@@ -155,13 +156,13 @@
       !
       DO jk = 1, jpkm1           ! volume variation (calculated with scale factors)
-         zwrk(:,:,jk) = ( surf(:,:)*e3t_n(:,:,jk) - surf_ini(:,:)*e3t_ini(:,:,jk) ) * tmask(:,:,jk)
+         zwrk(:,:,jk) = surf(:,:)*e3t(:,:,jk,Kmm)*tmask(:,:,jk) - surf_ini(:,:)*e3t_ini(:,:,jk)*tmask_ini(:,:,jk)
       END DO
-      zdiff_v2 = glob_sum_full( 'diahsb', zwrk(:,:,:) )
+      zdiff_v2 = glob_sum_full( 'diahsb', zwrk(:,:,:) )     ! glob_sum_full needed as tmask and tmask_ini could be different
       DO jk = 1, jpkm1           ! heat content variation
-         zwrk(:,:,jk) = ( surf(:,:)*e3t_n(:,:,jk)*tsn(:,:,jk,jp_tem) - surf_ini(:,:)*hc_loc_ini(:,:,jk) ) * tmask(:,:,jk)
+         zwrk(:,:,jk) = ( surf(:,:)*e3t(:,:,jk,Kmm)*ts(:,:,jk,jp_tem,Kmm) - surf_ini(:,:)*hc_loc_ini(:,:,jk) )
       END DO
       zdiff_hc = glob_sum_full( 'diahsb', zwrk(:,:,:) )
       DO jk = 1, jpkm1           ! salt content variation
-         zwrk(:,:,jk) = ( surf(:,:)*e3t_n(:,:,jk)*tsn(:,:,jk,jp_sal) - surf_ini(:,:)*sc_loc_ini(:,:,jk) ) * tmask(:,:,jk)
+         zwrk(:,:,jk) = ( surf(:,:)*e3t(:,:,jk,Kmm)*ts(:,:,jk,jp_sal,Kmm) - surf_ini(:,:)*sc_loc_ini(:,:,jk) )
       END DO
       zdiff_sc = glob_sum_full( 'diahsb', zwrk(:,:,:) )
@@ -185,18 +186,18 @@
       ! ----------------------- !
       DO jk = 1, jpkm1           ! total ocean volume (calculated with scale factors)
-         zwrk(:,:,jk) = surf(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk)
+         zwrk(:,:,jk) = surf(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk)
       END DO
-      zvol_tot = glob_sum_full( 'diahsb', zwrk(:,:,:) )
+      zvol_tot = glob_sum( 'diahsb', zwrk(:,:,:) )
 
 !!gm to be added ?
 !      IF( ln_linssh ) THEN            ! fixed volume, add the ssh contribution
-!        zvol_tot = zvol_tot + glob_sum( 'diahsb', surf(:,:) * sshn(:,:) )
+!        zvol_tot = zvol_tot + glob_sum( 'diahsb', surf(:,:) * ssh(:,:,Kmm) )
 !      ENDIF
 !!gm end
 
       CALL iom_put(   'bgfrcvol' , frc_v    * 1.e-9    )              ! vol - surface forcing (km3) 
-      CALL iom_put(   'bgfrctem' , frc_t    * rau0 * rcp * 1.e-20 )   ! hc  - surface forcing (1.e20 J) 
-      CALL iom_put(   'bgfrchfx' , frc_t    * rau0 * rcp /  &         ! hc  - surface forcing (W/m2) 
-         &                       ( surf_tot * kt * rdt )        )
+      CALL iom_put(   'bgfrctem' , frc_t    * rho0 * rcp * 1.e-20 )   ! hc  - surface forcing (1.e20 J) 
+      CALL iom_put(   'bgfrchfx' , frc_t    * rho0 * rcp /  &         ! hc  - surface forcing (W/m2) 
+         &                       ( surf_tot * kt * rn_Dt )        )
       CALL iom_put(   'bgfrcsal' , frc_s    * 1.e-9    )              ! sc  - surface forcing (psu*km3) 
 
@@ -204,7 +205,7 @@
          CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot )              ! Temperature drift     (C) 
          CALL iom_put( 'bgsaline' , zdiff_sc / zvol_tot )              ! Salinity    drift     (PSU)
-         CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * rau0 * rcp )   ! Heat content drift    (1.e20 J) 
-         CALL iom_put( 'bgheatfx' , zdiff_hc * rau0 * rcp /  &         ! Heat flux drift       (W/m2) 
-            &                       ( surf_tot * kt * rdt )        )
+         CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * rho0 * rcp )   ! Heat content drift    (1.e20 J) 
+         CALL iom_put( 'bgheatfx' , zdiff_hc * rho0 * rcp /  &         ! Heat flux drift       (W/m2) 
+            &                       ( surf_tot * kt * rn_Dt )        )
          CALL iom_put( 'bgsaltco' , zdiff_sc * 1.e-9    )              ! Salt content drift    (psu*km3)
          CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9    )              ! volume ssh drift      (km3)  
@@ -224,7 +225,7 @@
          CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot)              ! Heat content drift    (C) 
          CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot)              ! Salt content drift    (PSU)
-         CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rau0 * rcp )  ! Heat content drift    (1.e20 J) 
-         CALL iom_put( 'bgheatfx' , zdiff_hc1 * rau0 * rcp /  &        ! Heat flux drift       (W/m2) 
-            &                       ( surf_tot * kt * rdt )         )
+         CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rho0 * rcp )  ! Heat content drift    (1.e20 J) 
+         CALL iom_put( 'bgheatfx' , zdiff_hc1 * rho0 * rcp /  &        ! Heat flux drift       (W/m2) 
+            &                       ( surf_tot * kt * rn_Dt )         )
          CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9    )             ! Salt content drift    (psu*km3)
          CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9    )              ! volume ssh drift      (km3)  
@@ -233,5 +234,5 @@
       ENDIF
       !
-      IF( lrst_oce )   CALL dia_hsb_rst( kt, 'WRITE' )
+      IF( lrst_oce )   CALL dia_hsb_rst( kt, Kmm, 'WRITE' )
       !
       IF( ln_timing )   CALL timing_stop('dia_hsb')
@@ -240,5 +241,5 @@
 
 
-   SUBROUTINE dia_hsb_rst( kt, cdrw )
+   SUBROUTINE dia_hsb_rst( kt, Kmm, cdrw )
       !!---------------------------------------------------------------------
       !!                   ***  ROUTINE dia_hsb_rst  ***
@@ -249,4 +250,5 @@
       !!----------------------------------------------------------------------
       INTEGER         , INTENT(in) ::   kt     ! ocean time-step
+      INTEGER         , INTENT(in) ::   Kmm    ! ocean time level index
       CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag
       !
@@ -270,4 +272,5 @@
             CALL iom_get( numror, jpdom_autoglo, 'ssh_ini'   , ssh_ini   , ldxios = lrxios )
             CALL iom_get( numror, jpdom_autoglo, 'e3t_ini'   , e3t_ini   , ldxios = lrxios )
+            CALL iom_get( numror, jpdom_autoglo, 'tmask_ini' , tmask_ini , ldxios = lrxios )
             CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini, ldxios = lrxios )
             CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini, ldxios = lrxios )
@@ -281,10 +284,11 @@
             IF(lwp) WRITE(numout,*)
             surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:)         ! initial ocean surface
-            ssh_ini(:,:) = sshn(:,:)                          ! initial ssh
+            ssh_ini(:,:) = ssh(:,:,Kmm)                          ! initial ssh
             DO jk = 1, jpk
               ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance).
-               e3t_ini   (:,:,jk) = e3t_n(:,:,jk)                      * tmask(:,:,jk)  ! initial vertical scale factors
-               hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * e3t_n(:,:,jk) * tmask(:,:,jk)  ! initial heat content
-               sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * e3t_n(:,:,jk) * tmask(:,:,jk)  ! initial salt content
+               e3t_ini   (:,:,jk) = e3t(:,:,jk,Kmm)                      * tmask(:,:,jk)  ! initial vertical scale factors
+               tmask_ini (:,:,jk) = tmask(:,:,jk)                                       ! initial mask
+               hc_loc_ini(:,:,jk) = ts(:,:,jk,jp_tem,Kmm) * e3t(:,:,jk,Kmm) * tmask(:,:,jk)  ! initial heat content
+               sc_loc_ini(:,:,jk) = ts(:,:,jk,jp_sal,Kmm) * e3t(:,:,jk,Kmm) * tmask(:,:,jk)  ! initial salt content
             END DO
             frc_v = 0._wp                                           ! volume       trend due to forcing
@@ -295,11 +299,11 @@
                   DO ji = 1, jpi
                      DO jj = 1, jpj
-                        ssh_hc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj)   ! initial heat content in ssh
-                        ssh_sc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj)   ! initial salt content in ssh
+                        ssh_hc_loc_ini(ji,jj) = ts(ji,jj,mikt(ji,jj),jp_tem,Kmm) * ssh(ji,jj,Kmm)   ! initial heat content in ssh
+                        ssh_sc_loc_ini(ji,jj) = ts(ji,jj,mikt(ji,jj),jp_sal,Kmm) * ssh(ji,jj,Kmm)   ! initial salt content in ssh
                      END DO
                    END DO
                 ELSE
-                  ssh_hc_loc_ini(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:)   ! initial heat content in ssh
-                  ssh_sc_loc_ini(:,:) = tsn(:,:,1,jp_sal) * sshn(:,:)   ! initial salt content in ssh
+                  ssh_hc_loc_ini(:,:) = ts(:,:,1,jp_tem,Kmm) * ssh(:,:,Kmm)   ! initial heat content in ssh
+                  ssh_sc_loc_ini(:,:) = ts(:,:,1,jp_sal,Kmm) * ssh(:,:,Kmm)   ! initial salt content in ssh
                END IF
                frc_wn_t = 0._wp                                       ! initial heat content misfit due to free surface
@@ -325,4 +329,5 @@
          CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini'   , ssh_ini   , ldxios = lwxios )
          CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini'   , e3t_ini   , ldxios = lwxios )
+         CALL iom_rstput( kt, nitrst, numrow, 'tmask_ini' , tmask_ini , ldxios = lwxios )
          CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini, ldxios = lwxios )
          CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini, ldxios = lwxios )
@@ -338,5 +343,5 @@
 
 
-   SUBROUTINE dia_hsb_init
+   SUBROUTINE dia_hsb_init( Kmm )
       !!---------------------------------------------------------------------------
       !!                  ***  ROUTINE dia_hsb  ***
@@ -350,4 +355,6 @@
       !!             - Compute coefficients for conversion
       !!---------------------------------------------------------------------------
+      INTEGER, INTENT(in) :: Kmm ! time level index
+      !
       INTEGER ::   ierror, ios   ! local integer
       !!
@@ -360,8 +367,6 @@
          WRITE(numout,*) '~~~~~~~~~~~~ '
       ENDIF
-      REWIND( numnam_ref )              ! Namelist namhsb in reference namelist
       READ  ( numnam_ref, namhsb, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namhsb in reference namelist' )
-      REWIND( numnam_cfg )              ! Namelist namhsb in configuration namelist
       READ  ( numnam_cfg, namhsb, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namhsb in configuration namelist' )
@@ -396,5 +401,5 @@
       ! ------------------- !
       ALLOCATE( hc_loc_ini(jpi,jpj,jpk), sc_loc_ini(jpi,jpj,jpk), surf_ini(jpi,jpj), &
-         &      e3t_ini(jpi,jpj,jpk), surf(jpi,jpj),  ssh_ini(jpi,jpj), STAT=ierror  )
+         &      e3t_ini(jpi,jpj,jpk), surf(jpi,jpj),  ssh_ini(jpi,jpj), tmask_ini(jpi,jpj,jpk),STAT=ierror  )
       IF( ierror > 0 ) THEN
          CALL ctl_stop( 'dia_hsb_init: unable to allocate hc_loc_ini' )   ;   RETURN
@@ -417,5 +422,5 @@
       ! 4 - initial conservation variables !
       ! ---------------------------------- !
-      CALL dia_hsb_rst( nit000, 'READ' )  !* read or initialize all required files
+      CALL dia_hsb_rst( nit000, Kmm, 'READ' )  !* read or initialize all required files
       !
    END SUBROUTINE dia_hsb_init
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/diahth.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/diahth.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/diahth.F90	(revision 12928)
@@ -21,4 +21,5 @@
    USE lib_mpp         ! MPP library
    USE iom             ! I/O library
+   USE timing          ! performance summary
 
    IMPLICIT NONE
@@ -26,8 +27,20 @@
 
    PUBLIC   dia_hth       ! routine called by step.F90
-   PUBLIC   dia_hth_init  ! routine called by nemogcm.F90
-
-   LOGICAL, PUBLIC ::   ll_diahth   !: Compute further diagnostics of ML and thermocline depth
-
+   PUBLIC   dia_hth_alloc ! routine called by nemogcm.F90
+
+   LOGICAL, SAVE  ::   l_hth     !: thermocline-20d depths flag
+   
+   ! note: following variables should move to local variables once iom_put is always used 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hth    !: depth of the max vertical temperature gradient [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hd20   !: depth of 20 C isotherm                         [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hd26   !: depth of 26 C isotherm                         [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hd28   !: depth of 28 C isotherm                         [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   htc3   !: heat content of first 300 m                    [W]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   htc7   !: heat content of first 700 m                    [W]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   htc20  !: heat content of first 2000 m                   [W]
+
+
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -37,299 +50,320 @@
 CONTAINS
 
-
-   SUBROUTINE dia_hth( kt )
-     !!---------------------------------------------------------------------
-     !!                  ***  ROUTINE dia_hth  ***
-     !!
-     !! ** Purpose : Computes
-     !!      the mixing layer depth (turbocline): avt = 5.e-4
-     !!      the depth of strongest vertical temperature gradient
-     !!      the mixed layer depth with density     criteria: rho = rho(10m or surf) + 0.03(or 0.01)
-     !!      the mixed layer depth with temperature criteria: abs( tn - tn(10m) ) = 0.2
-     !!      the top of the thermochine: tn = tn(10m) - ztem2
-     !!      the pycnocline depth with density criteria equivalent to a temperature variation
-     !!                rho = rho10m + (dr/dT)(T,S,10m)*(-0.2 degC)
-     !!      the barrier layer thickness
-     !!      the maximal verical inversion of temperature and its depth max( 0, max of tn - tn(10m) )
-     !!      the depth of the 20 degree isotherm (linear interpolation)
-     !!      the depth of the 28 degree isotherm (linear interpolation)
-     !!      the heat content of first 300 m
-     !!
-     !! ** Method :
-     !!-------------------------------------------------------------------
-     INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
-     !!
-     INTEGER                          ::   ji, jj, jk            ! dummy loop arguments
-     INTEGER                          ::   iid, ilevel           ! temporary integers
-     INTEGER, DIMENSION(jpi,jpj) ::   ik20, ik28  ! levels
-     REAL(wp)                         ::   zavt5 = 5.e-4_wp      ! Kz criterion for the turbocline depth
-     REAL(wp)                         ::   zrho3 = 0.03_wp       ! density     criterion for mixed layer depth
-     REAL(wp)                         ::   zrho1 = 0.01_wp       ! density     criterion for mixed layer depth
-     REAL(wp)                         ::   ztem2 = 0.2_wp        ! temperature criterion for mixed layer depth
-     REAL(wp)                         ::   zthick_0, zcoef       ! temporary scalars
-     REAL(wp)                         ::   zztmp, zzdep          ! temporary scalars inside do loop
-     REAL(wp)                         ::   zu, zv, zw, zut, zvt  ! temporary workspace
-     REAL(wp), DIMENSION(jpi,jpj) ::   zabs2      ! MLD: abs( tn - tn(10m) ) = ztem2
-     REAL(wp), DIMENSION(jpi,jpj) ::   ztm2       ! Top of thermocline: tn = tn(10m) - ztem2
-     REAL(wp), DIMENSION(jpi,jpj) ::   zrho10_3   ! MLD: rho = rho10m + zrho3
-     REAL(wp), DIMENSION(jpi,jpj) ::   zpycn      ! pycnocline: rho = rho10m + (dr/dT)(T,S,10m)*(-0.2 degC)
-     REAL(wp), DIMENSION(jpi,jpj) ::   ztinv      ! max of temperature inversion
-     REAL(wp), DIMENSION(jpi,jpj) ::   zdepinv    ! depth of temperature inversion
-     REAL(wp), DIMENSION(jpi,jpj) ::   zrho0_3    ! MLD rho = rho(surf) = 0.03
-     REAL(wp), DIMENSION(jpi,jpj) ::   zrho0_1    ! MLD rho = rho(surf) = 0.01
-     REAL(wp), DIMENSION(jpi,jpj) ::   zmaxdzT    ! max of dT/dz
-     REAL(wp), DIMENSION(jpi,jpj) ::   zthick     ! vertical integration thickness
-     REAL(wp), DIMENSION(jpi,jpj) ::   zdelr      ! delta rho equivalent to deltaT = 0.2
-   ! note: following variables should move to local variables once iom_put is always used
-     REAL(wp), DIMENSION(jpi,jpj) ::   zhth    !: depth of the max vertical temperature gradient [m]
-     REAL(wp), DIMENSION(jpi,jpj) ::   zhd20   !: depth of 20 C isotherm                         [m]
-     REAL(wp), DIMENSION(jpi,jpj) ::   zhd28   !: depth of 28 C isotherm                         [m]
-     REAL(wp), DIMENSION(jpi,jpj) ::   zhtc3   !: heat content of first 300 m                    [W]
-
-     IF (iom_use("mlddzt") .OR. iom_use("mldr0_3") .OR. iom_use("mldr0_1")) THEN
-        ! ------------------------------------------------------------- !
-        ! thermocline depth: strongest vertical gradient of temperature !
-        ! turbocline depth (mixing layer depth): avt = zavt5            !
-        ! MLD: rho = rho(1) + zrho3                                     !
-        ! MLD: rho = rho(1) + zrho1                                     !
-        ! ------------------------------------------------------------- !
-        zmaxdzT(:,:) = 0._wp
-        IF( nla10 > 1 ) THEN
-           DO jj = 1, jpj
-              DO ji = 1, jpi
-                 zztmp = gdepw_n(ji,jj,mbkt(ji,jj)+1)
-                 zrho0_3(ji,jj) = zztmp
-                 zrho0_1(ji,jj) = zztmp
-                 zhth(ji,jj) = zztmp
-              END DO
-           END DO
-        ELSE IF (iom_use("mlddzt")) THEN
-           DO jj = 1, jpj
-              DO ji = 1, jpi
-                 zztmp = gdepw_n(ji,jj,mbkt(ji,jj)+1)
-                 zhth(ji,jj) = zztmp
-              END DO
-           END DO
-        ELSE
-           zhth(:,:) = 0._wp
-
-        ENDIF
-
-        DO jk = jpkm1, 2, -1   ! loop from bottom to 2
-           DO jj = 1, jpj
-              DO ji = 1, jpi
-                 !
-                 zzdep = gdepw_n(ji,jj,jk)
-                 zztmp = ( tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) / zzdep * tmask(ji,jj,jk)   ! vertical gradient of temperature (dT/dz)
-                 zzdep = zzdep * tmask(ji,jj,1)
-
-                 IF( zztmp > zmaxdzT(ji,jj) ) THEN
-                    zmaxdzT(ji,jj) = zztmp   ;   zhth    (ji,jj) = zzdep                ! max and depth of dT/dz
-                 ENDIF
-
-                 IF( nla10 > 1 ) THEN
-                    zztmp = rhop(ji,jj,jk) - rhop(ji,jj,1)                             ! delta rho(1)
-                    IF( zztmp > zrho3 )          zrho0_3(ji,jj) = zzdep                ! > 0.03
-                    IF( zztmp > zrho1 )          zrho0_1(ji,jj) = zzdep                ! > 0.01
-                 ENDIF
-
-              END DO
-           END DO
-        END DO
-
-        IF (iom_use("mlddzt")) CALL iom_put( "mlddzt", zhth*tmask(:,:,1) )            ! depth of the thermocline
-        IF( nla10 > 1 ) THEN
-           IF (iom_use("mldr0_3")) CALL iom_put( "mldr0_3", zrho0_3*tmask(:,:,1) )   ! MLD delta rho(surf) = 0.03
-           IF (iom_use("mldr0_1")) CALL iom_put( "mldr0_1", zrho0_1*tmask(:,:,1) )   ! MLD delta rho(surf) = 0.01
-        ENDIF
+   FUNCTION dia_hth_alloc()
+      !!---------------------------------------------------------------------
+      INTEGER :: dia_hth_alloc
+      !!---------------------------------------------------------------------
+      !
+      ALLOCATE( hth(jpi,jpj), hd20(jpi,jpj), hd26(jpi,jpj), hd28(jpi,jpj), &
+         &      htc3(jpi,jpj), htc7(jpi,jpj), htc20(jpi,jpj), STAT=dia_hth_alloc )
+      !
+      CALL mpp_sum ( 'diahth', dia_hth_alloc )
+      IF(dia_hth_alloc /= 0)   CALL ctl_stop( 'STOP', 'dia_hth_alloc: failed to allocate arrays.' )
+      !
+   END FUNCTION dia_hth_alloc
+
+   SUBROUTINE dia_hth( kt, Kmm )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_hth  ***
+      !!
+      !! ** Purpose : Computes
+      !!      the mixing layer depth (turbocline): avt = 5.e-4
+      !!      the depth of strongest vertical temperature gradient
+      !!      the mixed layer depth with density     criteria: rho = rho(10m or surf) + 0.03(or 0.01)
+      !!      the mixed layer depth with temperature criteria: abs( tn - tn(10m) ) = 0.2       
+      !!      the top of the thermochine: tn = tn(10m) - ztem2 
+      !!      the pycnocline depth with density criteria equivalent to a temperature variation 
+      !!                rho = rho10m + (dr/dT)(T,S,10m)*(-0.2 degC) 
+      !!      the barrier layer thickness
+      !!      the maximal verical inversion of temperature and its depth max( 0, max of tn - tn(10m) )
+      !!      the depth of the 20 degree isotherm (linear interpolation)
+      !!      the depth of the 28 degree isotherm (linear interpolation)
+      !!      the heat content of first 300 m
+      !!
+      !! ** Method : 
+      !!-------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      INTEGER, INTENT( in ) ::   Kmm     ! ocean time level index
+      !!
+      INTEGER                      ::   ji, jj, jk            ! dummy loop arguments
+      REAL(wp)                     ::   zrho3 = 0.03_wp       ! density     criterion for mixed layer depth
+      REAL(wp)                     ::   zrho1 = 0.01_wp       ! density     criterion for mixed layer depth
+      REAL(wp)                     ::   ztem2 = 0.2_wp        ! temperature criterion for mixed layer depth
+      REAL(wp)                     ::   zztmp, zzdep          ! temporary scalars inside do loop
+      REAL(wp)                     ::   zu, zv, zw, zut, zvt  ! temporary workspace
+      REAL(wp), DIMENSION(jpi,jpj) ::   zabs2      ! MLD: abs( tn - tn(10m) ) = ztem2 
+      REAL(wp), DIMENSION(jpi,jpj) ::   ztm2       ! Top of thermocline: tn = tn(10m) - ztem2     
+      REAL(wp), DIMENSION(jpi,jpj) ::   zrho10_3   ! MLD: rho = rho10m + zrho3      
+      REAL(wp), DIMENSION(jpi,jpj) ::   zpycn      ! pycnocline: rho = rho10m + (dr/dT)(T,S,10m)*(-0.2 degC)
+      REAL(wp), DIMENSION(jpi,jpj) ::   ztinv      ! max of temperature inversion
+      REAL(wp), DIMENSION(jpi,jpj) ::   zdepinv    ! depth of temperature inversion
+      REAL(wp), DIMENSION(jpi,jpj) ::   zrho0_3    ! MLD rho = rho(surf) = 0.03
+      REAL(wp), DIMENSION(jpi,jpj) ::   zrho0_1    ! MLD rho = rho(surf) = 0.01
+      REAL(wp), DIMENSION(jpi,jpj) ::   zmaxdzT    ! max of dT/dz
+      REAL(wp), DIMENSION(jpi,jpj) ::   zdelr      ! delta rho equivalent to deltaT = 0.2
+      !!----------------------------------------------------------------------
+      IF( ln_timing )   CALL timing_start('dia_hth')
+
+      IF( kt == nit000 ) THEN
+         l_hth = .FALSE.
+         IF(   iom_use( 'mlddzt'   ) .OR. iom_use( 'mldr0_3'  ) .OR. iom_use( 'mldr0_1'  )    .OR.  & 
+            &  iom_use( 'mld_dt02' ) .OR. iom_use( 'topthdep' ) .OR. iom_use( 'mldr10_3' )    .OR.  &    
+            &  iom_use( '20d'      ) .OR. iom_use( '26d'      ) .OR. iom_use( '28d'      )    .OR.  &    
+            &  iom_use( 'hc300'    ) .OR. iom_use( 'hc700'    ) .OR. iom_use( 'hc2000'   )    .OR.  &    
+            &  iom_use( 'pycndep'  ) .OR. iom_use( 'tinv'     ) .OR. iom_use( 'depti'    )  ) l_hth = .TRUE.
+         !                                      ! allocate dia_hth array
+         IF( l_hth ) THEN 
+            IF( dia_hth_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_hth : unable to allocate standard arrays' )
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'dia_hth : diagnostics of the thermocline depth'
+            IF(lwp) WRITE(numout,*) '~~~~~~~ '
+            IF(lwp) WRITE(numout,*)
+         ENDIF
+      ENDIF
+
+      IF( l_hth ) THEN
+         !
+         IF( iom_use( 'mlddzt' ) .OR. iom_use( 'mldr0_3' ) .OR. iom_use( 'mldr0_1' ) ) THEN
+            ! initialization
+            ztinv  (:,:) = 0._wp  
+            zdepinv(:,:) = 0._wp  
+            zmaxdzT(:,:) = 0._wp  
+            DO_2D_11_11
+               zztmp = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) 
+               hth     (ji,jj) = zztmp
+               zabs2   (ji,jj) = zztmp
+               ztm2    (ji,jj) = zztmp
+               zrho10_3(ji,jj) = zztmp
+               zpycn   (ji,jj) = zztmp
+            END_2D
+            IF( nla10 > 1 ) THEN 
+               DO_2D_11_11
+                  zztmp = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) 
+                  zrho0_3(ji,jj) = zztmp
+                  zrho0_1(ji,jj) = zztmp
+               END_2D
+            ENDIF
+      
+            ! Preliminary computation
+            ! computation of zdelr = (dr/dT)(T,S,10m)*(-0.2 degC)
+            DO_2D_11_11
+               IF( tmask(ji,jj,nla10) == 1. ) THEN
+                  zu  =  1779.50 + 11.250 * ts(ji,jj,nla10,jp_tem,Kmm) - 3.80   * ts(ji,jj,nla10,jp_sal,Kmm)  &
+                     &           - 0.0745 * ts(ji,jj,nla10,jp_tem,Kmm) * ts(ji,jj,nla10,jp_tem,Kmm)   &
+                     &           - 0.0100 * ts(ji,jj,nla10,jp_tem,Kmm) * ts(ji,jj,nla10,jp_sal,Kmm)
+                  zv  =  5891.00 + 38.000 * ts(ji,jj,nla10,jp_tem,Kmm) + 3.00   * ts(ji,jj,nla10,jp_sal,Kmm)  &
+                     &           - 0.3750 * ts(ji,jj,nla10,jp_tem,Kmm) * ts(ji,jj,nla10,jp_tem,Kmm)
+                  zut =    11.25 -  0.149 * ts(ji,jj,nla10,jp_tem,Kmm) - 0.01   * ts(ji,jj,nla10,jp_sal,Kmm)
+                  zvt =    38.00 -  0.750 * ts(ji,jj,nla10,jp_tem,Kmm)
+                  zw  = (zu + 0.698*zv) * (zu + 0.698*zv)
+                  zdelr(ji,jj) = ztem2 * (1000.*(zut*zv - zvt*zu)/zw)
+               ELSE
+                  zdelr(ji,jj) = 0._wp
+               ENDIF
+            END_2D
+
+            ! ------------------------------------------------------------- !
+            ! thermocline depth: strongest vertical gradient of temperature !
+            ! turbocline depth (mixing layer depth): avt = zavt5            !
+            ! MLD: rho = rho(1) + zrho3                                     !
+            ! MLD: rho = rho(1) + zrho1                                     !
+            ! ------------------------------------------------------------- !
+            DO_3DS_11_11( jpkm1, 2, -1 )
+               !
+               zzdep = gdepw(ji,jj,jk,Kmm)
+               zztmp = ( ts(ji,jj,jk-1,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm) ) &
+                      & / zzdep * tmask(ji,jj,jk)   ! vertical gradient of temperature (dT/dz)
+               zzdep = zzdep * tmask(ji,jj,1)
+
+               IF( zztmp > zmaxdzT(ji,jj) ) THEN                        
+                   zmaxdzT(ji,jj) = zztmp   
+                   hth    (ji,jj) = zzdep                ! max and depth of dT/dz
+               ENDIF
+         
+               IF( nla10 > 1 ) THEN 
+                  zztmp = rhop(ji,jj,jk) - rhop(ji,jj,1)                       ! delta rho(1)
+                  IF( zztmp > zrho3 )   zrho0_3(ji,jj) = zzdep                ! > 0.03
+                  IF( zztmp > zrho1 )   zrho0_1(ji,jj) = zzdep                ! > 0.01
+               ENDIF
+            END_3D
+         
+            CALL iom_put( 'mlddzt', hth*tmask(:,:,1) )            ! depth of the thermocline
+            IF( nla10 > 1 ) THEN 
+               CALL iom_put( 'mldr0_3', zrho0_3*tmask(:,:,1) )   ! MLD delta rho(surf) = 0.03
+               CALL iom_put( 'mldr0_1', zrho0_1*tmask(:,:,1) )   ! MLD delta rho(surf) = 0.01
+            ENDIF
+            !
+         ENDIF
+         !
+         IF(  iom_use( 'mld_dt02' ) .OR. iom_use( 'topthdep' ) .OR. iom_use( 'mldr10_3' ) .OR.  &    
+            &  iom_use( 'pycndep' ) .OR. iom_use( 'tinv'     ) .OR. iom_use( 'depti'    )  ) THEN
+            ! ------------------------------------------------------------- !
+            ! MLD: abs( tn - tn(10m) ) = ztem2                              !
+            ! Top of thermocline: tn = tn(10m) - ztem2                      !
+            ! MLD: rho = rho10m + zrho3                                     !
+            ! pycnocline: rho = rho10m + (dr/dT)(T,S,10m)*(-0.2 degC)       !
+            ! temperature inversion: max( 0, max of tn - tn(10m) )          !
+            ! depth of temperature inversion                                !
+            ! ------------------------------------------------------------- !
+            DO_3DS_11_11( jpkm1, nlb10, -1 )
+               !
+               zzdep = gdepw(ji,jj,jk,Kmm) * tmask(ji,jj,1)
+               !
+               zztmp = ts(ji,jj,nla10,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm)  ! - delta T(10m)
+               IF( ABS(zztmp) > ztem2 )      zabs2   (ji,jj) = zzdep   ! abs > 0.2
+               IF(     zztmp  > ztem2 )      ztm2    (ji,jj) = zzdep   ! > 0.2
+               zztmp = -zztmp                                          ! delta T(10m)
+               IF( zztmp >  ztinv(ji,jj) ) THEN                        ! temperature inversion
+                  ztinv(ji,jj) = zztmp   
+                  zdepinv (ji,jj) = zzdep   ! max value and depth
+               ENDIF
+
+               zztmp = rhop(ji,jj,jk) - rhop(ji,jj,nla10)              ! delta rho(10m)
+               IF( zztmp > zrho3        )    zrho10_3(ji,jj) = zzdep   ! > 0.03
+               IF( zztmp > zdelr(ji,jj) )    zpycn   (ji,jj) = zzdep   ! > equi. delta T(10m) - 0.2
+               !
+            END_3D
+
+        CALL iom_put( "mld_dt02", zabs2*tmask(:,:,1)        )   ! MLD abs(delta t) - 0.2
+        CALL iom_put( "topthdep", ztm2*tmask(:,:,1)         )   ! T(10) - 0.2
+        CALL iom_put( "mldr10_3", zrho10_3*tmask(:,:,1)     )   ! MLD delta rho(10m) = 0.03
+        CALL iom_put( "pycndep" , zpycn*tmask(:,:,1)        )   ! MLD delta rho equi. delta T(10m) = 0.2
+        CALL iom_put( "tinv"    , ztinv*tmask(:,:,1)        )   ! max. temp. inv. (t10 ref)
+        CALL iom_put( "depti"   , zdepinv*tmask(:,:,1)      )   ! depth of max. temp. inv. (t10 ref)
      ENDIF
-
-     IF (iom_use("mld_dt02") .OR. iom_use("topthdep") .OR. iom_use("mldr10_3") .OR.  &
-          & iom_use("pycndep") .OR. iom_use("tinv") .OR. iom_use("depti")) THEN
-        DO jj = 1, jpj
-           DO ji = 1, jpi
-              zztmp = gdepw_n(ji,jj,mbkt(ji,jj)+1)
-              zabs2   (ji,jj) = zztmp
-              ztm2    (ji,jj) = zztmp
-              zrho10_3(ji,jj) = zztmp
-              zpycn   (ji,jj) = zztmp
-           END DO
-        END DO
-        ztinv  (:,:) = 0._wp
-        zdepinv(:,:) = 0._wp
-
-        IF (iom_use("pycndep")) THEN
-           ! Preliminary computation
-           ! computation of zdelr = (dr/dT)(T,S,10m)*(-0.2 degC)
-           DO jj = 1, jpj
-              DO ji = 1, jpi
-                 IF( tmask(ji,jj,nla10) == 1. ) THEN
-                    zu  =  1779.50 + 11.250 * tsn(ji,jj,nla10,jp_tem) - 3.80   * tsn(ji,jj,nla10,jp_sal)                             &
-                         &                                              - 0.0745 * tsn(ji,jj,nla10,jp_tem) * tsn(ji,jj,nla10,jp_tem)   &
-                         &                                              - 0.0100 * tsn(ji,jj,nla10,jp_tem) * tsn(ji,jj,nla10,jp_sal)
-                    zv  =  5891.00 + 38.000 * tsn(ji,jj,nla10,jp_tem) + 3.00   * tsn(ji,jj,nla10,jp_sal)                             &
-                         &                                              - 0.3750 * tsn(ji,jj,nla10,jp_tem) * tsn(ji,jj,nla10,jp_tem)
-                    zut =    11.25 -  0.149 * tsn(ji,jj,nla10,jp_tem) - 0.01   * tsn(ji,jj,nla10,jp_sal)
-                    zvt =    38.00 -  0.750 * tsn(ji,jj,nla10,jp_tem)
-                    zw  = (zu + 0.698*zv) * (zu + 0.698*zv)
-                    zdelr(ji,jj) = ztem2 * (1000.*(zut*zv - zvt*zu)/zw)
-                 ELSE
-                    zdelr(ji,jj) = 0._wp
-                 ENDIF
-              END DO
-           END DO
-        ELSE
-           zdelr(:,:) = 0._wp
-        ENDIF
-
-        ! ------------------------------------------------------------- !
-        ! MLD: abs( tn - tn(10m) ) = ztem2                              !
-        ! Top of thermocline: tn = tn(10m) - ztem2                      !
-        ! MLD: rho = rho10m + zrho3                                     !
-        ! pycnocline: rho = rho10m + (dr/dT)(T,S,10m)*(-0.2 degC)       !
-        ! temperature inversion: max( 0, max of tn - tn(10m) )          !
-        ! depth of temperature inversion                                !
-        ! ------------------------------------------------------------- !
-        DO jk = jpkm1, nlb10, -1   ! loop from bottom to nlb10
-           DO jj = 1, jpj
-              DO ji = 1, jpi
-                 !
-                 zzdep = gdepw_n(ji,jj,jk) * tmask(ji,jj,1)
-                 !
-                 zztmp = tsn(ji,jj,nla10,jp_tem) - tsn(ji,jj,jk,jp_tem)  ! - delta T(10m)
-                 IF( ABS(zztmp) > ztem2 )      zabs2   (ji,jj) = zzdep   ! abs > 0.2
-                 IF(     zztmp  > ztem2 )      ztm2    (ji,jj) = zzdep   ! > 0.2
-                 zztmp = -zztmp                                          ! delta T(10m)
-                 IF( zztmp >  ztinv(ji,jj) ) THEN                        ! temperature inversion
-                    ztinv(ji,jj) = zztmp   ;   zdepinv (ji,jj) = zzdep   ! max value and depth
-                 ENDIF
-
-                 zztmp = rhop(ji,jj,jk) - rhop(ji,jj,nla10)              ! delta rho(10m)
-                 IF( zztmp > zrho3        )    zrho10_3(ji,jj) = zzdep   ! > 0.03
-                 IF( zztmp > zdelr(ji,jj) )    zpycn   (ji,jj) = zzdep   ! > equi. delta T(10m) - 0.2
-                 !
-              END DO
-           END DO
-        END DO
-
-        IF (iom_use("mld_dt02")) CALL iom_put( "mld_dt02", zabs2*tmask(:,:,1)        )   ! MLD abs(delta t) - 0.2
-        IF (iom_use("topthdep")) CALL iom_put( "topthdep", ztm2*tmask(:,:,1)         )   ! T(10) - 0.2
-        IF (iom_use("mldr10_3")) CALL iom_put( "mldr10_3", zrho10_3*tmask(:,:,1)     )   ! MLD delta rho(10m) = 0.03
-        IF (iom_use("pycndep")) CALL iom_put( "pycndep" , zpycn*tmask(:,:,1)        )   ! MLD delta rho equi. delta T(10m) = 0.2
-        IF (iom_use("tinv")) CALL iom_put( "tinv"    , ztinv*tmask(:,:,1)        )   ! max. temp. inv. (t10 ref)
-        IF (iom_use("depti")) CALL iom_put( "depti"   , zdepinv*tmask(:,:,1)      )   ! depth of max. temp. inv. (t10 ref)
-     ENDIF
-
-     IF(iom_use("20d") .OR. iom_use("28d")) THEN
-        ! ----------------------------------- !
-        ! search deepest level above 20C/28C  !
-        ! ----------------------------------- !
-        ik20(:,:) = 1
-        ik28(:,:) = 1
-        DO jk = 1, jpkm1   ! beware temperature is not always decreasing with depth => loop from top to bottom
-           DO jj = 1, jpj
-              DO ji = 1, jpi
-                 zztmp = tsn(ji,jj,jk,jp_tem)
-                 IF( zztmp >= 20. )   ik20(ji,jj) = jk
-                 IF( zztmp >= 28. )   ik28(ji,jj) = jk
-              END DO
-           END DO
-        END DO
-
-        ! --------------------------- !
-        !  Depth of 20C/28C isotherm  !
-        ! --------------------------- !
-        DO jj = 1, jpj
-           DO ji = 1, jpi
-              !
-              zzdep = gdepw_n(ji,jj,mbkt(ji,jj)+1)       ! depth of the oean bottom
-              !
-              iid = ik20(ji,jj)
-              IF( iid /= 1 ) THEN
-                 zztmp =      gdept_n(ji,jj,iid  )   &                     ! linear interpolation
-                      &  + (    gdept_n(ji,jj,iid+1) - gdept_n(ji,jj,iid)                       )   &
-                      &  * ( 20.*tmask(ji,jj,iid+1) - tsn(ji,jj,iid,jp_tem)                       )   &
-                      &  / ( tsn(ji,jj,iid+1,jp_tem) - tsn(ji,jj,iid,jp_tem) + (1.-tmask(ji,jj,1)) )
-                 zhd20(ji,jj) = MIN( zztmp , zzdep) * tmask(ji,jj,1)       ! bound by the ocean depth
-              ELSE
-                 zhd20(ji,jj) = 0._wp
-              ENDIF
-              !
-              iid = ik28(ji,jj)
-              IF( iid /= 1 ) THEN
-                 zztmp =      gdept_n(ji,jj,iid  )   &                     ! linear interpolation
-                      &  + (    gdept_n(ji,jj,iid+1) - gdept_n(ji,jj,iid)                       )   &
-                      &  * ( 28.*tmask(ji,jj,iid+1) -    tsn(ji,jj,iid,jp_tem)                       )   &
-                      &  / (  tsn(ji,jj,iid+1,jp_tem) -    tsn(ji,jj,iid,jp_tem) + (1.-tmask(ji,jj,1)) )
-                 zhd28(ji,jj) = MIN( zztmp , zzdep ) * tmask(ji,jj,1)      ! bound by the ocean depth
-              ELSE
-                 zhd28(ji,jj) = 0._wp
-              ENDIF
-
-           END DO
-        END DO
-        CALL iom_put( "20d", zhd20 )   ! depth of the 20 isotherm
-        CALL iom_put( "28d", zhd28 )   ! depth of the 28 isotherm
-     ENDIF
-
-     ! ----------------------------- !
-     !  Heat content of first 300 m  !
-     ! ----------------------------- !
-     IF (iom_use("hc300")) THEN
-        ! find ilevel with (ilevel+1) the deepest W-level above 300m (we assume we can use e3t_1d to do this search...)
-        ilevel   = 0
-        zthick_0 = 0._wp
-        DO jk = 1, jpkm1
-           zthick_0 = zthick_0 + e3t_1d(jk)
-           IF( zthick_0 < 300. )   ilevel = jk
-        END DO
-        ! surface boundary condition
-        IF( ln_linssh ) THEN   ;   zthick(:,:) = sshn(:,:)   ;   zhtc3(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) * tmask(:,:,1)
-        ELSE                   ;   zthick(:,:) = 0._wp       ;   zhtc3(:,:) = 0._wp
-        ENDIF
-        ! integration down to ilevel
-        DO jk = 1, ilevel
-           zthick(:,:) = zthick(:,:) + e3t_n(:,:,jk)
-           zhtc3  (:,:) = zhtc3  (:,:) + e3t_n(:,:,jk) * tsn(:,:,jk,jp_tem) * tmask(:,:,jk)
-        END DO
-        ! deepest layer
-        zthick(:,:) = 300. - zthick(:,:)   !   remaining thickness to reach 300m
-        DO jj = 1, jpj
-           DO ji = 1, jpi
-              zhtc3(ji,jj) = zhtc3(ji,jj) + tsn(ji,jj,ilevel+1,jp_tem)                  &
-                   &                      * MIN( e3t_n(ji,jj,ilevel+1), zthick(ji,jj) ) * tmask(ji,jj,ilevel+1)
-           END DO
-        END DO
-        ! from temperature to heat contain
-        zcoef = rau0 * rcp
-        zhtc3(:,:) = zcoef * zhtc3(:,:)
-        CALL iom_put( "hc300", zhtc3*tmask(:,:,1) )      ! first 300m heat content
-     ENDIF
-     !
+ 
+         ! ------------------------------- !
+         !  Depth of 20C/26C/28C isotherm  !
+         ! ------------------------------- !
+         IF( iom_use ('20d') ) THEN  ! depth of the 20 isotherm
+            ztem2 = 20.
+            CALL dia_hth_dep( Kmm, ztem2, hd20 )  
+            CALL iom_put( '20d', hd20 )    
+         ENDIF
+         !
+         IF( iom_use ('26d') ) THEN  ! depth of the 26 isotherm
+            ztem2 = 26.
+            CALL dia_hth_dep( Kmm, ztem2, hd26 )  
+            CALL iom_put( '26d', hd26 )    
+         ENDIF
+         !
+         IF( iom_use ('28d') ) THEN  ! depth of the 28 isotherm
+            ztem2 = 28.
+            CALL dia_hth_dep( Kmm, ztem2, hd28 )  
+            CALL iom_put( '28d', hd28 )    
+         ENDIF
+        
+         ! ----------------------------- !
+         !  Heat content of first 300 m  !
+         ! ----------------------------- !
+         IF( iom_use ('hc300') ) THEN  
+            zzdep = 300.
+            CALL  dia_hth_htc( Kmm, zzdep, ts(:,:,:,jp_tem,Kmm), htc3 )
+            CALL iom_put( 'hc300', rho0_rcp * htc3*tmask(:,:,1) )  ! vertically integrated heat content (J/m2)
+         ENDIF
+         !
+         ! ----------------------------- !
+         !  Heat content of first 700 m  !
+         ! ----------------------------- !
+         IF( iom_use ('hc700') ) THEN  
+            zzdep = 700.
+            CALL  dia_hth_htc( Kmm, zzdep, ts(:,:,:,jp_tem,Kmm), htc7 )
+            CALL iom_put( 'hc700', rho0_rcp * htc7 )  ! vertically integrated heat content (J/m2)
+  
+         ENDIF
+         !
+         ! ----------------------------- !
+         !  Heat content of first 2000 m  !
+         ! ----------------------------- !
+         IF( iom_use ('hc2000') ) THEN  
+            zzdep = 2000.
+            CALL  dia_hth_htc( Kmm, zzdep, ts(:,:,:,jp_tem,Kmm), htc20 )
+            CALL iom_put( 'hc2000', rho0_rcp * htc20 )  ! vertically integrated heat content (J/m2)  
+         ENDIF
+         !
+      ENDIF
+
+      !
+      IF( ln_timing )   CALL timing_stop('dia_hth')
+      !
    END SUBROUTINE dia_hth
 
-
-   SUBROUTINE dia_hth_init
-      !!---------------------------------------------------------------------------
-      !!                  ***  ROUTINE dia_hth_init  ***
-      !!
-      !! ** Purpose: Initialization for ML and thermocline depths
-      !!
-      !! ** Action : If any upper ocean diagnostic required by xml file, set in dia_hth
-      !!---------------------------------------------------------------------------
-       !
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'dia_hth_init : heat and salt budgets diagnostics'
-         WRITE(numout,*) '~~~~~~~~~~~~ '
+   SUBROUTINE dia_hth_dep( Kmm, ptem, pdept )
+      !
+      INTEGER , INTENT(in) :: Kmm      ! ocean time level index
+      REAL(wp), INTENT(in) :: ptem
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(out) :: pdept     
+      !
+      INTEGER  :: ji, jj, jk, iid
+      REAL(wp) :: zztmp, zzdep
+      INTEGER, DIMENSION(jpi,jpj) :: iktem
+      
+      ! --------------------------------------- !
+      ! search deepest level above ptem         !
+      ! --------------------------------------- !
+      iktem(:,:) = 1
+      DO_3D_11_11( 1, jpkm1 )
+         zztmp = ts(ji,jj,jk,jp_tem,Kmm)
+         IF( zztmp >= ptem )   iktem(ji,jj) = jk
+      END_3D
+
+      ! ------------------------------- !
+      !  Depth of ptem isotherm         !
+      ! ------------------------------- !
+      DO_2D_11_11
+         !
+         zzdep = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm)       ! depth of the ocean bottom
+         !
+         iid = iktem(ji,jj)
+         IF( iid /= 1 ) THEN 
+             zztmp =     gdept(ji,jj,iid  ,Kmm)   &                     ! linear interpolation
+               &  + (    gdept(ji,jj,iid+1,Kmm) - gdept(ji,jj,iid,Kmm)                       )   &
+               &  * ( 20.*tmask(ji,jj,iid+1) - ts(ji,jj,iid,jp_tem,Kmm)                       )   &
+               &  / ( ts(ji,jj,iid+1,jp_tem,Kmm) - ts(ji,jj,iid,jp_tem,Kmm) + (1.-tmask(ji,jj,1)) )
+            pdept(ji,jj) = MIN( zztmp , zzdep) * tmask(ji,jj,1)       ! bound by the ocean depth
+         ELSE 
+            pdept(ji,jj) = 0._wp
+         ENDIF
+      END_2D
+      !
+   END SUBROUTINE dia_hth_dep
+
+   SUBROUTINE dia_hth_htc( Kmm, pdep, pt, phtc )
+      !
+      INTEGER , INTENT(in) :: Kmm      ! ocean time level index
+      REAL(wp), INTENT(in) :: pdep     ! depth over the heat content
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pt   
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: phtc  
+      !
+      INTEGER  :: ji, jj, jk, ik
+      REAL(wp), DIMENSION(jpi,jpj) :: zthick
+      INTEGER , DIMENSION(jpi,jpj) :: ilevel
+
+
+      ! surface boundary condition
+      
+      IF( .NOT. ln_linssh ) THEN   ;   zthick(:,:) = 0._wp       ;   phtc(:,:) = 0._wp                                   
+      ELSE                         ;   zthick(:,:) = ssh(:,:,Kmm)   ;   phtc(:,:) = pt(:,:,1) * ssh(:,:,Kmm) * tmask(:,:,1)   
       ENDIF
-      ll_diahth = iom_use("mlddzt") .OR. iom_use("mldr0_3") .OR. iom_use("mldr0_1") .OR.  &
-           & iom_use("mld_dt02") .OR. iom_use("topthdep") .OR. iom_use("mldr10_3") .OR.  &
-           & iom_use("pycndep") .OR. iom_use("tinv") .OR. iom_use("depti").OR. &
-           & iom_use("20d") .OR. iom_use("28d") .OR. iom_use("hc300")
-      IF(lwp) THEN
-         WRITE(numout,*) '   output upper ocean diagnostics (T) or not (F)       ll_diahth = ', ll_diahth
-      ENDIF
-      !
-   END SUBROUTINE dia_hth_init
+      !
+      ilevel(:,:) = 1
+      DO_3D_11_11( 2, jpkm1 )
+         IF( ( gdept(ji,jj,jk,Kmm) < pdep ) .AND. ( tmask(ji,jj,jk) == 1 ) ) THEN
+             ilevel(ji,jj) = jk
+             zthick(ji,jj) = zthick(ji,jj) + e3t(ji,jj,jk,Kmm)
+             phtc  (ji,jj) = phtc  (ji,jj) + e3t(ji,jj,jk,Kmm) * pt(ji,jj,jk)
+         ENDIF
+      END_3D
+      !
+      DO_2D_11_11
+         ik = ilevel(ji,jj)
+         zthick(ji,jj) = pdep - zthick(ji,jj)   !   remaining thickness to reach depht pdep
+         phtc(ji,jj)   = phtc(ji,jj) + pt(ji,jj,ik+1) * MIN( e3t(ji,jj,ik+1,Kmm), zthick(ji,jj) ) &
+                                                       * tmask(ji,jj,ik+1)
+      END_2D
+      !
+      !
+   END SUBROUTINE dia_hth_htc
+
+   !!======================================================================
 END MODULE diahth
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/diamlr.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/diamlr.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/diamlr.F90	(revision 12928)
@@ -0,0 +1,424 @@
+MODULE diamlr
+   !!======================================================================
+   !!                       ***  MODULE  diamlr  ***
+   !! Management of the IOM context for multiple-linear-regression analysis
+   !!======================================================================
+   !! History :       !  2019  (S. Mueller)
+   !!----------------------------------------------------------------------
+
+   USE par_oce        , ONLY :   wp, jpi, jpj
+   USE phycst         , ONLY :   rpi
+   USE in_out_manager , ONLY :   lwp, numout, ln_timing
+   USE iom            , ONLY :   iom_put, iom_use, iom_update_file_name
+   USE dom_oce        , ONLY :   adatrj
+   USE timing         , ONLY :   timing_start, timing_stop
+#if defined key_iomput
+   USE xios
+#endif
+   USE tide_mod
+
+   IMPLICIT NONE
+   PRIVATE
+
+   LOGICAL, PUBLIC ::   lk_diamlr = .FALSE.
+
+   PUBLIC ::   dia_mlr_init, dia_mlr_iom_init, dia_mlr
+
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2019)
+   !! $Id$
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+   
+   SUBROUTINE dia_mlr_init
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE dia_mlr_init  ***
+      !!
+      !! ** Purpose : initialisation of IOM context management for 
+      !!              multiple-linear-regression analysis
+      !!
+      !!----------------------------------------------------------------------
+
+      lk_diamlr = .TRUE.
+
+      IF(lwp) THEN
+         WRITE(numout, *)
+         WRITE(numout, *) 'dia_mlr_init : initialisation of IOM context management for'
+         WRITE(numout, *) '~~~~~~~~~~~~   multiple-linear-regression analysis'
+      END IF
+
+   END SUBROUTINE dia_mlr_init
+
+   SUBROUTINE dia_mlr_iom_init
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE dia_mlr_iom_init  ***
+      !!
+      !! ** Purpose : IOM context setup for multiple-linear-regression
+      !!              analysis
+      !!
+      !!----------------------------------------------------------------------
+#if defined key_iomput
+
+      TYPE(xios_fieldgroup)                       ::   slxhdl_fldgrp
+      TYPE(xios_filegroup)                        ::   slxhdl_filgrp
+      TYPE(xios_field), ALLOCATABLE, DIMENSION(:) ::   slxhdl_regs,    slxhdl_flds
+      TYPE(xios_field)                            ::   slxhdl_fld
+      TYPE(xios_file)                             ::   slxhdl_fil
+      LOGICAL                                     ::   llxatt_enabled, llxatt_comment
+      CHARACTER(LEN=256)                          ::   clxatt_expr,    clxatt_comment
+      CHARACTER(LEN=32)                           ::   clxatt_name1,   clxatt_name2
+      CHARACTER(LEN=32)                           ::   clxatt_gridref, clxatt_fieldref
+      INTEGER, PARAMETER                          ::   jpscanmax = 999
+      INTEGER                                     ::   ireg, ifld
+      CHARACTER(LEN=3)                            ::   cl3i
+      CHARACTER(LEN=6)                            ::   cl6a
+      CHARACTER(LEN=7)                            ::   cl7a
+      CHARACTER(LEN=1)                            ::   clgt
+      CHARACTER(LEN=2)                            ::   clgd
+      CHARACTER(LEN=25)                           ::   clfloat
+      CHARACTER(LEN=32)                           ::   clrepl
+      INTEGER                                     ::   jl, jm, jn
+      INTEGER                                     ::   itide                       ! Number of available tidal components
+      REAL(wp)                                    ::   ztide_phase                 ! Tidal-constituent phase at adatrj=0
+      CHARACTER (LEN=4), DIMENSION(jpmax_harmo)   ::   ctide_selected = 'n/a '
+      TYPE(tide_harmonic), DIMENSION(:), POINTER  ::   stideconst
+
+      IF(lwp) THEN
+         WRITE(numout, *)
+         WRITE(numout, *) 'dia_mlr_iom_init : IOM context setup for multiple-linear-regression'
+         WRITE(numout, *) '~~~~~~~~~~~~~~~~'
+      END IF
+
+      ! Get handles to multiple-linear-regression analysis configuration (field
+      ! group 'diamrl_fields' and file group 'diamlr_files'); if no suitable
+      ! configuration is found, disable diamlr
+      IF ( lk_diamlr .AND. xios_is_valid_fieldgroup( "diamlr_fields" ) .AND. xios_is_valid_field( "diamlr_time" ) .AND.   &
+         & xios_is_valid_filegroup( "diamlr_files" ) ) THEN
+         CALL xios_get_handle("diamlr_fields", slxhdl_fldgrp)
+         CALL xios_get_handle("diamlr_files",  slxhdl_filgrp)
+      ELSE
+         IF (lwp) THEN
+            WRITE(numout, *) "diamlr: configuration not found or incomplete (field group 'diamlr_fields'"
+            WRITE(numout, *) "        and/or file group 'diamlr_files' and/or field 'diamlr_time' missing);"
+            WRITE(numout, *) "        disabling output for multiple-linear-regression analysis."
+         END IF
+         lk_diamlr = .FALSE.
+      END IF
+
+      ! Set up IOM context for multiple-linear-regression analysis
+      IF ( lk_diamlr ) THEN
+
+         ! Set up output files for grid types scalar, grid_T, grid_U, grid_V,
+         ! and grid_W
+         DO jm = 1, 5
+            SELECT CASE( jm )
+            CASE( 1 )
+               cl6a = 'scalar'
+            CASE( 2 )
+               cl6a = 'grid_T'
+            CASE( 3 )
+               cl6a = 'grid_U'
+            CASE( 4 )
+               cl6a = 'grid_V'
+            CASE( 5 )
+               cl6a = 'grid_W'
+            END SELECT
+            CALL xios_add_child      ( slxhdl_filgrp, slxhdl_fil, "diamlr_file_"//cl6a )
+            CALL xios_set_attr       ( slxhdl_fil, name_suffix="_diamlr_"//cl6a,   &
+               &                       description="Intermediate output for multiple-linear-regression analysis - "//cl6a )
+            CALL iom_update_file_name( "diamlr_file_"//cl6a )
+         END DO
+
+         ! Compile lists of active regressors and of fields selected for
+         ! analysis (fields "diamlr_r<nnn>" and "diamlr_f<nnn>", where <nnn> is
+         ! a 3-digit integer); also carry out placeholder substitution of tidal
+         ! parameters in regressor expressions
+         !
+         ALLOCATE( slxhdl_regs( jpscanmax ), slxhdl_flds( jpscanmax ) )
+         ireg = 0
+         ifld = 0
+         !
+         IF ( ln_tide ) THEN
+            ! Retrieve information (frequency, phase, nodal correction) about all
+            ! available tidal constituents for placeholder substitution below
+            ! Warning: we must use the same character length in an array constructor (at least for gcc compiler)
+            ctide_selected(1:34) = (/ 'Mf  ', 'Mm  ', 'Ssa ', 'Mtm ', 'Msf ',         &
+               &                      'Msqm', 'Sa  ', 'K1  ', 'O1  ', 'P1  ',         &
+               &                      'Q1  ', 'J1  ', 'S1  ', 'M2  ', 'S2  ', 'N2  ', &
+               &                      'K2  ', 'nu2 ', 'mu2 ', '2N2 ', 'L2  ',         &
+               &                      'T2  ', 'eps2', 'lam2', 'R2  ', 'M3  ',         &
+               &                      'MKS2', 'MN4 ', 'MS4 ', 'M4  ', 'N4  ',         &
+               &                      'S4  ', 'M6  ', 'M8  ' /)
+            CALL tide_init_harmonics(ctide_selected, stideconst)
+            itide = size(stideconst)
+         ELSE
+            itide = 0
+         ENDIF
+         
+         DO jm = 1, jpscanmax
+            WRITE (cl3i, '(i3.3)') jm
+
+            ! Look for regressor
+            IF ( xios_is_valid_field( "diamlr_r"//cl3i ) ) THEN
+
+               CALL xios_get_handle( "diamlr_r"//cl3i, slxhdl_regs(ireg+1) )
+               ! Retrieve pre-configured value of "enabled" attribute and
+               ! regressor expression
+               CALL xios_get_attr  ( slxhdl_regs(ireg+1), enabled=llxatt_enabled, expr=clxatt_expr )
+               ! If enabled, keep handle in list of active regressors; also
+               ! substitute placeholders for tidal frequencies, phases, and
+               ! nodal corrections in regressor expressions
+               IF ( llxatt_enabled ) THEN
+
+                  ! Substitution of placeholders for tidal-constituent
+                  ! parameters (amplitudes, angular veloccities, nodal phase
+                  ! correction) with values that have been obtained from the
+                  ! tidal-forcing implementation (if enabled)
+                  DO jn = 1, itide
+                     ! Compute phase of tidal constituent (incl. current nodal
+                     ! correction) at the start of the model run (i.e. for
+                     ! adatrj=0)
+                     ztide_phase = MOD( stideconst(jn)%u +  stideconst(jn)%v0 - adatrj * 86400.0_wp * stideconst(jn)%omega, &
+                        & 2.0_wp * rpi )
+                     clrepl = "__TDE_"//TRIM( stideconst(jn)%cname_tide )//"_omega__"
+                     DO WHILE ( INDEX( clxatt_expr, TRIM( clrepl ) ) > 0 )
+                        WRITE (clfloat, '(e25.18)') stideconst(jn)%omega
+                        jl = INDEX( clxatt_expr, TRIM( clrepl ) )
+                        clxatt_expr = clxatt_expr(1:jl - 1)//clfloat//   &
+                           &          clxatt_expr(jl + LEN( TRIM( clrepl ) ):LEN( TRIM( clxatt_expr ) ))
+                     END DO
+                     clrepl = "__TDE_"//TRIM( stideconst(jn)%cname_tide )//"_phase__"
+                     DO WHILE ( INDEX( clxatt_expr, TRIM( clrepl ) ) > 0 )
+                        WRITE (clfloat, '(e25.18)') ztide_phase
+                        jl = INDEX( clxatt_expr, TRIM( clrepl ) )
+                        clxatt_expr = clxatt_expr(1:jl - 1)//clfloat//   &
+                           &          clxatt_expr(jl + LEN( TRIM( clrepl ) ):LEN( TRIM( clxatt_expr ) ))
+                     END DO
+                     clrepl = "__TDE_"//TRIM( stideconst(jn)%cname_tide )//"_amplitude__"
+                     DO WHILE (INDEX( clxatt_expr, TRIM( clrepl ) ) > 0 )
+                        WRITE (clfloat, '(e25.18)') stideconst(jn)%f
+                        jl = INDEX( clxatt_expr, TRIM( clrepl ) )
+                        clxatt_expr = clxatt_expr(1:jl - 1)//clfloat//   &
+                           &          clxatt_expr(jl + LEN( TRIM( clrepl ) ):LEN( TRIM( clxatt_expr ) ))
+                     END DO
+                  END DO
+
+                  ! Set standard value for comment attribute, including possible
+                  ! existing comment added in parantheses
+                  CALL xios_is_defined_attr( slxhdl_regs(ireg+1), comment=llxatt_comment )
+                  IF ( llxatt_comment ) THEN
+                     CALL xios_get_attr( slxhdl_regs(ireg+1), comment=clxatt_comment )
+                     clxatt_comment = "Regressor "//cl3i//" ("//TRIM( clxatt_comment )//") "
+                  ELSE
+                     clxatt_comment = "Regressor "//cl3i
+                  END IF
+
+                  ! Set name attribute (and overwrite possible pre-configured
+                  ! name) with field id to enable id string retrieval from
+                  ! stored handle below, re-set expression with possible
+                  ! substitutions, and set or re-set comment attribute
+                  CALL xios_set_attr  ( slxhdl_regs(ireg+1), name="diamlr_r"//cl3i, expr=TRIM( clxatt_expr ),   &
+                     &                  comment=TRIM( clxatt_comment ) )
+
+                  ireg = ireg + 1   ! Accept regressor in list of active regressors
+
+               END IF
+            END IF
+
+            ! Look for field
+            IF ( xios_is_valid_field( "diamlr_f"//cl3i ) ) THEN
+
+               CALL xios_get_handle( "diamlr_f"//cl3i, slxhdl_flds(ifld+1) )
+               ! Retrieve pre-configured value of "enabled" attribute
+               CALL xios_get_attr  ( slxhdl_flds(ifld+1), enabled=llxatt_enabled )
+               ! If enabled, keep handle in list of fields selected for analysis
+               IF ( llxatt_enabled ) THEN
+                  
+                  ! Set name attribute (and overwrite possible pre-configured name)
+                  ! with field id to enable id string retrieval from stored handle
+                  ! below
+                  CALL xios_set_attr  ( slxhdl_flds(ifld+1), name="diamlr_f"//cl3i )
+
+                  ifld = ifld + 1   ! Accept field in list of fields selected for analysis
+
+               END IF
+            END IF
+
+         END DO
+
+         ! Output number of active regressors and fields selected for analysis
+         IF ( lwp ) WRITE(numout,'(a,i3,a)' ) 'diamlr: ', ireg, ' active regressors found'
+         IF ( lwp ) WRITE(numout,'(a,i3,a)' ) 'diamlr: ', ifld, ' fields selected for analysis'
+
+         ! Set up output of minimum, maximum, and average values of the time
+         ! variable available for the computation of regressors (diamlr_time)
+         CALL xios_get_handle( "diamlr_file_scalar", slxhdl_fil )
+         CALL xios_add_child ( slxhdl_fil, slxhdl_fld, "diamlr_time_average" )
+!$AGRIF_DO_NOT_TREAT
+         CALL xios_set_attr  ( slxhdl_fld, standard_name="diamlr_time",                          &
+            &                  long_name="Elapsed model time at start of regression interval",   &
+            &                  unit="s", operation="average", field_ref="diamlr_time",           &
+            &                  grid_ref="diamlr_grid_2D_to_scalar" )
+!$AGRIF_END_DO_NOT_TREAT
+         CALL xios_add_child ( slxhdl_fil, slxhdl_fld, "diamlr_time_minimum" )
+!$AGRIF_DO_NOT_TREAT
+         CALL xios_set_attr  ( slxhdl_fld, standard_name="diamlr_time",                          &
+            &                  long_name="Elapsed model time at start of regression interval",   &
+            &                  unit="s", operation="minimum", field_ref="diamlr_time",           &
+            &                  grid_ref="diamlr_grid_2D_to_scalar" )
+!$AGRIF_END_DO_NOT_TREAT
+         CALL xios_add_child ( slxhdl_fil, slxhdl_fld, "diamlr_time_maximum" )
+!$AGRIF_DO_NOT_TREAT
+         CALL xios_set_attr  ( slxhdl_fld, standard_name="diamlr_time",                          &
+            &                  long_name="Elapsed model time at start of regression interval",   &
+            &                  unit="s", operation="maximum", field_ref="diamlr_time",           &
+            &                  grid_ref="diamlr_grid_2D_to_scalar" )
+!$AGRIF_END_DO_NOT_TREAT
+
+         ! For each active regressor:
+         DO jm = 1, ireg
+
+            !   i) set up 2-dimensional and 3-dimensional versions of the
+            !      regressors; explicitely set "enabled" attribute; note, while
+            !      the scalar versions of regressors are part of the
+            !      configuration, the respective 2-dimensional versions take
+            !      over the defining expression, while the scalar and
+            !      3-dimensional versions are simply obtained via grid
+            !      transformations from the 2-dimensional version.
+            CALL xios_get_attr  ( slxhdl_regs( jm ), name=clxatt_name1, expr=clxatt_expr,              &
+               &                  enabled=llxatt_enabled, comment=clxatt_comment )
+            CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( clxatt_name1 )//"_grid_T_2D" )
+            CALL xios_set_attr  ( slxhdl_fld, expr=TRIM( clxatt_expr ), grid_ref="diamlr_grid_T_2D",     &
+               &                  field_ref="diamlr_time", enabled=llxatt_enabled )
+            CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( clxatt_name1 )//"_grid_U_2D" )
+            CALL xios_set_attr  ( slxhdl_fld, expr=TRIM( clxatt_expr ), grid_ref="diamlr_grid_U_2D",     &
+               &                  field_ref="diamlr_time", enabled=llxatt_enabled )
+            CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( clxatt_name1 )//"_grid_V_2D" )
+            CALL xios_set_attr  ( slxhdl_fld, expr=TRIM( clxatt_expr ), grid_ref="diamlr_grid_V_2D",     &
+               &                  field_ref="diamlr_time", enabled=llxatt_enabled )
+            CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( clxatt_name1 )//"_grid_W_2D" )
+            CALL xios_set_attr  ( slxhdl_fld, expr=TRIM( clxatt_expr ), grid_ref="diamlr_grid_W_2D",     &
+               &                  field_ref="diamlr_time", enabled=llxatt_enabled )
+            CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( clxatt_name1 )//"_grid_T_3D")
+            CALL xios_set_attr  ( slxhdl_fld, expr="this", grid_ref="diamlr_grid_2D_to_grid_T_3D",            &
+               &                  field_ref=TRIM( clxatt_name1 )//"_grid_T_2D", enabled=llxatt_enabled)
+            CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( clxatt_name1 )//"_grid_U_3D")
+            CALL xios_set_attr  ( slxhdl_fld, expr="this", grid_ref="diamlr_grid_2D_to_grid_U_3D",            &
+               &                  field_ref=TRIM( clxatt_name1 )//"_grid_U_2D", enabled=llxatt_enabled)
+            CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( clxatt_name1 )//"_grid_V_3D")
+            CALL xios_set_attr  ( slxhdl_fld, expr="this", grid_ref="diamlr_grid_2D_to_grid_V_3D",            &
+               &                  field_ref=TRIM( clxatt_name1 )//"_grid_V_2D", enabled=llxatt_enabled)
+            CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( clxatt_name1 )//"_grid_W_3D")
+            CALL xios_set_attr  ( slxhdl_fld, expr="this", grid_ref="diamlr_grid_2D_to_grid_W_3D",            &
+               &                  field_ref=TRIM( clxatt_name1 )//"_grid_W_2D", enabled=llxatt_enabled)
+            CALL xios_set_attr  ( slxhdl_regs(jm), expr="this", grid_ref="diamlr_grid_2D_to_scalar",   &
+               &                  field_ref=TRIM( clxatt_name1 )//"_grid_T_2D", enabled=llxatt_enabled)
+
+            !  ii) set up output of active regressors, including metadata
+            CALL xios_get_handle( "diamlr_file_scalar", slxhdl_fil )
+            ! Add regressor to output file
+            CALL xios_add_child ( slxhdl_fil, slxhdl_fld, TRIM( clxatt_name1 ) )
+            CALL xios_set_attr  ( slxhdl_fld, standard_name=TRIM( clxatt_comment ), long_name=TRIM( clxatt_expr ),   &
+               &                  operation="average" )
+               
+            ! iii) set up the output of scalar products with itself and with
+            !      other active regressors
+            CALL xios_get_attr  ( slxhdl_regs(jm), name=clxatt_name1 )
+            DO jn = 1, jm
+               ! Field for product between regressors
+               CALL xios_get_attr  ( slxhdl_regs(jn), name=clxatt_name2 )
+               CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( clxatt_name1 )//"."//TRIM( clxatt_name2 ) )
+               ! Set appropriate name attribute to avoid the possibility of
+               ! using an inappropriate inherited name attribute as the variable
+               ! name in the output file
+               CALL xios_set_attr  ( slxhdl_fld,                                                        &
+                  &                  name=TRIM( clxatt_name1 )//"."//TRIM( clxatt_name2 ),              &
+                  &                  grid_ref="diamlr_grid_scalar",                                     &
+                  &                  expr="this * "//TRIM( clxatt_name2 ),                              &
+                  &                  field_ref=TRIM( clxatt_name1 ),                                    &
+                  &                  enabled=llxatt_enabled,                                            &
+                  &                  long_name="Scalar product of regressor "//TRIM( clxatt_name1 )//   &
+                  &                     " and regressor "//TRIM( clxatt_name2 ),                        &
+                  &                  standard_name=TRIM( clxatt_name1 )//"."//TRIM( clxatt_name2 ),     &
+                  &                  operation="accumulate")
+               ! Add regressor-product field to output file
+               CALL xios_add_child ( slxhdl_fil, slxhdl_fld, TRIM( clxatt_name1 )//"."//TRIM( clxatt_name2 ) )
+            END DO
+
+            !  iv) set up definitions for the output of scalar products with
+            !      fields selected for analysis
+            DO jn = 1, ifld
+               CALL xios_get_attr  ( slxhdl_flds(jn), name=clxatt_name2, field_ref=clxatt_fieldref )
+               CALL xios_get_handle( TRIM( clxatt_fieldref ), slxhdl_fld )
+               CALL xios_get_attr  ( slxhdl_fld, grid_ref=clxatt_gridref )
+               clgt="T"
+               IF ( INDEX( clxatt_gridref, "_U_" ) > 0 ) clgt="U"
+               IF ( INDEX( clxatt_gridref, "_V_" ) > 0 ) clgt="V"
+               IF ( INDEX( clxatt_gridref, "_W_" ) > 0 ) clgt="W"
+               clgd="2D"
+               cl7a=""
+               IF ( INDEX( clxatt_gridref, "_3D" ) > 0 ) THEN
+                  clgd="3D"
+               ELSE
+                  cl7a="diamlr_"
+               END IF
+               CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( clxatt_name2 )//"."//TRIM( clxatt_name1 ) )
+               ! Set appropriate name attribute to avoid the possibility of
+               ! using an inappropriate inherited name attribute as the variable
+               ! name in the output file; use metadata (standard_name and
+               ! long_name) to refer to the id of the analysed field
+               CALL xios_set_attr  ( slxhdl_fld,                                                         &
+                  &                  name=TRIM( clxatt_name2 )//"."//TRIM( clxatt_name1 ),               &
+                  &                  expr="this * "//TRIM( clxatt_fieldref ),                            &
+                  &                  grid_ref=cl7a//"grid_"//clgt//"_"//clgd,                                      &
+                  &                  field_ref=TRIM( clxatt_name1 )//"_grid_"//clgt//"_"//clgd,          &
+                  &                  enabled=llxatt_enabled,                                             &
+                  &                  long_name="Scalar product of "//TRIM( clxatt_fieldref )//           &
+                  &                     " and regressor "//TRIM( clxatt_name1 ),                         &
+                  &                  standard_name=TRIM( clxatt_fieldref )//"."//TRIM( clxatt_name1 ),   &
+                  &                  operation="accumulate" )
+               CALL xios_get_handle( "diamlr_file_grid_"//clgt, slxhdl_fil )
+               CALL xios_add_child ( slxhdl_fil, slxhdl_fld, TRIM( clxatt_name2 )//"."//TRIM( clxatt_name1 ) )
+            END DO
+
+         END DO
+
+         ! Release list of active regressors and fields selected for analysis
+         DEALLOCATE( slxhdl_regs, slxhdl_flds )
+
+      END IF
+#else
+      IF( .FALSE. ) write(numout,*) 'dia_mlr_iom_init: should not see this'    ! useless statement to avoid compiler warnings
+#endif
+
+   END SUBROUTINE dia_mlr_iom_init
+
+   SUBROUTINE dia_mlr
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE dia_mlr  ***
+      !!
+      !! ** Purpose : update time used in multiple-linear-regression analysis
+      !!
+      !!----------------------------------------------------------------------
+
+      REAL(wp), DIMENSION(jpi,jpj) ::   zadatrj2d
+
+      IF( ln_timing )   CALL timing_start('dia_mlr')
+
+      ! Update time to the continuous time since the start of the model run
+      ! (value of adatrj converted to time in units of seconds)
+      !
+      ! A 2-dimensional field of constant value is sent, and subsequently used
+      ! directly or transformed to a scalar or a constant 3-dimensional field as
+      ! required.
+      zadatrj2d(:,:) = adatrj*86400.0_wp
+      IF ( iom_use('diamlr_time') ) CALL iom_put('diamlr_time', zadatrj2d)
+      
+      IF( ln_timing )   CALL timing_stop('dia_mlr')
+
+   END SUBROUTINE dia_mlr
+
+END MODULE diamlr
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/dianam.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/dianam.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/dianam.F90	(revision 12928)
@@ -72,5 +72,5 @@
 
       IF( llfsec .OR. kfreq < 0 ) THEN   ;   inbsec = kfreq                       ! output frequency already in seconds
-      ELSE                               ;   inbsec = kfreq * NINT( rdt )   ! from time-step to seconds
+      ELSE                               ;   inbsec = kfreq * NINT( rn_Dt )   ! from time-step to seconds
       ENDIF
       iddss = NINT( rday          )                                         ! number of seconds in 1 day
@@ -116,6 +116,6 @@
       ! date of the beginning and the end of the run
 
-      zdrun = rdt / rday * REAL( nitend - nit000, wp )                ! length of the run in days
-      zjul  = fjulday - rdt / rday
+      zdrun = rn_Dt / rday * REAL( nitend - nit000, wp )                ! length of the run in days
+      zjul  = fjulday - rn_Dt / rday
       CALL ju2ymds( zjul        , iyear1, imonth1, iday1, zsec1 )           ! year/month/day of the beginning of run
       CALL ju2ymds( zjul + zdrun, iyear2, imonth2, iday2, zsec2 )           ! year/month/day of the end       of run
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/diaptr.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/diaptr.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/diaptr.F90	(revision 12928)
@@ -10,4 +10,5 @@
    !!            3.6  ! 2014-12  (C. Ethe) use of IOM
    !!            3.6  ! 2016-06  (T. Graham) Addition of diagnostics for CMIP6
+   !!            4.0  ! 2010-08  ( C. Ethe, J. Deshayes ) Improvment
    !!----------------------------------------------------------------------
 
@@ -42,26 +43,23 @@
 
    !                                  !!** namelist  namptr  **
-   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   htr_adv, htr_ldf, htr_eiv   !: Heat TRansports (adv, diff, Bolus.)
-   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   str_adv, str_ldf, str_eiv   !: Salt TRansports (adv, diff, Bolus.)
-   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   htr_ove, str_ove   !: heat Salt TRansports ( overturn.)
-   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   htr_btr, str_btr   !: heat Salt TRansports ( barotropic )
-
-   LOGICAL, PUBLIC ::   ln_diaptr   !  Poleward transport flag (T) or not (F)
-   LOGICAL, PUBLIC ::   ln_subbas   !  Atlantic/Pacific/Indian basins calculation
-   INTEGER, PUBLIC ::   nptr        ! = 1 (l_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (l_subbas=T) 
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hstr_adv, hstr_ldf, hstr_eiv   !: Heat/Salt TRansports(adv, diff, Bolus.)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hstr_ove, hstr_btr, hstr_vtr   !: heat Salt TRansports(overturn, baro, merional)
+
+   LOGICAL , PUBLIC ::   l_diaptr        !: tracers  trend flag (set from namelist in trdini)
+   INTEGER, PARAMETER, PUBLIC ::   nptr = 5  ! (glo, atl, pac, ind, ipc)
 
    REAL(wp) ::   rc_sv    = 1.e-6_wp   ! conversion from m3/s to Sverdrup
-   REAL(wp) ::   rc_pwatt = 1.e-15_wp  ! conversion from W    to PW (further x rau0 x Cp)
-   REAL(wp) ::   rc_ggram = 1.e-6_wp   ! conversion from g    to Pg
-
-   CHARACTER(len=3), ALLOCATABLE, SAVE, DIMENSION(:)     :: clsubb
-   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk   ! T-point basin interior masks
-   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:)   :: btm30   ! mask out Southern Ocean (=0 south of 30°S)
-
-   REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:)     :: p_fval1d
-   REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:,:)   :: p_fval2d
-
+   REAL(wp) ::   rc_pwatt = 1.e-15_wp  ! conversion from W    to PW (further x rho0 x Cp)
+   REAL(wp) ::   rc_ggram = 1.e-9_wp   ! conversion from g    to Gg  (further x rho0)
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk   ! T-point basin interior masks
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk34 ! mask out Southern Ocean (=0 south of 34°S)
+
+   REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:)   :: p_fval1d
+   REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:,:) :: p_fval2d
+
+   LOGICAL ::   ll_init = .TRUE.        !: tracers  trend flag (set from namelist in trdini)
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -71,8 +69,10 @@
 CONTAINS
 
-   SUBROUTINE dia_ptr( pvtr )
+   SUBROUTINE dia_ptr( kt, Kmm, pvtr )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dia_ptr  ***
       !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in)           ::   kt     ! ocean time-step index     
+      INTEGER                         , INTENT(in)           ::   Kmm    ! time level index
       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   pvtr   ! j-effective transport
       !
@@ -80,293 +80,229 @@
       REAL(wp) ::   zsfc,zvfc               ! local scalar
       REAL(wp), DIMENSION(jpi,jpj)     ::  z2d   ! 2D workspace
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  z3d   ! 3D workspace
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zmask   ! 3D workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  z3d    ! 3D workspace
       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) ::  zts   ! 3D workspace
-      REAL(wp), DIMENSION(jpj)     ::  vsum   ! 1D workspace
-      REAL(wp), DIMENSION(jpj,jpts)     ::  tssum   ! 1D workspace
- 
+      REAL(wp), DIMENSION(jpj)      ::  zvsum, ztsum, zssum   ! 1D workspace
       !
       !overturning calculation
-      REAL(wp), DIMENSION(jpj,jpk,nptr) ::   sjk  , r1_sjk ! i-mean i-k-surface and its inverse
-      REAL(wp), DIMENSION(jpj,jpk,nptr) ::   v_msf, sn_jk  , tn_jk ! i-mean T and S, j-Stream-Function
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zvn   ! 3D workspace
-
-
-      CHARACTER( len = 12 )  :: cl1
+      REAL(wp), DIMENSION(jpj,jpk,nptr) :: sjk, r1_sjk, v_msf  ! i-mean i-k-surface and its inverse
+      REAL(wp), DIMENSION(jpj,jpk,nptr) :: zt_jk, zs_jk ! i-mean T and S, j-Stream-Function
+
+      REAL(wp), DIMENSION(jpi,jpj,jpk,nptr)  :: z4d1, z4d2
+      REAL(wp), DIMENSION(jpi,jpj,nptr)      :: z3dtr ! i-mean T and S, j-Stream-Function
       !!----------------------------------------------------------------------
       !
       IF( ln_timing )   CALL timing_start('dia_ptr')
 
-      !
+      IF( kt == nit000 .AND. ll_init )   CALL dia_ptr_init
+      !
+      IF( .NOT. l_diaptr )   RETURN
+
       IF( PRESENT( pvtr ) ) THEN
-         IF( iom_use("zomsfglo") ) THEN    ! effective MSF
-            z3d(1,:,:) = ptr_sjk( pvtr(:,:,:) )  ! zonal cumulative effective transport
-            DO jk = 2, jpkm1 
-              z3d(1,:,jk) = z3d(1,:,jk-1) + z3d(1,:,jk)   ! effective j-Stream-Function (MSF)
+         IF( iom_use( 'zomsf' ) ) THEN    ! effective MSF
+            DO jn = 1, nptr                                    ! by sub-basins
+               z4d1(1,:,:,jn) =  ptr_sjk( pvtr(:,:,:), btmsk34(:,:,jn) )  ! zonal cumulative effective transport excluding closed seas
+               DO jk = jpkm1, 1, -1 
+                  z4d1(1,:,jk,jn) = z4d1(1,:,jk+1,jn) - z4d1(1,:,jk,jn)    ! effective j-Stream-Function (MSF)
+               END DO
+               DO ji = 1, jpi
+                  z4d1(ji,:,:,jn) = z4d1(1,:,:,jn)
+               ENDDO
             END DO
-            DO ji = 1, jpi
-               z3d(ji,:,:) = z3d(1,:,:)
-            ENDDO
-            cl1 = TRIM('zomsf'//clsubb(1) )
-            CALL iom_put( cl1, z3d * rc_sv )
-            DO jn = 2, nptr                                    ! by sub-basins
-               z3d(1,:,:) =  ptr_sjk( pvtr(:,:,:), btmsk(:,:,jn)*btm30(:,:) ) 
-               DO jk = 2, jpkm1 
-                  z3d(1,:,jk) = z3d(1,:,jk-1) + z3d(1,:,jk)    ! effective j-Stream-Function (MSF)
-               END DO
-               DO ji = 1, jpi
-                  z3d(ji,:,:) = z3d(1,:,:)
-               ENDDO
-               cl1 = TRIM('zomsf'//clsubb(jn) )
-               CALL iom_put( cl1, z3d * rc_sv )
-            END DO
-         ENDIF
-         IF( iom_use("sopstove") .OR. iom_use("sophtove") .OR. iom_use("sopstbtr") .OR. iom_use("sophtbtr") ) THEN
+            CALL iom_put( 'zomsf', z4d1 * rc_sv )
+         ENDIF
+         IF(  iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) .OR.   &
+            & iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) ) THEN
             ! define fields multiplied by scalar
             zmask(:,:,:) = 0._wp
             zts(:,:,:,:) = 0._wp
-            zvn(:,:,:) = 0._wp
-            DO jk = 1, jpkm1
-               DO jj = 1, jpjm1
-                  DO ji = 1, jpi
-                     zvfc = e1v(ji,jj) * e3v_n(ji,jj,jk)
-                     zmask(ji,jj,jk)      = vmask(ji,jj,jk)      * zvfc
-                     zts(ji,jj,jk,jp_tem) = (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) * 0.5 * zvfc  !Tracers averaged onto V grid
-                     zts(ji,jj,jk,jp_sal) = (tsn(ji,jj,jk,jp_sal)+tsn(ji,jj+1,jk,jp_sal)) * 0.5 * zvfc
-                     zvn(ji,jj,jk)        = vn(ji,jj,jk)         * zvfc
-                  ENDDO
-               ENDDO
-             ENDDO
-         ENDIF
-         IF( iom_use("sopstove") .OR. iom_use("sophtove") ) THEN
-             sjk(:,:,1) = ptr_sjk( zmask(:,:,:), btmsk(:,:,1) )
-             r1_sjk(:,:,1) = 0._wp
-             WHERE( sjk(:,:,1) /= 0._wp )   r1_sjk(:,:,1) = 1._wp / sjk(:,:,1)
-
-             ! i-mean T and S, j-Stream-Function, global
-             tn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_tem) ) * r1_sjk(:,:,1)
-             sn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_sal) ) * r1_sjk(:,:,1)
-             v_msf(:,:,1) = ptr_sjk( zvn(:,:,:) )
-
-             htr_ove(:,1) = SUM( v_msf(:,:,1)*tn_jk(:,:,1) ,2 )
-             str_ove(:,1) = SUM( v_msf(:,:,1)*sn_jk(:,:,1) ,2 )
-
-             z2d(1,:) = htr_ove(:,1) * rc_pwatt        !  (conversion in PW)
-             DO ji = 1, jpi
-               z2d(ji,:) = z2d(1,:)
-             ENDDO
-             cl1 = 'sophtove'
-             CALL iom_put( TRIM(cl1), z2d )
-             z2d(1,:) = str_ove(:,1) * rc_ggram        !  (conversion in Gg)
-             DO ji = 1, jpi
-               z2d(ji,:) = z2d(1,:)
-             ENDDO
-             cl1 = 'sopstove'
-             CALL iom_put( TRIM(cl1), z2d )
-             IF( ln_subbas ) THEN
-                DO jn = 2, nptr
-                    sjk(:,:,jn) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) )
-                    r1_sjk(:,:,jn) = 0._wp
-                    WHERE( sjk(:,:,jn) /= 0._wp )   r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn)
-
-                    ! i-mean T and S, j-Stream-Function, basin
-                    tn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn)
-                    sn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) * r1_sjk(:,:,jn)
-                    v_msf(:,:,jn) = ptr_sjk( zvn(:,:,:), btmsk(:,:,jn) ) 
-                    htr_ove(:,jn) = SUM( v_msf(:,:,jn)*tn_jk(:,:,jn) ,2 )
-                    str_ove(:,jn) = SUM( v_msf(:,:,jn)*sn_jk(:,:,jn) ,2 )
-
-                    z2d(1,:) = htr_ove(:,jn) * rc_pwatt !  (conversion in PW)
-                    DO ji = 1, jpi
-                        z2d(ji,:) = z2d(1,:)
-                    ENDDO
-                    cl1 = TRIM('sophtove_'//clsubb(jn))
-                    CALL iom_put( cl1, z2d )
-                    z2d(1,:) = str_ove(:,jn) * rc_ggram        ! (conversion in Gg)
-                    DO ji = 1, jpi
-                        z2d(ji,:) = z2d(1,:)
-                    ENDDO
-                    cl1 = TRIM('sopstove_'//clsubb(jn))
-                    CALL iom_put( cl1, z2d )
-                END DO
-             ENDIF
-         ENDIF
-         IF( iom_use("sopstbtr") .OR. iom_use("sophtbtr") ) THEN
-         ! Calculate barotropic heat and salt transport here 
-             sjk(:,1,1) = ptr_sj( zmask(:,:,:), btmsk(:,:,1) )
-             r1_sjk(:,1,1) = 0._wp
-             WHERE( sjk(:,1,1) /= 0._wp )   r1_sjk(:,1,1) = 1._wp / sjk(:,1,1)
-            
-            vsum = ptr_sj( zvn(:,:,:), btmsk(:,:,1))
-            tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,1) )
-            tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,1) )
-            htr_btr(:,1) = vsum * tssum(:,jp_tem) * r1_sjk(:,1,1)
-            str_btr(:,1) = vsum * tssum(:,jp_sal) * r1_sjk(:,1,1)
-            z2d(1,:) = htr_btr(:,1) * rc_pwatt        !  (conversion in PW)
-            DO ji = 2, jpi
-               z2d(ji,:) = z2d(1,:)
-            ENDDO
-            cl1 = 'sophtbtr'
-            CALL iom_put( TRIM(cl1), z2d )
-            z2d(1,:) = str_btr(:,1) * rc_ggram        !  (conversion in Gg)
-            DO ji = 2, jpi
-              z2d(ji,:) = z2d(1,:)
-            ENDDO
-            cl1 = 'sopstbtr'
-            CALL iom_put( TRIM(cl1), z2d )
-            IF( ln_subbas ) THEN
-                DO jn = 2, nptr
-                    sjk(:,1,jn) = ptr_sj( zmask(:,:,:), btmsk(:,:,jn) )
-                    r1_sjk(:,1,jn) = 0._wp
-                    WHERE( sjk(:,1,jn) /= 0._wp )   r1_sjk(:,1,jn) = 1._wp / sjk(:,1,jn)
-                    vsum = ptr_sj( zvn(:,:,:), btmsk(:,:,jn))
-                    tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,jn) )
-                    tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,jn) )
-                    htr_btr(:,jn) = vsum * tssum(:,jp_tem) * r1_sjk(:,1,jn)
-                    str_btr(:,jn) = vsum * tssum(:,jp_sal) * r1_sjk(:,1,jn)
-                    z2d(1,:) = htr_btr(:,jn) * rc_pwatt !  (conversion in PW)
-                    DO ji = 1, jpi
-                        z2d(ji,:) = z2d(1,:)
-                    ENDDO
-                    cl1 = TRIM('sophtbtr_'//clsubb(jn))
-                    CALL iom_put( cl1, z2d )
-                    z2d(1,:) = str_btr(:,jn) * rc_ggram        ! (conversion in Gg)
-                    DO ji = 1, jpi
-                        z2d(ji,:) = z2d(1,:)
-                    ENDDO
-                    cl1 = TRIM('sopstbtr_'//clsubb(jn))
-                    CALL iom_put( cl1, z2d )
-               ENDDO
-            ENDIF !ln_subbas
-         ENDIF !iom_use("sopstbtr....)
+            DO_3D_10_11( 1, jpkm1 )
+               zvfc = e1v(ji,jj) * e3v(ji,jj,jk,Kmm)
+               zmask(ji,jj,jk)      = vmask(ji,jj,jk)      * zvfc
+               zts(ji,jj,jk,jp_tem) = (ts(ji,jj,jk,jp_tem,Kmm)+ts(ji,jj+1,jk,jp_tem,Kmm)) * 0.5 * zvfc  !Tracers averaged onto V grid
+               zts(ji,jj,jk,jp_sal) = (ts(ji,jj,jk,jp_sal,Kmm)+ts(ji,jj+1,jk,jp_sal,Kmm)) * 0.5 * zvfc
+            END_3D
+         ENDIF
+         IF( iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) ) THEN
+            DO jn = 1, nptr
+               sjk(:,:,jn) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) )
+               r1_sjk(:,:,jn) = 0._wp
+               WHERE( sjk(:,:,jn) /= 0._wp )   r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn)
+               ! i-mean T and S, j-Stream-Function, basin
+               zt_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn)
+               zs_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) * r1_sjk(:,:,jn)
+               v_msf(:,:,jn) = ptr_sjk( pvtr(:,:,:), btmsk34(:,:,jn) ) 
+               hstr_ove(:,jp_tem,jn) = SUM( v_msf(:,:,jn)*zt_jk(:,:,jn), 2 )
+               hstr_ove(:,jp_sal,jn) = SUM( v_msf(:,:,jn)*zs_jk(:,:,jn), 2 )
+               !
+            ENDDO
+            DO jn = 1, nptr
+               z3dtr(1,:,jn) = hstr_ove(:,jp_tem,jn) * rc_pwatt  !  (conversion in PW)
+               DO ji = 1, jpi
+                  z3dtr(ji,:,jn) = z3dtr(1,:,jn)
+               ENDDO
+            ENDDO
+            CALL iom_put( 'sophtove', z3dtr )
+            DO jn = 1, nptr
+               z3dtr(1,:,jn) = hstr_ove(:,jp_sal,jn) * rc_ggram !  (conversion in Gg)
+               DO ji = 1, jpi
+                  z3dtr(ji,:,jn) = z3dtr(1,:,jn)
+               ENDDO
+            ENDDO
+            CALL iom_put( 'sopstove', z3dtr )
+         ENDIF
+
+         IF( iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) ) THEN
+            ! Calculate barotropic heat and salt transport here 
+            DO jn = 1, nptr
+               sjk(:,1,jn) = ptr_sj( zmask(:,:,:), btmsk(:,:,jn) )
+               r1_sjk(:,1,jn) = 0._wp
+               WHERE( sjk(:,1,jn) /= 0._wp )   r1_sjk(:,1,jn) = 1._wp / sjk(:,1,jn)
+               !
+               zvsum(:) = ptr_sj( pvtr(:,:,:), btmsk34(:,:,jn) )
+               ztsum(:) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,jn) )
+               zssum(:) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,jn) )
+               hstr_btr(:,jp_tem,jn) = zvsum(:) * ztsum(:) * r1_sjk(:,1,jn)
+               hstr_btr(:,jp_sal,jn) = zvsum(:) * zssum(:) * r1_sjk(:,1,jn)
+               !
+            ENDDO
+            DO jn = 1, nptr
+               z3dtr(1,:,jn) = hstr_btr(:,jp_tem,jn) * rc_pwatt  !  (conversion in PW)
+               DO ji = 1, jpi
+                  z3dtr(ji,:,jn) = z3dtr(1,:,jn)
+               ENDDO
+            ENDDO
+            CALL iom_put( 'sophtbtr', z3dtr )
+            DO jn = 1, nptr
+               z3dtr(1,:,jn) = hstr_btr(:,jp_sal,jn) * rc_ggram !  (conversion in Gg)
+               DO ji = 1, jpi
+                  z3dtr(ji,:,jn) = z3dtr(1,:,jn)
+               ENDDO
+            ENDDO
+            CALL iom_put( 'sopstbtr', z3dtr )
+         ENDIF 
          !
       ELSE
          !
-         IF( iom_use("zotemglo") ) THEN    ! i-mean i-k-surface 
-            DO jk = 1, jpkm1
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     zsfc = e1t(ji,jj) * e3t_n(ji,jj,jk)
-                     zmask(ji,jj,jk)      = tmask(ji,jj,jk)      * zsfc
-                     zts(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) * zsfc
-                     zts(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal) * zsfc
-                  END DO
-               END DO
-            END DO
+         zmask(:,:,:) = 0._wp
+         zts(:,:,:,:) = 0._wp
+         IF( iom_use( 'zotem' ) .OR. iom_use( 'zosal' ) .OR. iom_use( 'zosrf' )  ) THEN    ! i-mean i-k-surface 
+            DO_3D_11_11( 1, jpkm1 )
+               zsfc = e1t(ji,jj) * e3t(ji,jj,jk,Kmm)
+               zmask(ji,jj,jk)      = tmask(ji,jj,jk)      * zsfc
+               zts(ji,jj,jk,jp_tem) = ts(ji,jj,jk,jp_tem,Kmm) * zsfc
+               zts(ji,jj,jk,jp_sal) = ts(ji,jj,jk,jp_sal,Kmm) * zsfc
+            END_3D
+            !
             DO jn = 1, nptr
                zmask(1,:,:) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) )
-               cl1 = TRIM('zosrf'//clsubb(jn) )
-               CALL iom_put( cl1, zmask )
-               !
-               z3d(1,:,:) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) &
-                  &            / MAX( zmask(1,:,:), 10.e-15 )
-               DO ji = 1, jpi
-                  z3d(ji,:,:) = z3d(1,:,:)
-               ENDDO
-               cl1 = TRIM('zotem'//clsubb(jn) )
-               CALL iom_put( cl1, z3d )
-               !
-               z3d(1,:,:) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) &
-                  &            / MAX( zmask(1,:,:), 10.e-15 )
-               DO ji = 1, jpi
-                  z3d(ji,:,:) = z3d(1,:,:)
-               ENDDO
-               cl1 = TRIM('zosal'//clsubb(jn) )
-               CALL iom_put( cl1, z3d )
-            END DO
+               z4d1(:,:,:,jn) = zmask(:,:,:)
+            ENDDO
+            CALL iom_put( 'zosrf', z4d1 )
+            !
+            DO jn = 1, nptr
+               z4d2(1,:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) &
+                  &            / MAX( z4d1(1,:,:,jn), 10.e-15 )
+               DO ji = 1, jpi
+                  z4d2(ji,:,:,jn) = z4d2(1,:,:,jn)
+               ENDDO
+            ENDDO
+            CALL iom_put( 'zotem', z4d2 )
+            !
+            DO jn = 1, nptr
+               z4d2(1,:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) &
+                  &            / MAX( z4d1(1,:,:,jn), 10.e-15 )
+               DO ji = 1, jpi
+                  z4d2(ji,:,:,jn) = z4d2(1,:,:,jn)
+               ENDDO
+            ENDDO
+            CALL iom_put( 'zosal', z4d2 )
+            !
          ENDIF
          !
          !                                ! Advective and diffusive heat and salt transport
-         IF( iom_use("sophtadv") .OR. iom_use("sopstadv") ) THEN   
-            z2d(1,:) = htr_adv(:,1) * rc_pwatt        !  (conversion in PW)
-            DO ji = 1, jpi
-               z2d(ji,:) = z2d(1,:)
-            ENDDO
-            cl1 = 'sophtadv'                 
-            CALL iom_put( TRIM(cl1), z2d )
-            z2d(1,:) = str_adv(:,1) * rc_ggram        ! (conversion in Gg)
-            DO ji = 1, jpi
-               z2d(ji,:) = z2d(1,:)
-            ENDDO
-            cl1 = 'sopstadv'
-            CALL iom_put( TRIM(cl1), z2d )
-            IF( ln_subbas ) THEN
-              DO jn=2,nptr
-               z2d(1,:) = htr_adv(:,jn) * rc_pwatt        !  (conversion in PW)
-               DO ji = 1, jpi
-                 z2d(ji,:) = z2d(1,:)
-               ENDDO
-               cl1 = TRIM('sophtadv_'//clsubb(jn))                 
-               CALL iom_put( cl1, z2d )
-               z2d(1,:) = str_adv(:,jn) * rc_ggram        ! (conversion in Gg)
-               DO ji = 1, jpi
-                  z2d(ji,:) = z2d(1,:)
-               ENDDO
-               cl1 = TRIM('sopstadv_'//clsubb(jn))                 
-               CALL iom_put( cl1, z2d )              
-              ENDDO
-            ENDIF
-         ENDIF
-         !
-         IF( iom_use("sophtldf") .OR. iom_use("sopstldf") ) THEN   
-            z2d(1,:) = htr_ldf(:,1) * rc_pwatt        !  (conversion in PW) 
-            DO ji = 1, jpi
-               z2d(ji,:) = z2d(1,:)
-            ENDDO
-            cl1 = 'sophtldf'
-            CALL iom_put( TRIM(cl1), z2d )
-            z2d(1,:) = str_ldf(:,1) * rc_ggram        !  (conversion in Gg)
-            DO ji = 1, jpi
-               z2d(ji,:) = z2d(1,:)
-            ENDDO
-            cl1 = 'sopstldf'
-            CALL iom_put( TRIM(cl1), z2d )
-            IF( ln_subbas ) THEN
-              DO jn=2,nptr
-               z2d(1,:) = htr_ldf(:,jn) * rc_pwatt        !  (conversion in PW)
-               DO ji = 1, jpi
-                 z2d(ji,:) = z2d(1,:)
-               ENDDO
-               cl1 = TRIM('sophtldf_'//clsubb(jn))                 
-               CALL iom_put( cl1, z2d )
-               z2d(1,:) = str_ldf(:,jn) * rc_ggram        ! (conversion in Gg)
-               DO ji = 1, jpi
-                  z2d(ji,:) = z2d(1,:)
-               ENDDO
-               cl1 = TRIM('sopstldf_'//clsubb(jn))                 
-               CALL iom_put( cl1, z2d )              
-              ENDDO
-            ENDIF
-         ENDIF
-
-         IF( iom_use("sophteiv") .OR. iom_use("sopsteiv") ) THEN 
-            z2d(1,:) = htr_eiv(:,1) * rc_pwatt        !  (conversion in PW) 
-            DO ji = 1, jpi
-               z2d(ji,:) = z2d(1,:)
-            ENDDO
-            cl1 = 'sophteiv'
-            CALL iom_put( TRIM(cl1), z2d )
-            z2d(1,:) = str_eiv(:,1) * rc_ggram        !  (conversion in Gg)
-            DO ji = 1, jpi
-               z2d(ji,:) = z2d(1,:)
-            ENDDO
-            cl1 = 'sopsteiv'
-            CALL iom_put( TRIM(cl1), z2d )
-            IF( ln_subbas ) THEN
-               DO jn=2,nptr
-                  z2d(1,:) = htr_eiv(:,jn) * rc_pwatt        !  (conversion in PW)
-                  DO ji = 1, jpi
-                     z2d(ji,:) = z2d(1,:)
-                  ENDDO
-                  cl1 = TRIM('sophteiv_'//clsubb(jn))                 
-                  CALL iom_put( cl1, z2d )
-                  z2d(1,:) = str_eiv(:,jn) * rc_ggram        ! (conversion in Gg)
-                  DO ji = 1, jpi
-                     z2d(ji,:) = z2d(1,:)
-                  ENDDO
-                  cl1 = TRIM('sopsteiv_'//clsubb(jn)) 
-                  CALL iom_put( cl1, z2d )              
-               ENDDO
-            ENDIF
+         IF( iom_use( 'sophtadv' ) .OR. iom_use( 'sopstadv' ) ) THEN  
+            ! 
+            DO jn = 1, nptr
+               z3dtr(1,:,jn) = hstr_adv(:,jp_tem,jn) * rc_pwatt  !  (conversion in PW)
+               DO ji = 1, jpi
+                  z3dtr(ji,:,jn) = z3dtr(1,:,jn)
+               ENDDO
+            ENDDO
+            CALL iom_put( 'sophtadv', z3dtr )
+            DO jn = 1, nptr
+               z3dtr(1,:,jn) = hstr_adv(:,jp_sal,jn) * rc_ggram !  (conversion in Gg)
+               DO ji = 1, jpi
+                  z3dtr(ji,:,jn) = z3dtr(1,:,jn)
+               ENDDO
+            ENDDO
+            CALL iom_put( 'sopstadv', z3dtr )
+         ENDIF
+         !
+         IF( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) THEN  
+            ! 
+            DO jn = 1, nptr
+               z3dtr(1,:,jn) = hstr_ldf(:,jp_tem,jn) * rc_pwatt  !  (conversion in PW)
+               DO ji = 1, jpi
+                  z3dtr(ji,:,jn) = z3dtr(1,:,jn)
+               ENDDO
+            ENDDO
+            CALL iom_put( 'sophtldf', z3dtr )
+            DO jn = 1, nptr
+               z3dtr(1,:,jn) = hstr_ldf(:,jp_sal,jn) * rc_ggram !  (conversion in Gg)
+               DO ji = 1, jpi
+                  z3dtr(ji,:,jn) = z3dtr(1,:,jn)
+               ENDDO
+            ENDDO
+            CALL iom_put( 'sopstldf', z3dtr )
+         ENDIF
+         !
+         IF( iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) ) THEN  
+            ! 
+            DO jn = 1, nptr
+               z3dtr(1,:,jn) = hstr_eiv(:,jp_tem,jn) * rc_pwatt  !  (conversion in PW)
+               DO ji = 1, jpi
+                  z3dtr(ji,:,jn) = z3dtr(1,:,jn)
+               ENDDO
+            ENDDO
+            CALL iom_put( 'sophteiv', z3dtr )
+            DO jn = 1, nptr
+               z3dtr(1,:,jn) = hstr_eiv(:,jp_sal,jn) * rc_ggram !  (conversion in Gg)
+               DO ji = 1, jpi
+                  z3dtr(ji,:,jn) = z3dtr(1,:,jn)
+               ENDDO
+            ENDDO
+            CALL iom_put( 'sopsteiv', z3dtr )
+         ENDIF
+         !
+         IF( iom_use( 'sopstvtr' ) .OR. iom_use( 'sophtvtr' ) ) THEN
+            zts(:,:,:,:) = 0._wp
+            DO_3D_10_11( 1, jpkm1 )
+               zvfc = e1v(ji,jj) * e3v(ji,jj,jk,Kmm)
+               zts(ji,jj,jk,jp_tem) = (ts(ji,jj,jk,jp_tem,Kmm)+ts(ji,jj+1,jk,jp_tem,Kmm)) * 0.5 * zvfc  !Tracers averaged onto V grid
+               zts(ji,jj,jk,jp_sal) = (ts(ji,jj,jk,jp_sal,Kmm)+ts(ji,jj+1,jk,jp_sal,Kmm)) * 0.5 * zvfc
+            END_3D
+             CALL dia_ptr_hst( jp_tem, 'vtr', zts(:,:,:,jp_tem) )
+             CALL dia_ptr_hst( jp_sal, 'vtr', zts(:,:,:,jp_sal) )
+             DO jn = 1, nptr
+                z3dtr(1,:,jn) = hstr_vtr(:,jp_tem,jn) * rc_pwatt  !  (conversion in PW)
+                DO ji = 1, jpi
+                   z3dtr(ji,:,jn) = z3dtr(1,:,jn)
+                ENDDO
+             ENDDO
+             CALL iom_put( 'sophtvtr', z3dtr )
+             DO jn = 1, nptr
+               z3dtr(1,:,jn) = hstr_vtr(:,jp_sal,jn) * rc_ggram !  (conversion in Gg)
+               DO ji = 1, jpi
+                  z3dtr(ji,:,jn) = z3dtr(1,:,jn)
+               ENDDO
+            ENDDO
+            CALL iom_put( 'sopstvtr', z3dtr )
+         ENDIF
+         !
+         IF( iom_use( 'uocetr_vsum_cumul' ) ) THEN
+            CALL iom_get_var(  'uocetr_vsum_op', z2d ) ! get uocetr_vsum_op from xml
+            z2d(:,:) = ptr_ci_2d( z2d(:,:) )  
+            CALL iom_put( 'uocetr_vsum_cumul', z2d )
          ENDIF
          !
@@ -384,20 +320,18 @@
       !! ** Purpose :   Initialization, namelist read
       !!----------------------------------------------------------------------
-      INTEGER ::  jn           ! local integers
-      INTEGER ::  inum, ierr   ! local integers
-      INTEGER ::  ios          ! Local integer output status for namelist read
-      !!
-      NAMELIST/namptr/ ln_diaptr, ln_subbas
-      !!----------------------------------------------------------------------
-
-      REWIND( numnam_ref )              ! Namelist namptr in reference namelist : Poleward transport
-      READ  ( numnam_ref, namptr, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namptr in reference namelist' )
-
-      REWIND( numnam_cfg )              ! Namelist namptr in configuration namelist : Poleward transport
-      READ  ( numnam_cfg, namptr, IOSTAT = ios, ERR = 902 )
-902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namptr in configuration namelist' )
-      IF(lwm) WRITE ( numond, namptr )
-
+      INTEGER ::  inum, jn           ! local integers
+      !!
+      REAL(wp), DIMENSION(jpi,jpj) :: zmsk
+      !!----------------------------------------------------------------------
+
+      l_diaptr = .FALSE.
+      IF(   iom_use( 'zomsf'    ) .OR. iom_use( 'zotem'    ) .OR. iom_use( 'zosal'    ) .OR.  &
+         &  iom_use( 'zosrf'    ) .OR. iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) .OR.  &
+         &  iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) .OR. iom_use( 'sophtadv' ) .OR.  &
+         &  iom_use( 'sopstadv' ) .OR. iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) .OR.  & 
+         &  iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) .OR. iom_use( 'sopstvtr' ) .OR.  &
+         &  iom_use( 'sophtvtr' ) .OR. iom_use( 'uocetr_vsum_cumul' ) )  l_diaptr  = .TRUE.
+
+ 
       IF(lwp) THEN                     ! Control print
          WRITE(numout,*)
@@ -405,52 +339,47 @@
          WRITE(numout,*) '~~~~~~~~~~~~'
          WRITE(numout,*) '   Namelist namptr : set ptr parameters'
-         WRITE(numout,*) '      Poleward heat & salt transport (T) or not (F)      ln_diaptr  = ', ln_diaptr
-         WRITE(numout,*) '      Global (F) or glo/Atl/Pac/Ind/Indo-Pac basins      ln_subbas  = ', ln_subbas
+         WRITE(numout,*) '      Poleward heat & salt transport (T) or not (F)      l_diaptr  = ', l_diaptr
       ENDIF
 
-      IF( ln_diaptr ) THEN  
-         !
-         IF( ln_subbas ) THEN 
-            nptr = 5            ! Global, Atlantic, Pacific, Indian, Indo-Pacific
-            ALLOCATE( clsubb(nptr) )
-            clsubb(1) = 'glo' ;  clsubb(2) = 'atl'  ;  clsubb(3) = 'pac'  ;  clsubb(4) = 'ind'  ;  clsubb(5) = 'ipc'
-         ELSE               
-            nptr = 1       ! Global only
-            ALLOCATE( clsubb(nptr) )
-            clsubb(1) = 'glo' 
-         ENDIF
-
-         !                                      ! allocate dia_ptr arrays
+      IF( l_diaptr ) THEN  
+         !
          IF( dia_ptr_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ptr_init : unable to allocate arrays' )
 
-         rc_pwatt = rc_pwatt * rau0_rcp          ! conversion from K.s-1 to PetaWatt
+         rc_pwatt = rc_pwatt * rho0_rcp          ! conversion from K.s-1 to PetaWatt
+         rc_ggram = rc_ggram * rho0              ! conversion from m3/s to Gg/s
 
          IF( lk_mpp )   CALL mpp_ini_znl( numout )     ! Define MPI communicator for zonal sum
 
-         IF( ln_subbas ) THEN                ! load sub-basin mask
-            CALL iom_open( 'subbasins', inum,  ldstop = .FALSE.  )
-            CALL iom_get( inum, jpdom_data, 'atlmsk', btmsk(:,:,2) )   ! Atlantic basin
-            CALL iom_get( inum, jpdom_data, 'pacmsk', btmsk(:,:,3) )   ! Pacific  basin
-            CALL iom_get( inum, jpdom_data, 'indmsk', btmsk(:,:,4) )   ! Indian   basin
-            CALL iom_close( inum )
-            btmsk(:,:,5) = MAX ( btmsk(:,:,3), btmsk(:,:,4) )          ! Indo-Pacific basin
-            WHERE( gphit(:,:) < -30._wp)   ;   btm30(:,:) = 0._wp      ! mask out Southern Ocean
-            ELSE WHERE                     ;   btm30(:,:) = ssmask(:,:)
-            END WHERE
-         ENDIF
-   
-         btmsk(:,:,1) = tmask_i(:,:)                                   ! global ocean
-      
-         DO jn = 1, nptr
+         btmsk(:,:,1) = tmask_i(:,:)                 
+         CALL iom_open( 'subbasins', inum,  ldstop = .FALSE.  )
+         CALL iom_get( inum, jpdom_data, 'atlmsk', btmsk(:,:,2) )   ! Atlantic basin
+         CALL iom_get( inum, jpdom_data, 'pacmsk', btmsk(:,:,3) )   ! Pacific  basin
+         CALL iom_get( inum, jpdom_data, 'indmsk', btmsk(:,:,4) )   ! Indian   basin
+         CALL iom_close( inum )
+         btmsk(:,:,5) = MAX ( btmsk(:,:,3), btmsk(:,:,4) )          ! Indo-Pacific basin
+         DO jn = 2, nptr
             btmsk(:,:,jn) = btmsk(:,:,jn) * tmask_i(:,:)               ! interior domain only
          END DO
+         ! JD : modification so that overturning streamfunction is available in Atlantic at 34S to compare with observations
+         WHERE( gphit(:,:)*tmask_i(:,:) < -34._wp)
+           zmsk(:,:) = 0._wp      ! mask out Southern Ocean
+         ELSE WHERE                  
+           zmsk(:,:) = ssmask(:,:)
+         END WHERE
+         btmsk34(:,:,1) = btmsk(:,:,1)                 
+         DO jn = 2, nptr
+            btmsk34(:,:,jn) = btmsk(:,:,jn) * zmsk(:,:)               ! interior domain only
+         ENDDO
 
          ! Initialise arrays to zero because diatpr is called before they are first calculated
          ! Note that this means diagnostics will not be exactly correct when model run is restarted.
-         htr_adv(:,:) = 0._wp  ;  str_adv(:,:) =  0._wp 
-         htr_ldf(:,:) = 0._wp  ;  str_ldf(:,:) =  0._wp 
-         htr_eiv(:,:) = 0._wp  ;  str_eiv(:,:) =  0._wp 
-         htr_ove(:,:) = 0._wp  ;   str_ove(:,:) =  0._wp
-         htr_btr(:,:) = 0._wp  ;   str_btr(:,:) =  0._wp
+         hstr_adv(:,:,:) = 0._wp           
+         hstr_ldf(:,:,:) = 0._wp           
+         hstr_eiv(:,:,:) = 0._wp           
+         hstr_ove(:,:,:) = 0._wp           
+         hstr_btr(:,:,:) = 0._wp           !
+         hstr_vtr(:,:,:) = 0._wp           !
+         !
+         ll_init = .FALSE.
          !
       ENDIF 
@@ -459,5 +388,5 @@
 
 
-   SUBROUTINE dia_ptr_hst( ktra, cptr, pva ) 
+   SUBROUTINE dia_ptr_hst( ktra, cptr, pvflx ) 
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE dia_ptr_hst ***
@@ -468,60 +397,60 @@
       INTEGER                         , INTENT(in )  :: ktra  ! tracer index
       CHARACTER(len=3)                , INTENT(in)   :: cptr  ! transport type  'adv'/'ldf'/'eiv'
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: pva   ! 3D input array of advection/diffusion
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: pvflx   ! 3D input array of advection/diffusion
       INTEGER                                        :: jn    !
 
+      !
       IF( cptr == 'adv' ) THEN
-         IF( ktra == jp_tem )  htr_adv(:,1) = ptr_sj( pva(:,:,:) )
-         IF( ktra == jp_sal )  str_adv(:,1) = ptr_sj( pva(:,:,:) )
+         IF( ktra == jp_tem )  THEN
+             DO jn = 1, nptr
+                hstr_adv(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) )
+             ENDDO
+         ENDIF
+         IF( ktra == jp_sal )  THEN
+             DO jn = 1, nptr
+                hstr_adv(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) )
+             ENDDO
+         ENDIF
       ENDIF
+      !
       IF( cptr == 'ldf' ) THEN
-         IF( ktra == jp_tem )  htr_ldf(:,1) = ptr_sj( pva(:,:,:) )
-         IF( ktra == jp_sal )  str_ldf(:,1) = ptr_sj( pva(:,:,:) )
+         IF( ktra == jp_tem )  THEN
+             DO jn = 1, nptr
+                hstr_ldf(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) )
+             ENDDO
+         ENDIF
+         IF( ktra == jp_sal )  THEN
+             DO jn = 1, nptr
+                hstr_ldf(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) )
+             ENDDO
+         ENDIF
       ENDIF
+      !
       IF( cptr == 'eiv' ) THEN
-         IF( ktra == jp_tem )  htr_eiv(:,1) = ptr_sj( pva(:,:,:) )
-         IF( ktra == jp_sal )  str_eiv(:,1) = ptr_sj( pva(:,:,:) )
+         IF( ktra == jp_tem )  THEN
+             DO jn = 1, nptr
+                hstr_eiv(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) )
+             ENDDO
+         ENDIF
+         IF( ktra == jp_sal )  THEN
+             DO jn = 1, nptr
+                hstr_eiv(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) )
+             ENDDO
+         ENDIF
       ENDIF
       !
-      IF( ln_subbas ) THEN
-         !
-         IF( cptr == 'adv' ) THEN
-             IF( ktra == jp_tem ) THEN 
-                DO jn = 2, nptr
-                   htr_adv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) )
-                END DO
-             ENDIF
-             IF( ktra == jp_sal ) THEN 
-                DO jn = 2, nptr
-                   str_adv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) )
-                END DO
-             ENDIF
-         ENDIF
-         IF( cptr == 'ldf' ) THEN
-             IF( ktra == jp_tem ) THEN 
-                DO jn = 2, nptr
-                    htr_ldf(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) )
-                 END DO
-             ENDIF
-             IF( ktra == jp_sal ) THEN 
-                DO jn = 2, nptr
-                   str_ldf(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) )
-                END DO
-             ENDIF
-         ENDIF
-         IF( cptr == 'eiv' ) THEN
-             IF( ktra == jp_tem ) THEN 
-                DO jn = 2, nptr
-                    htr_eiv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) )
-                 END DO
-             ENDIF
-             IF( ktra == jp_sal ) THEN 
-                DO jn = 2, nptr
-                   str_eiv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) )
-                END DO
-             ENDIF
-         ENDIF
-         !
+      IF( cptr == 'vtr' ) THEN
+         IF( ktra == jp_tem )  THEN
+             DO jn = 1, nptr
+                hstr_vtr(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) )
+             ENDDO
+         ENDIF
+         IF( ktra == jp_sal )  THEN
+             DO jn = 1, nptr
+                hstr_vtr(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) )
+             ENDDO
+         ENDIF
       ENDIF
+      !
    END SUBROUTINE dia_ptr_hst
 
@@ -536,23 +465,20 @@
       ierr(:) = 0
       !
-      ALLOCATE( btmsk(jpi,jpj,nptr) ,              &
-         &      htr_adv(jpj,nptr) , str_adv(jpj,nptr) ,   &
-         &      htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) ,   &
-         &      htr_ove(jpj,nptr) , str_ove(jpj,nptr) ,   &
-         &      htr_btr(jpj,nptr) , str_btr(jpj,nptr) ,   &
-         &      htr_ldf(jpj,nptr) , str_ldf(jpj,nptr) , STAT=ierr(1)  )
-         !
-      ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2))
-      !
-      ALLOCATE( btm30(jpi,jpj), STAT=ierr(3)  )
-
-         !
-      dia_ptr_alloc = MAXVAL( ierr )
-      CALL mpp_sum( 'diaptr', dia_ptr_alloc )
+      IF( .NOT. ALLOCATED( btmsk ) ) THEN
+         ALLOCATE( btmsk(jpi,jpj,nptr)    , btmsk34(jpi,jpj,nptr),   &
+            &      hstr_adv(jpj,jpts,nptr), hstr_eiv(jpj,jpts,nptr), &
+            &      hstr_ove(jpj,jpts,nptr), hstr_btr(jpj,jpts,nptr), &
+            &      hstr_ldf(jpj,jpts,nptr), hstr_vtr(jpj,jpts,nptr), STAT=ierr(1)  )
+            !
+         ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2))
+         !
+         dia_ptr_alloc = MAXVAL( ierr )
+         CALL mpp_sum( 'diaptr', dia_ptr_alloc )
+      ENDIF
       !
    END FUNCTION dia_ptr_alloc
 
 
-   FUNCTION ptr_sj_3d( pva, pmsk )   RESULT ( p_fval )
+   FUNCTION ptr_sj_3d( pvflx, pmsk )   RESULT ( p_fval )
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE ptr_sj_3d  ***
@@ -560,11 +486,11 @@
       !! ** Purpose :   i-k sum computation of a j-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
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk)       ::   pva   ! mask flux array at V-point
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj), OPTIONAL ::   pmsk   ! Optional 2D basin mask
+      !! ** Method  : - i-k sum of pvflx using the interior 2D vmask (vmask_i).
+      !!              pvflx is supposed to be a masked flux (i.e. * vmask*e1v*e3v)
+      !!
+      !! ** Action  : - p_fval: i-k-mean poleward flux of pvflx
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk)  ::   pvflx  ! mask flux array at V-point
+      REAL(wp), INTENT(in), DIMENSION(jpi,jpj)      ::   pmsk   ! Optional 2D basin mask
       !
       INTEGER                  ::   ji, jj, jk   ! dummy loop arguments
@@ -577,21 +503,7 @@
       ijpj = jpj
       p_fval(:) = 0._wp
-      IF( PRESENT( pmsk ) ) THEN 
-         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) * pmsk(ji,jj)
-               END DO
-            END DO
-         END DO
-      ELSE
-         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) 
-               END DO
-            END DO
-         END DO
-      ENDIF
+      DO_3D_00_00( 1, jpkm1 )
+         p_fval(jj) = p_fval(jj) + pvflx(ji,jj,jk) * pmsk(ji,jj) * tmask_i(ji,jj)
+      END_3D
 #if defined key_mpp_mpi
       CALL mpp_sum( 'diaptr', p_fval, ijpj, ncomm_znl)
@@ -601,17 +513,17 @@
 
 
-   FUNCTION ptr_sj_2d( pva, pmsk )   RESULT ( p_fval )
+   FUNCTION ptr_sj_2d( pvflx, pmsk )   RESULT ( p_fval )
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE ptr_sj_2d  ***
       !!
-      !! ** Purpose :   "zonal" and vertical sum computation of a i-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
-      !!----------------------------------------------------------------------
-      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)           ::   pva   ! mask flux array at V-point
-      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj), OPTIONAL ::   pmsk   ! Optional 2D basin mask
+      !! ** Purpose :   "zonal" and vertical sum computation of a j-flux array
+      !!
+      !! ** Method  : - i-k sum of pvflx using the interior 2D vmask (vmask_i).
+      !!      pvflx is supposed to be a masked flux (i.e. * vmask*e1v*e3v)
+      !!
+      !! ** Action  : - p_fval: i-k-mean poleward flux of pvflx
+      !!----------------------------------------------------------------------
+      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) ::   pvflx  ! mask flux array at V-point
+      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) ::   pmsk   ! Optional 2D basin mask
       !
       INTEGER                  ::   ji,jj       ! dummy loop arguments
@@ -624,17 +536,7 @@
       ijpj = jpj
       p_fval(:) = 0._wp
-      IF( PRESENT( pmsk ) ) THEN 
-         DO jj = 2, jpjm1
-            DO ji = nldi, nlei   ! No vector optimisation here. Better use a mask ?
-               p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj) * pmsk(ji,jj)
-            END DO
-         END DO
-      ELSE
-         DO jj = 2, jpjm1
-            DO ji = nldi, nlei   ! No vector optimisation here. Better use a mask ?
-               p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj)
-            END DO
-         END DO
-      ENDIF
+      DO_2D_00_00
+         p_fval(jj) = p_fval(jj) + pvflx(ji,jj) * pmsk(ji,jj) * tmask_i(ji,jj)
+      END_2D
 #if defined key_mpp_mpi
       CALL mpp_sum( 'diaptr', p_fval, ijpj, ncomm_znl )
@@ -643,4 +545,33 @@
    END FUNCTION ptr_sj_2d
 
+   FUNCTION ptr_ci_2d( pva )   RESULT ( p_fval )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE ptr_ci_2d  ***
+      !!
+      !! ** Purpose :   "meridional" cumulated sum computation of a j-flux array
+      !!
+      !! ** Method  : - j cumulated sum of pva using the interior 2D vmask (umask_i).
+      !!
+      !! ** Action  : - p_fval: j-cumulated sum of pva
+      !!----------------------------------------------------------------------
+      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)  ::   pva   ! mask flux array at V-point
+      !
+      INTEGER                  ::   ji,jj,jc       ! dummy loop arguments
+      INTEGER                  ::   ijpj        ! ??? 
+      REAL(wp), DIMENSION(jpi,jpj) :: p_fval ! function value
+      !!--------------------------------------------------------------------
+      ! 
+      ijpj = jpj  ! ???
+      p_fval(:,:) = 0._wp
+      DO jc = 1, jpnj ! looping over all processors in j axis
+         DO_2D_00_00
+            p_fval(ji,jj) = p_fval(ji,jj-1) + pva(ji,jj) * tmask_i(ji,jj)
+         END_2D
+         CALL lbc_lnk( 'diaptr', p_fval, 'U', -1. )
+      END DO
+      ! 
+   END FUNCTION ptr_ci_2d
+
+
 
    FUNCTION ptr_sjk( pta, pmsk )   RESULT ( p_fval )
@@ -650,12 +581,12 @@
       !! ** Purpose :   i-sum computation of an array
       !!
-      !! ** Method  : - i-sum of pva using the interior 2D vmask (vmask_i).
-      !!
-      !! ** Action  : - p_fval: i-mean poleward flux of pva
+      !! ** Method  : - i-sum of field using the interior 2D vmask (pmsk).
+      !!
+      !! ** Action  : - p_fval: i-sum of masked field
       !!----------------------------------------------------------------------
       !!
       IMPLICIT none
-      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk)           ::   pta    ! mask flux array at V-point
-      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)    , OPTIONAL ::   pmsk   ! Optional 2D basin mask
+      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pta    ! mask flux array at V-point
+      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)     ::   pmsk   ! Optional 2D basin mask
       !!
       INTEGER                           :: ji, jj, jk ! dummy loop arguments
@@ -673,22 +604,7 @@
       p_fval(:,:) = 0._wp
       !
-      IF( PRESENT( pmsk ) ) THEN 
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-!!gm here, use of tmask_i  ==> no need of loop over nldi, nlei....
-               DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ?
-                  p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * pmsk(ji,jj)
-               END DO
-            END DO
-         END DO
-      ELSE 
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ?
-                  p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * tmask_i(ji,jj)
-               END DO
-            END DO
-         END DO
-      END IF
+      DO_3D_00_00( 1, jpkm1 )
+         p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * pmsk(ji,jj) * tmask_i(ji,jj)
+      END_3D
       !
 #if defined key_mpp_mpi
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/diatmb.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/diatmb.F90	(revision 12384)
+++ 	(revision )
@@ -1,139 +1,0 @@
-MODULE diatmb 
-   !!======================================================================
-   !!                       ***  MODULE  diaharm  ***
-   !! Harmonic analysis of tidal constituents 
-   !!======================================================================
-   !! History :  3.6  !  08-2014  (E O'Dea)  Original code
-   !!            3.7  !  05-2016  (G. Madec)  use mbkt, mikt to account for ocean cavities
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers variables
-   USE dom_oce         ! ocean space and time domain
-   !
-   USE in_out_manager  ! I/O units
-   USE iom             ! I/0 library
-   USE wet_dry
-
-   IMPLICIT NONE
-   PRIVATE
-
-   LOGICAL , PUBLIC ::   ln_diatmb     !: Top Middle and Bottom output 
-   PUBLIC   dia_tmb_init            ! routine called by nemogcm.F90
-   PUBLIC   dia_tmb                 ! routine called by diawri.F90
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id$
-   !! Software governed by the CeCILL license (see ./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE dia_tmb_init 
-      !!---------------------------------------------------------------------------
-      !!                  ***  ROUTINE dia_tmb_init  ***
-      !!     
-      !! ** Purpose :   Initialization of tmb namelist 
-      !!        
-      !! ** Method  :   Read namelist
-      !!---------------------------------------------------------------------------
-      INTEGER ::   ios                 ! Local integer output status for namelist read
-      !
-      NAMELIST/nam_diatmb/ ln_diatmb
-      !!----------------------------------------------------------------------
-      !
-      REWIND( numnam_ref )              ! Read Namelist nam_diatmb in reference namelist : TMB diagnostics
-      READ  ( numnam_ref, nam_diatmb, IOSTAT=ios, ERR= 901 )
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diatmb in reference namelist' )
- 
-      REWIND( numnam_cfg )              ! Namelist nam_diatmb in configuration namelist  TMB diagnostics
-      READ  ( numnam_cfg, nam_diatmb, IOSTAT = ios, ERR = 902 )
-902   IF( ios >  0 ) CALL ctl_nam ( ios , 'nam_diatmb in configuration namelist' )
-      IF(lwm) WRITE ( numond, nam_diatmb )
-
-      IF(lwp) THEN                   ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'dia_tmb_init : Output Top, Middle, Bottom Diagnostics'
-         WRITE(numout,*) '~~~~~~~~~~~~'
-         WRITE(numout,*) '   Namelist nam_diatmb : set tmb outputs '
-         WRITE(numout,*) '      Switch for TMB diagnostics (T) or not (F)  ln_diatmb  = ', ln_diatmb
-      ENDIF
-      !
-   END SUBROUTINE dia_tmb_init
-
-
-   SUBROUTINE dia_calctmb( pfield, ptmb )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE dia_tmb  ***
-      !!                   
-      !! ** Purpose :    Find the Top, Mid and Bottom fields of water Column
-      !!
-      !! ** Method  :    use mbkt, mikt to find surface, mid and bottom of 
-      !!              model levels due to potential existence of ocean cavities
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi, jpj, jpk), INTENT(in   ) ::   pfield   ! Input 3D field and mask
-      REAL(wp), DIMENSION(jpi, jpj,  3 ), INTENT(  out) ::   ptmb     ! top, middle, bottom extracted from pfield
-      !
-      INTEGER ::   ji, jj   ! Dummy loop indices
-      INTEGER ::   itop, imid, ibot   ! local integers
-      REAL(wp)::   zmdi = 1.e+20_wp   ! land value
-      !!---------------------------------------------------------------------
-      !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            itop = mikt(ji,jj)                        ! top    ocean 
-            ibot = mbkt(ji,jj)                        ! bottom ocean 
-            imid =  itop + ( ibot - itop + 1 ) / 2    ! middle ocean          
-            !                    
-            ptmb(ji,jj,1) = pfield(ji,jj,itop)*tmask(ji,jj,itop) + zmdi*( 1._wp-tmask(ji,jj,itop) )
-            ptmb(ji,jj,2) = pfield(ji,jj,imid)*tmask(ji,jj,imid) + zmdi*( 1._wp-tmask(ji,jj,imid) )
-            ptmb(ji,jj,3) = pfield(ji,jj,ibot)*tmask(ji,jj,ibot) + zmdi*( 1._wp-tmask(ji,jj,ibot) )
-         END DO
-      END DO
-      !
-   END SUBROUTINE dia_calctmb
-
-
-   SUBROUTINE dia_tmb
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE dia_tmb  ***
-      !! ** Purpose :   Write diagnostics for Top, Mid and Bottom of water Column
-      !!
-      !! ** Method  :  use mikt,mbkt to find surface, mid and bottom of model levels
-      !!      calls calctmb to retrieve TMB values before sending to iom_put
-      !!
-      !!--------------------------------------------------------------------
-      REAL(wp) ::   zmdi =1.e+20     ! land value
-      REAL(wp), DIMENSION(jpi,jpj,3) :: zwtmb    ! workspace 
-      !!--------------------------------------------------------------------
-      !
-      CALL dia_calctmb( tsn(:,:,:,jp_tem), zwtmb )
-      !ssh already output but here we output it masked
-      IF( ll_wd ) THEN
-         CALL iom_put( "sshnmasked", (sshn(:,:)+ssh_ref)*tmask(:,:,1) + zmdi*(1.0 - tmask(:,:,1)) )
-      ELSE
-         CALL iom_put( "sshnmasked", sshn(:,:)*tmask(:,:,1) + zmdi*(1.0 - tmask(:,:,1)) )
-      ENDIF
-
-      CALL iom_put( "top_temp"  , zwtmb(:,:,1) )    ! tmb Temperature
-      CALL iom_put( "mid_temp"  , zwtmb(:,:,2) )    ! tmb Temperature
-      CALL iom_put( "bot_temp"  , zwtmb(:,:,3) )    ! tmb Temperature
-      !
-      CALL dia_calctmb( tsn(:,:,:,jp_sal), zwtmb )
-      CALL iom_put( "top_sal"   , zwtmb(:,:,1) )    ! tmb Salinity 
-      CALL iom_put( "mid_sal"   , zwtmb(:,:,2) )    ! tmb Salinity
-      CALL iom_put( "bot_sal"   , zwtmb(:,:,3) )    ! tmb Salinity
-      !
-      CALL dia_calctmb( un(:,:,:), zwtmb )
-      CALL iom_put( "top_u"     , zwtmb(:,:,1) )    ! tmb  U Velocity
-      CALL iom_put( "mid_u"     , zwtmb(:,:,2) )    ! tmb  U Velocity
-      CALL iom_put( "bot_u"     , zwtmb(:,:,3) )    ! tmb  U Velocity
-      !
-      CALL dia_calctmb( vn(:,:,:), zwtmb )
-      CALL iom_put( "top_v"     , zwtmb(:,:,1) )    ! tmb  V Velocity
-      CALL iom_put( "mid_v"     , zwtmb(:,:,2) )    ! tmb  V Velocity
-      CALL iom_put( "bot_v"     , zwtmb(:,:,3) )    ! tmb  V Velocity
-      !
-   END SUBROUTINE dia_tmb
-
-   !!======================================================================
-END MODULE diatmb
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/diawri.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/diawri.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIA/diawri.F90	(revision 12928)
@@ -26,4 +26,7 @@
    !!----------------------------------------------------------------------
    USE oce            ! ocean dynamics and tracers 
+   USE isf_oce
+   USE isfcpl
+   USE abl            ! abl variables in case ln_abl = .true.
    USE dom_oce        ! ocean space and time domain
    USE phycst         ! physical constants
@@ -47,5 +50,4 @@
    USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
    USE in_out_manager ! I/O manager
-   USE diatmb         ! Top,middle,bottom output
    USE dia25h         ! 25h Mean output
    USE iom            ! 
@@ -58,6 +60,6 @@
    USE lib_mpp         ! MPP library
    USE timing          ! preformance summary
-   USE diurnal_bulk    ! diurnal warm layer
-   USE cool_skin       ! Cool skin
+   USE diu_bulk        ! diurnal warm layer
+   USE diu_coolskin    ! Cool skin
 
    IMPLICIT NONE
@@ -67,5 +69,7 @@
    PUBLIC   dia_wri_state
    PUBLIC   dia_wri_alloc           ! Called by nemogcm module
-
+#if ! defined key_iomput   
+   PUBLIC   dia_wri_alloc_abl       ! Called by sbcabl  module (if ln_abl = .true.)
+#endif
    INTEGER ::   nid_T, nz_T, nh_T, ndim_T, ndim_hT   ! grid_T file
    INTEGER ::          nb_T              , ndim_bT   ! grid_T file
@@ -73,11 +77,13 @@
    INTEGER ::   nid_V, nz_V, nh_V, ndim_V, ndim_hV   ! grid_V file
    INTEGER ::   nid_W, nz_W, nh_W                    ! grid_W file
+   INTEGER ::   nid_A, nz_A, nh_A, ndim_A, ndim_hA   ! grid_ABL file   
    INTEGER ::   ndex(1)                              ! ???
    INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV
+   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hA, ndex_A ! ABL
    INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_T, ndex_U, ndex_V
    INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_bT
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -98,5 +104,5 @@
 
    
-   SUBROUTINE dia_wri( kt )
+   SUBROUTINE dia_wri( kt, Kmm )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE dia_wri  ***
@@ -108,4 +114,5 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      INTEGER, INTENT( in ) ::   Kmm     ! ocean time level index
       !!
       INTEGER ::   ji, jj, jk       ! dummy loop indices
@@ -121,5 +128,5 @@
       ! Output the initial state and forcings
       IF( ninist == 1 ) THEN                       
-         CALL dia_wri_state( 'output.init' )
+         CALL dia_wri_state( Kmm, 'output.init' )
          ninist = 0
       ENDIF
@@ -130,93 +137,83 @@
       CALL iom_put("e3v_0", e3v_0(:,:,:) )
       !
-      CALL iom_put( "e3t" , e3t_n(:,:,:) )
-      CALL iom_put( "e3u" , e3u_n(:,:,:) )
-      CALL iom_put( "e3v" , e3v_n(:,:,:) )
-      CALL iom_put( "e3w" , e3w_n(:,:,:) )
+      CALL iom_put( "e3t" , e3t(:,:,:,Kmm) )
+      CALL iom_put( "e3u" , e3u(:,:,:,Kmm) )
+      CALL iom_put( "e3v" , e3v(:,:,:,Kmm) )
+      CALL iom_put( "e3w" , e3w(:,:,:,Kmm) )
       IF( iom_use("e3tdef") )   &
-         CALL iom_put( "e3tdef"  , ( ( e3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 )
+         CALL iom_put( "e3tdef"  , ( ( e3t(:,:,:,Kmm) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 )
 
       IF( ll_wd ) THEN
-         CALL iom_put( "ssh" , (sshn+ssh_ref)*tmask(:,:,1) )   ! sea surface height (brought back to the reference used for wetting and drying)
+         CALL iom_put( "ssh" , (ssh(:,:,Kmm)+ssh_ref)*tmask(:,:,1) )   ! sea surface height (brought back to the reference used for wetting and drying)
       ELSE
-         CALL iom_put( "ssh" , sshn )              ! sea surface height
+         CALL iom_put( "ssh" , ssh(:,:,Kmm) )              ! sea surface height
       ENDIF
 
       IF( iom_use("wetdep") )   &                  ! wet depth
-         CALL iom_put( "wetdep" , ht_0(:,:) + sshn(:,:) )
+         CALL iom_put( "wetdep" , ht_0(:,:) + ssh(:,:,Kmm) )
       
-      CALL iom_put( "toce", tsn(:,:,:,jp_tem) )    ! 3D temperature
-      CALL iom_put(  "sst", tsn(:,:,1,jp_tem) )    ! surface temperature
+      CALL iom_put( "toce", ts(:,:,:,jp_tem,Kmm) )    ! 3D temperature
+      CALL iom_put(  "sst", ts(:,:,1,jp_tem,Kmm) )    ! surface temperature
       IF ( iom_use("sbt") ) THEN
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ikbot = mbkt(ji,jj)
-               z2d(ji,jj) = tsn(ji,jj,ikbot,jp_tem)
-            END DO
-         END DO
+         DO_2D_11_11
+            ikbot = mbkt(ji,jj)
+            z2d(ji,jj) = ts(ji,jj,ikbot,jp_tem,Kmm)
+         END_2D
          CALL iom_put( "sbt", z2d )                ! bottom temperature
       ENDIF
       
-      CALL iom_put( "soce", tsn(:,:,:,jp_sal) )    ! 3D salinity
-      CALL iom_put(  "sss", tsn(:,:,1,jp_sal) )    ! surface salinity
+      CALL iom_put( "soce", ts(:,:,:,jp_sal,Kmm) )    ! 3D salinity
+      CALL iom_put(  "sss", ts(:,:,1,jp_sal,Kmm) )    ! surface salinity
       IF ( iom_use("sbs") ) THEN
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ikbot = mbkt(ji,jj)
-               z2d(ji,jj) = tsn(ji,jj,ikbot,jp_sal)
-            END DO
-         END DO
+         DO_2D_11_11
+            ikbot = mbkt(ji,jj)
+            z2d(ji,jj) = ts(ji,jj,ikbot,jp_sal,Kmm)
+         END_2D
          CALL iom_put( "sbs", z2d )                ! bottom salinity
       ENDIF
 
       IF ( iom_use("taubot") ) THEN                ! bottom stress
-         zztmp = rau0 * 0.25
+         zztmp = rho0 * 0.25
          z2d(:,:) = 0._wp
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zztmp2 = (  ( rCdU_bot(ji+1,jj)+rCdU_bot(ji  ,jj) ) * un(ji  ,jj,mbku(ji  ,jj))  )**2   &
-                  &   + (  ( rCdU_bot(ji  ,jj)+rCdU_bot(ji-1,jj) ) * un(ji-1,jj,mbku(ji-1,jj))  )**2   &
-                  &   + (  ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj  ) ) * vn(ji,jj  ,mbkv(ji,jj  ))  )**2   &
-                  &   + (  ( rCdU_bot(ji,jj  )+rCdU_bot(ji,jj-1) ) * vn(ji,jj-1,mbkv(ji,jj-1))  )**2
-               z2d(ji,jj) = zztmp * SQRT( zztmp2 ) * tmask(ji,jj,1) 
-               !
-            END DO
-         END DO
+         DO_2D_00_00
+            zztmp2 = (  ( rCdU_bot(ji+1,jj)+rCdU_bot(ji  ,jj) ) * uu(ji  ,jj,mbku(ji  ,jj),Kmm)  )**2   &
+               &   + (  ( rCdU_bot(ji  ,jj)+rCdU_bot(ji-1,jj) ) * uu(ji-1,jj,mbku(ji-1,jj),Kmm)  )**2   &
+               &   + (  ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj  ) ) * vv(ji,jj  ,mbkv(ji,jj  ),Kmm)  )**2   &
+               &   + (  ( rCdU_bot(ji,jj  )+rCdU_bot(ji,jj-1) ) * vv(ji,jj-1,mbkv(ji,jj-1),Kmm)  )**2
+            z2d(ji,jj) = zztmp * SQRT( zztmp2 ) * tmask(ji,jj,1) 
+            !
+         END_2D
          CALL lbc_lnk( 'diawri', z2d, 'T', 1. )
          CALL iom_put( "taubot", z2d )           
       ENDIF
          
-      CALL iom_put( "uoce", un(:,:,:) )            ! 3D i-current
-      CALL iom_put(  "ssu", un(:,:,1) )            ! surface i-current
+      CALL iom_put( "uoce", uu(:,:,:,Kmm) )            ! 3D i-current
+      CALL iom_put(  "ssu", uu(:,:,1,Kmm) )            ! surface i-current
       IF ( iom_use("sbu") ) THEN
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ikbot = mbku(ji,jj)
-               z2d(ji,jj) = un(ji,jj,ikbot)
-            END DO
-         END DO
+         DO_2D_11_11
+            ikbot = mbku(ji,jj)
+            z2d(ji,jj) = uu(ji,jj,ikbot,Kmm)
+         END_2D
          CALL iom_put( "sbu", z2d )                ! bottom i-current
       ENDIF
       
-      CALL iom_put( "voce", vn(:,:,:) )            ! 3D j-current
-      CALL iom_put(  "ssv", vn(:,:,1) )            ! surface j-current
+      CALL iom_put( "voce", vv(:,:,:,Kmm) )            ! 3D j-current
+      CALL iom_put(  "ssv", vv(:,:,1,Kmm) )            ! surface j-current
       IF ( iom_use("sbv") ) THEN
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ikbot = mbkv(ji,jj)
-               z2d(ji,jj) = vn(ji,jj,ikbot)
-            END DO
-         END DO
+         DO_2D_11_11
+            ikbot = mbkv(ji,jj)
+            z2d(ji,jj) = vv(ji,jj,ikbot,Kmm)
+         END_2D
          CALL iom_put( "sbv", z2d )                ! bottom j-current
       ENDIF
 
-      IF( ln_zad_Aimp ) wn = wn + wi               ! Recombine explicit and implicit parts of vertical velocity for diagnostic output
-      !
-      CALL iom_put( "woce", wn )                   ! vertical velocity
+      IF( ln_zad_Aimp ) ww = ww + wi               ! Recombine explicit and implicit parts of vertical velocity for diagnostic output
+      !
+      CALL iom_put( "woce", ww )                   ! vertical velocity
       IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN   ! vertical mass transport & its square value
          ! Caution: in the VVL case, it only correponds to the baroclinic mass transport.
-         z2d(:,:) = rau0 * e1e2t(:,:)
+         z2d(:,:) = rho0 * e1e2t(:,:)
          DO jk = 1, jpk
-            z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:)
+            z3d(:,:,jk) = ww(:,:,jk) * z2d(:,:)
          END DO
          CALL iom_put( "w_masstr" , z3d )  
@@ -224,5 +221,5 @@
       ENDIF
       !
-      IF( ln_zad_Aimp ) wn = wn - wi               ! Remove implicit part of vertical velocity that was added for diagnostic output
+      IF( ln_zad_Aimp ) ww = ww - wi               ! Remove implicit part of vertical velocity that was added for diagnostic output
 
       CALL iom_put( "avt" , avt )                  ! T vert. eddy diff. coef.
@@ -234,13 +231,11 @@
 
       IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN
-         DO jj = 2, jpjm1                                    ! sst gradient
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zztmp  = tsn(ji,jj,1,jp_tem)
-               zztmpx = ( tsn(ji+1,jj,1,jp_tem) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - tsn(ji-1,jj  ,1,jp_tem) ) * r1_e1u(ji-1,jj)
-               zztmpy = ( tsn(ji,jj+1,1,jp_tem) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - tsn(ji  ,jj-1,1,jp_tem) ) * r1_e2v(ji,jj-1)
-               z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy )   &
-                  &              * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1)
-            END DO
-         END DO
+         DO_2D_00_00
+            zztmp  = ts(ji,jj,1,jp_tem,Kmm)
+            zztmpx = ( ts(ji+1,jj,1,jp_tem,Kmm) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - ts(ji-1,jj  ,1,jp_tem,Kmm) ) * r1_e1u(ji-1,jj)
+            zztmpy = ( ts(ji,jj+1,1,jp_tem,Kmm) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - ts(ji  ,jj-1,1,jp_tem,Kmm) ) * r1_e2v(ji,jj-1)
+            z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy )   &
+               &              * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1)
+         END_2D
          CALL lbc_lnk( 'diawri', z2d, 'T', 1. )
          CALL iom_put( "sstgrad2",  z2d )          ! square of module of sst gradient
@@ -252,44 +247,32 @@
       IF( iom_use("heatc") ) THEN
          z2d(:,:)  = 0._wp 
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         CALL iom_put( "heatc", rau0_rcp * z2d )   ! vertically integrated heat content (J/m2)
+         DO_3D_11_11( 1, jpkm1 )
+            z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) * tmask(ji,jj,jk)
+         END_3D
+         CALL iom_put( "heatc", rho0_rcp * z2d )   ! vertically integrated heat content (J/m2)
       ENDIF
 
       IF( iom_use("saltc") ) THEN
          z2d(:,:)  = 0._wp 
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         CALL iom_put( "saltc", rau0 * z2d )          ! vertically integrated salt content (PSU*kg/m2)
+         DO_3D_11_11( 1, jpkm1 )
+            z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * tmask(ji,jj,jk)
+         END_3D
+         CALL iom_put( "saltc", rho0 * z2d )          ! vertically integrated salt content (PSU*kg/m2)
       ENDIF
       !
       IF ( iom_use("eken") ) THEN
          z3d(:,:,jpk) = 0._wp 
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zztmp  = 0.25_wp * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
-                  z3d(ji,jj,jk) = zztmp * (  un(ji-1,jj,jk)**2 * e2u(ji-1,jj) * e3u_n(ji-1,jj,jk)   &
-                     &                     + un(ji  ,jj,jk)**2 * e2u(ji  ,jj) * e3u_n(ji  ,jj,jk)   &
-                     &                     + vn(ji,jj-1,jk)**2 * e1v(ji,jj-1) * e3v_n(ji,jj-1,jk)   &
-                     &                     + vn(ji,jj  ,jk)**2 * e1v(ji,jj  ) * e3v_n(ji,jj  ,jk)   )
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            zztmp  = 0.25_wp * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+            z3d(ji,jj,jk) = zztmp * (  uu(ji-1,jj,jk,Kmm)**2 * e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm)   &
+               &                     + uu(ji  ,jj,jk,Kmm)**2 * e2u(ji  ,jj) * e3u(ji  ,jj,jk,Kmm)   &
+               &                     + vv(ji,jj-1,jk,Kmm)**2 * e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm)   &
+               &                     + vv(ji,jj  ,jk,Kmm)**2 * e1v(ji,jj  ) * e3v(ji,jj  ,jk,Kmm)   )
+         END_3D
          CALL lbc_lnk( 'diawri', z3d, 'T', 1. )
          CALL iom_put( "eken", z3d )                 ! kinetic energy
       ENDIF
       !
-      CALL iom_put( "hdiv", hdivn )                  ! Horizontal divergence
+      CALL iom_put( "hdiv", hdiv )                  ! Horizontal divergence
       !
       IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN
@@ -297,5 +280,5 @@
          z2d(:,:) = 0.e0
          DO jk = 1, jpkm1
-            z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * e3u_n(:,:,jk) * umask(:,:,jk)
+            z3d(:,:,jk) = rho0 * uu(:,:,jk,Kmm) * e2u(:,:) * e3u(:,:,jk,Kmm) * umask(:,:,jk)
             z2d(:,:) = z2d(:,:) + z3d(:,:,jk)
          END DO
@@ -306,11 +289,7 @@
       IF( iom_use("u_heattr") ) THEN
          z2d(:,:) = 0._wp 
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) )
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji+1,jj,jk,jp_tem,Kmm) )
+         END_3D
          CALL lbc_lnk( 'diawri', z2d, 'U', -1. )
          CALL iom_put( "u_heattr", 0.5*rcp * z2d )    ! heat transport in i-direction
@@ -319,11 +298,7 @@
       IF( iom_use("u_salttr") ) THEN
          z2d(:,:) = 0.e0 
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) )
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji+1,jj,jk,jp_sal,Kmm) )
+         END_3D
          CALL lbc_lnk( 'diawri', z2d, 'U', -1. )
          CALL iom_put( "u_salttr", 0.5 * z2d )        ! heat transport in i-direction
@@ -334,5 +309,5 @@
          z3d(:,:,jpk) = 0.e0
          DO jk = 1, jpkm1
-            z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * e3v_n(:,:,jk) * vmask(:,:,jk)
+            z3d(:,:,jk) = rho0 * vv(:,:,jk,Kmm) * e1v(:,:) * e3v(:,:,jk,Kmm) * vmask(:,:,jk)
          END DO
          CALL iom_put( "v_masstr", z3d )              ! mass transport in j-direction
@@ -341,11 +316,7 @@
       IF( iom_use("v_heattr") ) THEN
          z2d(:,:) = 0.e0 
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) )
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji,jj+1,jk,jp_tem,Kmm) )
+         END_3D
          CALL lbc_lnk( 'diawri', z2d, 'V', -1. )
          CALL iom_put( "v_heattr", 0.5*rcp * z2d )    !  heat transport in j-direction
@@ -354,11 +325,7 @@
       IF( iom_use("v_salttr") ) THEN
          z2d(:,:) = 0._wp 
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) )
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji,jj+1,jk,jp_sal,Kmm) )
+         END_3D
          CALL lbc_lnk( 'diawri', z2d, 'V', -1. )
          CALL iom_put( "v_salttr", 0.5 * z2d )        !  heat transport in j-direction
@@ -367,33 +334,23 @@
       IF( iom_use("tosmint") ) THEN
          z2d(:,:) = 0._wp
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) *  tsn(ji,jj,jk,jp_tem)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) *  ts(ji,jj,jk,jp_tem,Kmm)
+         END_3D
          CALL lbc_lnk( 'diawri', z2d, 'T', -1. )
-         CALL iom_put( "tosmint", rau0 * z2d )        ! Vertical integral of temperature
+         CALL iom_put( "tosmint", rho0 * z2d )        ! Vertical integral of temperature
       ENDIF
       IF( iom_use("somint") ) THEN
          z2d(:,:)=0._wp
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm)
+         END_3D
          CALL lbc_lnk( 'diawri', z2d, 'T', -1. )
-         CALL iom_put( "somint", rau0 * z2d )         ! Vertical integral of salinity
+         CALL iom_put( "somint", rho0 * z2d )         ! Vertical integral of salinity
       ENDIF
 
       CALL iom_put( "bn2", rn2 )                      ! Brunt-Vaisala buoyancy frequency (N^2)
       !
-
-      IF (ln_diatmb)   CALL dia_tmb                   ! tmb values 
-          
-      IF (ln_dia25h)   CALL dia_25h( kt )             ! 25h averaging
+      
+      IF (ln_dia25h)   CALL dia_25h( kt, Kmm )        ! 25h averaging
 
       IF( ln_timing )   CALL timing_stop('dia_wri')
@@ -410,16 +367,28 @@
       INTEGER, DIMENSION(2) :: ierr
       !!----------------------------------------------------------------------
-      ierr = 0
-      ALLOCATE( ndex_hT(jpi*jpj) , ndex_T(jpi*jpj*jpk) ,     &
-         &      ndex_hU(jpi*jpj) , ndex_U(jpi*jpj*jpk) ,     &
-         &      ndex_hV(jpi*jpj) , ndex_V(jpi*jpj*jpk) , STAT=ierr(1) )
+      IF( nn_write == -1 ) THEN
+         dia_wri_alloc = 0
+      ELSE    
+         ierr = 0
+         ALLOCATE( ndex_hT(jpi*jpj) , ndex_T(jpi*jpj*jpk) ,     &
+            &      ndex_hU(jpi*jpj) , ndex_U(jpi*jpj*jpk) ,     &
+            &      ndex_hV(jpi*jpj) , ndex_V(jpi*jpj*jpk) , STAT=ierr(1) )
          !
-      dia_wri_alloc = MAXVAL(ierr)
-      CALL mpp_sum( 'diawri', dia_wri_alloc )
+         dia_wri_alloc = MAXVAL(ierr)
+         CALL mpp_sum( 'diawri', dia_wri_alloc )
+         !
+      ENDIF
       !
    END FUNCTION dia_wri_alloc
+ 
+   INTEGER FUNCTION dia_wri_alloc_abl()
+      !!----------------------------------------------------------------------
+	  ALLOCATE(   ndex_hA(jpi*jpj), ndex_A (jpi*jpj*jpkam1), STAT=dia_wri_alloc_abl)
+      CALL mpp_sum( 'diawri', dia_wri_alloc_abl )
+      !
+   END FUNCTION dia_wri_alloc_abl
 
    
-   SUBROUTINE dia_wri( kt )
+   SUBROUTINE dia_wri( kt, Kmm )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE dia_wri  ***
@@ -434,4 +403,5 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      INTEGER, INTENT( in ) ::   Kmm  ! ocean time level index
       !
       LOGICAL ::   ll_print = .FALSE.                        ! =T print and flush numout
@@ -441,4 +411,5 @@
       INTEGER  ::   ierr                                     ! error code return from allocation
       INTEGER  ::   iimi, iima, ipk, it, itmod, ijmi, ijma   ! local integers
+      INTEGER  ::   ipka                                     ! ABL
       INTEGER  ::   jn, ierror                               ! local integers
       REAL(wp) ::   zsto, zout, zmax, zjulian                ! local scalars
@@ -446,8 +417,9 @@
       REAL(wp), DIMENSION(jpi,jpj)   :: zw2d       ! 2D workspace
       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d       ! 3D workspace
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zw3d_abl   ! ABL 3D workspace
       !!----------------------------------------------------------------------
       !
       IF( ninist == 1 ) THEN     !==  Output the initial state and forcings  ==!
-         CALL dia_wri_state( 'output.init' )
+         CALL dia_wri_state( Kmm, 'output.init' )
          ninist = 0
       ENDIF
@@ -466,12 +438,12 @@
       clop = "x"         ! no use of the mask value (require less cpu time and otherwise the model crashes)
 #if defined key_diainstant
-      zsto = nn_write * rdt
+      zsto = nn_write * rn_Dt
       clop = "inst("//TRIM(clop)//")"
 #else
-      zsto=rdt
+      zsto=rn_Dt
       clop = "ave("//TRIM(clop)//")"
 #endif
-      zout = nn_write * rdt
-      zmax = ( nitend - nit000 + 1 ) * rdt
+      zout = nn_write * rn_Dt
+      zmax = ( nitend - nit000 + 1 ) * rn_Dt
 
       ! Define indices of the horizontal output zoom and vertical limit storage
@@ -479,4 +451,5 @@
       ijmi = 1      ;      ijma = jpj
       ipk = jpk
+      IF(ln_abl) ipka = jpkam1
 
       ! define time axis
@@ -493,5 +466,5 @@
 
          ! Compute julian date from starting date of the run
-         CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )
+         CALL ymds2ju( nyear, nmonth, nday, rn_Dt, zjulian )
          zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
          IF(lwp)WRITE(numout,*)
@@ -515,5 +488,5 @@
          CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit
             &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
-            &          nit000-1, zjulian, rdt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set )
+            &          nit000-1, zjulian, rn_Dt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set )
          CALL histvert( nid_T, "deptht", "Vertical T levels",      &  ! Vertical grid: gdept
             &           "m", ipk, gdept_1d, nz_T, "down" )
@@ -551,5 +524,5 @@
          CALL histbeg( clhstnam, jpi, glamu, jpj, gphiu,           &  ! Horizontal grid: glamu and gphiu
             &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
-            &          nit000-1, zjulian, rdt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set )
+            &          nit000-1, zjulian, rn_Dt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set )
          CALL histvert( nid_U, "depthu", "Vertical U levels",      &  ! Vertical grid: gdept
             &           "m", ipk, gdept_1d, nz_U, "down" )
@@ -564,5 +537,5 @@
          CALL histbeg( clhstnam, jpi, glamv, jpj, gphiv,           &  ! Horizontal grid: glamv and gphiv
             &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
-            &          nit000-1, zjulian, rdt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set )
+            &          nit000-1, zjulian, rn_Dt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set )
          CALL histvert( nid_V, "depthv", "Vertical V levels",      &  ! Vertical grid : gdept
             &          "m", ipk, gdept_1d, nz_V, "down" )
@@ -577,8 +550,24 @@
          CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit
             &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
-            &          nit000-1, zjulian, rdt, nh_W, nid_W, domain_id=nidom, snc4chunks=snc4set )
+            &          nit000-1, zjulian, rn_Dt, nh_W, nid_W, domain_id=nidom, snc4chunks=snc4set )
          CALL histvert( nid_W, "depthw", "Vertical W levels",      &  ! Vertical grid: gdepw
             &          "m", ipk, gdepw_1d, nz_W, "down" )
 
+         IF( ln_abl ) THEN 
+         ! Define the ABL grid FILE ( nid_A )
+            CALL dia_nam( clhstnam, nn_write, 'grid_ABL' )
+            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,       &
+               &          nit000-1, zjulian, rn_Dt, nh_A, nid_A, domain_id=nidom, snc4chunks=snc4set )
+            CALL histvert( nid_A, "ght_abl", "Vertical T levels",      &  ! Vertical grid: gdept
+               &           "m", ipka, ght_abl(2:jpka), nz_A, "up" )
+            !                                                            ! Index of ocean points
+			ALLOCATE( zw3d_abl(jpi,jpj,ipka) ) 
+			zw3d_abl(:,:,:) = 1._wp 
+			CALL wheneq( jpi*jpj*ipka, zw3d_abl, 1, 1., ndex_A , ndim_A  )      ! volume
+            CALL wheneq( jpi*jpj     , zw3d_abl, 1, 1., ndex_hA, ndim_hA )      ! surface
+			DEALLOCATE(zw3d_abl)
+         ENDIF
 
          ! Declare all the output fields as NETCDF variables
@@ -590,9 +579,9 @@
             &          jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
          IF(  .NOT.ln_linssh  ) THEN
-            CALL histdef( nid_T, "vovvle3t", "Level thickness"                    , "m"      ,&  ! e3t_n
+            CALL histdef( nid_T, "vovvle3t", "Level thickness"                    , "m"      ,&  ! e3t(:,:,:,Kmm)
             &             jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
-            CALL histdef( nid_T, "vovvldep", "T point depth"                      , "m"      ,&  ! e3t_n
+            CALL histdef( nid_T, "vovvldep", "T point depth"                      , "m"      ,&  ! e3t(:,:,:,Kmm)
             &             jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
-            CALL histdef( nid_T, "vovvldef", "Squared level deformation"          , "%^2"    ,&  ! e3t_n
+            CALL histdef( nid_T, "vovvldef", "Squared level deformation"          , "%^2"    ,&  ! e3t(:,:,:,Kmm)
             &             jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
          ENDIF
@@ -611,8 +600,8 @@
             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
          IF(  ln_linssh  ) THEN
-            CALL histdef( nid_T, "sosst_cd", "Concentration/Dilution term on temperature"     &  ! emp * tsn(:,:,1,jp_tem)
+            CALL histdef( nid_T, "sosst_cd", "Concentration/Dilution term on temperature"     &  ! emp * ts(:,:,1,jp_tem,Kmm)
             &                                                                  , "KgC/m2/s",  &  ! sosst_cd
             &             jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-            CALL histdef( nid_T, "sosss_cd", "Concentration/Dilution term on salinity"        &  ! emp * tsn(:,:,1,jp_sal)
+            CALL histdef( nid_T, "sosss_cd", "Concentration/Dilution term on salinity"        &  ! emp * ts(:,:,1,jp_sal,Kmm)
             &                                                                  , "KgPSU/m2/s",&  ! sosss_cd
             &             jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
@@ -630,5 +619,29 @@
          CALL histdef( nid_T, "sowindsp", "wind speed at 10m"                  , "m/s"    ,   &  ! wndm
             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-!
+         !
+         IF( ln_abl ) THEN
+            CALL histdef( nid_A, "t_abl", "Potential Temperature"     , "K"        ,       &  ! t_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )
+            CALL histdef( nid_A, "q_abl", "Humidity"                  , "kg/kg"    ,       &  ! q_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
+            CALL histdef( nid_A, "u_abl", "Atmospheric U-wind   "     , "m/s"        ,     &  ! u_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )
+            CALL histdef( nid_A, "v_abl", "Atmospheric V-wind   "     , "m/s"    ,         &  ! v_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
+            CALL histdef( nid_A, "tke_abl", "Atmospheric TKE   "     , "m2/s2"    ,        &  ! tke_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
+            CALL histdef( nid_A, "avm_abl", "Atmospheric turbulent viscosity", "m2/s"   ,  &  ! avm_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
+            CALL histdef( nid_A, "avt_abl", "Atmospheric turbulent diffusivity", "m2/s2",  &  ! avt_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
+            CALL histdef( nid_A, "pblh", "Atmospheric boundary layer height "  , "m",      &  ! pblh
+               &          jpi, jpj, nh_A,  1  , 1, 1   , -99 , 32, clop, zsto, zout )		 			   
+#if defined key_si3
+            CALL histdef( nid_A, "oce_frac", "Fraction of open ocean"  , " ",      &  ! ato_i
+               &          jpi, jpj, nh_A,  1  , 1, 1   , -99 , 32, clop, zsto, zout )
+#endif
+            CALL histend( nid_A, snc4chunks=snc4set )
+         ENDIF
+         !
          IF( ln_icebergs ) THEN
             CALL histdef( nid_T, "calving"             , "calving mass input"                       , "kg/s"   , &
@@ -690,5 +703,5 @@
 
          !                                                                                      !!! nid_U : 3D
-         CALL histdef( nid_U, "vozocrtx", "Zonal Current"                      , "m/s"    ,   &  ! un
+         CALL histdef( nid_U, "vozocrtx", "Zonal Current"                      , "m/s"    ,   &  ! uu(:,:,:,Kmm)
             &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )
          IF( ln_wave .AND. ln_sdw) THEN
@@ -703,5 +716,5 @@
 
          !                                                                                      !!! nid_V : 3D
-         CALL histdef( nid_V, "vomecrty", "Meridional Current"                 , "m/s"    ,   &  ! vn
+         CALL histdef( nid_V, "vomecrty", "Meridional Current"                 , "m/s"    ,   &  ! vv(:,:,:,Kmm)
             &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )
          IF( ln_wave .AND. ln_sdw) THEN
@@ -716,5 +729,5 @@
 
          !                                                                                      !!! nid_W : 3D
-         CALL histdef( nid_W, "vovecrtz", "Vertical Velocity"                  , "m/s"    ,   &  ! wn
+         CALL histdef( nid_W, "vovecrtz", "Vertical Velocity"                  , "m/s"    ,   &  ! ww
             &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
          CALL histdef( nid_W, "votkeavt", "Vertical Eddy Diffusivity"          , "m2/s"   ,   &  ! avt
@@ -754,21 +767,21 @@
 
       IF( .NOT.ln_linssh ) THEN
-         CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem) * e3t_n(:,:,:) , ndim_T , ndex_T  )   ! heat content
-         CALL histwrite( nid_T, "vosaline", it, tsn(:,:,:,jp_sal) * e3t_n(:,:,:) , ndim_T , ndex_T  )   ! salt content
-         CALL histwrite( nid_T, "sosstsst", it, tsn(:,:,1,jp_tem) * e3t_n(:,:,1) , ndim_hT, ndex_hT )   ! sea surface heat content
-         CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal) * e3t_n(:,:,1) , ndim_hT, ndex_hT )   ! sea surface salinity content
+         CALL histwrite( nid_T, "votemper", it, ts(:,:,:,jp_tem,Kmm) * e3t(:,:,:,Kmm) , ndim_T , ndex_T  )   ! heat content
+         CALL histwrite( nid_T, "vosaline", it, ts(:,:,:,jp_sal,Kmm) * e3t(:,:,:,Kmm) , ndim_T , ndex_T  )   ! salt content
+         CALL histwrite( nid_T, "sosstsst", it, ts(:,:,1,jp_tem,Kmm) * e3t(:,:,1,Kmm) , ndim_hT, ndex_hT )   ! sea surface heat content
+         CALL histwrite( nid_T, "sosaline", it, ts(:,:,1,jp_sal,Kmm) * e3t(:,:,1,Kmm) , ndim_hT, ndex_hT )   ! sea surface salinity content
       ELSE
-         CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem) , ndim_T , ndex_T  )   ! temperature
-         CALL histwrite( nid_T, "vosaline", it, tsn(:,:,:,jp_sal) , ndim_T , ndex_T  )   ! salinity
-         CALL histwrite( nid_T, "sosstsst", it, tsn(:,:,1,jp_tem) , ndim_hT, ndex_hT )   ! sea surface temperature
-         CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal) , ndim_hT, ndex_hT )   ! sea surface salinity
+         CALL histwrite( nid_T, "votemper", it, ts(:,:,:,jp_tem,Kmm) , ndim_T , ndex_T  )   ! temperature
+         CALL histwrite( nid_T, "vosaline", it, ts(:,:,:,jp_sal,Kmm) , ndim_T , ndex_T  )   ! salinity
+         CALL histwrite( nid_T, "sosstsst", it, ts(:,:,1,jp_tem,Kmm) , ndim_hT, ndex_hT )   ! sea surface temperature
+         CALL histwrite( nid_T, "sosaline", it, ts(:,:,1,jp_sal,Kmm) , ndim_hT, ndex_hT )   ! sea surface salinity
       ENDIF
       IF( .NOT.ln_linssh ) THEN
-         zw3d(:,:,:) = ( ( e3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2
-         CALL histwrite( nid_T, "vovvle3t", it, e3t_n (:,:,:) , ndim_T , ndex_T  )   ! level thickness
-         CALL histwrite( nid_T, "vovvldep", it, gdept_n(:,:,:) , ndim_T , ndex_T  )   ! t-point depth
+         zw3d(:,:,:) = ( ( e3t(:,:,:,Kmm) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2
+         CALL histwrite( nid_T, "vovvle3t", it, e3t (:,:,:,Kmm) , ndim_T , ndex_T  )   ! level thickness
+         CALL histwrite( nid_T, "vovvldep", it, gdept(:,:,:,Kmm) , ndim_T , ndex_T  )   ! t-point depth
          CALL histwrite( nid_T, "vovvldef", it, zw3d             , ndim_T , ndex_T  )   ! level thickness deformation
       ENDIF
-      CALL histwrite( nid_T, "sossheig", it, sshn          , ndim_hT, ndex_hT )   ! sea surface height
+      CALL histwrite( nid_T, "sossheig", it, ssh(:,:,Kmm)          , ndim_hT, ndex_hT )   ! sea surface height
       CALL histwrite( nid_T, "sowaflup", it, ( emp-rnf )   , ndim_hT, ndex_hT )   ! upward water flux
       CALL histwrite( nid_T, "sorunoff", it, rnf           , ndim_hT, ndex_hT )   ! river runoffs
@@ -777,7 +790,7 @@
                                                                                   ! in linear free surface case)
       IF( ln_linssh ) THEN
-         zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_tem)
+         zw2d(:,:) = emp (:,:) * ts(:,:,1,jp_tem,Kmm)
          CALL histwrite( nid_T, "sosst_cd", it, zw2d, ndim_hT, ndex_hT )          ! c/d term on sst
-         zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_sal)
+         zw2d(:,:) = emp (:,:) * ts(:,:,1,jp_sal,Kmm)
          CALL histwrite( nid_T, "sosss_cd", it, zw2d, ndim_hT, ndex_hT )          ! c/d term on sss
       ENDIF
@@ -788,5 +801,28 @@
       CALL histwrite( nid_T, "soicecov", it, fr_i          , ndim_hT, ndex_hT )   ! ice fraction   
       CALL histwrite( nid_T, "sowindsp", it, wndm          , ndim_hT, ndex_hT )   ! wind speed   
-!
+      !
+      IF( ln_abl ) THEN 
+         ALLOCATE( zw3d_abl(jpi,jpj,jpka) )
+         IF( ln_mskland )   THEN 
+            DO jk=1,jpka
+               zw3d_abl(:,:,jk) = tmask(:,:,1)
+            END DO       
+         ELSE
+            zw3d_abl(:,:,:) = 1._wp		 
+         ENDIF			
+         CALL histwrite( nid_A,  "pblh"   , it, pblh(:,:)                  *zw3d_abl(:,:,1     ), ndim_hA, ndex_hA )   ! pblh 
+         CALL histwrite( nid_A,  "u_abl"  , it, u_abl   (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! u_abl
+         CALL histwrite( nid_A,  "v_abl"  , it, v_abl   (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! v_abl
+         CALL histwrite( nid_A,  "t_abl"  , it, tq_abl  (:,:,2:jpka,nt_n,1)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! t_abl
+         CALL histwrite( nid_A,  "q_abl"  , it, tq_abl  (:,:,2:jpka,nt_n,2)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! q_abl		 
+         CALL histwrite( nid_A,  "tke_abl", it, tke_abl (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! tke_abl
+         CALL histwrite( nid_A,  "avm_abl", it, avm_abl (:,:,2:jpka       )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! avm_abl
+         CALL histwrite( nid_A,  "avt_abl", it, avt_abl (:,:,2:jpka       )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! avt_abl	
+#if defined key_si3
+         CALL histwrite( nid_A,  "oce_frac"   , it, ato_i(:,:)                                  , ndim_hA, ndex_hA )   ! ato_i
+#endif
+         DEALLOCATE(zw3d_abl)
+      ENDIF
+      !
       IF( ln_icebergs ) THEN
          !
@@ -815,5 +851,5 @@
          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(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1)
+         zw2d(:,:) = erp(:,:) * ts(:,:,1,jp_sal,Kmm) * tmask(:,:,1)
          CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping
       ENDIF
@@ -828,14 +864,14 @@
 #endif
 
-      CALL histwrite( nid_U, "vozocrtx", it, un            , ndim_U , ndex_U )    ! i-current
+      CALL histwrite( nid_U, "vozocrtx", it, uu(:,:,:,Kmm)            , ndim_U , ndex_U )    ! i-current
       CALL histwrite( nid_U, "sozotaux", it, utau          , ndim_hU, ndex_hU )   ! i-wind stress
 
-      CALL histwrite( nid_V, "vomecrty", it, vn            , ndim_V , ndex_V  )   ! j-current
+      CALL histwrite( nid_V, "vomecrty", it, vv(:,:,:,Kmm)            , ndim_V , ndex_V  )   ! j-current
       CALL histwrite( nid_V, "sometauy", it, vtau          , ndim_hV, ndex_hV )   ! j-wind stress
 
       IF( ln_zad_Aimp ) THEN
-         CALL histwrite( nid_W, "vovecrtz", it, wn + wi     , ndim_T, ndex_T )    ! vert. current
+         CALL histwrite( nid_W, "vovecrtz", it, ww + wi     , ndim_T, ndex_T )    ! vert. current
       ELSE
-         CALL histwrite( nid_W, "vovecrtz", it, wn          , ndim_T, ndex_T )    ! vert. current
+         CALL histwrite( nid_W, "vovecrtz", it, ww          , ndim_T, ndex_T )    ! vert. current
       ENDIF
       CALL histwrite( nid_W, "votkeavt", it, avt            , ndim_T, ndex_T )    ! T vert. eddy diff. coef.
@@ -858,4 +894,5 @@
          CALL histclo( nid_V )
          CALL histclo( nid_W )
+         IF(ln_abl) CALL histclo( nid_A )
       ENDIF
       !
@@ -865,5 +902,5 @@
 #endif
 
-   SUBROUTINE dia_wri_state( cdfile_name )
+   SUBROUTINE dia_wri_state( Kmm, cdfile_name )
       !!---------------------------------------------------------------------
       !!                 ***  ROUTINE dia_wri_state  ***
@@ -878,7 +915,8 @@
       !!      File 'output.abort.nc' is created in case of abnormal job end
       !!----------------------------------------------------------------------
+      INTEGER           , INTENT( in ) ::   Kmm              ! time level index
       CHARACTER (len=* ), INTENT( in ) ::   cdfile_name      ! name of the file created
       !!
-      INTEGER :: inum
+      INTEGER :: inum, jk
       !!----------------------------------------------------------------------
       ! 
@@ -887,21 +925,40 @@
       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   and forcing fields file created '
       IF(lwp) WRITE(numout,*) '                and named :', cdfile_name, '...nc'
-
-#if defined key_si3
-     CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl )
-#else
-     CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. )
-#endif
-
-      CALL iom_rstput( 0, 0, inum, 'votemper', tsn(:,:,:,jp_tem) )    ! now temperature
-      CALL iom_rstput( 0, 0, inum, 'vosaline', tsn(:,:,:,jp_sal) )    ! now salinity
-      CALL iom_rstput( 0, 0, inum, 'sossheig', sshn              )    ! sea surface height
-      CALL iom_rstput( 0, 0, inum, 'vozocrtx', un                )    ! now i-velocity
-      CALL iom_rstput( 0, 0, inum, 'vomecrty', vn                )    ! now j-velocity
+      !
+      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. )
+      !
+      CALL iom_rstput( 0, 0, inum, 'votemper', ts(:,:,:,jp_tem,Kmm) )    ! now temperature
+      CALL iom_rstput( 0, 0, inum, 'vosaline', ts(:,:,:,jp_sal,Kmm) )    ! now salinity
+      CALL iom_rstput( 0, 0, inum, 'sossheig', ssh(:,:,Kmm)              )    ! sea surface height
+      CALL iom_rstput( 0, 0, inum, 'vozocrtx', uu(:,:,:,Kmm)                )    ! now i-velocity
+      CALL iom_rstput( 0, 0, inum, 'vomecrty', vv(:,:,:,Kmm)                )    ! now j-velocity
       IF( ln_zad_Aimp ) THEN
-         CALL iom_rstput( 0, 0, inum, 'vovecrtz', wn + wi        )    ! now k-velocity
+         CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww + wi        )    ! now k-velocity
       ELSE
-         CALL iom_rstput( 0, 0, inum, 'vovecrtz', wn             )    ! now k-velocity
-      ENDIF
+         CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww             )    ! now k-velocity
+      ENDIF
+      CALL iom_rstput( 0, 0, inum, 'risfdep', risfdep            )    ! now k-velocity
+      CALL iom_rstput( 0, 0, inum, 'ht'     , ht                 )    ! now water column height
+      !
+      IF ( ln_isf ) THEN
+         IF (ln_isfcav_mlt) THEN
+            CALL iom_rstput( 0, 0, inum, 'fwfisf_cav', fwfisf_cav          )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'rhisf_cav_tbl', rhisf_tbl_cav    )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'rfrac_cav_tbl', rfrac_tbl_cav    )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'misfkb_cav', REAL(misfkb_cav,wp) )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'misfkt_cav', REAL(misfkt_cav,wp) )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'mskisf_cav', REAL(mskisf_cav,wp), ktype = jp_i1 )
+         END IF
+         IF (ln_isfpar_mlt) THEN
+            CALL iom_rstput( 0, 0, inum, 'isfmsk_par', REAL(mskisf_par,wp) )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'fwfisf_par', fwfisf_par          )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'rhisf_par_tbl', rhisf_tbl_par    )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'rfrac_par_tbl', rfrac_tbl_par    )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'misfkb_par', REAL(misfkb_par,wp) )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'misfkt_par', REAL(misfkt_par,wp) )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'mskisf_par', REAL(mskisf_par,wp), ktype = jp_i1 )
+         END IF
+      END IF
+      !
       IF( ALLOCATED(ahtu) ) THEN
          CALL iom_rstput( 0, 0, inum,  'ahtu', ahtu              )    ! aht at u-point
@@ -919,6 +976,6 @@
       CALL iom_rstput( 0, 0, inum, 'sometauy', vtau              )    ! j-wind stress
       IF(  .NOT.ln_linssh  ) THEN             
-         CALL iom_rstput( 0, 0, inum, 'vovvldep', gdept_n        )    !  T-cell depth 
-         CALL iom_rstput( 0, 0, inum, 'vovvle3t', e3t_n          )    !  T-cell thickness  
+         CALL iom_rstput( 0, 0, inum, 'vovvldep', gdept(:,:,:,Kmm)        )    !  T-cell depth 
+         CALL iom_rstput( 0, 0, inum, 'vovvle3t', e3t(:,:,:,Kmm)          )    !  T-cell thickness  
       END IF
       IF( ln_wave .AND. ln_sdw ) THEN
@@ -942,12 +999,21 @@
       ENDIF
  
+      IF ( ln_abl ) THEN
+         CALL iom_rstput ( 0, 0, inum, "uz1_abl",   u_abl(:,:,2,nt_a  ) )   ! now first level i-wind
+         CALL iom_rstput ( 0, 0, inum, "vz1_abl",   v_abl(:,:,2,nt_a  ) )   ! now first level j-wind
+         CALL iom_rstput ( 0, 0, inum, "tz1_abl",  tq_abl(:,:,2,nt_a,1) )   ! now first level temperature
+         CALL iom_rstput ( 0, 0, inum, "qz1_abl",  tq_abl(:,:,2,nt_a,2) )   ! now first level humidity
+      ENDIF
+      !
+      CALL iom_close( inum )
+      ! 
 #if defined key_si3
       IF( nn_ice == 2 ) THEN   ! condition needed in case agrif + ice-model but no-ice in child grid
+         CALL iom_open( TRIM(cdfile_name)//'_ice', inum, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' )
          CALL ice_wri_state( inum )
+         CALL iom_close( inum )
       ENDIF
 #endif
-      !
-      CALL iom_close( inum )
-      ! 
+
    END SUBROUTINE dia_wri_state
 
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIU/cool_skin.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIU/cool_skin.F90	(revision 12384)
+++ 	(revision )
@@ -1,146 +1,0 @@
-MODULE cool_skin
-   !!======================================================================
-   !!                    ***  MODULE  cool_skin  ***
-   !!     Cool skin thickness and delta T correction using Artele et al. (2002)
-   !!     [see also Tu and Tsuang (2005)]
-   !!
-   !!=====================================================================
-   !! History :        !  2012-01  (P. Sykes)  Original code
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   diurnal_sst_coolskin_init : initialisation of the cool skin
-   !!   diurnal_sst_coolskin_step : time-stepping  of the cool skin corrections
-   !!----------------------------------------------------------------------
-   USE par_kind
-   USE phycst
-   USE dom_oce
-   USE in_out_manager
-   USE sbc_oce
-   USE lib_mpp
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   
-   IMPLICIT NONE
-   PRIVATE
-
-   ! Namelist parameters
-
-   ! Parameters
-   REAL(wp), PRIVATE, PARAMETER :: pp_k = 0.596_wp          ! Thermal conductivity of seawater
-   REAL(wp), PRIVATE, PARAMETER :: pp_v = 1.05e-6_wp        ! Kinematic viscosity of seawater
-   REAL(wp), PRIVATE, PARAMETER :: pp_C = 86400             ! seconds [see Tu and Tsuang (2005)]
-   REAL(wp), PRIVATE, PARAMETER :: pp_cw = 3993._wp         ! specific heat capacity of seawater
-   REAL(wp), PRIVATE, PARAMETER :: pp_h = 10._wp            ! reference depth [using 10m from Artale et al. (2002)]
-   REAL(wp), PRIVATE, PARAMETER :: pp_rhoa = 1.20421_wp     ! density of air (at 20C)
-   REAL(wp), PRIVATE, PARAMETER :: pp_cda = 1.45e-3_wp      ! assumed air-sea drag coefficient for calculating wind speed
-   
-   ! Key variables
-   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: x_csdsst    ! Cool skin delta SST
-   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: x_csthick   ! Cool skin thickness
-
-   PUBLIC diurnal_sst_coolskin_step, diurnal_sst_coolskin_init
-
-      !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id$
-   !! Software governed by the CeCILL license (see ./LICENSE)
-   !!----------------------------------------------------------------------   
-   CONTAINS 
-   
-   SUBROUTINE diurnal_sst_coolskin_init
-      !!----------------------------------------------------------------------
-      !! *** ROUTINE diurnal_sst_coolskin_init ***
-      !!
-      !! ** Purpose :   initialise the cool skin model
-      !!
-      !! ** Method : 
-      !!
-      !! ** Reference :
-      !! 
-      !!----------------------------------------------------------------------
-      ALLOCATE( x_csdsst(jpi,jpj), x_csthick(jpi,jpj) )
-      x_csdsst = 0.
-      x_csthick = 0.
-      !
-   END SUBROUTINE diurnal_sst_coolskin_init
-
-
-   SUBROUTINE diurnal_sst_coolskin_step(psqflux, pstauflux, psrho, rdt)
-      !!----------------------------------------------------------------------
-      !! *** ROUTINE diurnal_sst_takaya_step ***
-      !!
-      !! ** Purpose :   Time-step the Artale cool skin model
-      !!
-      !! ** Method : 
-      !!
-      !! ** Reference : 
-      !!----------------------------------------------------------------------
-      ! Dummy variables
-      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: psqflux     ! Heat (non-solar)(Watts)
-      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: pstauflux   ! Wind stress (kg/ m s^2)
-      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: psrho       ! Water density (kg/m^3)
-      REAL(wp), INTENT(IN) :: rdt                             ! Time-step
-     
-      ! Local variables
-      REAL(wp), DIMENSION(jpi,jpj) :: z_fv                    ! Friction velocity     
-      REAL(wp), DIMENSION(jpi,jpj) :: z_gamma                 ! Dimensionless function of wind speed
-      REAL(wp), DIMENSION(jpi,jpj) :: z_lamda                 ! Sauders (dimensionless) proportionality constant
-      REAL(wp), DIMENSION(jpi,jpj) :: z_wspd                  ! Wind speed (m/s)
-      REAL(wp) :: z_ztx                                       ! Temporary u wind stress
-      REAL(wp) :: z_zty                                       ! Temporary v wind stress
-      REAL(wp) :: z_zmod                                      ! Temporary total wind stress
-     
-      INTEGER :: ji,jj
-      !!----------------------------------------------------------------------
-      !
-      IF( .NOT. ln_blk )   CALL ctl_stop("cool_skin.f90: diurnal flux processing only implemented for bulk forcing")
-      !
-      DO jj = 1,jpj
-         DO ji = 1,jpi
-            !
-            ! Calcualte wind speed from wind stress and friction velocity
-            IF( tmask(ji,jj,1) == 1. .AND. pstauflux(ji,jj) /= 0 .AND. psrho(ji,jj) /=0 ) THEN
-               z_fv(ji,jj) = SQRT( pstauflux(ji,jj) / psrho(ji,jj) )
-               z_wspd(ji,jj) = SQRT( pstauflux(ji,jj) / ( pp_cda * pp_rhoa ) )
-            ELSE
-               z_fv(ji,jj) = 0.
-               z_wspd(ji,jj) = 0.     
-            ENDIF
-            !
-            ! Calculate gamma function which is dependent upon wind speed
-            IF( tmask(ji,jj,1) == 1. ) THEN
-               IF( ( z_wspd(ji,jj) <= 7.5 ) ) z_gamma(ji,jj) = ( 0.2 * z_wspd(ji,jj) ) + 0.5
-               IF( ( z_wspd(ji,jj) > 7.5 ) .AND. ( z_wspd(ji,jj) < 10. ) ) z_gamma(ji,jj) = ( 1.6 * z_wspd(ji,jj) ) - 10.
-               IF( ( z_wspd(ji,jj) >= 10. ) ) z_gamma(ji,jj) = 6.
-            ENDIF
-            !
-            ! Calculate lamda function
-            IF( tmask(ji,jj,1) == 1. .AND. z_fv(ji,jj) /= 0 ) THEN
-               z_lamda(ji,jj) = ( z_fv(ji,jj) * pp_k * pp_C ) / ( z_gamma(ji,jj) * psrho(ji,jj) * pp_cw * pp_h * pp_v )
-            ELSE
-               z_lamda(ji,jj) = 0.
-            ENDIF
-            !
-            ! Calculate the cool skin thickness - only when heat flux is out of the ocean
-            IF( tmask(ji,jj,1) == 1. .AND. z_fv(ji,jj) /= 0 .AND. psqflux(ji,jj) < 0 ) THEN
-               x_csthick(ji,jj) = ( z_lamda(ji,jj) * pp_v ) / z_fv(ji,jj)
-            ELSE
-               x_csthick(ji,jj) = 0.
-            ENDIF
-            !
-            ! Calculate the cool skin correction - only when the heat flux is out of the ocean
-            IF( tmask(ji,jj,1) == 1. .AND. x_csthick(ji,jj) /= 0. .AND. psqflux(ji,jj) < 0. ) THEN
-               x_csdsst(ji,jj) = ( psqflux(ji,jj) * x_csthick(ji,jj) ) / pp_k
-             ELSE
-               x_csdsst(ji,jj) = 0.
-            ENDIF
-            !
-         END DO
-      END DO
-      !
-   END SUBROUTINE diurnal_sst_coolskin_step
-
-   !!======================================================================
-END MODULE cool_skin
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIU/diu_bulk.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIU/diu_bulk.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIU/diu_bulk.F90	(revision 12928)
@@ -0,0 +1,262 @@
+MODULE diu_bulk
+   !!======================================================================
+   !!                    ***  MODULE  diu_bulk  ***
+   !!     Takaya model of diurnal warming (Takaya, 2010)
+   !!=====================================================================
+   !! History :        !  11-10  (J. While)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   diurnal_sst_bulk_init  : initialise diurnal model
+   !!   diurnal_sst_bulk_step  : time-step the diurnal model
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE phycst
+   USE dom_oce
+   USE lib_mpp
+   USE solfrac_mod
+   USE in_out_manager
+   
+   IMPLICIT NONE
+   PRIVATE
+   
+   ! Namelist parameters
+   LOGICAL, PUBLIC :: ln_diurnal
+   LOGICAL, PUBLIC :: ln_diurnal_only
+
+   ! Parameters
+   REAL(wp), PRIVATE, PARAMETER :: pp_alpha = 2.0e-4_wp
+   REAL(wp), PRIVATE, PARAMETER :: pp_veltol = 0._wp
+   REAL(wp), PRIVATE, PARAMETER :: pp_min_fvel = 1.e-10_wp 
+   
+   ! Key variables
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: x_dsst     ! Delta SST
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: x_solfrac  ! Fraction of 
+   !                                                           ! absorbed radiation
+
+   PUBLIC diurnal_sst_bulk_init, diurnal_sst_takaya_step
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+   
+   !!----------------------------------------------------------------------
+CONTAINS 
+   
+   SUBROUTINE diurnal_sst_bulk_init
+      !!----------------------------------------------------------------------
+      !! *** ROUTINE diurnal_sst_init ***
+      !!
+      !! ** Purpose : Initialise the Takaya diurnal model   
+      !!----------------------------------------------------------------------      
+      INTEGER ::   ios   ! local integer
+      !!
+      NAMELIST /namdiu/ ln_diurnal, ln_diurnal_only
+      !!----------------------------------------------------------------------      
+
+      ! Read the namelist
+      READ  ( numnam_ref, namdiu, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdiu in reference namelist' )
+      READ  ( numnam_cfg, namdiu, IOSTAT = ios, ERR = 902 )
+902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdiu in configuration namelist' )      
+      !
+      IF( ln_diurnal_only .AND. ( .NOT. ln_diurnal ) ) THEN
+         CALL ctl_stop( "ln_diurnal_only set, but ln_diurnal = FALSE !" )
+      ENDIF
+      
+      IF( ln_diurnal ) THEN      
+         !         
+         ALLOCATE( x_dsst(jpi,jpj), x_solfrac(jpi,jpj) )
+         !
+         x_solfrac = 0._wp         ! Initialise the solar fraction
+         x_dsst    = 0._wp
+         !
+         IF( ln_diurnal_only ) THEN
+            CALL ctl_warn( "ln_diurnal_only set; only the diurnal component of SST will be calculated" )
+         ENDIF
+      ENDIF
+      
+   END SUBROUTINE diurnal_sst_bulk_init
+
+
+   SUBROUTINE diurnal_sst_takaya_step(kt, psolflux, pqflux, ptauflux, prho, p_rdt,   &
+            &                  pla, pthick, pcoolthick, pmu, &
+            &                  p_fvel_bkginc, p_hflux_bkginc)
+      !!----------------------------------------------------------------------
+      !! *** ROUTINE diurnal_sst_takaya_step ***
+      !!
+      !! ** Purpose :   Time-step the Takaya diurnal model
+      !!
+      !! ** Method :    1) Calculate the Obukhov length
+      !!                2) Calculate the Similarity function
+      !!                2) Calculate the increment to dsst
+      !!                3) Apply the increment
+      !! ** Reference : Refinements to a prognostic scheme of skin sea surface
+      !!                temperature, Takaya et al, JGR, 2010 
+      !!----------------------------------------------------------------------
+      INTEGER                               , INTENT(in) ::   kt             ! time step
+      REAL(wp), DIMENSION(jpi,jpj)          , INTENT(in) ::   psolflux       ! solar flux (Watts)
+      REAL(wp), DIMENSION(jpi,jpj)          , INTENT(in) ::   pqflux         ! heat (non-solar) flux (Watts)
+      REAL(wp), DIMENSION(jpi,jpj)          , INTENT(in) ::   ptauflux       ! wind stress  (kg/ m s^2)
+      REAL(wp), DIMENSION(jpi,jpj)          , INTENT(in) ::   prho           ! water density  (kg/m^3)
+      REAL(wp)                              , INTENT(in) ::   p_rdt          ! time-step
+      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) ::   pLa            ! Langmuir number
+      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) ::   pthick         ! warm layer thickness (m)
+      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) ::   pcoolthick     ! cool skin thickness (m)
+      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) ::   pmu            ! mu parameter
+      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) ::   p_hflux_bkginc ! increment to the heat flux
+      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) ::   p_fvel_bkginc  ! increment to the friction velocity
+      !
+      INTEGER :: ji,jj
+      LOGICAL  :: ll_calcfrac
+      REAL(wp), DIMENSION(jpi,jpj) :: z_fvel              ! friction velocity     
+      REAL(wp), DIMENSION(jpi,jpj) :: zthick, zcoolthick, zmu, zla
+      REAL(wp), DIMENSION(jpi,jpj) :: z_abflux            ! absorbed flux           
+      REAL(wp), DIMENSION(jpi,jpj) :: z_fla               ! Langmuir function value 
+      !!----------------------------------------------------------------------
+
+      ! Set optional arguments to their defaults
+      IF( .NOT. PRESENT( pthick )   ) THEN   ;   zthick(:,:) = 3._wp
+      ELSE                                   ;   zthick(:,:) = pthick(:,:)
+      ENDIF
+      IF( .NOT. PRESENT(pcoolthick) ) THEN   ;   zcoolthick(:,:) = 0._wp
+      ELSE                                   ;   zcoolthick(:,:) = pcoolthick(:,:)
+      ENDIF
+      IF( .NOT. PRESENT( pmu )      ) THEN   ;   zmu(:,:) = 0.3_wp
+      ELSE                                   ;   zmu(:,:) = pmu(:,:)
+      ENDIF
+      IF( .NOT. PRESENT(pla) ) THEN          ;   zla(:,:) = 0.3_wp
+      ELSE                                   ;   zla(:,:) = pla(:,:)
+      ENDIF
+      
+      ! If not done already, calculate the solar fraction
+      IF ( kt==nit000 ) THEN
+         DO_2D_11_11
+            IF(  ( x_solfrac(ji,jj) == 0._wp ) .AND. ( tmask(ji,jj,1) == 1._wp ) ) &
+               &   x_solfrac(ji,jj) = solfrac( zcoolthick(ji,jj),zthick(ji,jj) )
+         END_2D
+      ENDIF   
+
+      ! convert solar flux and heat flux to absorbed flux   
+      WHERE ( tmask(:,:,1) == 1._wp) 
+         z_abflux(:,:) = (  x_solfrac(:,:) *  psolflux (:,:)) + pqflux(:,:)     
+      ELSEWHERE
+         z_abflux(:,:) = 0._wp
+      ENDWHERE
+      IF( PRESENT(p_hflux_bkginc) ) z_abflux(:,:) = z_abflux(:,:) + p_hflux_bkginc   ! Optional increment
+      WHERE ( ABS( z_abflux(:,:) ) < rsmall )
+         z_abflux(:,:) = rsmall
+      ENDWHERE 
+      
+      ! Calculate the friction velocity
+      WHERE ( (ptauflux /= 0) .AND. ( tmask(:,:,1) == 1.) )   
+         z_fvel(:,:) = SQRT( ptauflux(:,:) / prho(:,:) )
+      ELSEWHERE
+         z_fvel(:,:) = 0._wp
+      ENDWHERE
+      IF( PRESENT(p_fvel_bkginc) ) z_fvel(:,:) = z_fvel(:,:) + p_fvel_bkginc   ! Optional increment
+      
+       
+       
+      ! Calculate the Langmuir function value
+      WHERE ( tmask(:,:,1) == 1.)
+         z_fla(:,:) = MAX( 1._wp, zla(:,:)**( -2._wp / 3._wp ) )  
+      ELSEWHERE
+         z_fla(:,:) = 0._wp
+      ENDWHERE     
+      
+      ! Increment the temperature using the implicit solution
+      x_dsst(:,:) = t_imp( x_dsst(:,:), p_rdt, z_abflux(:,:), z_fvel(:,:),   &
+         &                       z_fla(:,:), zmu(:,:), zthick(:,:), prho(:,:) )
+      !
+   END SUBROUTINE diurnal_sst_takaya_step
+
+   
+   FUNCTION t_imp(p_dsst, p_rdt, p_abflux, p_fvel, &
+                          p_fla, pmu, pthick, prho )
+                          
+      IMPLICIT NONE
+      
+      ! Function definition
+      REAL(wp), DIMENSION(jpi,jpj) :: t_imp
+      ! Dummy variables
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_dsst     ! Delta SST
+      REAL(wp), INTENT(IN)                     :: p_rdt      ! Time-step
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_abflux   ! Heat forcing
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_fvel     ! Friction velocity
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_fla      ! Langmuir number
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: pmu        ! Structure parameter
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: pthick     ! Layer thickness
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: prho       ! Water density
+   
+      ! Local variables
+      REAL(wp) :: z_olength          ! Obukhov length
+      REAL(wp) :: z_sigma, z_sigma2
+      REAL(wp) :: z_term1, z_term2     
+      REAL(wp) :: z_stabfunc         ! stability function value
+      REAL(wp) :: z_fvel      
+      
+      CHARACTER(200) :: warn_string
+       
+      INTEGER :: ji,jj
+                     
+      DO_2D_11_11
+         
+         ! Only calculate outside tmask
+         IF ( tmask(ji,jj,1) /= 1._wp ) THEN
+            t_imp(ji,jj) = 0._wp
+            CYCLE   
+         END IF
+         
+         IF (p_fvel(ji,jj) < pp_min_fvel) THEN
+            z_fvel = pp_min_fvel
+            WRITE(warn_string,*) "diurnal_sst_takaya step: "&
+            &//"friction velocity < minimum\n" &
+            &//"Setting friction velocity =",pp_min_fvel
+            CALL ctl_warn(warn_string)
+            
+         ELSE
+            z_fvel = p_fvel(ji,jj)
+         ENDIF
+              
+         ! Calculate the Obukhov length
+         IF ( (z_fvel < pp_veltol ) .AND. &
+         &    (p_dsst(ji,jj) > 0._wp) ) THEN
+            z_olength =  z_fvel  / &
+            &     SQRT( p_dsst(ji,jj) * vkarmn * grav * &
+            &             pp_alpha / ( 5._wp * pthick(ji,jj) ) )
+         ELSE
+            z_olength = &
+            &   ( prho(ji,jj) * rcp * z_fvel**3._wp ) / &
+            &   ( vkarmn * grav * pp_alpha *&
+            &     p_abflux(ji,jj) )
+         ENDIF
+          
+         ! Calculate the stability function          
+         z_sigma = pthick(ji,jj) / z_olength
+         z_sigma2 = z_sigma * z_sigma
+         IF ( z_sigma >= 0. ) THEN
+            z_stabfunc = 1._wp + &
+            &  ( ( 5._wp * z_sigma + 4._wp * z_sigma2 ) / &
+            &  ( 1._wp + 3._wp * z_sigma + 0.25_wp * &
+            &    z_sigma2 ) )
+         ELSE
+            z_stabfunc = 1._wp / &
+            &                   SQRT( 1._wp - 16._wp * z_sigma )
+         ENDIF
+
+         ! Calculate the T increment
+         z_term1 = ( p_abflux(ji,jj) * ( pmu(ji,jj) + 1._wp)  / &
+         & ( pmu(ji,jj) * pthick(ji,jj) * prho(ji,jj) * rcp ) )
+         
+          
+         z_term2 = -( ( pmu(ji,jj) + 1._wp) * &
+         &                       ( vkarmn * z_fvel * p_fla(ji,jj) ) / &
+         &      ( pthick(ji,jj) * z_stabfunc ) )     
+       
+         t_imp(ji,jj) = ( p_dsst(ji,jj) + p_rdt * z_term1 ) / &
+                        ( 1._wp - p_rdt * z_term2 )
+
+      END_2D
+      
+      END FUNCTION t_imp
+
+END MODULE diu_bulk
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIU/diu_coolskin.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIU/diu_coolskin.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIU/diu_coolskin.F90	(revision 12928)
@@ -0,0 +1,143 @@
+MODULE diu_coolskin
+   !!======================================================================
+   !!                    ***  MODULE  diu_coolskin  ***
+   !!     Cool skin thickness and delta T correction using Artele et al. (2002)
+   !!     [see also Tu and Tsuang (2005)]
+   !!
+   !!=====================================================================
+   !! History :        !  2012-01  (P. Sykes)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   diurnal_sst_coolskin_init : initialisation of the cool skin
+   !!   diurnal_sst_coolskin_step : time-stepping  of the cool skin corrections
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE phycst
+   USE dom_oce
+   USE in_out_manager
+   USE sbc_oce
+   USE lib_mpp
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   ! Namelist parameters
+
+   ! Parameters
+   REAL(wp), PRIVATE, PARAMETER :: pp_k = 0.596_wp          ! Thermal conductivity of seawater
+   REAL(wp), PRIVATE, PARAMETER :: pp_v = 1.05e-6_wp        ! Kinematic viscosity of seawater
+   REAL(wp), PRIVATE, PARAMETER :: pp_C = 86400             ! seconds [see Tu and Tsuang (2005)]
+   REAL(wp), PRIVATE, PARAMETER :: pp_cw = 3993._wp         ! specific heat capacity of seawater
+   REAL(wp), PRIVATE, PARAMETER :: pp_h = 10._wp            ! reference depth [using 10m from Artale et al. (2002)]
+   REAL(wp), PRIVATE, PARAMETER :: pp_rhoa = 1.20421_wp     ! density of air (at 20C)
+   REAL(wp), PRIVATE, PARAMETER :: pp_cda = 1.45e-3_wp      ! assumed air-sea drag coefficient for calculating wind speed
+   
+   ! Key variables
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: x_csdsst    ! Cool skin delta SST
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: x_csthick   ! Cool skin thickness
+   PUBLIC diurnal_sst_coolskin_step, diurnal_sst_coolskin_init
+
+      !! * Substitutions
+#  include "do_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id$
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------   
+   CONTAINS 
+   
+   SUBROUTINE diurnal_sst_coolskin_init
+      !!----------------------------------------------------------------------
+      !! *** ROUTINE diurnal_sst_coolskin_init ***
+      !!
+      !! ** Purpose :   initialise the cool skin model
+      !!
+      !! ** Method : 
+      !!
+      !! ** Reference :
+      !! 
+      !!----------------------------------------------------------------------
+      ALLOCATE( x_csdsst(jpi,jpj), x_csthick(jpi,jpj) )
+      x_csdsst = 0.
+      x_csthick = 0.
+      !
+   END SUBROUTINE diurnal_sst_coolskin_init
+
+
+   SUBROUTINE diurnal_sst_coolskin_step(psqflux, pstauflux, psrho, pDt)
+      !!----------------------------------------------------------------------
+      !! *** ROUTINE diurnal_sst_takaya_step ***
+      !!
+      !! ** Purpose :   Time-step the Artale cool skin model
+      !!
+      !! ** Method : 
+      !!
+      !! ** Reference : 
+      !!----------------------------------------------------------------------
+      ! Dummy variables
+      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: psqflux     ! Heat (non-solar)(Watts)
+      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: pstauflux   ! Wind stress (kg/ m s^2)
+      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: psrho       ! Water density (kg/m^3)
+      REAL(wp), INTENT(IN) :: pDt                             ! Time-step
+     
+      ! Local variables
+      REAL(wp), DIMENSION(jpi,jpj) :: z_fv                    ! Friction velocity     
+      REAL(wp), DIMENSION(jpi,jpj) :: z_gamma                 ! Dimensionless function of wind speed
+      REAL(wp), DIMENSION(jpi,jpj) :: z_lamda                 ! Sauders (dimensionless) proportionality constant
+      REAL(wp), DIMENSION(jpi,jpj) :: z_wspd                  ! Wind speed (m/s)
+      REAL(wp) :: z_ztx                                       ! Temporary u wind stress
+      REAL(wp) :: z_zty                                       ! Temporary v wind stress
+      REAL(wp) :: z_zmod                                      ! Temporary total wind stress
+     
+      INTEGER :: ji,jj
+      !!----------------------------------------------------------------------
+      !
+      IF( .NOT. ln_blk )   CALL ctl_stop("diu_coolskin.f90: diurnal flux processing only implemented for bulk forcing")
+      !
+      DO_2D_11_11
+         !
+         ! Calcualte wind speed from wind stress and friction velocity
+         IF( tmask(ji,jj,1) == 1. .AND. pstauflux(ji,jj) /= 0 .AND. psrho(ji,jj) /=0 ) THEN
+            z_fv(ji,jj) = SQRT( pstauflux(ji,jj) / psrho(ji,jj) )
+            z_wspd(ji,jj) = SQRT( pstauflux(ji,jj) / ( pp_cda * pp_rhoa ) )
+         ELSE
+            z_fv(ji,jj) = 0.
+            z_wspd(ji,jj) = 0.     
+         ENDIF
+         !
+         ! Calculate gamma function which is dependent upon wind speed
+         IF( tmask(ji,jj,1) == 1. ) THEN
+            IF( ( z_wspd(ji,jj) <= 7.5 ) ) z_gamma(ji,jj) = ( 0.2 * z_wspd(ji,jj) ) + 0.5
+            IF( ( z_wspd(ji,jj) > 7.5 ) .AND. ( z_wspd(ji,jj) < 10. ) ) z_gamma(ji,jj) = ( 1.6 * z_wspd(ji,jj) ) - 10.
+            IF( ( z_wspd(ji,jj) >= 10. ) ) z_gamma(ji,jj) = 6.
+         ENDIF
+         !
+         ! Calculate lamda function
+         IF( tmask(ji,jj,1) == 1. .AND. z_fv(ji,jj) /= 0 ) THEN
+            z_lamda(ji,jj) = ( z_fv(ji,jj) * pp_k * pp_C ) / ( z_gamma(ji,jj) * psrho(ji,jj) * pp_cw * pp_h * pp_v )
+         ELSE
+            z_lamda(ji,jj) = 0.
+         ENDIF
+         !
+         ! Calculate the cool skin thickness - only when heat flux is out of the ocean
+         IF( tmask(ji,jj,1) == 1. .AND. z_fv(ji,jj) /= 0 .AND. psqflux(ji,jj) < 0 ) THEN
+            x_csthick(ji,jj) = ( z_lamda(ji,jj) * pp_v ) / z_fv(ji,jj)
+         ELSE
+            x_csthick(ji,jj) = 0.
+         ENDIF
+         !
+         ! Calculate the cool skin correction - only when the heat flux is out of the ocean
+         IF( tmask(ji,jj,1) == 1. .AND. x_csthick(ji,jj) /= 0. .AND. psqflux(ji,jj) < 0. ) THEN
+            x_csdsst(ji,jj) = ( psqflux(ji,jj) * x_csthick(ji,jj) ) / pp_k
+          ELSE
+            x_csdsst(ji,jj) = 0.
+         ENDIF
+         !
+      END_2D
+      !
+   END SUBROUTINE diurnal_sst_coolskin_step
+
+   !!======================================================================
+END MODULE diu_coolskin
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIU/diu_layers.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIU/diu_layers.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIU/diu_layers.F90	(revision 12928)
@@ -0,0 +1,51 @@
+MODULE diu_layers
+   !!======================================================================
+   !!                       ***  MODULE diu_layers **
+   !! Apply coolskin and warm layer calculations
+   !!======================================================================
+   !! History :  3.7  ! 2015-11  (J. While)  Original code
+
+   USE diu_bulk     ! diurnal SST bulk routines  (diurnal_sst_takaya routine) 
+   USE diu_coolskin ! diurnal cool skin correction (diurnal_sst_coolskin routine)   
+   USE oce
+   USE iom
+   USE sbc_oce
+   USE sbcmod       ! surface boundary condition       (sbc     routine)
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC diurnal_sst_bulk_init      ! called by nemogcm.F90
+   PUBLIC diurnal_sst_coolskin_init  ! called by nemogcm.F90
+   PUBLIC diurnal_layers             ! called by step.F90 or step_diu.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: step_diu.F90 10922 2019-05-02 15:10:39Z acc $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+
+   CONTAINS
+
+   SUBROUTINE diurnal_layers( kstp ) 
+      INTEGER, INTENT(in) ::   kstp   ! ocean time-step index 
+      !!---------------------------------------------------------------------- 
+      !!                     ***  ROUTINE diurnal_layers  *** 
+      !!                       
+      !! ** Purpose : - Apply coolskin and warm layer calculations
+      !!   
+      !!---------------------------------------------------------------------- 
+      
+      ! Cool skin
+
+      CALL diurnal_sst_coolskin_step( qns, taum, rhop(:,:,1), rn_Dt)
+
+      CALL iom_put( "sst_wl"   , x_dsst               )    ! warm layer (write out before update below).
+      CALL iom_put( "sst_cs"   , x_csdsst             )    ! cool skin
+
+      ! Diurnal warm layer model       
+      CALL diurnal_sst_takaya_step( kstp, qsr, qns, taum, rhop(:,:,1), rn_Dt) 
+
+   END SUBROUTINE diurnal_layers  
+   
+END MODULE diu_layers
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIU/diurnal_bulk.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIU/diurnal_bulk.F90	(revision 12384)
+++ 	(revision )
@@ -1,267 +1,0 @@
-MODULE diurnal_bulk
-   !!======================================================================
-   !!                    ***  MODULE  diurnal_bulk  ***
-   !!     Takaya model of diurnal warming (Takaya, 2010)
-   !!=====================================================================
-   !! History :        !  11-10  (J. While)  Original code
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   diurnal_sst_bulk_init  : initialise diurnal model
-   !!   diurnal_sst_bulk_step  : time-step the diurnal model
-   !!----------------------------------------------------------------------
-   USE par_kind
-   USE phycst
-   USE dom_oce
-   USE lib_mpp
-   USE solfrac_mod
-   USE in_out_manager
-   
-   IMPLICIT NONE
-   PRIVATE
-   
-   ! Namelist parameters
-   LOGICAL, PUBLIC :: ln_diurnal
-   LOGICAL, PUBLIC :: ln_diurnal_only
-
-   ! Parameters
-   REAL(wp), PRIVATE, PARAMETER :: pp_alpha = 2.0e-4_wp
-   REAL(wp), PRIVATE, PARAMETER :: pp_veltol = 0._wp
-   REAL(wp), PRIVATE, PARAMETER :: pp_min_fvel = 1.e-10_wp 
-   
-   ! Key variables
-   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: x_dsst     ! Delta SST
-   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: x_solfrac  ! Fraction of 
-   !                                                           ! absorbed radiation
-
-   PUBLIC diurnal_sst_bulk_init, diurnal_sst_takaya_step
-   
-   !!----------------------------------------------------------------------
-CONTAINS 
-   
-   SUBROUTINE diurnal_sst_bulk_init
-      !!----------------------------------------------------------------------
-      !! *** ROUTINE diurnal_sst_init ***
-      !!
-      !! ** Purpose : Initialise the Takaya diurnal model   
-      !!----------------------------------------------------------------------      
-      INTEGER ::   ios   ! local integer
-      !!
-      NAMELIST /namdiu/ ln_diurnal, ln_diurnal_only
-      !!----------------------------------------------------------------------      
-
-      ! Read the namelist
-      REWIND( numnam_ref )
-      READ  ( numnam_ref, namdiu, IOSTAT = ios, ERR = 901 )
-901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdiu in reference namelist' )
-      REWIND( numnam_cfg )
-      READ  ( numnam_cfg, namdiu, IOSTAT = ios, ERR = 902 )
-902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdiu in configuration namelist' )      
-      !
-      IF( ln_diurnal_only .AND. ( .NOT. ln_diurnal ) ) THEN
-         CALL ctl_stop( "ln_diurnal_only set, but ln_diurnal = FALSE !" )
-      ENDIF
-      
-      IF( ln_diurnal ) THEN      
-         !         
-         ALLOCATE( x_dsst(jpi,jpj), x_solfrac(jpi,jpj) )
-         !
-         x_solfrac = 0._wp         ! Initialise the solar fraction
-         x_dsst    = 0._wp
-         !
-         IF( ln_diurnal_only ) THEN
-            CALL ctl_warn( "ln_diurnal_only set; only the diurnal component of SST will be calculated" )
-         ENDIF
-      ENDIF
-      
-   END SUBROUTINE diurnal_sst_bulk_init
-
-
-   SUBROUTINE diurnal_sst_takaya_step(kt, psolflux, pqflux, ptauflux, prho, p_rdt,   &
-            &                  pla, pthick, pcoolthick, pmu, &
-            &                  p_fvel_bkginc, p_hflux_bkginc)
-      !!----------------------------------------------------------------------
-      !! *** ROUTINE diurnal_sst_takaya_step ***
-      !!
-      !! ** Purpose :   Time-step the Takaya diurnal model
-      !!
-      !! ** Method :    1) Calculate the Obukhov length
-      !!                2) Calculate the Similarity function
-      !!                2) Calculate the increment to dsst
-      !!                3) Apply the increment
-      !! ** Reference : Refinements to a prognostic scheme of skin sea surface
-      !!                temperature, Takaya et al, JGR, 2010 
-      !!----------------------------------------------------------------------
-      INTEGER                               , INTENT(in) ::   kt             ! time step
-      REAL(wp), DIMENSION(jpi,jpj)          , INTENT(in) ::   psolflux       ! solar flux (Watts)
-      REAL(wp), DIMENSION(jpi,jpj)          , INTENT(in) ::   pqflux         ! heat (non-solar) flux (Watts)
-      REAL(wp), DIMENSION(jpi,jpj)          , INTENT(in) ::   ptauflux       ! wind stress  (kg/ m s^2)
-      REAL(wp), DIMENSION(jpi,jpj)          , INTENT(in) ::   prho           ! water density  (kg/m^3)
-      REAL(wp)                              , INTENT(in) ::   p_rdt          ! time-step
-      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) ::   pLa            ! Langmuir number
-      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) ::   pthick         ! warm layer thickness (m)
-      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) ::   pcoolthick     ! cool skin thickness (m)
-      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) ::   pmu            ! mu parameter
-      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) ::   p_hflux_bkginc ! increment to the heat flux
-      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) ::   p_fvel_bkginc  ! increment to the friction velocity
-      !
-      INTEGER :: ji,jj
-      LOGICAL  :: ll_calcfrac
-      REAL(wp), DIMENSION(jpi,jpj) :: z_fvel              ! friction velocity     
-      REAL(wp), DIMENSION(jpi,jpj) :: zthick, zcoolthick, zmu, zla
-      REAL(wp), DIMENSION(jpi,jpj) :: z_abflux            ! absorbed flux           
-      REAL(wp), DIMENSION(jpi,jpj) :: z_fla               ! Langmuir function value 
-      !!----------------------------------------------------------------------
-
-      ! Set optional arguments to their defaults
-      IF( .NOT. PRESENT( pthick )   ) THEN   ;   zthick(:,:) = 3._wp
-      ELSE                                   ;   zthick(:,:) = pthick(:,:)
-      ENDIF
-      IF( .NOT. PRESENT(pcoolthick) ) THEN   ;   zcoolthick(:,:) = 0._wp
-      ELSE                                   ;   zcoolthick(:,:) = pcoolthick(:,:)
-      ENDIF
-      IF( .NOT. PRESENT( pmu )      ) THEN   ;   zmu(:,:) = 0.3_wp
-      ELSE                                   ;   zmu(:,:) = pmu(:,:)
-      ENDIF
-      IF( .NOT. PRESENT(pla) ) THEN          ;   zla(:,:) = 0.3_wp
-      ELSE                                   ;   zla(:,:) = pla(:,:)
-      ENDIF
-      
-      ! If not done already, calculate the solar fraction
-      IF ( kt==nit000 ) THEN
-         DO jj = 1,jpj
-            DO ji = 1, jpi
-               IF(  ( x_solfrac(ji,jj) == 0._wp ) .AND. ( tmask(ji,jj,1) == 1._wp ) ) &
-                  &   x_solfrac(ji,jj) = solfrac( zcoolthick(ji,jj),zthick(ji,jj) )
-            END DO
-         END DO   
-      ENDIF   
-
-      ! convert solar flux and heat flux to absorbed flux   
-      WHERE ( tmask(:,:,1) == 1._wp) 
-         z_abflux(:,:) = (  x_solfrac(:,:) *  psolflux (:,:)) + pqflux(:,:)     
-      ELSEWHERE
-         z_abflux(:,:) = 0._wp
-      ENDWHERE
-      IF( PRESENT(p_hflux_bkginc) ) z_abflux(:,:) = z_abflux(:,:) + p_hflux_bkginc   ! Optional increment
-      WHERE ( ABS( z_abflux(:,:) ) < rsmall )
-         z_abflux(:,:) = rsmall
-      ENDWHERE 
-      
-      ! Calculate the friction velocity
-      WHERE ( (ptauflux /= 0) .AND. ( tmask(:,:,1) == 1.) )   
-         z_fvel(:,:) = SQRT( ptauflux(:,:) / prho(:,:) )
-      ELSEWHERE
-         z_fvel(:,:) = 0._wp
-      ENDWHERE
-      IF( PRESENT(p_fvel_bkginc) ) z_fvel(:,:) = z_fvel(:,:) + p_fvel_bkginc   ! Optional increment
-      
-       
-       
-      ! Calculate the Langmuir function value
-      WHERE ( tmask(:,:,1) == 1.)
-         z_fla(:,:) = MAX( 1._wp, zla(:,:)**( -2._wp / 3._wp ) )  
-      ELSEWHERE
-         z_fla(:,:) = 0._wp
-      ENDWHERE     
-      
-      ! Increment the temperature using the implicit solution
-      x_dsst(:,:) = t_imp( x_dsst(:,:), p_rdt, z_abflux(:,:), z_fvel(:,:),   &
-         &                       z_fla(:,:), zmu(:,:), zthick(:,:), prho(:,:) )
-      !
-   END SUBROUTINE diurnal_sst_takaya_step
-
-   
-   FUNCTION t_imp(p_dsst, p_rdt, p_abflux, p_fvel, &
-                          p_fla, pmu, pthick, prho )
-                          
-      IMPLICIT NONE
-      
-      ! Function definition
-      REAL(wp), DIMENSION(jpi,jpj) :: t_imp
-      ! Dummy variables
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_dsst     ! Delta SST
-      REAL(wp), INTENT(IN)                     :: p_rdt      ! Time-step
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_abflux   ! Heat forcing
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_fvel     ! Friction velocity
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_fla      ! Langmuir number
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: pmu        ! Structure parameter
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: pthick     ! Layer thickness
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: prho       ! Water density
-   
-      ! Local variables
-      REAL(wp) :: z_olength          ! Obukhov length
-      REAL(wp) :: z_sigma, z_sigma2
-      REAL(wp) :: z_term1, z_term2     
-      REAL(wp) :: z_stabfunc         ! stability function value
-      REAL(wp) :: z_fvel      
-      
-      CHARACTER(200) :: warn_string
-       
-      INTEGER :: ji,jj
-                     
-      DO jj = 1, jpj
-         DO ji = 1, jpi   
-            
-            ! Only calculate outside tmask
-            IF ( tmask(ji,jj,1) /= 1._wp ) THEN
-               t_imp(ji,jj) = 0._wp
-               CYCLE   
-            END IF
-            
-            IF (p_fvel(ji,jj) < pp_min_fvel) THEN
-               z_fvel = pp_min_fvel
-               WRITE(warn_string,*) "diurnal_sst_takaya step: "&
-               &//"friction velocity < minimum\n" &
-               &//"Setting friction velocity =",pp_min_fvel
-               CALL ctl_warn(warn_string)
-               
-            ELSE
-               z_fvel = p_fvel(ji,jj)
-            ENDIF
-                 
-            ! Calculate the Obukhov length
-            IF ( (z_fvel < pp_veltol ) .AND. &
-            &    (p_dsst(ji,jj) > 0._wp) ) THEN
-               z_olength =  z_fvel  / &
-               &     SQRT( p_dsst(ji,jj) * vkarmn * grav * &
-               &             pp_alpha / ( 5._wp * pthick(ji,jj) ) )
-            ELSE
-               z_olength = &
-               &   ( prho(ji,jj) * rcp * z_fvel**3._wp ) / &
-               &   ( vkarmn * grav * pp_alpha *&
-               &     p_abflux(ji,jj) )
-            ENDIF
-             
-            ! Calculate the stability function          
-            z_sigma = pthick(ji,jj) / z_olength
-            z_sigma2 = z_sigma * z_sigma
-  
-            IF ( z_sigma >= 0. ) THEN
-               z_stabfunc = 1._wp + &
-               &  ( ( 5._wp * z_sigma + 4._wp * z_sigma2 ) / &
-               &  ( 1._wp + 3._wp * z_sigma + 0.25_wp * &
-               &    z_sigma2 ) )
-            ELSE
-               z_stabfunc = 1._wp / &
-               &                   SQRT( 1._wp - 16._wp * z_sigma )
-            ENDIF
-
-            ! Calculate the T increment
-            z_term1 = ( p_abflux(ji,jj) * ( pmu(ji,jj) + 1._wp)  / &
-            & ( pmu(ji,jj) * pthick(ji,jj) * prho(ji,jj) * rcp ) )
-            
-             
-            z_term2 = -( ( pmu(ji,jj) + 1._wp) * &
-            &                       ( vkarmn * z_fvel * p_fla(ji,jj) ) / &
-            &      ( pthick(ji,jj) * z_stabfunc ) )     
-          
-            t_imp(ji,jj) = ( p_dsst(ji,jj) + p_rdt * z_term1 ) / &
-                           ( 1._wp - p_rdt * z_term2 )
-
-         END DO
-      END DO
-      
-      END FUNCTION t_imp
-
-END MODULE diurnal_bulk
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIU/step_diu.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIU/step_diu.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DIU/step_diu.F90	(revision 12928)
@@ -6,6 +6,5 @@
    !! History :  3.7  ! 2015-11  (J. While)  Original code
 
-   USE diurnal_bulk    ! diurnal SST bulk routines  (diurnal_sst_takaya routine) 
-   USE cool_skin       ! diurnal cool skin correction (diurnal_sst_coolskin routine)   
+   USE diu_layers      ! diurnal SST bulk and coolskin routines
    USE iom
    USE sbc_oce
@@ -49,4 +48,5 @@
       INTEGER ::   indic    ! error indicator if < 0 
       REAL(wp), DIMENSION(jpi,jpj) :: z_fvel_bkginc, z_hflux_bkginc     
+      INTEGER :: Nbb, Nnn, Naa, Nrhs    ! local definitions as placeholders for now
       !! --------------------------------------------------------------------- 
       
@@ -60,23 +60,12 @@
          ENDIF
        
-            CALL sbc    ( kstp )                      ! Sea Boundary Conditions 
+            CALL sbc    ( kstp, Nbb, Nnn )            ! Sea Boundary Conditions 
       ENDIF
      
-      ! Cool skin
-      IF( .NOT.ln_diurnal )   CALL ctl_stop( "stp_diurnal: ln_diurnal not set" )
-         
-      IF( .NOT. ln_blk    )   CALL ctl_stop( "stp_diurnal: diurnal flux processing only implemented for bulk forcing" ) 
-
-      CALL diurnal_sst_coolskin_step( qns, taum, rhop(:,:,1), rdt)
-
-      CALL iom_put( "sst_wl"   , x_dsst               )    ! warm layer (write out before update below).
-      CALL iom_put( "sst_cs"   , x_csdsst             )    ! cool skin
-
-      ! Diurnal warm layer model       
-      CALL diurnal_sst_takaya_step( kstp, & 
-      &    qsr, qns, taum, rhop(:,:,1), rdt) 
+      call diurnal_layers( kstp )                     ! coolskin and warm layer calculations
 
       IF( ln_diurnal_only ) THEN
-         IF( ln_diaobs )         CALL dia_obs( kstp )         ! obs-minus-model (assimilation) diagnostics (call after dynamics update)
+         ! WILL HAVE TO INCREMENT Nbb and Nnn here in ln_diurnal_only case !
+         IF( ln_diaobs )         CALL dia_obs( kstp, Nnn )    ! obs-minus-model (assimilation) diagnostics (call after dynamics update)
      
          !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
@@ -84,5 +73,5 @@
          !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
          IF( kstp == nit000   )   CALL iom_close( numror )     ! close input  ocean restart file 
-         IF( lrst_oce         )   CALL rst_write    ( kstp )   ! write output ocean restart file
+         IF( lrst_oce         )   CALL rst_write    ( kstp, Nbb, Nnn )   ! write output ocean restart file
      
          IF( ln_timing .AND.  kstp == nit000  )   CALL timing_reset 
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/closea.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/closea.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/closea.F90	(revision 12928)
@@ -11,56 +11,44 @@
    !!             4.0  !  2016-06  (G. Madec)  move to usrdef_closea, remove clo_ups
    !!             4.0  !  2017-12  (D. Storkey) new formulation based on masks read from file
+   !!             4.1  !  2019-07  (P. Mathiot) update to the new domcfg.nc input file
    !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
    !!   dom_clo    : read in masks which define closed seas and runoff areas
-   !!   sbc_clo    : Special handling of freshwater fluxes over closed seas
    !!   clo_rnf    : set close sea outflows as river mouths (see sbcrnf)
-   !!   clo_bat    : set to zero a field over closed sea (see domzgr)
-   !!----------------------------------------------------------------------
-   USE oce             ! dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE phycst          ! physical constants
-   USE sbc_oce         ! ocean surface boundary conditions
-   USE iom             ! I/O routines
+   !!   clo_msk    : set to zero a field over closed sea (see domzgr)
+   !!----------------------------------------------------------------------
+   USE in_out_manager  ! I/O manager
    !
-   USE in_out_manager  ! I/O manager
-   USE lib_fortran,    ONLY: glob_sum
-   USE lbclnk          ! lateral boundary condition - MPP exchanges
-   USE lib_mpp         ! MPP library
-   USE timing          ! Timing
+   USE diu_bulk    , ONLY: ln_diurnal_only            ! used for sanity check
+   USE iom         , ONLY: iom_open, iom_get, iom_close, jpdom_data ! I/O routines
+   USE lib_fortran , ONLY: glob_sum                   ! fortran library
+   USE lib_mpp     , ONLY: mpp_max, ctl_nam, ctl_stop ! MPP library
 
    IMPLICIT NONE
+
    PRIVATE
 
    PUBLIC dom_clo      ! called by domain module
-   PUBLIC sbc_clo      ! called by sbcmod module
    PUBLIC clo_rnf      ! called by sbcrnf module
-   PUBLIC clo_bat      ! called in domzgr module
-
-   LOGICAL, PUBLIC :: ln_closea  !:  T => keep closed seas (defined by closea_mask field) in the domain and apply
-                                 !:       special treatment of freshwater fluxes.
-                                 !:  F => suppress closed seas (defined by closea_mask field) from the bathymetry
-                                 !:       at runtime.
-                                 !:  If there is no closea_mask field in the domain_cfg file or we do not use
-                                 !:  a domain_cfg file then this logical does nothing.
-                                 !:
-   LOGICAL, PUBLIC :: l_sbc_clo  !: T => Closed seas defined, apply special treatment of freshwater fluxes.
-                                 !: F => No closed seas defined (closea_mask field not found).
-   LOGICAL, PUBLIC :: l_clo_rnf  !: T => Some closed seas output freshwater (RNF or EMPMR) to specified runoff points.
-   INTEGER, PUBLIC :: jncs       !: number of closed seas (inferred from closea_mask field)
-   INTEGER, PUBLIC :: jncsr      !: number of closed seas rnf mappings (inferred from closea_mask_rnf field)
-   INTEGER, PUBLIC :: jncse      !: number of closed seas empmr mappings (inferred from closea_mask_empmr field)
-   
-   INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::  closea_mask       !: mask of integers defining closed seas
-   INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::  closea_mask_rnf   !: mask of integers defining closed seas rnf mappings
-   INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::  closea_mask_empmr !: mask of integers defining closed seas empmr mappings
-   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:)  ::   surf         !: closed sea surface areas 
-                                                                  !: (and residual global surface area) 
-   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:)  ::   surfr        !: closed sea target rnf surface areas 
-   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:)  ::   surfe        !: closed sea target empmr surface areas 
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+   PUBLIC clo_msk      ! called in domzgr module
+
+   LOGICAL, PUBLIC :: ln_maskcs        !: logical to mask all closed sea
+   LOGICAL, PUBLIC :: ln_mask_csundef  !: logical to mask all undefined closed sea
+   LOGICAL, PUBLIC :: ln_clo_rnf       !: closed sea treated as runoff (update rnf mask)
+
+   LOGICAL, PUBLIC :: l_sbc_clo  !: T => net evap/precip over closed seas spread outover the globe/river mouth
+   LOGICAL, PUBLIC :: l_clo_rnf  !: T => Some closed seas output freshwater (RNF) to specified runoff points.
+
+   INTEGER, PUBLIC :: ncsg      !: number of closed seas global mappings (inferred from closea_mask_glo field)
+   INTEGER, PUBLIC :: ncsr      !: number of closed seas rnf    mappings (inferred from closea_mask_rnf field)
+   INTEGER, PUBLIC :: ncse      !: number of closed seas empmr  mappings (inferred from closea_mask_emp field)
+
+   INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: mask_opnsea, mask_csundef  !: mask defining the open sea and the undefined closed sea
+ 
+   INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: mask_csglo , mask_csgrpglo !: mask of integers defining closed seas
+   INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: mask_csrnf , mask_csgrprnf !: mask of integers defining closed seas rnf mappings
+   INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: mask_csemp , mask_csgrpemp !: mask of integers defining closed seas empmr mappings
+
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -76,331 +64,103 @@
       !! ** 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  :   Read closea_mask* fields (if they exist) from domain_cfg file and infer
-      !!                number of closed seas from closea_mask field.
-      !!                closea_mask       : integer values defining closed seas (or groups of closed seas)
-      !!                closea_mask_rnf   : integer values defining mappings from closed seas or groups of
-      !!                                    closed seas to a runoff area for downwards flux only.
-      !!                closea_mask_empmr : integer values defining mappings from closed seas or groups of
-      !!                                    closed seas to a runoff area for net fluxes.
-      !!
-      !!                Python code to generate the closea_masks* fields from the old-style indices
-      !!                definitions is available at TOOLS/DOMAINcfg/make_closea_masks.py
-      !!----------------------------------------------------------------------
-      INTEGER ::   inum    ! input file identifier
-      INTEGER ::   ierr    ! error code
-      INTEGER ::   id      ! netcdf variable ID
-
-      REAL(wp), DIMENSION(jpi,jpj) :: zdata_in ! temporary real array for input
-      !!----------------------------------------------------------------------
-      !
+      !! ** Action  :   Read mask_cs* fields (if needed) from domain_cfg file and infer
+      !!                number of closed seas for each case (glo, rnf, emp) from mask_cs* field.
+      !!
+      !! ** Output  :   mask_csglo and mask_csgrpglo  : integer values defining mappings from closed seas and associated groups to the open ocean for net fluxes.
+      !!                mask_csrnf and mask_csgrprnf  : integer values defining mappings from closed seas and associated groups to a runoff area for downwards flux only.
+      !!                mask_csemp and mask_csgrpemp  : integer values defining mappings from closed seas and associated groups to a runoff area for net fluxes.
+      !!----------------------------------------------------------------------
+      INTEGER ::   ios     ! io status
+      !!
+      NAMELIST/namclo/ ln_maskcs, ln_mask_csundef, ln_clo_rnf
+      !!---------------------------------------------------------------------
+      !!
+      READ  ( numnam_ref, namclo, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namclo in reference namelist' )
+      READ  ( numnam_cfg, namclo, IOSTAT = ios, ERR = 902 )
+902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namclo in configuration namelist' )
+      IF(lwm) WRITE ( numond, namclo )
+      !!
       IF(lwp) WRITE(numout,*)
       IF(lwp) WRITE(numout,*)'dom_clo : read in masks to define closed seas '
       IF(lwp) WRITE(numout,*)'~~~~~~~'
+      IF(lwp) WRITE(numout,*)
+      !!
+      !! check option compatibility
+      IF( .NOT. ln_read_cfg ) THEN
+         CALL ctl_stop('Suppression of closed seas does not work with ln_read_cfg = .true. . Set ln_closea = .false. .')
+      ENDIF
+      !!
+      IF( (.NOT. ln_maskcs) .AND. ln_diurnal_only ) THEN
+         CALL ctl_stop('Special handling of freshwater fluxes over closed seas not compatible with ln_diurnal_only.')
+      END IF
       !
       ! read the closed seas masks (if they exist) from domain_cfg file (if it exists)
       ! ------------------------------------------------------------------------------
       !
-      IF( ln_read_cfg) THEN
-         !
-         CALL iom_open( cn_domcfg, inum )
-         !
-         id = iom_varid(inum, 'closea_mask', ldstop = .false.)
-         IF( id > 0 ) THEN 
-            l_sbc_clo = .true.
-            ALLOCATE( closea_mask(jpi,jpj) , STAT=ierr )
-            IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'dom_clo: failed to allocate closea_mask array')
-            zdata_in(:,:) = 0.0
-            CALL iom_get ( inum, jpdom_data, 'closea_mask', zdata_in )
-            closea_mask(:,:) = NINT(zdata_in(:,:)) * tmask(:,:,1)
-            ! number of closed seas = global maximum value in closea_mask field
-            jncs = maxval(closea_mask(:,:))
-            CALL mpp_max('closea', jncs)
-            IF( jncs > 0 ) THEN
-               IF( lwp ) WRITE(numout,*) 'Number of closed seas : ',jncs
-            ELSE
-               CALL ctl_stop( 'Problem with closea_mask field in domain_cfg file. Has no values > 0 so no closed seas defined.')
-            ENDIF
-         ELSE 
-            IF( lwp ) WRITE(numout,*)
-            IF( lwp ) WRITE(numout,*) '   ==>>>   closea_mask field not found in domain_cfg file.'
-            IF( lwp ) WRITE(numout,*) '           No closed seas defined.'
-            IF( lwp ) WRITE(numout,*)
-            l_sbc_clo = .false.
-            jncs = 0 
-         ENDIF
-
-         l_clo_rnf = .false.
-
-         IF( l_sbc_clo ) THEN ! No point reading in closea_mask_rnf or closea_mask_empmr fields if no closed seas defined.
-
-            id = iom_varid(inum, 'closea_mask_rnf', ldstop = .false.)
-            IF( id > 0 ) THEN 
-               l_clo_rnf = .true.            
-               ALLOCATE( closea_mask_rnf(jpi,jpj) , STAT=ierr )
-               IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'dom_clo: failed to allocate closea_mask_rnf array')
-               CALL iom_get ( inum, jpdom_data, 'closea_mask_rnf', zdata_in )
-               closea_mask_rnf(:,:) = NINT(zdata_in(:,:)) * tmask(:,:,1)
-               ! number of closed seas rnf mappings = global maximum in closea_mask_rnf field
-               jncsr = maxval(closea_mask_rnf(:,:))
-               CALL mpp_max('closea', jncsr)
-               IF( jncsr > 0 ) THEN
-                  IF( lwp ) WRITE(numout,*) 'Number of closed seas rnf mappings : ',jncsr
-               ELSE
-                  CALL ctl_stop( 'Problem with closea_mask_rnf field in domain_cfg file. Has no values > 0 so no closed seas rnf mappings defined.')
-               ENDIF
-            ELSE 
-               IF( lwp ) WRITE(numout,*) 'closea_mask_rnf field not found in domain_cfg file. No closed seas rnf mappings defined.'
-               jncsr = 0
-            ENDIF
- 
-            id = iom_varid(inum, 'closea_mask_empmr', ldstop = .false.)
-            IF( id > 0 ) THEN 
-               l_clo_rnf = .true.            
-               ALLOCATE( closea_mask_empmr(jpi,jpj) , STAT=ierr )
-               IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'dom_clo: failed to allocate closea_mask_empmr array')
-               CALL iom_get ( inum, jpdom_data, 'closea_mask_empmr', zdata_in )
-               closea_mask_empmr(:,:) = NINT(zdata_in(:,:)) * tmask(:,:,1)
-               ! number of closed seas empmr mappings = global maximum value in closea_mask_empmr field
-               jncse = maxval(closea_mask_empmr(:,:))
-               CALL mpp_max('closea', jncse)
-               IF( jncse > 0 ) THEN 
-                  IF( lwp ) WRITE(numout,*) 'Number of closed seas empmr mappings : ',jncse
-               ELSE
-                  CALL ctl_stop( 'Problem with closea_mask_empmr field in domain_cfg file. Has no values > 0 so no closed seas empmr mappings defined.')
-               ENDIF
-            ELSE 
-               IF( lwp ) WRITE(numout,*) 'closea_mask_empmr field not found in domain_cfg file. No closed seas empmr mappings defined.'
-               jncse = 0
-            ENDIF
-
-         ENDIF ! l_sbc_clo
-         !
-         CALL iom_close( inum )
-         !
-      ELSE ! ln_read_cfg = .false. so no domain_cfg file
-         IF( lwp ) WRITE(numout,*) 'No domain_cfg file so no closed seas defined.'
-         l_sbc_clo = .false.
-         l_clo_rnf = .false.
-      ENDIF
-      !
+      ! load mask of open sea
+      CALL alloc_csmask( mask_opnsea )
+      CALL read_csmask( cn_domcfg, 'mask_opensea' , mask_opnsea  )
+      !
+      IF ( ln_maskcs ) THEN
+         ! closed sea are masked
+         IF(lwp) WRITE(numout,*)'          ln_maskcs = T : all closed seas are masked'
+         IF(lwp) WRITE(numout,*)
+         ! no special treatment of closed sea
+         ! no redistribution of emp unbalance over closed sea into river mouth/open ocean
+         l_sbc_clo = .false. ; l_clo_rnf = .false.
+      ELSE
+         ! redistribution of emp unbalance over closed sea into river mouth/open ocean
+         IF(lwp) WRITE(numout,*)'          ln_maskcs = F : net emp is corrected over defined closed seas'
+         !
+         l_sbc_clo = .true.
+         !
+         ! river mouth from lakes added to rnf mask for special treatment
+         IF ( ln_clo_rnf) l_clo_rnf = .true.
+         !
+         IF ( ln_mask_csundef) THEN
+            ! closed sea not defined (ie not in the domcfg namelist used to build the domcfg.nc file) are masked 
+            IF(lwp) WRITE(numout,*)'          ln_mask_csundef = T : all undefined closed seas are masked'
+            !
+            CALL alloc_csmask( mask_csundef )
+            CALL read_csmask( cn_domcfg, 'mask_csundef', mask_csundef )
+            ! revert the mask for masking of undefined closed seas in domzgr 
+            ! (0 over the undefined closed sea and 1 elsewhere)
+            mask_csundef(:,:) = 1 - mask_csundef(:,:)
+         END IF
+         IF(lwp) WRITE(numout,*)
+         !
+         ! allocate source mask for each cases
+         CALL alloc_csmask( mask_csglo )
+         CALL alloc_csmask( mask_csrnf )
+         CALL alloc_csmask( mask_csemp )
+         !
+         ! load source mask of cs for each cases
+         CALL read_csmask( cn_domcfg, 'mask_csglo', mask_csglo )
+         CALL read_csmask( cn_domcfg, 'mask_csrnf', mask_csrnf )
+         CALL read_csmask( cn_domcfg, 'mask_csemp', mask_csemp )
+         !
+         ! compute number of cs for each cases
+         ncsg = MAXVAL( mask_csglo(:,:) ) ; CALL mpp_max( 'closea', ncsg )
+         ncsr = MAXVAL( mask_csrnf(:,:) ) ; CALL mpp_max( 'closea', ncsr )
+         ncse = MAXVAL( mask_csemp(:,:) ) ; CALL mpp_max( 'closea', ncse )
+         !
+         ! allocate closed sea group masks 
+         !(used to defined the target area in case multiple lakes have the same river mouth (great lakes for example))
+         CALL alloc_csmask( mask_csgrpglo )
+         CALL alloc_csmask( mask_csgrprnf )
+         CALL alloc_csmask( mask_csgrpemp )
+
+         ! load mask of cs group for each cases
+         CALL read_csmask( cn_domcfg, 'mask_csgrpglo', mask_csgrpglo )
+         CALL read_csmask( cn_domcfg, 'mask_csgrprnf', mask_csgrprnf )
+         CALL read_csmask( cn_domcfg, 'mask_csgrpemp', mask_csgrpemp )
+         !
+      END IF
    END SUBROUTINE dom_clo
 
-
-   SUBROUTINE sbc_clo( kt )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE sbc_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  :   emp updated surface freshwater fluxes and associated heat content at kt
-      !!----------------------------------------------------------------------
-      INTEGER         , INTENT(in   ) ::   kt       ! ocean model time step
-      !
-      INTEGER             ::   ierr
-      INTEGER             ::   jc, jcr, jce   ! dummy loop indices
-      REAL(wp), PARAMETER ::   rsmall = 1.e-20_wp    ! Closed sea correction epsilon
-      REAL(wp)            ::   zfwf_total, zcoef, zcoef1         ! 
-      REAL(wp), DIMENSION(jncs)    ::   zfwf      !:
-      REAL(wp), DIMENSION(jncsr+1) ::   zfwfr     !: freshwater fluxes over closed seas
-      REAL(wp), DIMENSION(jncse+1) ::   zfwfe     !: 
-      REAL(wp), DIMENSION(jpi,jpj) ::   ztmp2d   ! 2D workspace
-      !!----------------------------------------------------------------------
-      !
-      IF( ln_timing )  CALL timing_start('sbc_clo')
-      !
-      !                                                   !------------------! 
-      IF( kt == nit000 ) THEN                             !  Initialisation  !
-         !                                                !------------------!
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*)'sbc_clo : closed seas '
-         IF(lwp) WRITE(numout,*)'~~~~~~~'
-
-         ALLOCATE( surf(jncs+1) , STAT=ierr )
-         IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'sbc_clo: failed to allocate surf array')
-         surf(:) = 0.e0_wp
-         !
-         ! jncsr can be zero so add 1 to avoid allocating zero-length array
-         ALLOCATE( surfr(jncsr+1) , STAT=ierr )
-         IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'sbc_clo: failed to allocate surfr array')
-         surfr(:) = 0.e0_wp
-         !
-         ! jncse can be zero so add 1 to avoid allocating zero-length array
-         ALLOCATE( surfe(jncse+1) , STAT=ierr )
-         IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'sbc_clo: failed to allocate surfe array')
-         surfe(:) = 0.e0_wp
-         !
-         surf(jncs+1) = glob_sum( 'closea', e1e2t(:,:) )   ! surface of the global ocean
-         !
-         !                                        ! surface areas of closed seas 
-         DO jc = 1, jncs
-            ztmp2d(:,:) = 0.e0_wp
-            WHERE( closea_mask(:,:) == jc ) ztmp2d(:,:) = e1e2t(:,:) * tmask_i(:,:)
-            surf(jc) = glob_sum( 'closea', ztmp2d(:,:) )
-         END DO
-         !
-         ! jncs+1 : surface area of global ocean, closed seas excluded
-         surf(jncs+1) = surf(jncs+1) - SUM(surf(1:jncs))
-         !
-         !                                        ! surface areas of rnf target areas
-         IF( jncsr > 0 ) THEN
-            DO jcr = 1, jncsr
-               ztmp2d(:,:) = 0.e0_wp
-               WHERE( closea_mask_rnf(:,:) == jcr .and. closea_mask(:,:) == 0 ) ztmp2d(:,:) = e1e2t(:,:) * tmask_i(:,:)
-               surfr(jcr) = glob_sum( 'closea', ztmp2d(:,:) )
-            END DO
-         ENDIF
-         !
-         !                                        ! surface areas of empmr target areas
-         IF( jncse > 0 ) THEN
-            DO jce = 1, jncse
-               ztmp2d(:,:) = 0.e0_wp
-               WHERE( closea_mask_empmr(:,:) == jce .and. closea_mask(:,:) == 0 ) ztmp2d(:,:) = e1e2t(:,:) * tmask_i(:,:)
-               surfe(jce) = glob_sum( 'closea', ztmp2d(:,:) )
-            END DO
-         ENDIF
-         !
-         IF(lwp) WRITE(numout,*)'     Closed sea surface areas (km2)'
-         DO jc = 1, jncs
-            IF(lwp) WRITE(numout,FMT='(1I3,5X,ES12.2)') jc, surf(jc) * 1.0e-6
-         END DO
-         IF(lwp) WRITE(numout,FMT='(A,ES12.2)') 'Global surface area excluding closed seas (km2): ', surf(jncs+1) * 1.0e-6
-         !
-         IF(jncsr > 0) THEN
-            IF(lwp) WRITE(numout,*)'     Closed sea target rnf surface areas (km2)'
-            DO jcr = 1, jncsr
-               IF(lwp) WRITE(numout,FMT='(1I3,5X,ES12.2)') jcr, surfr(jcr) * 1.0e-6
-            END DO
-         ENDIF
-         !
-         IF(jncse > 0) THEN
-            IF(lwp) WRITE(numout,*)'     Closed sea target empmr surface areas (km2)'
-            DO jce = 1, jncse
-               IF(lwp) WRITE(numout,FMT='(1I3,5X,ES12.2)') jce, surfe(jce) * 1.0e-6
-            END DO
-         ENDIF
-      ENDIF
-      !
-      !                                                      !--------------------!
-      !                                                      !  update emp        !
-      !                                                      !--------------------!
-
-      zfwf_total = 0._wp
-
-      !
-      ! 1. Work out total freshwater fluxes over closed seas from EMP - RNF.
-      !
-      zfwf(:) = 0.e0_wp           
-      DO jc = 1, jncs
-         ztmp2d(:,:) = 0.e0_wp
-         WHERE( closea_mask(:,:) == jc ) ztmp2d(:,:) = e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:)
-         zfwf(jc) = glob_sum( 'closea', ztmp2d(:,:) )
-      END DO
-      zfwf_total = SUM(zfwf)
-
-      zfwfr(:) = 0.e0_wp           
-      IF( jncsr > 0 ) THEN
-         !
-         ! 2. Work out total FW fluxes over rnf source areas and add to rnf target areas. 
-         !    Where zfwf is negative add flux at specified runoff points and subtract from fluxes for global redistribution.
-         !    Where positive leave in global redistribution total.
-         !
-         DO jcr = 1, jncsr
-            !
-            ztmp2d(:,:) = 0.e0_wp
-            WHERE( closea_mask_rnf(:,:) == jcr .and. closea_mask(:,:) > 0 ) ztmp2d(:,:) = e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:)
-            zfwfr(jcr) = glob_sum( 'closea', ztmp2d(:,:) )
-            !
-            ! The following if avoids the redistribution of the round off
-            IF ( ABS(zfwfr(jcr) / surf(jncs+1) ) > rsmall) THEN
-               !
-               ! Add residuals to target runoff points if negative and subtract from total to be added globally
-               IF( zfwfr(jcr) < 0.0 ) THEN 
-                  zfwf_total = zfwf_total - zfwfr(jcr)
-                  zcoef    = zfwfr(jcr) / surfr(jcr)
-                  zcoef1   = rcp * zcoef
-                  WHERE( closea_mask_rnf(:,:) == jcr .and. closea_mask(:,:) == 0.0)
-                     emp(:,:) = emp(:,:) + zcoef
-                     qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:)
-                  ENDWHERE
-               ENDIF
-               !
-            ENDIF
-         END DO
-      ENDIF  ! jncsr > 0    
-      !
-      zfwfe(:) = 0.e0_wp           
-      IF( jncse > 0 ) THEN
-         !
-         ! 3. Work out total fluxes over empmr source areas and add to empmr target areas. 
-         !
-         DO jce = 1, jncse
-            !
-            ztmp2d(:,:) = 0.e0_wp
-            WHERE( closea_mask_empmr(:,:) == jce .and. closea_mask(:,:) > 0 ) ztmp2d(:,:) = e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:)
-            zfwfe(jce) = glob_sum( 'closea', ztmp2d(:,:) )
-            !
-            ! The following if avoids the redistribution of the round off
-            IF ( ABS( zfwfe(jce) / surf(jncs+1) ) > rsmall ) THEN
-               !
-               ! Add residuals to runoff points and subtract from total to be added globally
-               zfwf_total = zfwf_total - zfwfe(jce)
-               zcoef    = zfwfe(jce) / surfe(jce)
-               zcoef1   = rcp * zcoef
-               WHERE( closea_mask_empmr(:,:) == jce .and. closea_mask(:,:) == 0.0)
-                  emp(:,:) = emp(:,:) + zcoef
-                  qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:)
-               ENDWHERE
-               !
-            ENDIF
-         END DO
-      ENDIF ! jncse > 0    
-
-      !
-      ! 4. Spread residual flux over global ocean. 
-      !
-      ! The following if avoids the redistribution of the round off
-      IF ( ABS(zfwf_total / surf(jncs+1) ) > rsmall) THEN
-         zcoef    = zfwf_total / surf(jncs+1)
-         zcoef1   = rcp * zcoef
-         WHERE( closea_mask(:,:) == 0 )
-            emp(:,:) = emp(:,:) + zcoef
-            qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:)
-         ENDWHERE
-      ENDIF
-
-      !
-      ! 5. Subtract area means from emp (and qns) over closed seas to give zero mean FW flux over each sea.
-      !
-      DO jc = 1, jncs
-         ! The following if avoids the redistribution of the round off
-         IF ( ABS(zfwf(jc) / surf(jncs+1) ) > rsmall) THEN
-            !
-            ! Subtract residuals from fluxes over closed sea
-            zcoef    = zfwf(jc) / surf(jc)
-            zcoef1   = rcp * zcoef
-            WHERE( closea_mask(:,:) == jc )
-               emp(:,:) = emp(:,:) - zcoef
-               qns(:,:) = qns(:,:) + zcoef1 * sst_m(:,:)
-            ENDWHERE
-            !
-         ENDIF
-      END DO
-      !
-      emp (:,:) = emp (:,:) * tmask(:,:,1)
-      !
-      CALL lbc_lnk( 'closea', emp , 'T', 1._wp )
-      !
-   END SUBROUTINE sbc_clo
-
    SUBROUTINE clo_rnf( p_rnfmsk )
       !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE sbc_rnf  ***
+      !!                  ***  ROUTINE clo_rnf  ***
       !!                    
       !! ** Purpose :   allow the treatment of closed sea outflow grid-points
@@ -412,30 +172,26 @@
       !! ** Action  :   update (p_)mskrnf (set 1 at closed sea outflow)
       !!----------------------------------------------------------------------
+      !! subroutine parameter
       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_rnfmsk   ! river runoff mask (rnfmsk array)
-      !!----------------------------------------------------------------------
-      !
-      IF( jncsr > 0 ) THEN
-         WHERE( closea_mask_rnf(:,:) > 0 .and. closea_mask(:,:) == 0 )
-            p_rnfmsk(:,:) = MAX( p_rnfmsk(:,:), 1.0_wp )
-         ENDWHERE
-      ENDIF
-      !
-      IF( jncse > 0 ) THEN
-         WHERE( closea_mask_empmr(:,:) > 0 .and. closea_mask(:,:) == 0 )
-            p_rnfmsk(:,:) = MAX( p_rnfmsk(:,:), 1.0_wp )
-         ENDWHERE
-      ENDIF
+      !!
+      !! local variables
+      REAL(wp), DIMENSION(jpi,jpj) :: zmsk
+      !!----------------------------------------------------------------------
+      !
+      ! zmsk > 0 where cs river mouth defined (case rnf and emp)
+      zmsk(:,:) = ( mask_csgrprnf (:,:) + mask_csgrpemp(:,:) ) * mask_opnsea(:,:)
+      WHERE( zmsk(:,:) > 0 )
+         p_rnfmsk(:,:) = 1.0_wp
+      END WHERE
       !
    END SUBROUTINE clo_rnf
-   
       
-   SUBROUTINE clo_bat( k_top, k_bot )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE clo_bat  ***
+   SUBROUTINE clo_msk( k_top, k_bot, k_mask, cd_prt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE clo_msk  ***
       !!                    
       !! ** Purpose :   Suppress closed sea from the domain
       !!
-      !! ** Method  :   Read in closea_mask field (if it exists) from domain_cfg file.
-      !!                Where closea_mask > 0 set first and last ocean level to 0
+      !! ** Method  :   Where closea_mask > 0 set first and last ocean level to 0
       !!                (As currently coded you can't define a closea_mask field in 
       !!                usr_def_zgr).
@@ -443,46 +199,64 @@
       !! ** Action  :   set k_top=0 and k_bot=0 over closed seas
       !!----------------------------------------------------------------------
+      !! subroutine parameter
       INTEGER, DIMENSION(:,:), INTENT(inout) ::   k_top, k_bot   ! ocean first and last level indices
-      INTEGER                           :: inum, id
-      INTEGER,  DIMENSION(jpi,jpj) :: closea_mask ! closea_mask field
-      REAL(wp), DIMENSION(jpi,jpj) :: zdata_in ! temporary real array for input
-      !!----------------------------------------------------------------------
-      !
-      IF(lwp) THEN                     ! Control print
+      INTEGER, DIMENSION(:,:), INTENT(in   ) ::   k_mask         ! mask used to mask ktop and k_bot
+      CHARACTER(LEN=*),        INTENT(in   ) ::   cd_prt         ! text for control print
+      !!
+      !! local variables
+      !!----------------------------------------------------------------------
+      !!
+      IF ( lwp ) THEN
          WRITE(numout,*)
-         WRITE(numout,*) 'clo_bat : suppression of closed seas'
+         WRITE(numout,*) 'clo_msk : Suppression closed seas based on ',TRIM(cd_prt),' field.'
          WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*)
       ENDIF
-      !
-      IF( ln_read_cfg ) THEN
-         !
-         CALL iom_open( cn_domcfg, inum )
-         !
-         id = iom_varid(inum, 'closea_mask', ldstop = .false.)      
-         IF( id > 0 ) THEN
-            IF( lwp ) WRITE(numout,*) 'Suppressing closed seas in bathymetry based on closea_mask field,'
-            CALL iom_get ( inum, jpdom_data, 'closea_mask', zdata_in )
-            closea_mask(:,:) = NINT(zdata_in(:,:))
-            WHERE( closea_mask(:,:) > 0 )
-               k_top(:,:) = 0   
-               k_bot(:,:) = 0   
-            ENDWHERE
-         ELSE
-            IF( lwp ) WRITE(numout,*) 'No closea_mask field found in domain_cfg file. No suppression of closed seas.'
-         ENDIF
-         !
-         CALL iom_close(inum)
-         !
-      ELSE
-         IF( lwp ) WRITE(numout,*) 'No domain_cfg file => no suppression of closed seas.'
-      ENDIF
-      !
-      ! Initialise l_sbc_clo and l_clo_rnf for this case (ln_closea=.false.)
-      l_sbc_clo = .false.
-      l_clo_rnf = .false.
-      !
-   END SUBROUTINE clo_bat
-
-   !!======================================================================
+      !!
+      k_top(:,:) = k_top(:,:) * k_mask(:,:)
+      k_bot(:,:) = k_bot(:,:) * k_mask(:,:)
+      !!
+   END SUBROUTINE clo_msk
+
+   SUBROUTINE read_csmask(cd_file, cd_var, k_mskout)
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE read_csmask  ***
+      !!                    
+      !! ** Purpose : read mask in cd_filec file
+      !!----------------------------------------------------------------------
+      ! subroutine parameter
+      CHARACTER(LEN=256),          INTENT(in   ) :: cd_file    ! netcdf file     name
+      CHARACTER(LEN= * ),          INTENT(in   ) :: cd_var     ! netcdf variable name
+      INTEGER, DIMENSION(:,:), INTENT(  out) :: k_mskout            ! output mask variable
+      !
+      ! local variables
+      INTEGER :: ics                       ! netcdf id
+      REAL(wp), DIMENSION(jpi,jpj) :: zdta ! netcdf data
+      !!----------------------------------------------------------------------
+      !
+      CALL iom_open ( cd_file, ics )
+      CALL iom_get  ( ics, jpdom_data, TRIM(cd_var), zdta )
+      CALL iom_close( ics )
+      k_mskout(:,:) = NINT(zdta(:,:))
+      !
+   END SUBROUTINE read_csmask
+
+   SUBROUTINE alloc_csmask( kmask )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE alloc_csmask  ***
+      !!                    
+      !! ** Purpose : allocated cs mask
+      !!----------------------------------------------------------------------
+      ! subroutine parameter
+      INTEGER, ALLOCATABLE, DIMENSION(:,:), INTENT(inout) :: kmask
+      !
+      ! local variables
+      INTEGER :: ierr
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( kmask(jpi,jpj) , STAT=ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'alloc_csmask: failed to allocate surf array')
+      !
+   END SUBROUTINE
+
 END MODULE closea
-
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/daymod.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/daymod.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/daymod.F90	(revision 12928)
@@ -20,5 +20,5 @@
    !!                    -------------------------------
    !!   sbcmod assume that the time step is dividing the number of second of 
-   !!   in a day, i.e. ===> MOD( rday, rdt ) == 0 
+   !!   in a day, i.e. ===> MOD( rday, rn_Dt ) == 0 
    !!   except when user defined forcing is used (see sbcmod.F90)
    !!----------------------------------------------------------------------
@@ -58,26 +58,27 @@
       !!
       !! ** 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
-      !!              - nsec_year    : current time step counted in second since 00h jan 1st of the current year
-      !!              - nsec_month   : current time step counted in second since 00h 1st day of the current month
-      !!              - nsec_day     : current time step counted in second since 00h of the current day
-      !!              - nsec1jan000  : second since Jan. 1st 00h of nit000 year and Jan. 1st 00h of the current year
-      !!              - nmonth_len, nyear_len, nmonth_half, nmonth_end through day_mth
-      !!----------------------------------------------------------------------
-      INTEGER  ::   inbday, idweek   ! local integers
+      !!              - nmonth       : current month of the current nyear
+      !!              - nday         : current   day of the current nmonth
+      !!              - nday_year    : current   day of the current nyear
+      !!              - nsec_year    : seconds between 00h jan 1st of the current  year and half of the current time step
+      !!              - nsec_month   : seconds between 00h 1st day of the current month and half of the current time step
+      !!              - nsec_monday  : seconds between 00h         of the   last Monday and half of the current time step
+      !!              - nsec_day     : seconds between 00h         of the current   day and half of the current time step
+      !!              - nsec1jan000  : seconds between Jan. 1st 00h of nit000 year and Jan. 1st 00h of the current year
+      !!              - nmonth_len, nyear_len, nmonth_beg through day_mth
+      !!----------------------------------------------------------------------
+      INTEGER  ::   inbday, imonday, isecrst   ! local integers
       REAL(wp) ::   zjul             ! local scalar
       !!----------------------------------------------------------------------
       !
       ! max number of seconds between each restart
-      IF( REAL( nitend - nit000 + 1 ) * rdt > REAL( HUGE( nsec1jan000 ) ) ) THEN
+      IF( REAL( nitend - nit000 + 1 ) * rn_Dt > REAL( HUGE( nsec1jan000 ) ) ) THEN
          CALL ctl_stop( 'The number of seconds between each restart exceeds the integer 4 max value: 2^31-1. ',   &
             &           'You must do a restart at higher frequency (or remove this stop and recompile the code in I8)' )
       ENDIF
-      nsecd   = NINT( rday       )
+      nsecd   = NINT(       rday )
       nsecd05 = NINT( 0.5 * rday )
-      ndt     = NINT(       rdt  )
-      ndt05   = NINT( 0.5 * rdt  )
+      ndt     = NINT(       rn_Dt  )
+      ndt05   = NINT( 0.5 * rn_Dt  )
 
       IF( .NOT. l_offline )   CALL day_rst( nit000, 'READ' )
@@ -90,8 +91,9 @@
       nhour   =   nn_time0 / 100
       nminute = ( nn_time0 - nhour * 100 )
-
-      CALL ymds2ju( nyear, nmonth, nday, nhour*3600._wp+nminute*60._wp, fjulday )  
+      isecrst = ( nhour * NINT(rhhmm) + nminute ) * NINT(rmmss)
+
+      CALL ymds2ju( nyear, nmonth, nday, REAL(isecrst,wp), fjulday )  
       IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < 0.1 / rday )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error
-      IF( nn_time0*3600 - ndt05 .lt. 0 ) fjulday = fjulday + 1.                    ! move back to the day at nit000 (and not at nit000 - 1)
+      IF( nhour*NINT(rhhmm*rmmss) + nminute*NINT(rmmss) - ndt05 .LT. 0 ) fjulday = fjulday+1.       ! move back to the day at nit000 (and not at nit000 - 1)
 
       nsec1jan000 = 0
@@ -112,31 +114,34 @@
       nday_year = nday + SUM( nmonth_len(1:nmonth - 1) )
 
-      !compute number of days between last monday and today
-      CALL ymds2ju( 1900, 01, 01, 0.0, zjul )  ! compute julian day value of 01.01.1900 (our reference that was a Monday)
-      inbday = FLOOR(fjulday - zjul)            ! compute nb day between  01.01.1900 and start of current day
-      idweek = MOD(inbday, 7)                  ! compute nb day between last monday and current day
-      IF (idweek .lt. 0) idweek=idweek+7       ! Avoid negative values for dates before 01.01.1900
+      !compute number of days between last Monday and today
+      CALL ymds2ju( 1900, 01, 01, 0.0, zjul )     ! compute julian day value of 01.01.1900 (our reference that was a Monday)
+      inbday = FLOOR(fjulday - zjul)              ! compute nb day between  01.01.1900 and start of current day
+      imonday = MOD(inbday, 7)                    ! compute nb day between last monday and current day
+      IF (imonday .LT. 0) imonday = imonday + 7   ! Avoid negative values for dates before 01.01.1900
 
       ! number of seconds since the beginning of current year/month/week/day at the middle of the time-step
-      IF (nhour*3600+nminute*60-ndt05 .gt. 0) THEN
+      IF( isecrst - ndt05 .GT. 0 ) THEN
          ! 1 timestep before current middle of first time step is still the same day
-         nsec_year  = (nday_year-1) * nsecd + nhour*3600+nminute*60 - ndt05 
-         nsec_month = (nday-1)      * nsecd + nhour*3600+nminute*60 - ndt05    
+         nsec_year  = (nday_year-1) * nsecd + isecrst - ndt05 
+         nsec_month = (nday-1)      * nsecd + isecrst - ndt05    
       ELSE
          ! 1 time step before the middle of the first time step is the previous day 
-         nsec_year  = nday_year * nsecd + nhour*3600+nminute*60 - ndt05 
-         nsec_month = nday      * nsecd + nhour*3600+nminute*60 - ndt05   
-      ENDIF
-      nsec_week  = idweek    * nsecd + nhour*3600+nminute*60 - ndt05
-      nsec_day   =             nhour*3600+nminute*60 - ndt05 
-      IF( nsec_day .lt. 0 ) nsec_day = nsec_day + nsecd
-      IF( nsec_week .lt. 0 ) nsec_week = nsec_week + nsecd*7
+         nsec_year  = nday_year     * nsecd + isecrst - ndt05 
+         nsec_month = nday          * nsecd + isecrst - ndt05   
+      ENDIF
+      nsec_monday   = imonday       * nsecd + isecrst - ndt05
+      nsec_day      =                         isecrst - ndt05 
+      IF( nsec_day    .LT. 0 ) nsec_day    = nsec_day    + nsecd
+      IF( nsec_monday .LT. 0 ) nsec_monday = nsec_monday + nsecd*7
 
       ! control print
       IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i8,a,i8,a,i8,a,i8)')   &
            &                   ' =======>> 1/2 time step before the start of the run DATE Y/M/D = ',   &
-           &                   nyear, '/', nmonth, '/', nday, '  nsec_day:', nsec_day, '  nsec_week:', nsec_week, '  &
+           &                   nyear, '/', nmonth, '/', nday, '  nsec_day:', nsec_day, '  nsec_monday:', nsec_monday, '  &
            &                   nsec_month:', nsec_month , '  nsec_year:' , nsec_year
 
+      nsec000_1jan000 = nsec1jan000 + nsec_year + ndt05
+      nsecend_1jan000 = nsec000_1jan000 + ndt * ( nitend - nit000 + 1 )
+      
       ! Up to now, calendar parameters are related to the end of previous run (nit000-1)
       ! call day to set the calendar parameters at the begining of the current simulaton. needed by iom_init
@@ -160,27 +165,27 @@
       !! ** Purpose :   calendar values related to the months
       !!
-      !! ** Action  : - nmonth_len    : length in days of the months of the current year
-      !!              - nyear_len     : length in days of the previous/current year
-      !!              - nmonth_half   : second since the beginning of the year and the halft of the months
-      !!              - nmonth_end    : second since the beginning of the year and the end of the months
-      !!----------------------------------------------------------------------
-      INTEGER  ::   jm               ! dummy loop indice
+      !! ** Action  : - nyear_len     : length in days of the previous/current year
+      !!              - nmonth_len    : length in days of the months of the current year
+      !!              - nmonth_half   : second since the beginning of the current year and the halft of the months
+      !!              - nmonth_end    : second since the beginning of the current year and the end of the months
+      !!----------------------------------------------------------------------
+      INTEGER  ::   jm ,jy                   ! dummy loop indice
+      INTEGER, DIMENSION(12) ::   idaymt     ! length in days of the 12 months for non-leap year
       !!----------------------------------------------------------------------
 
       ! length of the month of the current year (from nleapy, read in namelist)
       IF ( nleapy < 2 ) THEN
-         nmonth_len(:) = (/ 31, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31, 31 /)
+         ! default values
+         idaymt(1:12) = (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /)
+         nmonth_len(-11: 25) = (/ idaymt(1:12), idaymt(1:12), idaymt(1:12), idaymt(1) /)
          nyear_len(:) = 365
+         !
          IF ( nleapy == 1 ) THEN   ! we are using calandar with leap years
-            IF ( MOD(nyear-1, 4) == 0 .AND. ( MOD(nyear-1, 400) == 0 .OR. MOD(nyear-1, 100) /= 0 ) ) THEN
-               nyear_len(0)  = 366
-            ENDIF
-            IF ( MOD(nyear  , 4) == 0 .AND. ( MOD(nyear  , 400) == 0 .OR. MOD(nyear  , 100) /= 0 ) ) THEN
-               nmonth_len(2) = 29
-               nyear_len(1)  = 366
-            ENDIF
-            IF ( MOD(nyear+1, 4) == 0 .AND. ( MOD(nyear+1, 400) == 0 .OR. MOD(nyear+1, 100) /= 0 ) ) THEN
-               nyear_len(2)  = 366
-            ENDIF
+            DO jy = -1,1
+               IF ( MOD(nyear+jy, 4) == 0 .AND. ( MOD(nyear+jy, 400) == 0 .OR. MOD(nyear+jy, 100) /= 0 ) ) THEN
+                  nmonth_len(2 + 12*jy) = 29
+                  nyear_len( 1 +    jy) = 366
+               ENDIF
+            ENDDO
          ENDIF
       ELSE
@@ -189,19 +194,14 @@
       ENDIF
 
-      ! half month in second since the begining of the year:
       ! time since Jan 1st   0     1     2    ...    11    12    13
       !          ---------*--|--*--|--*--| ... |--*--|--*--|--*--|--------------------------------------
       !                 <---> <---> <--->  ...  <---> <---> <--->
       ! month number      0     1     2    ...    11    12    13
-      !
-      ! nmonth_half(jm) = rday * REAL( 0.5 * nmonth_len(jm) + SUM(nmonth_len(1:jm-1)) )
-      nmonth_half(0) = - nsecd05 * nmonth_len(0)
-      DO jm = 1, 13
-         nmonth_half(jm) = nmonth_half(jm-1) + nsecd05 * ( nmonth_len(jm-1) + nmonth_len(jm) )
+      nmonth_beg(1) = 0
+      DO jm = 2, 25
+         nmonth_beg(jm) = nmonth_beg(jm-1) + nsecd * nmonth_len(jm-1)
       END DO
-
-      nmonth_end(0) = 0
-      DO jm = 1, 13
-         nmonth_end(jm) = nmonth_end(jm-1) + nsecd * nmonth_len(jm)
+      DO jm = 0,-11,-1
+         nmonth_beg(jm) = nmonth_beg(jm+1) - nsecd * nmonth_len(jm)
       END DO
       !
@@ -235,10 +235,10 @@
       zprec = 0.1 / rday
       !                                                 ! New time-step
-      nsec_year  = nsec_year  + ndt
-      nsec_month = nsec_month + ndt
-      nsec_week  = nsec_week  + ndt
+      nsec_year    = nsec_year    + ndt
+      nsec_month   = nsec_month   + ndt
+      nsec_monday  = nsec_monday  + ndt
       nsec_day   = nsec_day   + ndt
-      adatrj  = adatrj  + rdt / rday
-      fjulday = fjulday + rdt / rday
+      adatrj  = adatrj  + rn_Dt / rday
+      fjulday = fjulday + rn_Dt / rday
       IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < zprec )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error
       IF( ABS(adatrj  - REAL(NINT(adatrj ),wp)) < zprec )   adatrj  = REAL(NINT(adatrj ),wp)   ! avoid truncation error
@@ -272,10 +272,10 @@
               &   '      New day, DATE Y/M/D = ', nyear, '/', nmonth, '/', nday, '      nday_year = ', nday_year
          IF(lwp) WRITE(numout,'(a,i8,a,i7,a,i5)') '         nsec_year = ', nsec_year,   &
-              &   '   nsec_month = ', nsec_month, '   nsec_day = ', nsec_day, '   nsec_week = ', nsec_week
-      ENDIF
-
-      IF( nsec_week > 7*nsecd )   nsec_week = ndt05     ! New week
-
-      IF(ln_ctl) THEN
+              &   '   nsec_month = ', nsec_month, '   nsec_day = ', nsec_day, '   nsec_monday = ', nsec_monday
+      ENDIF
+
+      IF( nsec_monday > 7*nsecd )   nsec_monday = ndt05     ! New week
+
+      IF(sn_cfctl%l_prtctl) THEN
          WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear
          CALL prt_ctl_info(charout)
@@ -309,5 +309,5 @@
       !!       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.
+      !!       is not stored in the restart and is assumed to be (nit000-1)*rn_Dt.
       !!       This is valid is the time step has remained constant.
       !!
@@ -319,5 +319,5 @@
       !
       REAL(wp) ::   zkt, zndastp, zdayfrac, ksecs, ktime
-      INTEGER  ::   ihour, iminute
+      INTEGER  ::   ihour, iminute, isecond
       !!----------------------------------------------------------------------
 
@@ -349,27 +349,27 @@
                CALL iom_get( numror, 'adatrj', adatrj , ldxios = lrxios )
 	       CALL iom_get( numror, 'ntime' , ktime  , ldxios = lrxios )
-	       nn_time0=INT(ktime)
+               nn_time0 = NINT(ktime)
                ! calculate start time in hours and minutes
-	       zdayfrac=adatrj-INT(adatrj)
-	       ksecs = NINT(zdayfrac*86400)	       ! Nearest second to catch rounding errors in adatrj	       
-	       ihour = INT(ksecs/3600)
-	       iminute = ksecs/60-ihour*60
+               zdayfrac = adatrj - REAL(INT(adatrj), wp)
+	       ksecs = NINT(zdayfrac * rday)	       ! Nearest second to catch rounding errors in adatrj	       
+               ihour = ksecs / NINT( rhhmm*rmmss )
+	       iminute = ksecs / NINT(rmmss) - ihour*NINT(rhhmm)
  	        
                ! Add to nn_time0
                nhour   =   nn_time0 / 100
                nminute = ( nn_time0 - nhour * 100 )
-	       nminute=nminute+iminute
+	       nminute = nminute + iminute
 	       
-	       IF( nminute >= 60 ) THEN
-	          nminute=nminute-60
-		  nhour=nhour+1
+               IF( nminute >= NINT(rhhmm) ) THEN
+	          nminute = nminute - NINT(rhhmm)
+		  nhour = nhour+1
 	       ENDIF
 	       nhour=nhour+ihour
-	       IF( nhour >= 24 ) THEN
-		  nhour=nhour-24
-	          adatrj=adatrj+1
+	       IF( nhour >= NINT(rjjhh) ) THEN
+		  nhour = nhour - NINT(rjjhh)
+	          adatrj = adatrj + 1.
 	       ENDIF	       
 	       nn_time0 = nhour * 100 + nminute
-	       adatrj = INT(adatrj)                    ! adatrj set to integer as nn_time0 updated	       
+               adatrj = REAL(INT(adatrj), wp)                    ! adatrj set to integer as nn_time0 updated	       
             ELSE
                ! parameters corresponding to nit000 - 1 (as we start the step loop with a call to day)
@@ -377,6 +377,7 @@
                nhour   =   nn_time0 / 100
                nminute = ( nn_time0 - nhour * 100 )
-               IF( nhour*3600+nminute*60-ndt05 .lt. 0 )  ndastp=ndastp-1      ! Start hour is specified in the namelist (default 0)
-               adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday
+               isecond = ( nhour * NINT(rhhmm) + nminute ) * NINT(rmmss)
+               IF( isecond - ndt05 .lt. 0 )   ndastp = ndastp - 1      ! Start hour is specified in the namelist (default 0)
+               adatrj = ( REAL( nit000-1, wp ) * rn_Dt ) / rday
                ! note this is wrong if time step has changed during run
             ENDIF
@@ -386,6 +387,7 @@
             nhour   =   nn_time0 / 100
 	    nminute = ( nn_time0 - nhour * 100 )
-            IF( nhour*3600+nminute*60-ndt05 .lt. 0 )  ndastp=ndastp-1      ! Start hour is specified in the namelist (default 0)
-            adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday
+            isecond = ( nhour * NINT(rhhmm) + nminute ) * NINT(rmmss)
+            IF( isecond - ndt05 .LT. 0 )   ndastp = ndastp - 1         ! Start hour is specified in the namelist (default 0)
+            adatrj = ( REAL( nit000-1, wp ) * rn_Dt ) / rday
          ENDIF
          IF( ABS(adatrj  - REAL(NINT(adatrj),wp)) < 0.1 / rday )   adatrj = REAL(NINT(adatrj),wp)   ! avoid truncation error
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/depth_e3.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/depth_e3.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/depth_e3.F90	(revision 12928)
@@ -36,6 +36,4 @@
    PUBLIC   e3_to_depth        ! called by domzgr.F90
       
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/dom_oce.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/dom_oce.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/dom_oce.F90	(revision 12928)
@@ -12,4 +12,5 @@
    !!            3.7  ! 2015-11  (G. Madec) introduce surface and scale factor ratio
    !!             -   ! 2015-11  (G. Madec, A. Coward)  time varying zgr by default
+   !!            4.1  ! 2019-08  (A. Coward, D. Storkey) rename prognostic variables in preparation for new time scheme.
    !!----------------------------------------------------------------------
 
@@ -32,9 +33,7 @@
    LOGICAL , PUBLIC ::   ln_linssh      !: =T  linear free surface ==>> model level are fixed in time
    LOGICAL , PUBLIC ::   ln_meshmask    !: =T  create a mesh-mask file (mesh_mask.nc)
-   REAL(wp), PUBLIC ::   rn_isfhmin     !: threshold to discriminate grounded ice to floating ice
-   REAL(wp), PUBLIC ::   rn_rdt         !: time step for the dynamics and tracer
+   REAL(wp), PUBLIC ::   rn_Dt          !: time step for the dynamics and tracer
    REAL(wp), PUBLIC ::   rn_atfp        !: asselin time filter parameter
-   INTEGER , PUBLIC ::   nn_euler       !: =0 start with forward time step or not (=1)
-   LOGICAL , PUBLIC ::   ln_iscpl       !: coupling with ice sheet
+   LOGICAL , PUBLIC ::   ln_1st_euler   !: =T start with forward time step or not (=F)
    LOGICAL , PUBLIC ::   ln_crs         !: Apply grid coarsening to dynamical model output or online passive tracers
 
@@ -50,16 +49,15 @@
    LOGICAL,  PUBLIC :: ln_bt_auto       !: Set number of barotropic iterations automatically
    INTEGER,  PUBLIC :: nn_bt_flt        !: Filter choice
-   INTEGER,  PUBLIC :: nn_baro          !: Number of barotropic iterations during one baroclinic step (rdt)
+   INTEGER,  PUBLIC :: nn_e          !: Number of barotropic iterations during one baroclinic step (rn_Dt)
    REAL(wp), PUBLIC :: rn_bt_cmax       !: Maximum allowed courant number (used if ln_bt_auto=T)
    REAL(wp), PUBLIC :: rn_bt_alpha      !: Time stepping diffusion parameter
 
 
-   !                                   !! old non-DOCTOR names still used in the model
-   REAL(wp), PUBLIC ::   atfp           !: asselin time filter parameter
-   REAL(wp), PUBLIC ::   rdt            !: time step for the dynamics and tracer
-
    !                                   !!! associated variables
-   INTEGER , PUBLIC ::   neuler         !: restart euler forward option (0=Euler)
-   REAL(wp), PUBLIC ::   r2dt           !: = 2*rdt except at nit000 (=rdt) if neuler=0
+   LOGICAL , PUBLIC ::   l_1st_euler    !: Euler 1st time-step flag (=T if ln_restart=F or ln_1st_euler=T)
+   REAL(wp), PUBLIC ::   rDt, r1_Dt     !: Current model timestep and reciprocal
+                                        !: rDt = 2 * rn_Dt if leapfrog and l_1st_euler = F
+                                        !:     =     rn_Dt if leapfrog and l_1st_euler = T
+                                        !:     =     rn_Dt if RK3
 
    !!----------------------------------------------------------------------
@@ -121,5 +119,5 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2f , r1_e1e2f                !: associated metrics at f-point
    !
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   ff_f  , ff_t                    !: Coriolis factor at f- & t-points  [1/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ff_f  , ff_t                    !: Coriolis factor at f- & t-points  [1/s]
    !!----------------------------------------------------------------------
    !! vertical coordinate and scale factors
@@ -129,24 +127,31 @@
    LOGICAL, PUBLIC ::   ln_sco       !: s-coordinate or hybrid z-s coordinate
    LOGICAL, PUBLIC ::   ln_isfcav    !: presence of ISF 
-   !                                                        !  ref.   ! before  !   now   ! after  !
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3t_0 ,   e3t_b ,   e3t_n ,  e3t_a   !: t- vert. scale factor [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3u_0 ,   e3u_b ,   e3u_n ,  e3u_a   !: u- vert. scale factor [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3v_0 ,   e3v_b ,   e3v_n ,  e3v_a   !: v- vert. scale factor [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3f_0           ,   e3f_n            !: f- vert. scale factor [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3w_0 ,   e3w_b ,   e3w_n            !: w- vert. scale factor [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3uw_0 ,  e3uw_b ,  e3uw_n            !: uw-vert. scale factor [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3vw_0 ,  e3vw_b ,  e3vw_n            !: vw-vert. scale factor [m]
-
-   !                                                        !  ref.   ! before  !   now   !
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdept_0 , gdept_b , gdept_n   !: t- depth              [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdepw_0 , gdepw_b , gdepw_n   !: w- depth              [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gde3w_0           , gde3w_n   !: w- depth (sum of e3w) [m]
+   !                                                        !  reference scale factors
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3t_0   !: t- vert. scale factor [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3u_0   !: u- vert. scale factor [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3v_0   !: v- vert. scale factor [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3f_0   !: f- vert. scale factor [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3w_0   !: w- vert. scale factor [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3uw_0   !: uw-vert. scale factor [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3vw_0   !: vw-vert. scale factor [m]
+   !                                                        !  time-dependent scale factors
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e3t, e3u, e3v, e3w, e3uw, e3vw  !: vert. scale factor [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   e3f                             !: F-point vert. scale factor [m]
+
+   !                                                        !  reference depths of cells
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdept_0  !: t- depth              [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdepw_0  !: w- depth              [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gde3w_0  !: w- depth (sum of e3w) [m]
+   !                                                        !  time-dependent depths of cells
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  gdept, gdepw  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  gde3w  
    
-   !                                                      !  ref. ! before  !   now   !  after  !
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ht_0            ,    ht_n             !: t-depth              [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hu_0  ,    hu_b ,    hu_n ,    hu_a   !: u-depth              [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hv_0  ,    hv_b ,    hv_n ,    hv_a   !: v-depth              [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::           r1_hu_b , r1_hu_n , r1_hu_a   !: inverse of u-depth [1/m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::           r1_hv_b , r1_hv_n , r1_hv_a   !: inverse of v-depth [1/m]
+   !                                                      !  reference heights of water column
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ht_0  !: t-depth              [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hu_0  !: u-depth              [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hv_0  !: v-depth              [m]
+                                                          ! time-dependent heights of water column
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ht                     !: height of water column at T-points [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hu, hv, r1_hu, r1_hv   !: height of water column [m] and reciprocal [1/m]
 
    INTEGER, PUBLIC ::   nla10              !: deepest    W level Above  ~10m (nlb10 - 1)
@@ -158,4 +163,5 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   e3t_1d  , e3w_1d   !: reference vertical scale factors at T- and W-pts (m)
 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   risfdep, bathy
 
    !!----------------------------------------------------------------------
@@ -170,7 +176,5 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmask_h            !: internal domain T-point mask (Figure 8.5 NEMO book)
 
-   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   misfdep                 !: top first ocean level             (ISF)
-   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mikt, miku, mikv, mikf  !: top first wet T-, U-, V-, F-level (ISF)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   risfdep                 !: Iceshelf draft                    (ISF)
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mikt, miku, mikv, mikf  !: top first wet T-, U-, V-, F-level           (ISF)
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssmask, ssumask, ssvmask             !: surface mask at T-,U-, V- and F-pts
@@ -190,17 +194,18 @@
    INTEGER , PUBLIC ::   ndastp        !: time step date in yyyymmdd format
    INTEGER , PUBLIC ::   nday_year     !: current day counted from jan 1st of the current year
-   INTEGER , PUBLIC ::   nsec_year     !: current time step counted in second since 00h jan 1st of the current year
-   INTEGER , PUBLIC ::   nsec_month    !: current time step counted in second since 00h 1st day of the current month
-   INTEGER , PUBLIC ::   nsec_week     !: current time step counted in second since 00h of last monday
-   INTEGER , PUBLIC ::   nsec_day      !: current time step counted in second since 00h of the current day
+   INTEGER , PUBLIC ::   nsec_year     !: seconds between 00h jan 1st of the current  year and half of the current time step
+   INTEGER , PUBLIC ::   nsec_month    !: seconds between 00h 1st day of the current month and half of the current time step
+   INTEGER , PUBLIC ::   nsec_monday   !: seconds between 00h         of the last Monday   and half of the current time step
+   INTEGER , PUBLIC ::   nsec_day      !: seconds between 00h         of the current   day and half of the current time step
    REAL(wp), PUBLIC ::   fjulday       !: current julian day 
    REAL(wp), PUBLIC ::   fjulstartyear !: first day of the current year in julian days
    REAL(wp), PUBLIC ::   adatrj        !: number of elapsed days since the begining of the whole simulation
    !                                   !: (cumulative duration of previous runs that may have used different time-step size)
-   INTEGER , PUBLIC, DIMENSION(0: 2) ::   nyear_len     !: length in days of the previous/current/next year
-   INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_len    !: length in days of the months of the current year
-   INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_half   !: second since Jan 1st 0h of the current year and the half of the months
-   INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_end    !: second since Jan 1st 0h of the current year and the end of the months
-   INTEGER , PUBLIC                  ::   nsec1jan000   !: second since Jan 1st 0h of nit000 year and Jan 1st 0h the current year
+   INTEGER , PUBLIC, DIMENSION(  0: 2) ::   nyear_len     !: length in days of the previous/current/next year
+   INTEGER , PUBLIC, DIMENSION(-11:25) ::   nmonth_len    !: length in days of the months of the current year
+   INTEGER , PUBLIC, DIMENSION(-11:25) ::   nmonth_beg    !: second since Jan 1st 0h of the current year and the half of the months
+   INTEGER , PUBLIC                  ::   nsec1jan000     !: second since Jan 1st 0h of nit000 year and Jan 1st 0h the current year
+   INTEGER , PUBLIC                  ::   nsec000_1jan000   !: second since Jan 1st 0h of nit000 year and nit000
+   INTEGER , PUBLIC                  ::   nsecend_1jan000   !: second since Jan 1st 0h of nit000 year and nitend
 
    !!----------------------------------------------------------------------
@@ -256,24 +261,19 @@
          &      ff_f (jpi,jpj) ,    ff_t (jpi,jpj)                                     , STAT=ierr(3) )
          !
-      ALLOCATE( gdept_0(jpi,jpj,jpk) , gdepw_0(jpi,jpj,jpk) , gde3w_0(jpi,jpj,jpk) ,      &
-         &      gdept_b(jpi,jpj,jpk) , gdepw_b(jpi,jpj,jpk) ,                             &
-         &      gdept_n(jpi,jpj,jpk) , gdepw_n(jpi,jpj,jpk) , gde3w_n(jpi,jpj,jpk) , STAT=ierr(4) )
-         !
-      ALLOCATE( e3t_0(jpi,jpj,jpk) , e3u_0(jpi,jpj,jpk) , e3v_0(jpi,jpj,jpk) , e3f_0(jpi,jpj,jpk) , e3w_0(jpi,jpj,jpk) ,   &
-         &      e3t_b(jpi,jpj,jpk) , e3u_b(jpi,jpj,jpk) , e3v_b(jpi,jpj,jpk) ,                      e3w_b(jpi,jpj,jpk) ,   & 
-         &      e3t_n(jpi,jpj,jpk) , e3u_n(jpi,jpj,jpk) , e3v_n(jpi,jpj,jpk) , e3f_n(jpi,jpj,jpk) , e3w_n(jpi,jpj,jpk) ,   & 
-         &      e3t_a(jpi,jpj,jpk) , e3u_a(jpi,jpj,jpk) , e3v_a(jpi,jpj,jpk) ,                                             &
-         !                                                          !
-         &      e3uw_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) ,         &
-         &      e3uw_b(jpi,jpj,jpk) , e3vw_b(jpi,jpj,jpk) ,         &               
-         &      e3uw_n(jpi,jpj,jpk) , e3vw_n(jpi,jpj,jpk) ,     STAT=ierr(5) )                       
-         !
-      ALLOCATE( ht_0(jpi,jpj) , hu_0(jpi,jpj) , hv_0(jpi,jpj) ,                                           &
-         &                      hu_b(jpi,jpj) , hv_b(jpi,jpj) , r1_hu_b(jpi,jpj) , r1_hv_b(jpi,jpj) ,     &
-         &      ht_n(jpi,jpj) , hu_n(jpi,jpj) , hv_n(jpi,jpj) , r1_hu_n(jpi,jpj) , r1_hv_n(jpi,jpj) ,     &
-         &                      hu_a(jpi,jpj) , hv_a(jpi,jpj) , r1_hu_a(jpi,jpj) , r1_hv_a(jpi,jpj) , STAT=ierr(6)  )
-         !
-         !
-      ALLOCATE( gdept_1d(jpk) , gdepw_1d(jpk) , e3t_1d(jpk) , e3w_1d(jpk) , STAT=ierr(7) )
+      ALLOCATE( gdept_0(jpi,jpj,jpk)     , gdepw_0(jpi,jpj,jpk)     , gde3w_0(jpi,jpj,jpk) ,      &
+         &      gdept  (jpi,jpj,jpk,jpt) , gdepw  (jpi,jpj,jpk,jpt) , gde3w  (jpi,jpj,jpk) , STAT=ierr(4) )
+         !
+      ALLOCATE( e3t_0(jpi,jpj,jpk)     , e3u_0(jpi,jpj,jpk)     , e3v_0(jpi,jpj,jpk)     , e3f_0(jpi,jpj,jpk) , e3w_0(jpi,jpj,jpk)     ,   &
+         &      e3t  (jpi,jpj,jpk,jpt) , e3u  (jpi,jpj,jpk,jpt) , e3v  (jpi,jpj,jpk,jpt) , e3f  (jpi,jpj,jpk) , e3w  (jpi,jpj,jpk,jpt) ,   & 
+         &      e3uw_0(jpi,jpj,jpk)     , e3vw_0(jpi,jpj,jpk)     ,         &
+         &      e3uw  (jpi,jpj,jpk,jpt) , e3vw  (jpi,jpj,jpk,jpt) ,    STAT=ierr(5) )                       
+         !
+      ALLOCATE( ht_0(jpi,jpj) , hu_0(jpi,jpj)    , hv_0(jpi,jpj)     ,                                             &
+         &      ht  (jpi,jpj) , hu(  jpi,jpj,jpt), hv(  jpi,jpj,jpt) , r1_hu(jpi,jpj,jpt) , r1_hv(jpi,jpj,jpt) ,   &
+         &                      STAT=ierr(6)  )
+         !
+      ALLOCATE( risfdep(jpi,jpj) , bathy(jpi,jpj) , STAT=ierr(7)  ) 
+         !
+      ALLOCATE( gdept_1d(jpk) , gdepw_1d(jpk) , e3t_1d(jpk) , e3w_1d(jpk) , STAT=ierr(8) )
          !
       ALLOCATE( tmask_i(jpi,jpj) , tmask_h(jpi,jpj) ,                        & 
@@ -281,6 +281,5 @@
          &      mbkt   (jpi,jpj) , mbku   (jpi,jpj) , mbkv   (jpi,jpj) , STAT=ierr(9) )
          !
-      ALLOCATE( misfdep(jpi,jpj) , mikt(jpi,jpj) , miku(jpi,jpj) ,     &
-         &      risfdep(jpi,jpj) , mikv(jpi,jpj) , mikf(jpi,jpj) , STAT=ierr(10) )
+      ALLOCATE( mikt(jpi,jpj), miku(jpi,jpj), mikv(jpi,jpj), mikf(jpi,jpj), STAT=ierr(10) )
          !
       ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk) ,     & 
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/domain.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/domain.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/domain.F90	(revision 12928)
@@ -30,5 +30,4 @@
    USE trc_oce        ! shared ocean & passive tracers variab
    USE phycst         ! physical constants
-   USE closea         ! closed seas
    USE domhgr         ! domain: set the horizontal mesh
    USE domzgr         ! domain: set the vertical mesh
@@ -38,5 +37,6 @@
    USE c1d            ! 1D configuration
    USE dyncor_c1d     ! 1D configuration: Coriolis term    (cor_c1d routine)
-   USE wet_dry,  ONLY : ll_wd
+   USE wet_dry, ONLY : ll_wd
+   USE closea , ONLY : dom_clo ! closed seas
    !
    USE in_out_manager ! I/O manager
@@ -58,5 +58,5 @@
 CONTAINS
 
-   SUBROUTINE dom_init(cdstr)
+   SUBROUTINE dom_init( Kbb, Kmm, Kaa, cdstr )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dom_init  ***
@@ -73,8 +73,10 @@
       !!              - 1D configuration, move Coriolis, u and v at T-point
       !!----------------------------------------------------------------------
+      INTEGER          , INTENT(in) :: Kbb, Kmm, Kaa          ! ocean time level indices
+      CHARACTER (len=*), INTENT(in) :: cdstr                  ! model: NEMO or SAS. Determines core restart variables
+      !
       INTEGER ::   ji, jj, jk, ik   ! dummy loop indices
       INTEGER ::   iconf = 0    ! local integers
       CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7))" 
-      CHARACTER (len=*), INTENT(IN) :: cdstr                  ! model: NEMO or SAS. Determines core restart variables
       INTEGER , DIMENSION(jpi,jpj) ::   ik_top , ik_bot       ! top and bottom ocean level
       REAL(wp), DIMENSION(jpi,jpj) ::   z1_hu_0, z1_hv_0
@@ -134,16 +136,11 @@
       ENDIF
       !
-      CALL dom_hgr                     ! Horizontal mesh
-      CALL dom_zgr( ik_top, ik_bot )   ! Vertical mesh and bathymetry
-      CALL dom_msk( ik_top, ik_bot )   ! Masks
-      IF( ln_closea )   CALL dom_clo   ! ln_closea=T : closed seas included in the simulation
-                                       ! Read in masks to define closed seas and lakes 
-      !
-      DO jj = 1, jpj                   ! depth of the iceshelves
-         DO ji = 1, jpi
-            ik = mikt(ji,jj)
-            risfdep(ji,jj) = gdepw_0(ji,jj,ik)
-         END DO
-      END DO
+      CALL dom_hgr                      ! Horizontal mesh
+
+      IF( ln_closea ) CALL dom_clo      ! Read in masks to define closed seas and lakes
+
+      CALL dom_zgr( ik_top, ik_bot )    ! Vertical mesh and bathymetry
+
+      CALL dom_msk( ik_top, ik_bot )    ! Masks
       !
       ht_0(:,:) = 0._wp  ! Reference ocean thickness
@@ -161,15 +158,15 @@
       !
          !       before        !          now          !       after         !
-            gdept_b = gdept_0  ;   gdept_n = gdept_0   !        ---          ! depth of grid-points
-            gdepw_b = gdepw_0  ;   gdepw_n = gdepw_0   !        ---          !
-                                   gde3w_n = gde3w_0   !        ---          !
+            gdept(:,:,:,Kbb) = gdept_0  ;   gdept(:,:,:,Kmm) = gdept_0   ;   gdept(:,:,:,Kaa) = gdept_0   ! depth of grid-points
+            gdepw(:,:,:,Kbb) = gdepw_0  ;   gdepw(:,:,:,Kmm) = gdepw_0   ;   gdepw(:,:,:,Kaa) = gdepw_0   !
+                                   gde3w = gde3w_0   !        ---          !
          !                                                                  
-              e3t_b =   e3t_0  ;     e3t_n =   e3t_0   ;   e3t_a =  e3t_0    ! scale factors
-              e3u_b =   e3u_0  ;     e3u_n =   e3u_0   ;   e3u_a =  e3u_0    !
-              e3v_b =   e3v_0  ;     e3v_n =   e3v_0   ;   e3v_a =  e3v_0    !
-                                     e3f_n =   e3f_0   !        ---          !
-              e3w_b =   e3w_0  ;     e3w_n =   e3w_0   !        ---          !
-             e3uw_b =  e3uw_0  ;    e3uw_n =  e3uw_0   !        ---          !
-             e3vw_b =  e3vw_0  ;    e3vw_n =  e3vw_0   !        ---          !
+              e3t(:,:,:,Kbb) =   e3t_0  ;     e3t(:,:,:,Kmm) =   e3t_0   ;   e3t(:,:,:,Kaa) =  e3t_0    ! scale factors
+              e3u(:,:,:,Kbb) =   e3u_0  ;     e3u(:,:,:,Kmm) =   e3u_0   ;   e3u(:,:,:,Kaa) =  e3u_0    !
+              e3v(:,:,:,Kbb) =   e3v_0  ;     e3v(:,:,:,Kmm) =   e3v_0   ;   e3v(:,:,:,Kaa) =  e3v_0    !
+                                     e3f =   e3f_0   !        ---          !
+              e3w(:,:,:,Kbb) =   e3w_0  ;     e3w(:,:,:,Kmm) =   e3w_0   ;    e3w(:,:,:,Kaa) =   e3w_0   ! 
+             e3uw(:,:,:,Kbb) =  e3uw_0  ;    e3uw(:,:,:,Kmm) =  e3uw_0   ;   e3uw(:,:,:,Kaa) =  e3uw_0   !  
+             e3vw(:,:,:,Kbb) =  e3vw_0  ;    e3vw(:,:,:,Kmm) =  e3vw_0   ;   e3vw(:,:,:,Kaa) =  e3vw_0   !
          !
          z1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) )     ! _i mask due to ISF
@@ -177,14 +174,14 @@
          !
          !        before       !          now          !       after         !
-                                      ht_n =    ht_0   !                     ! water column thickness
-               hu_b =    hu_0  ;      hu_n =    hu_0   ;    hu_a =    hu_0   ! 
-               hv_b =    hv_0  ;      hv_n =    hv_0   ;    hv_a =    hv_0   !
-            r1_hu_b = z1_hu_0  ;   r1_hu_n = z1_hu_0   ; r1_hu_a = z1_hu_0   ! inverse of water column thickness
-            r1_hv_b = z1_hv_0  ;   r1_hv_n = z1_hv_0   ; r1_hv_a = z1_hv_0   !
+                                      ht =    ht_0   !                     ! water column thickness
+               hu(:,:,Kbb) =    hu_0  ;      hu(:,:,Kmm) =    hu_0   ;    hu(:,:,Kaa) =    hu_0   ! 
+               hv(:,:,Kbb) =    hv_0  ;      hv(:,:,Kmm) =    hv_0   ;    hv(:,:,Kaa) =    hv_0   !
+            r1_hu(:,:,Kbb) = z1_hu_0  ;   r1_hu(:,:,Kmm) = z1_hu_0   ; r1_hu(:,:,Kaa) = z1_hu_0   ! inverse of water column thickness
+            r1_hv(:,:,Kbb) = z1_hv_0  ;   r1_hv(:,:,Kmm) = z1_hv_0   ; r1_hv(:,:,Kaa) = z1_hv_0   !
          !
          !
       ELSE                       != time varying : initialize before/now/after variables
          !
-         IF( .NOT.l_offline )  CALL dom_vvl_init 
+         IF( .NOT.l_offline )  CALL dom_vvl_init( Kbb, Kmm, Kaa )
          !
       ENDIF
@@ -192,9 +189,8 @@
       IF( lk_c1d         )   CALL cor_c1d       ! 1D configuration: Coriolis set at T-point
       !
-      IF( ln_meshmask .AND. .NOT.ln_iscpl )                        CALL dom_wri     ! Create a domain file
-      IF( ln_meshmask .AND.      ln_iscpl .AND. .NOT.ln_rstart )   CALL dom_wri     ! Create a domain file
-      IF(                                       .NOT.ln_rstart )   CALL dom_ctl     ! Domain control
-      !
-      IF( ln_write_cfg )   CALL cfg_write         ! create the configuration file
+      IF( ln_meshmask    )   CALL dom_wri       ! Create a domain file
+      IF( .NOT.ln_rstart )   CALL dom_ctl       ! Domain control
+      !
+      IF( ln_write_cfg   )   CALL cfg_write     ! create the configuration file
       !
       IF(lwp) THEN
@@ -291,7 +287,7 @@
          &             nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,     &
          &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  , nn_istate ,     &
-         &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, nn_euler  ,     &
-         &             ln_cfmeta, ln_iscpl, ln_xios_read, nn_wxios
-      NAMELIST/namdom/ ln_linssh, rn_isfhmin, rn_rdt, rn_atfp, ln_crs, ln_meshmask
+         &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, ln_1st_euler  , &
+         &             ln_cfmeta, ln_xios_read, nn_wxios
+      NAMELIST/namdom/ ln_linssh, rn_Dt, rn_atfp, ln_crs, ln_meshmask
 #if defined key_netcdf4
       NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
@@ -306,8 +302,6 @@
       !
       !
-      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
       READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist' )
-      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
       READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist' )
@@ -323,5 +317,5 @@
          WRITE(numout,*) '      restart output directory        cn_ocerst_outdir= ', TRIM( cn_ocerst_outdir )
          WRITE(numout,*) '      restart logical                 ln_rstart       = ', ln_rstart
-         WRITE(numout,*) '      start with forward time step    nn_euler        = ', nn_euler
+         WRITE(numout,*) '      start with forward time step    ln_1st_euler    = ', ln_1st_euler
          WRITE(numout,*) '      control of time step            nn_rstctl       = ', nn_rstctl
          WRITE(numout,*) '      number of the first time step   nn_it000        = ', nn_it000
@@ -343,5 +337,4 @@
          WRITE(numout,*) '      overwrite an existing file      ln_clobber      = ', ln_clobber
          WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz      = ', nn_chunksz
-         WRITE(numout,*) '      IS coupling at the restart step ln_iscpl        = ', ln_iscpl
          IF( TRIM(Agrif_CFixed()) == '0' ) THEN
             WRITE(numout,*) '      READ restart for a single file using XIOS ln_xios_read =', ln_xios_read
@@ -360,10 +353,10 @@
       nleapy = nn_leapy
       ninist = nn_istate
-      neuler = nn_euler
-      IF( neuler == 1 .AND. .NOT. ln_rstart ) THEN
+      l_1st_euler = ln_1st_euler
+      IF( .NOT. l_1st_euler .AND. .NOT. ln_rstart ) THEN
          IF(lwp) WRITE(numout,*)  
          IF(lwp) WRITE(numout,*)'   ==>>>   Start from rest (ln_rstart=F)'
-         IF(lwp) WRITE(numout,*)'           an Euler initial time step is used : nn_euler is forced to 0 '   
-         neuler = 0
+         IF(lwp) WRITE(numout,*)'           an Euler initial time step is used : l_1st_euler is forced to .true. '   
+         l_1st_euler = .true.
       ENDIF
       !                             ! control of output frequency
@@ -404,8 +397,6 @@
 #endif
 
-      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
       READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
 903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdom in reference namelist' )
-      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
       READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdom in configuration namelist' )
@@ -417,13 +408,12 @@
          WRITE(numout,*) '      linear free surface (=T)                ln_linssh   = ', ln_linssh
          WRITE(numout,*) '      create mesh/mask file                   ln_meshmask = ', ln_meshmask
-         WRITE(numout,*) '      treshold to open the isf cavity         rn_isfhmin  = ', rn_isfhmin, ' [m]'
-         WRITE(numout,*) '      ocean time step                         rn_rdt      = ', rn_rdt
+         WRITE(numout,*) '      ocean time step                         rn_Dt       = ', rn_Dt
          WRITE(numout,*) '      asselin time filter parameter           rn_atfp     = ', rn_atfp
          WRITE(numout,*) '      online coarsening of dynamical fields   ln_crs      = ', ln_crs
       ENDIF
       !
-      !          ! conversion DOCTOR names into model names (this should disappear soon)
-      atfp = rn_atfp
-      rdt  = rn_rdt
+      !! Initialise current model timestep rDt = 2*rn_Dt if MLF or rDt = rn_Dt if RK3
+      rDt  = 2._wp * rn_Dt
+      r1_Dt = 1._wp / rDt
 
       IF( TRIM(Agrif_CFixed()) == '0' ) THEN
@@ -436,8 +426,6 @@
 #if defined key_netcdf4
       !                             ! NetCDF 4 case   ("key_netcdf4" defined)
-      REWIND( numnam_ref )              ! Namelist namnc4 in reference namelist : NETCDF
       READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
 907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namnc4 in reference namelist' )
-      REWIND( numnam_cfg )              ! Namelist namnc4 in configuration namelist : NETCDF
       READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
 908   IF( ios >  0 )   CALL ctl_nam ( ios , 'namnc4 in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/dommsk.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/dommsk.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/dommsk.F90	(revision 12928)
@@ -44,5 +44,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -103,8 +103,6 @@
       !!---------------------------------------------------------------------
       !
-      REWIND( numnam_ref )              ! Namelist namlbc in reference namelist : Lateral momentum boundary condition
       READ  ( numnam_ref, namlbc, IOSTAT = ios, ERR = 901 )
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlbc in reference namelist' )
-      REWIND( numnam_cfg )              ! Namelist namlbc in configuration namelist : Lateral momentum boundary condition
       READ  ( numnam_cfg, namlbc, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlbc in configuration namelist' )
@@ -133,13 +131,11 @@
       !
       tmask(:,:,:) = 0._wp
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            iktop = k_top(ji,jj)
-            ikbot = k_bot(ji,jj)
-            IF( iktop /= 0 ) THEN       ! water in the column
-               tmask(ji,jj,iktop:ikbot  ) = 1._wp
-            ENDIF
-         END DO  
-      END DO
+      DO_2D_11_11
+         iktop = k_top(ji,jj)
+         ikbot = k_bot(ji,jj)
+         IF( iktop /= 0 ) THEN       ! water in the column
+            tmask(ji,jj,iktop:ikbot  ) = 1._wp
+         ENDIF
+      END_2D
       !
       ! the following call is mandatory
@@ -148,8 +144,6 @@
 
      ! Mask corrections for bdy (read in mppini2)
-      REWIND( numnam_ref )              ! Namelist nambdy in reference namelist :Unstructured open boundaries
       READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903)
 903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist' )
-      REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist :Unstructured open boundaries
       READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 904 )
 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist' )
@@ -159,11 +153,7 @@
          CALL iom_get ( inum, jpdom_data, 'bdy_msk', bdytmask(:,:) )
          CALL iom_close( inum )
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  tmask(ji,jj,jk) = tmask(ji,jj,jk) * bdytmask(ji,jj)
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, jpkm1 )
+            tmask(ji,jj,jk) = tmask(ji,jj,jk) * bdytmask(ji,jj)
+         END_3D
       ENDIF
          
@@ -173,5 +163,5 @@
       DO jk = 1, jpk
          DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector loop
+            DO ji = 1, 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)
@@ -247,12 +237,10 @@
          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._wp ) THEN
-                     fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1),   &
-                        &                                           zwf(ji-1,jj), zwf(ji,jj-1)  )  )
-                  ENDIF
-               END DO
-            END DO
+            DO_2D_00_00
+               IF( fmask(ji,jj,jk) == 0._wp ) THEN
+                  fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1),   &
+                     &                                           zwf(ji-1,jj), zwf(ji,jj-1)  )  )
+               ENDIF
+            END_2D
             DO jj = 2, jpjm1
                IF( fmask(1,jj,jk) == 0._wp ) THEN
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/domvvl.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/domvvl.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/domvvl.F90	(revision 12928)
@@ -8,4 +8,5 @@
    !!            3.3  !  2011-10  (M. Leclair) totally rewrote domvvl: vvl option includes z_star and z_tilde coordinates
    !!            3.6  !  2014-11  (P. Mathiot) add ice shelf capability
+   !!            4.1  !  2019-08  (A. Coward, D. Storkey) rename dom_vvl_sf_swp -> dom_vvl_sf_update for new timestepping
    !!----------------------------------------------------------------------
 
@@ -13,5 +14,5 @@
    !!   dom_vvl_init     : define initial vertical scale factors, depths and column thickness
    !!   dom_vvl_sf_nxt   : Compute next vertical scale factors
-   !!   dom_vvl_sf_swp   : Swap vertical scale factors and update the vertical grid
+   !!   dom_vvl_sf_update   : Swap vertical scale factors and update the vertical grid
    !!   dom_vvl_interpol : Interpolate vertical scale factors from one grid point to another
    !!   dom_vvl_rst      : read/write restart file
@@ -36,6 +37,7 @@
 
    PUBLIC  dom_vvl_init       ! called by domain.F90
+   PUBLIC  dom_vvl_zgr        ! called by isfcpl.F90
    PUBLIC  dom_vvl_sf_nxt     ! called by step.F90
-   PUBLIC  dom_vvl_sf_swp     ! called by step.F90
+   PUBLIC  dom_vvl_sf_update  ! called by step.F90
    PUBLIC  dom_vvl_interpol   ! called by dynnxt.F90
 
@@ -62,5 +64,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -93,5 +95,5 @@
 
 
-   SUBROUTINE dom_vvl_init
+   SUBROUTINE dom_vvl_init( Kbb, Kmm, Kaa )
       !!----------------------------------------------------------------------
       !!                ***  ROUTINE dom_vvl_init  ***
@@ -102,4 +104,44 @@
       !! ** Method  :  - use restart file and/or initialize
       !!               - interpolate scale factors
+      !!
+      !! ** Action  : - e3t_(n/b) and tilde_e3t_(n/b)
+      !!              - Regrid: e3[u/v](:,:,:,Kmm)
+      !!                        e3[u/v](:,:,:,Kmm)       
+      !!                        e3w(:,:,:,Kmm)           
+      !!                        e3[u/v]w_b
+      !!                        e3[u/v]w_n      
+      !!                        gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm) and gde3w
+      !!              - h(t/u/v)_0
+      !!              - frq_rst_e3t and frq_rst_hdv
+      !!
+      !! Reference  : Leclair, M., and G. Madec, 2011, Ocean Modelling.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: Kbb, Kmm, Kaa
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'dom_vvl_init : Variable volume activated'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+      !
+      CALL dom_vvl_ctl     ! choose vertical coordinate (z_star, z_tilde or layer)
+      !
+      !                    ! Allocate module arrays
+      IF( dom_vvl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dom_vvl_init : unable to allocate arrays' )
+      !
+      !                    ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf
+      CALL dom_vvl_rst( nit000, Kbb, Kmm, 'READ' )
+      e3t(:,:,jpk,Kaa) = e3t_0(:,:,jpk)  ! last level always inside the sea floor set one for all
+      !
+      CALL dom_vvl_zgr(Kbb, Kmm, Kaa) ! interpolation scale factor, depth and water column
+      !
+   END SUBROUTINE dom_vvl_init
+   !
+   SUBROUTINE dom_vvl_zgr(Kbb, Kmm, Kaa)
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE dom_vvl_init  ***
+      !!                   
+      !! ** Purpose :  Interpolation of all scale factors, 
+      !!               depths and water column heights
+      !!
+      !! ** Method  :  - interpolate scale factors
       !!
       !! ** Action  : - e3t_(n/b) and tilde_e3t_(n/b)
@@ -115,4 +157,6 @@
       !! Reference  : Leclair, M., and G. Madec, 2011, Ocean Modelling.
       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: Kbb, Kmm, Kaa
+      !!----------------------------------------------------------------------
       INTEGER ::   ji, jj, jk
       INTEGER ::   ii0, ii1, ij0, ij1
@@ -120,81 +164,64 @@
       !!----------------------------------------------------------------------
       !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'dom_vvl_init : Variable volume activated'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
-      !
-      CALL dom_vvl_ctl     ! choose vertical coordinate (z_star, z_tilde or layer)
-      !
-      !                    ! Allocate module arrays
-      IF( dom_vvl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dom_vvl_init : unable to allocate arrays' )
-      !
-      !                    ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf
-      CALL dom_vvl_rst( nit000, 'READ' )
-      e3t_a(:,:,jpk) = e3t_0(:,:,jpk)  ! last level always inside the sea floor set one for all
-      !
       !                    !== Set of all other vertical scale factors  ==!  (now and before)
       !                                ! Horizontal interpolation of e3t
-      CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' )    ! from T to U
-      CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' )
-      CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' )    ! from T to V 
-      CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' )
-      CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' )    ! from U to F
+      CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb), 'U' )    ! from T to U
+      CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' )
+      CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' )    ! from T to V 
+      CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' )
+      CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' )    ! from U to F
       !                                ! Vertical interpolation of e3t,u,v 
-      CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  )  ! from T to W
-      CALL dom_vvl_interpol( e3t_b(:,:,:), e3w_b (:,:,:), 'W'  )
-      CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' )  ! from U to UW
-      CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' )
-      CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' )  ! from V to UW
-      CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' )
+      CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W'  )  ! from T to W
+      CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3w (:,:,:,Kbb), 'W'  )
+      CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3uw(:,:,:,Kmm), 'UW' )  ! from U to UW
+      CALL dom_vvl_interpol( e3u(:,:,:,Kbb), e3uw(:,:,:,Kbb), 'UW' )
+      CALL dom_vvl_interpol( e3v(:,:,:,Kmm), e3vw(:,:,:,Kmm), 'VW' )  ! from V to UW
+      CALL dom_vvl_interpol( e3v(:,:,:,Kbb), e3vw(:,:,:,Kbb), 'VW' )
 
       ! We need to define e3[tuv]_a for AGRIF initialisation (should not be a problem for the restartability...)
-      e3t_a(:,:,:) = e3t_n(:,:,:)
-      e3u_a(:,:,:) = e3u_n(:,:,:)
-      e3v_a(:,:,:) = e3v_n(:,:,:)
+      e3t(:,:,:,Kaa) = e3t(:,:,:,Kmm)
+      e3u(:,:,:,Kaa) = e3u(:,:,:,Kmm)
+      e3v(:,:,:,Kaa) = e3v(:,:,:,Kmm)
       !
       !                    !==  depth of t and w-point  ==!   (set the isf depth as it is in the initial timestep)
-      gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)       ! reference to the ocean surface (used for MLD and light penetration)
-      gdepw_n(:,:,1) = 0.0_wp
-      gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)  ! reference to a common level z=0 for hpg
-      gdept_b(:,:,1) = 0.5_wp * e3w_b(:,:,1)
-      gdepw_b(:,:,1) = 0.0_wp
-      DO jk = 2, jpk                               ! vertical sum
-         DO jj = 1,jpj
-            DO ji = 1,jpi
-               !    zcoef = tmask - wmask    ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt
-               !                             ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf)
-               !                             ! 0.5 where jk = mikt     
-!!gm ???????   BUG ?  gdept_n as well as gde3w_n  does not include the thickness of ISF ??
-               zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) )
-               gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1)
-               gdept_n(ji,jj,jk) =      zcoef  * ( gdepw_n(ji,jj,jk  ) + 0.5 * e3w_n(ji,jj,jk))  &
-                  &                + (1-zcoef) * ( gdept_n(ji,jj,jk-1) +       e3w_n(ji,jj,jk)) 
-               gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk) - sshn(ji,jj)
-               gdepw_b(ji,jj,jk) = gdepw_b(ji,jj,jk-1) + e3t_b(ji,jj,jk-1)
-               gdept_b(ji,jj,jk) =      zcoef  * ( gdepw_b(ji,jj,jk  ) + 0.5 * e3w_b(ji,jj,jk))  &
-                  &                + (1-zcoef) * ( gdept_b(ji,jj,jk-1) +       e3w_b(ji,jj,jk)) 
-            END DO
-         END DO
+      gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm)       ! reference to the ocean surface (used for MLD and light penetration)
+      gdepw(:,:,1,Kmm) = 0.0_wp
+      gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm)  ! reference to a common level z=0 for hpg
+      gdept(:,:,1,Kbb) = 0.5_wp * e3w(:,:,1,Kbb)
+      gdepw(:,:,1,Kbb) = 0.0_wp
+      DO_3D_11_11( 2, jpk )
+         !    zcoef = tmask - wmask    ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt
+         !                             ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf)
+         !                             ! 0.5 where jk = mikt     
+!!gm ???????   BUG ?  gdept(:,:,:,Kmm) as well as gde3w  does not include the thickness of ISF ??
+         zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) )
+         gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm)
+         gdept(ji,jj,jk,Kmm) =      zcoef  * ( gdepw(ji,jj,jk  ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm))  &
+            &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm)) 
+         gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm)
+         gdepw(ji,jj,jk,Kbb) = gdepw(ji,jj,jk-1,Kbb) + e3t(ji,jj,jk-1,Kbb)
+         gdept(ji,jj,jk,Kbb) =      zcoef  * ( gdepw(ji,jj,jk  ,Kbb) + 0.5 * e3w(ji,jj,jk,Kbb))  &
+            &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb) +       e3w(ji,jj,jk,Kbb)) 
+      END_3D
+      !
+      !                    !==  thickness of the water column  !!   (ocean portion only)
+      ht(:,:) = e3t(:,:,1,Kmm) * tmask(:,:,1)   !!gm  BUG  :  this should be 1/2 * e3w(k=1) ....
+      hu(:,:,Kbb) = e3u(:,:,1,Kbb) * umask(:,:,1)
+      hu(:,:,Kmm) = e3u(:,:,1,Kmm) * umask(:,:,1)
+      hv(:,:,Kbb) = e3v(:,:,1,Kbb) * vmask(:,:,1)
+      hv(:,:,Kmm) = e3v(:,:,1,Kmm) * vmask(:,:,1)
+      DO jk = 2, jpkm1
+         ht(:,:) = ht(:,:) + e3t(:,:,jk,Kmm) * tmask(:,:,jk)
+         hu(:,:,Kbb) = hu(:,:,Kbb) + e3u(:,:,jk,Kbb) * umask(:,:,jk)
+         hu(:,:,Kmm) = hu(:,:,Kmm) + e3u(:,:,jk,Kmm) * umask(:,:,jk)
+         hv(:,:,Kbb) = hv(:,:,Kbb) + e3v(:,:,jk,Kbb) * vmask(:,:,jk)
+         hv(:,:,Kmm) = hv(:,:,Kmm) + e3v(:,:,jk,Kmm) * vmask(:,:,jk)
       END DO
       !
-      !                    !==  thickness of the water column  !!   (ocean portion only)
-      ht_n(:,:) = e3t_n(:,:,1) * tmask(:,:,1)   !!gm  BUG  :  this should be 1/2 * e3w(k=1) ....
-      hu_b(:,:) = e3u_b(:,:,1) * umask(:,:,1)
-      hu_n(:,:) = e3u_n(:,:,1) * umask(:,:,1)
-      hv_b(:,:) = e3v_b(:,:,1) * vmask(:,:,1)
-      hv_n(:,:) = e3v_n(:,:,1) * vmask(:,:,1)
-      DO jk = 2, jpkm1
-         ht_n(:,:) = ht_n(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk)
-         hu_b(:,:) = hu_b(:,:) + e3u_b(:,:,jk) * umask(:,:,jk)
-         hu_n(:,:) = hu_n(:,:) + e3u_n(:,:,jk) * umask(:,:,jk)
-         hv_b(:,:) = hv_b(:,:) + e3v_b(:,:,jk) * vmask(:,:,jk)
-         hv_n(:,:) = hv_n(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk)
-      END DO
-      !
       !                    !==  inverse of water column thickness   ==!   (u- and v- points)
-      r1_hu_b(:,:) = ssumask(:,:) / ( hu_b(:,:) + 1._wp - ssumask(:,:) )    ! _i mask due to ISF
-      r1_hu_n(:,:) = ssumask(:,:) / ( hu_n(:,:) + 1._wp - ssumask(:,:) )
-      r1_hv_b(:,:) = ssvmask(:,:) / ( hv_b(:,:) + 1._wp - ssvmask(:,:) )
-      r1_hv_n(:,:) = ssvmask(:,:) / ( hv_n(:,:) + 1._wp - ssvmask(:,:) )
+      r1_hu(:,:,Kbb) = ssumask(:,:) / ( hu(:,:,Kbb) + 1._wp - ssumask(:,:) )    ! _i mask due to ISF
+      r1_hu(:,:,Kmm) = ssumask(:,:) / ( hu(:,:,Kmm) + 1._wp - ssumask(:,:) )
+      r1_hv(:,:,Kbb) = ssvmask(:,:) / ( hv(:,:,Kbb) + 1._wp - ssvmask(:,:) )
+      r1_hv(:,:,Kmm) = ssvmask(:,:) / ( hv(:,:,Kmm) + 1._wp - ssvmask(:,:) )
 
       !                    !==   z_tilde coordinate case  ==!   (Restoring frequencies)
@@ -208,30 +235,28 @@
          IF( ln_vvl_ztilde_as_zstar ) THEN   ! z-star emulation using z-tile
             frq_rst_e3t(:,:) = 0._wp               !Ignore namelist settings
-            frq_rst_hdv(:,:) = 1._wp / rdt
+            frq_rst_hdv(:,:) = 1._wp / rn_Dt
          ENDIF
          IF ( ln_vvl_zstar_at_eqtor ) THEN   ! use z-star in vicinity of the Equator
-            DO jj = 1, jpj
-               DO ji = 1, jpi
+            DO_2D_11_11
 !!gm  case |gphi| >= 6 degrees is useless   initialized just above by default
-                  IF( ABS(gphit(ji,jj)) >= 6.) THEN
-                     ! values outside the equatorial band and transition zone (ztilde)
-                     frq_rst_e3t(ji,jj) =  2.0_wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400.e0_wp )
-                     frq_rst_hdv(ji,jj) =  2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.e0_wp )
-                  ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN    ! Equator strip ==> z-star
-                     ! values inside the equatorial band (ztilde as zstar)
-                     frq_rst_e3t(ji,jj) =  0.0_wp
-                     frq_rst_hdv(ji,jj) =  1.0_wp / rdt
-                  ELSE                                      ! transition band (2.5 to 6 degrees N/S)
-                     !                                      ! (linearly transition from z-tilde to z-star)
-                     frq_rst_e3t(ji,jj) = 0.0_wp + (frq_rst_e3t(ji,jj)-0.0_wp)*0.5_wp   &
-                        &            * (  1.0_wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  &
-                        &                                          * 180._wp / 3.5_wp ) )
-                     frq_rst_hdv(ji,jj) = (1.0_wp / rdt)                                &
-                        &            + (  frq_rst_hdv(ji,jj)-(1.e0_wp / rdt) )*0.5_wp   &
-                        &            * (  1._wp  - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  &
-                        &                                          * 180._wp / 3.5_wp ) )
-                  ENDIF
-               END DO
-            END DO
+               IF( ABS(gphit(ji,jj)) >= 6.) THEN
+                  ! values outside the equatorial band and transition zone (ztilde)
+                  frq_rst_e3t(ji,jj) =  2.0_wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400.e0_wp )
+                  frq_rst_hdv(ji,jj) =  2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.e0_wp )
+               ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN    ! Equator strip ==> z-star
+                  ! values inside the equatorial band (ztilde as zstar)
+                  frq_rst_e3t(ji,jj) =  0.0_wp
+                  frq_rst_hdv(ji,jj) =  1.0_wp / rn_Dt
+               ELSE                                      ! transition band (2.5 to 6 degrees N/S)
+                  !                                      ! (linearly transition from z-tilde to z-star)
+                  frq_rst_e3t(ji,jj) = 0.0_wp + (frq_rst_e3t(ji,jj)-0.0_wp)*0.5_wp   &
+                     &            * (  1.0_wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  &
+                     &                                          * 180._wp / 3.5_wp ) )
+                  frq_rst_hdv(ji,jj) = (1.0_wp / rn_Dt)                                &
+                     &            + (  frq_rst_hdv(ji,jj)-(1.e0_wp / rn_Dt) )*0.5_wp   &
+                     &            * (  1._wp  - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  &
+                     &                                          * 180._wp / 3.5_wp ) )
+               ENDIF
+            END_2D
             IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN
                IF( nn_cfg == 3 ) THEN   ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2
@@ -239,5 +264,5 @@
                   ij0 = 128   ;   ij1 = 135   ;   
                   frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  0.0_wp
-                  frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  1.e0_wp / rdt
+                  frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  1.e0_wp / rn_Dt
                ENDIF
             ENDIF
@@ -263,8 +288,8 @@
       ENDIF
       !
-   END SUBROUTINE dom_vvl_init
-
-
-   SUBROUTINE dom_vvl_sf_nxt( kt, kcall ) 
+   END SUBROUTINE dom_vvl_zgr
+
+
+   SUBROUTINE dom_vvl_sf_nxt( kt, Kbb, Kmm, Kaa, kcall ) 
       !!----------------------------------------------------------------------
       !!                ***  ROUTINE dom_vvl_sf_nxt  ***
@@ -288,10 +313,11 @@
       !! Reference  : Leclair, M., and Madec, G. 2011, Ocean Modelling.
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in )           ::   kt      ! time step
-      INTEGER, INTENT( in ), OPTIONAL ::   kcall   ! optional argument indicating call sequence
+      INTEGER, INTENT( in )           ::   kt             ! time step
+      INTEGER, INTENT( in )           ::   Kbb, Kmm, Kaa  ! time step
+      INTEGER, INTENT( in ), OPTIONAL ::   kcall          ! optional argument indicating call sequence
       !
       INTEGER                ::   ji, jj, jk            ! dummy loop indices
       INTEGER , DIMENSION(3) ::   ijk_max, ijk_min      ! temporary integers
-      REAL(wp)               ::   z2dt, z_tmin, z_tmax  ! local scalars
+      REAL(wp)               ::   z_tmin, z_tmax        ! local scalars
       LOGICAL                ::   ll_do_bclinic         ! local logical
       REAL(wp), DIMENSION(jpi,jpj)     ::   zht, z_scale, zwu, zwv, zhdiv
@@ -321,8 +347,8 @@
       !                                                ! --------------------------------------------- !
       !
-      z_scale(:,:) = ( ssha(:,:) - sshb(:,:) ) * ssmask(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - ssmask(:,:) )
+      z_scale(:,:) = ( ssh(:,:,Kaa) - ssh(:,:,Kbb) ) * ssmask(:,:) / ( ht_0(:,:) + ssh(:,:,Kmm) + 1. - ssmask(:,:) )
       DO jk = 1, jpkm1
-         ! formally this is the same as e3t_a = e3t_0*(1+ssha/ht_0)
-         e3t_a(:,:,jk) = e3t_b(:,:,jk) + e3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk)
+         ! formally this is the same as e3t(:,:,:,Kaa) = e3t_0*(1+ssha/ht_0)
+         e3t(:,:,jk,Kaa) = e3t(:,:,jk,Kbb) + e3t(:,:,jk,Kmm) * z_scale(:,:) * tmask(:,:,jk)
       END DO
       !
@@ -337,6 +363,6 @@
          zht(:,:)   = 0._wp
          DO jk = 1, jpkm1
-            zhdiv(:,:) = zhdiv(:,:) + e3t_n(:,:,jk) * hdivn(:,:,jk)
-            zht  (:,:) = zht  (:,:) + e3t_n(:,:,jk) * tmask(:,:,jk)
+            zhdiv(:,:) = zhdiv(:,:) + e3t(:,:,jk,Kmm) * hdiv(:,:,jk)
+            zht  (:,:) = zht  (:,:) + e3t(:,:,jk,Kmm) * tmask(:,:,jk)
          END DO
          zhdiv(:,:) = zhdiv(:,:) / ( zht(:,:) + 1. - tmask_i(:,:) )
@@ -347,6 +373,6 @@
             IF( kt > nit000 ) THEN
                DO jk = 1, jpkm1
-                  hdiv_lf(:,:,jk) = hdiv_lf(:,:,jk) - rdt * frq_rst_hdv(:,:)   &
-                     &          * ( hdiv_lf(:,:,jk) - e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) )
+                  hdiv_lf(:,:,jk) = hdiv_lf(:,:,jk) - rn_Dt * frq_rst_hdv(:,:)   &
+                     &          * ( hdiv_lf(:,:,jk) - e3t(:,:,jk,Kmm) * ( hdiv(:,:,jk) - zhdiv(:,:) ) )
                END DO
             ENDIF
@@ -361,9 +387,9 @@
          IF( ln_vvl_ztilde ) THEN     ! z_tilde case
             DO jk = 1, jpkm1
-               tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - ( e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) - hdiv_lf(:,:,jk) )
+               tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - ( e3t(:,:,jk,Kmm) * ( hdiv(:,:,jk) - zhdiv(:,:) ) - hdiv_lf(:,:,jk) )
             END DO
          ELSE                         ! layer case
             DO jk = 1, jpkm1
-               tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) -   e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) * tmask(:,:,jk)
+               tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) -   e3t(:,:,jk,Kmm) * ( hdiv(:,:,jk) - zhdiv(:,:) ) * tmask(:,:,jk)
             END DO
          ENDIF
@@ -381,31 +407,21 @@
          zwu(:,:) = 0._wp
          zwv(:,:) = 0._wp
-         DO jk = 1, jpkm1        ! a - first derivative: diffusive fluxes
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj)           &
-                     &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj  ,jk) )
-                  vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj)           & 
-                     &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji  ,jj+1,jk) )
-                  zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk)
-                  zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         DO jj = 1, jpj          ! b - correction for last oceanic u-v points
-            DO ji = 1, jpi
-               un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj)
-               vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj)
-            END DO
-         END DO
-         DO jk = 1, jpkm1        ! c - second derivative: divergence of diffusive fluxes
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + (   un_td(ji-1,jj  ,jk) - un_td(ji,jj,jk)    &
-                     &                                          +     vn_td(ji  ,jj-1,jk) - vn_td(ji,jj,jk)    &
-                     &                                            ) * r1_e1e2t(ji,jj)
-               END DO
-            END DO
-         END DO
+         DO_3D_10_10( 1, jpkm1 )
+            un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj)           &
+               &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj  ,jk) )
+            vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj)           & 
+               &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji  ,jj+1,jk) )
+            zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk)
+            zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk)
+         END_3D
+         DO_2D_11_11
+            un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj)
+            vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj)
+         END_2D
+         DO_3D_00_00( 1, jpkm1 )
+            tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + (   un_td(ji-1,jj  ,jk) - un_td(ji,jj,jk)    &
+               &                                          +     vn_td(ji  ,jj-1,jk) - vn_td(ji,jj,jk)    &
+               &                                            ) * r1_e1e2t(ji,jj)
+         END_3D
          !                       ! d - thickness diffusion transport: boundary conditions
          !                             (stored for tracer advction and continuity equation)
@@ -414,13 +430,6 @@
          ! 4 - Time stepping of baroclinic scale factors
          ! ---------------------------------------------
-         ! Leapfrog time stepping
-         ! ~~~~~~~~~~~~~~~~~~~~~~
-         IF( neuler == 0 .AND. kt == nit000 ) THEN
-            z2dt =  rdt
-         ELSE
-            z2dt = 2.0_wp * rdt
-         ENDIF
          CALL lbc_lnk( 'domvvl', tilde_e3t_a(:,:,:), 'T', 1._wp )
-         tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + z2dt * tmask(:,:,:) * tilde_e3t_a(:,:,:)
+         tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + rDt * tmask(:,:,:) * tilde_e3t_a(:,:,:)
 
          ! Maximum deformation control
@@ -476,7 +485,7 @@
             zht(:,:)  = zht(:,:) + tilde_e3t_a(:,:,jk) * tmask(:,:,jk)
          END DO
-         z_scale(:,:) =  - zht(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - ssmask(:,:) )
+         z_scale(:,:) =  - zht(:,:) / ( ht_0(:,:) + ssh(:,:,Kmm) + 1. - ssmask(:,:) )
          DO jk = 1, jpkm1
-            dtilde_e3t_a(:,:,jk) = dtilde_e3t_a(:,:,jk) + e3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk)
+            dtilde_e3t_a(:,:,jk) = dtilde_e3t_a(:,:,jk) + e3t(:,:,jk,Kmm) * z_scale(:,:) * tmask(:,:,jk)
          END DO
 
@@ -486,5 +495,5 @@
       !                                           ! ---baroclinic part--------- !
          DO jk = 1, jpkm1
-            e3t_a(:,:,jk) = e3t_a(:,:,jk) + dtilde_e3t_a(:,:,jk) * tmask(:,:,jk)
+            e3t(:,:,jk,Kaa) = e3t(:,:,jk,Kaa) + dtilde_e3t_a(:,:,jk) * tmask(:,:,jk)
          END DO
       ENDIF
@@ -501,37 +510,37 @@
          zht(:,:) = 0.0_wp
          DO jk = 1, jpkm1
-            zht(:,:) = zht(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk)
-         END DO
-         z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshn(:,:) - zht(:,:) ) )
+            zht(:,:) = zht(:,:) + e3t(:,:,jk,Kmm) * tmask(:,:,jk)
+         END DO
+         z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + ssh(:,:,Kmm) - zht(:,:) ) )
          CALL mpp_max( 'domvvl', z_tmax )                                ! max over the global domain
-         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshn-SUM(e3t_n))) =', z_tmax
+         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshn-SUM(e3t(:,:,:,Kmm)))) =', z_tmax
          !
          zht(:,:) = 0.0_wp
          DO jk = 1, jpkm1
-            zht(:,:) = zht(:,:) + e3t_a(:,:,jk) * tmask(:,:,jk)
-         END DO
-         z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + ssha(:,:) - zht(:,:) ) )
+            zht(:,:) = zht(:,:) + e3t(:,:,jk,Kaa) * tmask(:,:,jk)
+         END DO
+         z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + ssh(:,:,Kaa) - zht(:,:) ) )
          CALL mpp_max( 'domvvl', z_tmax )                                ! max over the global domain
-         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+ssha-SUM(e3t_a))) =', z_tmax
+         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+ssha-SUM(e3t(:,:,:,Kaa)))) =', z_tmax
          !
          zht(:,:) = 0.0_wp
          DO jk = 1, jpkm1
-            zht(:,:) = zht(:,:) + e3t_b(:,:,jk) * tmask(:,:,jk)
-         END DO
-         z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshb(:,:) - zht(:,:) ) )
+            zht(:,:) = zht(:,:) + e3t(:,:,jk,Kbb) * tmask(:,:,jk)
+         END DO
+         z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + ssh(:,:,Kbb) - zht(:,:) ) )
          CALL mpp_max( 'domvvl', z_tmax )                                ! max over the global domain
-         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshb-SUM(e3t_b))) =', z_tmax
-         !
-         z_tmax = MAXVAL( tmask(:,:,1) *  ABS( sshb(:,:) ) )
+         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshb-SUM(e3t(:,:,:,Kbb)))) =', z_tmax
+         !
+         z_tmax = MAXVAL( tmask(:,:,1) *  ABS( ssh(:,:,Kbb) ) )
          CALL mpp_max( 'domvvl', z_tmax )                                ! max over the global domain
-         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(sshb))) =', z_tmax
-         !
-         z_tmax = MAXVAL( tmask(:,:,1) *  ABS( sshn(:,:) ) )
+         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ssh(:,:,Kbb)))) =', z_tmax
+         !
+         z_tmax = MAXVAL( tmask(:,:,1) *  ABS( ssh(:,:,Kmm) ) )
          CALL mpp_max( 'domvvl', z_tmax )                                ! max over the global domain
-         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(sshn))) =', z_tmax
-         !
-         z_tmax = MAXVAL( tmask(:,:,1) *  ABS( ssha(:,:) ) )
+         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ssh(:,:,Kmm)))) =', z_tmax
+         !
+         z_tmax = MAXVAL( tmask(:,:,1) *  ABS( ssh(:,:,Kaa) ) )
          CALL mpp_max( 'domvvl', z_tmax )                                ! max over the global domain
-         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ssha))) =', z_tmax
+         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ssh(:,:,Kaa)))) =', z_tmax
       END IF
 
@@ -540,6 +549,6 @@
       ! *********************************** !
 
-      CALL dom_vvl_interpol( e3t_a(:,:,:), e3u_a(:,:,:), 'U' )
-      CALL dom_vvl_interpol( e3t_a(:,:,:), e3v_a(:,:,:), 'V' )
+      CALL dom_vvl_interpol( e3t(:,:,:,Kaa), e3u(:,:,:,Kaa), 'U' )
+      CALL dom_vvl_interpol( e3t(:,:,:,Kaa), e3v(:,:,:,Kaa), 'V' )
 
       ! *********************************** !
@@ -547,14 +556,14 @@
       ! *********************************** !
 
-      hu_a(:,:) = e3u_a(:,:,1) * umask(:,:,1)
-      hv_a(:,:) = e3v_a(:,:,1) * vmask(:,:,1)
+      hu(:,:,Kaa) = e3u(:,:,1,Kaa) * umask(:,:,1)
+      hv(:,:,Kaa) = e3v(:,:,1,Kaa) * vmask(:,:,1)
       DO jk = 2, jpkm1
-         hu_a(:,:) = hu_a(:,:) + e3u_a(:,:,jk) * umask(:,:,jk)
-         hv_a(:,:) = hv_a(:,:) + e3v_a(:,:,jk) * vmask(:,:,jk)
+         hu(:,:,Kaa) = hu(:,:,Kaa) + e3u(:,:,jk,Kaa) * umask(:,:,jk)
+         hv(:,:,Kaa) = hv(:,:,Kaa) + e3v(:,:,jk,Kaa) * vmask(:,:,jk)
       END DO
       !                                        ! Inverse of the local depth
 !!gm BUG ?  don't understand the use of umask_i here .....
-      r1_hu_a(:,:) = ssumask(:,:) / ( hu_a(:,:) + 1._wp - ssumask(:,:) )
-      r1_hv_a(:,:) = ssvmask(:,:) / ( hv_a(:,:) + 1._wp - ssvmask(:,:) )
+      r1_hu(:,:,Kaa) = ssumask(:,:) / ( hu(:,:,Kaa) + 1._wp - ssumask(:,:) )
+      r1_hv(:,:,Kaa) = ssvmask(:,:) / ( hv(:,:,Kaa) + 1._wp - ssvmask(:,:) )
       !
       IF( ln_timing )   CALL timing_stop('dom_vvl_sf_nxt')
@@ -563,23 +572,23 @@
 
 
-   SUBROUTINE dom_vvl_sf_swp( kt )
-      !!----------------------------------------------------------------------
-      !!                ***  ROUTINE dom_vvl_sf_swp  ***
+   SUBROUTINE dom_vvl_sf_update( kt, Kbb, Kmm, Kaa )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE dom_vvl_sf_update  ***
       !!                   
-      !! ** Purpose :  compute time filter and swap of scale factors 
+      !! ** Purpose :  for z tilde case: compute time filter and swap of scale factors 
       !!               compute all depths and related variables for next time step
       !!               write outputs and restart file
       !!
-      !! ** Method  :  - swap of e3t with trick for volume/tracer conservation
+      !! ** Method  :  - swap of e3t with trick for volume/tracer conservation (ONLY FOR Z TILDE CASE)
       !!               - reconstruct scale factor at other grid points (interpolate)
       !!               - recompute depths and water height fields
       !!
-      !! ** Action  :  - e3t_(b/n), tilde_e3t_(b/n) and e3(u/v)_n ready for next time step
+      !! ** Action  :  - tilde_e3t_(b/n) ready for next time step
       !!               - Recompute:
       !!                    e3(u/v)_b       
-      !!                    e3w_n           
+      !!                    e3w(:,:,:,Kmm)           
       !!                    e3(u/v)w_b      
       !!                    e3(u/v)w_n      
-      !!                    gdept_n, gdepw_n  and gde3w_n
+      !!                    gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm)  and gde3w
       !!                    h(u/v) and h(u/v)r
       !!
@@ -587,5 +596,6 @@
       !!              Leclair, M., and G. Madec, 2011, Ocean Modelling.
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt   ! time step
+      INTEGER, INTENT( in ) ::   kt              ! time step
+      INTEGER, INTENT( in ) ::   Kbb, Kmm, Kaa   ! time level indices
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -595,10 +605,10 @@
       IF( ln_linssh )   RETURN      ! No calculation in linear free surface
       !
-      IF( ln_timing )   CALL timing_start('dom_vvl_sf_swp')
+      IF( ln_timing )   CALL timing_start('dom_vvl_sf_update')
       !
       IF( kt == nit000 )   THEN
          IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'dom_vvl_sf_swp : - time filter and swap of scale factors'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~   - interpolate scale factors and compute depths for next time step'
+         IF(lwp) WRITE(numout,*) 'dom_vvl_sf_update : - interpolate scale factors and compute depths for next time step'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~'
       ENDIF
       !
@@ -607,18 +617,12 @@
       ! - ML - e3(t/u/v)_b are allready computed in dynnxt.
       IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN
-         IF( neuler == 0 .AND. kt == nit000 ) THEN
+         IF( l_1st_euler ) THEN
             tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:)
          ELSE
             tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) & 
-            &         + atfp * ( tilde_e3t_b(:,:,:) - 2.0_wp * tilde_e3t_n(:,:,:) + tilde_e3t_a(:,:,:) )
+            &         + rn_atfp * ( tilde_e3t_b(:,:,:) - 2.0_wp * tilde_e3t_n(:,:,:) + tilde_e3t_a(:,:,:) )
          ENDIF
          tilde_e3t_n(:,:,:) = tilde_e3t_a(:,:,:)
       ENDIF
-      gdept_b(:,:,:) = gdept_n(:,:,:)
-      gdepw_b(:,:,:) = gdepw_n(:,:,:)
-
-      e3t_n(:,:,:) = e3t_a(:,:,:)
-      e3u_n(:,:,:) = e3u_a(:,:,:)
-      e3v_n(:,:,:) = e3v_a(:,:,:)
 
       ! Compute all missing vertical scale factor and depths
@@ -626,52 +630,46 @@
       ! Horizontal scale factor interpolations
       ! --------------------------------------
-      ! - ML - e3u_b and e3v_b are allready computed in dynnxt
-      ! - JC - hu_b, hv_b, hur_b, hvr_b also
+      ! - ML - e3u(:,:,:,Kbb) and e3v(:,:,:,Kbb) are already computed in dynnxt
+      ! - JC - hu(:,:,:,Kbb), hv(:,:,:,:,Kbb), hur_b, hvr_b also
       
-      CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F'  )
+      CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F'  )
       
       ! Vertical scale factor interpolations
-      CALL dom_vvl_interpol( e3t_n(:,:,:),  e3w_n(:,:,:), 'W'  )
-      CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' )
-      CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' )
-      CALL dom_vvl_interpol( e3t_b(:,:,:),  e3w_b(:,:,:), 'W'  )
-      CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' )
-      CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' )
+      CALL dom_vvl_interpol( e3t(:,:,:,Kmm),  e3w(:,:,:,Kmm), 'W'  )
+      CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3uw(:,:,:,Kmm), 'UW' )
+      CALL dom_vvl_interpol( e3v(:,:,:,Kmm), e3vw(:,:,:,Kmm), 'VW' )
+      CALL dom_vvl_interpol( e3t(:,:,:,Kbb),  e3w(:,:,:,Kbb), 'W'  )
+      CALL dom_vvl_interpol( e3u(:,:,:,Kbb), e3uw(:,:,:,Kbb), 'UW' )
+      CALL dom_vvl_interpol( e3v(:,:,:,Kbb), e3vw(:,:,:,Kbb), 'VW' )
 
       ! t- and w- points depth (set the isf depth as it is in the initial step)
-      gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)
-      gdepw_n(:,:,1) = 0.0_wp
-      gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)
-      DO jk = 2, jpk
-         DO jj = 1,jpj
-            DO ji = 1,jpi
-              !    zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))   ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt
-                                                                 ! 1 for jk = mikt
-               zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))
-               gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1)
-               gdept_n(ji,jj,jk) =    zcoef  * ( gdepw_n(ji,jj,jk  ) + 0.5 * e3w_n(ji,jj,jk) )  &
-                   &             + (1-zcoef) * ( gdept_n(ji,jj,jk-1) +       e3w_n(ji,jj,jk) ) 
-               gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk) - sshn(ji,jj)
-            END DO
-         END DO
-      END DO
+      gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm)
+      gdepw(:,:,1,Kmm) = 0.0_wp
+      gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm)
+      DO_3D_11_11( 2, jpk )
+        !    zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))   ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt
+                                                           ! 1 for jk = mikt
+         zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))
+         gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm)
+         gdept(ji,jj,jk,Kmm) =    zcoef  * ( gdepw(ji,jj,jk  ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm) )  &
+             &             + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm) ) 
+         gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm)
+      END_3D
 
       ! Local depth and Inverse of the local depth of the water
       ! -------------------------------------------------------
-      hu_n(:,:) = hu_a(:,:)   ;   r1_hu_n(:,:) = r1_hu_a(:,:)
-      hv_n(:,:) = hv_a(:,:)   ;   r1_hv_n(:,:) = r1_hv_a(:,:)
-      !
-      ht_n(:,:) = e3t_n(:,:,1) * tmask(:,:,1)
+      !
+      ht(:,:) = e3t(:,:,1,Kmm) * tmask(:,:,1)
       DO jk = 2, jpkm1
-         ht_n(:,:) = ht_n(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk)
+         ht(:,:) = ht(:,:) + e3t(:,:,jk,Kmm) * tmask(:,:,jk)
       END DO
 
       ! write restart file
       ! ==================
-      IF( lrst_oce  )   CALL dom_vvl_rst( kt, 'WRITE' )
-      !
-      IF( ln_timing )   CALL timing_stop('dom_vvl_sf_swp')
-      !
-   END SUBROUTINE dom_vvl_sf_swp
+      IF( lrst_oce  )   CALL dom_vvl_rst( kt, Kbb, Kmm, 'WRITE' )
+      !
+      IF( ln_timing )   CALL timing_stop('dom_vvl_sf_update')
+      !
+   END SUBROUTINE dom_vvl_sf_update
 
 
@@ -704,40 +702,28 @@
          !
       CASE( 'U' )                   !* from T- to U-point : hor. surface weighted mean
-         DO jk = 1, jpk
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj)   &
-                     &                       * (   e1e2t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) )     &
-                     &                           + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) )
-               END DO
-            END DO
-         END DO
+         DO_3D_10_10( 1, jpk )
+            pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj)   &
+               &                       * (   e1e2t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) )     &
+               &                           + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) )
+         END_3D
          CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'U', 1._wp )
          pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:)
          !
       CASE( 'V' )                   !* from T- to V-point : hor. surface weighted mean
-         DO jk = 1, jpk
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk)  * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj)   &
-                     &                       * (   e1e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) )     &
-                     &                           + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) )
-               END DO
-            END DO
-         END DO
+         DO_3D_10_10( 1, jpk )
+            pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk)  * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj)   &
+               &                       * (   e1e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) )     &
+               &                           + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) )
+         END_3D
          CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'V', 1._wp )
          pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:)
          !
       CASE( 'F' )                   !* from U-point to F-point : hor. surface weighted mean
-         DO jk = 1, jpk
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) &
-                     &                       *    r1_e1e2f(ji,jj)                                                  &
-                     &                       * (   e1e2u(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3u_0(ji,jj  ,jk) )     &
-                     &                           + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) )
-               END DO
-            END DO
-         END DO
+         DO_3D_10_10( 1, jpk )
+            pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) &
+               &                       *    r1_e1e2f(ji,jj)                                                  &
+               &                       * (   e1e2u(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3u_0(ji,jj  ,jk) )     &
+               &                           + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) )
+         END_3D
          CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'F', 1._wp )
          pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:)
@@ -783,5 +769,5 @@
 
 
-   SUBROUTINE dom_vvl_rst( kt, cdrw )
+   SUBROUTINE dom_vvl_rst( kt, Kbb, Kmm, cdrw )
       !!---------------------------------------------------------------------
       !!                   ***  ROUTINE dom_vvl_rst  ***
@@ -795,6 +781,7 @@
       !!                they are set to 0.
       !!----------------------------------------------------------------------
-      INTEGER         , INTENT(in) ::   kt     ! ocean time-step
-      CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag
+      INTEGER         , INTENT(in) ::   kt        ! ocean time-step
+      INTEGER         , INTENT(in) ::   Kbb, Kmm  ! ocean time level indices
+      CHARACTER(len=*), INTENT(in) ::   cdrw      ! "READ"/"WRITE" flag
       !
       INTEGER ::   ji, jj, jk
@@ -806,5 +793,5 @@
          IF( ln_rstart ) THEN                   !* Read the restart file
             CALL rst_read_open                  !  open the restart file if necessary
-            CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn, ldxios = lrxios    )
+            CALL iom_get( numror, jpdom_autoglo, 'sshn'   , ssh(:,:,Kmm), ldxios = lrxios    )
             !
             id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. )
@@ -813,44 +800,46 @@
             id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. )
             id5 = iom_varid( numror, 'hdiv_lf', ldstop = .FALSE. )
+            !
             !                             ! --------- !
             !                             ! all cases !
             !                             ! --------- !
+            !
             IF( MIN( id1, id2 ) > 0 ) THEN       ! all required arrays exist
-               CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:), ldxios = lrxios )
-               CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:), ldxios = lrxios )
+               CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios )
+               CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios )
                ! needed to restart if land processor not computed 
-               IF(lwp) write(numout,*) 'dom_vvl_rst : e3t_b and e3t_n found in restart files'
+               IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files'
                WHERE ( tmask(:,:,:) == 0.0_wp ) 
-                  e3t_n(:,:,:) = e3t_0(:,:,:)
-                  e3t_b(:,:,:) = e3t_0(:,:,:)
+                  e3t(:,:,:,Kmm) = e3t_0(:,:,:)
+                  e3t(:,:,:,Kbb) = e3t_0(:,:,:)
                END WHERE
-               IF( neuler == 0 ) THEN
-                  e3t_b(:,:,:) = e3t_n(:,:,:)
+               IF( l_1st_euler ) THEN
+                  e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm)
                ENDIF
             ELSE IF( id1 > 0 ) THEN
-               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t_n not found in restart files'
+               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart files'
                IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.'
-               IF(lwp) write(numout,*) 'neuler is forced to 0'
-               CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:), ldxios = lrxios )
-               e3t_n(:,:,:) = e3t_b(:,:,:)
-               neuler = 0
+               IF(lwp) write(numout,*) 'l_1st_euler is forced to true'
+               CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios )
+               e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb)
+               l_1st_euler = .true.
             ELSE IF( id2 > 0 ) THEN
-               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t_b not found in restart files'
+               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kbb) not found in restart files'
                IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.'
-               IF(lwp) write(numout,*) 'neuler is forced to 0'
-               CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:), ldxios = lrxios )
-               e3t_b(:,:,:) = e3t_n(:,:,:)
-               neuler = 0
+               IF(lwp) write(numout,*) 'l_1st_euler is forced to true'
+               CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios )
+               e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm)
+               l_1st_euler = .true.
             ELSE
-               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t_n not found in restart file'
+               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart file'
                IF(lwp) write(numout,*) 'Compute scale factor from sshn'
-               IF(lwp) write(numout,*) 'neuler is forced to 0'
+               IF(lwp) write(numout,*) 'l_1st_euler is forced to true'
                DO jk = 1, jpk
-                  e3t_n(:,:,jk) =  e3t_0(:,:,jk) * ( ht_0(:,:) + sshn(:,:) ) &
+                  e3t(:,:,jk,Kmm) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) &
                       &                          / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   &
                       &          + e3t_0(:,:,jk)                               * (1._wp -tmask(:,:,jk))
                END DO
-               e3t_b(:,:,:) = e3t_n(:,:,:)
-               neuler = 0
+               e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm)
+               l_1st_euler = .true.
             ENDIF
             !                             ! ----------- !
@@ -888,41 +877,35 @@
                IF( cn_cfg == 'wad' ) THEN
                   ! Wetting and drying test case
-                  CALL usr_def_istate( gdept_b, tmask, tsb, ub, vb, sshb  )
-                  tsn  (:,:,:,:) = tsb (:,:,:,:)       ! set now values from to before ones
-                  sshn (:,:)     = sshb(:,:)
-                  un   (:,:,:)   = ub  (:,:,:)
-                  vn   (:,:,:)   = vb  (:,:,:)
+                  CALL usr_def_istate( gdept(:,:,:,Kbb), tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  )
+                  ts  (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb)       ! set now values from to before ones
+                  ssh (:,:,Kmm)     = ssh(:,:,Kbb)
+                  uu   (:,:,:,Kmm)   = uu  (:,:,:,Kbb)
+                  vv   (:,:,:,Kmm)   = vv  (:,:,:,Kbb)
                ELSE
                   ! if not test case
-                  sshn(:,:) = -ssh_ref
-                  sshb(:,:) = -ssh_ref
-
-                  DO jj = 1, jpj
-                     DO ji = 1, jpi
-                        IF( ht_0(ji,jj)-ssh_ref <  rn_wdmin1 ) THEN ! if total depth is less than min depth
-
-                           sshb(ji,jj) = rn_wdmin1 - (ht_0(ji,jj) )
-                           sshn(ji,jj) = rn_wdmin1 - (ht_0(ji,jj) )
-                           ssha(ji,jj) = rn_wdmin1 - (ht_0(ji,jj) )
-                        ENDIF
-                     ENDDO
-                  ENDDO
+                  ssh(:,:,Kmm) = -ssh_ref
+                  ssh(:,:,Kbb) = -ssh_ref
+
+                  DO_2D_11_11
+                     IF( ht_0(ji,jj)-ssh_ref <  rn_wdmin1 ) THEN ! if total depth is less than min depth
+                        ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) )
+                        ssh(ji,jj,Kmm) = rn_wdmin1 - (ht_0(ji,jj) )
+                     ENDIF
+                  END_2D
                ENDIF !If test case else
 
                ! Adjust vertical metrics for all wad
                DO jk = 1, jpk
-                  e3t_n(:,:,jk) =  e3t_0(:,:,jk) * ( ht_0(:,:) + sshn(:,:)  ) &
+                  e3t(:,:,jk,Kmm) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm)  ) &
                     &                            / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   &
                     &            + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) )
                END DO
-               e3t_b(:,:,:) = e3t_n(:,:,:)
-
-               DO ji = 1, jpi
-                  DO jj = 1, jpj
-                     IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN
-                       CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' )
-                     ENDIF
-                  END DO 
-               END DO 
+               e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm)
+
+               DO_2D_11_11
+                  IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN
+                     CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' )
+                  ENDIF
+               END_2D
                !
             ELSE
@@ -930,14 +913,14 @@
                ! Just to read set ssh in fact, called latter once vertical grid
                ! is set up:
-!               CALL usr_def_istate( gdept_0, tmask, tsb, ub, vb, sshb  )
+!               CALL usr_def_istate( gdept_0, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  )
 !               !
 !               DO jk=1,jpk
-!                  e3t_b(:,:,jk) =  e3t_0(:,:,jk) * ( ht_0(:,:) + sshb(:,:) ) &
+!                  e3t(:,:,jk,Kbb) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb) ) &
 !                     &            / ( ht_0(:,:) + 1._wp -ssmask(:,:) ) * tmask(:,:,jk)
 !               END DO
-!               e3t_n(:,:,:) = e3t_b(:,:,:)
-                sshn(:,:)=0._wp
-                e3t_n(:,:,:)=e3t_0(:,:,:)
-                e3t_b(:,:,:)=e3t_0(:,:,:)
+!               e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb)
+                ssh(:,:,Kmm)=0._wp
+                e3t(:,:,:,Kmm)=e3t_0(:,:,:)
+                e3t(:,:,:,Kbb)=e3t_0(:,:,:)
                !
             END IF           ! end of ll_wd edits
@@ -957,6 +940,6 @@
          !                                           ! all cases !
          !                                           ! --------- !
-         CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t_b(:,:,:), ldxios = lwxios )
-         CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:), ldxios = lwxios )
+         CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lwxios )
+         CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lwxios )
          !                                           ! ----------------------- !
          IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN  ! z_tilde and layer cases !
@@ -991,8 +974,6 @@
       !!---------------------------------------------------------------------- 
       !
-      REWIND( numnam_ref )              ! Namelist nam_vvl in reference namelist : 
       READ  ( numnam_ref, nam_vvl, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_vvl in reference namelist' )
-      REWIND( numnam_cfg )              ! Namelist nam_vvl in configuration namelist : Parameters of the run
       READ  ( numnam_cfg, nam_vvl, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'nam_vvl in configuration namelist' )
@@ -1018,5 +999,5 @@
             WRITE(numout,*) '                         rn_rst_e3t     = 0.e0'
             WRITE(numout,*) '            hard-wired : z-tilde cutoff frequency of low-pass filter (days)'
-            WRITE(numout,*) '                         rn_lf_cutoff   = 1.0/rdt'
+            WRITE(numout,*) '                         rn_lf_cutoff   = 1.0/rn_Dt'
          ELSE
             WRITE(numout,*) '      z-tilde to zstar restoration timescale (days)        rn_rst_e3t   = ', rn_rst_e3t
@@ -1033,5 +1014,4 @@
       !
       IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE vertical coordinate in namelist nam_vvl' )
-      IF( .NOT. ln_vvl_zstar .AND. ln_isf ) CALL ctl_stop( 'Only vvl_zstar has been tested with ice shelf cavity' )
       !
       IF(lwp) THEN                   ! Print the choice
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/domwri.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/domwri.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/domwri.F90	(revision 12928)
@@ -16,4 +16,5 @@
    !!   dom_stiff      : diagnose maximum grid stiffness/hydrostatic consistency (s-coordinate)
    !!----------------------------------------------------------------------
+   !
    USE dom_oce         ! ocean space and time domain
    USE phycst ,   ONLY :   rsmall
@@ -32,5 +33,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -99,23 +100,17 @@
       
       CALL dom_uniq( zprw, 'T' )
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zprt(ji,jj) = ssmask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask
-         END DO
-      END DO                             !    ! unique point mask
+      DO_2D_11_11
+         zprt(ji,jj) = ssmask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask
+      END_2D
       CALL iom_rstput( 0, 0, inum, 'tmaskutil', zprt, ktype = jp_i1 )  
       CALL dom_uniq( zprw, 'U' )
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zprt(ji,jj) = ssumask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask
-         END DO
-      END DO
+      DO_2D_11_11
+         zprt(ji,jj) = ssumask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask
+      END_2D
       CALL iom_rstput( 0, 0, inum, 'umaskutil', zprt, ktype = jp_i1 )  
       CALL dom_uniq( zprw, 'V' )
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zprt(ji,jj) = ssvmask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask
-         END DO
-      END DO
+      DO_2D_11_11
+         zprt(ji,jj) = ssvmask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask
+      END_2D
       CALL iom_rstput( 0, 0, inum, 'vmaskutil', zprt, ktype = jp_i1 )  
 !!gm  ssfmask has been removed  ==>> find another solution to defined fmaskutil
@@ -155,10 +150,8 @@
       
       ! note that mbkt is set to 1 over land ==> use surface tmask
-      zprt(:,:) = ssmask(:,:) * REAL( mbkt(:,:) , wp )
+      zprt(:,:) = REAL( mbkt(:,:) , wp )
       CALL iom_rstput( 0, 0, inum, 'mbathy', zprt, ktype = jp_i4 )     !    ! nb of ocean T-points
-      zprt(:,:) = ssmask(:,:) * REAL( mikt(:,:) , wp )
+      zprt(:,:) = REAL( mikt(:,:) , wp )
       CALL iom_rstput( 0, 0, inum, 'misf', zprt, ktype = jp_i4 )       !    ! nb of ocean T-points
-      zprt(:,:) = ssmask(:,:) * REAL( risfdep(:,:) , wp )
-      CALL iom_rstput( 0, 0, inum, 'isfdraft', zprt, ktype = jp_r8 )   !    ! nb of ocean T-points
       !															             ! vertical mesh
       CALL iom_rstput( 0, 0, inum, 'e3t_1d', e3t_1d, ktype = jp_r8  )    !    ! scale factors
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/domzgr.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/domzgr.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/domzgr.F90	(revision 12928)
@@ -44,5 +44,5 @@
 
   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -71,5 +71,6 @@
       INTEGER, DIMENSION(:,:), INTENT(out) ::   k_top, k_bot   ! ocean first and last level indices
       !
-      INTEGER  ::   jk                  ! dummy loop index
+      INTEGER  ::   ji,jj,jk            ! dummy loop index
+      INTEGER  ::   ikt, ikb            ! top/bot index
       INTEGER  ::   ioptio, ibat, ios   ! local integer
       REAL(wp) ::   zrefdep             ! depth of the reference level (~10m)
@@ -118,5 +119,14 @@
       ! Any closed seas (defined by closea_mask > 0 in domain_cfg file) to be filled 
       ! in at runtime if ln_closea=.false.
-      IF( .NOT.ln_closea )   CALL clo_bat( k_top, k_bot )
+      IF( ln_closea ) THEN
+         IF ( ln_maskcs ) THEN
+            ! mask all the closed sea
+            CALL clo_msk( k_top, k_bot, mask_opnsea, 'mask_opensea' )
+         ELSE IF ( ln_mask_csundef ) THEN
+            ! defined closed sea are kept
+            ! mask all the undefined closed sea
+            CALL clo_msk( k_top, k_bot, mask_csundef, 'mask_csundef' )
+         END IF
+      END IF
       !
       IF(lwp) THEN                     ! Control print
@@ -138,6 +148,13 @@
       !                                ! top/bottom ocean level indices for t-, u- and v-points (f-point also for top)
       CALL zgr_top_bot( k_top, k_bot )      ! with a minimum value set to 1
-      
-
+      !
+      !                                ! ice shelf draft and bathymetry
+      DO_2D_11_11
+         ikt = mikt(ji,jj)
+         ikb = mbkt(ji,jj)
+         bathy  (ji,jj) = gdepw_0(ji,jj,ikb+1)
+         risfdep(ji,jj) = gdepw_0(ji,jj,ikt  )
+      END_2D
+      !
       !                                ! deepest/shallowest W level Above/Below ~10m
 !!gm BUG in s-coordinate this does not work!
@@ -296,14 +313,12 @@
       !                                    ! N.B.  top     k-index of W-level = mikt
       !                                    !       bottom  k-index of W-level = mbkt+1
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-            miku(ji,jj) = MAX(  mikt(ji+1,jj  ) , mikt(ji,jj)  )
-            mikv(ji,jj) = MAX(  mikt(ji  ,jj+1) , mikt(ji,jj)  )
-            mikf(ji,jj) = MAX(  mikt(ji  ,jj+1) , mikt(ji,jj), mikt(ji+1,jj  ), mikt(ji+1,jj+1)  )
-            !
-            mbku(ji,jj) = MIN(  mbkt(ji+1,jj  ) , mbkt(ji,jj)  )
-            mbkv(ji,jj) = MIN(  mbkt(ji  ,jj+1) , mbkt(ji,jj)  )
-         END DO
-      END DO
+      DO_2D_10_10
+         miku(ji,jj) = MAX(  mikt(ji+1,jj  ) , mikt(ji,jj)  )
+         mikv(ji,jj) = MAX(  mikt(ji  ,jj+1) , mikt(ji,jj)  )
+         mikf(ji,jj) = MAX(  mikt(ji  ,jj+1) , mikt(ji,jj), mikt(ji+1,jj  ), mikt(ji+1,jj+1)  )
+         !
+         mbku(ji,jj) = MIN(  mbkt(ji+1,jj  ) , mbkt(ji,jj)  )
+         mbkv(ji,jj) = MIN(  mbkt(ji  ,jj+1) , mbkt(ji,jj)  )
+      END_2D
       ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 
       zk(:,:) = REAL( miku(:,:), wp )   ;   CALL lbc_lnk( 'domzgr', zk, 'U', 1. )   ;   miku(:,:) = MAX( NINT( zk(:,:) ), 1 )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/dtatsd.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/dtatsd.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/dtatsd.F90	(revision 12928)
@@ -35,4 +35,6 @@
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tsd   ! structure of input SST (file informations, fields read)
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -65,8 +67,6 @@
       ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0
       !
-      REWIND( numnam_ref )              ! Namelist namtsd in reference namelist : 
       READ  ( numnam_ref, namtsd, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtsd in reference namelist' )
-      REWIND( numnam_cfg )              ! Namelist namtsd in configuration namelist : Parameters of the run
       READ  ( numnam_cfg, namtsd, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtsd in configuration namelist' )
@@ -186,32 +186,30 @@
          ENDIF
          !
-         DO jj = 1, jpj                         ! vertical interpolation of T & S
-            DO ji = 1, jpi
-               DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points
-                  zl = gdept_0(ji,jj,jk)
-                  IF(     zl < gdept_1d(1  ) ) THEN          ! above the first level of data
-                     ztp(jk) =  ptsd(ji,jj,1    ,jp_tem)
-                     zsp(jk) =  ptsd(ji,jj,1    ,jp_sal)
-                  ELSEIF( zl > gdept_1d(jpk) ) THEN          ! below the last level of data
-                     ztp(jk) =  ptsd(ji,jj,jpkm1,jp_tem)
-                     zsp(jk) =  ptsd(ji,jj,jpkm1,jp_sal)
-                  ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1
-                     DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1)
-                        IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN
-                           zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk))
-                           ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi 
-                           zsp(jk) = ptsd(ji,jj,jkk,jp_sal) + ( ptsd(ji,jj,jkk+1,jp_sal) - ptsd(ji,jj,jkk,jp_sal) ) * zi
-                        ENDIF
-                     END DO
-                  ENDIF
-               END DO
-               DO jk = 1, jpkm1
-                  ptsd(ji,jj,jk,jp_tem) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord
-                  ptsd(ji,jj,jk,jp_sal) = zsp(jk) * tmask(ji,jj,jk)
-               END DO
-               ptsd(ji,jj,jpk,jp_tem) = 0._wp
-               ptsd(ji,jj,jpk,jp_sal) = 0._wp
+         DO_2D_11_11
+            DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points
+               zl = gdept_0(ji,jj,jk)
+               IF(     zl < gdept_1d(1  ) ) THEN          ! above the first level of data
+                  ztp(jk) =  ptsd(ji,jj,1    ,jp_tem)
+                  zsp(jk) =  ptsd(ji,jj,1    ,jp_sal)
+               ELSEIF( zl > gdept_1d(jpk) ) THEN          ! below the last level of data
+                  ztp(jk) =  ptsd(ji,jj,jpkm1,jp_tem)
+                  zsp(jk) =  ptsd(ji,jj,jpkm1,jp_sal)
+               ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1
+                  DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1)
+                     IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN
+                        zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk))
+                        ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi 
+                        zsp(jk) = ptsd(ji,jj,jkk,jp_sal) + ( ptsd(ji,jj,jkk+1,jp_sal) - ptsd(ji,jj,jkk,jp_sal) ) * zi
+                     ENDIF
+                  END DO
+               ENDIF
             END DO
-         END DO
+            DO jk = 1, jpkm1
+               ptsd(ji,jj,jk,jp_tem) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord
+               ptsd(ji,jj,jk,jp_sal) = zsp(jk) * tmask(ji,jj,jk)
+            END DO
+            ptsd(ji,jj,jpk,jp_tem) = 0._wp
+            ptsd(ji,jj,jpk,jp_sal) = 0._wp
+         END_2D
          ! 
       ELSE                                !==   z- or zps- coordinate   ==!
@@ -221,20 +219,18 @@
          !
          IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  ik = mbkt(ji,jj) 
-                  IF( ik > 1 ) THEN
-                     zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
-                     ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik-1,jp_tem)
-                     ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik-1,jp_sal)
-                  ENDIF
-                  ik = mikt(ji,jj)
-                  IF( ik > 1 ) THEN
-                     zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 
-                     ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik+1,jp_tem)
-                     ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik+1,jp_sal)
-                  END IF
-               END DO
-            END DO
+            DO_2D_11_11
+               ik = mbkt(ji,jj) 
+               IF( ik > 1 ) THEN
+                  zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
+                  ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik-1,jp_tem)
+                  ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik-1,jp_sal)
+               ENDIF
+               ik = mikt(ji,jj)
+               IF( ik > 1 ) THEN
+                  zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 
+                  ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik+1,jp_tem)
+                  ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik+1,jp_sal)
+               END IF
+            END_2D
          ENDIF
          !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/iscplhsb.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/iscplhsb.F90	(revision 12384)
+++ 	(revision )
@@ -1,324 +1,0 @@
-MODULE iscplhsb
-   !!======================================================================
-   !!                       ***  MODULE  iscplhsb  ***
-   !! Ocean forcing: ice sheet/ocean coupling (conservation)
-   !!=====================================================================
-   !! History :  NEMO  ! 2015-01 P. Mathiot: original 
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   iscpl_alloc    : variable allocation
-   !!   iscpl_hsb      : compute and store the input of heat/salt/volume 
-   !!                    into the system due to the coupling process
-   !!   iscpl_div      : correction of divergence to keep volume conservation
-   !!----------------------------------------------------------------------
-   USE oce             ! global tra/dyn variable
-   USE dom_oce         ! ocean space and time domain
-   USE domwri          ! ocean space and time domain
-   USE domngb          ! 
-   USE phycst          ! physical constants
-   USE sbc_oce         ! surface boundary condition variables
-   USE iscplini        ! 
-   !
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! MPP library
-   USE lib_fortran     ! MPP library
-   USE lbclnk          !
-
-   IMPLICIT NONE
-   PRIVATE
-   
-   PUBLIC   iscpl_div   
-   PUBLIC   iscpl_cons       
-   !! * Substitutions  
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id$
-   !! Software governed by the CeCILL license (see ./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE iscpl_cons(ptmask_b, psmask_b, pe3t_b, pts_flx, pvol_flx, prdt_iscpl)
-      !!---------------------------------------------------------------------- 
-      !!                   ***  ROUTINE iscpl_cons  ***
-      !! 
-      !! ** Purpose :   compute input into the system during the coupling step
-      !!                compute the correction term
-      !!                compute where the correction have to be applied
-      !! 
-      !! ** Method  :   compute tsn*e3t-tsb*e3tb and e3t-e3t_b
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: ptmask_b    !! mask before
-      REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: pe3t_b      !! scale factor before
-      REAL(wp), DIMENSION(:,:    ), INTENT(in ) :: psmask_b    !! mask before
-      REAL(wp), DIMENSION(:,:,:,:), INTENT(out) :: pts_flx     !! corrective flux to have tracer conservation
-      REAL(wp), DIMENSION(:,:,:  ), INTENT(out) :: pvol_flx    !! corrective flux to have volume conservation
-      REAL(wp),                     INTENT(in ) :: prdt_iscpl  !! coupling period 
-      !
-      INTEGER  ::   ji  , jj  , jk           ! loop index
-      INTEGER  ::   jip1, jim1, jjp1, jjm1
-      REAL(wp) ::   summsk, zsum , zsumn, zjip1_ratio  , zjim1_ratio, zdtem, zde3t, z1_rdtiscpl
-      REAL(wp) ::   zarea , zsum1, zsumb, zjjp1_ratio  , zjjm1_ratio, zdsal
-      REAL(wp), DIMENSION(jpi,jpj)        ::   zdssh   ! workspace
-      REAL(wp), DIMENSION(:), ALLOCATABLE ::   zlon, zlat
-      REAL(wp), DIMENSION(:), ALLOCATABLE ::   zcorr_vol, zcorr_tem, zcorr_sal
-      INTEGER , DIMENSION(:), ALLOCATABLE ::   ixpts, iypts, izpts, inpts
-      INTEGER :: jpts, npts
-      !!----------------------------------------------------------------------
-
-      ! get imbalance (volume heat and salt)
-      ! initialisation difference
-      zde3t = 0._wp   ;   zdsal = 0._wp   ;   zdtem = 0._wp
-
-      ! initialisation correction term
-      pvol_flx(:,:,:  ) = 0._wp
-      pts_flx (:,:,:,:) = 0._wp
-      
-      z1_rdtiscpl = 1._wp / prdt_iscpl 
-
-      ! mask tsn and tsb 
-      tsb(:,:,:,jp_tem) = tsb(:,:,:,jp_tem) * ptmask_b(:,:,:)
-      tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) *  tmask  (:,:,:)
-      tsb(:,:,:,jp_sal) = tsb(:,:,:,jp_sal) * ptmask_b(:,:,:)
-      tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) *  tmask  (:,:,:)
-
-      !==============================================================================
-      ! diagnose the heat, salt and volume input and compute the correction variable
-      !==============================================================================
-
-      ! 
-      zdssh(:,:) = sshn(:,:) * ssmask(:,:) - sshb(:,:) * psmask_b(:,:)
-      IF (.NOT. ln_linssh ) zdssh = 0.0_wp ! already included in the levels by definition
-      
-      DO jk = 1,jpk-1
-         DO jj = 2,jpj-1
-            DO ji = fs_2,fs_jpim1
-               IF (tmask_h(ji,jj) == 1._wp) THEN
-
-                  ! volume differences
-                  zde3t = e3t_n(ji,jj,jk) * tmask(ji,jj,jk) - pe3t_b(ji,jj,jk) * ptmask_b(ji,jj,jk)
-
-                  ! heat diff
-                  zdtem = tsn(ji,jj,jk,jp_tem) * e3t_n(ji,jj,jk) *  tmask  (ji,jj,jk)   &
-                        - tsb(ji,jj,jk,jp_tem) * pe3t_b (ji,jj,jk) * ptmask_b(ji,jj,jk)
-                  ! salt diff
-                  zdsal = tsn(ji,jj,jk,jp_sal) * e3t_n(ji,jj,jk) *  tmask  (ji,jj,jk)   &
-                        - tsb(ji,jj,jk,jp_sal) * pe3t_b (ji,jj,jk) * ptmask_b(ji,jj,jk)
-               
-                  ! shh changes
-                  IF ( ptmask_b(ji,jj,jk) == 1._wp .OR. tmask(ji,jj,jk) == 1._wp ) THEN 
-                     zde3t = zde3t + zdssh(ji,jj) ! zdssh = 0 if vvl
-                     zdssh(ji,jj) = 0._wp
-                  END IF
-
-                  ! volume, heat and salt differences in each cell 
-                  pvol_flx(ji,jj,jk)       =   pvol_flx(ji,jj,jk)        + zde3t * z1_rdtiscpl
-                  pts_flx (ji,jj,jk,jp_sal)=   pts_flx (ji,jj,jk,jp_sal) + zdsal * z1_rdtiscpl 
-                  pts_flx (ji,jj,jk,jp_tem)=   pts_flx (ji,jj,jk,jp_tem) + zdtem * z1_rdtiscpl
-
-                  ! case where we close a cell: check if the neighbour cells are wet 
-                  IF ( tmask(ji,jj,jk) == 0._wp .AND. ptmask_b(ji,jj,jk) == 1._wp ) THEN
-
-                     jip1=ji+1 ; jim1=ji-1 ; jjp1=jj+1 ; jjm1=jj-1 ;
-
-                     zsum =   e1e2t(ji  ,jjp1) * tmask(ji  ,jjp1,jk) + e1e2t(ji  ,jjm1) * tmask(ji  ,jjm1,jk) &
-                       &    + e1e2t(jim1,jj  ) * tmask(jim1,jj  ,jk) + e1e2t(jip1,jj  ) * tmask(jip1,jj  ,jk)
-
-                     IF ( zsum /= 0._wp ) THEN
-                        zjip1_ratio   = e1e2t(jip1,jj  ) * tmask(jip1,jj  ,jk) / zsum
-                        zjim1_ratio   = e1e2t(jim1,jj  ) * tmask(jim1,jj  ,jk) / zsum
-                        zjjp1_ratio   = e1e2t(ji  ,jjp1) * tmask(ji  ,jjp1,jk) / zsum
-                        zjjm1_ratio   = e1e2t(ji  ,jjm1) * tmask(ji  ,jjm1,jk) / zsum
-
-                        pvol_flx(ji  ,jjp1,jk       ) = pvol_flx(ji  ,jjp1,jk       ) + pvol_flx(ji,jj,jk       ) * zjjp1_ratio
-                        pvol_flx(ji  ,jjm1,jk       ) = pvol_flx(ji  ,jjm1,jk       ) + pvol_flx(ji,jj,jk       ) * zjjm1_ratio
-                        pvol_flx(jip1,jj  ,jk       ) = pvol_flx(jip1,jj  ,jk       ) + pvol_flx(ji,jj,jk       ) * zjip1_ratio
-                        pvol_flx(jim1,jj  ,jk       ) = pvol_flx(jim1,jj  ,jk       ) + pvol_flx(ji,jj,jk       ) * zjim1_ratio
-                        pts_flx (ji  ,jjp1,jk,jp_sal) = pts_flx (ji  ,jjp1,jk,jp_sal) + pts_flx (ji,jj,jk,jp_sal) * zjjp1_ratio
-                        pts_flx (ji  ,jjm1,jk,jp_sal) = pts_flx (ji  ,jjm1,jk,jp_sal) + pts_flx (ji,jj,jk,jp_sal) * zjjm1_ratio
-                        pts_flx (jip1,jj  ,jk,jp_sal) = pts_flx (jip1,jj  ,jk,jp_sal) + pts_flx (ji,jj,jk,jp_sal) * zjip1_ratio
-                        pts_flx (jim1,jj  ,jk,jp_sal) = pts_flx (jim1,jj  ,jk,jp_sal) + pts_flx (ji,jj,jk,jp_sal) * zjim1_ratio
-                        pts_flx (ji  ,jjp1,jk,jp_tem) = pts_flx (ji  ,jjp1,jk,jp_tem) + pts_flx (ji,jj,jk,jp_tem) * zjjp1_ratio
-                        pts_flx (ji  ,jjm1,jk,jp_tem) = pts_flx (ji  ,jjm1,jk,jp_tem) + pts_flx (ji,jj,jk,jp_tem) * zjjm1_ratio
-                        pts_flx (jip1,jj  ,jk,jp_tem) = pts_flx (jip1,jj  ,jk,jp_tem) + pts_flx (ji,jj,jk,jp_tem) * zjip1_ratio
-                        pts_flx (jim1,jj  ,jk,jp_tem) = pts_flx (jim1,jj  ,jk,jp_tem) + pts_flx (ji,jj,jk,jp_tem) * zjim1_ratio
-
-                        ! set to 0 the cell we distributed over neigbourg cells
-                        pvol_flx(ji,jj,jk       ) = 0._wp
-                        pts_flx (ji,jj,jk,jp_sal) = 0._wp
-                        pts_flx (ji,jj,jk,jp_tem) = 0._wp
-
-                     ELSE IF (zsum == 0._wp ) THEN
-                        ! case where we close a cell and no adjacent cell open
-                        ! check if the cell beneath is wet
-                        IF ( tmask(ji,jj,jk+1) == 1._wp ) THEN
-                           pvol_flx(ji,jj,jk+1)       =  pvol_flx(ji,jj,jk+1)        + pvol_flx(ji,jj,jk)
-                           pts_flx (ji,jj,jk+1,jp_sal)=  pts_flx (ji,jj,jk+1,jp_sal) + pts_flx (ji,jj,jk,jp_sal)
-                           pts_flx (ji,jj,jk+1,jp_tem)=  pts_flx (ji,jj,jk+1,jp_tem) + pts_flx (ji,jj,jk,jp_tem)
-
-                           ! set to 0 the cell we distributed over neigbourg cells
-                           pvol_flx(ji,jj,jk       ) = 0._wp
-                           pts_flx (ji,jj,jk,jp_sal) = 0._wp
-                           pts_flx (ji,jj,jk,jp_tem) = 0._wp
-                        ELSE
-                        ! case no adjacent cell on the horizontal and on the vertical
-                           IF ( lwp ) THEN   ! JMM : cAution this warning may occur on any mpp subdomain but numout is only
-                                             ! open for narea== 1 (lwp=T)
-                           WRITE(numout,*) 'W A R N I N G iscpl: no adjacent cell on the vertical and horizontal'
-                           WRITE(numout,*) '                     ',mig(ji),' ',mjg(jj),' ',jk
-                           WRITE(numout,*) '                     ',ji,' ',jj,' ',jk,' ',narea
-                           WRITE(numout,*) ' we are now looking for the closest wet cell on the horizontal '
-                           ENDIF
-                        ! We deal with these points later.
-                        END IF
-                     END IF
-                  END IF
-               END IF
-            END DO
-         END DO
-      END DO
-
-!!gm  ERROR !!!!
-!!    juste use tmask_i  or in case of ISF smask_i (to be created to compute the sum without halos)
-!
-!      CALL lbc_sum(pvol_flx(:,:,:       ),'T',1.)
-!      CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1.)
-!      CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1.)
-      CALL ctl_stop( 'STOP', ' iscpl_cons:   please modify this MODULE !' )
-!!gm end
-      ! if no neighbour wet cell in case of 2close a cell", need to find the nearest wet point 
-      ! allocation and initialisation of the list of problematic point
-      ALLOCATE( inpts(jpnij) )
-      inpts(:) = 0
-
-      ! fill narea location with the number of problematic point
-      DO jk = 1,jpk-1
-         DO jj = 2,jpj-1
-            DO ji = fs_2,fs_jpim1
-               IF (     ptmask_b(ji,jj,jk) == 1._wp .AND. tmask(ji,jj,jk+1)  == 0._wp .AND. tmask_h(ji,jj) == 1._wp  &
-                  .AND. SUM(tmask(ji-1:ji+1,jj,jk)) + SUM(tmask(ji,jj-1:jj+1,jk)) == 0._wp) THEN
-                  inpts(narea) = inpts(narea) + 1 
-               END IF
-            END DO
-         END DO
-      END DO
-
-      ! build array of total problematic point on each cpu (share to each cpu)
-      CALL mpp_max('iscplhsb', inpts,jpnij) 
-
-      ! size of the new variable
-      npts  = SUM(inpts)    
-      
-      ! allocation of the coordinates, correction, index vector for the problematic points 
-      ALLOCATE(ixpts(npts), iypts(npts), izpts(npts), zcorr_vol(npts), zcorr_sal(npts), zcorr_tem(npts), zlon(npts), zlat(npts))
-      ixpts(:) = -9999 ; iypts(:) = -9999 ; izpts(:) = -9999 ; zlon(:) = -1.0e20_wp ; zlat(:) = -1.0e20_wp
-      zcorr_vol(:) = -1.0e20_wp
-      zcorr_sal(:) = -1.0e20_wp
-      zcorr_tem(:) = -1.0e20_wp
-
-      ! fill new variable
-      jpts = SUM(inpts(1:narea-1))
-      DO jk = 1,jpk-1
-         DO jj = 2,jpj-1
-            DO ji = fs_2,fs_jpim1
-               IF (     ptmask_b(ji,jj,jk) == 1._wp .AND. tmask(ji,jj,jk+1)  == 0._wp .AND. tmask_h(ji,jj) == 1._wp  &
-                  .AND. SUM(tmask(ji-1:ji+1,jj,jk)) + SUM(tmask(ji,jj-1:jj+1,jk)) == 0._wp) THEN
-                  jpts = jpts + 1  ! positioning in the inpts vector for the area narea
-                  ixpts(jpts) = ji           ; iypts(jpts) = jj ; izpts(jpts) = jk
-                  zlon (jpts) = glamt(ji,jj) ; zlat (jpts) = gphit(ji,jj)
-                  zcorr_vol(jpts) = pvol_flx(ji,jj,jk)
-                  zcorr_sal(jpts) = pts_flx (ji,jj,jk,jp_sal)
-                  zcorr_tem(jpts) = pts_flx (ji,jj,jk,jp_tem)
-
-                  ! set flx to 0 (safer)
-                  pvol_flx(ji,jj,jk       ) = 0.0_wp
-                  pts_flx (ji,jj,jk,jp_sal) = 0.0_wp
-                  pts_flx (ji,jj,jk,jp_tem) = 0.0_wp
-               END IF
-            END DO
-         END DO
-      END DO
-
-      ! build array of total problematic point on each cpu (share to each cpu)
-      ! point coordinates
-      CALL mpp_max('iscplhsb', zlat ,npts)
-      CALL mpp_max('iscplhsb', zlon ,npts)
-      CALL mpp_max('iscplhsb', izpts,npts)
-
-      ! correction values 
-      CALL mpp_max('iscplhsb', zcorr_vol,npts)
-      CALL mpp_max('iscplhsb', zcorr_sal,npts)
-      CALL mpp_max('iscplhsb', zcorr_tem,npts)
-
-      ! put correction term in the closest cell          
-      DO jpts = 1,npts
-         CALL dom_ngb(zlon(jpts), zlat(jpts), ixpts(jpts), iypts(jpts),'T', izpts(jpts))
-         DO jj = mj0(iypts(jpts)),mj1(iypts(jpts))
-            DO ji = mi0(ixpts(jpts)),mi1(ixpts(jpts))
-               jk = izpts(jpts)
-
-               IF (tmask_h(ji,jj) == 1._wp) THEN
-                  ! correct the vol_flx in the closest cell
-                  pvol_flx(ji,jj,jk)        =  pvol_flx(ji,jj,jk       ) + zcorr_vol(jpts)
-                  pts_flx (ji,jj,jk,jp_sal) =  pts_flx (ji,jj,jk,jp_sal) + zcorr_sal(jpts)
-                  pts_flx (ji,jj,jk,jp_tem) =  pts_flx (ji,jj,jk,jp_tem) + zcorr_tem(jpts)
-
-                  ! set correction to 0
-                  zcorr_vol(jpts) = 0.0_wp
-                  zcorr_sal(jpts) = 0.0_wp
-                  zcorr_tem(jpts) = 0.0_wp
-               END IF
-            END DO
-         END DO
-      END DO
-
-      ! deallocate variables 
-      DEALLOCATE(inpts)
-      DEALLOCATE(ixpts, iypts, izpts, zcorr_vol, zcorr_sal, zcorr_tem, zlon, zlat)
-    
-      ! add contribution store on the hallo (lbclnk remove one of the contribution)
-      pvol_flx(:,:,:       ) = pvol_flx(:,:,:       ) * tmask(:,:,:)
-      pts_flx (:,:,:,jp_sal) = pts_flx (:,:,:,jp_sal) * tmask(:,:,:)
-      pts_flx (:,:,:,jp_tem) = pts_flx (:,:,:,jp_tem) * tmask(:,:,:)
-
-!!gm  ERROR !!!!
-!!    juste use tmask_i  or in case of ISF smask_i (to be created to compute the sum without halos)
-!
-!      ! compute sum over the halo and set it to 0.
-!      CALL lbc_sum(pvol_flx(:,:,:       ),'T',1._wp)
-!      CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1._wp)
-!      CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1._wp)
-!!gm end
-
-      !
-   END SUBROUTINE iscpl_cons
-
-
-   SUBROUTINE iscpl_div( phdivn )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE iscpl_div  ***
-      !!
-      !! ** Purpose :   update the horizontal divergenc
-      !!
-      !! ** Method  :
-      !!                CAUTION : iscpl is positive (inflow) and expressed in m/s
-      !!
-      !! ** Action  :   phdivn   increase by the iscpl correction term
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   phdivn   ! horizontal divergence
-      !!
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      !!----------------------------------------------------------------------
-      !
-      DO jk = 1, jpk
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               phdivn(ji,jj,jk) = phdivn(ji,jj,jk) + hdiv_iscpl(ji,jj,jk) / e3t_n(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-      !
-   END SUBROUTINE iscpl_div
-
-END MODULE iscplhsb
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/iscplini.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/iscplini.F90	(revision 12384)
+++ 	(revision )
@@ -1,90 +1,0 @@
-MODULE iscplini
-   !!======================================================================
-   !!                       ***  MODULE  sbciscpl  ***
-   !! Ocean forcing:  ?????
-   !!=====================================================================
-   !! History :  NEMO  ! 2015-01 P. Mathiot: original 
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   iscpl_init     : initialisation routine (namelist)
-   !!   iscpl_alloc    : allocation of correction variables
-   !!----------------------------------------------------------------------
-   USE oce             ! global tra/dyn variable
-   USE dom_oce         ! ocean space and time domain
-   !
-   USE lib_mpp         ! MPP library
-   USE lib_fortran     ! MPP library
-   USE in_out_manager  ! I/O manager
-
-   IMPLICIT NONE
-   PRIVATE
-   
-   PUBLIC   iscpl_init      
-   PUBLIC   iscpl_alloc 
-   
-   !                                 !!* namsbc_iscpl namelist *
-   LOGICAL , PUBLIC ::   ln_hsb       !:
-   INTEGER , PUBLIC ::   nn_fiscpl    !:
-   INTEGER , PUBLIC ::   nn_drown     !:
-   
-   INTEGER , PUBLIC ::   nstp_iscpl   !:
-   REAL(wp), PUBLIC ::   rdt_iscpl    !: 
-   !
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   hdiv_iscpl   !:
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   htsc_iscpl   !:
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id$
-   !! Software governed by the CeCILL license (see ./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   INTEGER FUNCTION iscpl_alloc()
-      !!----------------------------------------------------------------------
-      !!                ***  ROUTINE sbc_iscpl_alloc  ***
-      !!----------------------------------------------------------------------
-      ALLOCATE( htsc_iscpl(jpi,jpj,jpk,jpts) , hdiv_iscpl(jpi,jpj,jpk) , STAT=iscpl_alloc )
-         !
-      CALL mpp_sum ( 'iscplini', iscpl_alloc )
-      IF( iscpl_alloc > 0 )   CALL ctl_warn('iscpl_alloc: allocation of arrays failed')
-   END FUNCTION iscpl_alloc
-
-
-   SUBROUTINE iscpl_init()
-      !!----------------------------------------------------------------------
-      !!----------------------------------------------------------------------
-      INTEGER ::   ios           ! Local integer output status for namelist read
-      NAMELIST/namsbc_iscpl/ nn_fiscpl, ln_hsb, nn_drown
-      !!----------------------------------------------------------------------
-      !
-      nn_fiscpl = 0
-      ln_hsb    = .FALSE.
-      REWIND( numnam_ref )              ! Namelist namsbc_iscpl in reference namelist : Ice sheet coupling
-      READ  ( numnam_ref, namsbc_iscpl, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_iscpl in reference namelist' )
-      REWIND( numnam_cfg )              ! Namelist namsbc_iscpl in configuration namelist : Ice Sheet coupling
-      READ  ( numnam_cfg, namsbc_iscpl, IOSTAT = ios, ERR = 902 )
-902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_iscpl in configuration namelist' )
-      IF(lwm) WRITE ( numond, namsbc_iscpl )
-      !
-      nstp_iscpl=MIN( nn_fiscpl, nitend-nit000+1 ) ! the coupling period have to be less or egal than the total number of time step
-      rdt_iscpl = nstp_iscpl * rn_rdt
-      !
-      IF (lwp) THEN
-         WRITE(numout,*) 'iscpl_rst:'
-         WRITE(numout,*) '~~~~~~~~~'
-         WRITE(numout,*) ' coupling     flag (ln_iscpl )            = ', ln_iscpl
-         WRITE(numout,*) ' conservation flag (ln_hsb   )            = ', ln_hsb
-         WRITE(numout,*) ' nb of stp for cons (rn_fiscpl)           = ', nstp_iscpl
-         IF (nstp_iscpl .NE. nn_fiscpl) WRITE(numout,*) 'W A R N I N G: nb of stp for cons has been modified &
-            &                                           (larger than run length)'
-         WRITE(numout,*) ' coupling time step                       = ', rdt_iscpl
-         WRITE(numout,*) ' number of call of the extrapolation loop = ', nn_drown
-      ENDIF
-      !
-   END SUBROUTINE iscpl_init
-
-   !!======================================================================
-END MODULE iscplini
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/iscplrst.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/iscplrst.F90	(revision 12384)
+++ 	(revision )
@@ -1,407 +1,0 @@
-MODULE iscplrst
-   !!======================================================================
-   !!                       ***  MODULE  iscplrst  ***
-   !! Ocean forcing: update the restart file in case of ice sheet/ocean coupling
-   !!=====================================================================
-   !! History :  NEMO  ! 2015-01 P. Mathiot: original 
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   iscpl_stp          : step management
-   !!   iscpl_rst_interpol : restart interpolation in case of coupling with ice sheet
-   !!----------------------------------------------------------------------
-   USE oce             ! global tra/dyn variable
-   USE dom_oce         ! ocean space and time domain
-   USE domwri          ! ocean space and time domain
-   USE domvvl   , ONLY : dom_vvl_interpol
-   USE phycst          ! physical constants
-   USE sbc_oce         ! surface boundary condition variables
-   USE iscplini        ! ice sheet coupling: initialisation
-   USE iscplhsb        ! ice sheet coupling: conservation
-   !
-   USE in_out_manager  ! I/O manager
-   USE iom             ! I/O module
-   USE lib_mpp         ! MPP library
-   USE lib_fortran     ! MPP library
-   USE lbclnk          ! communication
-
-   IMPLICIT NONE
-   PRIVATE
-   
-   PUBLIC   iscpl_stp          ! step management 
-   !!
-   !! * Substitutions  
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id$
-   !! Software governed by the CeCILL license (see ./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE iscpl_stp
-      !!---------------------------------------------------------------------- 
-      !!                   ***  ROUTINE iscpl_stp  ***
-      !! 
-      !! ** Purpose : compute initialisation
-      !!              compute extrapolation of restart variable un, vn, tsn, sshn (wetting/drying)   
-      !!              compute correction term if needed
-      !! 
-      !!----------------------------------------------------------------------
-      INTEGER  ::   inum0
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zsmask_b
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztmask_b, zumask_b, zvmask_b
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze3t_b  , ze3u_b  , ze3v_b  
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdepw_b
-      CHARACTER(20) :: cfile
-      !!----------------------------------------------------------------------
-      !
-      !                       ! get restart variable
-      CALL iom_get( numror, jpdom_autoglo, 'tmask'  , ztmask_b, ldxios = lrxios   ) ! need to extrapolate T/S
-      CALL iom_get( numror, jpdom_autoglo, 'umask'  , zumask_b, ldxios = lrxios   ) ! need to correct barotropic velocity
-      CALL iom_get( numror, jpdom_autoglo, 'vmask'  , zvmask_b, ldxios = lrxios   ) ! need to correct barotropic velocity
-      CALL iom_get( numror, jpdom_autoglo, 'smask'  , zsmask_b, ldxios = lrxios   ) ! need to correct barotropic velocity
-      CALL iom_get( numror, jpdom_autoglo, 'e3t_n'  , ze3t_b(:,:,:), ldxios = lrxios )  ! need to compute temperature correction
-      CALL iom_get( numror, jpdom_autoglo, 'e3u_n'  , ze3u_b(:,:,:), ldxios = lrxios )  ! need to correct barotropic velocity
-      CALL iom_get( numror, jpdom_autoglo, 'e3v_n'  , ze3v_b(:,:,:), ldxios = lrxios )  ! need to correct barotropic velocity
-      CALL iom_get( numror, jpdom_autoglo, 'gdepw_n', zdepw_b(:,:,:), ldxios = lrxios ) ! need to interpol vertical profile (vvl)
-      !
-      CALL iscpl_init()       ! read namelist
-      !                       ! Extrapolation/interpolation of modify cell and new cells ... (maybe do it later after domvvl)
-      CALL iscpl_rst_interpol( ztmask_b, zumask_b, zvmask_b, zsmask_b, ze3t_b, ze3u_b, ze3v_b, zdepw_b )
-      !
-      IF ( ln_hsb ) THEN      ! compute correction if conservation needed
-         IF( iscpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'rst_iscpl : unable to allocate rst_iscpl arrays' )
-         CALL iscpl_cons(ztmask_b, zsmask_b, ze3t_b, htsc_iscpl, hdiv_iscpl, rdt_iscpl)
-      END IF
-         
-      !                       ! create  a domain file
-      IF( ln_meshmask .AND. ln_iscpl )   CALL dom_wri
-      !
-      IF ( ln_hsb ) THEN
-         cfile='correction'
-         cfile = TRIM( cfile )
-         CALL iom_open  ( cfile, inum0, ldwrt = .TRUE. )
-         CALL iom_rstput( 0, 0, inum0, 'vol_cor', hdiv_iscpl(:,:,:) )
-         CALL iom_rstput( 0, 0, inum0, 'tem_cor', htsc_iscpl(:,:,:,jp_tem) )
-         CALL iom_rstput( 0, 0, inum0, 'sal_cor', htsc_iscpl(:,:,:,jp_sal) )
-         CALL iom_close ( inum0 )
-      END IF
-      !
-      neuler = 0              ! next step is an euler time step
-      !
-      !                       ! set _b and _n variables equal
-      tsb (:,:,:,:) = tsn (:,:,:,:)
-      ub  (:,:,:)   = un  (:,:,:)
-      vb  (:,:,:)   = vn  (:,:,:)
-      sshb(:,:)     = sshn(:,:)
-      !
-      !                       ! set _b and _n vertical scale factor equal
-      e3t_b (:,:,:) = e3t_n (:,:,:)
-      e3u_b (:,:,:) = e3u_n (:,:,:)
-      e3v_b (:,:,:) = e3v_n (:,:,:)
-      !
-      e3uw_b (:,:,:) = e3uw_n (:,:,:)
-      e3vw_b (:,:,:) = e3vw_n (:,:,:)
-      gdept_b(:,:,:) = gdept_n(:,:,:)
-      gdepw_b(:,:,:) = gdepw_n(:,:,:)
-      hu_b   (:,:)   = hu_n   (:,:)
-      hv_b   (:,:)   = hv_n   (:,:)
-      r1_hu_b(:,:)   = r1_hu_n(:,:)
-      r1_hv_b(:,:)   = r1_hv_n(:,:)
-      !
-   END SUBROUTINE iscpl_stp
-
-
-   SUBROUTINE iscpl_rst_interpol (ptmask_b, pumask_b, pvmask_b, psmask_b, pe3t_b, pe3u_b, pe3v_b, pdepw_b)
-      !!---------------------------------------------------------------------- 
-      !!                   ***  ROUTINE iscpl_rst_interpol  ***
-      !! 
-      !! ** Purpose :   compute new tn, sn, un, vn and sshn in case of evolving geometry of ice shelves 
-      !!                compute 2d fields of heat, salt and volume correction
-      !! 
-      !! ** Method  :   tn, sn : extrapolation from neigbourg cells
-      !!                un, vn : fill with 0 velocity and keep barotropic transport by modifing surface velocity or adjacent velocity
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: ptmask_b, pumask_b, pvmask_b    !! mask before
-      REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: pe3t_b  , pe3u_b  , pe3v_b      !! scale factor before
-      REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: pdepw_b                         !! depth w before
-      REAL(wp), DIMENSION(:,:    ), INTENT(in ) :: psmask_b                        !! mask before
-      !!
-      INTEGER :: ji, jj, jk, iz          !! loop index
-      INTEGER :: jip1, jim1, jjp1, jjm1, jkp1, jkm1
-      !!
-      REAL(wp):: summsk, zsum, zsum1, zarea, zsumn, zsumb
-      REAL(wp):: zdz, zdzm1, zdzp1
-      !!
-      REAL(wp), DIMENSION(jpi,jpj)          :: zdmask , zsmask0, zucorr, zbub, zbun, zssh0, zhu1, zde3t
-      REAL(wp), DIMENSION(jpi,jpj)          :: zdsmask, zsmask1, zvcorr, zbvb, zbvn, zssh1, zhv1
-      REAL(wp), DIMENSION(jpi,jpj,jpk)      :: ztmask0, zwmaskn, ztrp
-      REAL(wp), DIMENSION(jpi,jpj,jpk)      :: ztmask1, zwmaskb, ztmp3d
-      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts0
-      !!----------------------------------------------------------------------
-      !
-      !                 ! mask value to be sure
-      tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) * ptmask_b(:,:,:)
-      tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) * ptmask_b(:,:,:)
-      !
-      !                 ! compute wmask
-      zwmaskn(:,:,1) = tmask   (:,:,1)
-      zwmaskb(:,:,1) = ptmask_b(:,:,1)
-      DO jk = 2,jpk
-         zwmaskn(:,:,jk) =  tmask  (:,:,jk) *  tmask  (:,:,jk-1)
-         zwmaskb(:,:,jk) = ptmask_b(:,:,jk) * ptmask_b(:,:,jk-1)
-      END DO
-      !    
-      !                 ! compute new ssh if we open a full water column (average of the closest neigbourgs)  
-      sshb (:,:)=sshn(:,:)
-      zssh0(:,:)=sshn(:,:)
-      zsmask0(:,:) = psmask_b(:,:)
-      zsmask1(:,:) = psmask_b(:,:)
-      DO iz = 1, 10                 ! need to be tuned (configuration dependent) (OK for ISOMIP+)
-         zdsmask(:,:) = ssmask(:,:)-zsmask0(:,:)
-         DO jj = 2,jpj-1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               jip1=ji+1; jim1=ji-1;
-               jjp1=jj+1; jjm1=jj-1;
-               summsk=(zsmask0(jip1,jj)+zsmask0(jim1,jj)+zsmask0(ji,jjp1)+zsmask0(ji,jjm1))
-               IF (zdsmask(ji,jj) == 1._wp .AND. summsk /= 0._wp) THEN
-                  sshn(ji,jj)=( zssh0(jip1,jj)*zsmask0(jip1,jj)     &
-                  &           + zssh0(jim1,jj)*zsmask0(jim1,jj)     &
-                  &           + zssh0(ji,jjp1)*zsmask0(ji,jjp1)     &
-                  &           + zssh0(ji,jjm1)*zsmask0(ji,jjm1))/summsk
-                  zsmask1(ji,jj)=1._wp
-               ENDIF
-            END DO
-         END DO
-         CALL lbc_lnk_multi( 'iscplrst', sshn, 'T', 1., zsmask1, 'T', 1. )
-         zssh0   = sshn
-         zsmask0 = zsmask1
-      END DO
-      sshn(:,:) = sshn(:,:) * ssmask(:,:)
-
-!=============================================================================
-!PM: Is this needed since introduction of VVL by default?
-      IF ( .NOT.ln_linssh ) THEN
-      ! Reconstruction of all vertical scale factors at now time steps
-      ! =============================================================================
-      ! Horizontal scale factor interpolations
-      ! --------------------------------------
-         DO jk = 1,jpk
-            DO jj=1,jpj
-               DO ji=1,jpi
-                  IF (tmask(ji,jj,1) == 0._wp .OR. ptmask_b(ji,jj,1) == 0._wp) THEN
-                     e3t_n(ji,jj,jk) = e3t_0(ji,jj,jk) * ( 1._wp + sshn(ji,jj) /   &
-                     &   ( ht_0(ji,jj) + 1._wp - ssmask(ji,jj) ) * tmask(ji,jj,jk) )
-                  ENDIF
-               END DO
-            END DO
-         END DO
-         !
-         CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' )
-         CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' )
-         CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' )
-
-         ! Vertical scale factor interpolations
-         ! ------------------------------------
-         CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  )
-         CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' )
-         CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' )
-         
-         ! t- and w- points depth
-         ! ----------------------
-         gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)
-         gdepw_n(:,:,1) = 0.0_wp
-         gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)
-         DO jj = 1,jpj
-            DO ji = 1,jpi
-               DO jk = 2,mikt(ji,jj)-1
-                  gdept_n(ji,jj,jk) = gdept_0(ji,jj,jk)
-                  gdepw_n(ji,jj,jk) = gdepw_0(ji,jj,jk)
-                  gde3w_n(ji,jj,jk) = gdept_0(ji,jj,jk) - sshn(ji,jj)
-               END DO
-               IF (mikt(ji,jj) > 1) THEN
-                  jk = mikt(ji,jj)
-                  gdept_n(ji,jj,jk) = gdepw_0(ji,jj,jk) + 0.5_wp * e3w_n(ji,jj,jk)
-                  gdepw_n(ji,jj,jk) = gdepw_0(ji,jj,jk)
-                  gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk  ) - sshn   (ji,jj)
-               END IF
-               DO jk = mikt(ji,jj)+1, jpk
-                  gdept_n(ji,jj,jk) = gdept_n(ji,jj,jk-1) + e3w_n(ji,jj,jk)
-                  gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1)
-                  gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk  ) - sshn (ji,jj)
-               END DO
-            END DO
-         END DO
-
-      ! t-, u- and v- water column thickness
-      ! ------------------------------------
-         ht_n(:,:) = 0._wp ; hu_n(:,:) = 0._wp ; hv_n(:,:) = 0._wp
-         DO jk = 1, jpkm1
-            hu_n(:,:) = hu_n(:,:) + e3u_n(:,:,jk) * umask(:,:,jk)
-            hv_n(:,:) = hv_n(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk)
-            ht_n(:,:) = ht_n(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk)
-         END DO
-         !                                        ! Inverse of the local depth
-         r1_hu_n(:,:) = 1._wp / ( hu_n(:,:) + 1._wp - ssumask(:,:) ) * ssumask(:,:)
-         r1_hv_n(:,:) = 1._wp / ( hv_n(:,:) + 1._wp - ssvmask(:,:) ) * ssvmask(:,:)
-
-      END IF
-
-!=============================================================================
-! compute velocity
-! compute velocity in order to conserve barotropic velocity (modification by poderation of the scale factor).
-      ub(:,:,:)=un(:,:,:)
-      vb(:,:,:)=vn(:,:,:)
-      DO jk = 1,jpk
-         DO jj = 1,jpj
-            DO ji = 1,jpi
-               un(ji,jj,jk) = ub(ji,jj,jk)*pe3u_b(ji,jj,jk)*pumask_b(ji,jj,jk)/e3u_n(ji,jj,jk)*umask(ji,jj,jk);
-               vn(ji,jj,jk) = vb(ji,jj,jk)*pe3v_b(ji,jj,jk)*pvmask_b(ji,jj,jk)/e3v_n(ji,jj,jk)*vmask(ji,jj,jk);
-            END DO
-         END DO
-      END DO
-
-! compute new velocity if we close a cell (check barotropic velocity and change velocity over the water column)
-! compute barotropic velocity now and after 
-      ztrp(:,:,:) = ub(:,:,:)*pe3u_b(:,:,:); 
-      zbub(:,:)   = SUM(ztrp,DIM=3)
-      ztrp(:,:,:) = vb(:,:,:)*pe3v_b(:,:,:); 
-      zbvb(:,:)   = SUM(ztrp,DIM=3)
-      ztrp(:,:,:) = un(:,:,:)*e3u_n(:,:,:); 
-      zbun(:,:)   = SUM(ztrp,DIM=3)
-      ztrp(:,:,:) = vn(:,:,:)*e3v_n(:,:,:); 
-      zbvn(:,:)   = SUM(ztrp,DIM=3)
-
-      ! new water column
-      zhu1=0.0_wp ;
-      zhv1=0.0_wp ;
-      DO jk  = 1,jpk
-        zhu1(:,:) = zhu1(:,:) + e3u_n(:,:,jk) * umask(:,:,jk)
-        zhv1(:,:) = zhv1(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk)
-      END DO
-      
-      ! compute correction      
-      zucorr = 0._wp
-      zvcorr = 0._wp
-      DO jj = 1,jpj
-         DO ji = 1,jpi
-            IF (zbun(ji,jj) /= zbub(ji,jj) .AND. zhu1(ji,jj) /= 0._wp ) THEN
-               zucorr(ji,jj) = (zbun(ji,jj) - zbub(ji,jj))/zhu1(ji,jj)
-            END IF
-            IF (zbvn(ji,jj) /= zbvb(ji,jj) .AND. zhv1(ji,jj) /= 0._wp ) THEN
-               zvcorr(ji,jj) = (zbvn(ji,jj) - zbvb(ji,jj))/zhv1(ji,jj)
-            END IF
-         END DO
-      END DO 
-      
-      ! update velocity
-      DO jk  = 1,jpk
-         un(:,:,jk)=(un(:,:,jk) - zucorr(:,:))*umask(:,:,jk)
-         vn(:,:,jk)=(vn(:,:,jk) - zvcorr(:,:))*vmask(:,:,jk)
-      END DO
-
-!=============================================================================
-      ! compute temp and salt
-      ! compute new tn and sn if we open a new cell
-      tsb (:,:,:,:) = tsn(:,:,:,:)
-      zts0(:,:,:,:) = tsn(:,:,:,:)
-      ztmask1(:,:,:) = ptmask_b(:,:,:)
-      ztmask0(:,:,:) = ptmask_b(:,:,:)
-      DO iz = 1,nn_drown ! resolution dependent (OK for ISOMIP+ case)
-          DO jk = 1,jpk-1
-              zdmask=tmask(:,:,jk)-ztmask0(:,:,jk);
-              DO jj = 2,jpj-1
-                 DO ji = fs_2,fs_jpim1
-                      jip1=ji+1; jim1=ji-1;
-                      jjp1=jj+1; jjm1=jj-1;
-                      summsk= (ztmask0(jip1,jj  ,jk)+ztmask0(jim1,jj  ,jk)+ztmask0(ji  ,jjp1,jk)+ztmask0(ji  ,jjm1,jk))
-                      IF (zdmask(ji,jj) == 1._wp .AND. summsk /= 0._wp) THEN
-                      !! horizontal basic extrapolation
-                         tsn(ji,jj,jk,1)=( zts0(jip1,jj  ,jk,1)*ztmask0(jip1,jj  ,jk) &
-                         &                +zts0(jim1,jj  ,jk,1)*ztmask0(jim1,jj  ,jk) &
-                         &                +zts0(ji  ,jjp1,jk,1)*ztmask0(ji  ,jjp1,jk) &
-                         &                +zts0(ji  ,jjm1,jk,1)*ztmask0(ji  ,jjm1,jk) ) / summsk
-                         tsn(ji,jj,jk,2)=( zts0(jip1,jj  ,jk,2)*ztmask0(jip1,jj  ,jk) &
-                         &                +zts0(jim1,jj  ,jk,2)*ztmask0(jim1,jj  ,jk) &
-                         &                +zts0(ji  ,jjp1,jk,2)*ztmask0(ji  ,jjp1,jk) &
-                         &                +zts0(ji  ,jjm1,jk,2)*ztmask0(ji  ,jjm1,jk) ) / summsk
-                         ztmask1(ji,jj,jk)=1
-                      ELSEIF (zdmask(ji,jj) == 1._wp .AND. summsk == 0._wp) THEN
-                      !! vertical extrapolation if horizontal extrapolation failed
-                         jkm1=max(1,jk-1) ; jkp1=min(jpk,jk+1)
-                         summsk=(ztmask0(ji,jj,jkm1)+ztmask0(ji,jj,jkp1))
-                         IF (zdmask(ji,jj) == 1._wp .AND. summsk /= 0._wp ) THEN
-                            tsn(ji,jj,jk,1)=( zts0(ji,jj,jkp1,1)*ztmask0(ji,jj,jkp1)     &
-                            &                +zts0(ji,jj,jkm1,1)*ztmask0(ji,jj,jkm1))/summsk
-                            tsn(ji,jj,jk,2)=( zts0(ji,jj,jkp1,2)*ztmask0(ji,jj,jkp1)     &
-                            &                +zts0(ji,jj,jkm1,2)*ztmask0(ji,jj,jkm1))/summsk
-                            ztmask1(ji,jj,jk)=1._wp
-                         END IF
-                      END IF
-                  END DO
-              END DO
-          END DO
-          
-          CALL lbc_lnk_multi( 'iscplrst', tsn(:,:,:,jp_tem), 'T', 1., tsn(:,:,:,jp_sal), 'T', 1., ztmask1, 'T', 1.)
-
-          ! update
-          zts0(:,:,:,:) = tsn(:,:,:,:)
-          ztmask0 = ztmask1
-
-      END DO
-
-      ! mask new tsn field
-      tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) * tmask(:,:,:)
-      tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) * tmask(:,:,:)
-
-      ! compute new T/S (interpolation) if vvl only for common wet cell in before and after wmask
-      !PM: Is this IF needed since change to VVL by default
-      IF (.NOT.ln_linssh) THEN
-         DO jk = 2,jpk-1
-            DO jj = 1,jpj
-               DO ji = 1,jpi
-                  IF (zwmaskn(ji,jj,jk) * zwmaskb(ji,jj,jk) == 1._wp .AND.   &
-                  &      (tmask(ji,jj,1)==0._wp .OR. ptmask_b(ji,jj,1)==0._wp) ) THEN
-                     !compute weight
-                     zdzp1 = MAX(0._wp,gdepw_n(ji,jj,jk+1) - pdepw_b(ji,jj,jk+1))
-                     zdz   =           gdepw_n(ji,jj,jk+1) - pdepw_b(ji,jj,jk  ) 
-                     zdzm1 = MAX(0._wp,pdepw_b(ji,jj,jk  ) - gdepw_n(ji,jj,jk  ))
-                     IF (zdz .LT. 0._wp) THEN 
-                        CALL ctl_stop( 'STOP', 'rst_iscpl : unable to compute the interpolation' )
-                     END IF
-                     tsn(ji,jj,jk,jp_tem) = ( zdzp1*tsb(ji,jj,jk+1,jp_tem)      &
-                        &                   + zdz  *tsb(ji,jj,jk  ,jp_tem)      &
-                        &                   + zdzm1*tsb(ji,jj,jk-1,jp_tem)      )/e3t_n(ji,jj,jk)
-                     tsn(ji,jj,jk,jp_sal) = ( zdzp1*tsb(ji,jj,jk+1,jp_sal)      &
-                        &                   + zdz  *tsb(ji,jj,jk  ,jp_sal)      &
-                        &                   + zdzm1*tsb(ji,jj,jk-1,jp_sal)      )/e3t_n(ji,jj,jk)
-                  END IF
-               END DO
-            END DO
-         END DO               
-      END IF
-
-      ! closed pool
-      ! -----------------------------------------------------------------------------------------
-      ! case we open a cell but no neigbour cells available to get an estimate of T and S
-      WHERE (tmask(:,:,:) == 1._wp .AND. tsn(:,:,:,2) == 0._wp) 
-         tsn(:,:,:,2) = -99._wp  ! Special value for closed pool (checking purpose in output.init)
-         tmask(:,:,:) = 0._wp    ! set mask to 0 to run
-         umask(:,:,:) = 0._wp
-         vmask(:,:,:) = 0._wp
-      END WHERE
-      
-      ! set mbkt and mikt to 1 in thiese location
-      WHERE (SUM(tmask,dim=3) == 0)
-         mbkt(:,:)=1 ; mbku(:,:)=1 ; mbkv(:,:)=1
-         mikt(:,:)=1 ; miku(:,:)=1 ; mikv(:,:)=1
-      END WHERE
-      ! -------------------------------------------------------------------------------------------
-      ! compute new tn and sn if we close cell 
-      ! nothing to do
-      ! 
-   END SUBROUTINE iscpl_rst_interpol
-
-   !!======================================================================
-END MODULE iscplrst
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/istate.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/istate.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/istate.F90	(revision 12928)
@@ -28,5 +28,4 @@
    USE dtauvd         ! data: U & V current             (dta_uvd routine)
    USE domvvl          ! varying vertical mesh
-   USE iscplrst        ! ice sheet coupling
    USE wet_dry         ! wetting and drying (needed for wad_istate)
    USE usrdef_istate   ! User defined initial state
@@ -43,5 +42,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -51,5 +50,5 @@
 CONTAINS
 
-   SUBROUTINE istate_init
+   SUBROUTINE istate_init( Kbb, Kmm, Kaa )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE istate_init  ***
@@ -57,4 +56,6 @@
       !! ** Purpose :   Initialization of the dynamics and tracer fields.
       !!----------------------------------------------------------------------
+      INTEGER, INTENT( in )  ::  Kbb, Kmm, Kaa   ! ocean time level indices
+      !
       INTEGER ::   ji, jj, jk   ! dummy loop indices
 !!gm see comment further down
@@ -76,15 +77,14 @@
       rhd  (:,:,:  ) = 0._wp   ;   rhop (:,:,:  ) = 0._wp      ! set one for all to 0 at level jpk
       rn2b (:,:,:  ) = 0._wp   ;   rn2  (:,:,:  ) = 0._wp      ! set one for all to 0 at levels 1 and jpk
-      tsa  (:,:,:,:) = 0._wp                                   ! set one for all to 0 at level jpk
+      ts  (:,:,:,:,Kaa) = 0._wp                                   ! set one for all to 0 at level jpk
       rab_b(:,:,:,:) = 0._wp   ;   rab_n(:,:,:,:) = 0._wp      ! set one for all to 0 at level jpk
 #if defined key_agrif
-      ua   (:,:,:  ) = 0._wp   ! used in agrif_oce_sponge at initialization
-      va   (:,:,:  ) = 0._wp   ! used in agrif_oce_sponge at initialization    
+      uu   (:,:,:  ,Kaa) = 0._wp   ! used in agrif_oce_sponge at initialization
+      vv   (:,:,:  ,Kaa) = 0._wp   ! used in agrif_oce_sponge at initialization    
 #endif
 
       IF( ln_rstart ) THEN                    ! Restart from a file
          !                                    ! -------------------
-         CALL rst_read                        ! Read the restart file
-         IF (ln_iscpl)       CALL iscpl_stp   ! extrapolate restart to wet and dry
+         CALL rst_read( Kbb, Kmm )            ! Read the restart file
          CALL day_init                        ! model calendar (using both namelist and restart infos)
          !
@@ -92,41 +92,39 @@
          !                                    ! ---------------
          numror = 0                           ! define numror = 0 -> no restart file to read
-         neuler = 0                           ! Set time-step indicator at nit000 (euler forward)
+         l_1st_euler = .true.                 ! Set time-step indicator at nit000 (euler forward)
          CALL day_init                        ! model calendar (using both namelist and restart infos)
          !                                    ! Initialization of ocean to zero
          !
          IF( ln_tsd_init ) THEN               
-            CALL dta_tsd( nit000, tsb )       ! read 3D T and S data at nit000
+            CALL dta_tsd( nit000, ts(:,:,:,:,Kbb) )       ! read 3D T and S data at nit000
             !
-            sshb(:,:)   = 0._wp               ! set the ocean at rest
+            ssh(:,:,Kbb)   = 0._wp               ! set the ocean at rest
             IF( ll_wd ) THEN
-               sshb(:,:) =  -ssh_ref  ! Added in 30 here for bathy that adds 30 as Iterative test CEOD 
+               ssh(:,:,Kbb) =  -ssh_ref  ! Added in 30 here for bathy that adds 30 as Iterative test CEOD 
                !
                ! Apply minimum wetdepth criterion
                !
-               DO jj = 1,jpj
-                  DO ji = 1,jpi
-                     IF( ht_0(ji,jj) + sshb(ji,jj)  < rn_wdmin1 ) THEN
-                        sshb(ji,jj) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) )
-                     ENDIF
-                  END DO
-               END DO 
+               DO_2D_11_11
+                  IF( ht_0(ji,jj) + ssh(ji,jj,Kbb)  < rn_wdmin1 ) THEN
+                     ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) )
+                  ENDIF
+               END_2D
             ENDIF 
-            ub  (:,:,:) = 0._wp
-            vb  (:,:,:) = 0._wp  
+            uu  (:,:,:,Kbb) = 0._wp
+            vv  (:,:,:,Kbb) = 0._wp  
             !
          ELSE                                 ! user defined initial T and S
-            CALL usr_def_istate( gdept_b, tmask, tsb, ub, vb, sshb  )         
+            CALL usr_def_istate( gdept(:,:,:,Kbb), tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  )         
          ENDIF
-         tsn  (:,:,:,:) = tsb (:,:,:,:)       ! set now values from to before ones
-         sshn (:,:)     = sshb(:,:)   
-         un   (:,:,:)   = ub  (:,:,:)
-         vn   (:,:,:)   = vb  (:,:,:)
-         hdivn(:,:,jpk) = 0._wp               ! bottom divergence set one for 0 to zero at jpk level
-         CALL div_hor( 0 )                    ! compute interior hdivn value  
-!!gm                                    hdivn(:,:,:) = 0._wp
+         ts  (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb)       ! set now values from to before ones
+         ssh (:,:,Kmm)     = ssh(:,:,Kbb)   
+         uu   (:,:,:,Kmm)   = uu  (:,:,:,Kbb)
+         vv   (:,:,:,Kmm)   = vv  (:,:,:,Kbb)
+         hdiv(:,:,jpk) = 0._wp               ! bottom divergence set one for 0 to zero at jpk level
+         CALL div_hor( 0, Kbb, Kmm )         ! compute interior hdiv value  
+!!gm                                    hdiv(:,:,:) = 0._wp
 
 !!gm POTENTIAL BUG :
-!!gm  ISSUE :  if sshb /= 0  then, in non linear free surface, the e3._n, e3._b should be recomputed
+!!gm  ISSUE :  if ssh(:,:,Kbb) /= 0  then, in non linear free surface, the e3._n, e3._b should be recomputed
 !!             as well as gdept and gdepw....   !!!!! 
 !!      ===>>>>   probably a call to domvvl initialisation here....
@@ -138,14 +136,14 @@
 !            ALLOCATE( zuvd(jpi,jpj,jpk,2) )
 !            CALL dta_uvd( nit000, zuvd )
-!            ub(:,:,:) = zuvd(:,:,:,1) ;  un(:,:,:) = ub(:,:,:)
-!            vb(:,:,:) = zuvd(:,:,:,2) ;  vn(:,:,:) = vb(:,:,:)
+!            uu(:,:,:,Kbb) = zuvd(:,:,:,1) ;  uu(:,:,:,Kmm) = uu(:,:,:,Kbb)
+!            vv(:,:,:,Kbb) = zuvd(:,:,:,2) ;  vv(:,:,:,Kmm) = vv(:,:,:,Kbb)
 !            DEALLOCATE( zuvd )
 !         ENDIF
          !
 !!gm This is to be changed !!!!
-!         ! - ML - sshn could be modified by istate_eel, so that initialization of e3t_b is done here
+!         ! - ML - ssh(:,:,Kmm) could be modified by istate_eel, so that initialization of e3t(:,:,:,Kbb) is done here
 !         IF( .NOT.ln_linssh ) THEN
 !            DO jk = 1, jpk
-!               e3t_b(:,:,jk) = e3t_n(:,:,jk)
+!               e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm)
 !            END DO
 !         ENDIF
@@ -157,25 +155,21 @@
       ! Do it whatever the free surface method, these arrays being eventually used
       !
-      un_b(:,:) = 0._wp   ;   vn_b(:,:) = 0._wp
-      ub_b(:,:) = 0._wp   ;   vb_b(:,:) = 0._wp
+      uu_b(:,:,Kmm) = 0._wp   ;   vv_b(:,:,Kmm) = 0._wp
+      uu_b(:,:,Kbb) = 0._wp   ;   vv_b(:,:,Kbb) = 0._wp
       !
-!!gm  the use of umsak & vmask is not necessary below as un, vn, ub, vb are always masked
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               un_b(ji,jj) = un_b(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk)
-               vn_b(ji,jj) = vn_b(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk)
-               !
-               ub_b(ji,jj) = ub_b(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk)
-               vb_b(ji,jj) = vb_b(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+!!gm  the use of umsak & vmask is not necessary below as uu(:,:,:,Kmm), vv(:,:,:,Kmm), uu(:,:,:,Kbb), vv(:,:,:,Kbb) are always masked
+      DO_3D_11_11( 1, jpkm1 )
+         uu_b(ji,jj,Kmm) = uu_b(ji,jj,Kmm) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * umask(ji,jj,jk)
+         vv_b(ji,jj,Kmm) = vv_b(ji,jj,Kmm) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * vmask(ji,jj,jk)
+         !
+         uu_b(ji,jj,Kbb) = uu_b(ji,jj,Kbb) + e3u(ji,jj,jk,Kbb) * uu(ji,jj,jk,Kbb) * umask(ji,jj,jk)
+         vv_b(ji,jj,Kbb) = vv_b(ji,jj,Kbb) + e3v(ji,jj,jk,Kbb) * vv(ji,jj,jk,Kbb) * vmask(ji,jj,jk)
+      END_3D
       !
-      un_b(:,:) = un_b(:,:) * r1_hu_n(:,:)
-      vn_b(:,:) = vn_b(:,:) * r1_hv_n(:,:)
+      uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * r1_hu(:,:,Kmm)
+      vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * r1_hv(:,:,Kmm)
       !
-      ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:)
-      vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:)
+      uu_b(:,:,Kbb) = uu_b(:,:,Kbb) * r1_hu(:,:,Kbb)
+      vv_b(:,:,Kbb) = vv_b(:,:,Kbb) * r1_hv(:,:,Kbb)
       !
    END SUBROUTINE istate_init
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/phycst.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/phycst.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/phycst.F90	(revision 12928)
@@ -39,10 +39,10 @@
    REAL(wp), PUBLIC ::   rt0      = 273.15_wp        !: freezing point of fresh water [Kelvin]
 
-   REAL(wp), PUBLIC ::   rau0                        !: volumic mass of reference     [kg/m3]
-   REAL(wp), PUBLIC ::   r1_rau0                     !: = 1. / rau0                   [m3/kg]
+   REAL(wp), PUBLIC ::   rho0                        !: volumic mass of reference     [kg/m3]
+   REAL(wp), PUBLIC ::   r1_rho0                     !: = 1. / rho0                   [m3/kg]
    REAL(wp), PUBLIC ::   rcp                         !: ocean specific heat           [J/Kelvin]
    REAL(wp), PUBLIC ::   r1_rcp                      !: = 1. / rcp                    [Kelvin/J]
-   REAL(wp), PUBLIC ::   rau0_rcp                    !: = rau0 * rcp 
-   REAL(wp), PUBLIC ::   r1_rau0_rcp                 !: = 1. / ( rau0 * rcp )
+   REAL(wp), PUBLIC ::   rho0_rcp                    !: = rho0 * rcp 
+   REAL(wp), PUBLIC ::   r1_rho0_rcp                 !: = 1. / ( rho0 * rcp )
 
    REAL(wp), PUBLIC ::   emic     =    0.97_wp       !: emissivity of snow or ice (not used?)
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/divhor.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/divhor.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/divhor.F90	(revision 12928)
@@ -20,9 +20,8 @@
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
-   USE sbc_oce, ONLY : ln_rnf, ln_isf ! surface boundary condition: ocean
-   USE sbcrnf          ! river runoff 
-   USE sbcisf          ! ice shelf
-   USE iscplhsb        ! ice sheet / ocean coupling
-   USE iscplini        ! ice sheet / ocean coupling
+   USE sbc_oce, ONLY : ln_rnf      ! river runoff
+   USE sbcrnf , ONLY : sbc_rnf_div ! river runoff 
+   USE isf_oce, ONLY : ln_isf      ! ice shelf
+   USE isfhdiv, ONLY : isf_hdiv    ! ice shelf
 #if defined key_asminc   
    USE asminc          ! Assimilation increment
@@ -40,5 +39,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -48,5 +47,5 @@
 CONTAINS
 
-   SUBROUTINE div_hor( kt )
+   SUBROUTINE div_hor( kt, Kbb, Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE div_hor  ***
@@ -55,13 +54,15 @@
       !!
       !! ** Method  :   the now divergence is computed as :
-      !!         hdivn = 1/(e1e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] )
+      !!         hdiv = 1/(e1e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] )
       !!      and correct with runoff inflow (div_rnf) and cross land flow (div_cla) 
       !!
-      !! ** Action  : - update hdivn, the now horizontal divergence
+      !! ** Action  : - update hdiv, the now horizontal divergence
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER, INTENT(in) ::   kt        ! ocean time-step index
+      INTEGER, INTENT(in) ::   Kbb, Kmm  ! ocean time level indices
       !
       INTEGER  ::   ji, jj, jk    ! dummy loop indices
       REAL(wp) ::   zraur, zdep   ! local scalars
+      REAL(wp), DIMENSION(jpi,jpj) :: ztmp
       !!----------------------------------------------------------------------
       !
@@ -72,37 +73,34 @@
          IF(lwp) WRITE(numout,*) 'div_hor : horizontal velocity divergence '
          IF(lwp) WRITE(numout,*) '~~~~~~~   '
+         hdiv(:,:,:) = 0._wp    ! initialize hdiv for the halos at the first time step
       ENDIF
       !
-      DO jk = 1, jpkm1                                      !==  Horizontal divergence  ==!
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               hdivn(ji,jj,jk) = (  e2u(ji  ,jj) * e3u_n(ji  ,jj,jk) * un(ji  ,jj,jk)      &
-                  &               - e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) * un(ji-1,jj,jk)      &
-                  &               + e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) * vn(ji,jj  ,jk)      &
-                  &               - e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * vn(ji,jj-1,jk)  )   &
-                  &            * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
-            END DO  
-         END DO  
-      END DO
+      DO_3D_00_00( 1, jpkm1 )
+         hdiv(ji,jj,jk) = (  e2u(ji  ,jj) * e3u(ji  ,jj,jk,Kmm) * uu(ji  ,jj,jk,Kmm)      &
+            &               - e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * uu(ji-1,jj,jk,Kmm)      &
+            &               + e1v(ji,jj  ) * e3v(ji,jj  ,jk,Kmm) * vv(ji,jj  ,jk,Kmm)      &
+            &               - e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) * vv(ji,jj-1,jk,Kmm)  )   &
+            &            * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+      END_3D
+      !
 #if defined key_agrif
       IF( .NOT. Agrif_Root() ) THEN
-         IF( nbondi == -1 .OR. nbondi == 2 )   hdivn(   2   ,  :   ,:) = 0._wp      ! west
-         IF( nbondi ==  1 .OR. nbondi == 2 )   hdivn( nlci-1,  :   ,:) = 0._wp      ! east
-         IF( nbondj == -1 .OR. nbondj == 2 )   hdivn(   :   ,  2   ,:) = 0._wp      ! south
-         IF( nbondj ==  1 .OR. nbondj == 2 )   hdivn(   :   ,nlcj-1,:) = 0._wp      ! north
+         IF( nbondi == -1 .OR. nbondi == 2 )   hdiv(   2   ,  :   ,:) = 0._wp      ! west
+         IF( nbondi ==  1 .OR. nbondi == 2 )   hdiv( nlci-1,  :   ,:) = 0._wp      ! east
+         IF( nbondj == -1 .OR. nbondj == 2 )   hdiv(   :   ,  2   ,:) = 0._wp      ! south
+         IF( nbondj ==  1 .OR. nbondj == 2 )   hdiv(   :   ,nlcj-1,:) = 0._wp      ! north
       ENDIF
 #endif
       !
-      IF( ln_rnf )   CALL sbc_rnf_div( hdivn )              !==  runoffs    ==!   (update hdivn field)
+      IF( ln_rnf )   CALL sbc_rnf_div( hdiv, Kmm )                     !==  runoffs    ==!   (update hdiv field)
       !
 #if defined key_asminc 
-      IF( ln_sshinc .AND. ln_asmiau )   CALL ssh_asm_div( kt, hdivn )   !==  SSH assimilation  ==!   (update hdivn field)
+      IF( ln_sshinc .AND. ln_asmiau )   CALL ssh_asm_div( kt, Kbb, Kmm, hdiv )   !==  SSH assimilation  ==!   (update hdiv field)
       ! 
 #endif
-      IF( ln_isf )   CALL sbc_isf_div( hdivn )      !==  ice shelf  ==!   (update hdivn field)
       !
-      IF( ln_iscpl .AND. ln_hsb )   CALL iscpl_div( hdivn ) !==  ice sheet  ==!   (update hdivn field)
+      IF( ln_isf )                      CALL isf_hdiv( kt, Kmm, hdiv )           !==  ice shelf         ==!   (update hdiv field)
       !
-      CALL lbc_lnk( 'divhor', hdivn, 'T', 1. )   !   (no sign change)
+      CALL lbc_lnk( 'divhor', hdiv, 'T', 1. )   !   (no sign change)
       !
       IF( ln_timing )   CALL timing_stop('div_hor')
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynadv.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynadv.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynadv.F90	(revision 12928)
@@ -44,6 +44,4 @@
    INTEGER, PUBLIC, PARAMETER ::   np_FLX_ubs = 3   ! flux   form : 3rd order Upstream Biased Scheme
 
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -53,5 +51,5 @@
 CONTAINS
 
-   SUBROUTINE dyn_adv( kt )
+   SUBROUTINE dyn_adv( kt, Kbb, Kmm, puu, pvv, Krhs )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE dyn_adv  ***
@@ -59,5 +57,5 @@
       !! ** Purpose :   compute the ocean momentum advection trend.
       !!
-      !! ** Method  : - Update (ua,va) with the advection term following n_dynadv
+      !! ** Method  : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the advection term following n_dynadv
       !!
       !!      NB: in flux form advection (ln_dynadv_cen2 or ln_dynadv_ubs=T) 
@@ -66,5 +64,7 @@
       !!      (see dynvor module).
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  kt               ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kbb, Kmm, Krhs   ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv         ! ocean velocities and RHS of momentum equation
       !!----------------------------------------------------------------------
       !
@@ -73,10 +73,10 @@
       SELECT CASE( n_dynadv )    !==  compute advection trend and add it to general trend  ==!
       CASE( np_VEC_c2  )     
-         CALL dyn_keg     ( kt, nn_dynkeg )    ! vector form : horizontal gradient of kinetic energy
-         CALL dyn_zad     ( kt )               ! vector form : vertical advection
+         CALL dyn_keg     ( kt, nn_dynkeg,      Kmm, puu, pvv, Krhs )    ! vector form : horizontal gradient of kinetic energy
+         CALL dyn_zad     ( kt,                 Kmm, puu, pvv, Krhs )    ! vector form : vertical advection
       CASE( np_FLX_c2  ) 
-         CALL dyn_adv_cen2( kt )               ! 2nd order centered scheme
+         CALL dyn_adv_cen2( kt,                 Kmm, puu, pvv, Krhs )    ! 2nd order centered scheme
       CASE( np_FLX_ubs )   
-         CALL dyn_adv_ubs ( kt )               ! 3rd order UBS      scheme (UP3)
+         CALL dyn_adv_ubs ( kt,            Kbb, Kmm, puu, pvv, Krhs )    ! 3rd order UBS      scheme (UP3)
       END SELECT
       !
@@ -104,8 +104,6 @@
       ENDIF
       !
-      REWIND( numnam_ref )              ! Namelist namdyn_adv in reference namelist : Momentum advection scheme
       READ  ( numnam_ref, namdyn_adv, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_adv in reference namelist' )
-      REWIND( numnam_cfg )              ! Namelist namdyn_adv in configuration namelist : Momentum advection scheme
       READ  ( numnam_cfg, namdyn_adv, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_adv in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynadv_cen2.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynadv_cen2.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynadv_cen2.F90	(revision 12928)
@@ -27,5 +27,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -35,5 +35,5 @@
 CONTAINS
 
-   SUBROUTINE dyn_adv_cen2( kt )
+   SUBROUTINE dyn_adv_cen2( kt, Kmm, puu, pvv, Krhs )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dyn_adv_cen2  ***
@@ -44,7 +44,9 @@
       !! ** Method  :   Trend evaluated using now fields (centered in time) 
       !!
-      !! ** Action  :   (ua,va) updated with the now vorticity term trend
+      !! ** Action  :   (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) updated with the now vorticity term trend
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  kt           ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kmm, Krhs    ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv     ! ocean velocities and RHS of momentum equation
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -60,6 +62,6 @@
       !
       IF( l_trddyn ) THEN           ! trends: store the input trends
-         zfu_uw(:,:,:) = ua(:,:,:)
-         zfv_vw(:,:,:) = va(:,:,:)
+         zfu_uw(:,:,:) = puu(:,:,:,Krhs)
+         zfv_vw(:,:,:) = pvv(:,:,:,Krhs)
       ENDIF
       !
@@ -67,78 +69,62 @@
       !
       DO jk = 1, jpkm1                    ! horizontal transport
-         zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk)
-         zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk)
-         DO jj = 1, jpjm1                 ! horizontal momentum fluxes (at T- and F-point)
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zfu_t(ji+1,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji+1,jj,jk) ) * ( un(ji,jj,jk) + un(ji+1,jj  ,jk) )
-               zfv_f(ji  ,jj  ,jk) = ( zfv(ji,jj,jk) + zfv(ji+1,jj,jk) ) * ( un(ji,jj,jk) + un(ji  ,jj+1,jk) )
-               zfu_f(ji  ,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji,jj+1,jk) ) * ( vn(ji,jj,jk) + vn(ji+1,jj  ,jk) )
-               zfv_t(ji  ,jj+1,jk) = ( zfv(ji,jj,jk) + zfv(ji,jj+1,jk) ) * ( vn(ji,jj,jk) + vn(ji  ,jj+1,jk) )
-            END DO
-         END DO
-         DO jj = 2, jpjm1                 ! divergence of horizontal momentum fluxes
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ua(ji,jj,jk) = ua(ji,jj,jk) - (  zfu_t(ji+1,jj,jk) - zfu_t(ji,jj  ,jk)    &
-                  &                           + zfv_f(ji  ,jj,jk) - zfv_f(ji,jj-1,jk)  ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
-               va(ji,jj,jk) = va(ji,jj,jk) - (  zfu_f(ji,jj  ,jk) - zfu_f(ji-1,jj,jk)    &
-                  &                           + zfv_t(ji,jj+1,jk) - zfv_t(ji  ,jj,jk)  ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
-            END DO
-         END DO
+         zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm)
+         zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm)
+         DO_2D_10_10
+            zfu_t(ji+1,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji+1,jj  ,jk,Kmm) )
+            zfv_f(ji  ,jj  ,jk) = ( zfv(ji,jj,jk) + zfv(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji  ,jj+1,jk,Kmm) )
+            zfu_f(ji  ,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji+1,jj  ,jk,Kmm) )
+            zfv_t(ji  ,jj+1,jk) = ( zfv(ji,jj,jk) + zfv(ji,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji  ,jj+1,jk,Kmm) )
+         END_2D
+         DO_2D_00_00
+            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - (  zfu_t(ji+1,jj,jk) - zfu_t(ji,jj  ,jk)    &
+               &                           + zfv_f(ji  ,jj,jk) - zfv_f(ji,jj-1,jk)  ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm)
+            pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - (  zfu_f(ji,jj  ,jk) - zfu_f(ji-1,jj,jk)    &
+               &                           + zfv_t(ji,jj+1,jk) - zfv_t(ji  ,jj,jk)  ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm)
+         END_2D
       END DO
       !
       IF( l_trddyn ) THEN           ! trends: send trend to trddyn for diagnostic
-         zfu_uw(:,:,:) = ua(:,:,:) - zfu_uw(:,:,:)
-         zfv_vw(:,:,:) = va(:,:,:) - zfv_vw(:,:,:)
-         CALL trd_dyn( zfu_uw, zfv_vw, jpdyn_keg, kt )
-         zfu_t(:,:,:) = ua(:,:,:)
-         zfv_t(:,:,:) = va(:,:,:)
+         zfu_uw(:,:,:) = puu(:,:,:,Krhs) - zfu_uw(:,:,:)
+         zfv_vw(:,:,:) = pvv(:,:,:,Krhs) - zfv_vw(:,:,:)
+         CALL trd_dyn( zfu_uw, zfv_vw, jpdyn_keg, kt, Kmm )
+         zfu_t(:,:,:) = puu(:,:,:,Krhs)
+         zfv_t(:,:,:) = pvv(:,:,:,Krhs)
       ENDIF
       !
       !                             !==  Vertical advection  ==!
       !
-      DO jj = 2, jpjm1                    ! surface/bottom advective fluxes set to zero
-         DO ji = fs_2, fs_jpim1
-            zfu_uw(ji,jj,jpk) = 0._wp   ;   zfv_vw(ji,jj,jpk) = 0._wp
-            zfu_uw(ji,jj, 1 ) = 0._wp   ;   zfv_vw(ji,jj, 1 ) = 0._wp
-         END DO
-      END DO
+      DO_2D_00_00
+         zfu_uw(ji,jj,jpk) = 0._wp   ;   zfv_vw(ji,jj,jpk) = 0._wp
+         zfu_uw(ji,jj, 1 ) = 0._wp   ;   zfv_vw(ji,jj, 1 ) = 0._wp
+      END_2D
       IF( ln_linssh ) THEN                ! linear free surface: advection through the surface
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * wn(ji,jj,1) + e1e2t(ji+1,jj) * wn(ji+1,jj,1) ) * un(ji,jj,1)
-               zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * wn(ji,jj,1) + e1e2t(ji,jj+1) * wn(ji,jj+1,1) ) * vn(ji,jj,1)
-            END DO
-         END DO
+         DO_2D_00_00
+            zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji+1,jj) * ww(ji+1,jj,1) ) * puu(ji,jj,1,Kmm)
+            zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji,jj+1) * ww(ji,jj+1,1) ) * pvv(ji,jj,1,Kmm)
+         END_2D
       ENDIF
       DO jk = 2, jpkm1                    ! interior advective fluxes
-         DO jj = 2, jpj                       ! 1/4 * Vertical transport
-            DO ji = 2, jpi
-               zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk)
-            END DO
-         END DO
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji+1,jj  ,jk) ) * ( un(ji,jj,jk) + un(ji,jj,jk-1) )
-               zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji  ,jj+1,jk) ) * ( vn(ji,jj,jk) + vn(ji,jj,jk-1) )
-            END DO
-         END DO
+         DO_2D_01_01
+            zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk)
+         END_2D
+         DO_2D_00_00
+            zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji+1,jj  ,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji,jj,jk-1,Kmm) )
+            zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji  ,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk-1,Kmm) )
+         END_2D
       END DO
-      DO jk = 1, jpkm1                    ! divergence of vertical momentum flux divergence
-         DO jj = 2, jpjm1 
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ua(ji,jj,jk) = ua(ji,jj,jk) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
-               va(ji,jj,jk) = va(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 1, jpkm1 )
+         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm)
+         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm)
+      END_3D
       !
       IF( l_trddyn ) THEN                 ! trends: send trend to trddyn for diagnostic
-         zfu_t(:,:,:) = ua(:,:,:) - zfu_t(:,:,:)
-         zfv_t(:,:,:) = va(:,:,:) - zfv_t(:,:,:)
-         CALL trd_dyn( zfu_t, zfv_t, jpdyn_zad, kt )
+         zfu_t(:,:,:) = puu(:,:,:,Krhs) - zfu_t(:,:,:)
+         zfv_t(:,:,:) = pvv(:,:,:,Krhs) - zfv_t(:,:,:)
+         CALL trd_dyn( zfu_t, zfv_t, jpdyn_zad, kt, Kmm )
       ENDIF
       !                                   ! Control print
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' cen2 adv - Ua: ', mask1=umask,   &
-         &                       tab3d_2=va, clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' cen2 adv - Ua: ', mask1=umask,   &
+         &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' )
       !
    END SUBROUTINE dyn_adv_cen2
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynadv_ubs.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynadv_ubs.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynadv_ubs.F90	(revision 12928)
@@ -33,5 +33,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -41,5 +41,5 @@
 CONTAINS
 
-   SUBROUTINE dyn_adv_ubs( kt )
+   SUBROUTINE dyn_adv_ubs( kt, Kbb, Kmm, puu, pvv, Krhs )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dyn_adv_ubs  ***
@@ -64,9 +64,11 @@
       !!      gamma1=1/3 and gamma2=1/32.
       !!
-      !! ** Action : - (ua,va) updated with the 3D advective momentum trends
+      !! ** Action : - (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) updated with the 3D advective momentum trends
       !!
       !! Reference : Shchepetkin & McWilliams, 2005, Ocean Modelling. 
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  kt              ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kbb, Kmm, Krhs  ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv        ! ocean velocities and RHS of momentum equation
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -95,6 +97,6 @@
       !
       IF( l_trddyn ) THEN           ! trends: store the input trends
-         zfu_uw(:,:,:) = ua(:,:,:)
-         zfv_vw(:,:,:) = va(:,:,:)
+         zfu_uw(:,:,:) = puu(:,:,:,Krhs)
+         zfv_vw(:,:,:) = pvv(:,:,:,Krhs)
       ENDIF
       !                                      ! =========================== !
@@ -102,24 +104,22 @@
          !                                   ! =========================== !
          !                                         ! horizontal volume fluxes
-         zfu(:,:,jk) = e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk)
-         zfv(:,:,jk) = e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk)
+         zfu(:,:,jk) = e2u(:,:) * e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm)
+         zfv(:,:,jk) = e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm)
          !            
-         DO jj = 2, jpjm1                          ! laplacian
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zlu_uu(ji,jj,jk,1) = ( ub (ji+1,jj  ,jk) - 2.*ub (ji,jj,jk) + ub (ji-1,jj  ,jk) ) * umask(ji,jj,jk)
-               zlv_vv(ji,jj,jk,1) = ( vb (ji  ,jj+1,jk) - 2.*vb (ji,jj,jk) + vb (ji  ,jj-1,jk) ) * vmask(ji,jj,jk)
-               zlu_uv(ji,jj,jk,1) = ( ub (ji  ,jj+1,jk) - ub (ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   &
-                  &               - ( ub (ji  ,jj  ,jk) - ub (ji  ,jj-1,jk) ) * fmask(ji  ,jj-1,jk)
-               zlv_vu(ji,jj,jk,1) = ( vb (ji+1,jj  ,jk) - vb (ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   &
-                  &               - ( vb (ji  ,jj  ,jk) - vb (ji-1,jj  ,jk) ) * fmask(ji-1,jj  ,jk)
-               !
-               zlu_uu(ji,jj,jk,2) = ( zfu(ji+1,jj  ,jk) - 2.*zfu(ji,jj,jk) + zfu(ji-1,jj  ,jk) ) * umask(ji,jj,jk)
-               zlv_vv(ji,jj,jk,2) = ( zfv(ji  ,jj+1,jk) - 2.*zfv(ji,jj,jk) + zfv(ji  ,jj-1,jk) ) * vmask(ji,jj,jk)
-               zlu_uv(ji,jj,jk,2) = ( zfu(ji  ,jj+1,jk) - zfu(ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   &
-                  &               - ( zfu(ji  ,jj  ,jk) - zfu(ji  ,jj-1,jk) ) * fmask(ji  ,jj-1,jk)
-               zlv_vu(ji,jj,jk,2) = ( zfv(ji+1,jj  ,jk) - zfv(ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   &
-                  &               - ( zfv(ji  ,jj  ,jk) - zfv(ji-1,jj  ,jk) ) * fmask(ji-1,jj  ,jk)
-            END DO
-         END DO
+         DO_2D_00_00
+            zlu_uu(ji,jj,jk,1) = ( puu (ji+1,jj  ,jk,Kbb) - 2.*puu (ji,jj,jk,Kbb) + puu (ji-1,jj  ,jk,Kbb) ) * umask(ji,jj,jk)
+            zlv_vv(ji,jj,jk,1) = ( pvv (ji  ,jj+1,jk,Kbb) - 2.*pvv (ji,jj,jk,Kbb) + pvv (ji  ,jj-1,jk,Kbb) ) * vmask(ji,jj,jk)
+            zlu_uv(ji,jj,jk,1) = ( puu (ji  ,jj+1,jk,Kbb) - puu (ji  ,jj  ,jk,Kbb) ) * fmask(ji  ,jj  ,jk)   &
+               &               - ( puu (ji  ,jj  ,jk,Kbb) - puu (ji  ,jj-1,jk,Kbb) ) * fmask(ji  ,jj-1,jk)
+            zlv_vu(ji,jj,jk,1) = ( pvv (ji+1,jj  ,jk,Kbb) - pvv (ji  ,jj  ,jk,Kbb) ) * fmask(ji  ,jj  ,jk)   &
+               &               - ( pvv (ji  ,jj  ,jk,Kbb) - pvv (ji-1,jj  ,jk,Kbb) ) * fmask(ji-1,jj  ,jk)
+            !
+            zlu_uu(ji,jj,jk,2) = ( zfu(ji+1,jj  ,jk) - 2.*zfu(ji,jj,jk) + zfu(ji-1,jj  ,jk) ) * umask(ji,jj,jk)
+            zlv_vv(ji,jj,jk,2) = ( zfv(ji  ,jj+1,jk) - 2.*zfv(ji,jj,jk) + zfv(ji  ,jj-1,jk) ) * vmask(ji,jj,jk)
+            zlu_uv(ji,jj,jk,2) = ( zfu(ji  ,jj+1,jk) - zfu(ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   &
+               &               - ( zfu(ji  ,jj  ,jk) - zfu(ji  ,jj-1,jk) ) * fmask(ji  ,jj-1,jk)
+            zlv_vu(ji,jj,jk,2) = ( zfv(ji+1,jj  ,jk) - zfv(ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   &
+               &               - ( zfv(ji  ,jj  ,jk) - zfv(ji-1,jj  ,jk) ) * fmask(ji-1,jj  ,jk)
+         END_2D
       END DO
       CALL lbc_lnk_multi( 'dynadv_ubs', zlu_uu(:,:,:,1), 'U', 1. , zlu_uv(:,:,:,1), 'U', 1.,  &
@@ -132,106 +132,90 @@
       DO jk = 1, jpkm1                       ! ====================== !
          !                                         ! horizontal volume fluxes
-         zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk)
-         zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk)
+         zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm)
+         zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm)
          !
-         DO jj = 1, jpjm1                          ! horizontal momentum fluxes at T- and F-point
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zui = ( un(ji,jj,jk) + un(ji+1,jj  ,jk) )
-               zvj = ( vn(ji,jj,jk) + vn(ji  ,jj+1,jk) )
-               !
-               IF( zui > 0 ) THEN   ;   zl_u = zlu_uu(ji  ,jj,jk,1)
-               ELSE                 ;   zl_u = zlu_uu(ji+1,jj,jk,1)
-               ENDIF
-               IF( zvj > 0 ) THEN   ;   zl_v = zlv_vv(ji,jj  ,jk,1)
-               ELSE                 ;   zl_v = zlv_vv(ji,jj+1,jk,1)
-               ENDIF
-               !
-               zfu_t(ji+1,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji+1,jj  ,jk)                               &
-                  &                    - gamma2 * ( zlu_uu(ji,jj,jk,2) + zlu_uu(ji+1,jj  ,jk,2) )  )   &
-                  &                * ( zui - gamma1 * zl_u)
-               zfv_t(ji  ,jj+1,jk) = ( zfv(ji,jj,jk) + zfv(ji  ,jj+1,jk)                               &
-                  &                    - gamma2 * ( zlv_vv(ji,jj,jk,2) + zlv_vv(ji  ,jj+1,jk,2) )  )   &
-                  &                * ( zvj - gamma1 * zl_v)
-               !
-               zfuj = ( zfu(ji,jj,jk) + zfu(ji  ,jj+1,jk) )
-               zfvi = ( zfv(ji,jj,jk) + zfv(ji+1,jj  ,jk) )
-               IF( zfuj > 0 ) THEN   ;    zl_v = zlv_vu( ji  ,jj  ,jk,1)
-               ELSE                  ;    zl_v = zlv_vu( ji+1,jj,jk,1)
-               ENDIF
-               IF( zfvi > 0 ) THEN   ;    zl_u = zlu_uv( ji,jj  ,jk,1)
-               ELSE                  ;    zl_u = zlu_uv( ji,jj+1,jk,1)
-               ENDIF
-               !
-               zfv_f(ji  ,jj  ,jk) = ( zfvi - gamma2 * ( zlv_vu(ji,jj,jk,2) + zlv_vu(ji+1,jj  ,jk,2) )  )   &
-                  &                * ( un(ji,jj,jk) + un(ji  ,jj+1,jk) - gamma1 * zl_u )
-               zfu_f(ji  ,jj  ,jk) = ( zfuj - gamma2 * ( zlu_uv(ji,jj,jk,2) + zlu_uv(ji  ,jj+1,jk,2) )  )   &
-                  &                * ( vn(ji,jj,jk) + vn(ji+1,jj  ,jk) - gamma1 * zl_v )
-            END DO
-         END DO
-         DO jj = 2, jpjm1                          ! divergence of horizontal momentum fluxes
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ua(ji,jj,jk) = ua(ji,jj,jk) - (  zfu_t(ji+1,jj,jk) - zfu_t(ji,jj  ,jk)    &
-                  &                           + zfv_f(ji  ,jj,jk) - zfv_f(ji,jj-1,jk)  ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
-               va(ji,jj,jk) = va(ji,jj,jk) - (  zfu_f(ji,jj  ,jk) - zfu_f(ji-1,jj,jk)    &
-                  &                           + zfv_t(ji,jj+1,jk) - zfv_t(ji  ,jj,jk)  ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
-            END DO
-         END DO
+         DO_2D_10_10
+            zui = ( puu(ji,jj,jk,Kmm) + puu(ji+1,jj  ,jk,Kmm) )
+            zvj = ( pvv(ji,jj,jk,Kmm) + pvv(ji  ,jj+1,jk,Kmm) )
+            !
+            IF( zui > 0 ) THEN   ;   zl_u = zlu_uu(ji  ,jj,jk,1)
+            ELSE                 ;   zl_u = zlu_uu(ji+1,jj,jk,1)
+            ENDIF
+            IF( zvj > 0 ) THEN   ;   zl_v = zlv_vv(ji,jj  ,jk,1)
+            ELSE                 ;   zl_v = zlv_vv(ji,jj+1,jk,1)
+            ENDIF
+            !
+            zfu_t(ji+1,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji+1,jj  ,jk)                               &
+               &                    - gamma2 * ( zlu_uu(ji,jj,jk,2) + zlu_uu(ji+1,jj  ,jk,2) )  )   &
+               &                * ( zui - gamma1 * zl_u)
+            zfv_t(ji  ,jj+1,jk) = ( zfv(ji,jj,jk) + zfv(ji  ,jj+1,jk)                               &
+               &                    - gamma2 * ( zlv_vv(ji,jj,jk,2) + zlv_vv(ji  ,jj+1,jk,2) )  )   &
+               &                * ( zvj - gamma1 * zl_v)
+            !
+            zfuj = ( zfu(ji,jj,jk) + zfu(ji  ,jj+1,jk) )
+            zfvi = ( zfv(ji,jj,jk) + zfv(ji+1,jj  ,jk) )
+            IF( zfuj > 0 ) THEN   ;    zl_v = zlv_vu( ji  ,jj  ,jk,1)
+            ELSE                  ;    zl_v = zlv_vu( ji+1,jj,jk,1)
+            ENDIF
+            IF( zfvi > 0 ) THEN   ;    zl_u = zlu_uv( ji,jj  ,jk,1)
+            ELSE                  ;    zl_u = zlu_uv( ji,jj+1,jk,1)
+            ENDIF
+            !
+            zfv_f(ji  ,jj  ,jk) = ( zfvi - gamma2 * ( zlv_vu(ji,jj,jk,2) + zlv_vu(ji+1,jj  ,jk,2) )  )   &
+               &                * ( puu(ji,jj,jk,Kmm) + puu(ji  ,jj+1,jk,Kmm) - gamma1 * zl_u )
+            zfu_f(ji  ,jj  ,jk) = ( zfuj - gamma2 * ( zlu_uv(ji,jj,jk,2) + zlu_uv(ji  ,jj+1,jk,2) )  )   &
+               &                * ( pvv(ji,jj,jk,Kmm) + pvv(ji+1,jj  ,jk,Kmm) - gamma1 * zl_v )
+         END_2D
+         DO_2D_00_00
+            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - (  zfu_t(ji+1,jj,jk) - zfu_t(ji,jj  ,jk)    &
+               &                           + zfv_f(ji  ,jj,jk) - zfv_f(ji,jj-1,jk)  ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm)
+            pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - (  zfu_f(ji,jj  ,jk) - zfu_f(ji-1,jj,jk)    &
+               &                           + zfv_t(ji,jj+1,jk) - zfv_t(ji  ,jj,jk)  ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm)
+         END_2D
       END DO
       IF( l_trddyn ) THEN                          ! trends: send trends to trddyn for diagnostic
-         zfu_uw(:,:,:) = ua(:,:,:) - zfu_uw(:,:,:)
-         zfv_vw(:,:,:) = va(:,:,:) - zfv_vw(:,:,:)
-         CALL trd_dyn( zfu_uw, zfv_vw, jpdyn_keg, kt )
-         zfu_t(:,:,:) = ua(:,:,:)
-         zfv_t(:,:,:) = va(:,:,:)
+         zfu_uw(:,:,:) = puu(:,:,:,Krhs) - zfu_uw(:,:,:)
+         zfv_vw(:,:,:) = pvv(:,:,:,Krhs) - zfv_vw(:,:,:)
+         CALL trd_dyn( zfu_uw, zfv_vw, jpdyn_keg, kt, Kmm )
+         zfu_t(:,:,:) = puu(:,:,:,Krhs)
+         zfv_t(:,:,:) = pvv(:,:,:,Krhs)
       ENDIF
       !                                      ! ==================== !
       !                                      !  Vertical advection  !
       !                                      ! ==================== !
-      DO jj = 2, jpjm1                             ! surface/bottom advective fluxes set to zero                  
-         DO ji = fs_2, fs_jpim1
-            zfu_uw(ji,jj,jpk) = 0._wp
-            zfv_vw(ji,jj,jpk) = 0._wp
-            zfu_uw(ji,jj, 1 ) = 0._wp
-            zfv_vw(ji,jj, 1 ) = 0._wp
-         END DO
+      DO_2D_00_00
+         zfu_uw(ji,jj,jpk) = 0._wp
+         zfv_vw(ji,jj,jpk) = 0._wp
+         zfu_uw(ji,jj, 1 ) = 0._wp
+         zfv_vw(ji,jj, 1 ) = 0._wp
+      END_2D
+      IF( ln_linssh ) THEN                         ! constant volume : advection through the surface
+         DO_2D_00_00
+            zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji+1,jj) * ww(ji+1,jj,1) ) * puu(ji,jj,1,Kmm)
+            zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji,jj+1) * ww(ji,jj+1,1) ) * pvv(ji,jj,1,Kmm)
+         END_2D
+      ENDIF
+      DO jk = 2, jpkm1                          ! interior fluxes
+         DO_2D_01_01
+            zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk)
+         END_2D
+         DO_2D_00_00
+            zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji,jj,jk-1,Kmm) )
+            zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk-1,Kmm) )
+         END_2D
       END DO
-      IF( ln_linssh ) THEN                         ! constant volume : advection through the surface
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * wn(ji,jj,1) + e1e2t(ji+1,jj) * wn(ji+1,jj,1) ) * un(ji,jj,1)
-               zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * wn(ji,jj,1) + e1e2t(ji,jj+1) * wn(ji,jj+1,1) ) * vn(ji,jj,1)
-            END DO
-         END DO
-      ENDIF
-      DO jk = 2, jpkm1                          ! interior fluxes
-         DO jj = 2, jpj
-            DO ji = 2, jpi
-               zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk)
-            END DO
-         END DO
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji+1,jj,jk) ) * ( un(ji,jj,jk) + un(ji,jj,jk-1) )
-               zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji,jj+1,jk) ) * ( vn(ji,jj,jk) + vn(ji,jj,jk-1) )
-            END DO
-         END DO
-      END DO
-      DO jk = 1, jpkm1                          ! divergence of vertical momentum flux divergence
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ua(ji,jj,jk) =  ua(ji,jj,jk) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
-               va(ji,jj,jk) =  va(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 1, jpkm1 )
+         puu(ji,jj,jk,Krhs) =  puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm)
+         pvv(ji,jj,jk,Krhs) =  pvv(ji,jj,jk,Krhs) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm)
+      END_3D
       !
       IF( l_trddyn ) THEN                       ! save the vertical advection trend for diagnostic
-         zfu_t(:,:,:) = ua(:,:,:) - zfu_t(:,:,:)
-         zfv_t(:,:,:) = va(:,:,:) - zfv_t(:,:,:)
-         CALL trd_dyn( zfu_t, zfv_t, jpdyn_zad, kt )
+         zfu_t(:,:,:) = puu(:,:,:,Krhs) - zfu_t(:,:,:)
+         zfv_t(:,:,:) = pvv(:,:,:,Krhs) - zfv_t(:,:,:)
+         CALL trd_dyn( zfu_t, zfv_t, jpdyn_zad, kt, Kmm )
       ENDIF
       !                                         ! Control print
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' ubs2 adv - Ua: ', mask1=umask,   &
-         &                       tab3d_2=va, clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' ubs2 adv - Ua: ', mask1=umask,   &
+         &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' )
       !
    END SUBROUTINE dyn_adv_ubs
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynatf.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynatf.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynatf.F90	(revision 12928)
@@ -0,0 +1,315 @@
+MODULE dynatf
+   !!=========================================================================
+   !!                       ***  MODULE  dynatf  ***
+   !! Ocean dynamics: time filtering
+   !!=========================================================================
+   !! History :  OPA  !  1987-02  (P. Andrich, D. L Hostis)  Original code
+   !!                 !  1990-10  (C. Levy, G. Madec)
+   !!            7.0  !  1993-03  (M. Guyon)  symetrical conditions
+   !!            8.0  !  1997-02  (G. Madec & M. Imbard)  opa, release 8.0
+   !!            8.2  !  1997-04  (A. Weaver)  Euler forward step
+   !!             -   !  1997-06  (G. Madec)  lateral boudary cond., lbc routine
+   !!    NEMO    1.0  !  2002-08  (G. Madec)  F90: Free form and module
+   !!             -   !  2002-10  (C. Talandier, A-M. Treguier) Open boundary cond.
+   !!            2.0  !  2005-11  (V. Garnier) Surface pressure gradient organization
+   !!            2.3  !  2007-07  (D. Storkey) Calls to BDY routines. 
+   !!            3.2  !  2009-06  (G. Madec, R.Benshila)  re-introduce the vvl option
+   !!            3.3  !  2010-09  (D. Storkey, E.O'Dea) Bug fix for BDY module
+   !!            3.3  !  2011-03  (P. Oddo) Bug fix for time-splitting+(BDY-OBC) and not VVL
+   !!            3.5  !  2013-07  (J. Chanut) Compliant with time splitting changes
+   !!            3.6  !  2014-04  (G. Madec) add the diagnostic of the time filter trends
+   !!            3.7  !  2015-11  (J. Chanut) Free surface simplification
+   !!            4.1  !  2019-08  (A. Coward, D. Storkey) Rename dynnxt.F90 -> dynatf.F90. Now just does time filtering.
+   !!-------------------------------------------------------------------------
+  
+   !!----------------------------------------------------------------------------------------------
+   !!   dyn_atf       : apply Asselin time filtering to "now" velocities and vertical scale factors
+   !!----------------------------------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE sbc_oce        ! Surface boundary condition: ocean fields
+   USE sbcrnf         ! river runoffs
+   USE phycst         ! physical constants
+   USE dynadv         ! dynamics: vector invariant versus flux form
+   USE dynspg_ts      ! surface pressure gradient: split-explicit scheme
+   USE domvvl         ! variable volume
+   USE bdy_oce   , ONLY: ln_bdy
+   USE bdydta         ! ocean open boundary conditions
+   USE bdydyn         ! ocean open boundary conditions
+   USE bdyvol         ! ocean open boundary condition (bdy_vol routines)
+   USE trd_oce        ! trends: ocean variables
+   USE trddyn         ! trend manager: dynamics
+   USE trdken         ! trend manager: kinetic energy
+   USE isf_oce   , ONLY: ln_isf     ! ice shelf
+   USE isfdynatf , ONLY: isf_dynatf ! ice shelf volume filter correction subroutine 
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O manager library
+   USE lbclnk         ! lateral boundary condition (or mpp link)
+   USE lib_mpp        ! MPP library
+   USE prtctl         ! Print control
+   USE timing         ! Timing
+#if defined key_agrif
+   USE agrif_oce_interp
+#endif
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC    dyn_atf   ! routine called by step.F90
+
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id$ 
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dyn_atf ( kt, Kbb, Kmm, Kaa, puu, pvv, pe3t, pe3u, pe3v )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_atf  ***
+      !!                   
+      !! ** Purpose :   Finalize after horizontal velocity. Apply the boundary 
+      !!             condition on the after velocity and apply the Asselin time
+      !!             filter to the now fields.
+      !!
+      !! ** Method  : * Ensure after velocities transport matches time splitting
+      !!             estimate (ln_dynspg_ts=T)
+      !!
+      !!              * Apply lateral boundary conditions on after velocity 
+      !!             at the local domain boundaries through lbc_lnk call,
+      !!             at the one-way open boundaries (ln_bdy=T),
+      !!             at the AGRIF zoom   boundaries (lk_agrif=T)
+      !!
+      !!              * Apply the Asselin time filter to the now fields
+      !!             arrays to start the next time step:
+      !!                (puu(Kmm),pvv(Kmm)) = (puu(Kmm),pvv(Kmm)) 
+      !!                                    + rn_atfp [ (puu(Kbb),pvv(Kbb)) + (puu(Kaa),pvv(Kaa)) - 2 (puu(Kmm),pvv(Kmm)) ]
+      !!             Note that with flux form advection and non linear free surface,
+      !!             the time filter is applied on thickness weighted velocity.
+      !!             As a result, dyn_atf MUST be called after tra_atf.
+      !!
+      !! ** Action :   puu(Kmm),pvv(Kmm)   filtered now horizontal velocity 
+      !!----------------------------------------------------------------------
+      INTEGER                             , INTENT(in   ) :: kt               ! ocean time-step index
+      INTEGER                             , INTENT(in   ) :: Kbb, Kmm, Kaa    ! before and after time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv         ! velocities to be time filtered
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: pe3t, pe3u, pe3v ! scale factors to be time filtered
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zue3a, zue3n, zue3b, zcoef    ! local scalars
+      REAL(wp) ::   zve3a, zve3n, zve3b, z1_2dt   !   -      -
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zue, zve, zwfld
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ze3t_f, ze3u_f, ze3v_f, zua, zva 
+      !!----------------------------------------------------------------------
+      !
+      IF( ln_timing    )   CALL timing_start('dyn_atf')
+      IF( ln_dynspg_ts )   ALLOCATE( zue(jpi,jpj)     , zve(jpi,jpj)     )
+      IF( l_trddyn     )   ALLOCATE( zua(jpi,jpj,jpk) , zva(jpi,jpj,jpk) )
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_atf : Asselin time filtering'
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+      ENDIF
+
+      IF ( ln_dynspg_ts ) THEN
+         ! Ensure below that barotropic velocities match time splitting estimate
+         ! Compute actual transport and replace it with ts estimate at "after" time step
+         zue(:,:) = pe3u(:,:,1,Kaa) * puu(:,:,1,Kaa) * umask(:,:,1)
+         zve(:,:) = pe3v(:,:,1,Kaa) * pvv(:,:,1,Kaa) * vmask(:,:,1)
+         DO jk = 2, jpkm1
+            zue(:,:) = zue(:,:) + pe3u(:,:,jk,Kaa) * puu(:,:,jk,Kaa) * umask(:,:,jk)
+            zve(:,:) = zve(:,:) + pe3v(:,:,jk,Kaa) * pvv(:,:,jk,Kaa) * vmask(:,:,jk)
+         END DO
+         DO jk = 1, jpkm1
+            puu(:,:,jk,Kaa) = ( puu(:,:,jk,Kaa) - zue(:,:) * r1_hu(:,:,Kaa) + uu_b(:,:,Kaa) ) * umask(:,:,jk)
+            pvv(:,:,jk,Kaa) = ( pvv(:,:,jk,Kaa) - zve(:,:) * r1_hv(:,:,Kaa) + vv_b(:,:,Kaa) ) * vmask(:,:,jk)
+         END DO
+         !
+         IF( .NOT.ln_bt_fw ) THEN
+            ! Remove advective velocity from "now velocities" 
+            ! prior to asselin filtering     
+            ! In the forward case, this is done below after asselin filtering   
+            ! so that asselin contribution is removed at the same time 
+            DO jk = 1, jpkm1
+               puu(:,:,jk,Kmm) = ( puu(:,:,jk,Kmm) - un_adv(:,:)*r1_hu(:,:,Kmm) + uu_b(:,:,Kmm) )*umask(:,:,jk)
+               pvv(:,:,jk,Kmm) = ( pvv(:,:,jk,Kmm) - vn_adv(:,:)*r1_hv(:,:,Kmm) + vv_b(:,:,Kmm) )*vmask(:,:,jk)
+            END DO  
+         ENDIF
+      ENDIF
+
+      ! Update after velocity on domain lateral boundaries
+      ! --------------------------------------------------      
+# if defined key_agrif
+      CALL Agrif_dyn( kt )             !* AGRIF zoom boundaries
+# endif
+      !
+      CALL lbc_lnk_multi( 'dynatf', puu(:,:,:,Kaa), 'U', -1., pvv(:,:,:,Kaa), 'V', -1. )     !* local domain boundaries
+      !
+      !                                !* BDY open boundaries
+      IF( ln_bdy .AND. ln_dynspg_exp )   CALL bdy_dyn( kt, Kbb, puu, pvv, Kaa )
+      IF( ln_bdy .AND. ln_dynspg_ts  )   CALL bdy_dyn( kt, Kbb, puu, pvv, Kaa, dyn3d_only=.true. )
+
+!!$   Do we need a call to bdy_vol here??
+      !
+      IF( l_trddyn ) THEN             ! prepare the atf trend computation + some diagnostics
+         !
+         !                                  ! Kinetic energy and Conversion
+         IF( ln_KE_trd  )   CALL trd_dyn( puu(:,:,:,Kaa), pvv(:,:,:,Kaa), jpdyn_ken, kt, Kmm )
+         !
+         IF( ln_dyn_trd ) THEN              ! 3D output: total momentum trends
+            zua(:,:,:) = ( puu(:,:,:,Kaa) - puu(:,:,:,Kbb) ) * r1_Dt
+            zva(:,:,:) = ( pvv(:,:,:,Kaa) - pvv(:,:,:,Kbb) ) * r1_Dt
+            CALL iom_put( "utrd_tot", zua )        ! total momentum trends, except the asselin time filter
+            CALL iom_put( "vtrd_tot", zva )
+         ENDIF
+         !
+         zua(:,:,:) = puu(:,:,:,Kmm)             ! save the now velocity before the asselin filter
+         zva(:,:,:) = pvv(:,:,:,Kmm)             ! (caution: there will be a shift by 1 timestep in the
+         !                                  !  computation of the asselin filter trends)
+      ENDIF
+
+      ! Time filter and swap of dynamics arrays
+      ! ------------------------------------------
+         
+      IF( .NOT. l_1st_euler ) THEN    !* Leap-Frog : Asselin time filter 
+         !                                ! =============!
+         IF( ln_linssh ) THEN             ! Fixed volume !
+            !                             ! =============!
+            DO_3D_11_11( 1, jpkm1 )
+               puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Kmm) + rn_atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Kaa) )
+               pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Kmm) + rn_atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Kaa) )
+            END_3D
+            !                             ! ================!
+         ELSE                             ! Variable volume !
+            !                             ! ================!
+            ! Time-filtered scale factor at t-points
+            ! ----------------------------------------------------
+            ALLOCATE( ze3t_f(jpi,jpj,jpk), zwfld(jpi,jpj) )
+            DO jk = 1, jpkm1
+               ze3t_f(:,:,jk) = pe3t(:,:,jk,Kmm) + rn_atfp * ( pe3t(:,:,jk,Kbb) - 2._wp * pe3t(:,:,jk,Kmm) + pe3t(:,:,jk,Kaa) )
+            END DO
+            ! Add volume filter correction: compatibility with tracer advection scheme
+            ! => time filter + conservation correction
+            zcoef = rn_atfp * rn_Dt * r1_rho0
+            zwfld(:,:) = emp_b(:,:) - emp(:,:)
+            IF ( ln_rnf ) zwfld(:,:) =  zwfld(:,:) - ( rnf_b(:,:) - rnf(:,:) )
+            DO jk = 1, jpkm1
+               ze3t_f(:,:,jk) = ze3t_f(:,:,jk) - zcoef * zwfld(:,:) * tmask(:,:,jk) &
+                              &                        * pe3t(:,:,jk,Kmm) / ( ht(:,:) + 1._wp - ssmask(:,:) ) 
+            END DO
+            !
+            ! ice shelf melting (deal separately as it can be in depth)
+            ! PM: we could probably define a generic subroutine to do the in depth correction
+            !     to manage rnf, isf and possibly in the futur icb, tide water glacier (...)
+            !     ...(kt, coef, ktop, kbot, hz, fwf_b, fwf)
+            IF ( ln_isf ) CALL isf_dynatf( kt, Kmm, ze3t_f, rn_atfp * rn_Dt )
+            !
+            pe3t(:,:,1:jpkm1,Kmm) = ze3t_f(:,:,1:jpkm1)        ! filtered scale factor at T-points
+            !
+            IF( ln_dynadv_vec ) THEN      ! Asselin filter applied on velocity
+               ! Before filtered scale factor at (u/v)-points
+               CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), pe3u(:,:,:,Kmm), 'U' )
+               CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), pe3v(:,:,:,Kmm), 'V' )
+               DO_3D_11_11( 1, jpkm1 )
+                  puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Kmm) + rn_atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Kaa) )
+                  pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Kmm) + rn_atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Kaa) )
+               END_3D
+               !
+            ELSE                          ! Asselin filter applied on thickness weighted velocity
+               !
+               ALLOCATE( ze3u_f(jpi,jpj,jpk) , ze3v_f(jpi,jpj,jpk) )
+               ! Now filtered scale factor at (u/v)-points stored in ze3u_f, ze3v_f
+               CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), ze3u_f, 'U' )
+               CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), ze3v_f, 'V' )
+               DO_3D_11_11( 1, jpkm1 )
+                  zue3a = pe3u(ji,jj,jk,Kaa) * puu(ji,jj,jk,Kaa)
+                  zve3a = pe3v(ji,jj,jk,Kaa) * pvv(ji,jj,jk,Kaa)
+                  zue3n = pe3u(ji,jj,jk,Kmm) * puu(ji,jj,jk,Kmm)
+                  zve3n = pe3v(ji,jj,jk,Kmm) * pvv(ji,jj,jk,Kmm)
+                  zue3b = pe3u(ji,jj,jk,Kbb) * puu(ji,jj,jk,Kbb)
+                  zve3b = pe3v(ji,jj,jk,Kbb) * pvv(ji,jj,jk,Kbb)
+                  !
+                  puu(ji,jj,jk,Kmm) = ( zue3n + rn_atfp * ( zue3b - 2._wp * zue3n  + zue3a ) ) / ze3u_f(ji,jj,jk)
+                  pvv(ji,jj,jk,Kmm) = ( zve3n + rn_atfp * ( zve3b - 2._wp * zve3n  + zve3a ) ) / ze3v_f(ji,jj,jk)
+               END_3D
+               pe3u(:,:,1:jpkm1,Kmm) = ze3u_f(:,:,1:jpkm1)  
+               pe3v(:,:,1:jpkm1,Kmm) = ze3v_f(:,:,1:jpkm1)
+               !
+               DEALLOCATE( ze3u_f , ze3v_f )
+            ENDIF
+            !
+            DEALLOCATE( ze3t_f, zwfld )
+         ENDIF
+         !
+         IF( ln_dynspg_ts .AND. ln_bt_fw ) THEN
+            ! Revert filtered "now" velocities to time split estimate
+            ! Doing it here also means that asselin filter contribution is removed  
+            zue(:,:) = pe3u(:,:,1,Kmm) * puu(:,:,1,Kmm) * umask(:,:,1)
+            zve(:,:) = pe3v(:,:,1,Kmm) * pvv(:,:,1,Kmm) * vmask(:,:,1)    
+            DO jk = 2, jpkm1
+               zue(:,:) = zue(:,:) + pe3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) * umask(:,:,jk)
+               zve(:,:) = zve(:,:) + pe3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) * vmask(:,:,jk)    
+            END DO
+            DO jk = 1, jpkm1
+               puu(:,:,jk,Kmm) = puu(:,:,jk,Kmm) - (zue(:,:) * r1_hu(:,:,Kmm) - uu_b(:,:,Kmm)) * umask(:,:,jk)
+               pvv(:,:,jk,Kmm) = pvv(:,:,jk,Kmm) - (zve(:,:) * r1_hv(:,:,Kmm) - vv_b(:,:,Kmm)) * vmask(:,:,jk)
+            END DO
+         ENDIF
+         !
+      ENDIF ! .NOT. l_1st_euler
+      !
+      ! Set "now" and "before" barotropic velocities for next time step:
+      ! JC: Would be more clever to swap variables than to make a full vertical
+      ! integration
+      !
+      IF(.NOT.ln_linssh ) THEN
+         hu(:,:,Kmm) = pe3u(:,:,1,Kmm ) * umask(:,:,1)
+         hv(:,:,Kmm) = pe3v(:,:,1,Kmm ) * vmask(:,:,1)
+         DO jk = 2, jpkm1
+            hu(:,:,Kmm) = hu(:,:,Kmm) + pe3u(:,:,jk,Kmm ) * umask(:,:,jk)
+            hv(:,:,Kmm) = hv(:,:,Kmm) + pe3v(:,:,jk,Kmm ) * vmask(:,:,jk)
+         END DO
+         r1_hu(:,:,Kmm) = ssumask(:,:) / ( hu(:,:,Kmm) + 1._wp - ssumask(:,:) )
+         r1_hv(:,:,Kmm) = ssvmask(:,:) / ( hv(:,:,Kmm) + 1._wp - ssvmask(:,:) )
+      ENDIF
+      !
+      uu_b(:,:,Kaa) = pe3u(:,:,1,Kaa) * puu(:,:,1,Kaa) * umask(:,:,1)
+      uu_b(:,:,Kmm) = pe3u(:,:,1,Kmm) * puu(:,:,1,Kmm) * umask(:,:,1)
+      vv_b(:,:,Kaa) = pe3v(:,:,1,Kaa) * pvv(:,:,1,Kaa) * vmask(:,:,1)
+      vv_b(:,:,Kmm) = pe3v(:,:,1,Kmm) * pvv(:,:,1,Kmm) * vmask(:,:,1)
+      DO jk = 2, jpkm1
+         uu_b(:,:,Kaa) = uu_b(:,:,Kaa) + pe3u(:,:,jk,Kaa) * puu(:,:,jk,Kaa) * umask(:,:,jk)
+         uu_b(:,:,Kmm) = uu_b(:,:,Kmm) + pe3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) * umask(:,:,jk)
+         vv_b(:,:,Kaa) = vv_b(:,:,Kaa) + pe3v(:,:,jk,Kaa) * pvv(:,:,jk,Kaa) * vmask(:,:,jk)
+         vv_b(:,:,Kmm) = vv_b(:,:,Kmm) + pe3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) * vmask(:,:,jk)
+      END DO
+      uu_b(:,:,Kaa) = uu_b(:,:,Kaa) * r1_hu(:,:,Kaa)
+      vv_b(:,:,Kaa) = vv_b(:,:,Kaa) * r1_hv(:,:,Kaa)
+      uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * r1_hu(:,:,Kmm)
+      vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * r1_hv(:,:,Kmm)
+      !
+      IF( .NOT.ln_dynspg_ts ) THEN        ! output the barotropic currents
+         CALL iom_put(  "ubar", uu_b(:,:,Kmm) )
+         CALL iom_put(  "vbar", vv_b(:,:,Kmm) )
+      ENDIF
+      IF( l_trddyn ) THEN                ! 3D output: asselin filter trends on momentum
+         zua(:,:,:) = ( puu(:,:,:,Kmm) - zua(:,:,:) ) * z1_2dt
+         zva(:,:,:) = ( pvv(:,:,:,Kmm) - zva(:,:,:) ) * z1_2dt
+         CALL trd_dyn( zua, zva, jpdyn_atf, kt, Kmm )
+      ENDIF
+      !
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Kaa), clinfo1=' nxt  - puu(:,:,:,Kaa): ', mask1=umask,   &
+         &                                  tab3d_2=pvv(:,:,:,Kaa), clinfo2=' pvv(:,:,:,Kaa): '       , mask2=vmask )
+      ! 
+      IF( ln_dynspg_ts )   DEALLOCATE( zue, zve )
+      IF( l_trddyn     )   DEALLOCATE( zua, zva )
+      IF( ln_timing    )   CALL timing_stop('dyn_atf')
+      !
+   END SUBROUTINE dyn_atf
+
+   !!=========================================================================
+END MODULE dynatf
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynhpg.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynhpg.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynhpg.F90	(revision 12928)
@@ -31,4 +31,6 @@
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers
+   USE isf_oce , ONLY : risfload  ! ice shelf  (risfload variable)
+   USE isfload , ONLY : isf_load  ! ice shelf  (isf_load routine )
    USE sbc_oce         ! surface variable (only for the flag with ice shelf)
    USE dom_oce         ! ocean space and time domain
@@ -73,5 +75,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -81,5 +83,5 @@
 CONTAINS
 
-   SUBROUTINE dyn_hpg( kt )
+   SUBROUTINE dyn_hpg( kt, Kmm, puu, pvv, Krhs )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE dyn_hpg  ***
@@ -88,8 +90,11 @@
       !!              using the scheme defined in the namelist
       !!
-      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend
+      !! ** Action : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the now hydrastatic pressure trend
       !!             - send trends to trd_dyn for futher diagnostics (l_trddyn=T)
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation
+      !
       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdu, ztrdv
       !!----------------------------------------------------------------------
@@ -97,28 +102,28 @@
       IF( ln_timing )   CALL timing_start('dyn_hpg')
       !
-      IF( l_trddyn ) THEN                    ! Temporary saving of ua and va trends (l_trddyn)
+      IF( l_trddyn ) THEN                    ! Temporary saving of puu(:,:,:,Krhs) and pvv(:,:,:,Krhs) trends (l_trddyn)
          ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) )
-         ztrdu(:,:,:) = ua(:,:,:)
-         ztrdv(:,:,:) = va(:,:,:)
+         ztrdu(:,:,:) = puu(:,:,:,Krhs)
+         ztrdv(:,:,:) = pvv(:,:,:,Krhs)
       ENDIF
       !
       SELECT CASE ( nhpg )      ! Hydrostatic pressure gradient computation
-      CASE ( np_zco )   ;   CALL hpg_zco    ( kt )      ! z-coordinate
-      CASE ( np_zps )   ;   CALL hpg_zps    ( kt )      ! z-coordinate plus partial steps (interpolation)
-      CASE ( np_sco )   ;   CALL hpg_sco    ( kt )      ! s-coordinate (standard jacobian formulation)
-      CASE ( np_djc )   ;   CALL hpg_djc    ( kt )      ! s-coordinate (Density Jacobian with Cubic polynomial)
-      CASE ( np_prj )   ;   CALL hpg_prj    ( kt )      ! s-coordinate (Pressure Jacobian scheme)
-      CASE ( np_isf )   ;   CALL hpg_isf    ( kt )      ! s-coordinate similar to sco modify for ice shelf
+      CASE ( np_zco )   ;   CALL hpg_zco    ( kt, Kmm, puu, pvv, Krhs )  ! z-coordinate
+      CASE ( np_zps )   ;   CALL hpg_zps    ( kt, Kmm, puu, pvv, Krhs )  ! z-coordinate plus partial steps (interpolation)
+      CASE ( np_sco )   ;   CALL hpg_sco    ( kt, Kmm, puu, pvv, Krhs )  ! s-coordinate (standard jacobian formulation)
+      CASE ( np_djc )   ;   CALL hpg_djc    ( kt, Kmm, puu, pvv, Krhs )  ! s-coordinate (Density Jacobian with Cubic polynomial)
+      CASE ( np_prj )   ;   CALL hpg_prj    ( kt, Kmm, puu, pvv, Krhs )  ! s-coordinate (Pressure Jacobian scheme)
+      CASE ( np_isf )   ;   CALL hpg_isf    ( kt, Kmm, puu, pvv, Krhs )  ! s-coordinate similar to sco modify for ice shelf
       END SELECT
       !
       IF( l_trddyn ) THEN      ! save the hydrostatic pressure gradient trends for momentum trend diagnostics
-         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
-         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
-         CALL trd_dyn( ztrdu, ztrdv, jpdyn_hpg, kt )
+         ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:)
+         ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:)
+         CALL trd_dyn( ztrdu, ztrdv, jpdyn_hpg, kt, Kmm )
          DEALLOCATE( ztrdu , ztrdv )
       ENDIF
       !
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' hpg  - Ua: ', mask1=umask,   &
-         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' hpg  - Ua: ', mask1=umask,   &
+         &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
       !
       IF( ln_timing )   CALL timing_stop('dyn_hpg')
@@ -127,5 +132,5 @@
 
 
-   SUBROUTINE dyn_hpg_init
+   SUBROUTINE dyn_hpg_init( Kmm )
       !!----------------------------------------------------------------------
       !!                 ***  ROUTINE dyn_hpg_init  ***
@@ -137,4 +142,6 @@
       !!      with the type of vertical coordinate used (zco, zps, sco)
       !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) :: Kmm   ! ocean time level index
+      !
       INTEGER ::   ioptio = 0      ! temporary integer
       INTEGER ::   ios             ! Local integer output status for namelist read
@@ -150,9 +157,7 @@
       !!----------------------------------------------------------------------
       !
-      REWIND( numnam_ref )              ! Namelist namdyn_hpg in reference namelist : Hydrostatic pressure gradient
       READ  ( numnam_ref, namdyn_hpg, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_hpg in reference namelist' )
       !
-      REWIND( numnam_cfg )              ! Namelist namdyn_hpg in configuration namelist : Hydrostatic pressure gradient
       READ  ( numnam_cfg, namdyn_hpg, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_hpg in configuration namelist' )
@@ -213,48 +218,8 @@
       ENDIF
       !                          
-      IF ( .NOT. ln_isfcav ) THEN     !--- no ice shelf load
-         riceload(:,:) = 0._wp
-         !
-      ELSE                            !--- set an ice shelf load
-         !
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '   ice shelf case: set the ice-shelf load'
-         ALLOCATE( zts_top(jpi,jpj,jpts) , zrhd(jpi,jpj,jpk) , zrhdtop_isf(jpi,jpj) , ziceload(jpi,jpj) ) 
-         !
-         znad = 1._wp                     !- To use density and not density anomaly
-         !
-         !                                !- assume water displaced by the ice shelf is at T=-1.9 and S=34.4 (rude)
-         zts_top(:,:,jp_tem) = -1.9_wp   ;   zts_top(:,:,jp_sal) = 34.4_wp
-         !
-         DO jk = 1, jpk                   !- compute density of the water displaced by the ice shelf 
-            CALL eos( zts_top(:,:,:), gdept_n(:,:,jk), zrhd(:,:,jk) )
-         END DO
-         !
-         !                                !- compute rhd at the ice/oce interface (ice shelf side)
-         CALL eos( zts_top , risfdep, zrhdtop_isf )
-         !
-         !                                !- Surface value + ice shelf gradient
-         ziceload = 0._wp                       ! compute pressure due to ice shelf load 
-         DO jj = 1, jpj                         ! (used to compute hpgi/j for all the level from 1 to miku/v)
-            DO ji = 1, jpi                      ! divided by 2 later
-               ikt = mikt(ji,jj)
-               ziceload(ji,jj) = ziceload(ji,jj) + (znad + zrhd(ji,jj,1) ) * e3w_n(ji,jj,1) * (1._wp - tmask(ji,jj,1))
-               DO jk = 2, ikt-1
-                  ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + zrhd(ji,jj,jk-1) + zrhd(ji,jj,jk)) * e3w_n(ji,jj,jk) &
-                     &                              * (1._wp - tmask(ji,jj,jk))
-               END DO
-               IF (ikt  >=  2) ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + zrhdtop_isf(ji,jj) + zrhd(ji,jj,ikt-1)) &
-                  &                                              * ( risfdep(ji,jj) - gdept_n(ji,jj,ikt-1) )
-            END DO
-         END DO
-         riceload(:,:) = ziceload(:,:)  ! need to be saved for diaar5
-         !
-         DEALLOCATE( zts_top , zrhd , zrhdtop_isf , ziceload ) 
-      ENDIF
-      !
    END SUBROUTINE dyn_hpg_init
 
 
-   SUBROUTINE hpg_zco( kt )
+   SUBROUTINE hpg_zco( kt, Kmm, puu, pvv, Krhs )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE hpg_zco  ***
@@ -266,11 +231,13 @@
       !!      level:    zhpi = grav .....
       !!                zhpj = grav .....
-      !!      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
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
+      !!      add it to the general momentum trend (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)).
+      !!            puu(:,:,:,Krhs) = puu(:,:,:,Krhs) - 1/e1u * zhpi
+      !!            pvv(:,:,:,Krhs) = pvv(:,:,:,Krhs) - 1/e2v * zhpj
+      !!
+      !! ** Action : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the now hydrastatic pressure trend
+      !!----------------------------------------------------------------------
+      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation
       !
       INTEGER  ::   ji, jj, jk       ! dummy loop indices
@@ -288,41 +255,35 @@
 
       ! Surface value
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            zcoef1 = zcoef0 * e3w_n(ji,jj,1)
-            ! hydrostatic pressure gradient
-            zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj,1) - rhd(ji,jj,1) ) * r1_e1u(ji,jj)
-            zhpj(ji,jj,1) = zcoef1 * ( rhd(ji,jj+1,1) - rhd(ji,jj,1) ) * r1_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)
-         END DO
-      END DO
+      DO_2D_00_00
+         zcoef1 = zcoef0 * e3w(ji,jj,1,Kmm)
+         ! hydrostatic pressure gradient
+         zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj,1) - rhd(ji,jj,1) ) * r1_e1u(ji,jj)
+         zhpj(ji,jj,1) = zcoef1 * ( rhd(ji,jj+1,1) - rhd(ji,jj,1) ) * r1_e2v(ji,jj)
+         ! add to the general momentum trend
+         puu(ji,jj,1,Krhs) = puu(ji,jj,1,Krhs) + zhpi(ji,jj,1)
+         pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) + zhpj(ji,jj,1)
+      END_2D
 
       !
       ! interior value (2=<jk=<jpkm1)
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zcoef1 = zcoef0 * e3w_n(ji,jj,jk)
-               ! 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) )  ) * r1_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) )  ) * r1_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)
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 2, jpkm1 )
+         zcoef1 = zcoef0 * e3w(ji,jj,jk,Kmm)
+         ! 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) )  ) * r1_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) )  ) * r1_e2v(ji,jj)
+         ! add to the general momentum trend
+         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + zhpi(ji,jj,jk)
+         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + zhpj(ji,jj,jk)
+      END_3D
       !
    END SUBROUTINE hpg_zco
 
 
-   SUBROUTINE hpg_zps( kt )
+   SUBROUTINE hpg_zps( kt, Kmm, puu, pvv, Krhs )
       !!---------------------------------------------------------------------
       !!                 ***  ROUTINE hpg_zps  ***
@@ -330,7 +291,9 @@
       !! ** Method  :   z-coordinate plus partial steps case.  blahblah...
       !!
-      !! ** Action  : - Update (ua,va) with the now hydrastatic pressure trend
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
+      !! ** Action  : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the now hydrastatic pressure trend
+      !!----------------------------------------------------------------------
+      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation
       !!
       INTEGER  ::   ji, jj, jk                       ! dummy loop indices
@@ -348,5 +311,5 @@
 
       ! Partial steps: Compute NOW horizontal gradient of t, s, rd at the last ocean level
-      CALL zps_hde( kt, jpts, tsn, zgtsu, zgtsv, rhd, zgru , zgrv )
+      CALL zps_hde( kt, Kmm, jpts, ts(:,:,:,:,Kmm), zgtsu, zgtsv, rhd, zgru , zgrv )
 
       ! Local constant initialization
@@ -354,62 +317,54 @@
 
       !  Surface value (also valid in partial step case)
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            zcoef1 = zcoef0 * e3w_n(ji,jj,1)
-            ! hydrostatic pressure gradient
-            zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj  ,1) - rhd(ji,jj,1) ) * r1_e1u(ji,jj)
-            zhpj(ji,jj,1) = zcoef1 * ( rhd(ji  ,jj+1,1) - rhd(ji,jj,1) ) * r1_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)
-         END DO
-      END DO
+      DO_2D_00_00
+         zcoef1 = zcoef0 * e3w(ji,jj,1,Kmm)
+         ! hydrostatic pressure gradient
+         zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj  ,1) - rhd(ji,jj,1) ) * r1_e1u(ji,jj)
+         zhpj(ji,jj,1) = zcoef1 * ( rhd(ji  ,jj+1,1) - rhd(ji,jj,1) ) * r1_e2v(ji,jj)
+         ! add to the general momentum trend
+         puu(ji,jj,1,Krhs) = puu(ji,jj,1,Krhs) + zhpi(ji,jj,1)
+         pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) + zhpj(ji,jj,1)
+      END_2D
 
       ! interior value (2=<jk=<jpkm1)
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zcoef1 = zcoef0 * e3w_n(ji,jj,jk)
-               ! 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) )  ) * r1_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) )  ) * r1_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)
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 2, jpkm1 )
+         zcoef1 = zcoef0 * e3w(ji,jj,jk,Kmm)
+         ! 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) )  ) * r1_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) )  ) * r1_e2v(ji,jj)
+         ! add to the general momentum trend
+         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + zhpi(ji,jj,jk)
+         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + zhpj(ji,jj,jk)
+      END_3D
 
       ! partial steps correction at the last level  (use zgru & zgrv computed in zpshde.F90)
-      DO jj = 2, jpjm1
-         DO ji = 2, jpim1
-            iku = mbku(ji,jj)
-            ikv = mbkv(ji,jj)
-            zcoef2 = zcoef0 * MIN( e3w_n(ji,jj,iku), e3w_n(ji+1,jj  ,iku) )
-            zcoef3 = zcoef0 * MIN( e3w_n(ji,jj,ikv), e3w_n(ji  ,jj+1,ikv) )
-            IF( iku > 1 ) THEN            ! on i-direction (level 2 or more)
-               ua  (ji,jj,iku) = ua(ji,jj,iku) - zhpi(ji,jj,iku)         ! subtract old value
-               zhpi(ji,jj,iku) = zhpi(ji,jj,iku-1)                   &   ! compute the new one
-                  &            + zcoef2 * ( rhd(ji+1,jj,iku-1) - rhd(ji,jj,iku-1) + zgru(ji,jj) ) * r1_e1u(ji,jj)
-               ua  (ji,jj,iku) = ua(ji,jj,iku) + zhpi(ji,jj,iku)         ! add the new one to the general momentum trend
-            ENDIF
-            IF( ikv > 1 ) THEN            ! on j-direction (level 2 or more)
-               va  (ji,jj,ikv) = va(ji,jj,ikv) - zhpj(ji,jj,ikv)         ! subtract old value
-               zhpj(ji,jj,ikv) = zhpj(ji,jj,ikv-1)                   &   ! compute the new one
-                  &            + zcoef3 * ( rhd(ji,jj+1,ikv-1) - rhd(ji,jj,ikv-1) + zgrv(ji,jj) ) * r1_e2v(ji,jj)
-               va  (ji,jj,ikv) = va(ji,jj,ikv) + zhpj(ji,jj,ikv)         ! add the new one to the general momentum trend
-            ENDIF
-         END DO
-      END DO
+      DO_2D_00_00
+         iku = mbku(ji,jj)
+         ikv = mbkv(ji,jj)
+         zcoef2 = zcoef0 * MIN( e3w(ji,jj,iku,Kmm), e3w(ji+1,jj  ,iku,Kmm) )
+         zcoef3 = zcoef0 * MIN( e3w(ji,jj,ikv,Kmm), e3w(ji  ,jj+1,ikv,Kmm) )
+         IF( iku > 1 ) THEN            ! on i-direction (level 2 or more)
+            puu  (ji,jj,iku,Krhs) = puu(ji,jj,iku,Krhs) - zhpi(ji,jj,iku)         ! subtract old value
+            zhpi(ji,jj,iku) = zhpi(ji,jj,iku-1)                   &   ! compute the new one
+               &            + zcoef2 * ( rhd(ji+1,jj,iku-1) - rhd(ji,jj,iku-1) + zgru(ji,jj) ) * r1_e1u(ji,jj)
+            puu  (ji,jj,iku,Krhs) = puu(ji,jj,iku,Krhs) + zhpi(ji,jj,iku)         ! add the new one to the general momentum trend
+         ENDIF
+         IF( ikv > 1 ) THEN            ! on j-direction (level 2 or more)
+            pvv  (ji,jj,ikv,Krhs) = pvv(ji,jj,ikv,Krhs) - zhpj(ji,jj,ikv)         ! subtract old value
+            zhpj(ji,jj,ikv) = zhpj(ji,jj,ikv-1)                   &   ! compute the new one
+               &            + zcoef3 * ( rhd(ji,jj+1,ikv-1) - rhd(ji,jj,ikv-1) + zgrv(ji,jj) ) * r1_e2v(ji,jj)
+            pvv  (ji,jj,ikv,Krhs) = pvv(ji,jj,ikv,Krhs) + zhpj(ji,jj,ikv)         ! add the new one to the general momentum trend
+         ENDIF
+      END_2D
       !
    END SUBROUTINE hpg_zps
 
 
-   SUBROUTINE hpg_sco( kt )
+   SUBROUTINE hpg_sco( kt, Kmm, puu, pvv, Krhs )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE hpg_sco  ***
@@ -423,11 +378,13 @@
       !!         zhpi = grav .....  + 1/e1u mi(rhd) di[ grav dep3w ]
       !!         zhpj = grav .....  + 1/e2v mj(rhd) dj[ grav 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
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
+      !!      add it to the general momentum trend (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)).
+      !!         puu(:,:,:,Krhs) = puu(:,:,:,Krhs) - 1/e1u * zhpi
+      !!         pvv(:,:,:,Krhs) = pvv(:,:,:,Krhs) - 1/e2v * zhpj
+      !!
+      !! ** Action : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the now hydrastatic pressure trend
+      !!----------------------------------------------------------------------
+      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation
       !!
       INTEGER  ::   ji, jj, jk, jii, jjj                 ! dummy loop indices
@@ -452,103 +409,95 @@
       !
       IF( ln_wd_il ) THEN
-        DO jj = 2, jpjm1
-           DO ji = 2, jpim1 
-             ll_tmp1 = MIN(  sshn(ji,jj)               ,  sshn(ji+1,jj) ) >                &
-                  &    MAX( -ht_0(ji,jj)               , -ht_0(ji+1,jj) ) .AND.            &
-                  &    MAX(  sshn(ji,jj) +  ht_0(ji,jj),  sshn(ji+1,jj) + ht_0(ji+1,jj) )  &
-                  &                                                       > rn_wdmin1 + rn_wdmin2
-             ll_tmp2 = ( ABS( sshn(ji,jj)              -  sshn(ji+1,jj) ) > 1.E-12 ) .AND. (       &
-                  &    MAX(   sshn(ji,jj)              ,  sshn(ji+1,jj) ) >                &
-                  &    MAX(  -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
-
-             IF(ll_tmp1) THEN
-               zcpx(ji,jj) = 1.0_wp
-             ELSE IF(ll_tmp2) THEN
-               ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here
-               zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_0(ji+1,jj) - sshn(ji,jj) - ht_0(ji,jj)) &
-                           &    / (sshn(ji+1,jj) - sshn(ji  ,jj)) )
-             ELSE
-               zcpx(ji,jj) = 0._wp
-             END IF
-      
-             ll_tmp1 = MIN(  sshn(ji,jj)              ,  sshn(ji,jj+1) ) >                &
-                  &    MAX( -ht_0(ji,jj)              , -ht_0(ji,jj+1) ) .AND.            &
-                  &    MAX(  sshn(ji,jj) + ht_0(ji,jj),  sshn(ji,jj+1) + ht_0(ji,jj+1) )  &
-                  &                                                      > rn_wdmin1 + rn_wdmin2
-             ll_tmp2 = ( ABS( sshn(ji,jj)             -  sshn(ji,jj+1) ) > 1.E-12 ) .AND. (        &
-                  &    MAX(   sshn(ji,jj)             ,  sshn(ji,jj+1) ) >                &
-                  &    MAX(  -ht_0(ji,jj)             , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
-
-             IF(ll_tmp1) THEN
-               zcpy(ji,jj) = 1.0_wp
-             ELSE IF(ll_tmp2) THEN
-               ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here
-               zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_0(ji,jj+1) - sshn(ji,jj) - ht_0(ji,jj)) &
-                           &    / (sshn(ji,jj+1) - sshn(ji,jj  )) )
-             ELSE
-               zcpy(ji,jj) = 0._wp
-             END IF
-           END DO
-        END DO
+        DO_2D_00_00
+          ll_tmp1 = MIN(  ssh(ji,jj,Kmm)               ,  ssh(ji+1,jj,Kmm) ) >                &
+               &    MAX( -ht_0(ji,jj)               , -ht_0(ji+1,jj) ) .AND.            &
+               &    MAX(  ssh(ji,jj,Kmm) +  ht_0(ji,jj),  ssh(ji+1,jj,Kmm) + ht_0(ji+1,jj) )  &
+               &                                                       > rn_wdmin1 + rn_wdmin2
+          ll_tmp2 = ( ABS( ssh(ji,jj,Kmm)              -  ssh(ji+1,jj,Kmm) ) > 1.E-12 ) .AND. (       &
+               &    MAX(   ssh(ji,jj,Kmm)              ,  ssh(ji+1,jj,Kmm) ) >                &
+               &    MAX(  -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
+
+          IF(ll_tmp1) THEN
+            zcpx(ji,jj) = 1.0_wp
+          ELSE IF(ll_tmp2) THEN
+            ! no worries about  ssh(ji+1,jj,Kmm) -  ssh(ji  ,jj,Kmm) = 0, it won't happen ! here
+            zcpx(ji,jj) = ABS( (ssh(ji+1,jj,Kmm) + ht_0(ji+1,jj) - ssh(ji,jj,Kmm) - ht_0(ji,jj)) &
+                        &    / (ssh(ji+1,jj,Kmm) - ssh(ji  ,jj,Kmm)) )
+          ELSE
+            zcpx(ji,jj) = 0._wp
+          END IF
+   
+          ll_tmp1 = MIN(  ssh(ji,jj,Kmm)              ,  ssh(ji,jj+1,Kmm) ) >                &
+               &    MAX( -ht_0(ji,jj)              , -ht_0(ji,jj+1) ) .AND.            &
+               &    MAX(  ssh(ji,jj,Kmm) + ht_0(ji,jj),  ssh(ji,jj+1,Kmm) + ht_0(ji,jj+1) )  &
+               &                                                      > rn_wdmin1 + rn_wdmin2
+          ll_tmp2 = ( ABS( ssh(ji,jj,Kmm)             -  ssh(ji,jj+1,Kmm) ) > 1.E-12 ) .AND. (        &
+               &    MAX(   ssh(ji,jj,Kmm)             ,  ssh(ji,jj+1,Kmm) ) >                &
+               &    MAX(  -ht_0(ji,jj)             , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
+
+          IF(ll_tmp1) THEN
+            zcpy(ji,jj) = 1.0_wp
+          ELSE IF(ll_tmp2) THEN
+            ! no worries about  ssh(ji,jj+1,Kmm) -  ssh(ji,jj  ,Kmm) = 0, it won't happen ! here
+            zcpy(ji,jj) = ABS( (ssh(ji,jj+1,Kmm) + ht_0(ji,jj+1) - ssh(ji,jj,Kmm) - ht_0(ji,jj)) &
+                        &    / (ssh(ji,jj+1,Kmm) - ssh(ji,jj  ,Kmm)) )
+          ELSE
+            zcpy(ji,jj) = 0._wp
+          END IF
+        END_2D
         CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1., zcpy, 'V', 1. )
       END IF
 
       ! 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 * (  e3w_n(ji+1,jj  ,1) * ( znad + rhd(ji+1,jj  ,1) )    &
-               &                      - e3w_n(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) )  ) * r1_e1u(ji,jj)
-            zhpj(ji,jj,1) = zcoef0 * (  e3w_n(ji  ,jj+1,1) * ( znad + rhd(ji  ,jj+1,1) )    &
-               &                      - e3w_n(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) )  ) * r1_e2v(ji,jj)
-            ! s-coordinate pressure gradient correction
-            zuap = -zcoef0 * ( rhd    (ji+1,jj,1) + rhd    (ji,jj,1) + 2._wp * znad )   &
-               &           * ( gde3w_n(ji+1,jj,1) - gde3w_n(ji,jj,1) ) * r1_e1u(ji,jj)
-            zvap = -zcoef0 * ( rhd    (ji,jj+1,1) + rhd    (ji,jj,1) + 2._wp * znad )   &
-               &           * ( gde3w_n(ji,jj+1,1) - gde3w_n(ji,jj,1) ) * r1_e2v(ji,jj)
-            !
-            IF( ln_wd_il ) THEN
-               zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj)
-               zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj) 
-               zuap = zuap * zcpx(ji,jj)
-               zvap = zvap * zcpy(ji,jj)
-            ENDIF
-            !
-            ! 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
-         END DO
-      END DO
+      DO_2D_00_00
+         ! hydrostatic pressure gradient along s-surfaces
+         zhpi(ji,jj,1) = zcoef0 * (  e3w(ji+1,jj  ,1,Kmm) * ( znad + rhd(ji+1,jj  ,1) )    &
+            &                      - e3w(ji  ,jj  ,1,Kmm) * ( znad + rhd(ji  ,jj  ,1) )  ) * r1_e1u(ji,jj)
+         zhpj(ji,jj,1) = zcoef0 * (  e3w(ji  ,jj+1,1,Kmm) * ( znad + rhd(ji  ,jj+1,1) )    &
+            &                      - e3w(ji  ,jj  ,1,Kmm) * ( znad + rhd(ji  ,jj  ,1) )  ) * r1_e2v(ji,jj)
+         ! s-coordinate pressure gradient correction
+         zuap = -zcoef0 * ( rhd    (ji+1,jj,1) + rhd    (ji,jj,1) + 2._wp * znad )   &
+            &           * ( gde3w(ji+1,jj,1) - gde3w(ji,jj,1) ) * r1_e1u(ji,jj)
+         zvap = -zcoef0 * ( rhd    (ji,jj+1,1) + rhd    (ji,jj,1) + 2._wp * znad )   &
+            &           * ( gde3w(ji,jj+1,1) - gde3w(ji,jj,1) ) * r1_e2v(ji,jj)
+         !
+         IF( ln_wd_il ) THEN
+            zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj)
+            zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj) 
+            zuap = zuap * zcpx(ji,jj)
+            zvap = zvap * zcpy(ji,jj)
+         ENDIF
+         !
+         ! add to the general momentum trend
+         puu(ji,jj,1,Krhs) = puu(ji,jj,1,Krhs) + zhpi(ji,jj,1) + zuap
+         pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) + zhpj(ji,jj,1) + zvap
+      END_2D
 
       ! 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 * r1_e1u(ji,jj)   &
-                  &           * (  e3w_n(ji+1,jj,jk) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad )   &
-                  &              - e3w_n(ji  ,jj,jk) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad )  )
-               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 * r1_e2v(ji,jj)   &
-                  &           * (  e3w_n(ji,jj+1,jk) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad )   &
-                  &              - e3w_n(ji,jj  ,jk) * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) + 2*znad )  )
-               ! s-coordinate pressure gradient correction
-               zuap = -zcoef0 * ( rhd    (ji+1,jj  ,jk) + rhd    (ji,jj,jk) + 2._wp * znad )   &
-                  &           * ( gde3w_n(ji+1,jj  ,jk) - gde3w_n(ji,jj,jk) ) * r1_e1u(ji,jj)
-               zvap = -zcoef0 * ( rhd    (ji  ,jj+1,jk) + rhd    (ji,jj,jk) + 2._wp * znad )   &
-                  &           * ( gde3w_n(ji  ,jj+1,jk) - gde3w_n(ji,jj,jk) ) * r1_e2v(ji,jj)
-               !
-               IF( ln_wd_il ) THEN
-                  zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj)
-                  zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj) 
-                  zuap = zuap * zcpx(ji,jj)
-                  zvap = zvap * zcpy(ji,jj)
-               ENDIF
-               !
-               ! 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
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 2, jpkm1 )
+         ! hydrostatic pressure gradient along s-surfaces
+         zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 * r1_e1u(ji,jj)   &
+            &           * (  e3w(ji+1,jj,jk,Kmm) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad )   &
+            &              - e3w(ji  ,jj,jk,Kmm) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad )  )
+         zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 * r1_e2v(ji,jj)   &
+            &           * (  e3w(ji,jj+1,jk,Kmm) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad )   &
+            &              - e3w(ji,jj  ,jk,Kmm) * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) + 2*znad )  )
+         ! s-coordinate pressure gradient correction
+         zuap = -zcoef0 * ( rhd    (ji+1,jj  ,jk) + rhd    (ji,jj,jk) + 2._wp * znad )   &
+            &           * ( gde3w(ji+1,jj  ,jk) - gde3w(ji,jj,jk) ) * r1_e1u(ji,jj)
+         zvap = -zcoef0 * ( rhd    (ji  ,jj+1,jk) + rhd    (ji,jj,jk) + 2._wp * znad )   &
+            &           * ( gde3w(ji  ,jj+1,jk) - gde3w(ji,jj,jk) ) * r1_e2v(ji,jj)
+         !
+         IF( ln_wd_il ) THEN
+            zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj)
+            zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj) 
+            zuap = zuap * zcpx(ji,jj)
+            zvap = zvap * zcpy(ji,jj)
+         ENDIF
+         !
+         ! add to the general momentum trend
+         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + zhpi(ji,jj,jk) + zuap
+         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + zhpj(ji,jj,jk) + zvap
+      END_3D
       !
       IF( ln_wd_il )  DEALLOCATE( zcpx , zcpy )
@@ -557,5 +506,5 @@
 
 
-   SUBROUTINE hpg_isf( kt )
+   SUBROUTINE hpg_isf( kt, Kmm, puu, pvv, Krhs )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE hpg_isf  ***
@@ -569,12 +518,14 @@
       !!         zhpi = grav .....  + 1/e1u mi(rhd) di[ grav dep3w ]
       !!         zhpj = grav .....  + 1/e2v mj(rhd) dj[ grav dep3w ]
-      !!      add it to the general momentum trend (ua,va).
-      !!         ua = ua - 1/e1u * zhpi
-      !!         va = va - 1/e2v * zhpj
-      !!      iceload is added and partial cell case are added to the top and bottom
+      !!      add it to the general momentum trend (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)).
+      !!         puu(:,:,:,Krhs) = puu(:,:,:,Krhs) - 1/e1u * zhpi
+      !!         pvv(:,:,:,Krhs) = pvv(:,:,:,Krhs) - 1/e2v * zhpj
+      !!      iceload is added
       !!      
-      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
+      !! ** Action : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the now hydrastatic pressure trend
+      !!----------------------------------------------------------------------
+      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation
       !!
       INTEGER  ::   ji, jj, jk, ikt, iktp1i, iktp1j   ! dummy loop indices
@@ -597,6 +548,6 @@
         DO jj = 1, jpj
           ikt = mikt(ji,jj)
-          zts_top(ji,jj,1) = tsn(ji,jj,ikt,1)
-          zts_top(ji,jj,2) = tsn(ji,jj,ikt,2)
+          zts_top(ji,jj,1) = ts(ji,jj,ikt,1,Kmm)
+          zts_top(ji,jj,2) = ts(ji,jj,ikt,2,Kmm)
         END DO
       END DO
@@ -606,61 +557,55 @@
 !===== Compute surface value ===================================================== 
 !==================================================================================
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            ikt    = mikt(ji,jj)
-            iktp1i = mikt(ji+1,jj)
-            iktp1j = mikt(ji,jj+1)
-            ! hydrostatic pressure gradient along s-surfaces and ice shelf pressure
-            ! we assume ISF is in isostatic equilibrium
-            zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( 0.5_wp * e3w_n(ji+1,jj,iktp1i)                                    &
-               &                                    * ( 2._wp * znad + rhd(ji+1,jj,iktp1i) + zrhdtop_oce(ji+1,jj) )   &
-               &                                  - 0.5_wp * e3w_n(ji,jj,ikt)                                         &
-               &                                    * ( 2._wp * znad + rhd(ji,jj,ikt) + zrhdtop_oce(ji,jj) )          &
-               &                                  + ( riceload(ji+1,jj) - riceload(ji,jj))                            ) 
-            zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( 0.5_wp * e3w_n(ji,jj+1,iktp1j)                                    &
-               &                                    * ( 2._wp * znad + rhd(ji,jj+1,iktp1j) + zrhdtop_oce(ji,jj+1) )   &
-               &                                  - 0.5_wp * e3w_n(ji,jj,ikt)                                         & 
-               &                                    * ( 2._wp * znad + rhd(ji,jj,ikt) + zrhdtop_oce(ji,jj) )          &
-               &                                  + ( riceload(ji,jj+1) - riceload(ji,jj))                            ) 
-            ! s-coordinate pressure gradient correction (=0 if z coordinate)
-            zuap = -zcoef0 * ( rhd    (ji+1,jj,1) + rhd    (ji,jj,1) + 2._wp * znad )   &
-               &           * ( gde3w_n(ji+1,jj,1) - gde3w_n(ji,jj,1) ) * r1_e1u(ji,jj)
-            zvap = -zcoef0 * ( rhd    (ji,jj+1,1) + rhd    (ji,jj,1) + 2._wp * znad )   &
-               &           * ( gde3w_n(ji,jj+1,1) - gde3w_n(ji,jj,1) ) * r1_e2v(ji,jj)
-            ! add to the general momentum trend
-            ua(ji,jj,1) = ua(ji,jj,1) + (zhpi(ji,jj,1) + zuap) * umask(ji,jj,1)
-            va(ji,jj,1) = va(ji,jj,1) + (zhpj(ji,jj,1) + zvap) * vmask(ji,jj,1)
-         END DO
-      END DO
+      DO_2D_00_00
+         ikt    = mikt(ji,jj)
+         iktp1i = mikt(ji+1,jj)
+         iktp1j = mikt(ji,jj+1)
+         ! hydrostatic pressure gradient along s-surfaces and ice shelf pressure
+         ! we assume ISF is in isostatic equilibrium
+         zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( 0.5_wp * e3w(ji+1,jj,iktp1i,Kmm)                                    &
+            &                                    * ( 2._wp * znad + rhd(ji+1,jj,iktp1i) + zrhdtop_oce(ji+1,jj) )   &
+            &                                  - 0.5_wp * e3w(ji,jj,ikt,Kmm)                                         &
+            &                                    * ( 2._wp * znad + rhd(ji,jj,ikt) + zrhdtop_oce(ji,jj) )          &
+            &                                  + ( risfload(ji+1,jj) - risfload(ji,jj))                            ) 
+         zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( 0.5_wp * e3w(ji,jj+1,iktp1j,Kmm)                                    &
+            &                                    * ( 2._wp * znad + rhd(ji,jj+1,iktp1j) + zrhdtop_oce(ji,jj+1) )   &
+            &                                  - 0.5_wp * e3w(ji,jj,ikt,Kmm)                                         & 
+            &                                    * ( 2._wp * znad + rhd(ji,jj,ikt) + zrhdtop_oce(ji,jj) )          &
+            &                                  + ( risfload(ji,jj+1) - risfload(ji,jj))                            ) 
+         ! s-coordinate pressure gradient correction (=0 if z coordinate)
+         zuap = -zcoef0 * ( rhd    (ji+1,jj,1) + rhd    (ji,jj,1) + 2._wp * znad )   &
+            &           * ( gde3w(ji+1,jj,1) - gde3w(ji,jj,1) ) * r1_e1u(ji,jj)
+         zvap = -zcoef0 * ( rhd    (ji,jj+1,1) + rhd    (ji,jj,1) + 2._wp * znad )   &
+            &           * ( gde3w(ji,jj+1,1) - gde3w(ji,jj,1) ) * r1_e2v(ji,jj)
+         ! add to the general momentum trend
+         puu(ji,jj,1,Krhs) = puu(ji,jj,1,Krhs) + (zhpi(ji,jj,1) + zuap) * umask(ji,jj,1)
+         pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) + (zhpj(ji,jj,1) + zvap) * vmask(ji,jj,1)
+      END_2D
 !==================================================================================     
 !===== Compute interior value ===================================================== 
 !==================================================================================
       ! 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)   &
-                  &           * (  e3w_n(ji+1,jj,jk) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad ) * wmask(ji+1,jj,jk)   &
-                  &              - e3w_n(ji  ,jj,jk) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad ) * wmask(ji  ,jj,jk)   )
-               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 / e2v(ji,jj)   &
-                  &           * (  e3w_n(ji,jj+1,jk) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad ) * wmask(ji,jj+1,jk)   &
-                  &              - e3w_n(ji,jj  ,jk) * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) + 2*znad ) * wmask(ji,jj  ,jk)   )
-               ! s-coordinate pressure gradient correction
-               zuap = -zcoef0 * ( rhd   (ji+1,jj  ,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   &
-                  &           * ( gde3w_n(ji+1,jj  ,jk) - gde3w_n(ji,jj,jk) ) / e1u(ji,jj)
-               zvap = -zcoef0 * ( rhd   (ji  ,jj+1,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   &
-                  &           * ( gde3w_n(ji  ,jj+1,jk) - gde3w_n(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) * umask(ji,jj,jk)
-               va(ji,jj,jk) = va(ji,jj,jk) + (zhpj(ji,jj,jk) + zvap) * vmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 2, jpkm1 )
+         ! hydrostatic pressure gradient along s-surfaces
+         zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj)   &
+            &           * (  e3w(ji+1,jj,jk,Kmm) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad ) * wmask(ji+1,jj,jk)   &
+            &              - e3w(ji  ,jj,jk,Kmm) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad ) * wmask(ji  ,jj,jk)   )
+         zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 / e2v(ji,jj)   &
+            &           * (  e3w(ji,jj+1,jk,Kmm) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad ) * wmask(ji,jj+1,jk)   &
+            &              - e3w(ji,jj  ,jk,Kmm) * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) + 2*znad ) * wmask(ji,jj  ,jk)   )
+         ! s-coordinate pressure gradient correction
+         zuap = -zcoef0 * ( rhd   (ji+1,jj  ,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   &
+            &           * ( gde3w(ji+1,jj  ,jk) - gde3w(ji,jj,jk) ) / e1u(ji,jj)
+         zvap = -zcoef0 * ( rhd   (ji  ,jj+1,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   &
+            &           * ( gde3w(ji  ,jj+1,jk) - gde3w(ji,jj,jk) ) / e2v(ji,jj)
+         ! add to the general momentum trend
+         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + (zhpi(ji,jj,jk) + zuap) * umask(ji,jj,jk)
+         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + (zhpj(ji,jj,jk) + zvap) * vmask(ji,jj,jk)
+      END_3D
       !
    END SUBROUTINE hpg_isf
 
 
-   SUBROUTINE hpg_djc( kt )
+   SUBROUTINE hpg_djc( kt, Kmm, puu, pvv, Krhs )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE hpg_djc  ***
@@ -670,5 +615,7 @@
       !! Reference: Shchepetkin and McWilliams, J. Geophys. Res., 108(C3), 3090, 2003
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation
       !!
       INTEGER  ::   ji, jj, jk          ! dummy loop indices
@@ -686,42 +633,40 @@
       IF( ln_wd_il ) THEN
          ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) )
-        DO jj = 2, jpjm1
-           DO ji = 2, jpim1 
-             ll_tmp1 = MIN(  sshn(ji,jj)              ,  sshn(ji+1,jj) ) >                &
-                  &    MAX( -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) .AND.            &
-                  &    MAX(  sshn(ji,jj) + ht_0(ji,jj),  sshn(ji+1,jj) + ht_0(ji+1,jj) )  &
-                  &                                                      > rn_wdmin1 + rn_wdmin2
-             ll_tmp2 = ( ABS( sshn(ji,jj)             -  sshn(ji+1,jj) ) > 1.E-12 ) .AND. (        &
-                  &    MAX(   sshn(ji,jj)             ,  sshn(ji+1,jj) ) >                &
-                  &    MAX(  -ht_0(ji,jj)             , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
-             IF(ll_tmp1) THEN
-               zcpx(ji,jj) = 1.0_wp
-             ELSE IF(ll_tmp2) THEN
-               ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here
-               zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_0(ji+1,jj) - sshn(ji,jj) - ht_0(ji,jj)) &
-                           &    / (sshn(ji+1,jj) - sshn(ji  ,jj)) )
-             ELSE
-               zcpx(ji,jj) = 0._wp
-             END IF
-      
-             ll_tmp1 = MIN(  sshn(ji,jj)              ,  sshn(ji,jj+1) ) >                &
-                  &    MAX( -ht_0(ji,jj)              , -ht_0(ji,jj+1) ) .AND.            &
-                  &    MAX(  sshn(ji,jj) + ht_0(ji,jj),  sshn(ji,jj+1) + ht_0(ji,jj+1) )  &
-                  &                                                      > rn_wdmin1 + rn_wdmin2
-             ll_tmp2 = ( ABS( sshn(ji,jj)             -  sshn(ji,jj+1) ) > 1.E-12 ) .AND. (        &
-                  &    MAX(   sshn(ji,jj)             ,  sshn(ji,jj+1) ) >                &
-                  &    MAX(  -ht_0(ji,jj)             , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
-
-             IF(ll_tmp1) THEN
-               zcpy(ji,jj) = 1.0_wp
-             ELSE IF(ll_tmp2) THEN
-               ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here
-               zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_0(ji,jj+1) - sshn(ji,jj) - ht_0(ji,jj)) &
-                           &    / (sshn(ji,jj+1) - sshn(ji,jj  )) )
-             ELSE
-               zcpy(ji,jj) = 0._wp
-             END IF
-           END DO
-        END DO
+        DO_2D_00_00
+          ll_tmp1 = MIN(  ssh(ji,jj,Kmm)              ,  ssh(ji+1,jj,Kmm) ) >                &
+               &    MAX( -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) .AND.            &
+               &    MAX(  ssh(ji,jj,Kmm) + ht_0(ji,jj),  ssh(ji+1,jj,Kmm) + ht_0(ji+1,jj) )  &
+               &                                                      > rn_wdmin1 + rn_wdmin2
+          ll_tmp2 = ( ABS( ssh(ji,jj,Kmm)             -  ssh(ji+1,jj,Kmm) ) > 1.E-12 ) .AND. (        &
+               &    MAX(   ssh(ji,jj,Kmm)             ,  ssh(ji+1,jj,Kmm) ) >                &
+               &    MAX(  -ht_0(ji,jj)             , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
+          IF(ll_tmp1) THEN
+            zcpx(ji,jj) = 1.0_wp
+          ELSE IF(ll_tmp2) THEN
+            ! no worries about  ssh(ji+1,jj,Kmm) -  ssh(ji  ,jj,Kmm) = 0, it won't happen ! here
+            zcpx(ji,jj) = ABS( (ssh(ji+1,jj,Kmm) + ht_0(ji+1,jj) - ssh(ji,jj,Kmm) - ht_0(ji,jj)) &
+                        &    / (ssh(ji+1,jj,Kmm) - ssh(ji  ,jj,Kmm)) )
+          ELSE
+            zcpx(ji,jj) = 0._wp
+          END IF
+   
+          ll_tmp1 = MIN(  ssh(ji,jj,Kmm)              ,  ssh(ji,jj+1,Kmm) ) >                &
+               &    MAX( -ht_0(ji,jj)              , -ht_0(ji,jj+1) ) .AND.            &
+               &    MAX(  ssh(ji,jj,Kmm) + ht_0(ji,jj),  ssh(ji,jj+1,Kmm) + ht_0(ji,jj+1) )  &
+               &                                                      > rn_wdmin1 + rn_wdmin2
+          ll_tmp2 = ( ABS( ssh(ji,jj,Kmm)             -  ssh(ji,jj+1,Kmm) ) > 1.E-12 ) .AND. (        &
+               &    MAX(   ssh(ji,jj,Kmm)             ,  ssh(ji,jj+1,Kmm) ) >                &
+               &    MAX(  -ht_0(ji,jj)             , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
+
+          IF(ll_tmp1) THEN
+            zcpy(ji,jj) = 1.0_wp
+          ELSE IF(ll_tmp2) THEN
+            ! no worries about  ssh(ji,jj+1,Kmm) -  ssh(ji,jj  ,Kmm) = 0, it won't happen ! here
+            zcpy(ji,jj) = ABS( (ssh(ji,jj+1,Kmm) + ht_0(ji,jj+1) - ssh(ji,jj,Kmm) - ht_0(ji,jj)) &
+                        &    / (ssh(ji,jj+1,Kmm) - ssh(ji,jj  ,Kmm)) )
+          ELSE
+            zcpy(ji,jj) = 0._wp
+          END IF
+        END_2D
         CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1., zcpy, 'V', 1. )
       END IF
@@ -744,16 +689,12 @@
 !!bug gm   Not a true bug, but... dzz=e3w  for dzx, dzy verify what it is really
 
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               drhoz(ji,jj,jk) = rhd    (ji  ,jj  ,jk) - rhd    (ji,jj,jk-1)
-               dzz  (ji,jj,jk) = gde3w_n(ji  ,jj  ,jk) - gde3w_n(ji,jj,jk-1)
-               drhox(ji,jj,jk) = rhd    (ji+1,jj  ,jk) - rhd    (ji,jj,jk  )
-               dzx  (ji,jj,jk) = gde3w_n(ji+1,jj  ,jk) - gde3w_n(ji,jj,jk  )
-               drhoy(ji,jj,jk) = rhd    (ji  ,jj+1,jk) - rhd    (ji,jj,jk  )
-               dzy  (ji,jj,jk) = gde3w_n(ji  ,jj+1,jk) - gde3w_n(ji,jj,jk  )
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 2, jpkm1 )
+         drhoz(ji,jj,jk) = rhd    (ji  ,jj  ,jk) - rhd    (ji,jj,jk-1)
+         dzz  (ji,jj,jk) = gde3w(ji  ,jj  ,jk) - gde3w(ji,jj,jk-1)
+         drhox(ji,jj,jk) = rhd    (ji+1,jj  ,jk) - rhd    (ji,jj,jk  )
+         dzx  (ji,jj,jk) = gde3w(ji+1,jj  ,jk) - gde3w(ji,jj,jk  )
+         drhoy(ji,jj,jk) = rhd    (ji  ,jj+1,jk) - rhd    (ji,jj,jk  )
+         dzy  (ji,jj,jk) = gde3w(ji  ,jj+1,jk) - gde3w(ji,jj,jk  )
+      END_3D
 
       !-------------------------------------------------------------------------
@@ -765,56 +706,52 @@
 !!bug  gm  idem for drhox, drhoy et ji=jpi and jj=jpj
 
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               cffw = 2._wp * drhoz(ji  ,jj  ,jk) * drhoz(ji,jj,jk-1)
-
-               cffu = 2._wp * drhox(ji+1,jj  ,jk) * drhox(ji,jj,jk  )
-               cffx = 2._wp * dzx  (ji+1,jj  ,jk) * dzx  (ji,jj,jk  )
-
-               cffv = 2._wp * drhoy(ji  ,jj+1,jk) * drhoy(ji,jj,jk  )
-               cffy = 2._wp * dzy  (ji  ,jj+1,jk) * dzy  (ji,jj,jk  )
-
-               IF( cffw > zep) THEN
-                  drhow(ji,jj,jk) = 2._wp *   drhoz(ji,jj,jk) * drhoz(ji,jj,jk-1)   &
-                     &                    / ( drhoz(ji,jj,jk) + drhoz(ji,jj,jk-1) )
-               ELSE
-                  drhow(ji,jj,jk) = 0._wp
-               ENDIF
-
-               dzw(ji,jj,jk) = 2._wp *   dzz(ji,jj,jk) * dzz(ji,jj,jk-1)   &
-                  &                  / ( dzz(ji,jj,jk) + dzz(ji,jj,jk-1) )
-
-               IF( cffu > zep ) THEN
-                  drhou(ji,jj,jk) = 2._wp *   drhox(ji+1,jj,jk) * drhox(ji,jj,jk)   &
-                     &                    / ( drhox(ji+1,jj,jk) + drhox(ji,jj,jk) )
-               ELSE
-                  drhou(ji,jj,jk ) = 0._wp
-               ENDIF
-
-               IF( cffx > zep ) THEN
-                  dzu(ji,jj,jk) = 2._wp *   dzx(ji+1,jj,jk) * dzx(ji,jj,jk)   &
-                     &                  / ( dzx(ji+1,jj,jk) + dzx(ji,jj,jk) )
-               ELSE
-                  dzu(ji,jj,jk) = 0._wp
-               ENDIF
-
-               IF( cffv > zep ) THEN
-                  drhov(ji,jj,jk) = 2._wp *   drhoy(ji,jj+1,jk) * drhoy(ji,jj,jk)   &
-                     &                    / ( drhoy(ji,jj+1,jk) + drhoy(ji,jj,jk) )
-               ELSE
-                  drhov(ji,jj,jk) = 0._wp
-               ENDIF
-
-               IF( cffy > zep ) THEN
-                  dzv(ji,jj,jk) = 2._wp *   dzy(ji,jj+1,jk) * dzy(ji,jj,jk)   &
-                     &                  / ( dzy(ji,jj+1,jk) + dzy(ji,jj,jk) )
-               ELSE
-                  dzv(ji,jj,jk) = 0._wp
-               ENDIF
-
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 2, jpkm1 )
+         cffw = 2._wp * drhoz(ji  ,jj  ,jk) * drhoz(ji,jj,jk-1)
+
+         cffu = 2._wp * drhox(ji+1,jj  ,jk) * drhox(ji,jj,jk  )
+         cffx = 2._wp * dzx  (ji+1,jj  ,jk) * dzx  (ji,jj,jk  )
+
+         cffv = 2._wp * drhoy(ji  ,jj+1,jk) * drhoy(ji,jj,jk  )
+         cffy = 2._wp * dzy  (ji  ,jj+1,jk) * dzy  (ji,jj,jk  )
+
+         IF( cffw > zep) THEN
+            drhow(ji,jj,jk) = 2._wp *   drhoz(ji,jj,jk) * drhoz(ji,jj,jk-1)   &
+               &                    / ( drhoz(ji,jj,jk) + drhoz(ji,jj,jk-1) )
+         ELSE
+            drhow(ji,jj,jk) = 0._wp
+         ENDIF
+
+         dzw(ji,jj,jk) = 2._wp *   dzz(ji,jj,jk) * dzz(ji,jj,jk-1)   &
+            &                  / ( dzz(ji,jj,jk) + dzz(ji,jj,jk-1) )
+
+         IF( cffu > zep ) THEN
+            drhou(ji,jj,jk) = 2._wp *   drhox(ji+1,jj,jk) * drhox(ji,jj,jk)   &
+               &                    / ( drhox(ji+1,jj,jk) + drhox(ji,jj,jk) )
+         ELSE
+            drhou(ji,jj,jk ) = 0._wp
+         ENDIF
+
+         IF( cffx > zep ) THEN
+            dzu(ji,jj,jk) = 2._wp *   dzx(ji+1,jj,jk) * dzx(ji,jj,jk)   &
+               &                  / ( dzx(ji+1,jj,jk) + dzx(ji,jj,jk) )
+         ELSE
+            dzu(ji,jj,jk) = 0._wp
+         ENDIF
+
+         IF( cffv > zep ) THEN
+            drhov(ji,jj,jk) = 2._wp *   drhoy(ji,jj+1,jk) * drhoy(ji,jj,jk)   &
+               &                    / ( drhoy(ji,jj+1,jk) + drhoy(ji,jj,jk) )
+         ELSE
+            drhov(ji,jj,jk) = 0._wp
+         ENDIF
+
+         IF( cffy > zep ) THEN
+            dzv(ji,jj,jk) = 2._wp *   dzy(ji,jj+1,jk) * dzy(ji,jj,jk)   &
+               &                  / ( dzy(ji,jj+1,jk) + dzy(ji,jj,jk) )
+         ELSE
+            dzv(ji,jj,jk) = 0._wp
+         ENDIF
+
+      END_3D
 
       !----------------------------------------------------------------------------------
@@ -837,51 +774,45 @@
 !          true if gde3w is really defined as the sum of the e3w scale factors as, it seems to me, it should be
 
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            rho_k(ji,jj,1) = -grav * ( e3w_n(ji,jj,1) - gde3w_n(ji,jj,1) )               &
-               &                   * (  rhd(ji,jj,1)                                     &
-               &                     + 0.5_wp * ( rhd    (ji,jj,2) - rhd    (ji,jj,1) )  &
-               &                              * ( e3w_n  (ji,jj,1) - gde3w_n(ji,jj,1) )  &
-               &                              / ( gde3w_n(ji,jj,2) - gde3w_n(ji,jj,1) )  )
-         END DO
-      END DO
+      DO_2D_00_00
+         rho_k(ji,jj,1) = -grav * ( e3w(ji,jj,1,Kmm) - gde3w(ji,jj,1) )               &
+            &                   * (  rhd(ji,jj,1)                                     &
+            &                     + 0.5_wp * ( rhd    (ji,jj,2) - rhd    (ji,jj,1) )  &
+            &                              * ( e3w  (ji,jj,1,Kmm) - gde3w(ji,jj,1) )  &
+            &                              / ( gde3w(ji,jj,2) - gde3w(ji,jj,1) )  )
+      END_2D
 
 !!bug gm    : here also, simplification is possible
 !!bug gm    : optimisation: 1/10 and 1/12 the division should be done before the loop
 
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-
-               rho_k(ji,jj,jk) = zcoef0 * ( rhd    (ji,jj,jk) + rhd    (ji,jj,jk-1) )                                   &
-                  &                     * ( gde3w_n(ji,jj,jk) - gde3w_n(ji,jj,jk-1) )                                   &
-                  &            - grav * z1_10 * (                                                                   &
-                  &     ( drhow  (ji,jj,jk) - drhow  (ji,jj,jk-1) )                                                     &
-                  &   * ( gde3w_n(ji,jj,jk) - gde3w_n(ji,jj,jk-1) - z1_12 * ( dzw  (ji,jj,jk) + dzw  (ji,jj,jk-1) ) )   &
-                  &   - ( dzw    (ji,jj,jk) - dzw    (ji,jj,jk-1) )                                                     &
-                  &   * ( rhd    (ji,jj,jk) - rhd    (ji,jj,jk-1) - z1_12 * ( drhow(ji,jj,jk) + drhow(ji,jj,jk-1) ) )   &
-                  &                             )
-
-               rho_i(ji,jj,jk) = zcoef0 * ( rhd    (ji+1,jj,jk) + rhd    (ji,jj,jk) )                                   &
-                  &                     * ( gde3w_n(ji+1,jj,jk) - gde3w_n(ji,jj,jk) )                                   &
-                  &            - grav* z1_10 * (                                                                    &
-                  &     ( drhou  (ji+1,jj,jk) - drhou  (ji,jj,jk) )                                                     &
-                  &   * ( gde3w_n(ji+1,jj,jk) - gde3w_n(ji,jj,jk) - z1_12 * ( dzu  (ji+1,jj,jk) + dzu  (ji,jj,jk) ) )   &
-                  &   - ( dzu    (ji+1,jj,jk) - dzu    (ji,jj,jk) )                                                     &
-                  &   * ( rhd    (ji+1,jj,jk) - rhd    (ji,jj,jk) - z1_12 * ( drhou(ji+1,jj,jk) + drhou(ji,jj,jk) ) )   &
-                  &                            )
-
-               rho_j(ji,jj,jk) = zcoef0 * ( rhd    (ji,jj+1,jk) + rhd    (ji,jj,jk) )                                 &
-                  &                     * ( gde3w_n(ji,jj+1,jk) - gde3w_n(ji,jj,jk) )                                   &
-                  &            - grav* z1_10 * (                                                                    &
-                  &     ( drhov  (ji,jj+1,jk) - drhov  (ji,jj,jk) )                                                     &
-                  &   * ( gde3w_n(ji,jj+1,jk) - gde3w_n(ji,jj,jk) - z1_12 * ( dzv  (ji,jj+1,jk) + dzv  (ji,jj,jk) ) )   &
-                  &   - ( dzv    (ji,jj+1,jk) - dzv    (ji,jj,jk) )                                                     &
-                  &   * ( rhd    (ji,jj+1,jk) - rhd    (ji,jj,jk) - z1_12 * ( drhov(ji,jj+1,jk) + drhov(ji,jj,jk) ) )   &
-                  &                            )
-
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 2, jpkm1 )
+
+         rho_k(ji,jj,jk) = zcoef0 * ( rhd    (ji,jj,jk) + rhd    (ji,jj,jk-1) )                                   &
+            &                     * ( gde3w(ji,jj,jk) - gde3w(ji,jj,jk-1) )                                   &
+            &            - grav * z1_10 * (                                                                   &
+            &     ( drhow  (ji,jj,jk) - drhow  (ji,jj,jk-1) )                                                     &
+            &   * ( gde3w(ji,jj,jk) - gde3w(ji,jj,jk-1) - z1_12 * ( dzw  (ji,jj,jk) + dzw  (ji,jj,jk-1) ) )   &
+            &   - ( dzw    (ji,jj,jk) - dzw    (ji,jj,jk-1) )                                                     &
+            &   * ( rhd    (ji,jj,jk) - rhd    (ji,jj,jk-1) - z1_12 * ( drhow(ji,jj,jk) + drhow(ji,jj,jk-1) ) )   &
+            &                             )
+
+         rho_i(ji,jj,jk) = zcoef0 * ( rhd    (ji+1,jj,jk) + rhd    (ji,jj,jk) )                                   &
+            &                     * ( gde3w(ji+1,jj,jk) - gde3w(ji,jj,jk) )                                   &
+            &            - grav* z1_10 * (                                                                    &
+            &     ( drhou  (ji+1,jj,jk) - drhou  (ji,jj,jk) )                                                     &
+            &   * ( gde3w(ji+1,jj,jk) - gde3w(ji,jj,jk) - z1_12 * ( dzu  (ji+1,jj,jk) + dzu  (ji,jj,jk) ) )   &
+            &   - ( dzu    (ji+1,jj,jk) - dzu    (ji,jj,jk) )                                                     &
+            &   * ( rhd    (ji+1,jj,jk) - rhd    (ji,jj,jk) - z1_12 * ( drhou(ji+1,jj,jk) + drhou(ji,jj,jk) ) )   &
+            &                            )
+
+         rho_j(ji,jj,jk) = zcoef0 * ( rhd    (ji,jj+1,jk) + rhd    (ji,jj,jk) )                                 &
+            &                     * ( gde3w(ji,jj+1,jk) - gde3w(ji,jj,jk) )                                   &
+            &            - grav* z1_10 * (                                                                    &
+            &     ( drhov  (ji,jj+1,jk) - drhov  (ji,jj,jk) )                                                     &
+            &   * ( gde3w(ji,jj+1,jk) - gde3w(ji,jj,jk) - z1_12 * ( dzv  (ji,jj+1,jk) + dzv  (ji,jj,jk) ) )   &
+            &   - ( dzv    (ji,jj+1,jk) - dzv    (ji,jj,jk) )                                                     &
+            &   * ( rhd    (ji,jj+1,jk) - rhd    (ji,jj,jk) - z1_12 * ( drhov(ji,jj+1,jk) + drhov(ji,jj,jk) ) )   &
+            &                            )
+
+      END_3D
       CALL lbc_lnk_multi( 'dynhpg', rho_k, 'W', 1., rho_i, 'U', 1., rho_j, 'V', 1. )
 
@@ -889,41 +820,35 @@
       !  Surface value
       ! ---------------
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            zhpi(ji,jj,1) = ( rho_k(ji+1,jj  ,1) - rho_k(ji,jj,1) - rho_i(ji,jj,1) ) * r1_e1u(ji,jj)
-            zhpj(ji,jj,1) = ( rho_k(ji  ,jj+1,1) - rho_k(ji,jj,1) - rho_j(ji,jj,1) ) * r1_e2v(ji,jj)
-            IF( ln_wd_il ) THEN
-              zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj)
-              zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj) 
-            ENDIF
-            ! 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)
-         END DO
-      END DO
+      DO_2D_00_00
+         zhpi(ji,jj,1) = ( rho_k(ji+1,jj  ,1) - rho_k(ji,jj,1) - rho_i(ji,jj,1) ) * r1_e1u(ji,jj)
+         zhpj(ji,jj,1) = ( rho_k(ji  ,jj+1,1) - rho_k(ji,jj,1) - rho_j(ji,jj,1) ) * r1_e2v(ji,jj)
+         IF( ln_wd_il ) THEN
+           zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj)
+           zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj) 
+         ENDIF
+         ! add to the general momentum trend
+         puu(ji,jj,1,Krhs) = puu(ji,jj,1,Krhs) + zhpi(ji,jj,1)
+         pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) + zhpj(ji,jj,1)
+      END_2D
 
       ! ----------------
       !  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)                                &
-                  &           + (  ( rho_k(ji+1,jj,jk) - rho_k(ji,jj,jk  ) )    &
-                  &              - ( rho_i(ji  ,jj,jk) - rho_i(ji,jj,jk-1) )  ) * r1_e1u(ji,jj)
-               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)                                &
-                  &           + (  ( rho_k(ji,jj+1,jk) - rho_k(ji,jj,jk  ) )    &
-                  &               -( rho_j(ji,jj  ,jk) - rho_j(ji,jj,jk-1) )  ) * r1_e2v(ji,jj)
-               IF( ln_wd_il ) THEN
-                 zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj)
-                 zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj) 
-               ENDIF
-               ! 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)
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 2, jpkm1 )
+         ! hydrostatic pressure gradient along s-surfaces
+         zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)                                &
+            &           + (  ( rho_k(ji+1,jj,jk) - rho_k(ji,jj,jk  ) )    &
+            &              - ( rho_i(ji  ,jj,jk) - rho_i(ji,jj,jk-1) )  ) * r1_e1u(ji,jj)
+         zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)                                &
+            &           + (  ( rho_k(ji,jj+1,jk) - rho_k(ji,jj,jk  ) )    &
+            &               -( rho_j(ji,jj  ,jk) - rho_j(ji,jj,jk-1) )  ) * r1_e2v(ji,jj)
+         IF( ln_wd_il ) THEN
+           zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj)
+           zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj) 
+         ENDIF
+         ! add to the general momentum trend
+         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + zhpi(ji,jj,jk)
+         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + zhpj(ji,jj,jk)
+      END_3D
       !
       IF( ln_wd_il )   DEALLOCATE( zcpx, zcpy )
@@ -932,5 +857,5 @@
 
 
-   SUBROUTINE hpg_prj( kt )
+   SUBROUTINE hpg_prj( kt, Kmm, puu, pvv, Krhs )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE hpg_prj  ***
@@ -941,8 +866,10 @@
       !!      all vertical coordinate systems
       !!
-      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend
+      !! ** Action : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the now hydrastatic pressure trend
       !!----------------------------------------------------------------------
       INTEGER, PARAMETER  :: polynomial_type = 1    ! 1: cubic spline, 2: linear
-      INTEGER, INTENT(in) ::   kt                   ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation
       !!
       INTEGER  ::   ji, jj, jk, jkk                 ! dummy loop indices
@@ -974,47 +901,45 @@
       IF( ln_wd_il ) THEN
          ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) )
-         DO jj = 2, jpjm1
-           DO ji = 2, jpim1 
-             ll_tmp1 = MIN(  sshn(ji,jj)              ,  sshn(ji+1,jj) ) >                &
-                  &    MAX( -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) .AND.            &
-                  &    MAX(  sshn(ji,jj) + ht_0(ji,jj),  sshn(ji+1,jj) + ht_0(ji+1,jj) )  &
-                  &                                                      > rn_wdmin1 + rn_wdmin2
-             ll_tmp2 = ( ABS( sshn(ji,jj)             -  sshn(ji+1,jj) ) > 1.E-12 ) .AND. (         &
-                  &    MAX(   sshn(ji,jj)             ,  sshn(ji+1,jj) ) >                &
-                  &    MAX(  -ht_0(ji,jj)             , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
-
-             IF(ll_tmp1) THEN
-               zcpx(ji,jj) = 1.0_wp
-             ELSE IF(ll_tmp2) THEN
-               ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here
-               zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_0(ji+1,jj) - sshn(ji,jj) - ht_0(ji,jj)) &
-                           &    / (sshn(ji+1,jj) -  sshn(ji  ,jj)) )
-              
-                zcpx(ji,jj) = max(min( zcpx(ji,jj) , 1.0_wp),0.0_wp)
-             ELSE
-               zcpx(ji,jj) = 0._wp
-             END IF
-      
-             ll_tmp1 = MIN(  sshn(ji,jj)              ,  sshn(ji,jj+1) ) >                &
-                  &    MAX( -ht_0(ji,jj)              , -ht_0(ji,jj+1) ) .AND.            &
-                  &    MAX(  sshn(ji,jj) + ht_0(ji,jj),  sshn(ji,jj+1) + ht_0(ji,jj+1) )  &
-                  &                                                      > rn_wdmin1 + rn_wdmin2
-             ll_tmp2 = ( ABS( sshn(ji,jj)             -  sshn(ji,jj+1) ) > 1.E-12 ) .AND. (      &
-                  &    MAX(   sshn(ji,jj)             ,  sshn(ji,jj+1) ) >                &
-                  &    MAX(  -ht_0(ji,jj)             , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
-
-             IF(ll_tmp1) THEN
-               zcpy(ji,jj) = 1.0_wp
-             ELSE IF(ll_tmp2) THEN
-               ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here
-               zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_0(ji,jj+1) - sshn(ji,jj) - ht_0(ji,jj)) &
-                           &    / (sshn(ji,jj+1) - sshn(ji,jj  )) )
-                zcpy(ji,jj) = max(min( zcpy(ji,jj) , 1.0_wp),0.0_wp)
-
-               ELSE
-                  zcpy(ji,jj) = 0._wp
-               ENDIF
-            END DO
-         END DO
+         DO_2D_00_00
+          ll_tmp1 = MIN(  ssh(ji,jj,Kmm)              ,  ssh(ji+1,jj,Kmm) ) >                &
+               &    MAX( -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) .AND.            &
+               &    MAX(  ssh(ji,jj,Kmm) + ht_0(ji,jj),  ssh(ji+1,jj,Kmm) + ht_0(ji+1,jj) )  &
+               &                                                      > rn_wdmin1 + rn_wdmin2
+          ll_tmp2 = ( ABS( ssh(ji,jj,Kmm)             -  ssh(ji+1,jj,Kmm) ) > 1.E-12 ) .AND. (         &
+               &    MAX(   ssh(ji,jj,Kmm)             ,  ssh(ji+1,jj,Kmm) ) >                &
+               &    MAX(  -ht_0(ji,jj)             , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
+
+          IF(ll_tmp1) THEN
+            zcpx(ji,jj) = 1.0_wp
+          ELSE IF(ll_tmp2) THEN
+            ! no worries about  ssh(ji+1,jj,Kmm) -  ssh(ji  ,jj,Kmm) = 0, it won't happen ! here
+            zcpx(ji,jj) = ABS( (ssh(ji+1,jj,Kmm) + ht_0(ji+1,jj) - ssh(ji,jj,Kmm) - ht_0(ji,jj)) &
+                        &    / (ssh(ji+1,jj,Kmm) -  ssh(ji  ,jj,Kmm)) )
+           
+             zcpx(ji,jj) = max(min( zcpx(ji,jj) , 1.0_wp),0.0_wp)
+          ELSE
+            zcpx(ji,jj) = 0._wp
+          END IF
+   
+          ll_tmp1 = MIN(  ssh(ji,jj,Kmm)              ,  ssh(ji,jj+1,Kmm) ) >                &
+               &    MAX( -ht_0(ji,jj)              , -ht_0(ji,jj+1) ) .AND.            &
+               &    MAX(  ssh(ji,jj,Kmm) + ht_0(ji,jj),  ssh(ji,jj+1,Kmm) + ht_0(ji,jj+1) )  &
+               &                                                      > rn_wdmin1 + rn_wdmin2
+          ll_tmp2 = ( ABS( ssh(ji,jj,Kmm)             -  ssh(ji,jj+1,Kmm) ) > 1.E-12 ) .AND. (      &
+               &    MAX(   ssh(ji,jj,Kmm)             ,  ssh(ji,jj+1,Kmm) ) >                &
+               &    MAX(  -ht_0(ji,jj)             , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
+
+          IF(ll_tmp1) THEN
+            zcpy(ji,jj) = 1.0_wp
+          ELSE IF(ll_tmp2) THEN
+            ! no worries about  ssh(ji,jj+1,Kmm) -  ssh(ji,jj  ,Kmm) = 0, it won't happen ! here
+            zcpy(ji,jj) = ABS( (ssh(ji,jj+1,Kmm) + ht_0(ji,jj+1) - ssh(ji,jj,Kmm) - ht_0(ji,jj)) &
+                        &    / (ssh(ji,jj+1,Kmm) - ssh(ji,jj  ,Kmm)) )
+             zcpy(ji,jj) = max(min( zcpy(ji,jj) , 1.0_wp),0.0_wp)
+
+            ELSE
+               zcpy(ji,jj) = 0._wp
+            ENDIF
+         END_2D
          CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1., zcpy, 'V', 1. )
       ENDIF
@@ -1025,32 +950,24 @@
 
       ! Preparing vertical density profile "zrhh(:,:,:)" for hybrid-sco coordinate
-      DO jj = 1, jpj
-        DO ji = 1, jpi
-          jk = mbkt(ji,jj)+1
-          IF(     jk <=  0   ) THEN   ;   zrhh(ji,jj,    :   ) = 0._wp
-          ELSEIF( jk ==  1   ) THEN   ;   zrhh(ji,jj,jk+1:jpk) = rhd(ji,jj,jk)
-          ELSEIF( jk < jpkm1 ) THEN
-             DO jkk = jk+1, jpk
-                zrhh(ji,jj,jkk) = interp1(gde3w_n(ji,jj,jkk  ), gde3w_n(ji,jj,jkk-1),   &
-                   &                      gde3w_n(ji,jj,jkk-2), rhd    (ji,jj,jkk-1), rhd(ji,jj,jkk-2))
-             END DO
-          ENDIF
-        END DO
-      END DO
+      DO_2D_11_11
+       jk = mbkt(ji,jj)+1
+       IF(     jk <=  0   ) THEN   ;   zrhh(ji,jj,    :   ) = 0._wp
+       ELSEIF( jk ==  1   ) THEN   ;   zrhh(ji,jj,jk+1:jpk) = rhd(ji,jj,jk)
+       ELSEIF( jk < jpkm1 ) THEN
+          DO jkk = jk+1, jpk
+             zrhh(ji,jj,jkk) = interp1(gde3w(ji,jj,jkk  ), gde3w(ji,jj,jkk-1),   &
+                &                      gde3w(ji,jj,jkk-2), rhd    (ji,jj,jkk-1), rhd(ji,jj,jkk-2))
+          END DO
+       ENDIF
+      END_2D
 
       ! Transfer the depth of "T(:,:,:)" to vertical coordinate "zdept(:,:,:)"
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zdept(ji,jj,1) = 0.5_wp * e3w_n(ji,jj,1) - sshn(ji,jj) * znad
-         END DO
-      END DO
-
-      DO jk = 2, jpk
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zdept(ji,jj,jk) = zdept(ji,jj,jk-1) + e3w_n(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_2D_11_11
+         zdept(ji,jj,1) = 0.5_wp * e3w(ji,jj,1,Kmm) - ssh(ji,jj,Kmm) * znad
+      END_2D
+
+      DO_3D_11_11( 2, jpk )
+         zdept(ji,jj,jk) = zdept(ji,jj,jk-1) + e3w(ji,jj,jk,Kmm)
+      END_3D
 
       fsp(:,:,:) = zrhh (:,:,:)
@@ -1063,212 +980,186 @@
 
       ! Integrate the hydrostatic pressure "zhpi(:,:,:)" at "T(ji,jj,1)"
-      DO jj = 2, jpj
-        DO ji = 2, jpi
-          zrhdt1 = zrhh(ji,jj,1) - interp3( zdept(ji,jj,1), asp(ji,jj,1), bsp(ji,jj,1),  &
-             &                                              csp(ji,jj,1), dsp(ji,jj,1) ) * 0.25_wp * e3w_n(ji,jj,1)
-
-          ! assuming linear profile across the top half surface layer
-          zhpi(ji,jj,1) =  0.5_wp * e3w_n(ji,jj,1) * zrhdt1
-        END DO
-      END DO
+      DO_2D_01_01
+       zrhdt1 = zrhh(ji,jj,1) - interp3( zdept(ji,jj,1), asp(ji,jj,1), bsp(ji,jj,1),  &
+          &                                              csp(ji,jj,1), dsp(ji,jj,1) ) * 0.25_wp * e3w(ji,jj,1,Kmm)
+
+       ! assuming linear profile across the top half surface layer
+       zhpi(ji,jj,1) =  0.5_wp * e3w(ji,jj,1,Kmm) * zrhdt1
+      END_2D
 
       ! Calculate the pressure "zhpi(:,:,:)" at "T(ji,jj,2:jpkm1)"
-      DO jk = 2, jpkm1
-        DO jj = 2, jpj
-          DO ji = 2, jpi
-            zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) +                                  &
-               &             integ_spline( zdept(ji,jj,jk-1), zdept(ji,jj,jk),   &
-               &                           asp  (ji,jj,jk-1), bsp  (ji,jj,jk-1), &
-               &                           csp  (ji,jj,jk-1), dsp  (ji,jj,jk-1)  )
-          END DO
-        END DO
-      END DO
+      DO_3D_01_01( 2, jpkm1 )
+      zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) +                                  &
+         &             integ_spline( zdept(ji,jj,jk-1), zdept(ji,jj,jk),   &
+         &                           asp  (ji,jj,jk-1), bsp  (ji,jj,jk-1), &
+         &                           csp  (ji,jj,jk-1), dsp  (ji,jj,jk-1)  )
+      END_3D
 
       ! Z coordinate of U(ji,jj,1:jpkm1) and V(ji,jj,1:jpkm1)
 
       ! Prepare zsshu_n and zsshv_n
-      DO jj = 2, jpjm1
-        DO ji = 2, jpim1
+      DO_2D_00_00
 !!gm BUG ?    if it is ssh at u- & v-point then it should be:
-!          zsshu_n(ji,jj) = (e1e2t(ji,jj) * sshn(ji,jj) + e1e2t(ji+1,jj) * sshn(ji+1,jj)) * &
+!          zsshu_n(ji,jj) = (e1e2t(ji,jj) * ssh(ji,jj,Kmm) + e1e2t(ji+1,jj) * ssh(ji+1,jj,Kmm)) * &
 !                         & r1_e1e2u(ji,jj) * umask(ji,jj,1) * 0.5_wp 
-!          zsshv_n(ji,jj) = (e1e2t(ji,jj) * sshn(ji,jj) + e1e2t(ji,jj+1) * sshn(ji,jj+1)) * &
+!          zsshv_n(ji,jj) = (e1e2t(ji,jj) * ssh(ji,jj,Kmm) + e1e2t(ji,jj+1) * ssh(ji,jj+1,Kmm)) * &
 !                         & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp 
 !!gm not this:
-          zsshu_n(ji,jj) = (e1e2u(ji,jj) * sshn(ji,jj) + e1e2u(ji+1, jj) * sshn(ji+1,jj)) * &
-                         & r1_e1e2u(ji,jj) * umask(ji,jj,1) * 0.5_wp 
-          zsshv_n(ji,jj) = (e1e2v(ji,jj) * sshn(ji,jj) + e1e2v(ji+1, jj) * sshn(ji,jj+1)) * &
-                         & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp 
-        END DO
-      END DO
+       zsshu_n(ji,jj) = (e1e2u(ji,jj) * ssh(ji,jj,Kmm) + e1e2u(ji+1, jj) * ssh(ji+1,jj,Kmm)) * &
+                      & r1_e1e2u(ji,jj) * umask(ji,jj,1) * 0.5_wp 
+       zsshv_n(ji,jj) = (e1e2v(ji,jj) * ssh(ji,jj,Kmm) + e1e2v(ji+1, jj) * ssh(ji,jj+1,Kmm)) * &
+                      & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp 
+      END_2D
 
       CALL lbc_lnk_multi ('dynhpg', zsshu_n, 'U', 1., zsshv_n, 'V', 1. )
 
-      DO jj = 2, jpjm1
-        DO ji = 2, jpim1
-          zu(ji,jj,1) = - ( e3u_n(ji,jj,1) - zsshu_n(ji,jj) * znad) 
-          zv(ji,jj,1) = - ( e3v_n(ji,jj,1) - zsshv_n(ji,jj) * znad)
-        END DO
-      END DO
-
-      DO jk = 2, jpkm1
-        DO jj = 2, jpjm1
-          DO ji = 2, jpim1
-            zu(ji,jj,jk) = zu(ji,jj,jk-1) - e3u_n(ji,jj,jk)
-            zv(ji,jj,jk) = zv(ji,jj,jk-1) - e3v_n(ji,jj,jk)
-          END DO
-        END DO
-      END DO
-
-      DO jk = 1, jpkm1
-        DO jj = 2, jpjm1
-          DO ji = 2, jpim1
-            zu(ji,jj,jk) = zu(ji,jj,jk) + 0.5_wp * e3u_n(ji,jj,jk)
-            zv(ji,jj,jk) = zv(ji,jj,jk) + 0.5_wp * e3v_n(ji,jj,jk)
-          END DO
-        END DO
-      END DO
-
-      DO jk = 1, jpkm1
-        DO jj = 2, jpjm1
-          DO ji = 2, jpim1
-            zu(ji,jj,jk) = MIN(  zu(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  )
-            zu(ji,jj,jk) = MAX(  zu(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  )
-            zv(ji,jj,jk) = MIN(  zv(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji,jj+1,jk) )  )
-            zv(ji,jj,jk) = MAX(  zv(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji,jj+1,jk) )  )
-          END DO
-        END DO
-      END DO
-
-
-      DO jk = 1, jpkm1
-        DO jj = 2, jpjm1
-          DO ji = 2, jpim1
-            zpwes = 0._wp; zpwed = 0._wp
-            zpnss = 0._wp; zpnsd = 0._wp
-            zuijk = zu(ji,jj,jk)
-            zvijk = zv(ji,jj,jk)
-
-            !!!!!     for u equation
-            IF( jk <= mbku(ji,jj) ) THEN
-               IF( -zdept(ji+1,jj,jk) >= -zdept(ji,jj,jk) ) THEN
-                 jis = ji + 1; jid = ji
-               ELSE
-                 jis = ji;     jid = ji +1
-               ENDIF
-
-               ! integrate the pressure on the shallow side
-               jk1 = jk
-               DO WHILE ( -zdept(jis,jj,jk1) > zuijk )
-                 IF( jk1 == mbku(ji,jj) ) THEN
-                   zuijk = -zdept(jis,jj,jk1)
-                   EXIT
-                 ENDIF
-                 zdeps = MIN(zdept(jis,jj,jk1+1), -zuijk)
-                 zpwes = zpwes +                                    &
-                      integ_spline(zdept(jis,jj,jk1), zdeps,            &
-                             asp(jis,jj,jk1),    bsp(jis,jj,jk1), &
-                             csp(jis,jj,jk1),    dsp(jis,jj,jk1))
-                 jk1 = jk1 + 1
-               END DO
-
-               ! integrate the pressure on the deep side
-               jk1 = jk
-               DO WHILE ( -zdept(jid,jj,jk1) < zuijk )
-                 IF( jk1 == 1 ) THEN
-                   zdeps = zdept(jid,jj,1) + MIN(zuijk, sshn(jid,jj)*znad)
-                   zrhdt1 = zrhh(jid,jj,1) - interp3(zdept(jid,jj,1), asp(jid,jj,1), &
-                                                     bsp(jid,jj,1),   csp(jid,jj,1), &
-                                                     dsp(jid,jj,1)) * zdeps
-                   zpwed  = zpwed + 0.5_wp * (zrhh(jid,jj,1) + zrhdt1) * zdeps
-                   EXIT
-                 ENDIF
-                 zdeps = MAX(zdept(jid,jj,jk1-1), -zuijk)
-                 zpwed = zpwed +                                        &
-                        integ_spline(zdeps,              zdept(jid,jj,jk1), &
-                               asp(jid,jj,jk1-1), bsp(jid,jj,jk1-1),  &
-                               csp(jid,jj,jk1-1), dsp(jid,jj,jk1-1) )
-                 jk1 = jk1 - 1
-               END DO
-
-               ! update the momentum trends in u direction
-
-               zdpdx1 = zcoef0 * r1_e1u(ji,jj) * ( zhpi(ji+1,jj,jk) - zhpi(ji,jj,jk) )
-               IF( .NOT.ln_linssh ) THEN
-                 zdpdx2 = zcoef0 * r1_e1u(ji,jj) * &
-                    &    ( REAL(jis-jid, wp) * (zpwes + zpwed) + (sshn(ji+1,jj)-sshn(ji,jj)) )
-                ELSE
-                 zdpdx2 = zcoef0 * r1_e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed)
-               ENDIF
-               IF( ln_wd_il ) THEN
-                  zdpdx1 = zdpdx1 * zcpx(ji,jj) * wdrampu(ji,jj)
-                  zdpdx2 = zdpdx2 * zcpx(ji,jj) * wdrampu(ji,jj)
-               ENDIF
-               ua(ji,jj,jk) = ua(ji,jj,jk) + (zdpdx1 + zdpdx2) * umask(ji,jj,jk) 
-            ENDIF
-
-            !!!!!     for v equation
-            IF( jk <= mbkv(ji,jj) ) THEN
-               IF( -zdept(ji,jj+1,jk) >= -zdept(ji,jj,jk) ) THEN
-                 jjs = jj + 1; jjd = jj
-               ELSE
-                 jjs = jj    ; jjd = jj + 1
-               ENDIF
-
-               ! integrate the pressure on the shallow side
-               jk1 = jk
-               DO WHILE ( -zdept(ji,jjs,jk1) > zvijk )
-                 IF( jk1 == mbkv(ji,jj) ) THEN
-                   zvijk = -zdept(ji,jjs,jk1)
-                   EXIT
-                 ENDIF
-                 zdeps = MIN(zdept(ji,jjs,jk1+1), -zvijk)
-                 zpnss = zpnss +                                      &
-                        integ_spline(zdept(ji,jjs,jk1), zdeps,            &
-                               asp(ji,jjs,jk1),    bsp(ji,jjs,jk1), &
-                               csp(ji,jjs,jk1),    dsp(ji,jjs,jk1) )
-                 jk1 = jk1 + 1
-               END DO
-
-               ! integrate the pressure on the deep side
-               jk1 = jk
-               DO WHILE ( -zdept(ji,jjd,jk1) < zvijk )
-                 IF( jk1 == 1 ) THEN
-                   zdeps = zdept(ji,jjd,1) + MIN(zvijk, sshn(ji,jjd)*znad)
-                   zrhdt1 = zrhh(ji,jjd,1) - interp3(zdept(ji,jjd,1), asp(ji,jjd,1), &
-                                                     bsp(ji,jjd,1),   csp(ji,jjd,1), &
-                                                     dsp(ji,jjd,1) ) * zdeps
-                   zpnsd  = zpnsd + 0.5_wp * (zrhh(ji,jjd,1) + zrhdt1) * zdeps
-                   EXIT
-                 ENDIF
-                 zdeps = MAX(zdept(ji,jjd,jk1-1), -zvijk)
-                 zpnsd = zpnsd +                                        &
-                        integ_spline(zdeps,              zdept(ji,jjd,jk1), &
-                               asp(ji,jjd,jk1-1), bsp(ji,jjd,jk1-1), &
-                               csp(ji,jjd,jk1-1), dsp(ji,jjd,jk1-1) )
-                 jk1 = jk1 - 1
-               END DO
-
-
-               ! update the momentum trends in v direction
-
-               zdpdy1 = zcoef0 * r1_e2v(ji,jj) * ( zhpi(ji,jj+1,jk) - zhpi(ji,jj,jk) )
-               IF( .NOT.ln_linssh ) THEN
-                  zdpdy2 = zcoef0 * r1_e2v(ji,jj) * &
-                          ( REAL(jjs-jjd, wp) * (zpnss + zpnsd) + (sshn(ji,jj+1)-sshn(ji,jj)) )
-               ELSE
-                  zdpdy2 = zcoef0 * r1_e2v(ji,jj) * REAL(jjs-jjd, wp) * (zpnss + zpnsd )
-               ENDIF
-               IF( ln_wd_il ) THEN
-                  zdpdy1 = zdpdy1 * zcpy(ji,jj) * wdrampv(ji,jj) 
-                  zdpdy2 = zdpdy2 * zcpy(ji,jj) * wdrampv(ji,jj) 
-               ENDIF
-
-               va(ji,jj,jk) = va(ji,jj,jk) + (zdpdy1 + zdpdy2) * vmask(ji,jj,jk)
-            ENDIF
-               !
-            END DO
+      DO_2D_00_00
+       zu(ji,jj,1) = - ( e3u(ji,jj,1,Kmm) - zsshu_n(ji,jj) * znad) 
+       zv(ji,jj,1) = - ( e3v(ji,jj,1,Kmm) - zsshv_n(ji,jj) * znad)
+      END_2D
+
+      DO_3D_00_00( 2, jpkm1 )
+      zu(ji,jj,jk) = zu(ji,jj,jk-1) - e3u(ji,jj,jk,Kmm)
+      zv(ji,jj,jk) = zv(ji,jj,jk-1) - e3v(ji,jj,jk,Kmm)
+      END_3D
+
+      DO_3D_00_00( 1, jpkm1 )
+      zu(ji,jj,jk) = zu(ji,jj,jk) + 0.5_wp * e3u(ji,jj,jk,Kmm)
+      zv(ji,jj,jk) = zv(ji,jj,jk) + 0.5_wp * e3v(ji,jj,jk,Kmm)
+      END_3D
+
+      DO_3D_00_00( 1, jpkm1 )
+      zu(ji,jj,jk) = MIN(  zu(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  )
+      zu(ji,jj,jk) = MAX(  zu(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  )
+      zv(ji,jj,jk) = MIN(  zv(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji,jj+1,jk) )  )
+      zv(ji,jj,jk) = MAX(  zv(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji,jj+1,jk) )  )
+      END_3D
+
+
+      DO_3D_00_00( 1, jpkm1 )
+      zpwes = 0._wp; zpwed = 0._wp
+      zpnss = 0._wp; zpnsd = 0._wp
+      zuijk = zu(ji,jj,jk)
+      zvijk = zv(ji,jj,jk)
+
+      !!!!!     for u equation
+      IF( jk <= mbku(ji,jj) ) THEN
+         IF( -zdept(ji+1,jj,jk) >= -zdept(ji,jj,jk) ) THEN
+           jis = ji + 1; jid = ji
+         ELSE
+           jis = ji;     jid = ji +1
+         ENDIF
+
+         ! integrate the pressure on the shallow side
+         jk1 = jk
+         DO WHILE ( -zdept(jis,jj,jk1) > zuijk )
+           IF( jk1 == mbku(ji,jj) ) THEN
+             zuijk = -zdept(jis,jj,jk1)
+             EXIT
+           ENDIF
+           zdeps = MIN(zdept(jis,jj,jk1+1), -zuijk)
+           zpwes = zpwes +                                    &
+                integ_spline(zdept(jis,jj,jk1), zdeps,            &
+                       asp(jis,jj,jk1),    bsp(jis,jj,jk1), &
+                       csp(jis,jj,jk1),    dsp(jis,jj,jk1))
+           jk1 = jk1 + 1
          END DO
-      END DO
+
+         ! integrate the pressure on the deep side
+         jk1 = jk
+         DO WHILE ( -zdept(jid,jj,jk1) < zuijk )
+           IF( jk1 == 1 ) THEN
+             zdeps = zdept(jid,jj,1) + MIN(zuijk, ssh(jid,jj,Kmm)*znad)
+             zrhdt1 = zrhh(jid,jj,1) - interp3(zdept(jid,jj,1), asp(jid,jj,1), &
+                                               bsp(jid,jj,1),   csp(jid,jj,1), &
+                                               dsp(jid,jj,1)) * zdeps
+             zpwed  = zpwed + 0.5_wp * (zrhh(jid,jj,1) + zrhdt1) * zdeps
+             EXIT
+           ENDIF
+           zdeps = MAX(zdept(jid,jj,jk1-1), -zuijk)
+           zpwed = zpwed +                                        &
+                  integ_spline(zdeps,              zdept(jid,jj,jk1), &
+                         asp(jid,jj,jk1-1), bsp(jid,jj,jk1-1),  &
+                         csp(jid,jj,jk1-1), dsp(jid,jj,jk1-1) )
+           jk1 = jk1 - 1
+         END DO
+
+         ! update the momentum trends in u direction
+
+         zdpdx1 = zcoef0 * r1_e1u(ji,jj) * ( zhpi(ji+1,jj,jk) - zhpi(ji,jj,jk) )
+         IF( .NOT.ln_linssh ) THEN
+           zdpdx2 = zcoef0 * r1_e1u(ji,jj) * &
+              &    ( REAL(jis-jid, wp) * (zpwes + zpwed) + (ssh(ji+1,jj,Kmm)-ssh(ji,jj,Kmm)) )
+          ELSE
+           zdpdx2 = zcoef0 * r1_e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed)
+         ENDIF
+         IF( ln_wd_il ) THEN
+            zdpdx1 = zdpdx1 * zcpx(ji,jj) * wdrampu(ji,jj)
+            zdpdx2 = zdpdx2 * zcpx(ji,jj) * wdrampu(ji,jj)
+         ENDIF
+         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + (zdpdx1 + zdpdx2) * umask(ji,jj,jk) 
+      ENDIF
+
+      !!!!!     for v equation
+      IF( jk <= mbkv(ji,jj) ) THEN
+         IF( -zdept(ji,jj+1,jk) >= -zdept(ji,jj,jk) ) THEN
+           jjs = jj + 1; jjd = jj
+         ELSE
+           jjs = jj    ; jjd = jj + 1
+         ENDIF
+
+         ! integrate the pressure on the shallow side
+         jk1 = jk
+         DO WHILE ( -zdept(ji,jjs,jk1) > zvijk )
+           IF( jk1 == mbkv(ji,jj) ) THEN
+             zvijk = -zdept(ji,jjs,jk1)
+             EXIT
+           ENDIF
+           zdeps = MIN(zdept(ji,jjs,jk1+1), -zvijk)
+           zpnss = zpnss +                                      &
+                  integ_spline(zdept(ji,jjs,jk1), zdeps,            &
+                         asp(ji,jjs,jk1),    bsp(ji,jjs,jk1), &
+                         csp(ji,jjs,jk1),    dsp(ji,jjs,jk1) )
+           jk1 = jk1 + 1
+         END DO
+
+         ! integrate the pressure on the deep side
+         jk1 = jk
+         DO WHILE ( -zdept(ji,jjd,jk1) < zvijk )
+           IF( jk1 == 1 ) THEN
+             zdeps = zdept(ji,jjd,1) + MIN(zvijk, ssh(ji,jjd,Kmm)*znad)
+             zrhdt1 = zrhh(ji,jjd,1) - interp3(zdept(ji,jjd,1), asp(ji,jjd,1), &
+                                               bsp(ji,jjd,1),   csp(ji,jjd,1), &
+                                               dsp(ji,jjd,1) ) * zdeps
+             zpnsd  = zpnsd + 0.5_wp * (zrhh(ji,jjd,1) + zrhdt1) * zdeps
+             EXIT
+           ENDIF
+           zdeps = MAX(zdept(ji,jjd,jk1-1), -zvijk)
+           zpnsd = zpnsd +                                        &
+                  integ_spline(zdeps,              zdept(ji,jjd,jk1), &
+                         asp(ji,jjd,jk1-1), bsp(ji,jjd,jk1-1), &
+                         csp(ji,jjd,jk1-1), dsp(ji,jjd,jk1-1) )
+           jk1 = jk1 - 1
+         END DO
+
+
+         ! update the momentum trends in v direction
+
+         zdpdy1 = zcoef0 * r1_e2v(ji,jj) * ( zhpi(ji,jj+1,jk) - zhpi(ji,jj,jk) )
+         IF( .NOT.ln_linssh ) THEN
+            zdpdy2 = zcoef0 * r1_e2v(ji,jj) * &
+                    ( REAL(jjs-jjd, wp) * (zpnss + zpnsd) + (ssh(ji,jj+1,Kmm)-ssh(ji,jj,Kmm)) )
+         ELSE
+            zdpdy2 = zcoef0 * r1_e2v(ji,jj) * REAL(jjs-jjd, wp) * (zpnss + zpnsd )
+         ENDIF
+         IF( ln_wd_il ) THEN
+            zdpdy1 = zdpdy1 * zcpy(ji,jj) * wdrampv(ji,jj) 
+            zdpdy2 = zdpdy2 * zcpy(ji,jj) * wdrampv(ji,jj) 
+         ENDIF
+
+         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + (zdpdy1 + zdpdy2) * vmask(ji,jj,jk)
+      ENDIF
+         !
+      END_3D
       !
       IF( ln_wd_il )   DEALLOCATE( zcpx, zcpy )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynkeg.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynkeg.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynkeg.F90	(revision 12928)
@@ -36,5 +36,5 @@
    
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -44,5 +44,5 @@
 CONTAINS
 
-   SUBROUTINE dyn_keg( kt, kscheme )
+   SUBROUTINE dyn_keg( kt, kscheme, Kmm, puu, pvv, Krhs )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dyn_keg  ***
@@ -57,13 +57,13 @@
       !!              * kscheme = nkeg_HW : Hollingsworth correction following
       !!      Arakawa (2001). The now horizontal kinetic energy is given by:
-      !!         zhke = 1/6 [ mi-1(  2 * un^2 + ((un(j+1)+un(j-1))/2)^2  )
-      !!                    + mj-1(  2 * vn^2 + ((vn(i+1)+vn(i-1))/2)^2  ) ]
+      !!         zhke = 1/6 [ mi-1(  2 * un^2 + ((u(j+1)+u(j-1))/2)^2  )
+      !!                    + mj-1(  2 * vn^2 + ((v(i+1)+v(i-1))/2)^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 ]
+      !!      trend.
+      !!         u(rhs) = u(rhs) - 1/e1u di[ zhke ]
+      !!         v(rhs) = v(rhs) - 1/e2v dj[ zhke ]
       !!
-      !! ** Action : - Update the (ua, va) with the hor. ke gradient trend
+      !! ** Action : - Update the (puu(:,:,:,Krhs), pvv(:,:,:,Krhs)) with the hor. ke gradient trend
       !!             - send this trends to trd_dyn (l_trddyn=T) for post-processing
       !!
@@ -71,6 +71,8 @@
       !!                 Hollingsworth et al., Quart. J. Roy. Meteor. Soc., 1983.
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt        ! ocean time-step index
-      INTEGER, INTENT( in ) ::   kscheme   ! =0/1   type of KEG scheme 
+      INTEGER                             , INTENT( in )  ::  kt               ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  kscheme          ! =0/1   type of KEG scheme 
+      INTEGER                             , INTENT( in )  ::  Kmm, Krhs        ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv         ! ocean velocities and RHS of momentum equation
       !
       INTEGER  ::   ji, jj, jk             ! dummy loop indices
@@ -90,6 +92,6 @@
       IF( l_trddyn ) THEN           ! Save the input trends
          ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) )
-         ztrdu(:,:,:) = ua(:,:,:) 
-         ztrdv(:,:,:) = va(:,:,:) 
+         ztrdu(:,:,:) = puu(:,:,:,Krhs) 
+         ztrdv(:,:,:) = pvv(:,:,:,Krhs) 
       ENDIF
       
@@ -99,54 +101,42 @@
       !
       CASE ( nkeg_C2 )                          !--  Standard scheme  --!
-         DO jk = 1, jpkm1
-            DO jj = 2, jpj
-               DO ji = fs_2, jpi   ! vector opt.
-                  zu =    un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   &
-                     &  + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk)
-                  zv =    vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   &
-                     &  + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)
-                  zhke(ji,jj,jk) = 0.25_wp * ( zv + zu )
-               END DO  
-            END DO
-         END DO
+         DO_3D_01_01( 1, jpkm1 )
+            zu =    puu(ji-1,jj  ,jk,Kmm) * puu(ji-1,jj  ,jk,Kmm)   &
+               &  + puu(ji  ,jj  ,jk,Kmm) * puu(ji  ,jj  ,jk,Kmm)
+            zv =    pvv(ji  ,jj-1,jk,Kmm) * pvv(ji  ,jj-1,jk,Kmm)   &
+               &  + pvv(ji  ,jj  ,jk,Kmm) * pvv(ji  ,jj  ,jk,Kmm)
+            zhke(ji,jj,jk) = 0.25_wp * ( zv + zu )
+         END_3D
       CASE ( nkeg_HW )                          !--  Hollingsworth scheme  --!
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1       
-               DO ji = fs_2, jpim1   ! vector opt.
-                  zu = 8._wp * ( un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)    &
-                     &         + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk) )  &
-                     &   +     ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) ) * ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) )   &
-                     &   +     ( un(ji  ,jj-1,jk) + un(ji  ,jj+1,jk) ) * ( un(ji  ,jj-1,jk) + un(ji  ,jj+1,jk) )
-                     !
-                  zv = 8._wp * ( vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)    &
-                     &         + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk) )  &
-                     &  +      ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) ) * ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) )   &
-                     &  +      ( vn(ji-1,jj  ,jk) + vn(ji+1,jj  ,jk) ) * ( vn(ji-1,jj  ,jk) + vn(ji+1,jj  ,jk) )
-                  zhke(ji,jj,jk) = r1_48 * ( zv + zu )
-               END DO  
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            zu = 8._wp * ( puu(ji-1,jj  ,jk,Kmm) * puu(ji-1,jj  ,jk,Kmm)    &
+               &         + puu(ji  ,jj  ,jk,Kmm) * puu(ji  ,jj  ,jk,Kmm) )  &
+               &   +     ( puu(ji-1,jj-1,jk,Kmm) + puu(ji-1,jj+1,jk,Kmm) ) * ( puu(ji-1,jj-1,jk,Kmm) + puu(ji-1,jj+1,jk,Kmm) )   &
+               &   +     ( puu(ji  ,jj-1,jk,Kmm) + puu(ji  ,jj+1,jk,Kmm) ) * ( puu(ji  ,jj-1,jk,Kmm) + puu(ji  ,jj+1,jk,Kmm) )
+               !
+            zv = 8._wp * ( pvv(ji  ,jj-1,jk,Kmm) * pvv(ji  ,jj-1,jk,Kmm)    &
+               &         + pvv(ji  ,jj  ,jk,Kmm) * pvv(ji  ,jj  ,jk,Kmm) )  &
+               &  +      ( pvv(ji-1,jj-1,jk,Kmm) + pvv(ji+1,jj-1,jk,Kmm) ) * ( pvv(ji-1,jj-1,jk,Kmm) + pvv(ji+1,jj-1,jk,Kmm) )   &
+               &  +      ( pvv(ji-1,jj  ,jk,Kmm) + pvv(ji+1,jj  ,jk,Kmm) ) * ( pvv(ji-1,jj  ,jk,Kmm) + pvv(ji+1,jj  ,jk,Kmm) )
+            zhke(ji,jj,jk) = r1_48 * ( zv + zu )
+         END_3D
          CALL lbc_lnk( 'dynkeg', zhke, 'T', 1. )
          !
       END SELECT 
       !
-      DO jk = 1, jpkm1                    !==  grad( KE ) added to the general momentum trends  ==!
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ua(ji,jj,jk) = ua(ji,jj,jk) - ( zhke(ji+1,jj  ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj)
-               va(ji,jj,jk) = va(ji,jj,jk) - ( zhke(ji  ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj)
-            END DO 
-         END DO
-      END DO
+      DO_3D_00_00( 1, jpkm1 )
+         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zhke(ji+1,jj  ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj)
+         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zhke(ji  ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj)
+      END_3D
       !
       IF( l_trddyn ) THEN                 ! save the Kinetic Energy trends for diagnostic
-         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
-         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
-         CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt )
+         ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:)
+         ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:)
+         CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt, Kmm )
          DEALLOCATE( ztrdu , ztrdv )
       ENDIF
       !
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' keg  - Ua: ', mask1=umask,   &
-         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' keg  - Ua: ', mask1=umask,   &
+         &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
       !
       IF( ln_timing )   CALL timing_stop('dyn_keg')
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynldf.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynldf.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynldf.F90	(revision 12928)
@@ -34,6 +34,4 @@
    PUBLIC   dyn_ldf_init  ! called by opa  module 
 
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -43,5 +41,5 @@
 CONTAINS
 
-   SUBROUTINE dyn_ldf( kt )
+   SUBROUTINE dyn_ldf( kt, Kbb, Kmm, puu, pvv, Krhs )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dyn_ldf  ***
@@ -49,5 +47,7 @@
       !! ** Purpose :   compute the lateral ocean dynamics physics.
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  kt               ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kbb, Kmm, Krhs   ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv         ! ocean velocities and RHS of momentum equation
       !
       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdu, ztrdv
@@ -58,25 +58,28 @@
       IF( l_trddyn )   THEN                      ! temporary save of momentum trends
          ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) )
-         ztrdu(:,:,:) = ua(:,:,:) 
-         ztrdv(:,:,:) = va(:,:,:) 
+         ztrdu(:,:,:) = puu(:,:,:,Krhs) 
+         ztrdv(:,:,:) = pvv(:,:,:,Krhs) 
       ENDIF
 
       SELECT CASE ( nldf_dyn )                   ! compute lateral mixing trend and add it to the general trend
       !
-      CASE ( np_lap   )    ;   CALL dyn_ldf_lap( kt, ub, vb, ua, va, 1 )      ! iso-level    laplacian
-      CASE ( np_lap_i )    ;   CALL dyn_ldf_iso( kt )                         ! rotated      laplacian
-      CASE ( np_blp   )    ;   CALL dyn_ldf_blp( kt, ub, vb, ua, va    )      ! iso-level bi-laplacian
+      CASE ( np_lap   )  
+         CALL dyn_ldf_lap( kt, Kbb, Kmm, puu(:,:,:,Kbb), pvv(:,:,:,Kbb), puu(:,:,:,Krhs), pvv(:,:,:,Krhs), 1 ) ! iso-level    laplacian
+      CASE ( np_lap_i ) 
+         CALL dyn_ldf_iso( kt, Kbb, Kmm, puu, pvv, Krhs    )                                                   ! rotated      laplacian
+      CASE ( np_blp   )  
+         CALL dyn_ldf_blp( kt, Kbb, Kmm, puu(:,:,:,Kbb), pvv(:,:,:,Kbb), puu(:,:,:,Krhs), pvv(:,:,:,Krhs)    ) ! iso-level bi-laplacian
       !
       END SELECT
 
       IF( l_trddyn ) THEN                        ! save the horizontal diffusive trends for further diagnostics
-         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
-         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
-         CALL trd_dyn( ztrdu, ztrdv, jpdyn_ldf, kt )
+         ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:)
+         ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:)
+         CALL trd_dyn( ztrdu, ztrdv, jpdyn_ldf, kt, Kmm )
          DEALLOCATE ( ztrdu , ztrdv )
       ENDIF
       !                                          ! print sum trends (used for debugging)
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf  - Ua: ', mask1=umask,   &
-         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' ldf  - Ua: ', mask1=umask,   &
+         &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
       !
       IF( ln_timing )   CALL timing_stop('dyn_ldf')
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynldf_iso.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynldf_iso.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynldf_iso.F90	(revision 12928)
@@ -41,5 +41,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -60,5 +60,5 @@
 
 
-   SUBROUTINE dyn_ldf_iso( kt )
+   SUBROUTINE dyn_ldf_iso( kt, Kbb, Kmm, puu, pvv, Krhs )
       !!----------------------------------------------------------------------
       !!                     ***  ROUTINE dyn_ldf_iso  ***
@@ -81,27 +81,29 @@
       !!      horizontal fluxes associated with the rotated lateral mixing:
       !!      u-component:
-      !!         ziut = ( ahmt + rn_ahm_b ) e2t * e3t / e1t  di[ ub ]
-      !!               -  ahmt              e2t * mi-1(uslp) dk[ mi(mk(ub)) ]
-      !!         zjuf = ( ahmf + rn_ahm_b ) e1f * e3f / e2f  dj[ ub ]
-      !!               -  ahmf              e1f * mi(vslp)   dk[ mj(mk(ub)) ]
+      !!         ziut = ( ahmt + rn_ahm_b ) e2t * e3t / e1t  di[ uu ]
+      !!               -  ahmt              e2t * mi-1(uslp) dk[ mi(mk(uu)) ]
+      !!         zjuf = ( ahmf + rn_ahm_b ) e1f * e3f / e2f  dj[ uu ]
+      !!               -  ahmf              e1f * mi(vslp)   dk[ mj(mk(uu)) ]
       !!      v-component:
-      !!         zivf = ( ahmf + rn_ahm_b ) e2t * e3t / e1t  di[ vb ]
-      !!               -  ahmf              e2t * mj(uslp)   dk[ mi(mk(vb)) ]
-      !!         zjvt = ( ahmt + rn_ahm_b ) e1f * e3f / e2f  dj[ ub ]
-      !!               -  ahmt              e1f * mj-1(vslp) dk[ mj(mk(vb)) ]
+      !!         zivf = ( ahmf + rn_ahm_b ) e2t * e3t / e1t  di[ vv ]
+      !!               -  ahmf              e2t * mj(uslp)   dk[ mi(mk(vv)) ]
+      !!         zjvt = ( ahmt + rn_ahm_b ) e1f * e3f / e2f  dj[ vv ]
+      !!               -  ahmt              e1f * mj-1(vslp) dk[ mj(mk(vv)) ]
       !!      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
+      !!      Add this trend to the general trend (uu(rhs),vv(rhs)):
+      !!         uu(rhs) = uu(rhs) + diffu
       !!      CAUTION: here the isopycnal part is with a coeff. of aht. This
       !!      should be modified for applications others than orca_r2 (!!bug)
       !!
       !! ** Action :
-      !!       -(ua,va) updated with the before geopotential harmonic mixing trend
+      !!       -(puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) updated with the before geopotential harmonic mixing trend
       !!       -(akzu,akzv) to accompt for the diagonal vertical component
       !!                    of the rotated operator in dynzdf module
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  kt               ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kbb, Kmm, Krhs   ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv         ! ocean velocities and RHS of momentum equation
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -125,14 +127,10 @@
       IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN
          !
-         DO jk = 1, jpk         ! set the slopes of iso-level
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  uslp (ji,jj,jk) = - ( gdept_b(ji+1,jj,jk) - gdept_b(ji ,jj ,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk)
-                  vslp (ji,jj,jk) = - ( gdept_b(ji,jj+1,jk) - gdept_b(ji ,jj ,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk)
-                  wslpi(ji,jj,jk) = - ( gdepw_b(ji+1,jj,jk) - gdepw_b(ji-1,jj,jk) ) * r1_e1t(ji,jj) * tmask(ji,jj,jk) * 0.5
-                  wslpj(ji,jj,jk) = - ( gdepw_b(ji,jj+1,jk) - gdepw_b(ji,jj-1,jk) ) * r1_e2t(ji,jj) * tmask(ji,jj,jk) * 0.5
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpk )
+            uslp (ji,jj,jk) = - ( gdept(ji+1,jj,jk,Kbb) - gdept(ji ,jj ,jk,Kbb) ) * r1_e1u(ji,jj) * umask(ji,jj,jk)
+            vslp (ji,jj,jk) = - ( gdept(ji,jj+1,jk,Kbb) - gdept(ji ,jj ,jk,Kbb) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk)
+            wslpi(ji,jj,jk) = - ( gdepw(ji+1,jj,jk,Kbb) - gdepw(ji-1,jj,jk,Kbb) ) * r1_e1t(ji,jj) * tmask(ji,jj,jk) * 0.5
+            wslpj(ji,jj,jk) = - ( gdepw(ji,jj+1,jk,Kbb) - gdepw(ji,jj-1,jk,Kbb) ) * r1_e2t(ji,jj) * tmask(ji,jj,jk) * 0.5
+         END_3D
          ! Lateral boundary conditions on the slopes
          CALL lbc_lnk_multi( 'dynldf_iso', uslp , 'U', -1., vslp , 'V', -1., wslpi, 'W', -1., wslpj, 'W', -1. )
@@ -151,6 +149,6 @@
          !                             zdkv(jk=1)=zdkv(jk=2)
 
-         zdk1u(:,:) = ( ub(:,:,jk) -ub(:,:,jk+1) ) * umask(:,:,jk+1)
-         zdk1v(:,:) = ( vb(:,:,jk) -vb(:,:,jk+1) ) * vmask(:,:,jk+1)
+         zdk1u(:,:) = ( puu(:,:,jk,Kbb) -puu(:,:,jk+1,Kbb) ) * umask(:,:,jk+1)
+         zdk1v(:,:) = ( pvv(:,:,jk,Kbb) -pvv(:,:,jk+1,Kbb) ) * vmask(:,:,jk+1)
 
          IF( jk == 1 ) THEN
@@ -158,6 +156,6 @@
             zdkv(:,:) = zdk1v(:,:)
          ELSE
-            zdku(:,:) = ( ub(:,:,jk-1) - ub(:,:,jk) ) * umask(:,:,jk)
-            zdkv(:,:) = ( vb(:,:,jk-1) - vb(:,:,jk) ) * vmask(:,:,jk)
+            zdku(:,:) = ( puu(:,:,jk-1,Kbb) - puu(:,:,jk,Kbb) ) * umask(:,:,jk)
+            zdkv(:,:) = ( pvv(:,:,jk-1,Kbb) - pvv(:,:,jk,Kbb) ) * vmask(:,:,jk)
          ENDIF
 
@@ -169,50 +167,44 @@
 
          IF( ln_zps ) THEN      ! z-coordinate - partial steps : min(e3u)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, jpi   ! vector opt.
-                  zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * MIN( e3u_n(ji,jj,jk), e3u_n(ji-1,jj,jk) ) * r1_e1t(ji,jj)
-
-                  zmskt = 1._wp / MAX(   umask(ji-1,jj,jk  )+umask(ji,jj,jk+1)     &
-                     &                 + umask(ji-1,jj,jk+1)+umask(ji,jj,jk  ) , 1._wp )
-
-                  zcof1 = - zaht_0 * e2t(ji,jj) * zmskt * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )
-   
-                  ziut(ji,jj) = (  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) )  ) * tmask(ji,jj,jk)
-               END DO
-            END DO
+            DO_2D_00_01
+               zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * MIN( e3u(ji,jj,jk,Kmm), e3u(ji-1,jj,jk,Kmm) ) * r1_e1t(ji,jj)
+
+               zmskt = 1._wp / MAX(   umask(ji-1,jj,jk  )+umask(ji,jj,jk+1)     &
+                  &                 + umask(ji-1,jj,jk+1)+umask(ji,jj,jk  ) , 1._wp )
+
+               zcof1 = - zaht_0 * e2t(ji,jj) * zmskt * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )
+
+               ziut(ji,jj) = (  zabe1 * ( puu(ji,jj,jk,Kbb) - puu(ji-1,jj,jk,Kbb) )    &
+                  &           + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj)      &
+                  &                      +zdk1u(ji,jj) + zdku (ji-1,jj) )  ) * tmask(ji,jj,jk)
+            END_2D
          ELSE                   ! other coordinate system (zco or sco) : e3t
-            DO jj = 2, jpjm1
-               DO ji = fs_2, jpi   ! vector opt.
-                  zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * e3t_n(ji,jj,jk) * r1_e1t(ji,jj)
-
-                  zmskt = 1._wp / MAX(   umask(ji-1,jj,jk  ) + umask(ji,jj,jk+1)     &
-                     &                 + umask(ji-1,jj,jk+1) + umask(ji,jj,jk  ) , 1._wp )
-
-                  zcof1 = - zaht_0 * e2t(ji,jj) * zmskt * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )
-
-                  ziut(ji,jj) = (  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) )  ) * tmask(ji,jj,jk)
-               END DO
-            END DO
+            DO_2D_00_01
+               zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * e3t(ji,jj,jk,Kmm) * r1_e1t(ji,jj)
+
+               zmskt = 1._wp / MAX(   umask(ji-1,jj,jk  ) + umask(ji,jj,jk+1)     &
+                  &                 + umask(ji-1,jj,jk+1) + umask(ji,jj,jk  ) , 1._wp )
+
+               zcof1 = - zaht_0 * e2t(ji,jj) * zmskt * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )
+
+               ziut(ji,jj) = (  zabe1 * ( puu(ji,jj,jk,Kbb) - puu(ji-1,jj,jk,Kbb) )   &
+                  &           + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj)     &
+                  &                      +zdk1u(ji,jj) + zdku (ji-1,jj) )  ) * tmask(ji,jj,jk)
+            END_2D
          ENDIF
 
          ! j-flux at f-point
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zabe2 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e1f(ji,jj) * e3f_n(ji,jj,jk) * r1_e2f(ji,jj)
-
-               zmskf = 1._wp / MAX(   umask(ji,jj+1,jk  )+umask(ji,jj,jk+1)     &
-                  &                 + umask(ji,jj+1,jk+1)+umask(ji,jj,jk  ) , 1._wp )
-
-               zcof2 = - zaht_0 * e1f(ji,jj) * zmskf * 0.5  * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) )
-
-               zjuf(ji,jj) = (  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) )  ) * fmask(ji,jj,jk)
-            END DO
-         END DO
+         DO_2D_10_10
+            zabe2 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e1f(ji,jj) * e3f(ji,jj,jk) * r1_e2f(ji,jj)
+
+            zmskf = 1._wp / MAX(   umask(ji,jj+1,jk  )+umask(ji,jj,jk+1)     &
+               &                 + umask(ji,jj+1,jk+1)+umask(ji,jj,jk  ) , 1._wp )
+
+            zcof2 = - zaht_0 * e1f(ji,jj) * zmskf * 0.5  * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) )
+
+            zjuf(ji,jj) = (  zabe2 * ( puu(ji,jj+1,jk,Kbb) - puu(ji,jj,jk,Kbb) )   &
+               &           + zcof2 * ( zdku (ji,jj+1) + zdk1u(ji,jj)     &
+               &                      +zdk1u(ji,jj+1) + zdku (ji,jj) )  ) * fmask(ji,jj,jk)
+         END_2D
 
          !                                |   t   |
@@ -222,50 +214,44 @@
          ! i-flux at f-point              |   t   |
 
-         DO jj = 2, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zabe1 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e2f(ji,jj) * e3f_n(ji,jj,jk) * r1_e1f(ji,jj)
-
-               zmskf = 1._wp / MAX(  vmask(ji+1,jj,jk  )+vmask(ji,jj,jk+1)     &
-                  &                + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk  ) , 1._wp )
-
-               zcof1 = - zaht_0 * e2f(ji,jj) * zmskf * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) )
-
-               zivf(ji,jj) = (  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) )  ) * fmask(ji,jj,jk)
-            END DO
-         END DO
+         DO_2D_00_10
+            zabe1 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e2f(ji,jj) * e3f(ji,jj,jk) * r1_e1f(ji,jj)
+
+            zmskf = 1._wp / MAX(  vmask(ji+1,jj,jk  )+vmask(ji,jj,jk+1)     &
+               &                + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk  ) , 1._wp )
+
+            zcof1 = - zaht_0 * e2f(ji,jj) * zmskf * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) )
+
+            zivf(ji,jj) = (  zabe1 * ( pvv(ji+1,jj,jk,Kbb) - pvv(ji,jj,jk,Kbb) )    &
+               &           + zcof1 * (  zdkv (ji,jj) + zdk1v(ji+1,jj)      &
+               &                      + zdk1v(ji,jj) + zdkv (ji+1,jj) )  ) * fmask(ji,jj,jk)
+         END_2D
 
          ! j-flux at t-point
          IF( ln_zps ) THEN      ! z-coordinate - partial steps : min(e3u)
-            DO jj = 2, jpj
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * MIN( e3v_n(ji,jj,jk), e3v_n(ji,jj-1,jk) ) * r1_e2t(ji,jj)
-
-                  zmskt = 1._wp / MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)     &
-                     &                + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk  ) , 1._wp )
-
-                  zcof2 = - zaht_0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )
-
-                  zjvt(ji,jj) = (  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) )  ) * tmask(ji,jj,jk)
-               END DO
-            END DO
+            DO_2D_01_10
+               zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * MIN( e3v(ji,jj,jk,Kmm), e3v(ji,jj-1,jk,Kmm) ) * r1_e2t(ji,jj)
+
+               zmskt = 1._wp / MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)     &
+                  &                + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk  ) , 1._wp )
+
+               zcof2 = - zaht_0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )
+
+               zjvt(ji,jj) = (  zabe2 * ( pvv(ji,jj,jk,Kbb) - pvv(ji,jj-1,jk,Kbb) )    &
+                  &           + zcof2 * ( zdkv (ji,jj-1) + zdk1v(ji,jj)      &
+                  &                      +zdk1v(ji,jj-1) + zdkv (ji,jj) )  ) * tmask(ji,jj,jk)
+            END_2D
          ELSE                   ! other coordinate system (zco or sco) : e3t
-            DO jj = 2, jpj
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * e3t_n(ji,jj,jk) * r1_e2t(ji,jj)
-
-                  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 = - zaht_0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )
-
-                  zjvt(ji,jj) = (  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) )  ) * tmask(ji,jj,jk)
-               END DO
-            END DO
+            DO_2D_01_10
+               zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * e3t(ji,jj,jk,Kmm) * r1_e2t(ji,jj)
+
+               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 = - zaht_0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )
+
+               zjvt(ji,jj) = (  zabe2 * ( pvv(ji,jj,jk,Kbb) - pvv(ji,jj-1,jk,Kbb) )   &
+                  &           + zcof2 * ( zdkv (ji,jj-1) + zdk1v(ji,jj)     &
+                  &                      +zdk1v(ji,jj-1) + zdkv (ji,jj) )  ) * tmask(ji,jj,jk)
+            END_2D
          ENDIF
 
@@ -273,12 +259,10 @@
          ! Second derivative (divergence) and add to the general trend
          ! -----------------------------------------------------------
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1          !!gm Question vectop possible??? !!bug
-               ua(ji,jj,jk) = ua(ji,jj,jk) + (  ziut(ji+1,jj) - ziut(ji,jj  )    &
-                  &                           + zjuf(ji  ,jj) - zjuf(ji,jj-1)  ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
-               va(ji,jj,jk) = va(ji,jj,jk) + (  zivf(ji,jj  ) - zivf(ji-1,jj)    &
-                  &                           + zjvt(ji,jj+1) - zjvt(ji,jj  )  ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
-            END DO
-         END DO
+         DO_2D_00_00
+            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + (  ziut(ji+1,jj) - ziut(ji,jj  )    &
+               &                           + zjuf(ji  ,jj) - zjuf(ji,jj-1)  ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm)
+            pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + (  zivf(ji,jj  ) - zivf(ji-1,jj)    &
+               &                           + zjvt(ji,jj+1) - zjvt(ji,jj  )  ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm)
+         END_2D
          !                                             ! ===============
       END DO                                           !   End of slab
@@ -286,6 +270,6 @@
 
       ! print sum trends (used for debugging)
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' ldfh - Ua: ', mask1=umask, &
-         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' ldfh - Ua: ', mask1=umask, &
+         &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
 
 
@@ -306,11 +290,11 @@
             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) )
+               zdiu (ji,jk) = tmask(ji,jj  ,jk) * ( puu(ji,jj  ,jk,Kbb) - puu(ji-1,jj  ,jk,Kbb) )
                ! 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) )
+               zdju (ji,jk) = fmask(ji,jj  ,jk) * ( puu(ji,jj+1,jk,Kbb) - puu(ji  ,jj  ,jk,Kbb) )
+               zdjv (ji,jk) = tmask(ji,jj  ,jk) * ( pvv(ji,jj  ,jk,Kbb) - pvv(ji  ,jj-1,jk,Kbb) )
                ! 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) )
+               zdj1u(ji,jk) = fmask(ji,jj-1,jk) * ( puu(ji,jj  ,jk,Kbb) - puu(ji  ,jj-1,jk,Kbb) )
+               zdj1v(ji,jk) = tmask(ji,jj+1,jk) * ( pvv(ji,jj+1,jk,Kbb) - pvv(ji  ,jj  ,jk,Kbb) )
             END DO
          END DO
@@ -318,5 +302,5 @@
             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) )
+               zdiv (ji,jk) = fmask(ji,jj  ,jk) * ( pvv(ji+1,jj,jk,Kbb) - pvv(ji  ,jj  ,jk,Kbb) )
             END DO
          END DO
@@ -391,6 +375,6 @@
          DO jk = 1, jpkm1
             DO ji = 2, jpim1
-               ua(ji,jj,jk) = ua(ji,jj,jk) + ( zfuw(ji,jk) - zfuw(ji,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
-               va(ji,jj,jk) = va(ji,jj,jk) + ( zfvw(ji,jk) - zfvw(ji,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
+               puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + ( zfuw(ji,jk) - zfuw(ji,jk+1) ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm)
+               pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + ( zfvw(ji,jk) - zfvw(ji,jk+1) ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm)
             END DO
          END DO
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynldf_lap_blp.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynldf_lap_blp.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynldf_lap_blp.F90	(revision 12928)
@@ -27,5 +27,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -35,5 +35,5 @@
 CONTAINS
 
-   SUBROUTINE dyn_ldf_lap( kt, pub, pvb, pua, pva, kpass )
+   SUBROUTINE dyn_ldf_lap( kt, Kbb, Kmm, pu, pv, pu_rhs, pv_rhs, kpass )
       !!----------------------------------------------------------------------
       !!                     ***  ROUTINE dyn_ldf_lap  ***
@@ -45,10 +45,11 @@
       !!      writen as :   grad_h( ahmt div_h(U )) - curl_h( ahmf curl_z(U) ) 
       !!
-      !! ** Action : - pua, pva increased by the harmonic operator applied on pub, pvb.
+      !! ** Action : - pu_rhs, pv_rhs increased by the harmonic operator applied on pu, pv.
       !!----------------------------------------------------------------------
       INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   Kbb, Kmm   ! ocean time level indices
       INTEGER                         , INTENT(in   ) ::   kpass      ! =1/2 first or second passage
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pub, pvb   ! before velocity  [m/s]
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva   ! velocity trend   [m/s2]
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pu, pv     ! before velocity  [m/s]
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs   ! velocity trend   [m/s2]
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -71,31 +72,24 @@
       DO jk = 1, jpkm1                                 ! Horizontal slab
          !                                             ! ===============
-         DO jj = 2, jpj
-            DO ji = fs_2, jpi   ! vector opt.
-               !                                      ! ahm * e3 * curl  (computed from 1 to jpim1/jpjm1)
-!!gm open question here : e3f  at before or now ?    probably now...
-!!gm note that ahmf has already been multiplied by fmask
-               zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f_n(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1)       &
-                  &     * (  e2v(ji  ,jj-1) * pvb(ji  ,jj-1,jk) - e2v(ji-1,jj-1) * pvb(ji-1,jj-1,jk)  &
-                  &        - e1u(ji-1,jj  ) * pub(ji-1,jj  ,jk) + e1u(ji-1,jj-1) * pub(ji-1,jj-1,jk)  )
-               !                                      ! ahm * div        (computed from 2 to jpi/jpj)
-!!gm note that ahmt has already been multiplied by tmask
-               zdiv(ji,jj)     = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t_b(ji,jj,jk)                                         &
-                  &     * (  e2u(ji,jj)*e3u_b(ji,jj,jk) * pub(ji,jj,jk) - e2u(ji-1,jj)*e3u_b(ji-1,jj,jk) * pub(ji-1,jj,jk)  &
-                  &        + e1v(ji,jj)*e3v_b(ji,jj,jk) * pvb(ji,jj,jk) - e1v(ji,jj-1)*e3v_b(ji,jj-1,jk) * pvb(ji,jj-1,jk)  )
-            END DO  
-         END DO  
+         DO_2D_01_01
+            !                                      ! ahm * e3 * curl  (computed from 1 to jpim1/jpjm1)
+            zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1)       &   ! ahmf already * by fmask
+               &     * (  e2v(ji  ,jj-1) * pv(ji  ,jj-1,jk) - e2v(ji-1,jj-1) * pv(ji-1,jj-1,jk)  &
+               &        - e1u(ji-1,jj  ) * pu(ji-1,jj  ,jk) + e1u(ji-1,jj-1) * pu(ji-1,jj-1,jk)  )
+            !                                      ! ahm * div        (computed from 2 to jpi/jpj)
+            zdiv(ji,jj)     = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kbb)               &   ! ahmt already * by tmask
+               &     * (  e2u(ji,jj)*e3u(ji,jj,jk,Kbb) * pu(ji,jj,jk) - e2u(ji-1,jj)*e3u(ji-1,jj,jk,Kbb) * pu(ji-1,jj,jk)  &
+               &        + e1v(ji,jj)*e3v(ji,jj,jk,Kbb) * pv(ji,jj,jk) - e1v(ji,jj-1)*e3v(ji,jj-1,jk,Kbb) * pv(ji,jj-1,jk)  )
+         END_2D
          !
-         DO jj = 2, jpjm1                             ! - curl( curl) + grad( div )
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               pua(ji,jj,jk) = pua(ji,jj,jk) + zsign * (                                                 &
-                  &              - ( zcur(ji  ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u_n(ji,jj,jk)   &
-                  &              + ( zdiv(ji+1,jj) - zdiv(ji,jj  ) ) * r1_e1u(ji,jj)                     )
-                  !
-               pva(ji,jj,jk) = pva(ji,jj,jk) + zsign * (                                                 &
-                  &                ( zcur(ji,jj  ) - zcur(ji-1,jj) ) * r1_e1v(ji,jj) / e3v_n(ji,jj,jk)   &
-                  &              + ( zdiv(ji,jj+1) - zdiv(ji  ,jj) ) * r1_e2v(ji,jj)                     )
-            END DO
-         END DO
+         DO_2D_00_00
+            pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * umask(ji,jj,jk) * (    &    ! * by umask is mandatory for dyn_ldf_blp use
+               &              - ( zcur(ji  ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u(ji,jj,jk,Kmm)   &
+               &              + ( zdiv(ji+1,jj) - zdiv(ji,jj  ) ) * r1_e1u(ji,jj)                      )
+               !
+            pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zsign * vmask(ji,jj,jk) * (    &    ! * by vmask is mandatory for dyn_ldf_blp use
+               &                ( zcur(ji,jj  ) - zcur(ji-1,jj) ) * r1_e1v(ji,jj) / e3v(ji,jj,jk,Kmm)   &
+               &              + ( zdiv(ji,jj+1) - zdiv(ji  ,jj) ) * r1_e2v(ji,jj)                      )
+         END_2D
          !                                             ! ===============
       END DO                                           !   End of slab
@@ -105,5 +99,5 @@
 
 
-   SUBROUTINE dyn_ldf_blp( kt, pub, pvb, pua, pva )
+   SUBROUTINE dyn_ldf_blp( kt, Kbb, Kmm, pu, pv, pu_rhs, pv_rhs )
       !!----------------------------------------------------------------------
       !!                 ***  ROUTINE dyn_ldf_blp  ***
@@ -116,9 +110,10 @@
       !!      It is computed by two successive calls to dyn_ldf_lap routine
       !!
-      !! ** Action :   pta   updated with the before rotated bilaplacian diffusion
+      !! ** Action :   pt(:,:,:,:,Krhs)   updated with the before rotated bilaplacian diffusion
       !!----------------------------------------------------------------------
       INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pub, pvb   ! before velocity fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva   ! momentum trend
+      INTEGER                         , INTENT(in   ) ::   Kbb, Kmm   ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pu, pv     ! before velocity fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs   ! momentum trend
       !
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zulap, zvlap   ! laplacian at u- and v-point
@@ -134,9 +129,9 @@
       zvlap(:,:,:) = 0._wp
       !
-      CALL dyn_ldf_lap( kt, pub, pvb, zulap, zvlap, 1 )   ! rotated laplacian applied to ptb (output in zlap)
+      CALL dyn_ldf_lap( kt, Kbb, Kmm, pu, pv, zulap, zvlap, 1 )   ! rotated laplacian applied to pt (output in zlap,Kbb)
       !
       CALL lbc_lnk_multi( 'dynldf_lap_blp', zulap, 'U', -1., zvlap, 'V', -1. )             ! Lateral boundary conditions
       !
-      CALL dyn_ldf_lap( kt, zulap, zvlap, pua, pva, 2 )   ! rotated laplacian applied to zlap (output in pta)
+      CALL dyn_ldf_lap( kt, Kbb, Kmm, zulap, zvlap, pu_rhs, pv_rhs, 2 )   ! rotated laplacian applied to zlap (output in pt(:,:,:,:,Krhs))
       !
    END SUBROUTINE dyn_ldf_blp
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynnxt.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynnxt.F90	(revision 12384)
+++ 	(revision )
@@ -1,380 +1,0 @@
-MODULE dynnxt
-   !!=========================================================================
-   !!                       ***  MODULE  dynnxt  ***
-   !! Ocean dynamics: time stepping
-   !!=========================================================================
-   !! History :  OPA  !  1987-02  (P. Andrich, D. L Hostis)  Original code
-   !!                 !  1990-10  (C. Levy, G. Madec)
-   !!            7.0  !  1993-03  (M. Guyon)  symetrical conditions
-   !!            8.0  !  1997-02  (G. Madec & M. Imbard)  opa, release 8.0
-   !!            8.2  !  1997-04  (A. Weaver)  Euler forward step
-   !!             -   !  1997-06  (G. Madec)  lateral boudary cond., lbc routine
-   !!    NEMO    1.0  !  2002-08  (G. Madec)  F90: Free form and module
-   !!             -   !  2002-10  (C. Talandier, A-M. Treguier) Open boundary cond.
-   !!            2.0  !  2005-11  (V. Garnier) Surface pressure gradient organization
-   !!            2.3  !  2007-07  (D. Storkey) Calls to BDY routines. 
-   !!            3.2  !  2009-06  (G. Madec, R.Benshila)  re-introduce the vvl option
-   !!            3.3  !  2010-09  (D. Storkey, E.O'Dea) Bug fix for BDY module
-   !!            3.3  !  2011-03  (P. Oddo) Bug fix for time-splitting+(BDY-OBC) and not VVL
-   !!            3.5  !  2013-07  (J. Chanut) Compliant with time splitting changes
-   !!            3.6  !  2014-04  (G. Madec) add the diagnostic of the time filter trends
-   !!            3.7  !  2015-11  (J. Chanut) Free surface simplification
-   !!-------------------------------------------------------------------------
-  
-   !!-------------------------------------------------------------------------
-   !!   dyn_nxt       : obtain the next (after) horizontal velocity
-   !!-------------------------------------------------------------------------
-   USE oce            ! ocean dynamics and tracers
-   USE dom_oce        ! ocean space and time domain
-   USE sbc_oce        ! Surface boundary condition: ocean fields
-   USE sbcrnf         ! river runoffs
-   USE sbcisf         ! ice shelf
-   USE phycst         ! physical constants
-   USE dynadv         ! dynamics: vector invariant versus flux form
-   USE dynspg_ts      ! surface pressure gradient: split-explicit scheme
-   USE domvvl         ! variable volume
-   USE bdy_oce   , ONLY: ln_bdy
-   USE bdydta         ! ocean open boundary conditions
-   USE bdydyn         ! ocean open boundary conditions
-   USE bdyvol         ! ocean open boundary condition (bdy_vol routines)
-   USE trd_oce        ! trends: ocean variables
-   USE trddyn         ! trend manager: dynamics
-   USE trdken         ! trend manager: kinetic energy
-   !
-   USE in_out_manager ! I/O manager
-   USE iom            ! I/O manager library
-   USE lbclnk         ! lateral boundary condition (or mpp link)
-   USE lib_mpp        ! MPP library
-   USE prtctl         ! Print control
-   USE timing         ! Timing
-#if defined key_agrif
-   USE agrif_oce_interp
-#endif
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC    dyn_nxt   ! routine called by step.F90
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id$ 
-   !! Software governed by the CeCILL license (see ./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE dyn_nxt ( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE dyn_nxt  ***
-      !!                   
-      !! ** Purpose :   Finalize after horizontal velocity. Apply the boundary 
-      !!             condition on the after velocity, achieve the time stepping 
-      !!             by applying the Asselin filter on now fields and swapping 
-      !!             the fields.
-      !!
-      !! ** Method  : * Ensure after velocities transport matches time splitting
-      !!             estimate (ln_dynspg_ts=T)
-      !!
-      !!              * Apply lateral boundary conditions on after velocity 
-      !!             at the local domain boundaries through lbc_lnk call,
-      !!             at the one-way open boundaries (ln_bdy=T),
-      !!             at the AGRIF zoom   boundaries (lk_agrif=T)
-      !!
-      !!              * Apply the time filter applied and swap of the dynamics
-      !!             arrays to start the next time step:
-      !!                (ub,vb) = (un,vn) + atfp [ (ub,vb) + (ua,va) - 2 (un,vn) ]
-      !!                (un,vn) = (ua,va).
-      !!             Note that with flux form advection and non linear free surface,
-      !!             the time filter is applied on thickness weighted velocity.
-      !!             As a result, dyn_nxt MUST be called after tra_nxt.
-      !!
-      !! ** Action :   ub,vb   filtered before horizontal velocity of next time-step
-      !!               un,vn   now horizontal velocity of next time-step
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
-      !
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      INTEGER  ::   ikt          ! local integers
-      REAL(wp) ::   zue3a, zue3n, zue3b, zuf, zcoef    ! local scalars
-      REAL(wp) ::   zve3a, zve3n, zve3b, zvf, z1_2dt   !   -      -
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zue, zve
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ze3u_f, ze3v_f, zua, zva 
-      !!----------------------------------------------------------------------
-      !
-      IF( ln_timing    )   CALL timing_start('dyn_nxt')
-      IF( ln_dynspg_ts )   ALLOCATE( zue(jpi,jpj)     , zve(jpi,jpj)     )
-      IF( l_trddyn     )   ALLOCATE( zua(jpi,jpj,jpk) , zva(jpi,jpj,jpk) )
-      !
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'dyn_nxt : time stepping'
-         IF(lwp) WRITE(numout,*) '~~~~~~~'
-      ENDIF
-
-      IF ( ln_dynspg_ts ) THEN
-         ! Ensure below that barotropic velocities match time splitting estimate
-         ! Compute actual transport and replace it with ts estimate at "after" time step
-         zue(:,:) = e3u_a(:,:,1) * ua(:,:,1) * umask(:,:,1)
-         zve(:,:) = e3v_a(:,:,1) * va(:,:,1) * vmask(:,:,1)
-         DO jk = 2, jpkm1
-            zue(:,:) = zue(:,:) + e3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk)
-            zve(:,:) = zve(:,:) + e3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk)
-         END DO
-         DO jk = 1, jpkm1
-            ua(:,:,jk) = ( ua(:,:,jk) - zue(:,:) * r1_hu_a(:,:) + ua_b(:,:) ) * umask(:,:,jk)
-            va(:,:,jk) = ( va(:,:,jk) - zve(:,:) * r1_hv_a(:,:) + va_b(:,:) ) * vmask(:,:,jk)
-         END DO
-         !
-         IF( .NOT.ln_bt_fw ) THEN
-            ! Remove advective velocity from "now velocities" 
-            ! prior to asselin filtering     
-            ! In the forward case, this is done below after asselin filtering   
-            ! so that asselin contribution is removed at the same time 
-            DO jk = 1, jpkm1
-               un(:,:,jk) = ( un(:,:,jk) - un_adv(:,:)*r1_hu_n(:,:) + un_b(:,:) )*umask(:,:,jk)
-               vn(:,:,jk) = ( vn(:,:,jk) - vn_adv(:,:)*r1_hv_n(:,:) + vn_b(:,:) )*vmask(:,:,jk)
-            END DO  
-         ENDIF
-      ENDIF
-
-      ! Update after velocity on domain lateral boundaries
-      ! --------------------------------------------------      
-# if defined key_agrif
-      CALL Agrif_dyn( kt )             !* AGRIF zoom boundaries
-# endif
-      !
-      CALL lbc_lnk_multi( 'dynnxt', ua, 'U', -1., va, 'V', -1. )     !* local domain boundaries
-      !
-      !                                !* BDY open boundaries
-      IF( ln_bdy .AND. ln_dynspg_exp )   CALL bdy_dyn( kt )
-      IF( ln_bdy .AND. ln_dynspg_ts  )   CALL bdy_dyn( kt, dyn3d_only=.true. )
-
-!!$   Do we need a call to bdy_vol here??
-      !
-      IF( l_trddyn ) THEN             ! prepare the atf trend computation + some diagnostics
-         z1_2dt = 1._wp / (2. * rdt)        ! Euler or leap-frog time step 
-         IF( neuler == 0 .AND. kt == nit000 )   z1_2dt = 1._wp / rdt
-         !
-         !                                  ! Kinetic energy and Conversion
-         IF( ln_KE_trd  )   CALL trd_dyn( ua, va, jpdyn_ken, kt )
-         !
-         IF( ln_dyn_trd ) THEN              ! 3D output: total momentum trends
-            zua(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) * z1_2dt
-            zva(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) * z1_2dt
-            CALL iom_put( "utrd_tot", zua )        ! total momentum trends, except the asselin time filter
-            CALL iom_put( "vtrd_tot", zva )
-         ENDIF
-         !
-         zua(:,:,:) = un(:,:,:)             ! save the now velocity before the asselin filter
-         zva(:,:,:) = vn(:,:,:)             ! (caution: there will be a shift by 1 timestep in the
-         !                                  !  computation of the asselin filter trends)
-      ENDIF
-
-      ! Time filter and swap of dynamics arrays
-      ! ------------------------------------------
-      IF( neuler == 0 .AND. kt == nit000 ) THEN        !* Euler at first time-step: only swap
-         DO jk = 1, jpkm1
-            un(:,:,jk) = ua(:,:,jk)                         ! un <-- ua
-            vn(:,:,jk) = va(:,:,jk)
-         END DO
-         IF( .NOT.ln_linssh ) THEN                          ! e3._b <-- e3._n
-!!gm BUG ????    I don't understand why it is not : e3._n <-- e3._a  
-            DO jk = 1, jpkm1
-!               e3t_b(:,:,jk) = e3t_n(:,:,jk)
-!               e3u_b(:,:,jk) = e3u_n(:,:,jk)
-!               e3v_b(:,:,jk) = e3v_n(:,:,jk)
-               !
-               e3t_n(:,:,jk) = e3t_a(:,:,jk)
-               e3u_n(:,:,jk) = e3u_a(:,:,jk)
-               e3v_n(:,:,jk) = e3v_a(:,:,jk)
-            END DO
-!!gm BUG end
-         ENDIF
-                                                            ! 
-         
-      ELSE                                             !* Leap-Frog : Asselin filter and swap
-         !                                ! =============!
-         IF( ln_linssh ) THEN             ! Fixed volume !
-            !                             ! =============!
-            DO jk = 1, jpkm1                              
-               DO jj = 1, jpj
-                  DO ji = 1, jpi    
-                     zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2._wp * un(ji,jj,jk) + ua(ji,jj,jk) )
-                     zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2._wp * vn(ji,jj,jk) + va(ji,jj,jk) )
-                     !
-                     ub(ji,jj,jk) = zuf                      ! ub <-- filtered velocity
-                     vb(ji,jj,jk) = zvf
-                     un(ji,jj,jk) = ua(ji,jj,jk)             ! un <-- ua
-                     vn(ji,jj,jk) = va(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
-            !                             ! ================!
-         ELSE                             ! Variable volume !
-            !                             ! ================!
-            ! Before scale factor at t-points
-            ! (used as a now filtered scale factor until the swap)
-            ! ----------------------------------------------------
-            DO jk = 1, jpkm1
-               e3t_b(:,:,jk) = e3t_n(:,:,jk) + atfp * ( e3t_b(:,:,jk) - 2._wp * e3t_n(:,:,jk) + e3t_a(:,:,jk) )
-            END DO
-            ! Add volume filter correction: compatibility with tracer advection scheme
-            ! => time filter + conservation correction (only at the first level)
-            zcoef = atfp * rdt * r1_rau0
-
-            e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef * ( emp_b(:,:) - emp(:,:) ) * tmask(:,:,1)
-
-            IF ( ln_rnf ) THEN
-               IF( ln_rnf_depth ) THEN
-                  DO jk = 1, jpkm1 ! Deal with Rivers separetely, as can be through depth too
-                     DO jj = 1, jpj
-                        DO ji = 1, jpi
-                           IF( jk <=  nk_rnf(ji,jj)  ) THEN
-                               e3t_b(ji,jj,jk) =   e3t_b(ji,jj,jk) - zcoef *  ( - rnf_b(ji,jj) + rnf(ji,jj) ) &
-                                      &          * ( e3t_n(ji,jj,jk) / h_rnf(ji,jj) ) * tmask(ji,jj,jk)
-                           ENDIF
-                        ENDDO
-                     ENDDO
-                  ENDDO
-               ELSE
-                  e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef *  ( -rnf_b(:,:) + rnf(:,:))*tmask(:,:,1)
-               ENDIF
-            END IF
-
-            IF ( ln_isf ) THEN   ! if ice shelf melting
-               DO jk = 1, jpkm1 ! Deal with isf separetely, as can be through depth too
-                  DO jj = 1, jpj
-                     DO ji = 1, jpi
-                        IF( misfkt(ji,jj) <=jk .and. jk < misfkb(ji,jj)  ) THEN
-                           e3t_b(ji,jj,jk) = e3t_b(ji,jj,jk) - zcoef * ( fwfisf_b(ji,jj) - fwfisf(ji,jj) ) &
-                                &          * ( e3t_n(ji,jj,jk) * r1_hisf_tbl(ji,jj) ) * tmask(ji,jj,jk)
-                        ELSEIF ( jk==misfkb(ji,jj) ) THEN
-                           e3t_b(ji,jj,jk) = e3t_b(ji,jj,jk) - zcoef * ( fwfisf_b(ji,jj) - fwfisf(ji,jj) ) &
-                                &          * ( e3t_n(ji,jj,jk) * r1_hisf_tbl(ji,jj) ) * ralpha(ji,jj) * tmask(ji,jj,jk)
-                        ENDIF
-                     END DO
-                  END DO
-               END DO
-            END IF
-            !
-            IF( ln_dynadv_vec ) THEN      ! Asselin filter applied on velocity
-               ! Before filtered scale factor at (u/v)-points
-               CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' )
-               CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' )
-               DO jk = 1, jpkm1
-                  DO jj = 1, jpj
-                     DO ji = 1, jpi
-                        zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2._wp * un(ji,jj,jk) + ua(ji,jj,jk) )
-                        zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2._wp * vn(ji,jj,jk) + va(ji,jj,jk) )
-                        !
-                        ub(ji,jj,jk) = zuf                      ! ub <-- filtered velocity
-                        vb(ji,jj,jk) = zvf
-                        un(ji,jj,jk) = ua(ji,jj,jk)             ! un <-- ua
-                        vn(ji,jj,jk) = va(ji,jj,jk)
-                     END DO
-                  END DO
-               END DO
-               !
-            ELSE                          ! Asselin filter applied on thickness weighted velocity
-               !
-               ALLOCATE( ze3u_f(jpi,jpj,jpk) , ze3v_f(jpi,jpj,jpk) )
-               ! Before filtered scale factor at (u/v)-points stored in ze3u_f, ze3v_f
-               CALL dom_vvl_interpol( e3t_b(:,:,:), ze3u_f, 'U' )
-               CALL dom_vvl_interpol( e3t_b(:,:,:), ze3v_f, 'V' )
-               DO jk = 1, jpkm1
-                  DO jj = 1, jpj
-                     DO ji = 1, jpi                  
-                        zue3a = e3u_a(ji,jj,jk) * ua(ji,jj,jk)
-                        zve3a = e3v_a(ji,jj,jk) * va(ji,jj,jk)
-                        zue3n = e3u_n(ji,jj,jk) * un(ji,jj,jk)
-                        zve3n = e3v_n(ji,jj,jk) * vn(ji,jj,jk)
-                        zue3b = e3u_b(ji,jj,jk) * ub(ji,jj,jk)
-                        zve3b = e3v_b(ji,jj,jk) * vb(ji,jj,jk)
-                        !
-                        zuf = ( zue3n + atfp * ( zue3b - 2._wp * zue3n  + zue3a ) ) / ze3u_f(ji,jj,jk)
-                        zvf = ( zve3n + atfp * ( zve3b - 2._wp * zve3n  + zve3a ) ) / ze3v_f(ji,jj,jk)
-                        !
-                        ub(ji,jj,jk) = zuf                     ! ub <-- filtered velocity
-                        vb(ji,jj,jk) = zvf
-                        un(ji,jj,jk) = ua(ji,jj,jk)            ! un <-- ua
-                        vn(ji,jj,jk) = va(ji,jj,jk)
-                     END DO
-                  END DO
-               END DO
-               e3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1)        ! e3u_b <-- filtered scale factor
-               e3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1)
-               !
-               DEALLOCATE( ze3u_f , ze3v_f )
-            ENDIF
-            !
-         ENDIF
-         !
-         IF( ln_dynspg_ts .AND. ln_bt_fw ) THEN
-            ! Revert "before" velocities to time split estimate
-            ! Doing it here also means that asselin filter contribution is removed  
-            zue(:,:) = e3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1)
-            zve(:,:) = e3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1)    
-            DO jk = 2, jpkm1
-               zue(:,:) = zue(:,:) + e3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk)
-               zve(:,:) = zve(:,:) + e3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk)    
-            END DO
-            DO jk = 1, jpkm1
-               ub(:,:,jk) = ub(:,:,jk) - (zue(:,:) * r1_hu_n(:,:) - un_b(:,:)) * umask(:,:,jk)
-               vb(:,:,jk) = vb(:,:,jk) - (zve(:,:) * r1_hv_n(:,:) - vn_b(:,:)) * vmask(:,:,jk)
-            END DO
-         ENDIF
-         !
-      ENDIF ! neuler =/0
-      !
-      ! Set "now" and "before" barotropic velocities for next time step:
-      ! JC: Would be more clever to swap variables than to make a full vertical
-      ! integration
-      !
-      !
-      IF(.NOT.ln_linssh ) THEN
-         hu_b(:,:) = e3u_b(:,:,1) * umask(:,:,1)
-         hv_b(:,:) = e3v_b(:,:,1) * vmask(:,:,1)
-         DO jk = 2, jpkm1
-            hu_b(:,:) = hu_b(:,:) + e3u_b(:,:,jk) * umask(:,:,jk)
-            hv_b(:,:) = hv_b(:,:) + e3v_b(:,:,jk) * vmask(:,:,jk)
-         END DO
-         r1_hu_b(:,:) = ssumask(:,:) / ( hu_b(:,:) + 1._wp - ssumask(:,:) )
-         r1_hv_b(:,:) = ssvmask(:,:) / ( hv_b(:,:) + 1._wp - ssvmask(:,:) )
-      ENDIF
-      !
-      un_b(:,:) = e3u_a(:,:,1) * un(:,:,1) * umask(:,:,1)
-      ub_b(:,:) = e3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1)
-      vn_b(:,:) = e3v_a(:,:,1) * vn(:,:,1) * vmask(:,:,1)
-      vb_b(:,:) = e3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1)
-      DO jk = 2, jpkm1
-         un_b(:,:) = un_b(:,:) + e3u_a(:,:,jk) * un(:,:,jk) * umask(:,:,jk)
-         ub_b(:,:) = ub_b(:,:) + e3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk)
-         vn_b(:,:) = vn_b(:,:) + e3v_a(:,:,jk) * vn(:,:,jk) * vmask(:,:,jk)
-         vb_b(:,:) = vb_b(:,:) + e3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk)
-      END DO
-      un_b(:,:) = un_b(:,:) * r1_hu_a(:,:)
-      vn_b(:,:) = vn_b(:,:) * r1_hv_a(:,:)
-      ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:)
-      vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:)
-      !
-      IF( .NOT.ln_dynspg_ts ) THEN        ! output the barotropic currents
-         CALL iom_put(  "ubar", un_b(:,:) )
-         CALL iom_put(  "vbar", vn_b(:,:) )
-      ENDIF
-      IF( l_trddyn ) THEN                ! 3D output: asselin filter trends on momentum
-         zua(:,:,:) = ( ub(:,:,:) - zua(:,:,:) ) * z1_2dt
-         zva(:,:,:) = ( vb(:,:,:) - zva(:,:,:) ) * z1_2dt
-         CALL trd_dyn( zua, zva, jpdyn_atf, kt )
-      ENDIF
-      !
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=un, clinfo1=' nxt  - Un: ', mask1=umask,   &
-         &                       tab3d_2=vn, clinfo2=' Vn: '       , mask2=vmask )
-      ! 
-      IF( ln_dynspg_ts )   DEALLOCATE( zue, zve )
-      IF( l_trddyn     )   DEALLOCATE( zua, zva )
-      IF( ln_timing    )   CALL timing_stop('dyn_nxt')
-      !
-   END SUBROUTINE dyn_nxt
-
-   !!=========================================================================
-END MODULE dynnxt
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynspg.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynspg.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynspg.F90	(revision 12928)
@@ -21,6 +21,5 @@
    USE dynspg_exp     ! surface pressure gradient     (dyn_spg_exp routine)
    USE dynspg_ts      ! surface pressure gradient     (dyn_spg_ts  routine)
-   USE sbctide        ! 
-   USE updtide        ! 
+   USE tide_mod       !
    USE trd_oce        ! trends: ocean variables
    USE trddyn         ! trend manager: dynamics
@@ -43,7 +42,9 @@
    INTEGER, PARAMETER ::   np_EXP = 0   !       explicit time stepping
    INTEGER, PARAMETER ::   np_NO  =-1   ! no surface pressure gradient, no scheme
+   !
+   REAL(wp) ::   zt0step !   Time of day at the beginning of the time step
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -53,5 +54,5 @@
 CONTAINS
 
-   SUBROUTINE dyn_spg( kt )
+   SUBROUTINE dyn_spg( kt, Kbb, Kmm, Krhs, puu, pvv, pssh, puu_b, pvv_b, Kaa )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dyn_spg  ***
@@ -66,13 +67,16 @@
       !!              ln_apr_dyn=T : the atmospheric pressure forcing is applied 
       !!             as the gradient of the inverse barometer ssh:
-      !!                apgu = - 1/rau0 di[apr] = 0.5*grav di[ssh_ib+ssh_ibb]
-      !!                apgv = - 1/rau0 dj[apr] = 0.5*grav dj[ssh_ib+ssh_ibb]
-      !!             Note that as all external forcing a time averaging over a two rdt
+      !!                apgu = - 1/rho0 di[apr] = 0.5*grav di[ssh_ib+ssh_ibb]
+      !!                apgv = - 1/rho0 dj[apr] = 0.5*grav dj[ssh_ib+ssh_ibb]
+      !!             Note that as all external forcing a time averaging over a two rn_Dt
       !!             period is used to prevent the divergence of odd and even time step.
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  kt                  ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kbb, Kmm, Krhs, Kaa ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv            ! ocean velocities and RHS of momentum equation
+      REAL(wp), DIMENSION(jpi,jpj,jpt)    , INTENT(inout) ::  pssh, puu_b, pvv_b  ! SSH and barotropic velocities at main time levels
       !
       INTEGER  ::   ji, jj, jk                   ! dummy loop indices
-      REAL(wp) ::   z2dt, zg_2, zintp, zgrau0r, zld   ! local scalars
+      REAL(wp) ::   z2dt, zg_2, zintp, zgrho0r, zld   ! local scalars
       REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zpice
       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdu, ztrdv
@@ -83,6 +87,6 @@
       IF( l_trddyn )   THEN                      ! temporary save of ta and sa trends
          ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 
-         ztrdu(:,:,:) = ua(:,:,:)
-         ztrdv(:,:,:) = va(:,:,:)
+         ztrdu(:,:,:) = puu(:,:,:,Krhs)
+         ztrdv(:,:,:) = pvv(:,:,:,Krhs)
       ENDIF
       !
@@ -91,21 +95,17 @@
          .OR.  ln_ice_embd ) THEN                                            ! embedded sea-ice
          !
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               spgu(ji,jj) = 0._wp
-               spgv(ji,jj) = 0._wp
-            END DO
-         END DO         
+         DO_2D_00_00
+            spgu(ji,jj) = 0._wp
+            spgv(ji,jj) = 0._wp
+         END_2D
          !
          IF( ln_apr_dyn .AND. .NOT.ln_dynspg_ts ) THEN   !==  Atmospheric pressure gradient (added later in time-split case) ==!
             zg_2 = grav * 0.5
-            DO jj = 2, jpjm1                          ! gradient of Patm using inverse barometer ssh
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  spgu(ji,jj) = spgu(ji,jj) + zg_2 * (  ssh_ib (ji+1,jj) - ssh_ib (ji,jj)    &
-                     &                                + ssh_ibb(ji+1,jj) - ssh_ibb(ji,jj)  ) * r1_e1u(ji,jj)
-                  spgv(ji,jj) = spgv(ji,jj) + zg_2 * (  ssh_ib (ji,jj+1) - ssh_ib (ji,jj)    &
-                     &                                + ssh_ibb(ji,jj+1) - ssh_ibb(ji,jj)  ) * r1_e2v(ji,jj)
-               END DO
-            END DO
+            DO_2D_00_00
+               spgu(ji,jj) = spgu(ji,jj) + zg_2 * (  ssh_ib (ji+1,jj) - ssh_ib (ji,jj)    &
+                  &                                + ssh_ibb(ji+1,jj) - ssh_ibb(ji,jj)  ) * r1_e1u(ji,jj)
+               spgv(ji,jj) = spgv(ji,jj) + zg_2 * (  ssh_ib (ji,jj+1) - ssh_ib (ji,jj)    &
+                  &                                + ssh_ibb(ji,jj+1) - ssh_ibb(ji,jj)  ) * r1_e2v(ji,jj)
+            END_2D
          ENDIF
          !
@@ -113,21 +113,19 @@
          IF( .NOT.ln_dynspg_ts .AND. ( ln_tide_pot .AND. ln_tide )  ) THEN   ! N.B. added directly at sub-time-step in ts-case
             !
-            CALL upd_tide( kt )                      ! update tide potential
+            ! Update tide potential at the beginning of current time step
+            zt0step = REAL(nsec_day, wp)-0.5_wp*rn_Dt
+            CALL upd_tide(zt0step, Kmm)
             !
-            DO jj = 2, jpjm1                         ! add tide potential forcing
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  spgu(ji,jj) = spgu(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj)
-                  spgv(ji,jj) = spgv(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj)
-               END DO 
-            END DO
+            DO_2D_00_00
+               spgu(ji,jj) = spgu(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj)
+               spgv(ji,jj) = spgv(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj)
+            END_2D
             !
             IF (ln_scal_load) THEN
                zld = rn_scal_load * grav
-               DO jj = 2, jpjm1                    ! add scalar approximation for load potential
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     spgu(ji,jj) = spgu(ji,jj) + zld * ( sshn(ji+1,jj) - sshn(ji,jj) ) * r1_e1u(ji,jj)
-                     spgv(ji,jj) = spgv(ji,jj) + zld * ( sshn(ji,jj+1) - sshn(ji,jj) ) * r1_e2v(ji,jj)
-                  END DO 
-               END DO
+               DO_2D_00_00
+                  spgu(ji,jj) = spgu(ji,jj) + zld * ( pssh(ji+1,jj,Kmm) - pssh(ji,jj,Kmm) ) * r1_e1u(ji,jj)
+                  spgv(ji,jj) = spgv(ji,jj) + zld * ( pssh(ji,jj+1,Kmm) - pssh(ji,jj,Kmm) ) * r1_e2v(ji,jj)
+               END_2D
             ENDIF
          ENDIF
@@ -136,23 +134,17 @@
             ALLOCATE( zpice(jpi,jpj) )
             zintp = REAL( MOD( kt-1, nn_fsbc ) ) / REAL( nn_fsbc )
-            zgrau0r     = - grav * r1_rau0
-            zpice(:,:) = (  zintp * snwice_mass(:,:) + ( 1.- zintp ) * snwice_mass_b(:,:)  ) * zgrau0r
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  spgu(ji,jj) = spgu(ji,jj) + ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj)
-                  spgv(ji,jj) = spgv(ji,jj) + ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj)
-               END DO
-            END DO
+            zgrho0r     = - grav * r1_rho0
+            zpice(:,:) = (  zintp * snwice_mass(:,:) + ( 1.- zintp ) * snwice_mass_b(:,:)  ) * zgrho0r
+            DO_2D_00_00
+               spgu(ji,jj) = spgu(ji,jj) + ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj)
+               spgv(ji,jj) = spgv(ji,jj) + ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj)
+            END_2D
             DEALLOCATE( zpice )         
          ENDIF
          !
-         DO jk = 1, jpkm1                    !== Add all terms to the general trend
-            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)
-               END DO
-            END DO
-         END DO    
+         DO_3D_00_00( 1, jpkm1 )
+            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + spgu(ji,jj)
+            pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + spgv(ji,jj)
+         END_3D
          !
 !!gm add here a call to dyn_trd for ice pressure gradient, the surf pressure trends ????
@@ -161,17 +153,17 @@
       !
       SELECT CASE ( nspg )                   !== surface pressure gradient computed and add to the general trend ==!
-      CASE ( np_EXP )   ;   CALL dyn_spg_exp( kt )              ! explicit
-      CASE ( np_TS  )   ;   CALL dyn_spg_ts ( kt )              ! time-splitting
+      CASE ( np_EXP )   ;   CALL dyn_spg_exp( kt,      Kmm,       puu, pvv, Krhs )                    ! explicit
+      CASE ( np_TS  )   ;   CALL dyn_spg_ts ( kt, Kbb, Kmm, Krhs, puu, pvv, pssh, puu_b, pvv_b, Kaa ) ! time-splitting
       END SELECT
       !                    
       IF( l_trddyn )   THEN                  ! save the surface pressure gradient trends for further diagnostics
-         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
-         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
-         CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt )
+         ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:)
+         ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:)
+         CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt, Kmm )
          DEALLOCATE( ztrdu , ztrdv ) 
       ENDIF
       !                                      ! print mean trends (used for debugging)
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' spg  - Ua: ', mask1=umask, &
-         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' spg  - Ua: ', mask1=umask, &
+         &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
       !
       IF( ln_timing )   CALL timing_stop('dyn_spg')
@@ -191,5 +183,5 @@
       NAMELIST/namdyn_spg/ ln_dynspg_exp       , ln_dynspg_ts,   &
       &                    ln_bt_fw, ln_bt_av  , ln_bt_auto  ,   &
-      &                    nn_baro , rn_bt_cmax, nn_bt_flt, rn_bt_alpha
+      &                    nn_e , rn_bt_cmax, nn_bt_flt, rn_bt_alpha
       !!----------------------------------------------------------------------
       !
@@ -200,9 +192,7 @@
       ENDIF
       !
-      REWIND( numnam_ref )              ! Namelist namdyn_spg in reference namelist : Free surface
       READ  ( numnam_ref, namdyn_spg, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_spg in reference namelist' )
       !
-      REWIND( numnam_cfg )              ! Namelist namdyn_spg in configuration namelist : Free surface
       READ  ( numnam_cfg, namdyn_spg, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_spg in configuration namelist' )
@@ -232,5 +222,5 @@
       !
       IF( nspg == np_TS ) THEN   ! split-explicit scheme initialisation
-         CALL dyn_spg_ts_init          ! do it first: set nn_baro used to allocate some arrays later on
+         CALL dyn_spg_ts_init          ! do it first: set nn_e used to allocate some arrays later on
       ENDIF
       !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynspg_exp.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynspg_exp.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynspg_exp.F90	(revision 12928)
@@ -30,5 +30,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -38,5 +38,5 @@
 CONTAINS
 
-   SUBROUTINE dyn_spg_exp( kt )
+   SUBROUTINE dyn_spg_exp( kt, Kmm, puu, pvv, Krhs )
       !!----------------------------------------------------------------------
       !!                  ***  routine dyn_spg_exp  ***
@@ -48,12 +48,14 @@
       !! ** Method  :   Explicit free surface formulation. Add to the general
       !!              momentum trend the surface pressure gradient :
-      !!                      (ua,va) = (ua,va) + (spgu,spgv)
-      !!              where spgu = -1/rau0 d/dx(ps) = -g/e1u di( sshn )
-      !!                    spgv = -1/rau0 d/dy(ps) = -g/e2v dj( sshn )
+      !!                      (uu(rhs),vv(rhs)) = (uu(rhs),vv(rhs)) + (spgu,spgv)
+      !!              where spgu = -1/rho0 d/dx(ps) = -g/e1u di( ssh(now) )
+      !!                    spgv = -1/rho0 d/dy(ps) = -g/e2v dj( ssh(now) )
       !!
-      !! ** Action :   (ua,va)   trend of horizontal velocity increased by 
+      !! ** Action :   (puu(:,:,:,Krhs),pvv(:,:,:,Krhs))   trend of horizontal velocity increased by 
       !!                         the surf. pressure gradient trend
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in)  ::   kt   ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  kt        ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kmm, Krhs ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv  ! ocean velocities and RHS of momentum equation
       !!
       INTEGER ::   ji, jj, jk   ! dummy loop indices
@@ -72,19 +74,13 @@
       IF( ln_linssh ) THEN          !* linear free surface : add the surface pressure gradient trend
          !
-         DO jj = 2, jpjm1                    ! now surface pressure gradient
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               spgu(ji,jj) = - grav * ( sshn(ji+1,jj) - sshn(ji,jj) ) * r1_e1u(ji,jj)
-               spgv(ji,jj) = - grav * ( sshn(ji,jj+1) - sshn(ji,jj) ) * r1_e2v(ji,jj)
-            END DO 
-         END DO
+         DO_2D_00_00
+            spgu(ji,jj) = - grav * ( ssh(ji+1,jj,Kmm) - ssh(ji,jj,Kmm) ) * r1_e1u(ji,jj)
+            spgv(ji,jj) = - grav * ( ssh(ji,jj+1,Kmm) - ssh(ji,jj,Kmm) ) * r1_e2v(ji,jj)
+         END_2D
          !
-         DO jk = 1, jpkm1                    ! Add it to the general trend
-            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)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + spgu(ji,jj)
+            pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + spgv(ji,jj)
+         END_3D
          !
       ENDIF
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynspg_ts.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynspg_ts.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynspg_ts.F90	(revision 12928)
@@ -1,5 +1,5 @@
 MODULE dynspg_ts
 
-   !! Includes ROMS wd scheme with diagnostic outputs ; un and ua updates are commented out ! 
+   !! Includes ROMS wd scheme with diagnostic outputs ; puu(:,:,:,Kmm) and puu(:,:,:,Krhs) updates are commented out ! 
 
    !!======================================================================
@@ -31,7 +31,7 @@
    USE dom_oce         ! ocean space and time domain
    USE sbc_oce         ! surface boundary condition: ocean
+   USE isf_oce         ! ice shelf variable (fwfisf)
    USE zdf_oce         ! vertical physics: variables
    USE zdfdrg          ! vertical physics: top/bottom drag coef.
-   USE sbcisf          ! ice shelf variable (fwfisf)
    USE sbcapr          ! surface boundary condition: atmospheric pressure
    USE dynadv    , ONLY: ln_dynadv_vec
@@ -44,8 +44,6 @@
    USE bdytides        ! open boundary condition data
    USE bdydyn2d        ! open boundary conditions on barotropic variables
-   USE sbctide         ! tides
-   USE updtide         ! tide potential
+   USE tide_mod        !
    USE sbcwave         ! surface wave
-   USE diatmb          ! Top,middle,bottom output
 #if defined key_agrif
    USE agrif_oce_interp ! agrif
@@ -62,5 +60,4 @@
    USE iom             ! IOM library
    USE restart         ! only for lrst_oce
-   USE diatmb          ! Top,middle,bottom output
 
    USE iom   ! to remove
@@ -75,6 +72,6 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   un_adv , vn_adv   !: Advection vel. at "now" barocl. step
    !
-   INTEGER, SAVE :: icycle      ! Number of barotropic sub-steps for each internal step nn_baro <= 2.5 nn_baro
-   REAL(wp),SAVE :: rdtbt       ! Barotropic time step
+   INTEGER, SAVE :: icycle      ! Number of barotropic sub-steps for each internal step nn_e <= 2.5 nn_e
+   REAL(wp),SAVE :: rDt_e       ! Barotropic time step
    !
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)   ::   wgtbtp1, wgtbtp2   ! 1st & 2nd weights used in time filtering of barotropic fields
@@ -89,5 +86,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -105,5 +102,5 @@
       ierr(:) = 0
       !
-      ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(jpi,jpj), STAT=ierr(1) )
+      ALLOCATE( wgtbtp1(3*nn_e), wgtbtp2(3*nn_e), zwz(jpi,jpj), STAT=ierr(1) )
       IF( ln_dynvor_een .OR. ln_dynvor_eeT )   &
          &     ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , ftsw(jpi,jpj) , ftse(jpi,jpj), STAT=ierr(2)   )
@@ -119,5 +116,5 @@
 
 
-   SUBROUTINE dyn_spg_ts( kt )
+   SUBROUTINE dyn_spg_ts( kt, Kbb, Kmm, Krhs, puu, pvv, pssh, puu_b, pvv_b, Kaa )
       !!----------------------------------------------------------------------
       !!
@@ -134,15 +131,18 @@
       !!
       !! ** Action :
-      !!      -Update the filtered free surface at step "n+1"      : ssha
-      !!      -Update filtered barotropic velocities at step "n+1" : ua_b, va_b
+      !!      -Update the filtered free surface at step "n+1"      : pssh(:,:,Kaa)
+      !!      -Update filtered barotropic velocities at step "n+1" : puu_b(:,:,:,Kaa), vv_b(:,:,:,Kaa)
       !!      -Compute barotropic advective fluxes at step "n"     : un_adv, vn_adv
       !!      These are used to advect tracers and are compliant with discrete
       !!      continuity equation taken at the baroclinic time steps. This 
       !!      ensures tracers conservation.
-      !!      - (ua, va) momentum trend updated with barotropic component.
+      !!      - (puu(:,:,:,Krhs), pvv(:,:,:,Krhs)) momentum trend updated with barotropic component.
       !!
       !! References : Shchepetkin and McWilliams, Ocean Modelling, 2005. 
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in)  ::   kt   ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  kt                  ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kbb, Kmm, Krhs, Kaa ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv            ! ocean velocities and RHS of momentum equation
+      REAL(wp), DIMENSION(jpi,jpj,jpt)    , INTENT(inout) ::  pssh, puu_b, pvv_b  ! SSH and barotropic velocities at main time levels
       !
       INTEGER  ::   ji, jj, jk, jn        ! dummy loop indices
@@ -150,7 +150,7 @@
       LOGICAL  ::   ll_init               ! =T : special startup of 2d equations
       INTEGER  ::   noffset               ! local integers  : time offset for bdy update
-      REAL(wp) ::   r1_2dt_b, z1_hu, z1_hv          ! local scalars
+      REAL(wp) ::   r1_Dt_b, z1_hu, z1_hv          ! local scalars
       REAL(wp) ::   za0, za1, za2, za3              !   -      -
-      REAL(wp) ::   zmdi, zztmp, zldg               !   -      -
+      REAL(wp) ::   zztmp, zldg               !   -      -
       REAL(wp) ::   zhu_bck, zhv_bck, zhdiv         !   -      -
       REAL(wp) ::   zun_save, zvn_save              !   -      -
@@ -170,4 +170,5 @@
       REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztwdmask, zuwdmask, zvwdmask ! ROMS wetting and drying masks at t,u,v points
       REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zuwdav2, zvwdav2    ! averages over the sub-steps of zuwdmask and zvwdmask
+      REAL(wp) ::   zt0substep !   Time of day at the beginning of the time substep
       !!----------------------------------------------------------------------
       !
@@ -176,17 +177,13 @@
       IF( ln_wd_dl ) ALLOCATE( ztwdmask(jpi,jpj), zuwdmask(jpi,jpj), zvwdmask(jpi,jpj), zuwdav2(jpi,jpj), zvwdav2(jpi,jpj))
       !
-      zmdi=1.e+20                               !  missing data indicator for masking
-      !
       zwdramp = r_rn_wdmin1               ! simplest ramp 
 !     zwdramp = 1._wp / (rn_wdmin2 - rn_wdmin1) ! more general ramp
       !                                         ! inverse of baroclinic time step 
-      IF( kt == nit000 .AND. neuler == 0 ) THEN   ;   r1_2dt_b = 1._wp / (         rdt )
-      ELSE                                        ;   r1_2dt_b = 1._wp / ( 2._wp * rdt )
-      ENDIF
+      r1_Dt_b = 1._wp / rDt 
       !
       ll_init     = ln_bt_av                    ! if no time averaging, then no specific restart 
       ll_fw_start = .FALSE.
       !                                         ! time offset in steps for bdy data update
-      IF( .NOT.ln_bt_fw ) THEN   ;   noffset = - nn_baro
+      IF( .NOT.ln_bt_fw ) THEN   ;   noffset = - nn_e
       ELSE                       ;   noffset =   0 
       ENDIF
@@ -199,7 +196,7 @@
          IF(lwp) WRITE(numout,*)
          !
-         IF( neuler == 0 )   ll_init=.TRUE.
-         !
-         IF( ln_bt_fw .OR. neuler == 0 ) THEN
+         IF( l_1st_euler )   ll_init=.TRUE.
+         !
+         IF( ln_bt_fw .OR. l_1st_euler ) THEN
             ll_fw_start =.TRUE.
             noffset     = 0
@@ -210,14 +207,17 @@
          CALL ts_wgt( ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2 )
          !
-      ENDIF
-      !
-      ! If forward start at previous time step, and centered integration, 
-      ! then update averaging weights:
-      IF (.NOT.ln_bt_fw .AND.( neuler==0 .AND. kt==nit000+1 ) ) THEN
-         ll_fw_start=.FALSE.
-         CALL ts_wgt( ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2 )
-      ENDIF
-      !
-                          
+      ELSEIF( kt == nit000 + 1 ) THEN           !* initialisation 2nd time-step
+         !
+         IF( .NOT.ln_bt_fw ) THEN
+            ! If we did an Euler timestep on the first timestep we need to reset ll_fw_start
+            ! and the averaging weights. We don't have an easy way of telling whether we did
+            ! an Euler timestep on the first timestep (because l_1st_euler is reset to .false.
+            ! at the end of the first timestep) so just do this in all cases. 
+            ll_fw_start = .FALSE.
+            CALL ts_wgt( ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2 )
+         ENDIF
+         !
+      ENDIF
+      !
       ! -----------------------------------------------------------------------------
       !  Phase 1 : Coupling between general trend and barotropic estimates (1st step)
@@ -227,12 +227,12 @@
       !                                   !=  zu_frc =  1/H e3*d/dt(Ua)  =!  (Vertical mean of Ua, the 3D trends)
       !                                   !  ---------------------------  !
-      zu_frc(:,:) = SUM( e3u_n(:,:,:) * ua(:,:,:) * umask(:,:,:) , DIM=3 ) * r1_hu_n(:,:)
-      zv_frc(:,:) = SUM( e3v_n(:,:,:) * va(:,:,:) * vmask(:,:,:) , DIM=3 ) * r1_hv_n(:,:)
-      !
-      !
-      !                                   !=  Ua => baroclinic trend  =!   (remove its vertical mean)
-      DO jk = 1, jpkm1                    !  ------------------------  !
-         ua(:,:,jk) = ( ua(:,:,jk) - zu_frc(:,:) ) * umask(:,:,jk)
-         va(:,:,jk) = ( va(:,:,jk) - zv_frc(:,:) ) * vmask(:,:,jk)
+      zu_frc(:,:) = SUM( e3u(:,:,:,Kmm) * uu(:,:,:,Krhs) * umask(:,:,:) , DIM=3 ) * r1_hu(:,:,Kmm)
+      zv_frc(:,:) = SUM( e3v(:,:,:,Kmm) * vv(:,:,:,Krhs) * vmask(:,:,:) , DIM=3 ) * r1_hv(:,:,Kmm)
+      !
+      !
+      !                                   !=  U(Krhs) => baroclinic trend  =!   (remove its vertical mean)
+      DO jk = 1, jpkm1                    !  -----------------------------  !
+         uu(:,:,jk,Krhs) = ( uu(:,:,jk,Krhs) - zu_frc(:,:) ) * umask(:,:,jk)
+         vv(:,:,jk,Krhs) = ( vv(:,:,jk,Krhs) - zv_frc(:,:) ) * vmask(:,:,jk)
       END DO
       
@@ -243,69 +243,58 @@
       !                                   !  -------------------------------------------------  !
       !
-      IF( kt == nit000 .OR. .NOT. ln_linssh )   CALL dyn_cor_2D_init   ! Set zwz, the barotropic Coriolis force coefficient
+      IF( kt == nit000 .OR. .NOT. ln_linssh )   CALL dyn_cor_2D_init( Kmm )   ! Set zwz, the barotropic Coriolis force coefficient
       !       ! recompute zwz = f/depth  at every time step for (.NOT.ln_linssh) as the water colomn height changes
       !
       !                                         !* 2D Coriolis trends
-      zhU(:,:) = un_b(:,:) * hu_n(:,:) * e2u(:,:)        ! now fluxes 
-      zhV(:,:) = vn_b(:,:) * hv_n(:,:) * e1v(:,:)        ! NB: FULL domain : put a value in last row and column
-      !
-      CALL dyn_cor_2d( hu_n, hv_n, un_b, vn_b, zhU, zhV,  &   ! <<== in
-         &                               zu_trd, zv_trd   )   ! ==>> out
+      zhU(:,:) = puu_b(:,:,Kmm) * hu(:,:,Kmm) * e2u(:,:)        ! now fluxes 
+      zhV(:,:) = pvv_b(:,:,Kmm) * hv(:,:,Kmm) * e1v(:,:)        ! NB: FULL domain : put a value in last row and column
+      !
+      CALL dyn_cor_2d( hu(:,:,Kmm), hv(:,:,Kmm), puu_b(:,:,Kmm), pvv_b(:,:,Kmm), zhU, zhV,  &   ! <<== in
+         &                                                                     zu_trd, zv_trd   )   ! ==>> out
       !
       IF( .NOT.ln_linssh ) THEN                 !* surface pressure gradient   (variable volume only)
          !
          IF( ln_wd_il ) THEN                       ! W/D : limiter applied to spgspg
-            CALL wad_spg( sshn, zcpx, zcpy )          ! Calculating W/D gravity filters, zcpx and zcpy
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1                ! SPG with the application of W/D gravity filters
-                  zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( sshn(ji+1,jj  ) - sshn(ji  ,jj ) )   &
-                     &                          * r1_e1u(ji,jj) * zcpx(ji,jj)  * wdrampu(ji,jj)  !jth
-                  zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( sshn(ji  ,jj+1) - sshn(ji  ,jj ) )   &
-                     &                          * r1_e2v(ji,jj) * zcpy(ji,jj)  * wdrampv(ji,jj)  !jth
-               END DO
-            END DO
+            CALL wad_spg( pssh(:,:,Kmm), zcpx, zcpy )          ! Calculating W/D gravity filters, zcpx and zcpy
+            DO_2D_00_00
+               zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( pssh(ji+1,jj  ,Kmm) - pssh(ji  ,jj ,Kmm) )   &
+                  &                          * r1_e1u(ji,jj) * zcpx(ji,jj)  * wdrampu(ji,jj)  !jth
+               zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( pssh(ji  ,jj+1,Kmm) - pssh(ji  ,jj ,Kmm) )   &
+                  &                          * r1_e2v(ji,jj) * zcpy(ji,jj)  * wdrampv(ji,jj)  !jth
+            END_2D
          ELSE                                      ! now suface pressure gradient
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zu_trd(ji,jj) = zu_trd(ji,jj) - grav * (  sshn(ji+1,jj  ) - sshn(ji  ,jj  )  ) * r1_e1u(ji,jj)
-                  zv_trd(ji,jj) = zv_trd(ji,jj) - grav * (  sshn(ji  ,jj+1) - sshn(ji  ,jj  )  ) * r1_e2v(ji,jj) 
-               END DO
-            END DO
-         ENDIF
-         !
-      ENDIF
-      !
-      DO jj = 2, jpjm1                          ! Remove coriolis term (and possibly spg) from barotropic trend
-         DO ji = fs_2, fs_jpim1
-             zu_frc(ji,jj) = zu_frc(ji,jj) - zu_trd(ji,jj) * ssumask(ji,jj)
-             zv_frc(ji,jj) = zv_frc(ji,jj) - zv_trd(ji,jj) * ssvmask(ji,jj)
-          END DO
-      END DO 
+            DO_2D_00_00
+               zu_trd(ji,jj) = zu_trd(ji,jj) - grav * (  pssh(ji+1,jj  ,Kmm) - pssh(ji  ,jj  ,Kmm)  ) * r1_e1u(ji,jj)
+               zv_trd(ji,jj) = zv_trd(ji,jj) - grav * (  pssh(ji  ,jj+1,Kmm) - pssh(ji  ,jj  ,Kmm)  ) * r1_e2v(ji,jj) 
+            END_2D
+         ENDIF
+         !
+      ENDIF
+      !
+      DO_2D_00_00
+          zu_frc(ji,jj) = zu_frc(ji,jj) - zu_trd(ji,jj) * ssumask(ji,jj)
+          zv_frc(ji,jj) = zv_frc(ji,jj) - zv_trd(ji,jj) * ssvmask(ji,jj)
+      END_2D
       !
       !                                   !=  Add bottom stress contribution from baroclinic velocities  =!
       !                                   !  -----------------------------------------------------------  !
-      CALL dyn_drg_init( zu_frc, zv_frc,  zCdU_u, zCdU_v )      ! also provide the barotropic drag coefficients
-      !
+      CALL dyn_drg_init( Kbb, Kmm, puu, pvv, puu_b ,pvv_b, zu_frc, zv_frc,  zCdU_u, zCdU_v )      ! also provide the barotropic drag coefficients
       !                                   !=  Add atmospheric pressure forcing  =!
       !                                   !  ----------------------------------  !
       IF( ln_apr_dyn ) THEN
          IF( ln_bt_fw ) THEN                          ! FORWARD integration: use kt+1/2 pressure (NOW+1/2)
-            DO jj = 2, jpjm1              
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zu_frc(ji,jj) = zu_frc(ji,jj) + grav * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj) ) * r1_e1u(ji,jj)
-                  zv_frc(ji,jj) = zv_frc(ji,jj) + grav * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj) ) * r1_e2v(ji,jj)
-               END DO
-            END DO
+            DO_2D_00_00
+               zu_frc(ji,jj) = zu_frc(ji,jj) + grav * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj) ) * r1_e1u(ji,jj)
+               zv_frc(ji,jj) = zv_frc(ji,jj) + grav * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj) ) * r1_e2v(ji,jj)
+            END_2D
          ELSE                                         ! CENTRED integration: use kt-1/2 + kt+1/2 pressure (NOW)
             zztmp = grav * r1_2
-            DO jj = 2, jpjm1              
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zu_frc(ji,jj) = zu_frc(ji,jj) + zztmp * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj)  &
-                       &                                   + ssh_ibb(ji+1,jj  ) - ssh_ibb(ji,jj)  ) * r1_e1u(ji,jj)
-                  zv_frc(ji,jj) = zv_frc(ji,jj) + zztmp * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj)  &
-                       &                                   + ssh_ibb(ji  ,jj+1) - ssh_ibb(ji,jj)  ) * r1_e2v(ji,jj)
-               END DO
-            END DO
-         ENDIF 
+            DO_2D_00_00
+               zu_frc(ji,jj) = zu_frc(ji,jj) + zztmp * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj)  &
+                    &                                   + ssh_ibb(ji+1,jj  ) - ssh_ibb(ji,jj)  ) * r1_e1u(ji,jj)
+               zv_frc(ji,jj) = zv_frc(ji,jj) + zztmp * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj)  &
+                    &                                   + ssh_ibb(ji  ,jj+1) - ssh_ibb(ji,jj)  ) * r1_e2v(ji,jj)
+            END_2D
+         ENDIF
       ENDIF
       !
@@ -313,18 +302,14 @@
       !                                   !  ----------------------------------  !
       IF( ln_bt_fw ) THEN                        ! Add wind forcing
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zu_frc(ji,jj) =  zu_frc(ji,jj) + r1_rau0 * utau(ji,jj) * r1_hu_n(ji,jj)
-               zv_frc(ji,jj) =  zv_frc(ji,jj) + r1_rau0 * vtau(ji,jj) * r1_hv_n(ji,jj)
-            END DO
-         END DO
+         DO_2D_00_00
+            zu_frc(ji,jj) =  zu_frc(ji,jj) + r1_rho0 * utau(ji,jj) * r1_hu(ji,jj,Kmm)
+            zv_frc(ji,jj) =  zv_frc(ji,jj) + r1_rho0 * vtau(ji,jj) * r1_hv(ji,jj,Kmm)
+         END_2D
       ELSE
-         zztmp = r1_rau0 * r1_2
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zu_frc(ji,jj) =  zu_frc(ji,jj) + zztmp * ( utau_b(ji,jj) + utau(ji,jj) ) * r1_hu_n(ji,jj)
-               zv_frc(ji,jj) =  zv_frc(ji,jj) + zztmp * ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_hv_n(ji,jj)
-            END DO
-         END DO
+         zztmp = r1_rho0 * r1_2
+         DO_2D_00_00
+            zu_frc(ji,jj) =  zu_frc(ji,jj) + zztmp * ( utau_b(ji,jj) + utau(ji,jj) ) * r1_hu(ji,jj,Kmm)
+            zv_frc(ji,jj) =  zv_frc(ji,jj) + zztmp * ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_hv(ji,jj,Kmm)
+         END_2D
       ENDIF  
       !
@@ -335,8 +320,11 @@
       !                                   ! ---------------------------------------------------  !
       IF (ln_bt_fw) THEN                          ! FORWARD integration: use kt+1/2 fluxes (NOW+1/2)
-         zssh_frc(:,:) = r1_rau0 * ( emp(:,:)             - rnf(:,:)              + fwfisf(:,:)                  )
+         zssh_frc(:,:) = r1_rho0 * ( emp(:,:) - rnf(:,:) + fwfisf_cav(:,:) + fwfisf_par(:,:) )
       ELSE                                        ! CENTRED integration: use kt-1/2 + kt+1/2 fluxes (NOW)
-         zztmp = r1_rau0 * r1_2
-         zssh_frc(:,:) = zztmp * (  emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:) + fwfisf(:,:) + fwfisf_b(:,:)  )
+         zztmp = r1_rho0 * r1_2
+         zssh_frc(:,:) = zztmp * (  emp(:,:)        + emp_b(:,:)                    &
+                &                 - rnf(:,:)        - rnf_b(:,:)                    &
+                &                 + fwfisf_cav(:,:) + fwfisf_cav_b(:,:)             &
+                &                 + fwfisf_par(:,:) + fwfisf_par_b(:,:)             )
       ENDIF
       !                                   !=  Add Stokes drift divergence  =!   (if exist)
@@ -344,4 +332,19 @@
          zssh_frc(:,:) = zssh_frc(:,:) + div_sd(:,:)
       ENDIF
+      !
+      !                                         ! ice sheet coupling
+      IF ( ln_isf .AND. ln_isfcpl ) THEN
+         !
+         ! ice sheet coupling
+         IF( ln_rstart .AND. kt == nit000 ) THEN
+            zssh_frc(:,:) = zssh_frc(:,:) + risfcpl_ssh(:,:)
+         END IF
+         !
+         ! conservation option
+         IF( ln_isfcpl_cons ) THEN
+            zssh_frc(:,:) = zssh_frc(:,:) + risfcpl_cons_ssh(:,:)
+         END IF
+         !
+      END IF
       !
 #if defined key_asminc
@@ -376,33 +379,33 @@
       !
       IF( ln_linssh ) THEN    ! mid-step ocean depth is fixed (hup2_e=hu_n=hu_0)
-         zhup2_e(:,:) = hu_n(:,:)
-         zhvp2_e(:,:) = hv_n(:,:)
-         zhtp2_e(:,:) = ht_n(:,:)
+         zhup2_e(:,:) = hu(:,:,Kmm)
+         zhvp2_e(:,:) = hv(:,:,Kmm)
+         zhtp2_e(:,:) = ht(:,:)
       ENDIF
       !
       IF (ln_bt_fw) THEN                  ! FORWARD integration: start from NOW fields                    
-         sshn_e(:,:) =    sshn(:,:)            
-         un_e  (:,:) =    un_b(:,:)            
-         vn_e  (:,:) =    vn_b(:,:)
-         !
-         hu_e  (:,:) =    hu_n(:,:)       
-         hv_e  (:,:) =    hv_n(:,:) 
-         hur_e (:,:) = r1_hu_n(:,:)    
-         hvr_e (:,:) = r1_hv_n(:,:)
+         sshn_e(:,:) =    pssh(:,:,Kmm)            
+         un_e  (:,:) =    puu_b(:,:,Kmm)            
+         vn_e  (:,:) =    pvv_b(:,:,Kmm)
+         !
+         hu_e  (:,:) =    hu(:,:,Kmm)       
+         hv_e  (:,:) =    hv(:,:,Kmm) 
+         hur_e (:,:) = r1_hu(:,:,Kmm)    
+         hvr_e (:,:) = r1_hv(:,:,Kmm)
       ELSE                                ! CENTRED integration: start from BEFORE fields
-         sshn_e(:,:) =    sshb(:,:)
-         un_e  (:,:) =    ub_b(:,:)         
-         vn_e  (:,:) =    vb_b(:,:)
-         !
-         hu_e  (:,:) =    hu_b(:,:)       
-         hv_e  (:,:) =    hv_b(:,:) 
-         hur_e (:,:) = r1_hu_b(:,:)    
-         hvr_e (:,:) = r1_hv_b(:,:)
+         sshn_e(:,:) =    pssh(:,:,Kbb)
+         un_e  (:,:) =    puu_b(:,:,Kbb)         
+         vn_e  (:,:) =    pvv_b(:,:,Kbb)
+         !
+         hu_e  (:,:) =    hu(:,:,Kbb)       
+         hv_e  (:,:) =    hv(:,:,Kbb) 
+         hur_e (:,:) = r1_hu(:,:,Kbb)    
+         hvr_e (:,:) = r1_hv(:,:,Kbb)
       ENDIF
       !
       ! Initialize sums:
-      ua_b  (:,:) = 0._wp       ! After barotropic velocities (or transport if flux form)          
-      va_b  (:,:) = 0._wp
-      ssha  (:,:) = 0._wp       ! Sum for after averaged sea level
+      puu_b  (:,:,Kaa) = 0._wp       ! After barotropic velocities (or transport if flux form)          
+      pvv_b  (:,:,Kaa) = 0._wp
+      pssh  (:,:,Kaa) = 0._wp       ! Sum for after averaged sea level
       un_adv(:,:) = 0._wp       ! Sum for now transport issued from ts loop
       vn_adv(:,:) = 0._wp
@@ -423,6 +426,10 @@
          !                    !==  Update the forcing ==! (BDY and tides)
          !
-         IF( ln_bdy      .AND. ln_tide )   CALL bdy_dta_tides( kt, kit=jn, kt_offset= noffset+1 )
-         IF( ln_tide_pot .AND. ln_tide )   CALL upd_tide     ( kt, kit=jn, kt_offset= noffset   )
+         IF( ln_bdy      .AND. ln_tide )   CALL bdy_dta_tides( kt, kit=jn, pt_offset= REAL(noffset+1,wp) )
+         ! Update tide potential at the beginning of current time substep
+         IF( ln_tide_pot .AND. ln_tide ) THEN
+            zt0substep = REAL(nsec_day, wp) - 0.5_wp*rn_Dt + (jn + noffset - 1) * rn_Dt / REAL(nn_e, wp)
+            CALL upd_tide(zt0substep, Kmm)
+         END IF
          !
          !                    !==  extrapolation at mid-step  ==!   (jn+1/2)
@@ -461,18 +468,14 @@
             !
             !                          ! ocean u- and v-depth at mid-step   (separate DO-loops remove the need of a lbc_lnk)
-            DO jj = 1, jpj
-               DO ji = 1, jpim1   ! not jpi-column
-                  zhup2_e(ji,jj) = hu_0(ji,jj) + r1_2 * r1_e1e2u(ji,jj)                        &
-                       &                              * (  e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)  &
-                       &                                 + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj)  ) * ssumask(ji,jj)
-               END DO
-            END DO
-            DO jj = 1, jpjm1        ! not jpj-row
-               DO ji = 1, jpi
-                  zhvp2_e(ji,jj) = hv_0(ji,jj) + r1_2 * r1_e1e2v(ji,jj)                        &
-                       &                              * (  e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )  &
-                       &                                 + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1)  ) * ssvmask(ji,jj)
-               END DO
-            END DO
+            DO_2D_11_10
+               zhup2_e(ji,jj) = hu_0(ji,jj) + r1_2 * r1_e1e2u(ji,jj)                        &
+                    &                              * (  e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)  &
+                    &                                 + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj)  ) * ssumask(ji,jj)
+            END_2D
+            DO_2D_10_11
+               zhvp2_e(ji,jj) = hv_0(ji,jj) + r1_2 * r1_e1e2v(ji,jj)                        &
+                    &                              * (  e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )  &
+                    &                                 + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1)  ) * ssvmask(ji,jj)
+            END_2D
             !
          ENDIF
@@ -483,5 +486,5 @@
          !                             ! values of zhup2_e and zhvp2_e on the halo are not needed in bdy_vol2d
          IF( ln_bdy .AND. ln_vol ) CALL bdy_vol2d( kt, jn, ua_e, va_e, zhup2_e, zhvp2_e )
-         !
+         !      
          !                             ! resulting flux at mid-step (not over the full domain)
          zhU(1:jpim1,1:jpj  ) = e2u(1:jpim1,1:jpj  ) * ua_e(1:jpim1,1:jpj  ) * zhup2_e(1:jpim1,1:jpj  )   ! not jpi-column
@@ -490,32 +493,7 @@
 #if defined key_agrif
          ! Set fluxes during predictor step to ensure volume conservation
-         IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) THEN
-            IF((nbondi == -1).OR.(nbondi == 2)) THEN
-               DO jj = 1, jpj
-                  zhU(2:nbghostcells+1,jj) = ubdy_w(1:nbghostcells,jj) * e2u(2:nbghostcells+1,jj)
-                  zhV(2:nbghostcells+1,jj) = vbdy_w(1:nbghostcells,jj) * e1v(2:nbghostcells+1,jj)
-               END DO
-            ENDIF
-            IF((nbondi ==  1).OR.(nbondi == 2)) THEN
-               DO jj=1,jpj
-                  zhU(nlci-nbghostcells-1:nlci-2,jj) = ubdy_e(1:nbghostcells,jj) * e2u(nlci-nbghostcells-1:nlci-2,jj)
-                  zhV(nlci-nbghostcells  :nlci-1,jj) = vbdy_e(1:nbghostcells,jj) * e1v(nlci-nbghostcells  :nlci-1,jj)
-               END DO
-            ENDIF
-            IF((nbondj == -1).OR.(nbondj == 2)) THEN
-               DO ji=1,jpi
-                  zhV(ji,2:nbghostcells+1) = vbdy_s(ji,1:nbghostcells) * e1v(ji,2:nbghostcells+1)
-                  zhU(ji,2:nbghostcells+1) = ubdy_s(ji,1:nbghostcells) * e2u(ji,2:nbghostcells+1)
-               END DO
-            ENDIF
-            IF((nbondj ==  1).OR.(nbondj == 2)) THEN
-               DO ji=1,jpi
-                  zhV(ji,nlcj-nbghostcells-1:nlcj-2) = vbdy_n(ji,1:nbghostcells) * e1v(ji,nlcj-nbghostcells-1:nlcj-2)
-                  zhU(ji,nlcj-nbghostcells  :nlcj-1) = ubdy_n(ji,1:nbghostcells) * e2u(ji,nlcj-nbghostcells  :nlcj-1)
-               END DO
-            ENDIF
-         ENDIF
+         IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) CALL agrif_dyn_ts_flux( jn, zhU, zhV )
 #endif
-         IF( ln_wd_il )   CALL wad_lmt_bt(zhU, zhV, sshn_e, zssh_frc, rdtbt)    !!gm wad_lmt_bt use of lbc_lnk on zhU, zhV
+         IF( ln_wd_il )   CALL wad_lmt_bt(zhU, zhV, sshn_e, zssh_frc, rDt_e)    !!gm wad_lmt_bt use of lbc_lnk on zhU, zhV
 
          IF( ln_wd_dl ) THEN           ! un_e and vn_e are set to zero at faces where 
@@ -530,10 +508,8 @@
          !--        ssh    =  ssh   - delta_t' * [ frc + div( flux      ) ]      --!
          !-------------------------------------------------------------------------!
-         DO jj = 2, jpjm1        ! INNER domain                             
-            DO ji = 2, jpim1
-               zhdiv = (   zhU(ji,jj) - zhU(ji-1,jj) + zhV(ji,jj) - zhV(ji,jj-1)   ) * r1_e1e2t(ji,jj)
-               ssha_e(ji,jj) = (  sshn_e(ji,jj) - rdtbt * ( zssh_frc(ji,jj) + zhdiv )  ) * ssmask(ji,jj)
-            END DO
-         END DO
+         DO_2D_00_00
+            zhdiv = (   zhU(ji,jj) - zhU(ji-1,jj) + zhV(ji,jj) - zhV(ji,jj-1)   ) * r1_e1e2t(ji,jj)
+            ssha_e(ji,jj) = (  sshn_e(ji,jj) - rDt_e * ( zssh_frc(ji,jj) + zhdiv )  ) * ssmask(ji,jj)
+         END_2D
          !
          CALL lbc_lnk_multi( 'dynspg_ts', ssha_e, 'T', 1._wp,  zhU, 'U', -1._wp,  zhV, 'V', -1._wp )
@@ -557,14 +533,12 @@
          ! Sea Surface Height at u-,v-points (vvl case only)
          IF( .NOT.ln_linssh ) THEN                                
-            DO jj = 2, jpjm1   ! INNER domain, will be extended to whole domain later
-               DO ji = 2, jpim1      ! NO Vector Opt.
-                  zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj)    &
-                     &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) &
-                     &              +   e1e2t(ji+1,jj  )  * ssha_e(ji+1,jj  ) )
-                  zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj)    &
-                     &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) &
-                     &              +   e1e2t(ji  ,jj+1)  * ssha_e(ji  ,jj+1) )
-               END DO
-            END DO
+            DO_2D_00_00
+               zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj)    &
+                  &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) &
+                  &              +   e1e2t(ji+1,jj  )  * ssha_e(ji+1,jj  ) )
+               zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj)    &
+                  &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) &
+                  &              +   e1e2t(ji  ,jj+1)  * ssha_e(ji  ,jj+1) )
+            END_2D
          ENDIF   
          !         
@@ -579,10 +553,8 @@
          !                             ! Surface pressure gradient
          zldg = ( 1._wp - rn_scal_load ) * grav    ! local factor
-         DO jj = 2, jpjm1                            
-            DO ji = 2, jpim1
-               zu_spg(ji,jj) = - zldg * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj)
-               zv_spg(ji,jj) = - zldg * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj)
-            END DO
-         END DO
+         DO_2D_00_00
+            zu_spg(ji,jj) = - zldg * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj)
+            zv_spg(ji,jj) = - zldg * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj)
+         END_2D
          IF( ln_wd_il ) THEN        ! W/D : gravity filters applied on pressure gradient
             CALL wad_spg( zsshp2_e, zcpx, zcpy )   ! Calculating W/D gravity filters
@@ -599,10 +571,8 @@
          ! Add tidal astronomical forcing if defined
          IF ( ln_tide .AND. ln_tide_pot ) THEN
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zu_trd(ji,jj) = zu_trd(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj)
-                  zv_trd(ji,jj) = zv_trd(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj)
-               END DO
-            END DO
+            DO_2D_00_00
+               zu_trd(ji,jj) = zu_trd(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj)
+               zv_trd(ji,jj) = zv_trd(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj)
+            END_2D
          ENDIF
          !
@@ -610,10 +580,8 @@
 !jth do implicitly instead
          IF ( .NOT. ll_wd ) THEN ! Revert to explicit for bit comparison tests in non wad runs
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zu_trd(ji,jj) = zu_trd(ji,jj) + zCdU_u(ji,jj) * un_e(ji,jj) * hur_e(ji,jj)
-                  zv_trd(ji,jj) = zv_trd(ji,jj) + zCdU_v(ji,jj) * vn_e(ji,jj) * hvr_e(ji,jj)
-               END DO
-            END DO
+            DO_2D_00_00
+               zu_trd(ji,jj) = zu_trd(ji,jj) + zCdU_u(ji,jj) * un_e(ji,jj) * hur_e(ji,jj)
+               zv_trd(ji,jj) = zv_trd(ji,jj) + zCdU_v(ji,jj) * vn_e(ji,jj) * hvr_e(ji,jj)
+            END_2D
          ENDIF
          !
@@ -630,53 +598,47 @@
          !------------------------------------------------------------------------------------------------------------------------!
          IF( ln_dynadv_vec .OR. ln_linssh ) THEN      !* Vector form
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ua_e(ji,jj) = (                                 un_e(ji,jj)   & 
-                            &     + rdtbt * (                   zu_spg(ji,jj)   &
-                            &                                 + zu_trd(ji,jj)   &
-                            &                                 + zu_frc(ji,jj) ) & 
-                            &   ) * ssumask(ji,jj)
-
-                  va_e(ji,jj) = (                                 vn_e(ji,jj)   &
-                            &     + rdtbt * (                   zv_spg(ji,jj)   &
-                            &                                 + zv_trd(ji,jj)   &
-                            &                                 + zv_frc(ji,jj) ) &
-                            &   ) * ssvmask(ji,jj)
-               END DO
-            END DO
+            DO_2D_00_00
+               ua_e(ji,jj) = (                                 un_e(ji,jj)   & 
+                         &     + rDt_e * (                   zu_spg(ji,jj)   &
+                         &                                 + zu_trd(ji,jj)   &
+                         &                                 + zu_frc(ji,jj) ) & 
+                         &   ) * ssumask(ji,jj)
+
+               va_e(ji,jj) = (                                 vn_e(ji,jj)   &
+                         &     + rDt_e * (                   zv_spg(ji,jj)   &
+                         &                                 + zv_trd(ji,jj)   &
+                         &                                 + zv_frc(ji,jj) ) &
+                         &   ) * ssvmask(ji,jj)
+            END_2D
             !
          ELSE                           !* Flux form
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  !                    ! hu_e, hv_e hold depth at jn,  zhup2_e, zhvp2_e hold extrapolated depth at jn+1/2
-                  !                    ! backward interpolated depth used in spg terms at jn+1/2
-                  zhu_bck = hu_0(ji,jj) + r1_2*r1_e1e2u(ji,jj) * (  e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)    &
-                       &                                          + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj)  ) * ssumask(ji,jj)
-                  zhv_bck = hv_0(ji,jj) + r1_2*r1_e1e2v(ji,jj) * (  e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )    &
-                       &                                          + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1)  ) * ssvmask(ji,jj)
-                  !                    ! inverse depth at jn+1
-                  z1_hu = ssumask(ji,jj) / ( hu_0(ji,jj) + zsshu_a(ji,jj) + 1._wp - ssumask(ji,jj) )
-                  z1_hv = ssvmask(ji,jj) / ( hv_0(ji,jj) + zsshv_a(ji,jj) + 1._wp - ssvmask(ji,jj) )
-                  !
-                  ua_e(ji,jj) = (               hu_e  (ji,jj) *   un_e (ji,jj)      & 
-                       &            + rdtbt * (  zhu_bck        * zu_spg (ji,jj)  &   !
-                       &                       + zhup2_e(ji,jj) * zu_trd (ji,jj)  &   !
-                       &                       +  hu_n  (ji,jj) * zu_frc (ji,jj)  )   ) * z1_hu
-                  !
-                  va_e(ji,jj) = (               hv_e  (ji,jj) *   vn_e (ji,jj)      &
-                       &            + rdtbt * (  zhv_bck        * zv_spg (ji,jj)  &   !
-                       &                       + zhvp2_e(ji,jj) * zv_trd (ji,jj)  &   !
-                       &                       +  hv_n  (ji,jj) * zv_frc (ji,jj)  )   ) * z1_hv
-               END DO
-            END DO
+            DO_2D_00_00
+               !                    ! hu_e, hv_e hold depth at jn,  zhup2_e, zhvp2_e hold extrapolated depth at jn+1/2
+               !                    ! backward interpolated depth used in spg terms at jn+1/2
+               zhu_bck = hu_0(ji,jj) + r1_2*r1_e1e2u(ji,jj) * (  e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)    &
+                    &                                          + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj)  ) * ssumask(ji,jj)
+               zhv_bck = hv_0(ji,jj) + r1_2*r1_e1e2v(ji,jj) * (  e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )    &
+                    &                                          + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1)  ) * ssvmask(ji,jj)
+               !                    ! inverse depth at jn+1
+               z1_hu = ssumask(ji,jj) / ( hu_0(ji,jj) + zsshu_a(ji,jj) + 1._wp - ssumask(ji,jj) )
+               z1_hv = ssvmask(ji,jj) / ( hv_0(ji,jj) + zsshv_a(ji,jj) + 1._wp - ssvmask(ji,jj) )
+               !
+               ua_e(ji,jj) = (               hu_e  (ji,jj) *   un_e (ji,jj)      & 
+                    &            + rDt_e * (  zhu_bck        * zu_spg (ji,jj)  &   !
+                    &                       + zhup2_e(ji,jj) * zu_trd (ji,jj)  &   !
+                    &                       +  hu(ji,jj,Kmm) * zu_frc (ji,jj)  )   ) * z1_hu
+               !
+               va_e(ji,jj) = (               hv_e  (ji,jj) *   vn_e (ji,jj)      &
+                    &            + rDt_e * (  zhv_bck        * zv_spg (ji,jj)  &   !
+                    &                       + zhvp2_e(ji,jj) * zv_trd (ji,jj)  &   !
+                    &                       +  hv(ji,jj,Kmm) * zv_frc (ji,jj)  )   ) * z1_hv
+            END_2D
          ENDIF
 !jth implicit bottom friction:
          IF ( ll_wd ) THEN ! revert to explicit for bit comparison tests in non wad runs
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ua_e(ji,jj) =  ua_e(ji,jj) /(1.0 -   rdtbt * zCdU_u(ji,jj) * hur_e(ji,jj))
-                     va_e(ji,jj) =  va_e(ji,jj) /(1.0 -   rdtbt * zCdU_v(ji,jj) * hvr_e(ji,jj))
-               END DO
-            END DO
+            DO_2D_00_00
+                  ua_e(ji,jj) =  ua_e(ji,jj) /(1.0 -   rDt_e * zCdU_u(ji,jj) * hur_e(ji,jj))
+                  va_e(ji,jj) =  va_e(ji,jj) /(1.0 -   rDt_e * zCdU_v(ji,jj) * hvr_e(ji,jj))
+            END_2D
          ENDIF
        
@@ -687,6 +649,6 @@
             hvr_e(2:jpim1,2:jpjm1) = ssvmask(2:jpim1,2:jpjm1) / ( hv_e(2:jpim1,2:jpjm1) + 1._wp - ssvmask(2:jpim1,2:jpjm1) )
             CALL lbc_lnk_multi( 'dynspg_ts', ua_e , 'U', -1._wp, va_e , 'V', -1._wp  &
-                 &                         , hu_e , 'U', -1._wp, hv_e , 'V', -1._wp  &
-                 &                         , hur_e, 'U', -1._wp, hvr_e, 'V', -1._wp  )
+                 &                         , hu_e , 'U',  1._wp, hv_e , 'V',  1._wp  &
+                 &                         , hur_e, 'U',  1._wp, hvr_e, 'V',  1._wp  )
          ELSE
             CALL lbc_lnk_multi( 'dynspg_ts', ua_e , 'U', -1._wp, va_e , 'V', -1._wp  )
@@ -717,17 +679,17 @@
          za1 = wgtbtp1(jn)                                    
          IF( ln_dynadv_vec .OR. ln_linssh ) THEN    ! Sum velocities
-            ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:) 
-            va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:) 
+            puu_b  (:,:,Kaa) = puu_b  (:,:,Kaa) + za1 * ua_e  (:,:) 
+            pvv_b  (:,:,Kaa) = pvv_b  (:,:,Kaa) + za1 * va_e  (:,:) 
          ELSE                                       ! Sum transports
             IF ( .NOT.ln_wd_dl ) THEN  
-               ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:) * hu_e (:,:)
-               va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:) * hv_e (:,:)
+               puu_b  (:,:,Kaa) = puu_b  (:,:,Kaa) + za1 * ua_e  (:,:) * hu_e (:,:)
+               pvv_b  (:,:,Kaa) = pvv_b  (:,:,Kaa) + za1 * va_e  (:,:) * hv_e (:,:)
             ELSE 
-               ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:) * hu_e (:,:) * zuwdmask(:,:)
-               va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:) * hv_e (:,:) * zvwdmask(:,:)
+               puu_b  (:,:,Kaa) = puu_b  (:,:,Kaa) + za1 * ua_e  (:,:) * hu_e (:,:) * zuwdmask(:,:)
+               pvv_b  (:,:,Kaa) = pvv_b  (:,:,Kaa) + za1 * va_e  (:,:) * hv_e (:,:) * zvwdmask(:,:)
             END IF 
          ENDIF
          !                                          ! Sum sea level
-         ssha(:,:) = ssha(:,:) + za1 * ssha_e(:,:)
+         pssh(:,:,Kaa) = pssh(:,:,Kaa) + za1 * ssha_e(:,:)
 
          !                                                 ! ==================== !
@@ -740,20 +702,18 @@
       ! Set advection velocity correction:
       IF (ln_bt_fw) THEN
-         IF( .NOT.( kt == nit000 .AND. neuler==0 ) ) THEN
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zun_save = un_adv(ji,jj)
-                  zvn_save = vn_adv(ji,jj)
-                  !                          ! apply the previously computed correction 
-                  un_adv(ji,jj) = r1_2 * ( ub2_b(ji,jj) + zun_save - atfp * un_bf(ji,jj) )
-                  vn_adv(ji,jj) = r1_2 * ( vb2_b(ji,jj) + zvn_save - atfp * vn_bf(ji,jj) )
-                  !                          ! Update corrective fluxes for next time step
-                  un_bf(ji,jj)  = atfp * un_bf(ji,jj) + ( zun_save - ub2_b(ji,jj) )
-                  vn_bf(ji,jj)  = atfp * vn_bf(ji,jj) + ( zvn_save - vb2_b(ji,jj) )
-                  !                          ! Save integrated transport for next computation
-                  ub2_b(ji,jj) = zun_save
-                  vb2_b(ji,jj) = zvn_save
-               END DO
-            END DO
+         IF( .NOT.( kt == nit000 .AND. l_1st_euler ) ) THEN
+            DO_2D_11_11
+               zun_save = un_adv(ji,jj)
+               zvn_save = vn_adv(ji,jj)
+               !                          ! apply the previously computed correction 
+               un_adv(ji,jj) = r1_2 * ( ub2_b(ji,jj) + zun_save - rn_atfp * un_bf(ji,jj) )
+               vn_adv(ji,jj) = r1_2 * ( vb2_b(ji,jj) + zvn_save - rn_atfp * vn_bf(ji,jj) )
+               !                          ! Update corrective fluxes for next time step
+               un_bf(ji,jj)  = rn_atfp * un_bf(ji,jj) + ( zun_save - ub2_b(ji,jj) )
+               vn_bf(ji,jj)  = rn_atfp * vn_bf(ji,jj) + ( zvn_save - vb2_b(ji,jj) )
+               !                          ! Save integrated transport for next computation
+               ub2_b(ji,jj) = zun_save
+               vb2_b(ji,jj) = zvn_save
+            END_2D
          ELSE
             un_bf(:,:) = 0._wp            ! corrective fluxes for next time step set to zero
@@ -769,28 +729,26 @@
       IF( ln_dynadv_vec .OR. ln_linssh ) THEN
          DO jk=1,jpkm1
-            ua(:,:,jk) = ua(:,:,jk) + ( ua_b(:,:) - ub_b(:,:) ) * r1_2dt_b
-            va(:,:,jk) = va(:,:,jk) + ( va_b(:,:) - vb_b(:,:) ) * r1_2dt_b
+            puu(:,:,jk,Krhs) = puu(:,:,jk,Krhs) + ( puu_b(:,:,Kaa) - puu_b(:,:,Kbb) ) * r1_Dt_b
+            pvv(:,:,jk,Krhs) = pvv(:,:,jk,Krhs) + ( pvv_b(:,:,Kaa) - pvv_b(:,:,Kbb) ) * r1_Dt_b
          END DO
       ELSE
-         ! At this stage, ssha has been corrected: compute new depths at velocity points
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1      ! NO Vector Opt.
-               zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj)  * r1_e1e2u(ji,jj) &
-                  &              * ( e1e2t(ji  ,jj) * ssha(ji  ,jj)      &
-                  &              +   e1e2t(ji+1,jj) * ssha(ji+1,jj) )
-               zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj)  * r1_e1e2v(ji,jj) &
-                  &              * ( e1e2t(ji,jj  ) * ssha(ji,jj  )      &
-                  &              +   e1e2t(ji,jj+1) * ssha(ji,jj+1) )
-            END DO
-         END DO
+         ! At this stage, pssh(:,:,:,Krhs) has been corrected: compute new depths at velocity points
+         DO_2D_10_10
+            zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj)  * r1_e1e2u(ji,jj) &
+               &              * ( e1e2t(ji  ,jj) * pssh(ji  ,jj,Kaa)      &
+               &              +   e1e2t(ji+1,jj) * pssh(ji+1,jj,Kaa) )
+            zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj)  * r1_e1e2v(ji,jj) &
+               &              * ( e1e2t(ji,jj  ) * pssh(ji,jj  ,Kaa)      &
+               &              +   e1e2t(ji,jj+1) * pssh(ji,jj+1,Kaa) )
+         END_2D
          CALL lbc_lnk_multi( 'dynspg_ts', zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions
          !
          DO jk=1,jpkm1
-            ua(:,:,jk) = ua(:,:,jk) + r1_hu_n(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * r1_2dt_b
-            va(:,:,jk) = va(:,:,jk) + r1_hv_n(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_b(:,:) ) * r1_2dt_b
+            puu(:,:,jk,Krhs) = puu(:,:,jk,Krhs) + r1_hu(:,:,Kmm) * ( puu_b(:,:,Kaa) - puu_b(:,:,Kbb) * hu(:,:,Kbb) ) * r1_Dt_b
+            pvv(:,:,jk,Krhs) = pvv(:,:,jk,Krhs) + r1_hv(:,:,Kmm) * ( pvv_b(:,:,Kaa) - pvv_b(:,:,Kbb) * hv(:,:,Kbb) ) * r1_Dt_b
          END DO
          ! Save barotropic velocities not transport:
-         ua_b(:,:) =  ua_b(:,:) / ( hu_0(:,:) + zsshu_a(:,:) + 1._wp - ssumask(:,:) )
-         va_b(:,:) =  va_b(:,:) / ( hv_0(:,:) + zsshv_a(:,:) + 1._wp - ssvmask(:,:) )
+         puu_b(:,:,Kaa) =  puu_b(:,:,Kaa) / ( hu_0(:,:) + zsshu_a(:,:) + 1._wp - ssumask(:,:) )
+         pvv_b(:,:,Kaa) =  pvv_b(:,:,Kaa) / ( hv_0(:,:) + zsshv_a(:,:) + 1._wp - ssvmask(:,:) )
       ENDIF
 
@@ -798,20 +756,20 @@
       ! Correct velocities so that the barotropic velocity equals (un_adv, vn_adv) (in all cases)  
       DO jk = 1, jpkm1
-         un(:,:,jk) = ( un(:,:,jk) + un_adv(:,:)*r1_hu_n(:,:) - un_b(:,:) ) * umask(:,:,jk)
-         vn(:,:,jk) = ( vn(:,:,jk) + vn_adv(:,:)*r1_hv_n(:,:) - vn_b(:,:) ) * vmask(:,:,jk)
+         puu(:,:,jk,Kmm) = ( puu(:,:,jk,Kmm) + un_adv(:,:)*r1_hu(:,:,Kmm) - puu_b(:,:,Kmm) ) * umask(:,:,jk)
+         pvv(:,:,jk,Kmm) = ( pvv(:,:,jk,Kmm) + vn_adv(:,:)*r1_hv(:,:,Kmm) - pvv_b(:,:,Kmm) ) * vmask(:,:,jk)
       END DO
 
       IF ( ln_wd_dl .and. ln_wd_dl_bc) THEN 
          DO jk = 1, jpkm1
-            un(:,:,jk) = ( un_adv(:,:)*r1_hu_n(:,:) &
-                       & + zuwdav2(:,:)*(un(:,:,jk) - un_adv(:,:)*r1_hu_n(:,:)) ) * umask(:,:,jk) 
-            vn(:,:,jk) = ( vn_adv(:,:)*r1_hv_n(:,:) & 
-                       & + zvwdav2(:,:)*(vn(:,:,jk) - vn_adv(:,:)*r1_hv_n(:,:)) ) * vmask(:,:,jk)  
+            puu(:,:,jk,Kmm) = ( un_adv(:,:)*r1_hu(:,:,Kmm) &
+                       & + zuwdav2(:,:)*(puu(:,:,jk,Kmm) - un_adv(:,:)*r1_hu(:,:,Kmm)) ) * umask(:,:,jk) 
+            pvv(:,:,jk,Kmm) = ( vn_adv(:,:)*r1_hv(:,:,Kmm) & 
+                       & + zvwdav2(:,:)*(pvv(:,:,jk,Kmm) - vn_adv(:,:)*r1_hv(:,:,Kmm)) ) * vmask(:,:,jk)  
          END DO
       END IF 
 
       
-      CALL iom_put(  "ubar", un_adv(:,:)*r1_hu_n(:,:) )    ! barotropic i-current
-      CALL iom_put(  "vbar", vn_adv(:,:)*r1_hv_n(:,:) )    ! barotropic i-current
+      CALL iom_put(  "ubar", un_adv(:,:)*r1_hu(:,:,Kmm) )    ! barotropic i-current
+      CALL iom_put(  "vbar", vn_adv(:,:)*r1_hv(:,:,Kmm) )    ! barotropic i-current
       !
 #if defined key_agrif
@@ -836,8 +794,6 @@
       IF( ln_wd_dl )   DEALLOCATE( ztwdmask, zuwdmask, zvwdmask, zuwdav2, zvwdav2 )
       !
-      IF( ln_diatmb ) THEN
-         CALL iom_put( "baro_u" , un_b*ssumask(:,:)+zmdi*(1.-ssumask(:,:) ) )  ! Barotropic  U Velocity
-         CALL iom_put( "baro_v" , vn_b*ssvmask(:,:)+zmdi*(1.-ssvmask(:,:) ) )  ! Barotropic  V Velocity
-      ENDIF
+      CALL iom_put( "baro_u" , puu_b(:,:,Kmm) )  ! Barotropic  U Velocity
+      CALL iom_put( "baro_v" , pvv_b(:,:,Kmm) )  ! Barotropic  V Velocity
       !
    END SUBROUTINE dyn_spg_ts
@@ -853,5 +809,5 @@
       LOGICAL, INTENT(in) ::   ll_fw      ! forward time splitting =.true.
       INTEGER, INTENT(inout) :: jpit      ! cycle length    
-      REAL(wp), DIMENSION(3*nn_baro), INTENT(inout) ::   zwgt1, & ! Primary weights
+      REAL(wp), DIMENSION(3*nn_e), INTENT(inout) ::   zwgt1, & ! Primary weights
                                                          zwgt2    ! Secondary weights
       
@@ -865,7 +821,7 @@
       ! Set time index when averaged value is requested
       IF (ll_fw) THEN 
-         jic = nn_baro
+         jic = nn_e
       ELSE
-         jic = 2 * nn_baro
+         jic = 2 * nn_e
       ENDIF
 
@@ -873,5 +829,5 @@
       IF (ll_av) THEN
            ! Define simple boxcar window for primary weights 
-           ! (width = nn_baro, centered around jic)     
+           ! (width = nn_e, centered around jic)     
          SELECT CASE ( nn_bt_flt )
               CASE( 0 )  ! No averaging
@@ -879,7 +835,7 @@
                  jpit = jic
 
-              CASE( 1 )  ! Boxcar, width = nn_baro
-                 DO jn = 1, 3*nn_baro
-                    za1 = ABS(float(jn-jic))/float(nn_baro) 
+              CASE( 1 )  ! Boxcar, width = nn_e
+                 DO jn = 1, 3*nn_e
+                    za1 = ABS(float(jn-jic))/float(nn_e) 
                     IF (za1 < 0.5_wp) THEN
                       zwgt1(jn) = 1._wp
@@ -888,7 +844,7 @@
                  ENDDO
 
-              CASE( 2 )  ! Boxcar, width = 2 * nn_baro
-                 DO jn = 1, 3*nn_baro
-                    za1 = ABS(float(jn-jic))/float(nn_baro) 
+              CASE( 2 )  ! Boxcar, width = 2 * nn_e
+                 DO jn = 1, 3*nn_e
+                    za1 = ABS(float(jn-jic))/float(nn_e) 
                     IF (za1 < 1._wp) THEN
                       zwgt1(jn) = 1._wp
@@ -934,5 +890,5 @@
       IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise 
          !                                   ! ---------------
-         IF( ln_rstart .AND. ln_bt_fw .AND. (neuler/=0) ) THEN    !* Read the restart file
+         IF( ln_rstart .AND. ln_bt_fw .AND. (.NOT.l_1st_euler) ) THEN    !* Read the restart file
             CALL iom_get( numror, jpdom_autoglo, 'ub2_b'  , ub2_b  (:,:), ldxios = lrxios )   
             CALL iom_get( numror, jpdom_autoglo, 'vb2_b'  , vb2_b  (:,:), ldxios = lrxios ) 
@@ -1006,16 +962,13 @@
       REAL(wp) ::   zxr2, zyr2, zcmax   ! local scalar
       REAL(wp), DIMENSION(jpi,jpj) ::   zcu
-      INTEGER  :: inum
       !!----------------------------------------------------------------------
       !
       ! Max courant number for ext. grav. waves
       !
-      DO jj = 1, jpj
-         DO ji =1, jpi
-            zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj)
-            zyr2 = r1_e2t(ji,jj) * r1_e2t(ji,jj)
-            zcu(ji,jj) = SQRT( grav * MAX(ht_0(ji,jj),0._wp) * (zxr2 + zyr2) )
-         END DO
-      END DO
+      DO_2D_11_11
+         zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj)
+         zyr2 = r1_e2t(ji,jj) * r1_e2t(ji,jj)
+         zcu(ji,jj) = SQRT( grav * MAX(ht_0(ji,jj),0._wp) * (zxr2 + zyr2) )
+      END_2D
       !
       zcmax = MAXVAL( zcu(:,:) )
@@ -1023,8 +976,8 @@
 
       ! Estimate number of iterations to satisfy a max courant number= rn_bt_cmax
-      IF( ln_bt_auto )   nn_baro = CEILING( rdt / rn_bt_cmax * zcmax)
+      IF( ln_bt_auto )   nn_e = CEILING( rn_Dt / rn_bt_cmax * zcmax)
       
-      rdtbt = rdt / REAL( nn_baro , wp )
-      zcmax = zcmax * rdtbt
+      rDt_e = rn_Dt / REAL( nn_e , wp )
+      zcmax = zcmax * rDt_e
       ! Print results
       IF(lwp) WRITE(numout,*)
@@ -1032,12 +985,12 @@
       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~'
       IF( ln_bt_auto ) THEN
-         IF(lwp) WRITE(numout,*) '     ln_ts_auto =.true. Automatically set nn_baro '
+         IF(lwp) WRITE(numout,*) '     ln_ts_auto =.true. Automatically set nn_e '
          IF(lwp) WRITE(numout,*) '     Max. courant number allowed: ', rn_bt_cmax
       ELSE
-         IF(lwp) WRITE(numout,*) '     ln_ts_auto=.false.: Use nn_baro in namelist   nn_baro = ', nn_baro
+         IF(lwp) WRITE(numout,*) '     ln_ts_auto=.false.: Use nn_e in namelist   nn_e = ', nn_e
       ENDIF
 
       IF(ln_bt_av) THEN
-         IF(lwp) WRITE(numout,*) '     ln_bt_av =.true.  ==> Time averaging over nn_baro time steps is on '
+         IF(lwp) WRITE(numout,*) '     ln_bt_av =.true.  ==> Time averaging over nn_e time steps is on '
       ELSE
          IF(lwp) WRITE(numout,*) '     ln_bt_av =.false. => No time averaging of barotropic variables '
@@ -1059,12 +1012,12 @@
       SELECT CASE ( nn_bt_flt )
          CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '           Dirac'
-         CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '           Boxcar: width = nn_baro'
-         CASE( 2 )      ;   IF(lwp) WRITE(numout,*) '           Boxcar: width = 2*nn_baro' 
+         CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '           Boxcar: width = nn_e'
+         CASE( 2 )      ;   IF(lwp) WRITE(numout,*) '           Boxcar: width = 2*nn_e' 
          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_bt_flt: should 0,1, or 2' )
       END SELECT
       !
       IF(lwp) WRITE(numout,*) ' '
-      IF(lwp) WRITE(numout,*) '     nn_baro = ', nn_baro
-      IF(lwp) WRITE(numout,*) '     Barotropic time step [s] is :', rdtbt
+      IF(lwp) WRITE(numout,*) '     nn_e = ', nn_e
+      IF(lwp) WRITE(numout,*) '     Barotropic time step [s] is :', rDt_e
       IF(lwp) WRITE(numout,*) '     Maximum Courant number is   :', zcmax
       !
@@ -1078,5 +1031,5 @@
       ENDIF
       IF( zcmax>0.9_wp ) THEN
-         CALL ctl_stop( 'dynspg_ts ERROR: Maximum Courant number is greater than 0.9: Inc. nn_baro !' )          
+         CALL ctl_stop( 'dynspg_ts ERROR: Maximum Courant number is greater than 0.9: Inc. nn_e !' )          
       ENDIF
       !
@@ -1114,7 +1067,7 @@
 
    
-   SUBROUTINE dyn_cor_2d_init
+   SUBROUTINE dyn_cor_2D_init( Kmm )
       !!---------------------------------------------------------------------
-      !!                   ***  ROUTINE dyn_cor_2d_init  ***
+      !!                   ***  ROUTINE dyn_cor_2D_init  ***
       !!
       !! ** Purpose : Set time splitting options
@@ -1128,4 +1081,5 @@
       !! Compute zwz = f / ( height of the water colomn )
       !!----------------------------------------------------------------------
+      INTEGER,  INTENT(in)         ::  Kmm  ! Time index
       INTEGER  ::   ji ,jj, jk              ! dummy loop indices
       REAL(wp) ::   z1_ht
@@ -1137,45 +1091,37 @@
          SELECT CASE( nn_een_e3f )              !* ff_f/e3 at F-point
          CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4)
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  zwz(ji,jj) =   ( ht_n(ji  ,jj+1) + ht_n(ji+1,jj+1) +                    &
-                       &             ht_n(ji  ,jj  ) + ht_n(ji+1,jj  )   ) * 0.25_wp  
-                  IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff_f(ji,jj) / zwz(ji,jj)
-               END DO
-            END DO
+            DO_2D_10_10
+               zwz(ji,jj) =   ( ht(ji  ,jj+1) + ht(ji+1,jj+1) +                    &
+                    &           ht(ji  ,jj  ) + ht(ji+1,jj  )   ) * 0.25_wp  
+               IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff_f(ji,jj) / zwz(ji,jj)
+            END_2D
          CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask)
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  zwz(ji,jj) =             (  ht_n  (ji  ,jj+1) + ht_n  (ji+1,jj+1)      &
-                       &                      + ht_n  (ji  ,jj  ) + ht_n  (ji+1,jj  )  )   &
-                       &       / ( MAX( 1._wp,  ssmask(ji  ,jj+1) + ssmask(ji+1,jj+1)      &
-                       &                      + ssmask(ji  ,jj  ) + ssmask(ji+1,jj  )  )   )
-                  IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff_f(ji,jj) / zwz(ji,jj)
-               END DO
-            END DO
+            DO_2D_10_10
+               zwz(ji,jj) =             (  ht  (ji  ,jj+1) + ht  (ji+1,jj+1)      &
+                    &                    + ht  (ji  ,jj  ) + ht  (ji+1,jj  )  )   &
+                    &       / ( MAX( 1._wp,  ssmask(ji  ,jj+1) + ssmask(ji+1,jj+1)      &
+                    &                      + ssmask(ji  ,jj  ) + ssmask(ji+1,jj  )  )   )
+               IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff_f(ji,jj) / zwz(ji,jj)
+            END_2D
          END SELECT
          CALL lbc_lnk( 'dynspg_ts', zwz, 'F', 1._wp )
          !
          ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp
-         DO jj = 2, jpj
-            DO ji = 2, jpi
-               ftne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1)
-               ftnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj  ) + zwz(ji  ,jj  )
-               ftse(ji,jj) = zwz(ji  ,jj  ) + zwz(ji  ,jj-1) + zwz(ji-1,jj-1)
-               ftsw(ji,jj) = zwz(ji  ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj  )
-            END DO
-         END DO
+         DO_2D_01_01
+            ftne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1)
+            ftnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj  ) + zwz(ji  ,jj  )
+            ftse(ji,jj) = zwz(ji  ,jj  ) + zwz(ji  ,jj-1) + zwz(ji-1,jj-1)
+            ftsw(ji,jj) = zwz(ji  ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj  )
+         END_2D
          !
       CASE( np_EET )                  != EEN scheme using e3t (energy conserving scheme)
          ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp
-         DO jj = 2, jpj
-            DO ji = 2, jpi
-               z1_ht = ssmask(ji,jj) / ( ht_n(ji,jj) + 1._wp - ssmask(ji,jj) )
-               ftne(ji,jj) = ( ff_f(ji-1,jj  ) + ff_f(ji  ,jj  ) + ff_f(ji  ,jj-1) ) * z1_ht
-               ftnw(ji,jj) = ( ff_f(ji-1,jj-1) + ff_f(ji-1,jj  ) + ff_f(ji  ,jj  ) ) * z1_ht
-               ftse(ji,jj) = ( ff_f(ji  ,jj  ) + ff_f(ji  ,jj-1) + ff_f(ji-1,jj-1) ) * z1_ht
-               ftsw(ji,jj) = ( ff_f(ji  ,jj-1) + ff_f(ji-1,jj-1) + ff_f(ji-1,jj  ) ) * z1_ht
-            END DO
-         END DO
+         DO_2D_01_01
+            z1_ht = ssmask(ji,jj) / ( ht(ji,jj) + 1._wp - ssmask(ji,jj) )
+            ftne(ji,jj) = ( ff_f(ji-1,jj  ) + ff_f(ji  ,jj  ) + ff_f(ji  ,jj-1) ) * z1_ht
+            ftnw(ji,jj) = ( ff_f(ji-1,jj-1) + ff_f(ji-1,jj  ) + ff_f(ji  ,jj  ) ) * z1_ht
+            ftse(ji,jj) = ( ff_f(ji  ,jj  ) + ff_f(ji  ,jj-1) + ff_f(ji-1,jj-1) ) * z1_ht
+            ftsw(ji,jj) = ( ff_f(ji  ,jj-1) + ff_f(ji-1,jj-1) + ff_f(ji-1,jj  ) ) * z1_ht
+         END_2D
          !
       CASE( np_ENE, np_ENS , np_MIX )  != all other schemes (ENE, ENS, MIX) except ENT !
@@ -1204,12 +1150,10 @@
             !
             !zhf(:,:) = hbatf(:,:)
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  zhf(ji,jj) =    (   ht_0  (ji,jj  ) + ht_0  (ji+1,jj  )          &
-                       &            + ht_0  (ji,jj+1) + ht_0  (ji+1,jj+1)   )      &
-                       &     / MAX(   ssmask(ji,jj  ) + ssmask(ji+1,jj  )          &
-                       &            + ssmask(ji,jj+1) + ssmask(ji+1,jj+1) , 1._wp  )
-               END DO
-            END DO
+            DO_2D_10_10
+               zhf(ji,jj) =    (   ht_0  (ji,jj  ) + ht_0  (ji+1,jj  )          &
+                    &            + ht_0  (ji,jj+1) + ht_0  (ji+1,jj+1)   )      &
+                    &     / MAX(   ssmask(ji,jj  ) + ssmask(ji+1,jj  )          &
+                    &            + ssmask(ji,jj+1) + ssmask(ji+1,jj+1) , 1._wp  )
+            END_2D
          ENDIF
          !
@@ -1220,14 +1164,12 @@
          DO jk = 1, jpkm1
             DO jj = 1, jpjm1
-               zhf(:,jj) = zhf(:,jj) + e3f_n(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk)
+               zhf(:,jj) = zhf(:,jj) + e3f(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk)
             END DO
          END DO
          CALL lbc_lnk( 'dynspg_ts', zhf, 'F', 1._wp )
          ! JC: TBC. hf should be greater than 0 
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( zhf(ji,jj) /= 0._wp )   zwz(ji,jj) = 1._wp / zhf(ji,jj)
-            END DO
-         END DO
+         DO_2D_11_11
+            IF( zhf(ji,jj) /= 0._wp )   zwz(ji,jj) = 1._wp / zhf(ji,jj)
+         END_2D
          zwz(:,:) = ff_f(:,:) * zwz(:,:)
       END SELECT
@@ -1237,5 +1179,5 @@
 
 
-   SUBROUTINE dyn_cor_2d( hu_n, hv_n, un_b, vn_b, zhU, zhV,    zu_trd, zv_trd   )
+   SUBROUTINE dyn_cor_2d( phu, phv, punb, pvnb, zhU, zhV,    zu_trd, zv_trd   )
       !!---------------------------------------------------------------------
       !!                   ***  ROUTINE dyn_cor_2d  ***
@@ -1245,61 +1187,53 @@
       INTEGER  ::   ji ,jj                             ! dummy loop indices
       REAL(wp) ::   zx1, zx2, zy1, zy2, z1_hu, z1_hv   !   -      -
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: hu_n, hv_n, un_b, vn_b, zhU, zhV
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: phu, phv, punb, pvnb, zhU, zhV
       REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: zu_trd, zv_trd
       !!----------------------------------------------------------------------
       SELECT CASE( nvor_scheme )
       CASE( np_ENT )                ! enstrophy conserving scheme (f-point)
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               z1_hu = ssumask(ji,jj) / ( hu_n(ji,jj) + 1._wp - ssumask(ji,jj) )
-               z1_hv = ssvmask(ji,jj) / ( hv_n(ji,jj) + 1._wp - ssvmask(ji,jj) )
-               zu_trd(ji,jj) = + r1_4 * r1_e1e2u(ji,jj) * z1_hu                    &
-                  &               * (  e1e2t(ji+1,jj)*ht_n(ji+1,jj)*ff_t(ji+1,jj) * ( vn_b(ji+1,jj) + vn_b(ji+1,jj-1) )   &
-                  &                  + e1e2t(ji  ,jj)*ht_n(ji  ,jj)*ff_t(ji  ,jj) * ( vn_b(ji  ,jj) + vn_b(ji  ,jj-1) )   )
-                  !
-               zv_trd(ji,jj) = - r1_4 * r1_e1e2v(ji,jj) * z1_hv                    &
-                  &               * (  e1e2t(ji,jj+1)*ht_n(ji,jj+1)*ff_t(ji,jj+1) * ( un_b(ji,jj+1) + un_b(ji-1,jj+1) )   & 
-                  &                  + e1e2t(ji,jj  )*ht_n(ji,jj  )*ff_t(ji,jj  ) * ( un_b(ji,jj  ) + un_b(ji-1,jj  ) )   ) 
-            END DO  
-         END DO  
+         DO_2D_00_00
+            z1_hu = ssumask(ji,jj) / ( phu(ji,jj) + 1._wp - ssumask(ji,jj) )
+            z1_hv = ssvmask(ji,jj) / ( phv(ji,jj) + 1._wp - ssvmask(ji,jj) )
+            zu_trd(ji,jj) = + r1_4 * r1_e1e2u(ji,jj) * z1_hu                    &
+               &               * (  e1e2t(ji+1,jj)*ht(ji+1,jj)*ff_t(ji+1,jj) * ( pvnb(ji+1,jj) + pvnb(ji+1,jj-1) )   &
+               &                  + e1e2t(ji  ,jj)*ht(ji  ,jj)*ff_t(ji  ,jj) * ( pvnb(ji  ,jj) + pvnb(ji  ,jj-1) )   )
+               !
+            zv_trd(ji,jj) = - r1_4 * r1_e1e2v(ji,jj) * z1_hv                    &
+               &               * (  e1e2t(ji,jj+1)*ht(ji,jj+1)*ff_t(ji,jj+1) * ( punb(ji,jj+1) + punb(ji-1,jj+1) )   & 
+               &                  + e1e2t(ji,jj  )*ht(ji,jj  )*ff_t(ji,jj  ) * ( punb(ji,jj  ) + punb(ji-1,jj  ) )   ) 
+         END_2D
          !         
       CASE( np_ENE , np_MIX )        ! energy conserving scheme (t-point) ENE or MIX
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zy1 = ( zhV(ji,jj-1) + zhV(ji+1,jj-1) ) * r1_e1u(ji,jj)
-               zy2 = ( zhV(ji,jj  ) + zhV(ji+1,jj  ) ) * r1_e1u(ji,jj)
-               zx1 = ( zhU(ji-1,jj) + zhU(ji-1,jj+1) ) * r1_e2v(ji,jj)
-               zx2 = ( zhU(ji  ,jj) + zhU(ji  ,jj+1) ) * r1_e2v(ji,jj)
-               ! energy conserving formulation for planetary vorticity term
-               zu_trd(ji,jj) =   r1_4 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
-               zv_trd(ji,jj) = - r1_4 * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )
-            END DO
-         END DO
+         DO_2D_00_00
+            zy1 = ( zhV(ji,jj-1) + zhV(ji+1,jj-1) ) * r1_e1u(ji,jj)
+            zy2 = ( zhV(ji,jj  ) + zhV(ji+1,jj  ) ) * r1_e1u(ji,jj)
+            zx1 = ( zhU(ji-1,jj) + zhU(ji-1,jj+1) ) * r1_e2v(ji,jj)
+            zx2 = ( zhU(ji  ,jj) + zhU(ji  ,jj+1) ) * r1_e2v(ji,jj)
+            ! energy conserving formulation for planetary vorticity term
+            zu_trd(ji,jj) =   r1_4 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
+            zv_trd(ji,jj) = - r1_4 * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )
+         END_2D
          !
       CASE( np_ENS )                ! enstrophy conserving scheme (f-point)
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zy1 =   r1_8 * ( zhV(ji  ,jj-1) + zhV(ji+1,jj-1) &
-                 &            + zhV(ji  ,jj  ) + zhV(ji+1,jj  ) ) * r1_e1u(ji,jj)
-               zx1 = - r1_8 * ( zhU(ji-1,jj  ) + zhU(ji-1,jj+1) &
-                 &            + zhU(ji  ,jj  ) + zhU(ji  ,jj+1) ) * r1_e2v(ji,jj)
-               zu_trd(ji,jj)  = zy1 * ( zwz(ji  ,jj-1) + zwz(ji,jj) )
-               zv_trd(ji,jj)  = zx1 * ( zwz(ji-1,jj  ) + zwz(ji,jj) )
-            END DO
-         END DO
+         DO_2D_00_00
+            zy1 =   r1_8 * ( zhV(ji  ,jj-1) + zhV(ji+1,jj-1) &
+              &            + zhV(ji  ,jj  ) + zhV(ji+1,jj  ) ) * r1_e1u(ji,jj)
+            zx1 = - r1_8 * ( zhU(ji-1,jj  ) + zhU(ji-1,jj+1) &
+              &            + zhU(ji  ,jj  ) + zhU(ji  ,jj+1) ) * r1_e2v(ji,jj)
+            zu_trd(ji,jj)  = zy1 * ( zwz(ji  ,jj-1) + zwz(ji,jj) )
+            zv_trd(ji,jj)  = zx1 * ( zwz(ji-1,jj  ) + zwz(ji,jj) )
+         END_2D
          !
       CASE( np_EET , np_EEN )      ! energy & enstrophy scheme (using e3t or e3f)         
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zu_trd(ji,jj) = + r1_12 * r1_e1u(ji,jj) * (  ftne(ji,jj  ) * zhV(ji  ,jj  ) &
-                &                                         + ftnw(ji+1,jj) * zhV(ji+1,jj  ) &
-                &                                         + ftse(ji,jj  ) * zhV(ji  ,jj-1) &
-                &                                         + ftsw(ji+1,jj) * zhV(ji+1,jj-1) )
-               zv_trd(ji,jj) = - r1_12 * r1_e2v(ji,jj) * (  ftsw(ji,jj+1) * zhU(ji-1,jj+1) &
-                &                                         + ftse(ji,jj+1) * zhU(ji  ,jj+1) &
-                &                                         + ftnw(ji,jj  ) * zhU(ji-1,jj  ) &
-                &                                         + ftne(ji,jj  ) * zhU(ji  ,jj  ) )
-            END DO
-         END DO
+         DO_2D_00_00
+            zu_trd(ji,jj) = + r1_12 * r1_e1u(ji,jj) * (  ftne(ji,jj  ) * zhV(ji  ,jj  ) &
+             &                                         + ftnw(ji+1,jj) * zhV(ji+1,jj  ) &
+             &                                         + ftse(ji,jj  ) * zhV(ji  ,jj-1) &
+             &                                         + ftsw(ji+1,jj) * zhV(ji+1,jj-1) )
+            zv_trd(ji,jj) = - r1_12 * r1_e2v(ji,jj) * (  ftsw(ji,jj+1) * zhU(ji-1,jj+1) &
+             &                                         + ftse(ji,jj+1) * zhU(ji  ,jj+1) &
+             &                                         + ftnw(ji,jj  ) * zhU(ji-1,jj  ) &
+             &                                         + ftne(ji,jj  ) * zhU(ji  ,jj  ) )
+         END_2D
          !
       END SELECT
@@ -1326,24 +1260,20 @@
       !
       IF( ln_wd_dl_rmp ) THEN     
-         DO jj = 1, jpj
-            DO ji = 1, jpi                    
-               IF    ( pssh(ji,jj) + ht_0(ji,jj) >  2._wp * rn_wdmin1 ) THEN 
-                  !           IF    ( pssh(ji,jj) + ht_0(ji,jj) >          rn_wdmin2 ) THEN 
-                  ptmsk(ji,jj) = 1._wp
-               ELSEIF( pssh(ji,jj) + ht_0(ji,jj) >          rn_wdmin1 ) THEN
-                  ptmsk(ji,jj) = TANH( 50._wp*( ( pssh(ji,jj) + ht_0(ji,jj) -  rn_wdmin1 )*r_rn_wdmin1) )
-               ELSE 
-                  ptmsk(ji,jj) = 0._wp
-               ENDIF
-            END DO
-         END DO
+         DO_2D_11_11
+            IF    ( pssh(ji,jj) + ht_0(ji,jj) >  2._wp * rn_wdmin1 ) THEN 
+               !           IF    ( pssh(ji,jj) + ht_0(ji,jj) >          rn_wdmin2 ) THEN 
+               ptmsk(ji,jj) = 1._wp
+            ELSEIF( pssh(ji,jj) + ht_0(ji,jj) >          rn_wdmin1 ) THEN
+               ptmsk(ji,jj) = TANH( 50._wp*( ( pssh(ji,jj) + ht_0(ji,jj) -  rn_wdmin1 )*r_rn_wdmin1) )
+            ELSE 
+               ptmsk(ji,jj) = 0._wp
+            ENDIF
+         END_2D
       ELSE  
-         DO jj = 1, jpj
-            DO ji = 1, jpi                              
-               IF ( pssh(ji,jj) + ht_0(ji,jj) >  rn_wdmin1 ) THEN   ;   ptmsk(ji,jj) = 1._wp
-               ELSE                                                 ;   ptmsk(ji,jj) = 0._wp
-               ENDIF
-            END DO
-         END DO
+         DO_2D_11_11
+            IF ( pssh(ji,jj) + ht_0(ji,jj) >  rn_wdmin1 ) THEN   ;   ptmsk(ji,jj) = 1._wp
+            ELSE                                                 ;   ptmsk(ji,jj) = 0._wp
+            ENDIF
+         END_2D
       ENDIF
       !
@@ -1369,28 +1299,24 @@
       !!----------------------------------------------------------------------
       !
-      DO jj = 1, jpj
-         DO ji = 1, jpim1   ! not jpi-column
-            IF ( phU(ji,jj) > 0._wp ) THEN   ;   pUmsk(ji,jj) = pTmsk(ji  ,jj) 
-            ELSE                             ;   pUmsk(ji,jj) = pTmsk(ji+1,jj)  
-            ENDIF
-            phU(ji,jj) = pUmsk(ji,jj)*phU(ji,jj)
-            pu (ji,jj) = pUmsk(ji,jj)*pu (ji,jj)
-         END DO
-      END DO
-      !
-      DO jj = 1, jpjm1   ! not jpj-row
-         DO ji = 1, jpi
-            IF ( phV(ji,jj) > 0._wp ) THEN   ;   pVmsk(ji,jj) = pTmsk(ji,jj  )
-            ELSE                             ;   pVmsk(ji,jj) = pTmsk(ji,jj+1)  
-            ENDIF
-            phV(ji,jj) = pVmsk(ji,jj)*phV(ji,jj) 
-            pv (ji,jj) = pVmsk(ji,jj)*pv (ji,jj)
-         END DO
-      END DO
+      DO_2D_11_10
+         IF ( phU(ji,jj) > 0._wp ) THEN   ;   pUmsk(ji,jj) = pTmsk(ji  ,jj) 
+         ELSE                             ;   pUmsk(ji,jj) = pTmsk(ji+1,jj)  
+         ENDIF
+         phU(ji,jj) = pUmsk(ji,jj)*phU(ji,jj)
+         pu (ji,jj) = pUmsk(ji,jj)*pu (ji,jj)
+      END_2D
+      !
+      DO_2D_10_11
+         IF ( phV(ji,jj) > 0._wp ) THEN   ;   pVmsk(ji,jj) = pTmsk(ji,jj  )
+         ELSE                             ;   pVmsk(ji,jj) = pTmsk(ji,jj+1)  
+         ENDIF
+         phV(ji,jj) = pVmsk(ji,jj)*phV(ji,jj) 
+         pv (ji,jj) = pVmsk(ji,jj)*pv (ji,jj)
+      END_2D
       !
    END SUBROUTINE wad_Umsk
 
 
-   SUBROUTINE wad_spg( sshn, zcpx, zcpy )
+   SUBROUTINE wad_spg( pshn, zcpx, zcpy )
       !!---------------------------------------------------------------------
       !!                   ***  ROUTINE  wad_sp  ***
@@ -1400,47 +1326,45 @@
       INTEGER  ::   ji ,jj               ! dummy loop indices
       LOGICAL  ::   ll_tmp1, ll_tmp2
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: sshn
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pshn
       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: zcpx, zcpy
       !!----------------------------------------------------------------------
-      DO jj = 2, jpjm1
-         DO ji = 2, jpim1 
-            ll_tmp1 = MIN(  sshn(ji,jj)               ,  sshn(ji+1,jj) ) >                &
-                 &      MAX( -ht_0(ji,jj)               , -ht_0(ji+1,jj) ) .AND.            &
-                 &      MAX(  sshn(ji,jj) + ht_0(ji,jj) ,  sshn(ji+1,jj) + ht_0(ji+1,jj) )  &
-                 &                                                         > rn_wdmin1 + rn_wdmin2
-            ll_tmp2 = ( ABS( sshn(ji+1,jj)            -  sshn(ji  ,jj))  > 1.E-12 ).AND.( &
-                 &      MAX(   sshn(ji,jj)              ,  sshn(ji+1,jj) ) >                &
-                 &      MAX(  -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
-            IF(ll_tmp1) THEN
-               zcpx(ji,jj) = 1.0_wp
-            ELSEIF(ll_tmp2) THEN
-               ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here
-               zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_0(ji+1,jj) - sshn(ji,jj) - ht_0(ji,jj)) &
-                    &    / (sshn(ji+1,jj) - sshn(ji  ,jj)) )
-               zcpx(ji,jj) = max(min( zcpx(ji,jj) , 1.0_wp),0.0_wp)
-            ELSE
-               zcpx(ji,jj) = 0._wp
-            ENDIF
-            !
-            ll_tmp1 = MIN(  sshn(ji,jj)               ,  sshn(ji,jj+1) ) >                &
-                 &      MAX( -ht_0(ji,jj)               , -ht_0(ji,jj+1) ) .AND.            &
-                 &      MAX(  sshn(ji,jj) + ht_0(ji,jj) ,  sshn(ji,jj+1) + ht_0(ji,jj+1) )  &
-                 &                                                       > rn_wdmin1 + rn_wdmin2
-            ll_tmp2 = ( ABS( sshn(ji,jj)              -  sshn(ji,jj+1))  > 1.E-12 ).AND.( &
-                 &      MAX(   sshn(ji,jj)              ,  sshn(ji,jj+1) ) >                &
-                 &      MAX(  -ht_0(ji,jj)              , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
-            
-            IF(ll_tmp1) THEN
-               zcpy(ji,jj) = 1.0_wp
-            ELSE IF(ll_tmp2) THEN
-               ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here
-               zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_0(ji,jj+1) - sshn(ji,jj) - ht_0(ji,jj)) &
-                    &             / (sshn(ji,jj+1) - sshn(ji,jj  )) )
-               zcpy(ji,jj) = MAX(  0._wp , MIN( zcpy(ji,jj) , 1.0_wp )  )
-            ELSE
-               zcpy(ji,jj) = 0._wp
-            ENDIF
-         END DO
-      END DO
+      DO_2D_00_00
+         ll_tmp1 = MIN(  pshn(ji,jj)               ,  pshn(ji+1,jj) ) >                &
+              &      MAX( -ht_0(ji,jj)               , -ht_0(ji+1,jj) ) .AND.            &
+              &      MAX(  pshn(ji,jj) + ht_0(ji,jj) ,  pshn(ji+1,jj) + ht_0(ji+1,jj) )  &
+              &                                                         > rn_wdmin1 + rn_wdmin2
+         ll_tmp2 = ( ABS( pshn(ji+1,jj)            -  pshn(ji  ,jj))  > 1.E-12 ).AND.( &
+              &      MAX(   pshn(ji,jj)              ,  pshn(ji+1,jj) ) >                &
+              &      MAX(  -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
+         IF(ll_tmp1) THEN
+            zcpx(ji,jj) = 1.0_wp
+         ELSEIF(ll_tmp2) THEN
+            ! no worries about  pshn(ji+1,jj) -  pshn(ji  ,jj) = 0, it won't happen ! here
+            zcpx(ji,jj) = ABS( (pshn(ji+1,jj) + ht_0(ji+1,jj) - pshn(ji,jj) - ht_0(ji,jj)) &
+                 &           / (pshn(ji+1,jj) - pshn(ji  ,jj)) )
+            zcpx(ji,jj) = max(min( zcpx(ji,jj) , 1.0_wp),0.0_wp)
+         ELSE
+            zcpx(ji,jj) = 0._wp
+         ENDIF
+         !
+         ll_tmp1 = MIN(  pshn(ji,jj)               ,  pshn(ji,jj+1) ) >                &
+              &      MAX( -ht_0(ji,jj)               , -ht_0(ji,jj+1) ) .AND.            &
+              &      MAX(  pshn(ji,jj) + ht_0(ji,jj) ,  pshn(ji,jj+1) + ht_0(ji,jj+1) )  &
+              &                                                       > rn_wdmin1 + rn_wdmin2
+         ll_tmp2 = ( ABS( pshn(ji,jj)              -  pshn(ji,jj+1))  > 1.E-12 ).AND.( &
+              &      MAX(   pshn(ji,jj)              ,  pshn(ji,jj+1) ) >                &
+              &      MAX(  -ht_0(ji,jj)              , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
+         
+         IF(ll_tmp1) THEN
+            zcpy(ji,jj) = 1.0_wp
+         ELSE IF(ll_tmp2) THEN
+            ! no worries about  pshn(ji,jj+1) -  pshn(ji,jj  ) = 0, it won't happen ! here
+            zcpy(ji,jj) = ABS( (pshn(ji,jj+1) + ht_0(ji,jj+1) - pshn(ji,jj) - ht_0(ji,jj)) &
+                 &           / (pshn(ji,jj+1) - pshn(ji,jj  )) )
+            zcpy(ji,jj) = MAX(  0._wp , MIN( zcpy(ji,jj) , 1.0_wp )  )
+         ELSE
+            zcpy(ji,jj) = 0._wp
+         ENDIF
+      END_2D
             
    END SUBROUTINE wad_spg
@@ -1448,5 +1372,5 @@
 
 
-   SUBROUTINE dyn_drg_init( pu_RHSi, pv_RHSi, pCdU_u, pCdU_v )
+   SUBROUTINE dyn_drg_init( Kbb, Kmm, puu, pvv, puu_b ,pvv_b, pu_RHSi, pv_RHSi, pCdU_u, pCdU_v )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dyn_drg_init  ***
@@ -1458,6 +1382,9 @@
       !! ** Method  :   computation done over the INNER domain only 
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pu_RHSi, pv_RHSi   ! baroclinic part of the barotropic RHS
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   pCdU_u , pCdU_v    ! barotropic drag coefficients
+      INTEGER                             , INTENT(in   ) ::  Kbb, Kmm           ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(in   ) ::  puu, pvv           ! ocean velocities and RHS of momentum equation
+      REAL(wp), DIMENSION(jpi,jpj,jpt)    , INTENT(in   ) ::  puu_b, pvv_b       ! barotropic velocities at main time levels
+      REAL(wp), DIMENSION(jpi,jpj)        , INTENT(inout) ::  pu_RHSi, pv_RHSi   ! baroclinic part of the barotropic RHS
+      REAL(wp), DIMENSION(jpi,jpj)        , INTENT(  out) ::  pCdU_u , pCdU_v    ! barotropic drag coefficients
       !
       INTEGER  ::   ji, jj   ! dummy loop indices
@@ -1471,17 +1398,13 @@
       IF( ln_isfcav ) THEN          ! top+bottom friction (ocean cavities)
          
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1     ! INNER domain
-               pCdU_u(ji,jj) = r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) + rCdU_top(ji+1,jj)+rCdU_top(ji,jj) )
-               pCdU_v(ji,jj) = r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) + rCdU_top(ji,jj+1)+rCdU_top(ji,jj) )
-            END DO
-         END DO
+         DO_2D_00_00
+            pCdU_u(ji,jj) = r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) + rCdU_top(ji+1,jj)+rCdU_top(ji,jj) )
+            pCdU_v(ji,jj) = r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) + rCdU_top(ji,jj+1)+rCdU_top(ji,jj) )
+         END_2D
       ELSE                          ! bottom friction only
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1  ! INNER domain
-               pCdU_u(ji,jj) = r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) )
-               pCdU_v(ji,jj) = r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) )
-            END DO
-         END DO
+         DO_2D_00_00
+            pCdU_u(ji,jj) = r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) )
+            pCdU_v(ji,jj) = r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) )
+         END_2D
       ENDIF
       !
@@ -1490,42 +1413,34 @@
       IF( ln_bt_fw ) THEN                 ! FORWARD integration: use NOW bottom baroclinic velocities
          
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1  ! INNER domain
-               ikbu = mbku(ji,jj)       
-               ikbv = mbkv(ji,jj)    
-               zu_i(ji,jj) = un(ji,jj,ikbu) - un_b(ji,jj)
-               zv_i(ji,jj) = vn(ji,jj,ikbv) - vn_b(ji,jj)
-            END DO
-         END DO
+         DO_2D_00_00
+            ikbu = mbku(ji,jj)       
+            ikbv = mbkv(ji,jj)    
+            zu_i(ji,jj) = puu(ji,jj,ikbu,Kmm) - puu_b(ji,jj,Kmm)
+            zv_i(ji,jj) = pvv(ji,jj,ikbv,Kmm) - pvv_b(ji,jj,Kmm)
+         END_2D
       ELSE                                ! CENTRED integration: use BEFORE bottom baroclinic velocities
          
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1   ! INNER domain
-               ikbu = mbku(ji,jj)       
-               ikbv = mbkv(ji,jj)    
-               zu_i(ji,jj) = ub(ji,jj,ikbu) - ub_b(ji,jj)
-               zv_i(ji,jj) = vb(ji,jj,ikbv) - vb_b(ji,jj)
-            END DO
-         END DO
+         DO_2D_00_00
+            ikbu = mbku(ji,jj)       
+            ikbv = mbkv(ji,jj)    
+            zu_i(ji,jj) = puu(ji,jj,ikbu,Kbb) - puu_b(ji,jj,Kbb)
+            zv_i(ji,jj) = pvv(ji,jj,ikbv,Kbb) - pvv_b(ji,jj,Kbb)
+         END_2D
       ENDIF
       !
       IF( ln_wd_il ) THEN      ! W/D : use the "clipped" bottom friction   !!gm   explain WHY, please !
-         zztmp = -1._wp / rdtbt
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1    ! INNER domain
-               pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + zu_i(ji,jj) *  wdrampu(ji,jj) * MAX(                                 & 
-                    &                              r1_hu_n(ji,jj) * r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) , zztmp  )
-               pv_RHSi(ji,jj) = pv_RHSi(ji,jj) + zv_i(ji,jj) *  wdrampv(ji,jj) * MAX(                                 & 
-                    &                              r1_hv_n(ji,jj) * r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) , zztmp  )
-            END DO
-         END DO
+         zztmp = -1._wp / rDt_e
+         DO_2D_00_00
+            pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + zu_i(ji,jj) *  wdrampu(ji,jj) * MAX(                                 & 
+                 &                              r1_hu(ji,jj,Kmm) * r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) , zztmp  )
+            pv_RHSi(ji,jj) = pv_RHSi(ji,jj) + zv_i(ji,jj) *  wdrampv(ji,jj) * MAX(                                 & 
+                 &                              r1_hv(ji,jj,Kmm) * r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) , zztmp  )
+         END_2D
       ELSE                    ! use "unclipped" drag (even if explicit friction is used in 3D calculation)
          
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1    ! INNER domain
-               pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + r1_hu_n(ji,jj) * r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * zu_i(ji,jj)
-               pv_RHSi(ji,jj) = pv_RHSi(ji,jj) + r1_hv_n(ji,jj) * r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * zv_i(ji,jj)
-            END DO
-         END DO
+         DO_2D_00_00
+            pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + r1_hu(ji,jj,Kmm) * r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * zu_i(ji,jj)
+            pv_RHSi(ji,jj) = pv_RHSi(ji,jj) + r1_hv(ji,jj,Kmm) * r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * zv_i(ji,jj)
+         END_2D
       END IF
       !
@@ -1536,32 +1451,26 @@
          IF( ln_bt_fw ) THEN                ! FORWARD integration: use NOW top baroclinic velocity
             
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1   ! INNER domain
-                  iktu = miku(ji,jj)
-                  iktv = mikv(ji,jj)
-                  zu_i(ji,jj) = un(ji,jj,iktu) - un_b(ji,jj)
-                  zv_i(ji,jj) = vn(ji,jj,iktv) - vn_b(ji,jj)
-               END DO
-            END DO
+            DO_2D_00_00
+               iktu = miku(ji,jj)
+               iktv = mikv(ji,jj)
+               zu_i(ji,jj) = puu(ji,jj,iktu,Kmm) - puu_b(ji,jj,Kmm)
+               zv_i(ji,jj) = pvv(ji,jj,iktv,Kmm) - pvv_b(ji,jj,Kmm)
+            END_2D
          ELSE                                ! CENTRED integration: use BEFORE top baroclinic velocity
             
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1      ! INNER domain
-                  iktu = miku(ji,jj)
-                  iktv = mikv(ji,jj)
-                  zu_i(ji,jj) = ub(ji,jj,iktu) - ub_b(ji,jj)
-                  zv_i(ji,jj) = vb(ji,jj,iktv) - vb_b(ji,jj)
-               END DO
-            END DO
+            DO_2D_00_00
+               iktu = miku(ji,jj)
+               iktv = mikv(ji,jj)
+               zu_i(ji,jj) = puu(ji,jj,iktu,Kbb) - puu_b(ji,jj,Kbb)
+               zv_i(ji,jj) = pvv(ji,jj,iktv,Kbb) - pvv_b(ji,jj,Kbb)
+            END_2D
          ENDIF
          !
          !                    ! use "unclipped" top drag (even if explicit friction is used in 3D calculation)
          
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1    ! INNER domain
-               pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + r1_hu_n(ji,jj) * r1_2*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * zu_i(ji,jj)
-               pv_RHSi(ji,jj) = pv_RHSi(ji,jj) + r1_hv_n(ji,jj) * r1_2*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * zv_i(ji,jj)
-            END DO
-         END DO
+         DO_2D_00_00
+            pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + r1_hu(ji,jj,Kmm) * r1_2*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * zu_i(ji,jj)
+            pv_RHSi(ji,jj) = pv_RHSi(ji,jj) + r1_hv(ji,jj,Kmm) * r1_2*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * zv_i(ji,jj)
+         END_2D
          !
       ENDIF
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynvor.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynvor.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynvor.F90	(revision 12928)
@@ -88,5 +88,5 @@
    
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -96,15 +96,17 @@
 CONTAINS
 
-   SUBROUTINE dyn_vor( kt )
+   SUBROUTINE dyn_vor( kt, Kmm, puu, pvv, Krhs )
       !!----------------------------------------------------------------------
       !!
       !! ** Purpose :   compute the lateral ocean tracer physics.
       !!
-      !! ** Action : - Update (ua,va) with the now vorticity term trend
+      !! ** Action : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the now vorticity term trend
       !!             - save the trends in (ztrdu,ztrdv) in 2 parts (relative
       !!               and planetary vorticity trends) and send them to trd_dyn 
       !!               for futher diagnostics (l_trddyn=T)
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      INTEGER                             , INTENT( in  ) ::   kt          ! ocean time-step index
+      INTEGER                             , INTENT( in  ) ::   Kmm, Krhs   ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::   puu, pvv    ! ocean velocity field and RHS of momentum equation
       !
       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  ztrdu, ztrdv
@@ -117,35 +119,35 @@
          ALLOCATE( ztrdu(jpi,jpj,jpk), ztrdv(jpi,jpj,jpk) )
          !
-         ztrdu(:,:,:) = ua(:,:,:)            !* planetary vorticity trend (including Stokes-Coriolis force)
-         ztrdv(:,:,:) = va(:,:,:)
+         ztrdu(:,:,:) = puu(:,:,:,Krhs)            !* planetary vorticity trend (including Stokes-Coriolis force)
+         ztrdv(:,:,:) = pvv(:,:,:,Krhs)
          SELECT CASE( nvor_scheme )
-         CASE( np_ENS )           ;   CALL vor_ens( kt, ncor, un , vn , ua, va )   ! enstrophy conserving scheme
-            IF( ln_stcor )            CALL vor_ens( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend
-         CASE( np_ENE, np_MIX )   ;   CALL vor_ene( kt, ncor, un , vn , ua, va )   ! energy conserving scheme
-            IF( ln_stcor )            CALL vor_ene( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend
-         CASE( np_ENT )           ;   CALL vor_enT( kt, ncor, un , vn , ua, va )   ! energy conserving scheme (T-pts)
-            IF( ln_stcor )            CALL vor_enT( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend
-         CASE( np_EET )           ;   CALL vor_eeT( kt, ncor, un , vn , ua, va )   ! energy conserving scheme (een with e3t)
-            IF( ln_stcor )            CALL vor_eeT( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend
-         CASE( np_EEN )           ;   CALL vor_een( kt, ncor, un , vn , ua, va )   ! energy & enstrophy scheme
-            IF( ln_stcor )            CALL vor_een( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend
+         CASE( np_ENS )           ;   CALL vor_ens( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! enstrophy conserving scheme
+            IF( ln_stcor )            CALL vor_ens( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
+         CASE( np_ENE, np_MIX )   ;   CALL vor_ene( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! energy conserving scheme
+            IF( ln_stcor )            CALL vor_ene( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
+         CASE( np_ENT )           ;   CALL vor_enT( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! energy conserving scheme (T-pts)
+            IF( ln_stcor )            CALL vor_enT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
+         CASE( np_EET )           ;   CALL vor_eeT( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! energy conserving scheme (een with e3t)
+            IF( ln_stcor )            CALL vor_eeT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
+         CASE( np_EEN )           ;   CALL vor_een( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! energy & enstrophy scheme
+            IF( ln_stcor )            CALL vor_een( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
          END SELECT
-         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
-         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
-         CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt )
+         ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:)
+         ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:)
+         CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt, Kmm )
          !
          IF( n_dynadv /= np_LIN_dyn ) THEN   !* relative vorticity or metric trend (only in non-linear case)
-            ztrdu(:,:,:) = ua(:,:,:)
-            ztrdv(:,:,:) = va(:,:,:)
+            ztrdu(:,:,:) = puu(:,:,:,Krhs)
+            ztrdv(:,:,:) = pvv(:,:,:,Krhs)
             SELECT CASE( nvor_scheme )
-            CASE( np_ENT )           ;   CALL vor_enT( kt, nrvm, un , vn , ua, va )  ! energy conserving scheme (T-pts)
-            CASE( np_EET )           ;   CALL vor_eeT( kt, nrvm, un , vn , ua, va )  ! energy conserving scheme (een with e3t)
-            CASE( np_ENE )           ;   CALL vor_ene( kt, nrvm, un , vn , ua, va )  ! energy conserving scheme
-            CASE( np_ENS, np_MIX )   ;   CALL vor_ens( kt, nrvm, un , vn , ua, va )  ! enstrophy conserving scheme
-            CASE( np_EEN )           ;   CALL vor_een( kt, nrvm, un , vn , ua, va )  ! energy & enstrophy scheme
+            CASE( np_ENT )           ;   CALL vor_enT( kt, Kmm, nrvm, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! energy conserving scheme (T-pts)
+            CASE( np_EET )           ;   CALL vor_eeT( kt, Kmm, nrvm, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! energy conserving scheme (een with e3t)
+            CASE( np_ENE )           ;   CALL vor_ene( kt, Kmm, nrvm, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! energy conserving scheme
+            CASE( np_ENS, np_MIX )   ;   CALL vor_ens( kt, Kmm, nrvm, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! enstrophy conserving scheme
+            CASE( np_EEN )           ;   CALL vor_een( kt, Kmm, nrvm, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! energy & enstrophy scheme
             END SELECT
-            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
-            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
-            CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt )
+            ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:)
+            ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:)
+            CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt, Kmm )
          ENDIF
          !
@@ -156,22 +158,22 @@
          SELECT CASE ( nvor_scheme )      !==  vorticity trend added to the general trend  ==!
          CASE( np_ENT )                        !* energy conserving scheme  (T-pts)
-                             CALL vor_enT( kt, ntot, un , vn , ua, va )   ! total vorticity trend
-            IF( ln_stcor )   CALL vor_enT( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend
+                             CALL vor_enT( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! total vorticity trend
+            IF( ln_stcor )   CALL vor_enT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
          CASE( np_EET )                        !* energy conserving scheme (een scheme using e3t)
-                             CALL vor_eeT( kt, ntot, un , vn , ua, va )   ! total vorticity trend
-            IF( ln_stcor )   CALL vor_eeT( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend
+                             CALL vor_eeT( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! total vorticity trend
+            IF( ln_stcor )   CALL vor_eeT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
          CASE( np_ENE )                        !* energy conserving scheme
-                             CALL vor_ene( kt, ntot, un , vn , ua, va )   ! total vorticity trend
-            IF( ln_stcor )   CALL vor_ene( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend
+                             CALL vor_ene( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! total vorticity trend
+            IF( ln_stcor )   CALL vor_ene( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
          CASE( np_ENS )                        !* enstrophy conserving scheme
-                             CALL vor_ens( kt, ntot, un , vn , ua, va )  ! total vorticity trend
-            IF( ln_stcor )   CALL vor_ens( kt, ncor, usd, vsd, ua, va )  ! add the Stokes-Coriolis trend
+                             CALL vor_ens( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! total vorticity trend
+            IF( ln_stcor )   CALL vor_ens( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! add the Stokes-Coriolis trend
          CASE( np_MIX )                        !* mixed ene-ens scheme
-                             CALL vor_ens( kt, nrvm, un , vn , ua, va )   ! relative vorticity or metric trend (ens)
-                             CALL vor_ene( kt, ncor, un , vn , ua, va )   ! planetary vorticity trend (ene)
-            IF( ln_stcor )   CALL vor_ene( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend
+                             CALL vor_ens( kt, Kmm, nrvm, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! relative vorticity or metric trend (ens)
+                             CALL vor_ene( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! planetary vorticity trend (ene)
+            IF( ln_stcor )   CALL vor_ene( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
          CASE( np_EEN )                        !* energy and enstrophy conserving scheme
-                             CALL vor_een( kt, ntot, un , vn , ua, va )   ! total vorticity trend
-            IF( ln_stcor )   CALL vor_een( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend
+                             CALL vor_een( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! total vorticity trend
+            IF( ln_stcor )   CALL vor_een( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
          END SELECT
          !
@@ -179,6 +181,6 @@
       !
       !                       ! print sum trends (used for debugging)
-      IF(ln_ctl) CALL prt_ctl( tab3d_1=ua, clinfo1=' vor  - Ua: ', mask1=umask,               &
-         &                     tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' vor  - Ua: ', mask1=umask,               &
+         &                                tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
       !
       IF( ln_timing )   CALL timing_stop('dyn_vor')
@@ -187,5 +189,5 @@
 
 
-   SUBROUTINE vor_enT( kt, kvor, pu, pv, pu_rhs, pv_rhs )
+   SUBROUTINE vor_enT( kt, Kmm, kvor, pu, pv, pu_rhs, pv_rhs )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE vor_enT  ***
@@ -203,7 +205,8 @@
       !!       where rvor is the relative vorticity at f-point
       !!
-      !! ** Action : - Update (ua,va) with the now vorticity term trend
+      !! ** Action : - Update (pu_rhs,pv_rhs) with the now vorticity term trend
       !!----------------------------------------------------------------------
       INTEGER                         , INTENT(in   ) ::   kt               ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   Kmm              ! ocean time level index
       INTEGER                         , INTENT(in   ) ::   kvor             ! total, planetary, relative, or metric
       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv           ! now velocities
@@ -226,16 +229,12 @@
       CASE ( np_RVO )                           !* relative vorticity
          DO jk = 1, jpkm1                                 ! Horizontal slab
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  zwz(ji,jj,jk) = (  e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)  &
-                     &             - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj)
-               END DO
-            END DO
+            DO_2D_10_10
+               zwz(ji,jj,jk) = (  e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)  &
+                  &             - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj)
+            END_2D
             IF( ln_dynvor_msk ) THEN                     ! mask/unmask relative vorticity 
-               DO jj = 1, jpjm1
-                  DO ji = 1, jpim1
-                     zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk)
-                  END DO
-               END DO
+               DO_2D_10_10
+                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk)
+               END_2D
             ENDIF
          END DO
@@ -245,16 +244,12 @@
       CASE ( np_CRV )                           !* Coriolis + relative vorticity
          DO jk = 1, jpkm1                                 ! Horizontal slab
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1                          ! relative vorticity
-                  zwz(ji,jj,jk) = (   e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)   &
-                     &              - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)   ) * r1_e1e2f(ji,jj)
-               END DO
-            END DO
+            DO_2D_10_10
+               zwz(ji,jj,jk) = (   e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)   &
+                  &              - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)   ) * r1_e1e2f(ji,jj)
+            END_2D
             IF( ln_dynvor_msk ) THEN                     ! mask/unmask relative vorticity 
-               DO jj = 1, jpjm1
-                  DO ji = 1, jpim1
-                     zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk)
-                  END DO
-               END DO
+               DO_2D_10_10
+                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk)
+               END_2D
             ENDIF
          END DO
@@ -270,34 +265,26 @@
          SELECT CASE( kvor )                 !==  volume weighted vorticity considered  ==!
          CASE ( np_COR )                           !* Coriolis (planetary vorticity)
-            zwt(:,:) = ff_t(:,:) * e1e2t(:,:)*e3t_n(:,:,jk)
+            zwt(:,:) = ff_t(:,:) * e1e2t(:,:)*e3t(:,:,jk,Kmm)
          CASE ( np_RVO )                           !* relative vorticity
-            DO jj = 2, jpj
-               DO ji = 2, jpi   ! vector opt.
-                  zwt(ji,jj) = r1_4 * (   zwz(ji-1,jj  ,jk) + zwz(ji,jj  ,jk)   &
-                     &                  + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) ) * e1e2t(ji,jj)*e3t_n(ji,jj,jk)
-               END DO
-            END DO
+            DO_2D_01_01
+               zwt(ji,jj) = r1_4 * (   zwz(ji-1,jj  ,jk) + zwz(ji,jj  ,jk)   &
+                  &                  + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) ) * e1e2t(ji,jj)*e3t(ji,jj,jk,Kmm)
+            END_2D
          CASE ( np_MET )                           !* metric term
-            DO jj = 2, jpj
-               DO ji = 2, jpi
-                  zwt(ji,jj) = (   ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj)   &
-                     &           - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj)   ) * e3t_n(ji,jj,jk)
-               END DO
-            END DO
+            DO_2D_01_01
+               zwt(ji,jj) = (   ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj)   &
+                  &           - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj)   ) * e3t(ji,jj,jk,Kmm)
+            END_2D
          CASE ( np_CRV )                           !* Coriolis + relative vorticity
-            DO jj = 2, jpj
-               DO ji = 2, jpi   ! vector opt.
-                  zwt(ji,jj) = (  ff_t(ji,jj) + r1_4 * ( zwz(ji-1,jj  ,jk) + zwz(ji,jj  ,jk)    &
-                     &                                 + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) )  ) * e1e2t(ji,jj)*e3t_n(ji,jj,jk)
-               END DO
-            END DO
+            DO_2D_01_01
+               zwt(ji,jj) = (  ff_t(ji,jj) + r1_4 * ( zwz(ji-1,jj  ,jk) + zwz(ji,jj  ,jk)    &
+                  &                                 + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) )  ) * e1e2t(ji,jj)*e3t(ji,jj,jk,Kmm)
+            END_2D
          CASE ( np_CME )                           !* Coriolis + metric
-            DO jj = 2, jpj
-               DO ji = 2, jpi   ! vector opt.
-                  zwt(ji,jj) = (  ff_t(ji,jj) * e1e2t(ji,jj)                           &
-                       &        + ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj)  &
-                       &        - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj)  ) * e3t_n(ji,jj,jk)
-               END DO
-            END DO
+            DO_2D_01_01
+               zwt(ji,jj) = (  ff_t(ji,jj) * e1e2t(ji,jj)                           &
+                    &        + ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj)  &
+                    &        - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj)  ) * e3t(ji,jj,jk,Kmm)
+            END_2D
          CASE DEFAULT                                             ! error
             CALL ctl_stop('STOP','dyn_vor: wrong value for kvor'  )
@@ -305,15 +292,13 @@
          !
          !                                   !==  compute and add the vorticity term trend  =!
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1   ! vector opt.
-               pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + r1_4 * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)                    &
-                  &                                * (  zwt(ji+1,jj) * ( pv(ji+1,jj,jk) + pv(ji+1,jj-1,jk) )   &
-                  &                                   + zwt(ji  ,jj) * ( pv(ji  ,jj,jk) + pv(ji  ,jj-1,jk) )   )
-                  !
-               pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - r1_4 * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)                    &
-                  &                                * (  zwt(ji,jj+1) * ( pu(ji,jj+1,jk) + pu(ji-1,jj+1,jk) )   & 
-                  &                                   + zwt(ji,jj  ) * ( pu(ji,jj  ,jk) + pu(ji-1,jj  ,jk) )   ) 
-            END DO  
-         END DO  
+         DO_2D_00_00
+            pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + r1_4 * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm)                    &
+               &                                * (  zwt(ji+1,jj) * ( pv(ji+1,jj,jk) + pv(ji+1,jj-1,jk) )   &
+               &                                   + zwt(ji  ,jj) * ( pv(ji  ,jj,jk) + pv(ji  ,jj-1,jk) )   )
+               !
+            pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - r1_4 * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm)                    &
+               &                                * (  zwt(ji,jj+1) * ( pu(ji,jj+1,jk) + pu(ji-1,jj+1,jk) )   & 
+               &                                   + zwt(ji,jj  ) * ( pu(ji,jj  ,jk) + pu(ji-1,jj  ,jk) )   ) 
+         END_2D
          !                                             ! ===============
       END DO                                           !   End of slab
@@ -322,5 +307,5 @@
 
 
-   SUBROUTINE vor_ene( kt, kvor, pun, pvn, pua, pva )
+   SUBROUTINE vor_ene( kt, Kmm, kvor, pu, pv, pu_rhs, pv_rhs )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE vor_ene  ***
@@ -334,16 +319,17 @@
       !!         The general trend of momentum is increased due to the vorticity 
       !!       term which is given by:
-      !!          voru = 1/e1u  mj-1[ (rvor+f)/e3f  mi(e1v*e3v vn) ]
-      !!          vorv = 1/e2v  mi-1[ (rvor+f)/e3f  mj(e2u*e3u un) ]
+      !!          voru = 1/e1u  mj-1[ (rvor+f)/e3f  mi(e1v*e3v pvv(:,:,:,Kmm)) ]
+      !!          vorv = 1/e2v  mi-1[ (rvor+f)/e3f  mj(e2u*e3u puu(:,:,:,Kmm)) ]
       !!       where rvor is the relative vorticity
       !!
-      !! ** Action : - Update (ua,va) with the now vorticity term trend
+      !! ** Action : - Update (pu_rhs,pv_rhs) with the now vorticity term trend
       !!
       !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689.
       !!----------------------------------------------------------------------
       INTEGER                         , INTENT(in   ) ::   kt          ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   Kmm              ! ocean time level index
       INTEGER                         , INTENT(in   ) ::   kvor        ! total, planetary, relative, or metric
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun, pvn    ! now velocities
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva    ! total v-trend
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv    ! now velocities
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs    ! total v-trend
       !
       INTEGER  ::   ji, jj, jk           ! dummy loop indices
@@ -366,31 +352,23 @@
             zwz(:,:) = ff_f(:,:) 
          CASE ( np_RVO )                           !* relative vorticity
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj) = (  e2v(ji+1,jj  ) * pvn(ji+1,jj  ,jk) - e2v(ji,jj) * pvn(ji,jj,jk)    &
-                     &          - e1u(ji  ,jj+1) * pun(ji  ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  ) * r1_e1e2f(ji,jj)
-               END DO
-            END DO
+            DO_2D_10_10
+               zwz(ji,jj) = (  e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk)    &
+                  &          - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj)
+            END_2D
          CASE ( np_MET )                           !* metric term
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj) = ( pvn(ji+1,jj  ,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
-                     &       - ( pun(ji  ,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
-               END DO
-            END DO
+            DO_2D_10_10
+               zwz(ji,jj) = ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
+                  &       - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
+            END_2D
          CASE ( np_CRV )                           !* Coriolis + relative vorticity
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj) = ff_f(ji,jj) + (  e2v(ji+1,jj) * pvn(ji+1,jj,jk) - e2v(ji,jj) * pvn(ji,jj,jk)      &
-                     &                        - e1u(ji,jj+1) * pun(ji,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  ) * r1_e1e2f(ji,jj)
-               END DO
-            END DO
+            DO_2D_10_10
+               zwz(ji,jj) = ff_f(ji,jj) + (  e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)      &
+                  &                        - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj)
+            END_2D
          CASE ( np_CME )                           !* Coriolis + metric
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj) = ff_f(ji,jj) + ( pvn(ji+1,jj  ,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
-                     &                     - ( pun(ji  ,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
-               END DO
-            END DO
+            DO_2D_10_10
+               zwz(ji,jj) = ff_f(ji,jj) + ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
+                  &                     - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
+            END_2D
          CASE DEFAULT                                             ! error
             CALL ctl_stop('STOP','dyn_vor: wrong value for kvor'  )
@@ -398,30 +376,26 @@
          !
          IF( ln_dynvor_msk ) THEN          !==  mask/unmask vorticity ==!
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk)
-               END DO
-            END DO
+            DO_2D_10_10
+               zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk)
+            END_2D
          ENDIF
 
          IF( ln_sco ) THEN
-            zwz(:,:) = zwz(:,:) / e3f_n(:,:,jk)
-            zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk)
-            zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk)
+            zwz(:,:) = zwz(:,:) / e3f(:,:,jk)
+            zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk)
+            zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk)
          ELSE
-            zwx(:,:) = e2u(:,:) * pun(:,:,jk)
-            zwy(:,:) = e1v(:,:) * pvn(:,:,jk)
+            zwx(:,:) = e2u(:,:) * pu(:,:,jk)
+            zwy(:,:) = e1v(:,:) * pv(:,:,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)
-               pua(ji,jj,jk) = pua(ji,jj,jk) + r1_4 * r1_e1u(ji,jj) * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
-               pva(ji,jj,jk) = pva(ji,jj,jk) - r1_4 * r1_e2v(ji,jj) * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 ) 
-            END DO  
-         END DO  
+         DO_2D_00_00
+            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)
+            pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + r1_4 * r1_e1u(ji,jj) * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
+            pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - r1_4 * r1_e2v(ji,jj) * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 ) 
+         END_2D
          !                                             ! ===============
       END DO                                           !   End of slab
@@ -430,5 +404,5 @@
 
 
-   SUBROUTINE vor_ens( kt, kvor, pun, pvn, pua, pva )
+   SUBROUTINE vor_ens( kt, Kmm, kvor, pu, pv, pu_rhs, pv_rhs )
       !!----------------------------------------------------------------------
       !!                ***  ROUTINE vor_ens  ***
@@ -441,17 +415,18 @@
       !!      potential enstrophy of a horizontally non-divergent flow. the
       !!      trend of the vorticity term is given by:
-      !!          voru = 1/e1u  mj-1[ (rvor+f)/e3f ]  mj-1[ mi(e1v*e3v vn) ]
-      !!          vorv = 1/e2v  mi-1[ (rvor+f)/e3f ]  mi-1[ mj(e2u*e3u 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
+      !!          voru = 1/e1u  mj-1[ (rvor+f)/e3f ]  mj-1[ mi(e1v*e3v pvv(:,:,:,Kmm)) ]
+      !!          vorv = 1/e2v  mi-1[ (rvor+f)/e3f ]  mi-1[ mj(e2u*e3u puu(:,:,:,Kmm)) ]
+      !!      Add this trend to the general momentum trend:
+      !!          (u(rhs),v(Krhs)) = (u(rhs),v(Krhs)) + ( voru , vorv )
+      !!
+      !! ** Action : - Update (pu_rhs,pv_rhs)) arrays with the now vorticity term trend
       !!
       !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689.
       !!----------------------------------------------------------------------
       INTEGER                         , INTENT(in   ) ::   kt          ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   Kmm              ! ocean time level index
       INTEGER                         , INTENT(in   ) ::   kvor        ! total, planetary, relative, or metric
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun, pvn    ! now velocities
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva    ! total v-trend
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv    ! now velocities
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs    ! total v-trend
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -473,31 +448,23 @@
             zwz(:,:) = ff_f(:,:) 
          CASE ( np_RVO )                           !* relative vorticity
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj) = (  e2v(ji+1,jj  ) * pvn(ji+1,jj  ,jk) - e2v(ji,jj) * pvn(ji,jj,jk)    &
-                     &          - e1u(ji  ,jj+1) * pun(ji  ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  ) * r1_e1e2f(ji,jj)
-               END DO
-            END DO
+            DO_2D_10_10
+               zwz(ji,jj) = (  e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk)    &
+                  &          - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj)
+            END_2D
          CASE ( np_MET )                           !* metric term
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj) = ( pvn(ji+1,jj  ,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
-                     &       - ( pun(ji  ,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
-               END DO
-            END DO
+            DO_2D_10_10
+               zwz(ji,jj) = ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
+                  &       - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
+            END_2D
          CASE ( np_CRV )                           !* Coriolis + relative vorticity
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj) = ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pvn(ji+1,jj  ,jk) - e2v(ji,jj) * pvn(ji,jj,jk)  &
-                     &                        - e1u(ji  ,jj+1) * pun(ji  ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  ) * r1_e1e2f(ji,jj)
-               END DO
-            END DO
+            DO_2D_10_10
+               zwz(ji,jj) = ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk)  &
+                  &                        - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj)
+            END_2D
          CASE ( np_CME )                           !* Coriolis + metric
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj) = ff_f(ji,jj) + ( pvn(ji+1,jj  ,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
-                     &                     - ( pun(ji  ,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
-               END DO
-            END DO
+            DO_2D_10_10
+               zwz(ji,jj) = ff_f(ji,jj) + ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
+                  &                     - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
+            END_2D
          CASE DEFAULT                                             ! error
             CALL ctl_stop('STOP','dyn_vor: wrong value for kvor'  )
@@ -505,30 +472,26 @@
          !
          IF( ln_dynvor_msk ) THEN           !==  mask/unmask vorticity ==!
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk)
-               END DO
-            END DO
+            DO_2D_10_10
+               zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk)
+            END_2D
          ENDIF
          !
          IF( ln_sco ) THEN                   !==  horizontal fluxes  ==!
-            zwz(:,:) = zwz(:,:) / e3f_n(:,:,jk)
-            zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk)
-            zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk)
+            zwz(:,:) = zwz(:,:) / e3f(:,:,jk)
+            zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk)
+            zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk)
          ELSE
-            zwx(:,:) = e2u(:,:) * pun(:,:,jk)
-            zwy(:,:) = e1v(:,:) * pvn(:,:,jk)
+            zwx(:,:) = e2u(:,:) * pu(:,:,jk)
+            zwy(:,:) = e1v(:,:) * pv(:,:,jk)
          ENDIF
          !                                   !==  compute and add the vorticity term trend  =!
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zuav = r1_8 * r1_e1u(ji,jj) * (  zwy(ji  ,jj-1) + zwy(ji+1,jj-1)  &
-                  &                           + zwy(ji  ,jj  ) + zwy(ji+1,jj  )  )
-               zvau =-r1_8 * r1_e2v(ji,jj) * (  zwx(ji-1,jj  ) + zwx(ji-1,jj+1)  &
-                  &                           + zwx(ji  ,jj  ) + zwx(ji  ,jj+1)  )
-               pua(ji,jj,jk) = pua(ji,jj,jk) + zuav * ( zwz(ji  ,jj-1) + zwz(ji,jj) )
-               pva(ji,jj,jk) = pva(ji,jj,jk) + zvau * ( zwz(ji-1,jj  ) + zwz(ji,jj) )
-            END DO  
-         END DO  
+         DO_2D_00_00
+            zuav = r1_8 * r1_e1u(ji,jj) * (  zwy(ji  ,jj-1) + zwy(ji+1,jj-1)  &
+               &                           + zwy(ji  ,jj  ) + zwy(ji+1,jj  )  )
+            zvau =-r1_8 * r1_e2v(ji,jj) * (  zwx(ji-1,jj  ) + zwx(ji-1,jj+1)  &
+               &                           + zwx(ji  ,jj  ) + zwx(ji  ,jj+1)  )
+            pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zuav * ( zwz(ji  ,jj-1) + zwz(ji,jj) )
+            pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zvau * ( zwz(ji-1,jj  ) + zwz(ji,jj) )
+         END_2D
          !                                             ! ===============
       END DO                                           !   End of slab
@@ -537,5 +500,5 @@
 
 
-   SUBROUTINE vor_een( kt, kvor, pun, pvn, pua, pva )
+   SUBROUTINE vor_een( kt, Kmm, kvor, pu, pv, pu_rhs, pv_rhs )
       !!----------------------------------------------------------------------
       !!                ***  ROUTINE vor_een  ***
@@ -548,14 +511,15 @@
       !!      both the horizontal kinetic energy and the potential enstrophy
       !!      when horizontal divergence is zero (see the NEMO documentation)
-      !!      Add this trend to the general momentum trend (ua,va).
-      !!
-      !! ** Action : - Update (ua,va) with the now vorticity term trend
+      !!      Add this trend to the general momentum trend (pu_rhs,pv_rhs).
+      !!
+      !! ** Action : - Update (pu_rhs,pv_rhs) with the now vorticity term trend
       !!
       !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36
       !!----------------------------------------------------------------------
       INTEGER                         , INTENT(in   ) ::   kt          ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   Kmm              ! ocean time level index
       INTEGER                         , INTENT(in   ) ::   kvor        ! total, planetary, relative, or metric
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun, pvn    ! now velocities
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva    ! total v-trend
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv    ! now velocities
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs    ! total v-trend
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -580,63 +544,49 @@
          SELECT CASE( nn_een_e3f )           ! == reciprocal of e3 at F-point
          CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4)
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  ze3f = (  e3t_n(ji,jj+1,jk)*tmask(ji,jj+1,jk) + e3t_n(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   &
-                     &    + e3t_n(ji,jj  ,jk)*tmask(ji,jj  ,jk) + e3t_n(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk)  )
-                  IF( ze3f /= 0._wp ) THEN   ;   z1_e3f(ji,jj) = 4._wp / ze3f
-                  ELSE                       ;   z1_e3f(ji,jj) = 0._wp
-                  ENDIF
-               END DO
-            END DO
+            DO_2D_10_10
+               ze3f = (  e3t(ji,jj+1,jk,Kmm)*tmask(ji,jj+1,jk) + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk)   &
+                  &    + e3t(ji,jj  ,jk,Kmm)*tmask(ji,jj  ,jk) + e3t(ji+1,jj  ,jk,Kmm)*tmask(ji+1,jj  ,jk)  )
+               IF( ze3f /= 0._wp ) THEN   ;   z1_e3f(ji,jj) = 4._wp / ze3f
+               ELSE                       ;   z1_e3f(ji,jj) = 0._wp
+               ENDIF
+            END_2D
          CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask)
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  ze3f = (  e3t_n(ji,jj+1,jk)*tmask(ji,jj+1,jk) + e3t_n(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   &
-                     &    + e3t_n(ji,jj  ,jk)*tmask(ji,jj  ,jk) + e3t_n(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk)  )
-                  zmsk = (                    tmask(ji,jj+1,jk) +                     tmask(ji+1,jj+1,jk)   &
-                     &                      + tmask(ji,jj  ,jk) +                     tmask(ji+1,jj  ,jk)  )
-                  IF( ze3f /= 0._wp ) THEN   ;   z1_e3f(ji,jj) = zmsk / ze3f
-                  ELSE                       ;   z1_e3f(ji,jj) = 0._wp
-                  ENDIF
-               END DO
-            END DO
+            DO_2D_10_10
+               ze3f = (  e3t(ji,jj+1,jk,Kmm)*tmask(ji,jj+1,jk) + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk)   &
+                  &    + e3t(ji,jj  ,jk,Kmm)*tmask(ji,jj  ,jk) + e3t(ji+1,jj  ,jk,Kmm)*tmask(ji+1,jj  ,jk)  )
+               zmsk = (                    tmask(ji,jj+1,jk) +                     tmask(ji+1,jj+1,jk)   &
+                  &                      + tmask(ji,jj  ,jk) +                     tmask(ji+1,jj  ,jk)  )
+               IF( ze3f /= 0._wp ) THEN   ;   z1_e3f(ji,jj) = zmsk / ze3f
+               ELSE                       ;   z1_e3f(ji,jj) = 0._wp
+               ENDIF
+            END_2D
          END SELECT
          !
          SELECT CASE( kvor )                 !==  vorticity considered  ==!
          CASE ( np_COR )                           !* Coriolis (planetary vorticity)
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj,jk) = ff_f(ji,jj) * z1_e3f(ji,jj)
-               END DO
-            END DO
+            DO_2D_10_10
+               zwz(ji,jj,jk) = ff_f(ji,jj) * z1_e3f(ji,jj)
+            END_2D
          CASE ( np_RVO )                           !* relative vorticity
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj,jk) = ( e2v(ji+1,jj  ) * pvn(ji+1,jj,jk) - e2v(ji,jj) * pvn(ji,jj,jk)  &
-                     &            - e1u(ji  ,jj+1) * pun(ji,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  ) * r1_e1e2f(ji,jj)*z1_e3f(ji,jj)
-               END DO
-            END DO
+            DO_2D_10_10
+               zwz(ji,jj,jk) = ( e2v(ji+1,jj  ) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)  &
+                  &            - e1u(ji  ,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj)*z1_e3f(ji,jj)
+            END_2D
          CASE ( np_MET )                           !* metric term
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj,jk) = (   ( pvn(ji+1,jj,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
-                     &              - ( pun(ji,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)   ) * z1_e3f(ji,jj)
-               END DO
-            END DO
+            DO_2D_10_10
+               zwz(ji,jj,jk) = (   ( pv(ji+1,jj,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
+                  &              - ( pu(ji,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)   ) * z1_e3f(ji,jj)
+            END_2D
          CASE ( np_CRV )                           !* Coriolis + relative vorticity
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj,jk) = (  ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pvn(ji+1,jj,jk) - e2v(ji,jj) * pvn(ji,jj,jk)      &
-                     &                              - e1u(ji  ,jj+1) * pun(ji,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  )   &
-                     &                           * r1_e1e2f(ji,jj)   ) * z1_e3f(ji,jj)
-               END DO
-            END DO
+            DO_2D_10_10
+               zwz(ji,jj,jk) = (  ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)      &
+                  &                              - e1u(ji  ,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  )   &
+                  &                           * r1_e1e2f(ji,jj)   ) * z1_e3f(ji,jj)
+            END_2D
          CASE ( np_CME )                           !* Coriolis + metric
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj,jk) = (   ff_f(ji,jj) + ( pvn(ji+1,jj  ,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
-                     &                            - ( pun(ji  ,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)   ) * z1_e3f(ji,jj)
-               END DO
-            END DO
+            DO_2D_10_10
+               zwz(ji,jj,jk) = (   ff_f(ji,jj) + ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
+                  &                            - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)   ) * z1_e3f(ji,jj)
+            END_2D
          CASE DEFAULT                                             ! error
             CALL ctl_stop('STOP','dyn_vor: wrong value for kvor'  )
@@ -644,9 +594,7 @@
          !
          IF( ln_dynvor_msk ) THEN          !==  mask/unmask vorticity ==!
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk)
-               END DO
-            END DO
+            DO_2D_10_10
+               zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk)
+            END_2D
          ENDIF
       END DO                                           !   End of slab
@@ -657,6 +605,6 @@
          !
          !                                   !==  horizontal fluxes  ==!
-         zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk)
-         zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk)
+         zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk)
+         zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk)
 
          !                                   !==  compute and add the vorticity term trend  =!
@@ -670,5 +618,5 @@
          END DO
          DO jj = 3, jpj
-            DO ji = fs_2, jpi   ! vector opt. ok because we start at jj = 3
+            DO ji = 2, jpi   ! vector opt. ok because we start at jj = 3
                ztne(ji,jj) = zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk)
                ztnw(ji,jj) = zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk)
@@ -677,14 +625,12 @@
             END DO
          END DO
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zua = + r1_12 * r1_e1u(ji,jj) * (  ztne(ji,jj  ) * zwy(ji  ,jj  ) + ztnw(ji+1,jj) * zwy(ji+1,jj  )   &
-                  &                             + ztse(ji,jj  ) * zwy(ji  ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) )
-               zva = - r1_12 * r1_e2v(ji,jj) * (  ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji  ,jj+1)   &
-                  &                             + ztnw(ji,jj  ) * zwx(ji-1,jj  ) + ztne(ji,jj  ) * zwx(ji  ,jj  ) )
-               pua(ji,jj,jk) = pua(ji,jj,jk) + zua
-               pva(ji,jj,jk) = pva(ji,jj,jk) + zva
-            END DO  
-         END DO  
+         DO_2D_00_00
+            zua = + r1_12 * r1_e1u(ji,jj) * (  ztne(ji,jj  ) * zwy(ji  ,jj  ) + ztnw(ji+1,jj) * zwy(ji+1,jj  )   &
+               &                             + ztse(ji,jj  ) * zwy(ji  ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) )
+            zva = - r1_12 * r1_e2v(ji,jj) * (  ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji  ,jj+1)   &
+               &                             + ztnw(ji,jj  ) * zwx(ji-1,jj  ) + ztne(ji,jj  ) * zwx(ji  ,jj  ) )
+            pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zua
+            pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zva
+         END_2D
          !                                             ! ===============
       END DO                                           !   End of slab
@@ -694,5 +640,5 @@
 
 
-   SUBROUTINE vor_eeT( kt, kvor, pun, pvn, pua, pva )
+   SUBROUTINE vor_eeT( kt, Kmm, kvor, pu, pv, pu_rhs, pv_rhs )
       !!----------------------------------------------------------------------
       !!                ***  ROUTINE vor_eeT  ***
@@ -705,14 +651,15 @@
       !!      a modified version of Arakawa and Lamb (1980) scheme (see vor_een).
       !!      The change consists in 
-      !!      Add this trend to the general momentum trend (ua,va).
-      !!
-      !! ** Action : - Update (ua,va) with the now vorticity term trend
+      !!      Add this trend to the general momentum trend (pu_rhs,pv_rhs).
+      !!
+      !! ** Action : - Update (pu_rhs,pv_rhs) with the now vorticity term trend
       !!
       !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36
       !!----------------------------------------------------------------------
       INTEGER                         , INTENT(in   ) ::   kt          ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   Kmm              ! ocean time level index
       INTEGER                         , INTENT(in   ) ::   kvor        ! total, planetary, relative, or metric
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun, pvn    ! now velocities
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva    ! total v-trend
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv    ! now velocities
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs    ! total v-trend
       !
       INTEGER  ::   ji, jj, jk     ! dummy loop indices
@@ -738,39 +685,29 @@
          SELECT CASE( kvor )                 !==  vorticity considered  ==!
          CASE ( np_COR )                           !* Coriolis (planetary vorticity)
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj,jk) = ff_f(ji,jj)
-               END DO
-            END DO
+            DO_2D_10_10
+               zwz(ji,jj,jk) = ff_f(ji,jj)
+            END_2D
          CASE ( np_RVO )                           !* relative vorticity
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj,jk) = (  e2v(ji+1,jj  ) * pvn(ji+1,jj  ,jk) - e2v(ji,jj) * pvn(ji,jj,jk)    &
-                     &             - e1u(ji  ,jj+1) * pun(ji  ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  ) &
-                     &          * r1_e1e2f(ji,jj)
-               END DO
-            END DO
+            DO_2D_10_10
+               zwz(ji,jj,jk) = (  e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk)    &
+                  &             - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) &
+                  &          * r1_e1e2f(ji,jj)
+            END_2D
          CASE ( np_MET )                           !* metric term
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj,jk) = ( pvn(ji+1,jj  ,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
-                     &          - ( pun(ji  ,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
-               END DO
-            END DO
+            DO_2D_10_10
+               zwz(ji,jj,jk) = ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
+                  &          - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
+            END_2D
          CASE ( np_CRV )                           !* Coriolis + relative vorticity
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj,jk) = (  ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pvn(ji+1,jj  ,jk) - e2v(ji,jj) * pvn(ji,jj,jk)    &
-                     &                              - e1u(ji  ,jj+1) * pun(ji  ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  ) &
-                     &                         * r1_e1e2f(ji,jj)    )
-               END DO
-            END DO
+            DO_2D_10_10
+               zwz(ji,jj,jk) = (  ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk)    &
+                  &                              - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) &
+                  &                         * r1_e1e2f(ji,jj)    )
+            END_2D
          CASE ( np_CME )                           !* Coriolis + metric
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj,jk) = ff_f(ji,jj) + ( pvn(ji+1,jj  ,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
-                     &                        - ( pun(ji  ,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
-               END DO
-            END DO
+            DO_2D_10_10
+               zwz(ji,jj,jk) = ff_f(ji,jj) + ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
+                  &                        - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
+            END_2D
          CASE DEFAULT                                             ! error
             CALL ctl_stop('STOP','dyn_vor: wrong value for kvor'  )
@@ -778,9 +715,7 @@
          !
          IF( ln_dynvor_msk ) THEN          !==  mask/unmask vorticity ==!
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk)
-               END DO
-            END DO
+            DO_2D_10_10
+               zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk)
+            END_2D
          ENDIF
       END DO
@@ -791,6 +726,6 @@
 
       !                                   !==  horizontal fluxes  ==!
-         zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk)
-         zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk)
+         zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk)
+         zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk)
 
          !                                   !==  compute and add the vorticity term trend  =!
@@ -798,5 +733,5 @@
          ztne(1,:) = 0   ;   ztnw(1,:) = 0   ;   ztse(1,:) = 0   ;   ztsw(1,:) = 0
          DO ji = 2, jpi          ! split in 2 parts due to vector opt.
-               z1_e3t = 1._wp / e3t_n(ji,jj,jk)
+               z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm)
                ztne(ji,jj) = ( zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) ) * z1_e3t
                ztnw(ji,jj) = ( zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) ) * z1_e3t
@@ -805,6 +740,6 @@
          END DO
          DO jj = 3, jpj
-            DO ji = fs_2, jpi   ! vector opt. ok because we start at jj = 3
-               z1_e3t = 1._wp / e3t_n(ji,jj,jk)
+            DO ji = 2, jpi   ! vector opt. ok because we start at jj = 3
+               z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm)
                ztne(ji,jj) = ( zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) ) * z1_e3t
                ztnw(ji,jj) = ( zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) ) * z1_e3t
@@ -813,14 +748,12 @@
             END DO
          END DO
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zua = + r1_12 * r1_e1u(ji,jj) * (  ztne(ji,jj  ) * zwy(ji  ,jj  ) + ztnw(ji+1,jj) * zwy(ji+1,jj  )   &
-                  &                             + ztse(ji,jj  ) * zwy(ji  ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) )
-               zva = - r1_12 * r1_e2v(ji,jj) * (  ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji  ,jj+1)   &
-                  &                             + ztnw(ji,jj  ) * zwx(ji-1,jj  ) + ztne(ji,jj  ) * zwx(ji  ,jj  ) )
-               pua(ji,jj,jk) = pua(ji,jj,jk) + zua
-               pva(ji,jj,jk) = pva(ji,jj,jk) + zva
-            END DO  
-         END DO  
+         DO_2D_00_00
+            zua = + r1_12 * r1_e1u(ji,jj) * (  ztne(ji,jj  ) * zwy(ji  ,jj  ) + ztnw(ji+1,jj) * zwy(ji+1,jj  )   &
+               &                             + ztse(ji,jj  ) * zwy(ji  ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) )
+            zva = - r1_12 * r1_e2v(ji,jj) * (  ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji  ,jj+1)   &
+               &                             + ztnw(ji,jj  ) * zwx(ji-1,jj  ) + ztne(ji,jj  ) * zwx(ji  ,jj  ) )
+            pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zua
+            pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zva
+         END_2D
          !                                             ! ===============
       END DO                                           !   End of slab
@@ -849,8 +782,6 @@
       ENDIF
       !
-      REWIND( numnam_ref )              ! Namelist namdyn_vor in reference namelist : Vorticity scheme options
       READ  ( numnam_ref, namdyn_vor, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_vor in reference namelist' )
-      REWIND( numnam_cfg )              ! Namelist namdyn_vor in configuration namelist : Vorticity scheme options
       READ  ( numnam_cfg, namdyn_vor, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_vor in configuration namelist' )
@@ -877,12 +808,8 @@
       IF(lwp) WRITE(numout,*) '      change fmask value in the angles (T)           ln_vorlat = ', ln_vorlat
       IF( ln_vorlat .AND. ( ln_dynvor_ene .OR. ln_dynvor_ens .OR. ln_dynvor_mix ) ) THEN
-         DO jk = 1, jpk
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  IF(    tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk)              &
-                     & + tmask(ji,jj  ,jk) + tmask(ji+1,jj+1,jk) == 3._wp )   fmask(ji,jj,jk) = 1._wp
-               END DO
-            END DO
-         END DO
+         DO_3D_10_10( 1, jpk )
+            IF(    tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk)              &
+               & + tmask(ji,jj  ,jk) + tmask(ji+1,jj  ,jk) == 3._wp )   fmask(ji,jj,jk) = 1._wp
+         END_3D
          !
          CALL lbc_lnk( 'dynvor', fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask
@@ -920,20 +847,16 @@
          CASE( np_ENT )                      !* T-point metric term :   pre-compute di(e2u)/2 and dj(e1v)/2
             ALLOCATE( di_e2u_2(jpi,jpj), dj_e1v_2(jpi,jpj) )
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  di_e2u_2(ji,jj) = ( e2u(ji,jj) - e2u(ji-1,jj  ) ) * 0.5_wp
-                  dj_e1v_2(ji,jj) = ( e1v(ji,jj) - e1v(ji  ,jj-1) ) * 0.5_wp
-               END DO
-            END DO
+            DO_2D_00_00
+               di_e2u_2(ji,jj) = ( e2u(ji,jj) - e2u(ji-1,jj  ) ) * 0.5_wp
+               dj_e1v_2(ji,jj) = ( e1v(ji,jj) - e1v(ji  ,jj-1) ) * 0.5_wp
+            END_2D
             CALL lbc_lnk_multi( 'dynvor', di_e2u_2, 'T', -1. , dj_e1v_2, 'T', -1. )   ! Lateral boundary conditions
             !
          CASE DEFAULT                        !* F-point metric term :   pre-compute di(e2u)/(2*e1e2f) and dj(e1v)/(2*e1e2f)
             ALLOCATE( di_e2v_2e1e2f(jpi,jpj), dj_e1u_2e1e2f(jpi,jpj) )
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  di_e2v_2e1e2f(ji,jj) = ( e2v(ji+1,jj  ) - e2v(ji,jj) )  * 0.5 * r1_e1e2f(ji,jj)
-                  dj_e1u_2e1e2f(ji,jj) = ( e1u(ji  ,jj+1) - e1u(ji,jj) )  * 0.5 * r1_e1e2f(ji,jj)
-               END DO
-            END DO
+            DO_2D_10_10
+               di_e2v_2e1e2f(ji,jj) = ( e2v(ji+1,jj  ) - e2v(ji,jj) )  * 0.5 * r1_e1e2f(ji,jj)
+               dj_e1u_2e1e2f(ji,jj) = ( e1u(ji  ,jj+1) - e1u(ji,jj) )  * 0.5 * r1_e1e2f(ji,jj)
+            END_2D
             CALL lbc_lnk_multi( 'dynvor', di_e2v_2e1e2f, 'F', -1. , dj_e1u_2e1e2f, 'F', -1. )   ! Lateral boundary conditions
          END SELECT
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynzad.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynzad.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynzad.F90	(revision 12928)
@@ -28,5 +28,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -36,5 +36,5 @@
 CONTAINS
 
-   SUBROUTINE dyn_zad ( kt )
+   SUBROUTINE dyn_zad ( kt, Kmm, puu, pvv, Krhs )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dynzad  ***
@@ -44,13 +44,15 @@
       !!
       !! ** Method  :   The now vertical advection of momentum is given by:
-      !!         w dz(u) = ua + 1/(e1e2u*e3u) mk+1[ mi(e1e2t*wn) dk(un) ]
-      !!         w dz(v) = va + 1/(e1e2v*e3v) mk+1[ mj(e1e2t*wn) dk(vn) ]
-      !!      Add this trend to the general trend (ua,va):
-      !!         (ua,va) = (ua,va) + w dz(u,v)
+      !!         w dz(u) = u(rhs) + 1/(e1e2u*e3u) mk+1[ mi(e1e2t*ww) dk(u) ]
+      !!         w dz(v) = v(rhs) + 1/(e1e2v*e3v) mk+1[ mj(e1e2t*ww) dk(v) ]
+      !!      Add this trend to the general trend (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)):
+      !!         (u(rhs),v(rhs)) = (u(rhs),v(rhs)) + w dz(u,v)
       !!
-      !! ** Action  : - Update (ua,va) with the vert. momentum adv. trends
+      !! ** Action  : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the vert. momentum adv. trends
       !!              - Send the trends to trddyn for diagnostics (l_trddyn=T)
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step inedx
+      INTEGER                             , INTENT( in )  ::  kt               ! ocean time-step inedx
+      INTEGER                             , INTENT( in )  ::  Kmm, Krhs        ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv         ! ocean velocities and RHS of momentum equation
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -68,52 +70,42 @@
       ENDIF
 
-      IF( l_trddyn )   THEN         ! Save ua and va trends
+      IF( l_trddyn )   THEN         ! Save puu(:,:,:,Krhs) and pvv(:,:,:,Krhs) trends
          ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 
-         ztrdu(:,:,:) = ua(:,:,:) 
-         ztrdv(:,:,:) = va(:,:,:) 
+         ztrdu(:,:,:) = puu(:,:,:,Krhs) 
+         ztrdv(:,:,:) = pvv(:,:,:,Krhs) 
       ENDIF
       
       DO jk = 2, jpkm1              ! Vertical momentum advection at level w and u- and v- vertical
-         DO jj = 2, jpj                   ! vertical fluxes 
-            DO ji = fs_2, jpi             ! vector opt.
-               zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk)
-            END DO
-         END DO
-         DO jj = 2, jpjm1                 ! vertical momentum advection at w-point
-            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   
+         DO_2D_01_01
+            zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk)
+         END_2D
+         DO_2D_00_00
+            zwuw(ji,jj,jk) = ( zww(ji+1,jj  ) + zww(ji,jj) ) * ( puu(ji,jj,jk-1,Kmm) - puu(ji,jj,jk,Kmm) )
+            zwvw(ji,jj,jk) = ( zww(ji  ,jj+1) + zww(ji,jj) ) * ( pvv(ji,jj,jk-1,Kmm) - pvv(ji,jj,jk,Kmm) )
+         END_2D
       END DO
       !
       ! Surface and bottom advective fluxes set to zero
-      DO jj = 2, jpjm1        
-         DO ji = fs_2, fs_jpim1           ! vector opt.
-            zwuw(ji,jj, 1 ) = 0._wp
-            zwvw(ji,jj, 1 ) = 0._wp
-            zwuw(ji,jj,jpk) = 0._wp
-            zwvw(ji,jj,jpk) = 0._wp
-         END DO  
-      END DO
+      DO_2D_00_00
+         zwuw(ji,jj, 1 ) = 0._wp
+         zwvw(ji,jj, 1 ) = 0._wp
+         zwuw(ji,jj,jpk) = 0._wp
+         zwvw(ji,jj,jpk) = 0._wp
+      END_2D
       !
-      DO jk = 1, jpkm1              ! Vertical momentum advection at u- and v-points
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1       ! vector opt.
-               ua(ji,jj,jk) = ua(ji,jj,jk) - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
-               va(ji,jj,jk) = va(ji,jj,jk) - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
-            END DO  
-         END DO  
-      END DO
+      DO_3D_00_00( 1, jpkm1 )
+         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm)
+         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm)
+      END_3D
 
       IF( l_trddyn ) THEN           ! save the vertical advection trends for diagnostic
-         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
-         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
-         CALL trd_dyn( ztrdu, ztrdv, jpdyn_zad, kt )
+         ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:)
+         ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:)
+         CALL trd_dyn( ztrdu, ztrdv, jpdyn_zad, kt, Kmm )
          DEALLOCATE( ztrdu, ztrdv ) 
       ENDIF
       !                             ! Control print
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' zad  - Ua: ', mask1=umask,   &
-         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' zad  - Ua: ', mask1=umask,   &
+         &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
       !
       IF( ln_timing )   CALL timing_stop('dyn_zad')
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynzdf.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynzdf.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynzdf.F90	(revision 12928)
@@ -37,5 +37,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -45,5 +45,5 @@
 CONTAINS
    
-   SUBROUTINE dyn_zdf( kt )
+   SUBROUTINE dyn_zdf( kt, Kbb, Kmm, Krhs, puu, pvv, Kaa )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dyn_zdf  ***
@@ -54,16 +54,18 @@
       !!
       !! ** Method  :  - Leap-Frog time stepping on all trends but the vertical mixing
-      !!         ua =         ub + 2*dt *       ua             vector form or linear free surf.
-      !!         ua = ( e3u_b*ub + 2*dt * e3u_n*ua ) / e3u_a   otherwise
+      !!         u(after) =         u(before) + 2*dt *       u(rhs)                vector form or linear free surf.
+      !!         u(after) = ( e3u_b*u(before) + 2*dt * e3u_n*u(rhs) ) / e3u(after)   otherwise
       !!               - update the after velocity with the implicit vertical mixing.
       !!      This requires to solver the following system: 
-      !!         ua = ua + 1/e3u_a dk+1[ mi(avm) / e3uw_a dk[ua] ]
+      !!         u(after) = u(after) + 1/e3u(after) dk+1[ mi(avm) / e3uw(after) dk[ua] ]
       !!      with the following surface/top/bottom boundary condition:
       !!      surface: wind stress input (averaged over kt-1/2 & kt+1/2)
       !!      top & bottom : top stress (iceshelf-ocean) & bottom stress (cf zdfdrg.F90)
       !!
-      !! ** Action :   (ua,va)   after velocity 
+      !! ** Action :   (puu(:,:,:,Kaa),pvv(:,:,:,Kaa))   after velocity 
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  kt                  ! ocean time-step index
+      INTEGER                             , INTENT( in )  ::  Kbb, Kmm, Krhs, Kaa ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv            ! ocean velocities and RHS of momentum equation
       !
       INTEGER  ::   ji, jj, jk         ! dummy loop indices
@@ -90,33 +92,28 @@
          ENDIF
       ENDIF
-      !                             !* set time step
-      IF( neuler == 0 .AND. kt == nit000     ) THEN   ;   r2dt =      rdt   ! = rdt (restart with Euler time stepping)
-      ELSEIF(               kt <= nit000 + 1 ) THEN   ;   r2dt = 2. * rdt   ! = 2 rdt (leapfrog)
-      ENDIF
-      !
       !                             !* explicit top/bottom drag case
-      IF( .NOT.ln_drgimp )   CALL zdf_drg_exp( kt, ub, vb, ua, va )  ! add top/bottom friction trend to (ua,va)
+      IF( .NOT.ln_drgimp )   CALL zdf_drg_exp( kt, Kmm, puu(:,:,:,Kbb), pvv(:,:,:,Kbb), puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! add top/bottom friction trend to (puu(Kaa),pvv(Kaa))
       !
       !
       IF( l_trddyn )   THEN         !* temporary save of ta and sa trends
          ALLOCATE( ztrdu(jpi,jpj,jpk), ztrdv(jpi,jpj,jpk) ) 
-         ztrdu(:,:,:) = ua(:,:,:)
-         ztrdv(:,:,:) = va(:,:,:)
-      ENDIF
-      !
-      !              !==  RHS: Leap-Frog time stepping on all trends but the vertical mixing  ==!   (put in ua,va)
+         ztrdu(:,:,:) = puu(:,:,:,Krhs)
+         ztrdv(:,:,:) = pvv(:,:,:,Krhs)
+      ENDIF
+      !
+      !              !==  RHS: Leap-Frog time stepping on all trends but the vertical mixing  ==!   (put in puu(:,:,:,Kaa),pvv(:,:,:,Kaa))
       !
       !                    ! time stepping except vertical diffusion
       IF( ln_dynadv_vec .OR. ln_linssh ) THEN   ! applied on velocity
          DO jk = 1, jpkm1
-            ua(:,:,jk) = ( ub(:,:,jk) + r2dt * ua(:,:,jk) ) * umask(:,:,jk)
-            va(:,:,jk) = ( vb(:,:,jk) + r2dt * va(:,:,jk) ) * vmask(:,:,jk)
+            puu(:,:,jk,Kaa) = ( puu(:,:,jk,Kbb) + rDt * puu(:,:,jk,Krhs) ) * umask(:,:,jk)
+            pvv(:,:,jk,Kaa) = ( pvv(:,:,jk,Kbb) + rDt * pvv(:,:,jk,Krhs) ) * vmask(:,:,jk)
          END DO
       ELSE                                      ! applied on thickness weighted velocity
          DO jk = 1, jpkm1
-            ua(:,:,jk) = (         e3u_b(:,:,jk) * ub(:,:,jk)  &
-               &          + r2dt * e3u_n(:,:,jk) * ua(:,:,jk)  ) / e3u_a(:,:,jk) * umask(:,:,jk)
-            va(:,:,jk) = (         e3v_b(:,:,jk) * vb(:,:,jk)  &
-               &          + r2dt * e3v_n(:,:,jk) * va(:,:,jk)  ) / e3v_a(:,:,jk) * vmask(:,:,jk)
+            puu(:,:,jk,Kaa) = (         e3u(:,:,jk,Kbb) * puu(:,:,jk,Kbb)  &
+               &          + rDt * e3u(:,:,jk,Kmm) * puu(:,:,jk,Krhs)  ) / e3u(:,:,jk,Kaa) * umask(:,:,jk)
+            pvv(:,:,jk,Kaa) = (         e3v(:,:,jk,Kbb) * pvv(:,:,jk,Kbb)  &
+               &          + rDt * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Krhs)  ) / e3v(:,:,jk,Kaa) * vmask(:,:,jk)
          END DO
       ENDIF
@@ -125,31 +122,27 @@
       !     J. Chanut: The bottom stress is computed considering after barotropic velocities, which does 
       !                not lead to the effective stress seen over the whole barotropic loop. 
-      !     G. Madec : in linear free surface, e3u_a = e3u_n = e3u_0, so systematic use of e3u_a
+      !     G. Madec : in linear free surface, e3u(:,:,:,Kaa) = e3u(:,:,:,Kmm) = e3u_0, so systematic use of e3u(:,:,:,Kaa)
       IF( ln_drgimp .AND. ln_dynspg_ts ) THEN
          DO jk = 1, jpkm1        ! remove barotropic velocities
-            ua(:,:,jk) = ( ua(:,:,jk) - ua_b(:,:) ) * umask(:,:,jk)
-            va(:,:,jk) = ( va(:,:,jk) - va_b(:,:) ) * vmask(:,:,jk)
+            puu(:,:,jk,Kaa) = ( puu(:,:,jk,Kaa) - uu_b(:,:,Kaa) ) * umask(:,:,jk)
+            pvv(:,:,jk,Kaa) = ( pvv(:,:,jk,Kaa) - vv_b(:,:,Kaa) ) * vmask(:,:,jk)
          END DO
-         DO jj = 2, jpjm1        ! Add bottom/top stress due to barotropic component only
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               iku = mbku(ji,jj)         ! ocean bottom level at u- and v-points 
-               ikv = mbkv(ji,jj)         ! (deepest ocean u- and v-points)
-               ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku)
-               ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv)
-               ua(ji,jj,iku) = ua(ji,jj,iku) + r2dt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * ua_b(ji,jj) / ze3ua
-               va(ji,jj,ikv) = va(ji,jj,ikv) + r2dt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * va_b(ji,jj) / ze3va
-            END DO
-         END DO
+         DO_2D_00_00
+            iku = mbku(ji,jj)         ! ocean bottom level at u- and v-points 
+            ikv = mbkv(ji,jj)         ! (deepest ocean u- and v-points)
+            ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,iku,Kmm) + r_vvl * e3u(ji,jj,iku,Kaa)
+            ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm) + r_vvl * e3v(ji,jj,ikv,Kaa)
+            puu(ji,jj,iku,Kaa) = puu(ji,jj,iku,Kaa) + rDt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * uu_b(ji,jj,Kaa) / ze3ua
+            pvv(ji,jj,ikv,Kaa) = pvv(ji,jj,ikv,Kaa) + rDt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * vv_b(ji,jj,Kaa) / ze3va
+         END_2D
          IF( ln_isfcav ) THEN    ! Ocean cavities (ISF)
-            DO jj = 2, jpjm1        
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  iku = miku(ji,jj)         ! top ocean level at u- and v-points 
-                  ikv = mikv(ji,jj)         ! (first wet ocean u- and v-points)
-                  ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku)
-                  ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv)
-                  ua(ji,jj,iku) = ua(ji,jj,iku) + r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * ua_b(ji,jj) / ze3ua
-                  va(ji,jj,ikv) = va(ji,jj,ikv) + r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * va_b(ji,jj) / ze3va
-               END DO
-            END DO
+            DO_2D_00_00
+               iku = miku(ji,jj)         ! top ocean level at u- and v-points 
+               ikv = mikv(ji,jj)         ! (first wet ocean u- and v-points)
+               ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,iku,Kmm) + r_vvl * e3u(ji,jj,iku,Kaa)
+               ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm) + r_vvl * e3v(ji,jj,ikv,Kaa)
+               puu(ji,jj,iku,Kaa) = puu(ji,jj,iku,Kaa) + rDt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * uu_b(ji,jj,Kaa) / ze3ua
+               pvv(ji,jj,ikv,Kaa) = pvv(ji,jj,ikv,Kaa) + rDt * 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * vv_b(ji,jj,Kaa) / ze3va
+            END_2D
          END IF
       ENDIF
@@ -158,87 +151,67 @@
       !
       !                    !* Matrix construction
-      zdt = r2dt * 0.5
+      zdt = rDt * 0.5
       IF( ln_zad_Aimp ) THEN   !!
          SELECT CASE( nldf_dyn )
          CASE( np_lap_i )           ! rotated lateral mixing: add its vertical mixing (akzu)
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1 
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at U-point
-                     zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) + akzu(ji,jj,jk  ) )   &
-                        &         / ( ze3ua * e3uw_n(ji,jj,jk  ) ) * wumask(ji,jj,jk  )
-                     zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) + akzu(ji,jj,jk+1) )   &
-                        &         / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1)
-                     zWui = ( wi(ji,jj,jk  ) + wi(ji+1,jj,jk  ) ) / ze3ua
-                     zWus = ( wi(ji,jj,jk+1) + wi(ji+1,jj,jk+1) ) / ze3ua
-                     zwi(ji,jj,jk) = zzwi + zdt * MIN( zWui, 0._wp ) 
-                     zws(ji,jj,jk) = zzws - zdt * MAX( zWus, 0._wp )
-                     zwd(ji,jj,jk) = 1._wp - zzwi - zzws + zdt * ( MAX( zWui, 0._wp ) - MIN( zWus, 0._wp ) )
-                  END DO
-               END DO
-            END DO
+            DO_3D_00_00( 1, jpkm1 )
+               ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) + r_vvl * e3u(ji,jj,jk,Kaa)   ! after scale factor at U-point
+               zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) + akzu(ji,jj,jk  ) )   &
+                  &         / ( ze3ua * e3uw(ji,jj,jk  ,Kmm) ) * wumask(ji,jj,jk  )
+               zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) + akzu(ji,jj,jk+1) )   &
+                  &         / ( ze3ua * e3uw(ji,jj,jk+1,Kmm) ) * wumask(ji,jj,jk+1)
+               zWui = ( wi(ji,jj,jk  ) + wi(ji+1,jj,jk  ) ) / ze3ua
+               zWus = ( wi(ji,jj,jk+1) + wi(ji+1,jj,jk+1) ) / ze3ua
+               zwi(ji,jj,jk) = zzwi + zdt * MIN( zWui, 0._wp ) 
+               zws(ji,jj,jk) = zzws - zdt * MAX( zWus, 0._wp )
+               zwd(ji,jj,jk) = 1._wp - zzwi - zzws + zdt * ( MAX( zWui, 0._wp ) - MIN( zWus, 0._wp ) )
+            END_3D
          CASE DEFAULT               ! iso-level lateral mixing
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1 
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at U-point
-                     zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) ) / ( ze3ua * e3uw_n(ji,jj,jk  ) ) * wumask(ji,jj,jk  )
-                     zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1)
-                     zWui = ( wi(ji,jj,jk  ) + wi(ji+1,jj,jk  ) ) / ze3ua
-                     zWus = ( wi(ji,jj,jk+1) + wi(ji+1,jj,jk+1) ) / ze3ua
-                     zwi(ji,jj,jk) = zzwi + zdt * MIN( zWui, 0._wp )
-                     zws(ji,jj,jk) = zzws - zdt * MAX( zWus, 0._wp )
-                     zwd(ji,jj,jk) = 1._wp - zzwi - zzws + zdt * ( MAX( zWui, 0._wp ) - MIN( zWus, 0._wp ) )
-                  END DO
-               END DO
-            END DO
+            DO_3D_00_00( 1, jpkm1 )
+               ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) + r_vvl * e3u(ji,jj,jk,Kaa)   ! after scale factor at U-point
+               zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) ) / ( ze3ua * e3uw(ji,jj,jk  ,Kmm) ) * wumask(ji,jj,jk  )
+               zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) / ( ze3ua * e3uw(ji,jj,jk+1,Kmm) ) * wumask(ji,jj,jk+1)
+               zWui = ( wi(ji,jj,jk  ) + wi(ji+1,jj,jk  ) ) / ze3ua
+               zWus = ( wi(ji,jj,jk+1) + wi(ji+1,jj,jk+1) ) / ze3ua
+               zwi(ji,jj,jk) = zzwi + zdt * MIN( zWui, 0._wp )
+               zws(ji,jj,jk) = zzws - zdt * MAX( zWus, 0._wp )
+               zwd(ji,jj,jk) = 1._wp - zzwi - zzws + zdt * ( MAX( zWui, 0._wp ) - MIN( zWus, 0._wp ) )
+            END_3D
          END SELECT
-         DO jj = 2, jpjm1     !* Surface boundary conditions
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zwi(ji,jj,1) = 0._wp
-               ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,1) + r_vvl * e3u_a(ji,jj,1)
-               zzws = - zdt * ( avm(ji+1,jj,2) + avm(ji  ,jj,2) ) / ( ze3ua * e3uw_n(ji,jj,2) ) * wumask(ji,jj,2)
-               zWus = ( wi(ji  ,jj,2) +  wi(ji+1,jj,2) ) / ze3ua
-               zws(ji,jj,1 ) = zzws - zdt * MAX( zWus, 0._wp )
-               zwd(ji,jj,1 ) = 1._wp - zzws - zdt * ( MIN( zWus, 0._wp ) )
-            END DO
-         END DO
+         DO_2D_00_00
+            zwi(ji,jj,1) = 0._wp
+            ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,1,Kmm) + r_vvl * e3u(ji,jj,1,Kaa)
+            zzws = - zdt * ( avm(ji+1,jj,2) + avm(ji  ,jj,2) ) / ( ze3ua * e3uw(ji,jj,2,Kmm) ) * wumask(ji,jj,2)
+            zWus = ( wi(ji  ,jj,2) +  wi(ji+1,jj,2) ) / ze3ua
+            zws(ji,jj,1 ) = zzws - zdt * MAX( zWus, 0._wp )
+            zwd(ji,jj,1 ) = 1._wp - zzws - zdt * ( MIN( zWus, 0._wp ) )
+         END_2D
       ELSE
          SELECT CASE( nldf_dyn )
          CASE( np_lap_i )           ! rotated lateral mixing: add its vertical mixing (akzu)
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1 
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at U-point
-                     zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) + akzu(ji,jj,jk  ) )   &
-                        &         / ( ze3ua * e3uw_n(ji,jj,jk  ) ) * wumask(ji,jj,jk  )
-                     zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) + akzu(ji,jj,jk+1) )   &
-                        &         / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1)
-                     zwi(ji,jj,jk) = zzwi
-                     zws(ji,jj,jk) = zzws
-                     zwd(ji,jj,jk) = 1._wp - zzwi - zzws
-                  END DO
-               END DO
-            END DO
+            DO_3D_00_00( 1, jpkm1 )
+               ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) + r_vvl * e3u(ji,jj,jk,Kaa)   ! after scale factor at U-point
+               zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) + akzu(ji,jj,jk  ) )   &
+                  &         / ( ze3ua * e3uw(ji,jj,jk  ,Kmm) ) * wumask(ji,jj,jk  )
+               zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) + akzu(ji,jj,jk+1) )   &
+                  &         / ( ze3ua * e3uw(ji,jj,jk+1,Kmm) ) * wumask(ji,jj,jk+1)
+               zwi(ji,jj,jk) = zzwi
+               zws(ji,jj,jk) = zzws
+               zwd(ji,jj,jk) = 1._wp - zzwi - zzws
+            END_3D
          CASE DEFAULT               ! iso-level lateral mixing
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1 
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at U-point
-                     zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) ) / ( ze3ua * e3uw_n(ji,jj,jk  ) ) * wumask(ji,jj,jk  )
-                     zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1)
-                     zwi(ji,jj,jk) = zzwi
-                     zws(ji,jj,jk) = zzws
-                     zwd(ji,jj,jk) = 1._wp - zzwi - zzws
-                  END DO
-               END DO
-            END DO
+            DO_3D_00_00( 1, jpkm1 )
+               ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) + r_vvl * e3u(ji,jj,jk,Kaa)   ! after scale factor at U-point
+               zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) ) / ( ze3ua * e3uw(ji,jj,jk  ,Kmm) ) * wumask(ji,jj,jk  )
+               zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) / ( ze3ua * e3uw(ji,jj,jk+1,Kmm) ) * wumask(ji,jj,jk+1)
+               zwi(ji,jj,jk) = zzwi
+               zws(ji,jj,jk) = zzws
+               zwd(ji,jj,jk) = 1._wp - zzwi - zzws
+            END_3D
          END SELECT
-         DO jj = 2, jpjm1     !* Surface boundary conditions
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zwi(ji,jj,1) = 0._wp
-               zwd(ji,jj,1) = 1._wp - zws(ji,jj,1)
-            END DO
-         END DO
+         DO_2D_00_00
+            zwi(ji,jj,1) = 0._wp
+            zwd(ji,jj,1) = 1._wp - zws(ji,jj,1)
+         END_2D
       ENDIF
       !
@@ -251,20 +224,16 @@
       !
       IF ( ln_drgimp ) THEN      ! implicit bottom friction
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               iku = mbku(ji,jj)       ! ocean bottom level at u- and v-points
-               ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku)   ! after scale factor at T-point
-               zwd(ji,jj,iku) = zwd(ji,jj,iku) - r2dt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / ze3ua
-            END DO
-         END DO
+         DO_2D_00_00
+            iku = mbku(ji,jj)       ! ocean bottom level at u- and v-points
+            ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,iku,Kmm) + r_vvl * e3u(ji,jj,iku,Kaa)   ! after scale factor at T-point
+            zwd(ji,jj,iku) = zwd(ji,jj,iku) - rDt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / ze3ua
+         END_2D
          IF ( ln_isfcav ) THEN   ! top friction (always implicit)
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  !!gm   top Cd is masked (=0 outside cavities) no need of test on mik>=2  ==>> it has been suppressed
-                  iku = miku(ji,jj)       ! ocean top level at u- and v-points 
-                  ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku)   ! after scale factor at T-point
-                  zwd(ji,jj,iku) = zwd(ji,jj,iku) - r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / ze3ua
-               END DO
-            END DO
+            DO_2D_00_00
+               !!gm   top Cd is masked (=0 outside cavities) no need of test on mik>=2  ==>> it has been suppressed
+               iku = miku(ji,jj)       ! ocean top level at u- and v-points 
+               ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,iku,Kmm) + r_vvl * e3u(ji,jj,iku,Kaa)   ! after scale factor at T-point
+               zwd(ji,jj,iku) = zwd(ji,jj,iku) - rDt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / ze3ua
+            END_2D
          END IF
       ENDIF
@@ -282,129 +251,93 @@
       !   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
+      !   The solution (the after velocity) is in puu(:,:,:,Kaa)
       !-----------------------------------------------------------------------
       !
-      DO jk = 2, jpkm1        !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  ==
-         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
-      !
-      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==!
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,1) + r_vvl * e3u_a(ji,jj,1) 
-            ua(ji,jj,1) = ua(ji,jj,1) + r2dt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   &
-               &                                      / ( ze3ua * rau0 ) * umask(ji,jj,1) 
-         END DO
-      END DO
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               ua(ji,jj,jk) = ua(ji,jj,jk) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * ua(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-      !
-      DO jj = 2, jpjm1        !==  thrid recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk  ==!
-         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
-               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
+      DO_3D_00_00( 2, jpkm1 )
+         zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1)
+      END_3D
+      !
+      DO_2D_00_00
+         ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,1,Kmm) + r_vvl * e3u(ji,jj,1,Kaa) 
+         puu(ji,jj,1,Kaa) = puu(ji,jj,1,Kaa) + rDt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   &
+            &                                      / ( ze3ua * rho0 ) * umask(ji,jj,1) 
+      END_2D
+      DO_3D_00_00( 2, jpkm1 )
+         puu(ji,jj,jk,Kaa) = puu(ji,jj,jk,Kaa) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * puu(ji,jj,jk-1,Kaa)
+      END_3D
+      !
+      DO_2D_00_00
+         puu(ji,jj,jpkm1,Kaa) = puu(ji,jj,jpkm1,Kaa) / zwd(ji,jj,jpkm1)
+      END_2D
+      DO_3DS_00_00( jpk-2, 1, -1 )
+         puu(ji,jj,jk,Kaa) = ( puu(ji,jj,jk,Kaa) - zws(ji,jj,jk) * puu(ji,jj,jk+1,Kaa) ) / zwd(ji,jj,jk)
+      END_3D
       !
       !              !==  Vertical diffusion on v  ==!
       !
       !                       !* Matrix construction
-      zdt = r2dt * 0.5
+      zdt = rDt * 0.5
       IF( ln_zad_Aimp ) THEN   !!
          SELECT CASE( nldf_dyn )
          CASE( np_lap_i )           ! rotated lateral mixing: add its vertical mixing (akzv)
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1 
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at V-point
-                     zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) + akzv(ji,jj,jk  ) )   &
-                        &         / ( ze3va * e3vw_n(ji,jj,jk  ) ) * wvmask(ji,jj,jk  )
-                     zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) + akzv(ji,jj,jk+1) )   &
-                        &         / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1)
-                     zWvi = ( wi(ji,jj,jk  ) + wi(ji,jj+1,jk  ) ) / ze3va
-                     zWvs = ( wi(ji,jj,jk+1) + wi(ji,jj+1,jk+1) ) / ze3va
-                     zwi(ji,jj,jk) = zzwi + zdt * MIN( zWvi, 0._wp )
-                     zws(ji,jj,jk) = zzws - zdt * MAX( zWvs, 0._wp )
-                     zwd(ji,jj,jk) = 1._wp - zzwi - zzws - zdt * ( - MAX( zWvi, 0._wp ) + MIN( zWvs, 0._wp ) )
-                  END DO
-               END DO
-            END DO
+            DO_3D_00_00( 1, jpkm1 )
+               ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) + r_vvl * e3v(ji,jj,jk,Kaa)   ! after scale factor at V-point
+               zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) + akzv(ji,jj,jk  ) )   &
+                  &         / ( ze3va * e3vw(ji,jj,jk  ,Kmm) ) * wvmask(ji,jj,jk  )
+               zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) + akzv(ji,jj,jk+1) )   &
+                  &         / ( ze3va * e3vw(ji,jj,jk+1,Kmm) ) * wvmask(ji,jj,jk+1)
+               zWvi = ( wi(ji,jj,jk  ) + wi(ji,jj+1,jk  ) ) / ze3va
+               zWvs = ( wi(ji,jj,jk+1) + wi(ji,jj+1,jk+1) ) / ze3va
+               zwi(ji,jj,jk) = zzwi + zdt * MIN( zWvi, 0._wp )
+               zws(ji,jj,jk) = zzws - zdt * MAX( zWvs, 0._wp )
+               zwd(ji,jj,jk) = 1._wp - zzwi - zzws - zdt * ( - MAX( zWvi, 0._wp ) + MIN( zWvs, 0._wp ) )
+            END_3D
          CASE DEFAULT               ! iso-level lateral mixing
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1 
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at V-point
-                     zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) ) / ( ze3va * e3vw_n(ji,jj,jk  ) ) * wvmask(ji,jj,jk  )
-                     zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1)
-                     zWvi = ( wi(ji,jj,jk  ) + wi(ji,jj+1,jk  ) ) / ze3va
-                     zWvs = ( wi(ji,jj,jk+1) + wi(ji,jj+1,jk+1) ) / ze3va
-                     zwi(ji,jj,jk) = zzwi  + zdt * MIN( zWvi, 0._wp )
-                     zws(ji,jj,jk) = zzws  - zdt * MAX( zWvs, 0._wp )
-                     zwd(ji,jj,jk) = 1._wp - zzwi - zzws - zdt * ( - MAX( zWvi, 0._wp ) + MIN( zWvs, 0._wp ) )
-                  END DO
-               END DO
-            END DO
+            DO_3D_00_00( 1, jpkm1 )
+               ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) + r_vvl * e3v(ji,jj,jk,Kaa)   ! after scale factor at V-point
+               zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) ) / ( ze3va * e3vw(ji,jj,jk  ,Kmm) ) * wvmask(ji,jj,jk  )
+               zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) / ( ze3va * e3vw(ji,jj,jk+1,Kmm) ) * wvmask(ji,jj,jk+1)
+               zWvi = ( wi(ji,jj,jk  ) + wi(ji,jj+1,jk  ) ) / ze3va
+               zWvs = ( wi(ji,jj,jk+1) + wi(ji,jj+1,jk+1) ) / ze3va
+               zwi(ji,jj,jk) = zzwi  + zdt * MIN( zWvi, 0._wp )
+               zws(ji,jj,jk) = zzws  - zdt * MAX( zWvs, 0._wp )
+               zwd(ji,jj,jk) = 1._wp - zzwi - zzws - zdt * ( - MAX( zWvi, 0._wp ) + MIN( zWvs, 0._wp ) )
+            END_3D
          END SELECT
-         DO jj = 2, jpjm1     !* Surface boundary conditions
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zwi(ji,jj,1) = 0._wp
-               ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,1) + r_vvl * e3v_a(ji,jj,1)
-               zzws = - zdt * ( avm(ji,jj+1,2) + avm(ji,jj,2) ) / ( ze3va * e3vw_n(ji,jj,2) ) * wvmask(ji,jj,2)
-               zWvs = ( wi(ji,jj  ,2) +  wi(ji,jj+1,2) ) / ze3va
-               zws(ji,jj,1 ) = zzws - zdt * MAX( zWvs, 0._wp )
-               zwd(ji,jj,1 ) = 1._wp - zzws - zdt * ( MIN( zWvs, 0._wp ) )
-            END DO
-         END DO
+         DO_2D_00_00
+            zwi(ji,jj,1) = 0._wp
+            ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,1,Kmm) + r_vvl * e3v(ji,jj,1,Kaa)
+            zzws = - zdt * ( avm(ji,jj+1,2) + avm(ji,jj,2) ) / ( ze3va * e3vw(ji,jj,2,Kmm) ) * wvmask(ji,jj,2)
+            zWvs = ( wi(ji,jj  ,2) +  wi(ji,jj+1,2) ) / ze3va
+            zws(ji,jj,1 ) = zzws - zdt * MAX( zWvs, 0._wp )
+            zwd(ji,jj,1 ) = 1._wp - zzws - zdt * ( MIN( zWvs, 0._wp ) )
+         END_2D
       ELSE
          SELECT CASE( nldf_dyn )
          CASE( np_lap_i )           ! rotated lateral mixing: add its vertical mixing (akzu)
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1   
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at V-point
-                     zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) + akzv(ji,jj,jk  ) )   &
-                        &         / ( ze3va * e3vw_n(ji,jj,jk  ) ) * wvmask(ji,jj,jk  )
-                     zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) + akzv(ji,jj,jk+1) )   &
-                        &         / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1)
-                     zwi(ji,jj,jk) = zzwi
-                     zws(ji,jj,jk) = zzws
-                     zwd(ji,jj,jk) = 1._wp - zzwi - zzws
-                  END DO
-               END DO
-            END DO
+            DO_3D_00_00( 1, jpkm1 )
+               ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) + r_vvl * e3v(ji,jj,jk,Kaa)   ! after scale factor at V-point
+               zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) + akzv(ji,jj,jk  ) )   &
+                  &         / ( ze3va * e3vw(ji,jj,jk  ,Kmm) ) * wvmask(ji,jj,jk  )
+               zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) + akzv(ji,jj,jk+1) )   &
+                  &         / ( ze3va * e3vw(ji,jj,jk+1,Kmm) ) * wvmask(ji,jj,jk+1)
+               zwi(ji,jj,jk) = zzwi
+               zws(ji,jj,jk) = zzws
+               zwd(ji,jj,jk) = 1._wp - zzwi - zzws
+            END_3D
          CASE DEFAULT               ! iso-level lateral mixing
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1   
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at V-point
-                     zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) ) / ( ze3va * e3vw_n(ji,jj,jk  ) ) * wvmask(ji,jj,jk  )
-                     zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1)
-                     zwi(ji,jj,jk) = zzwi
-                     zws(ji,jj,jk) = zzws
-                     zwd(ji,jj,jk) = 1._wp - zzwi - zzws
-                  END DO
-               END DO
-            END DO
+            DO_3D_00_00( 1, jpkm1 )
+               ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) + r_vvl * e3v(ji,jj,jk,Kaa)   ! after scale factor at V-point
+               zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) ) / ( ze3va * e3vw(ji,jj,jk  ,Kmm) ) * wvmask(ji,jj,jk  )
+               zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) / ( ze3va * e3vw(ji,jj,jk+1,Kmm) ) * wvmask(ji,jj,jk+1)
+               zwi(ji,jj,jk) = zzwi
+               zws(ji,jj,jk) = zzws
+               zwd(ji,jj,jk) = 1._wp - zzwi - zzws
+            END_3D
          END SELECT
-         DO jj = 2, jpjm1        !* Surface boundary conditions
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zwi(ji,jj,1) = 0._wp
-               zwd(ji,jj,1) = 1._wp - zws(ji,jj,1)
-            END DO
-         END DO
+         DO_2D_00_00
+            zwi(ji,jj,1) = 0._wp
+            zwd(ji,jj,1) = 1._wp - zws(ji,jj,1)
+         END_2D
       ENDIF
       !
@@ -416,19 +349,15 @@
       !
       IF( ln_drgimp ) THEN
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               ikv = mbkv(ji,jj)       ! (deepest ocean u- and v-points)
-               ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv)   ! after scale factor at T-point
-               zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - r2dt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / ze3va           
-            END DO
-         END DO
+         DO_2D_00_00
+            ikv = mbkv(ji,jj)       ! (deepest ocean u- and v-points)
+            ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm) + r_vvl * e3v(ji,jj,ikv,Kaa)   ! after scale factor at T-point
+            zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - rDt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / ze3va           
+         END_2D
          IF ( ln_isfcav ) THEN
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  ikv = mikv(ji,jj)       ! (first wet ocean u- and v-points)
-                  ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv)   ! after scale factor at T-point
-                  zwd(ji,jj,iku) = zwd(ji,jj,iku) - r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / ze3va
-               END DO
-            END DO
+            DO_2D_00_00
+               ikv = mikv(ji,jj)       ! (first wet ocean u- and v-points)
+               ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm) + r_vvl * e3v(ji,jj,ikv,Kaa)   ! after scale factor at T-point
+               zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - rDt * 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) / ze3va
+            END_2D
          ENDIF
       ENDIF
@@ -449,49 +378,33 @@
       !-----------------------------------------------------------------------
       !
-      DO jk = 2, jpkm1        !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  ==
-         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
-      !
-      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==!
-         DO ji = fs_2, fs_jpim1   ! vector opt.          
-            ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,1) + r_vvl * e3v_a(ji,jj,1) 
-            va(ji,jj,1) = va(ji,jj,1) + r2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   &
-               &                                      / ( ze3va * rau0 ) * vmask(ji,jj,1) 
-         END DO
-      END DO
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               va(ji,jj,jk) = va(ji,jj,jk) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * va(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-      !
-      DO jj = 2, jpjm1        !==  third recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk  ==!
-         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
-               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
+      DO_3D_00_00( 2, jpkm1 )
+         zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1)
+      END_3D
+      !
+      DO_2D_00_00
+         ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,1,Kmm) + r_vvl * e3v(ji,jj,1,Kaa) 
+         pvv(ji,jj,1,Kaa) = pvv(ji,jj,1,Kaa) + rDt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   &
+            &                                      / ( ze3va * rho0 ) * vmask(ji,jj,1) 
+      END_2D
+      DO_3D_00_00( 2, jpkm1 )
+         pvv(ji,jj,jk,Kaa) = pvv(ji,jj,jk,Kaa) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * pvv(ji,jj,jk-1,Kaa)
+      END_3D
+      !
+      DO_2D_00_00
+         pvv(ji,jj,jpkm1,Kaa) = pvv(ji,jj,jpkm1,Kaa) / zwd(ji,jj,jpkm1)
+      END_2D
+      DO_3DS_00_00( jpk-2, 1, -1 )
+         pvv(ji,jj,jk,Kaa) = ( pvv(ji,jj,jk,Kaa) - zws(ji,jj,jk) * pvv(ji,jj,jk+1,Kaa) ) / zwd(ji,jj,jk)
+      END_3D
       !
       IF( l_trddyn )   THEN                      ! save the vertical diffusive trends for further diagnostics
-         ztrdu(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) / r2dt - ztrdu(:,:,:)
-         ztrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) / r2dt - ztrdv(:,:,:)
-         CALL trd_dyn( ztrdu, ztrdv, jpdyn_zdf, kt )
+         ztrdu(:,:,:) = ( puu(:,:,:,Kaa) - puu(:,:,:,Kbb) ) / rDt - ztrdu(:,:,:)
+         ztrdv(:,:,:) = ( pvv(:,:,:,Kaa) - pvv(:,:,:,Kbb) ) / rDt - ztrdv(:,:,:)
+         CALL trd_dyn( ztrdu, ztrdv, jpdyn_zdf, kt, Kmm )
          DEALLOCATE( ztrdu, ztrdv ) 
       ENDIF
       !                                          ! print mean trends (used for debugging)
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf  - Ua: ', mask1=umask,               &
-         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Kaa), clinfo1=' zdf  - Ua: ', mask1=umask,               &
+         &                                  tab3d_2=pvv(:,:,:,Kaa), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
          !
       IF( ln_timing )   CALL timing_stop('dyn_zdf')
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/sshwzv.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/sshwzv.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/sshwzv.F90	(revision 12928)
@@ -10,12 +10,14 @@
    !!            3.3  !  2011-10  (M. Leclair) split former ssh_wzv routine and remove all vvl related work
    !!            4.0  !  2018-12  (A. Coward) add mixed implicit/explicit advection
+   !!            4.1  !  2019-08  (A. Coward, D. Storkey) Rename ssh_nxt -> ssh_atf. Now only does time filtering.
    !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
    !!   ssh_nxt       : after ssh
-   !!   ssh_swp       : filter ans swap the ssh arrays
+   !!   ssh_atf       : time filter the ssh arrays
    !!   wzv           : compute now vertical velocity
    !!----------------------------------------------------------------------
    USE oce            ! ocean dynamics and tracers variables
+   USE isf_oce        ! ice shelf
    USE dom_oce        ! ocean space and time domain variables 
    USE sbc_oce        ! surface boundary condition: ocean
@@ -44,8 +46,8 @@
    PUBLIC   wzv        ! called by step.F90
    PUBLIC   wAimp      ! called by step.F90
-   PUBLIC   ssh_swp    ! called by step.F90
+   PUBLIC   ssh_atf    ! called by step.F90
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -55,9 +57,9 @@
 CONTAINS
 
-   SUBROUTINE ssh_nxt( kt )
+   SUBROUTINE ssh_nxt( kt, Kbb, Kmm, pssh, Kaa )
       !!----------------------------------------------------------------------
       !!                ***  ROUTINE ssh_nxt  ***
       !!                   
-      !! ** Purpose :   compute the after ssh (ssha)
+      !! ** Purpose :   compute the after ssh (ssh(Kaa))
       !!
       !! ** Method  : - Using the incompressibility hypothesis, the ssh increment
@@ -65,12 +67,14 @@
       !!      by the time step.
       !!
-      !! ** action  :   ssha, after sea surface height
+      !! ** action  :   ssh(:,:,Kaa), after sea surface height
       !!
       !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling.
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! time step
+      INTEGER                         , INTENT(in   ) ::   kt             ! time step
+      INTEGER                         , INTENT(in   ) ::   Kbb, Kmm, Kaa  ! time level index
+      REAL(wp), DIMENSION(jpi,jpj,jpt), INTENT(inout) ::   pssh           ! sea-surface height
       ! 
-      INTEGER  ::   jk            ! dummy loop indice
-      REAL(wp) ::   z2dt, zcoef   ! local scalars
+      INTEGER  ::   jk      ! dummy loop index
+      REAL(wp) ::   zcoef   ! local scalar
       REAL(wp), DIMENSION(jpi,jpj) ::   zhdiv   ! 2D workspace
       !!----------------------------------------------------------------------
@@ -84,7 +88,5 @@
       ENDIF
       !
-      z2dt = 2._wp * rdt                          ! set time step size (Euler/Leapfrog)
-      IF( neuler == 0 .AND. kt == nit000 )   z2dt = rdt
-      zcoef = 0.5_wp * r1_rau0
+      zcoef = 0.5_wp * r1_rho0
 
       !                                           !------------------------------!
@@ -92,12 +94,12 @@
       !                                           !------------------------------!
       IF(ln_wd_il) THEN
-         CALL wad_lmt(sshb, zcoef * (emp_b(:,:) + emp(:,:)), z2dt)
-      ENDIF
-
-      CALL div_hor( kt )                               ! Horizontal divergence
+         CALL wad_lmt(pssh(:,:,Kbb), zcoef * (emp_b(:,:) + emp(:,:)), rDt, Kmm, uu, vv )
+      ENDIF
+
+      CALL div_hor( kt, Kbb, Kmm )                     ! Horizontal divergence
       !
       zhdiv(:,:) = 0._wp
       DO jk = 1, jpkm1                                 ! Horizontal divergence of barotropic transports
-        zhdiv(:,:) = zhdiv(:,:) + e3t_n(:,:,jk) * hdivn(:,:,jk)
+        zhdiv(:,:) = zhdiv(:,:) + e3t(:,:,jk,Kmm) * hdiv(:,:,jk)
       END DO
       !                                                ! Sea surface elevation time stepping
@@ -105,14 +107,14 @@
       ! compute the vertical velocity which can be used to compute the non-linear terms of the momentum equations.
       ! 
-      ssha(:,:) = (  sshb(:,:) - z2dt * ( zcoef * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * ssmask(:,:)
+      pssh(:,:,Kaa) = (  pssh(:,:,Kbb) - rDt * ( zcoef * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * ssmask(:,:)
       !
 #if defined key_agrif
-      CALL agrif_ssh( kt )
+      Kbb_a = Kbb; Kmm_a = Kmm; Krhs_a = Kaa; CALL agrif_ssh( kt )
 #endif
       !
       IF ( .NOT.ln_dynspg_ts ) THEN
          IF( ln_bdy ) THEN
-            CALL lbc_lnk( 'sshwzv', ssha, 'T', 1. )    ! Not sure that's necessary
-            CALL bdy_ssh( ssha )             ! Duplicate sea level across open boundaries
+            CALL lbc_lnk( 'sshwzv', pssh(:,:,Kaa), 'T', 1. )    ! Not sure that's necessary
+            CALL bdy_ssh( pssh(:,:,Kaa) )             ! Duplicate sea level across open boundaries
          ENDIF
       ENDIF
@@ -121,5 +123,5 @@
       !                                           !------------------------------!
       !
-      IF(ln_ctl)   CALL prt_ctl( tab2d_1=ssha, clinfo1=' ssha  - : ', mask1=tmask )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=pssh(:,:,Kaa), clinfo1=' pssh(:,:,Kaa)  - : ', mask1=tmask )
       !
       IF( ln_timing )   CALL timing_stop('ssh_nxt')
@@ -128,5 +130,5 @@
 
    
-   SUBROUTINE wzv( kt )
+   SUBROUTINE wzv( kt, Kbb, Kmm, pww, Kaa )
       !!----------------------------------------------------------------------
       !!                ***  ROUTINE wzv  ***
@@ -139,12 +141,13 @@
       !!        The boundary conditions are w=0 at the bottom (no flux) and.
       !!
-      !! ** action  :   wn      : now vertical velocity
+      !! ** action  :   pww      : now vertical velocity
       !!
       !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling.
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! time step
+      INTEGER                         , INTENT(in)    ::   kt             ! time step
+      INTEGER                         , INTENT(in)    ::   Kbb, Kmm, Kaa  ! time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pww            ! now vertical velocity
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   z1_2dt       ! local scalars
       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zhdiv
       !!----------------------------------------------------------------------
@@ -157,11 +160,9 @@
          IF(lwp) WRITE(numout,*) '~~~~~ '
          !
-         wn(:,:,jpk) = 0._wp                  ! bottom boundary condition: w=0 (set once for all)
+         pww(:,:,jpk) = 0._wp                  ! bottom boundary condition: w=0 (set once for all)
       ENDIF
       !                                           !------------------------------!
       !                                           !     Now Vertical Velocity    !
       !                                           !------------------------------!
-      z1_2dt = 1. / ( 2. * rdt )                         ! set time step size (Euler/Leapfrog)
-      IF( neuler == 0 .AND. kt == nit000 )   z1_2dt = 1. / rdt
       !
       IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN      ! z_tilde and layer cases
@@ -171,25 +172,23 @@
             ! horizontal divergence of thickness diffusion transport ( velocity multiplied by e3t)
             ! - ML - note: computation already done in dom_vvl_sf_nxt. Could be optimized (not critical and clearer this way)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zhdiv(ji,jj,jk) = r1_e1e2t(ji,jj) * ( un_td(ji,jj,jk) - un_td(ji-1,jj,jk) + vn_td(ji,jj,jk) - vn_td(ji,jj-1,jk) )
-               END DO
-            END DO
+            DO_2D_00_00
+               zhdiv(ji,jj,jk) = r1_e1e2t(ji,jj) * ( un_td(ji,jj,jk) - un_td(ji-1,jj,jk) + vn_td(ji,jj,jk) - vn_td(ji,jj-1,jk) )
+            END_2D
          END DO
          CALL lbc_lnk('sshwzv', zhdiv, 'T', 1.)  ! - ML - Perhaps not necessary: not used for horizontal "connexions"
          !                             ! Is it problematic to have a wrong vertical velocity in boundary cells?
-         !                             ! Same question holds for hdivn. Perhaps just for security
+         !                             ! Same question holds for hdiv. Perhaps just for security
          DO jk = jpkm1, 1, -1                       ! integrate from the bottom the hor. divergence
             ! computation of w
-            wn(:,:,jk) = wn(:,:,jk+1) - (  e3t_n(:,:,jk) * hdivn(:,:,jk) + zhdiv(:,:,jk)    &
-               &                         + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) )     ) * tmask(:,:,jk)
+            pww(:,:,jk) = pww(:,:,jk+1) - (  e3t(:,:,jk,Kmm) * hdiv(:,:,jk) + zhdiv(:,:,jk)    &
+               &                         + r1_Dt * ( e3t(:,:,jk,Kaa) - e3t(:,:,jk,Kbb) )     ) * tmask(:,:,jk)
          END DO
-         !          IF( ln_vvl_layer ) wn(:,:,:) = 0.e0
+         !          IF( ln_vvl_layer ) pww(:,:,:) = 0.e0
          DEALLOCATE( zhdiv ) 
       ELSE   ! z_star and linear free surface cases
          DO jk = jpkm1, 1, -1                       ! integrate from the bottom the hor. divergence
             ! computation of w
-            wn(:,:,jk) = wn(:,:,jk+1) - (  e3t_n(:,:,jk) * hdivn(:,:,jk)                 &
-               &                         + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) )  ) * tmask(:,:,jk)
+            pww(:,:,jk) = pww(:,:,jk+1) - (  e3t(:,:,jk,Kmm) * hdiv(:,:,jk)                 &
+               &                         + r1_Dt * ( e3t(:,:,jk,Kaa) - e3t(:,:,jk,Kbb) )  ) * tmask(:,:,jk)
          END DO
       ENDIF
@@ -197,5 +196,5 @@
       IF( ln_bdy ) THEN
          DO jk = 1, jpkm1
-            wn(:,:,jk) = wn(:,:,jk) * bdytmask(:,:)
+            pww(:,:,jk) = pww(:,:,jk) * bdytmask(:,:)
          END DO
       ENDIF
@@ -203,8 +202,8 @@
 #if defined key_agrif 
       IF( .NOT. AGRIF_Root() ) THEN 
-         IF ((nbondi ==  1).OR.(nbondi == 2)) wn(nlci-1 , :     ,:) = 0.e0      ! east 
-         IF ((nbondi == -1).OR.(nbondi == 2)) wn(2      , :     ,:) = 0.e0      ! west 
-         IF ((nbondj ==  1).OR.(nbondj == 2)) wn(:      ,nlcj-1 ,:) = 0.e0      ! north 
-         IF ((nbondj == -1).OR.(nbondj == 2)) wn(:      ,2      ,:) = 0.e0      ! south 
+         IF ((nbondi ==  1).OR.(nbondi == 2)) pww(nlci-1 , :     ,:) = 0.e0      ! east 
+         IF ((nbondi == -1).OR.(nbondi == 2)) pww(2      , :     ,:) = 0.e0      ! west 
+         IF ((nbondj ==  1).OR.(nbondj == 2)) pww(:      ,nlcj-1 ,:) = 0.e0      ! north 
+         IF ((nbondj == -1).OR.(nbondj == 2)) pww(:      ,2      ,:) = 0.e0      ! south 
       ENDIF 
 #endif 
@@ -215,58 +214,57 @@
 
 
-   SUBROUTINE ssh_swp( kt )
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE ssh_nxt  ***
-      !!
-      !! ** Purpose :   achieve the sea surface  height time stepping by 
-      !!              applying Asselin time filter and swapping the arrays
-      !!              ssha  already computed in ssh_nxt  
+   SUBROUTINE ssh_atf( kt, Kbb, Kmm, Kaa, pssh )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE ssh_atf  ***
+      !!
+      !! ** Purpose :   Apply Asselin time filter to now SSH.
       !!
       !! ** Method  : - apply Asselin time fiter to now ssh (excluding the forcing
       !!              from the filter, see Leclair and Madec 2010) and swap :
-      !!                sshn = ssha + atfp * ( sshb -2 sshn + ssha )
-      !!                            - atfp * rdt * ( emp_b - emp ) / rau0
-      !!                sshn = ssha
-      !!
-      !! ** action  : - sshb, sshn   : before & now sea surface height
-      !!                               ready for the next time step
+      !!                pssh(:,:,Kmm) = pssh(:,:,Kaa) + rn_atfp * ( pssh(:,:,Kbb) -2 pssh(:,:,Kmm) + pssh(:,:,Kaa) )
+      !!                            - rn_atfp * rn_Dt * ( emp_b - emp ) / rho0
+      !!
+      !! ** action  : - pssh(:,:,Kmm) time filtered
       !!
       !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling.
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   kt             ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   Kbb, Kmm, Kaa  ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpt), INTENT(inout) ::   pssh           ! SSH field
       !
       REAL(wp) ::   zcoef   ! local scalar
       !!----------------------------------------------------------------------
       !
-      IF( ln_timing )   CALL timing_start('ssh_swp')
+      IF( ln_timing )   CALL timing_start('ssh_atf')
       !
       IF( kt == nit000 ) THEN
          IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'ssh_swp : Asselin time filter and swap of sea surface height'
+         IF(lwp) WRITE(numout,*) 'ssh_atf : Asselin time filter of sea surface height'
          IF(lwp) WRITE(numout,*) '~~~~~~~ '
       ENDIF
       !              !==  Euler time-stepping: no filter, just swap  ==!
-      IF ( neuler == 0 .AND. kt == nit000 ) THEN
-         sshn(:,:) = ssha(:,:)                              ! now    <-- after  (before already = now)
-         !
-      ELSE           !==  Leap-Frog time-stepping: Asselin filter + swap  ==!
-         !                                                  ! before <-- now filtered
-         sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:) )
-         IF( .NOT.ln_linssh ) THEN                          ! before <-- with forcing removed
-            zcoef = atfp * rdt * r1_rau0
-            sshb(:,:) = sshb(:,:) - zcoef * (     emp_b(:,:) - emp   (:,:)   &
-               &                             -    rnf_b(:,:) + rnf   (:,:)   &
-               &                             + fwfisf_b(:,:) - fwfisf(:,:)   ) * ssmask(:,:)
+      IF ( .NOT.( l_1st_euler ) ) THEN   ! Only do time filtering for leapfrog timesteps
+         !                                                  ! filtered "now" field
+         pssh(:,:,Kmm) = pssh(:,:,Kmm) + rn_atfp * ( pssh(:,:,Kbb) - 2 * pssh(:,:,Kmm) + pssh(:,:,Kaa) )
+         IF( .NOT.ln_linssh ) THEN                          ! "now" <-- with forcing removed
+            zcoef = rn_atfp * rn_Dt * r1_rho0
+            pssh(:,:,Kmm) = pssh(:,:,Kmm) - zcoef * (     emp_b(:,:) - emp   (:,:)   &
+               &                             - rnf_b(:,:)        + rnf   (:,:)       &
+               &                             + fwfisf_cav_b(:,:) - fwfisf_cav(:,:)   &
+               &                             + fwfisf_par_b(:,:) - fwfisf_par(:,:)   ) * ssmask(:,:)
+
+            ! ice sheet coupling
+            IF ( ln_isf .AND. ln_isfcpl .AND. kt == nit000+1) pssh(:,:,Kbb) = pssh(:,:,Kbb) - rn_atfp * rn_Dt * ( risfcpl_ssh(:,:) - 0.0 ) * ssmask(:,:)
+
          ENDIF
-         sshn(:,:) = ssha(:,:)                              ! now <-- after
-      ENDIF
-      !
-      IF(ln_ctl)   CALL prt_ctl( tab2d_1=sshb, clinfo1=' sshb  - : ', mask1=tmask )
-      !
-      IF( ln_timing )   CALL timing_stop('ssh_swp')
-      !
-   END SUBROUTINE ssh_swp
-
-   SUBROUTINE wAimp( kt )
+      ENDIF
+      !
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=pssh(:,:,Kmm), clinfo1=' pssh(:,:,Kmm)  - : ', mask1=tmask )
+      !
+      IF( ln_timing )   CALL timing_stop('ssh_atf')
+      !
+   END SUBROUTINE ssh_atf
+
+   SUBROUTINE wAimp( kt, Kmm )
       !!----------------------------------------------------------------------
       !!                ***  ROUTINE wAimp  ***
@@ -277,5 +275,5 @@
       !! ** Method  : - 
       !!
-      !! ** action  :   wn      : now vertical velocity (to be handled explicitly)
+      !! ** action  :   ww      : now vertical velocity (to be handled explicitly)
       !!            :   wi      : now vertical velocity (for implicit treatment)
       !!
@@ -285,4 +283,5 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! time step
+      INTEGER, INTENT(in) ::   Kmm  ! time level index
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -305,37 +304,29 @@
       ! Calculate Courant numbers
       IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = 2, fs_jpim1   ! vector opt.
-                  z1_e3t = 1._wp / e3t_n(ji,jj,jk)
-                  ! 2*rdt and not r2dt (for restartability)
-                  Cu_adv(ji,jj,jk) = 2._wp * rdt * ( ( MAX( wn(ji,jj,jk) , 0._wp ) - MIN( wn(ji,jj,jk+1) , 0._wp ) )                       &  
-                     &                             + ( MAX( e2u(ji  ,jj)*e3u_n(ji  ,jj,jk)*un(ji  ,jj,jk) + un_td(ji  ,jj,jk), 0._wp ) -   &
-                     &                                 MIN( e2u(ji-1,jj)*e3u_n(ji-1,jj,jk)*un(ji-1,jj,jk) + un_td(ji-1,jj,jk), 0._wp ) )   &
-                     &                               * r1_e1e2t(ji,jj)                                                                     &
-                     &                             + ( MAX( e1v(ji,jj  )*e3v_n(ji,jj  ,jk)*vn(ji,jj  ,jk) + vn_td(ji,jj  ,jk), 0._wp ) -   &
-                     &                                 MIN( e1v(ji,jj-1)*e3v_n(ji,jj-1,jk)*vn(ji,jj-1,jk) + vn_td(ji,jj-1,jk), 0._wp ) )   &
-                     &                               * r1_e1e2t(ji,jj)                                                                     &
-                     &                             ) * z1_e3t
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm)
+            ! 2*rn_Dt and not rDt (for restartability)
+            Cu_adv(ji,jj,jk) = 2._wp * rn_Dt * ( ( MAX( ww(ji,jj,jk) , 0._wp ) - MIN( ww(ji,jj,jk+1) , 0._wp ) )                       &  
+               &                             + ( MAX( e2u(ji  ,jj)*e3u(ji  ,jj,jk,Kmm)*uu(ji  ,jj,jk,Kmm) + un_td(ji  ,jj,jk), 0._wp ) -   &
+               &                                 MIN( e2u(ji-1,jj)*e3u(ji-1,jj,jk,Kmm)*uu(ji-1,jj,jk,Kmm) + un_td(ji-1,jj,jk), 0._wp ) )   &
+               &                               * r1_e1e2t(ji,jj)                                                                     &
+               &                             + ( MAX( e1v(ji,jj  )*e3v(ji,jj  ,jk,Kmm)*vv(ji,jj  ,jk,Kmm) + vn_td(ji,jj  ,jk), 0._wp ) -   &
+               &                                 MIN( e1v(ji,jj-1)*e3v(ji,jj-1,jk,Kmm)*vv(ji,jj-1,jk,Kmm) + vn_td(ji,jj-1,jk), 0._wp ) )   &
+               &                               * r1_e1e2t(ji,jj)                                                                     &
+               &                             ) * z1_e3t
+         END_3D
       ELSE
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = 2, fs_jpim1   ! vector opt.
-                  z1_e3t = 1._wp / e3t_n(ji,jj,jk)
-                  ! 2*rdt and not r2dt (for restartability)
-                  Cu_adv(ji,jj,jk) = 2._wp * rdt * ( ( MAX( wn(ji,jj,jk) , 0._wp ) - MIN( wn(ji,jj,jk+1) , 0._wp ) )   & 
-                     &                             + ( MAX( e2u(ji  ,jj)*e3u_n(ji  ,jj,jk)*un(ji  ,jj,jk), 0._wp ) -   &
-                     &                                 MIN( e2u(ji-1,jj)*e3u_n(ji-1,jj,jk)*un(ji-1,jj,jk), 0._wp ) )   &
-                     &                               * r1_e1e2t(ji,jj)                                                 &
-                     &                             + ( MAX( e1v(ji,jj  )*e3v_n(ji,jj  ,jk)*vn(ji,jj  ,jk), 0._wp ) -   &
-                     &                                 MIN( e1v(ji,jj-1)*e3v_n(ji,jj-1,jk)*vn(ji,jj-1,jk), 0._wp ) )   &
-                     &                               * r1_e1e2t(ji,jj)                                                 &
-                     &                             ) * z1_e3t
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm)
+            ! 2*rn_Dt and not rDt (for restartability)
+            Cu_adv(ji,jj,jk) = 2._wp * rn_Dt * ( ( MAX( ww(ji,jj,jk) , 0._wp ) - MIN( ww(ji,jj,jk+1) , 0._wp ) )   & 
+               &                             + ( MAX( e2u(ji  ,jj)*e3u(ji  ,jj,jk,Kmm)*uu(ji  ,jj,jk,Kmm), 0._wp ) -   &
+               &                                 MIN( e2u(ji-1,jj)*e3u(ji-1,jj,jk,Kmm)*uu(ji-1,jj,jk,Kmm), 0._wp ) )   &
+               &                               * r1_e1e2t(ji,jj)                                                 &
+               &                             + ( MAX( e1v(ji,jj  )*e3v(ji,jj  ,jk,Kmm)*vv(ji,jj  ,jk,Kmm), 0._wp ) -   &
+               &                                 MIN( e1v(ji,jj-1)*e3v(ji,jj-1,jk,Kmm)*vv(ji,jj-1,jk,Kmm), 0._wp ) )   &
+               &                               * r1_e1e2t(ji,jj)                                                 &
+               &                             ) * z1_e3t
+         END_3D
       ENDIF
       CALL lbc_lnk( 'sshwzv', Cu_adv, 'T', 1. )
@@ -344,33 +335,29 @@
       !
       IF( MAXVAL( Cu_adv(:,:,:) ) > Cu_min ) THEN       ! Quick check if any breaches anywhere
-         DO jk = jpkm1, 2, -1                           ! or scan Courant criterion and partition
-            DO jj = 1, jpj                              ! w where necessary
-               DO ji = 1, jpi
-                  !
-                  zCu = MAX( Cu_adv(ji,jj,jk) , Cu_adv(ji,jj,jk-1) )
+         DO_3DS_11_11( jpkm1, 2, -1 )
+            !
+            zCu = MAX( Cu_adv(ji,jj,jk) , Cu_adv(ji,jj,jk-1) )
 ! alt:
-!                  IF ( wn(ji,jj,jk) > 0._wp ) THEN 
+!                  IF ( ww(ji,jj,jk) > 0._wp ) THEN 
 !                     zCu =  Cu_adv(ji,jj,jk) 
 !                  ELSE
 !                     zCu =  Cu_adv(ji,jj,jk-1)
 !                  ENDIF 
-                  !
-                  IF( zCu <= Cu_min ) THEN              !<-- Fully explicit
-                     zcff = 0._wp
-                  ELSEIF( zCu < Cu_cut ) THEN           !<-- Mixed explicit
-                     zcff = ( zCu - Cu_min )**2
-                     zcff = zcff / ( Fcu + zcff )
-                  ELSE                                  !<-- Mostly implicit
-                     zcff = ( zCu - Cu_max )/ zCu
-                  ENDIF
-                  zcff = MIN(1._wp, zcff)
-                  !
-                  wi(ji,jj,jk) =           zcff   * wn(ji,jj,jk)
-                  wn(ji,jj,jk) = ( 1._wp - zcff ) * wn(ji,jj,jk)
-                  !
-                  Cu_adv(ji,jj,jk) = zcff               ! Reuse array to output coefficient below and in stp_ctl
-               END DO
-            END DO
-         END DO
+            !
+            IF( zCu <= Cu_min ) THEN              !<-- Fully explicit
+               zcff = 0._wp
+            ELSEIF( zCu < Cu_cut ) THEN           !<-- Mixed explicit
+               zcff = ( zCu - Cu_min )**2
+               zcff = zcff / ( Fcu + zcff )
+            ELSE                                  !<-- Mostly implicit
+               zcff = ( zCu - Cu_max )/ zCu
+            ENDIF
+            zcff = MIN(1._wp, zcff)
+            !
+            wi(ji,jj,jk) =           zcff   * ww(ji,jj,jk)
+            ww(ji,jj,jk) = ( 1._wp - zcff ) * ww(ji,jj,jk)
+            !
+            Cu_adv(ji,jj,jk) = zcff               ! Reuse array to output coefficient below and in stp_ctl
+         END_3D
          Cu_adv(:,:,1) = 0._wp 
       ELSE
@@ -381,5 +368,5 @@
       CALL iom_put("wimp",wi) 
       CALL iom_put("wi_cff",Cu_adv)
-      CALL iom_put("wexp",wn)
+      CALL iom_put("wexp",ww)
       !
       IF( ln_timing )   CALL timing_stop('wAimp')
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/wet_dry.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/wet_dry.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/wet_dry.F90	(revision 12928)
@@ -31,4 +31,6 @@
    PRIVATE
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! critical depths,filters, limiters,and masks for  Wetting and Drying
@@ -61,5 +63,4 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
 CONTAINS
@@ -79,8 +80,6 @@
       !!----------------------------------------------------------------------
       !
-      REWIND( numnam_ref )              ! Namelist namwad in reference namelist : Parameters for Wetting/Drying
       READ  ( numnam_ref, namwad, IOSTAT = ios, ERR = 905)
 905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namwad in reference namelist' ) 
-      REWIND( numnam_cfg )              ! Namelist namwad in configuration namelist : Parameters for Wetting/Drying
       READ  ( numnam_cfg, namwad, IOSTAT = ios, ERR = 906)
 906   IF( ios >  0 )   CALL ctl_nam ( ios , 'namwad in configuration namelist' )
@@ -122,5 +121,5 @@
 
 
-   SUBROUTINE wad_lmt( sshb1, sshemp, z2dt )
+   SUBROUTINE wad_lmt( psshb1, psshemp, z2dt, Kmm, puu, pvv )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE wad_lmt  ***
@@ -132,7 +131,9 @@
       !! ** Action  : - calculate flux limiter and W/D flag
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   sshb1        !!gm DOCTOR names: should start with p !
-      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   sshemp
-      REAL(wp)                , INTENT(in   ) ::   z2dt
+      REAL(wp), DIMENSION(:,:)            , INTENT(inout) ::   psshb1
+      REAL(wp), DIMENSION(:,:)            , INTENT(in   ) ::   psshemp
+      REAL(wp)                            , INTENT(in   ) ::   z2dt
+      INTEGER                             , INTENT(in   ) ::   Kmm       ! time level index
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::   puu, pvv  ! velocity arrays
       !
       INTEGER  ::   ji, jj, jk, jk1     ! dummy loop indices
@@ -150,6 +151,6 @@
       !
       DO jk = 1, jpkm1
-         un(:,:,jk) = un(:,:,jk) * zwdlmtu(:,:) 
-         vn(:,:,jk) = vn(:,:,jk) * zwdlmtv(:,:) 
+         puu(:,:,jk,Kmm) = puu(:,:,jk,Kmm) * zwdlmtu(:,:) 
+         pvv(:,:,jk,Kmm) = pvv(:,:,jk,Kmm) * zwdlmtv(:,:) 
       END DO
       jflag  = 0
@@ -165,6 +166,6 @@
       !
       DO jk = 1, jpkm1     ! Horizontal Flux in u and v direction
-         zflxu(:,:) = zflxu(:,:) + e3u_n(:,:,jk) * un(:,:,jk) * umask(:,:,jk)
-         zflxv(:,:) = zflxv(:,:) + e3v_n(:,:,jk) * vn(:,:,jk) * vmask(:,:,jk)
+         zflxu(:,:) = zflxu(:,:) + e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) * umask(:,:,jk)
+         zflxv(:,:) = zflxv(:,:) + e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) * vmask(:,:,jk)
       END DO
       zflxu(:,:) = zflxu(:,:) * e2u(:,:)
@@ -172,36 +173,32 @@
       !
       wdmask(:,:) = 1._wp
-      DO jj = 2, jpj
-         DO ji = 2, jpi 
-            !
-            IF( tmask(ji,jj,1)        < 0.5_wp )   CYCLE    ! we don't care about land cells
-            IF( ht_0(ji,jj) - ssh_ref > zdepwd )   CYCLE    ! and cells which are unlikely to dry
-            !
-            zflxp(ji,jj) = MAX( zflxu(ji,jj) , 0._wp ) - MIN( zflxu(ji-1,jj  ) , 0._wp )   &
-               &         + MAX( zflxv(ji,jj) , 0._wp ) - MIN( zflxv(ji,  jj-1) , 0._wp ) 
-            zflxn(ji,jj) = MIN( zflxu(ji,jj) , 0._wp ) - MAX( zflxu(ji-1,jj  ) , 0._wp )   &
-               &         + MIN( zflxv(ji,jj) , 0._wp ) - MAX( zflxv(ji,  jj-1) , 0._wp ) 
-            !
-            zdep2 = ht_0(ji,jj) + sshb1(ji,jj) - rn_wdmin1
-            IF( zdep2 <= 0._wp ) THEN     ! add more safty, but not necessary
-               sshb1(ji,jj) = rn_wdmin1 - ht_0(ji,jj)
-               IF(zflxu(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = 0._wp
-               IF(zflxu(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = 0._wp
-               IF(zflxv(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = 0._wp
-               IF(zflxv(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = 0._wp 
-               wdmask(ji,jj) = 0._wp
-            END IF
-         END DO
-      END DO
+      DO_2D_01_01
+         !
+         IF( tmask(ji,jj,1)        < 0.5_wp )   CYCLE    ! we don't care about land cells
+         IF( ht_0(ji,jj) - ssh_ref > zdepwd )   CYCLE    ! and cells which are unlikely to dry
+         !
+         zflxp(ji,jj) = MAX( zflxu(ji,jj) , 0._wp ) - MIN( zflxu(ji-1,jj  ) , 0._wp )   &
+            &         + MAX( zflxv(ji,jj) , 0._wp ) - MIN( zflxv(ji,  jj-1) , 0._wp ) 
+         zflxn(ji,jj) = MIN( zflxu(ji,jj) , 0._wp ) - MAX( zflxu(ji-1,jj  ) , 0._wp )   &
+            &         + MIN( zflxv(ji,jj) , 0._wp ) - MAX( zflxv(ji,  jj-1) , 0._wp ) 
+         !
+         zdep2 = ht_0(ji,jj) + psshb1(ji,jj) - rn_wdmin1
+         IF( zdep2 <= 0._wp ) THEN     ! add more safty, but not necessary
+            psshb1(ji,jj) = rn_wdmin1 - ht_0(ji,jj)
+            IF(zflxu(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = 0._wp
+            IF(zflxu(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = 0._wp
+            IF(zflxv(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = 0._wp
+            IF(zflxv(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = 0._wp 
+            wdmask(ji,jj) = 0._wp
+         END IF
+      END_2D
       !
       !           ! HPG limiter from jholt
-      wdramp(:,:) = min((ht_0(:,:) + sshb1(:,:) - rn_wdmin1)/(rn_wdmin0 - rn_wdmin1),1.0_wp)
+      wdramp(:,:) = min((ht_0(:,:) + psshb1(:,:) - rn_wdmin1)/(rn_wdmin0 - rn_wdmin1),1.0_wp)
       !jth assume don't need a lbc_lnk here
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-            wdrampu(ji,jj) = MIN( wdramp(ji,jj) , wdramp(ji+1,jj) )
-            wdrampv(ji,jj) = MIN( wdramp(ji,jj) , wdramp(ji,jj+1) )
-         END DO
-      END DO
+      DO_2D_10_10
+         wdrampu(ji,jj) = MIN( wdramp(ji,jj) , wdramp(ji+1,jj) )
+         wdrampv(ji,jj) = MIN( wdramp(ji,jj) , wdramp(ji,jj+1) )
+      END_2D
       !           ! end HPG limiter
       !
@@ -213,37 +210,35 @@
          jflag = 0     ! flag indicating if any further iterations are needed
          !
-         DO jj = 2, jpj
-            DO ji = 2, jpi 
-               IF( tmask(ji, jj, 1) < 0.5_wp )   CYCLE 
-               IF( ht_0(ji,jj)      > zdepwd )   CYCLE
-               !
-               ztmp = e1e2t(ji,jj)
-               !
-               zzflxp = MAX( zflxu1(ji,jj) , 0._wp ) - MIN( zflxu1(ji-1,jj  ) , 0._wp)   &
-                  &   + MAX( zflxv1(ji,jj) , 0._wp ) - MIN( zflxv1(ji,  jj-1) , 0._wp) 
-               zzflxn = MIN( zflxu1(ji,jj) , 0._wp ) - MAX( zflxu1(ji-1,jj  ) , 0._wp)   &
-                  &   + MIN( zflxv1(ji,jj) , 0._wp ) - MAX( zflxv1(ji,  jj-1) , 0._wp) 
-               !
-               zdep1 = (zzflxp + zzflxn) * z2dt / ztmp
-               zdep2 = ht_0(ji,jj) + sshb1(ji,jj) - rn_wdmin1 - z2dt * sshemp(ji,jj)
-               !
-               IF( zdep1 > zdep2 ) THEN
-                  wdmask(ji, jj) = 0._wp
-                  zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt )
-                  !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt )
-                  ! flag if the limiter has been used but stop flagging if the only
-                  ! changes have zeroed the coefficient since further iterations will
-                  ! not change anything
-                  IF( zcoef > 0._wp ) THEN   ;   jflag = 1 
-                  ELSE                       ;   zcoef = 0._wp
-                  ENDIF
-                  IF( jk1 > nn_wdit )   zcoef = 0._wp
-                  IF( zflxu1(ji  ,jj  ) > 0._wp )   zwdlmtu(ji  ,jj  ) = zcoef
-                  IF( zflxu1(ji-1,jj  ) < 0._wp )   zwdlmtu(ji-1,jj  ) = zcoef
-                  IF( zflxv1(ji  ,jj  ) > 0._wp )   zwdlmtv(ji  ,jj  ) = zcoef
-                  IF( zflxv1(ji  ,jj-1) < 0._wp )   zwdlmtv(ji  ,jj-1) = zcoef
+         DO_2D_01_01
+            IF( tmask(ji, jj, 1) < 0.5_wp )   CYCLE 
+            IF( ht_0(ji,jj)      > zdepwd )   CYCLE
+            !
+            ztmp = e1e2t(ji,jj)
+            !
+            zzflxp = MAX( zflxu1(ji,jj) , 0._wp ) - MIN( zflxu1(ji-1,jj  ) , 0._wp)   &
+               &   + MAX( zflxv1(ji,jj) , 0._wp ) - MIN( zflxv1(ji,  jj-1) , 0._wp) 
+            zzflxn = MIN( zflxu1(ji,jj) , 0._wp ) - MAX( zflxu1(ji-1,jj  ) , 0._wp)   &
+               &   + MIN( zflxv1(ji,jj) , 0._wp ) - MAX( zflxv1(ji,  jj-1) , 0._wp) 
+            !
+            zdep1 = (zzflxp + zzflxn) * z2dt / ztmp
+            zdep2 = ht_0(ji,jj) + psshb1(ji,jj) - rn_wdmin1 - z2dt * psshemp(ji,jj)
+            !
+            IF( zdep1 > zdep2 ) THEN
+               wdmask(ji, jj) = 0._wp
+               zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt )
+               !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt )
+               ! flag if the limiter has been used but stop flagging if the only
+               ! changes have zeroed the coefficient since further iterations will
+               ! not change anything
+               IF( zcoef > 0._wp ) THEN   ;   jflag = 1 
+               ELSE                       ;   zcoef = 0._wp
                ENDIF
-            END DO
-         END DO
+               IF( jk1 > nn_wdit )   zcoef = 0._wp
+               IF( zflxu1(ji  ,jj  ) > 0._wp )   zwdlmtu(ji  ,jj  ) = zcoef
+               IF( zflxu1(ji-1,jj  ) < 0._wp )   zwdlmtu(ji-1,jj  ) = zcoef
+               IF( zflxv1(ji  ,jj  ) > 0._wp )   zwdlmtv(ji  ,jj  ) = zcoef
+               IF( zflxv1(ji  ,jj-1) < 0._wp )   zwdlmtv(ji  ,jj-1) = zcoef
+            ENDIF
+         END_2D
          CALL lbc_lnk_multi( 'wet_dry', zwdlmtu, 'U', 1., zwdlmtv, 'V', 1. )
          !
@@ -255,18 +250,18 @@
       !
       DO jk = 1, jpkm1
-         un(:,:,jk) = un(:,:,jk) * zwdlmtu(:,:) 
-         vn(:,:,jk) = vn(:,:,jk) * zwdlmtv(:,:) 
+         puu(:,:,jk,Kmm) = puu(:,:,jk,Kmm) * zwdlmtu(:,:) 
+         pvv(:,:,jk,Kmm) = pvv(:,:,jk,Kmm) * zwdlmtv(:,:) 
       END DO
-      un_b(:,:) = un_b(:,:) * zwdlmtu(:, :)
-      vn_b(:,:) = vn_b(:,:) * zwdlmtv(:, :)
+      uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * zwdlmtu(:, :)
+      vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * zwdlmtv(:, :)
       !
 !!gm TO BE SUPPRESSED ?  these lbc_lnk are useless since zwdlmtu and zwdlmtv are defined everywhere !
-      CALL lbc_lnk_multi( 'wet_dry', un  , 'U', -1., vn  , 'V', -1. )
-      CALL lbc_lnk_multi( 'wet_dry', un_b, 'U', -1., vn_b, 'V', -1. )
+      CALL lbc_lnk_multi( 'wet_dry', puu(:,:,:,Kmm)  , 'U', -1., pvv(:,:,:,Kmm)  , 'V', -1. )
+      CALL lbc_lnk_multi( 'wet_dry', uu_b(:,:,Kmm), 'U', -1., vv_b(:,:,Kmm), 'V', -1. )
 !!gm
       !
       IF(jflag == 1 .AND. lwp)   WRITE(numout,*) 'Need more iterations in wad_lmt!!!'
       !
-      !IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field)
+      !IF( ln_rnf      )   CALL sbc_rnf_div( hdiv )          ! runoffs (update hdiv field)
       !
       IF( ln_timing )   CALL timing_stop('wad_lmt')      !
@@ -275,5 +270,5 @@
 
 
-   SUBROUTINE wad_lmt_bt( zflxu, zflxv, sshn_e, zssh_frc, rdtbt )
+   SUBROUTINE wad_lmt_bt( zflxu, zflxv, sshn_e, zssh_frc, rDt_e )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE wad_lmt  ***
@@ -285,5 +280,5 @@
       !! ** Action  : - calculate flux limiter and W/D flag
       !!----------------------------------------------------------------------
-      REAL(wp)                , INTENT(in   ) ::   rdtbt    ! ocean time-step index
+      REAL(wp)                , INTENT(in   ) ::   rDt_e    ! ocean time-step index
       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   zflxu,  zflxv, sshn_e, zssh_frc  
       !
@@ -304,5 +299,5 @@
       zdepwd = 50._wp   ! maximum depth that ocean cells can have W/D processes
       !
-      z2dt = rdtbt   
+      z2dt = rDt_e   
       !
       zflxp(:,:)   = 0._wp
@@ -311,25 +306,23 @@
       zwdlmtv(:,:) = 1._wp
       !
-      DO jj = 2, jpj      ! Horizontal Flux in u and v direction
-         DO ji = 2, jpi 
-            !
-            IF( tmask(ji, jj, 1 ) < 0.5_wp) CYCLE   ! we don't care about land cells
-            IF( ht_0(ji,jj) > zdepwd )      CYCLE   ! and cells which are unlikely to dry
-            !
-            zflxp(ji,jj) = MAX( zflxu(ji,jj) , 0._wp ) - MIN( zflxu(ji-1,jj  ) , 0._wp )   &
-               &         + MAX( zflxv(ji,jj) , 0._wp ) - MIN( zflxv(ji,  jj-1) , 0._wp ) 
-            zflxn(ji,jj) = MIN( zflxu(ji,jj) , 0._wp ) - MAX( zflxu(ji-1,jj  ) , 0._wp )   &
-               &         + MIN( zflxv(ji,jj) , 0._wp ) - MAX( zflxv(ji,  jj-1) , 0._wp ) 
-            !
-            zdep2 = ht_0(ji,jj) + sshn_e(ji,jj) - rn_wdmin1
-            IF( zdep2 <= 0._wp ) THEN  !add more safety, but not necessary
-              sshn_e(ji,jj) = rn_wdmin1 - ht_0(ji,jj)
-              IF( zflxu(ji  ,jj  ) > 0._wp)   zwdlmtu(ji  ,jj  ) = 0._wp
-              IF( zflxu(ji-1,jj  ) < 0._wp)   zwdlmtu(ji-1,jj  ) = 0._wp
-              IF( zflxv(ji  ,jj  ) > 0._wp)   zwdlmtv(ji  ,jj  ) = 0._wp
-              IF( zflxv(ji  ,jj-1) < 0._wp)   zwdlmtv(ji  ,jj-1) = 0._wp 
-            ENDIF
-         END DO
-      END DO
+      DO_2D_01_01
+         !
+         IF( tmask(ji, jj, 1 ) < 0.5_wp) CYCLE   ! we don't care about land cells
+         IF( ht_0(ji,jj) > zdepwd )      CYCLE   ! and cells which are unlikely to dry
+         !
+         zflxp(ji,jj) = MAX( zflxu(ji,jj) , 0._wp ) - MIN( zflxu(ji-1,jj  ) , 0._wp )   &
+            &         + MAX( zflxv(ji,jj) , 0._wp ) - MIN( zflxv(ji,  jj-1) , 0._wp ) 
+         zflxn(ji,jj) = MIN( zflxu(ji,jj) , 0._wp ) - MAX( zflxu(ji-1,jj  ) , 0._wp )   &
+            &         + MIN( zflxv(ji,jj) , 0._wp ) - MAX( zflxv(ji,  jj-1) , 0._wp ) 
+         !
+         zdep2 = ht_0(ji,jj) + sshn_e(ji,jj) - rn_wdmin1
+         IF( zdep2 <= 0._wp ) THEN  !add more safety, but not necessary
+           sshn_e(ji,jj) = rn_wdmin1 - ht_0(ji,jj)
+           IF( zflxu(ji  ,jj  ) > 0._wp)   zwdlmtu(ji  ,jj  ) = 0._wp
+           IF( zflxu(ji-1,jj  ) < 0._wp)   zwdlmtu(ji-1,jj  ) = 0._wp
+           IF( zflxv(ji  ,jj  ) > 0._wp)   zwdlmtv(ji  ,jj  ) = 0._wp
+           IF( zflxv(ji  ,jj-1) < 0._wp)   zwdlmtv(ji  ,jj-1) = 0._wp 
+         ENDIF
+      END_2D
       !
       DO jk1 = 1, nn_wdit + 1      !! start limiter iterations 
@@ -339,39 +332,37 @@
          jflag = 0     ! flag indicating if any further iterations are needed
          !
-         DO jj = 2, jpj
-            DO ji = 2, jpi 
-               !
-               IF( tmask(ji, jj, 1 ) < 0.5_wp )   CYCLE 
-               IF( ht_0(ji,jj)       > zdepwd )   CYCLE
-               !
-               ztmp = e1e2t(ji,jj)
-               !
-               zzflxp = max(zflxu1(ji,jj), 0._wp) - min(zflxu1(ji-1,jj),   0._wp)   &
-                  &   + max(zflxv1(ji,jj), 0._wp) - min(zflxv1(ji,  jj-1), 0._wp) 
-               zzflxn = min(zflxu1(ji,jj), 0._wp) - max(zflxu1(ji-1,jj),   0._wp)   &
-                  &   + min(zflxv1(ji,jj), 0._wp) - max(zflxv1(ji,  jj-1), 0._wp) 
-          
-               zdep1 = (zzflxp + zzflxn) * z2dt / ztmp
-               zdep2 = ht_0(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 - z2dt * zssh_frc(ji,jj)
-          
-               IF(zdep1 > zdep2) THEN
-                 zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt )
-                 !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt )
-                 ! flag if the limiter has been used but stop flagging if the only
-                 ! changes have zeroed the coefficient since further iterations will
-                 ! not change anything
-                 IF( zcoef > 0._wp ) THEN
-                    jflag = 1 
-                 ELSE
-                    zcoef = 0._wp
-                 ENDIF
-                 IF(jk1 > nn_wdit) zcoef = 0._wp
-                 IF(zflxu1(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = zcoef
-                 IF(zflxu1(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = zcoef
-                 IF(zflxv1(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = zcoef
-                 IF(zflxv1(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = zcoef
-               END IF
-            END DO ! ji loop
-         END DO  ! jj loop
+         DO_2D_01_01
+            !
+            IF( tmask(ji, jj, 1 ) < 0.5_wp )   CYCLE 
+            IF( ht_0(ji,jj)       > zdepwd )   CYCLE
+            !
+            ztmp = e1e2t(ji,jj)
+            !
+            zzflxp = max(zflxu1(ji,jj), 0._wp) - min(zflxu1(ji-1,jj),   0._wp)   &
+               &   + max(zflxv1(ji,jj), 0._wp) - min(zflxv1(ji,  jj-1), 0._wp) 
+            zzflxn = min(zflxu1(ji,jj), 0._wp) - max(zflxu1(ji-1,jj),   0._wp)   &
+               &   + min(zflxv1(ji,jj), 0._wp) - max(zflxv1(ji,  jj-1), 0._wp) 
+       
+            zdep1 = (zzflxp + zzflxn) * z2dt / ztmp
+            zdep2 = ht_0(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 - z2dt * zssh_frc(ji,jj)
+       
+            IF(zdep1 > zdep2) THEN
+              zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt )
+              !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt )
+              ! flag if the limiter has been used but stop flagging if the only
+              ! changes have zeroed the coefficient since further iterations will
+              ! not change anything
+              IF( zcoef > 0._wp ) THEN
+                 jflag = 1 
+              ELSE
+                 zcoef = 0._wp
+              ENDIF
+              IF(jk1 > nn_wdit) zcoef = 0._wp
+              IF(zflxu1(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = zcoef
+              IF(zflxu1(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = zcoef
+              IF(zflxv1(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = zcoef
+              IF(zflxv1(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = zcoef
+            END IF
+         END_2D
          !
          CALL lbc_lnk_multi( 'wet_dry', zwdlmtu, 'U', 1., zwdlmtv, 'V', 1. )
@@ -392,5 +383,5 @@
       IF( jflag == 1 .AND. lwp )   WRITE(numout,*) 'Need more iterations in wad_lmt_bt!!!'
       !
-      !IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field)
+      !IF( ln_rnf      )   CALL sbc_rnf_div( hdiv )          ! runoffs (update hdiv field)
       !
       IF( ln_timing )   CALL timing_stop('wad_lmt_bt')      !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/FLO/flo4rk.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/FLO/flo4rk.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/FLO/flo4rk.F90	(revision 12928)
@@ -33,5 +33,5 @@
 CONTAINS
 
-   SUBROUTINE flo_4rk( kt )
+   SUBROUTINE flo_4rk( kt, Kbb, Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE flo_4rk  ***
@@ -45,5 +45,6 @@
       !!       floats and the grid defined on the domain.
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER, INTENT(in) ::   kt         ! ocean time-step index
+      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices
       !!
       INTEGER ::  jfl, jind           ! dummy loop indices
@@ -125,11 +126,11 @@
       
          ! for each step we compute the compute the velocity with Lagrange interpolation
-         CALL flo_interp( zgifl, zgjfl, zgkfl, zufl, zvfl, zwfl, jind )
+         CALL flo_interp( Kbb, Kmm, 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)
+            zrkxfl(jfl,jind) = rn_Dt*zufl(jfl)
+            zrkyfl(jfl,jind) = rn_Dt*zvfl(jfl)
+            zrkzfl(jfl,jind) = rn_Dt*zwfl(jfl)
          END DO
          IF( jind /= 4 ) THEN
@@ -153,5 +154,6 @@
 
 
-   SUBROUTINE flo_interp( pxt , pyt , pzt ,      &
+   SUBROUTINE flo_interp( Kbb, Kmm,              &
+      &                   pxt , pyt , pzt ,      &
       &                   pufl, pvfl, pwfl, ki )
       !!----------------------------------------------------------------------
@@ -165,4 +167,5 @@
       !!      integrated with RK method.
       !!----------------------------------------------------------------------
+      INTEGER                    , INTENT(in   ) ::   Kbb, Kmm           ! ocean time level indices
       REAL(wp) , DIMENSION(jpnfl), INTENT(in   ) ::   pxt , pyt , pzt    ! position of the float
       REAL(wp) , DIMENSION(jpnfl), INTENT(  out) ::   pufl, pvfl, pwfl   ! velocity at this position
@@ -246,6 +249,6 @@
                DO jind3 = 1, 4
                   ztufl(jfl,jind1,jind2,jind3) =   &
-                     &   (  tcoef1(ki) * ub(iidu(jfl,jind1),ijdu(jfl,jind2),ikdu(jfl,jind3)) +   &
-                     &      tcoef2(ki) * un(iidu(jfl,jind1),ijdu(jfl,jind2),ikdu(jfl,jind3)) )   &
+                     &   (  tcoef1(ki) * uu(iidu(jfl,jind1),ijdu(jfl,jind2),ikdu(jfl,jind3),Kbb) +   &
+                     &      tcoef2(ki) * uu(iidu(jfl,jind1),ijdu(jfl,jind2),ikdu(jfl,jind3),Kmm) )   &
                      &      / e1u(iidu(jfl,jind1),ijdu(jfl,jind2)) 
                END DO
@@ -330,6 +333,6 @@
                DO jind3 = 1 ,4
                   ztvfl(jfl,jind1,jind2,jind3)=   &
-                     &   ( tcoef1(ki) * vb(iidv(jfl,jind1),ijdv(jfl,jind2),ikdv(jfl,jind3))  +   &
-                     &     tcoef2(ki) * vn(iidv(jfl,jind1),ijdv(jfl,jind2),ikdv(jfl,jind3)) )    & 
+                     &   ( tcoef1(ki) * vv(iidv(jfl,jind1),ijdv(jfl,jind2),ikdv(jfl,jind3),Kbb)  +   &
+                     &     tcoef2(ki) * vv(iidv(jfl,jind1),ijdv(jfl,jind2),ikdv(jfl,jind3),Kmm) )    & 
                      &     / e2v(iidv(jfl,jind1),ijdv(jfl,jind2))
                END DO
@@ -422,6 +425,6 @@
                   ztwfl(jfl,jind1,jind2,jind3)=   &
                      &   ( tcoef1(ki) * wb(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3))+   &
-                     &     tcoef2(ki) * wn(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3)) )  &
-                     &   / e3w_n(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3))
+                     &     tcoef2(ki) * ww(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3)) )  &
+                     &   / e3w(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3),Kmm)
                END DO
             END DO
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/FLO/floats.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/FLO/floats.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/FLO/floats.F90	(revision 12928)
@@ -37,5 +37,5 @@
 CONTAINS
 
-   SUBROUTINE flo_stp( kt )
+   SUBROUTINE flo_stp( kt, Kbb, Kmm )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE flo_stp  ***
@@ -48,20 +48,21 @@
       !!        if ln_flork4 =T
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+      INTEGER, INTENT( in  ) ::   kt        ! ocean time step
+      INTEGER, INTENT( in  ) ::   Kbb, Kmm  ! ocean time level indices 
       !!----------------------------------------------------------------------
       !
       IF( ln_timing )   CALL timing_start('flo_stp')
       !
-      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
+      IF( ln_flork4 ) THEN   ;   CALL flo_4rk( kt, Kbb, Kmm )  ! Trajectories using a 4th order Runge Kutta scheme
+      ELSE                   ;   CALL flo_blk( kt, Kbb, Kmm )  ! Trajectories using Blanke' algorithme
       ENDIF
       !
       IF( lk_mpp )   CALL mppsync   ! synchronization of all the processor
       !
-      CALL flo_wri( kt )      ! trajectories ouput 
+      CALL flo_wri( kt, Kmm ) ! trajectories ouput 
       !
       CALL flo_rst( kt )      ! trajectories restart
       !
-      wb(:,:,:) = wn(:,:,:)         ! Save the old vertical velocity field
+      wb(:,:,:) = ww(:,:,:)         ! Save the old vertical velocity field
       !
       IF( ln_timing )   CALL timing_stop('flo_stp')
@@ -70,5 +71,5 @@
 
 
-   SUBROUTINE flo_init
+   SUBROUTINE flo_init( Kmm )
       !!----------------------------------------------------------------
       !!                 ***  ROUTINE flo_init  ***
@@ -76,4 +77,6 @@
       !! ** Purpose :   Read the namelist of floats
       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: Kmm       ! ocean time level index
+      !
       INTEGER ::   jfl
       INTEGER ::   ios                 ! Local integer output status for namelist read
@@ -86,9 +89,7 @@
       IF(lwp) WRITE(numout,*) '~~~~~~~'
 
-      REWIND( numnam_ref )              ! Namelist namflo in reference namelist : Floats
       READ  ( numnam_ref, namflo, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namflo in reference namelist' )
 
-      REWIND( numnam_cfg )              ! Namelist namflo in configuration namelist : Floats
       READ  ( numnam_cfg, namflo, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namflo in configuration namelist' )
@@ -130,10 +131,9 @@
          END DO
          !
-         CALL flo_dom                  ! compute/read initial position of floats
+         CALL flo_dom( Kmm )           ! compute/read initial position of floats
          !
-         wb(:,:,:) = wn(:,:,:)         ! set wb for computation of floats trajectories at the first time step
+         wb(:,:,:) = ww(:,:,:)         ! set wb for computation of floats trajectories at the first time step
          !
       ENDIF
-      !
    END SUBROUTINE flo_init
 
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/FLO/floblk.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/FLO/floblk.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/FLO/floblk.F90	(revision 12928)
@@ -27,5 +27,5 @@
 CONTAINS
 
-   SUBROUTINE flo_blk( kt )
+   SUBROUTINE flo_blk( kt, Kbb, Kmm )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE flo_blk  ***
@@ -38,5 +38,6 @@
       !!      of the floats and the grid defined on the domain.
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in  ) ::   kt ! ocean time step
+      INTEGER, INTENT( in  ) ::   kt       ! ocean time step
+      INTEGER, INTENT( in  ) ::   Kbb, Kmm ! ocean time level indices
       !!
       INTEGER :: jfl              ! dummy loop arguments
@@ -110,22 +111,22 @@
             ! compute the transport across the mesh where the float is.            
 !!bug (gm) change e3t into e3. but never checked 
-            zsurfx(1) = e2u(iiloc(jfl)-1,ijloc(jfl)  ) * e3u_n(iiloc(jfl)-1,ijloc(jfl)  ,-ikl(jfl))
-            zsurfx(2) = e2u(iiloc(jfl)  ,ijloc(jfl)  ) * e3u_n(iiloc(jfl)  ,ijloc(jfl)  ,-ikl(jfl))
-            zsurfy(1) = e1v(iiloc(jfl)  ,ijloc(jfl)-1) * e3v_n(iiloc(jfl)  ,ijloc(jfl)-1,-ikl(jfl))
-            zsurfy(2) = e1v(iiloc(jfl)  ,ijloc(jfl)  ) * e3v_n(iiloc(jfl)  ,ijloc(jfl)  ,-ikl(jfl))
+            zsurfx(1) = e2u(iiloc(jfl)-1,ijloc(jfl)  ) * e3u(iiloc(jfl)-1,ijloc(jfl)  ,-ikl(jfl),Kmm)
+            zsurfx(2) = e2u(iiloc(jfl)  ,ijloc(jfl)  ) * e3u(iiloc(jfl)  ,ijloc(jfl)  ,-ikl(jfl),Kmm)
+            zsurfy(1) = e1v(iiloc(jfl)  ,ijloc(jfl)-1) * e3v(iiloc(jfl)  ,ijloc(jfl)-1,-ikl(jfl),Kmm)
+            zsurfy(2) = e1v(iiloc(jfl)  ,ijloc(jfl)  ) * e3v(iiloc(jfl)  ,ijloc(jfl)  ,-ikl(jfl),Kmm)
 
             ! for a isobar float zsurfz is put to zero. The vertical velocity will be zero too.
             zsurfz =          e1e2t(iiloc(jfl),ijloc(jfl))
-            zvol   = zsurfz * e3t_n(iiloc(jfl),ijloc(jfl),-ikl(jfl))
+            zvol   = zsurfz * e3t(iiloc(jfl),ijloc(jfl),-ikl(jfl),Kmm)
 
             !
-            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)
+            zuinfl =( uu(iiloc(jfl)-1,ijloc(jfl),-ikl(jfl),Kbb) + uu(iiloc(jfl)-1,ijloc(jfl),-ikl(jfl),Kmm) )/2.*zsurfx(1)
+            zuoutfl=( uu(iiloc(jfl)  ,ijloc(jfl),-ikl(jfl),Kbb) + uu(iiloc(jfl)  ,ijloc(jfl),-ikl(jfl),Kmm) )/2.*zsurfx(2)
+            zvinfl =( vv(iiloc(jfl),ijloc(jfl)-1,-ikl(jfl),Kbb) + vv(iiloc(jfl),ijloc(jfl)-1,-ikl(jfl),Kmm) )/2.*zsurfy(1)
+            zvoutfl=( vv(iiloc(jfl),ijloc(jfl)  ,-ikl(jfl),Kbb) + vv(iiloc(jfl),ijloc(jfl)  ,-ikl(jfl),Kmm) )/2.*zsurfy(2)
             zwinfl =-(wb(iiloc(jfl),ijloc(jfl),-(ikl(jfl)-1))    &
-               &   +  wn(iiloc(jfl),ijloc(jfl),-(ikl(jfl)-1)) )/2. *  zsurfz*nisobfl(jfl)
+               &   +  ww(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)
+               &   +  ww(iiloc(jfl),ijloc(jfl),- ikl(jfl)   ) )/2. *  zsurfz*nisobfl(jfl)
             
             ! interpolation of velocity field on the float initial position            
@@ -174,5 +175,5 @@
             zgidfl(jfl) = float(iioutfl(jfl) - iiinfl(jfl))
             IF( zufl(jfl)*zuoutfl <= 0. ) THEN
-               ztxfl(jfl) = 1.E99
+               ztxfl(jfl) = HUGE(1._wp)
             ELSE
                IF( ABS(zudfl(jfl)) >= 1.E-5 ) THEN
@@ -190,5 +191,5 @@
             zgjdfl(jfl) = float(ijoutfl(jfl)-ijinfl(jfl))
             IF( zvfl(jfl)*zvoutfl <= 0. ) THEN
-               ztyfl(jfl) = 1.E99
+               ztyfl(jfl) = HUGE(1._wp)
             ELSE
                IF( ABS(zvdfl(jfl)) >= 1.E-5 ) THEN
@@ -207,5 +208,5 @@
                zgkdfl(jfl) = float(ikoutfl(jfl) - ikinfl(jfl))
                IF( zwfl(jfl)*zwoutfl <= 0. ) THEN
-                  ztzfl(jfl) = 1.E99
+                  ztzfl(jfl) = HUGE(1._wp)
                ELSE
                   IF( ABS(zwdfl(jfl)) >= 1.E-5 ) THEN
@@ -232,7 +233,7 @@
             ! 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
+            IF( zagenewfl(jfl) > rn_Dt ) THEN
+               zttfl(jfl) = (rn_Dt-zagefl(jfl)) / zvol
+               zagenewfl(jfl) = rn_Dt
             ENDIF
             
@@ -339,5 +340,5 @@
          ifin = 1
          DO jfl = 1, jpnfl
-            IF( zagefl(jfl) < rdt )   ifin = 0
+            IF( zagefl(jfl) < rn_Dt )   ifin = 0
             tpifl(jfl) = zgifl(jfl) + 0.5
             tpjfl(jfl) = zgjfl(jfl) + 0.5
@@ -346,5 +347,5 @@
          ifin = 1
          DO jfl = 1, jpnfl
-            IF( zagefl(jfl) < rdt )   ifin = 0
+            IF( zagefl(jfl) < rn_Dt )   ifin = 0
             tpifl(jfl) = zgifl(jfl) + 0.5
             tpjfl(jfl) = zgjfl(jfl) + 0.5
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/FLO/flodom.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/FLO/flodom.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/FLO/flodom.F90	(revision 12928)
@@ -40,5 +40,5 @@
 CONTAINS
 
-   SUBROUTINE flo_dom
+   SUBROUTINE flo_dom( Kmm )
       !! ---------------------------------------------------------------------
       !!                  ***  ROUTINE flo_dom  ***
@@ -49,4 +49,6 @@
       !!               the longitude (degree) and the depth (m).
       !!----------------------------------------------------------------------      
+      INTEGER, INTENT(in) ::  Kmm    ! ocean time level index
+      !
       INTEGER            ::   jfl    ! dummy loop  
       INTEGER            ::   inum   ! logical unit for file read
@@ -90,5 +92,5 @@
                 CALL flo_add_new_ariane_floats(jpnrstflo+1,jpnfl) 
             ELSE                 !Add new floats with long/lat convention
-                CALL flo_add_new_floats(jpnrstflo+1,jpnfl)
+                CALL flo_add_new_floats(Kmm,jpnrstflo+1,jpnfl)
             ENDIF
          ENDIF
@@ -102,5 +104,5 @@
             CALL flo_add_new_ariane_floats(1,jpnfl)
          ELSE                      !Add new floats with long/lat convention
-            CALL flo_add_new_floats(1,jpnfl)
+            CALL flo_add_new_floats(Kmm,1,jpnfl)
          ENDIF
 
@@ -109,5 +111,5 @@
    END SUBROUTINE flo_dom
 
-   SUBROUTINE flo_add_new_floats(kfl_start, kfl_end)
+   SUBROUTINE flo_add_new_floats(Kmm, kfl_start, kfl_end)
       !! -------------------------------------------------------------
       !!                 ***  SUBROUTINE add_new_arianefloats  ***
@@ -124,4 +126,5 @@
       !! ** Method  : 
       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: Kmm
       INTEGER, INTENT(in) :: kfl_start, kfl_end
       !!
@@ -170,5 +173,5 @@
                   ihtest(jfl) = ihtest(jfl)+1
                   DO jk = 1, jpk-1
-                     IF( (gdepw_n(ji,jj,jk) <= flzz(jfl)) .AND. (gdepw_n(ji,jj,jk+1) > flzz(jfl)) ) THEN
+                     IF( (gdepw(ji,jj,jk,Kmm) <= flzz(jfl)) .AND. (gdepw(ji,jj,jk+1,Kmm) > flzz(jfl)) ) THEN
                         ikmfl(jfl) = jk
                         ivtest(jfl) = ivtest(jfl) + 1
@@ -232,10 +235,10 @@
             zgifl(jfl)= (iimfl(jfl)-0.5) + zdxab/e1u(iimfl(jfl)-1,ijmfl(jfl)) + (mig(1)-1)
             zgjfl(jfl)= (ijmfl(jfl)-0.5) + zdyad/e2v(iimfl(jfl),ijmfl(jfl)-1) + (mjg(1)-1)
-            zgkfl(jfl) = (( gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - flzz(jfl) )* ikmfl(jfl))   &
-               &                 / (  gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1)                              &
-               &                    - gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl) ) )                             &
-               &                 + (( flzz(jfl)-gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) ) *(ikmfl(jfl)+1))   &
-               &                 / (  gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1)                              &
-               &                    - gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) )
+            zgkfl(jfl) = (( gdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1,Kmm) - flzz(jfl) )* ikmfl(jfl))   &
+               &                 / (  gdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1,Kmm)                              &
+               &                    - gdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl) ,Kmm) )                             &
+               &                 + (( flzz(jfl)-gdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl),Kmm) ) *(ikmfl(jfl)+1))   &
+               &                 / (  gdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1,Kmm)                              &
+               &                    - gdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl),Kmm) )
          ELSE
             zgifl(jfl) = 0.e0
@@ -433,5 +436,5 @@
       IF( ABS(dlx) > 1.0_wp ) dlx = 1.0_wp
       !
-      dld = ATAN(DSQRT( 1._wp * ( 1._wp-dlx )/( 1._wp+dlx ) )) * 222.24_wp / dls
+      dld = ATAN(SQRT( 1._wp * ( 1._wp-dlx )/( 1._wp+dlx ) )) * 222.24_wp / dls
       flo_dstnce = dld * 1000._wp
       !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/FLO/flowri.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/FLO/flowri.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/FLO/flowri.F90	(revision 12928)
@@ -51,5 +51,5 @@
    END FUNCTION flo_wri_alloc
 
-   SUBROUTINE flo_wri( kt )
+   SUBROUTINE flo_wri( kt, Kmm )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE flo_wri ***
@@ -64,5 +64,6 @@
       !!----------------------------------------------------------------------
       !! * Arguments
-      INTEGER  :: kt                               ! time step
+      INTEGER, INTENT(in)  :: kt                 ! time step
+      INTEGER, INTENT(in)  :: Kmm                ! time level index
 
       !! * Local declarations
@@ -116,10 +117,10 @@
                zlon(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)
-               zdep(jfl) = (1.-zcfl)*gdepw_n(iafloc,ibfloc,icfl ) + zcfl * gdepw_n(iafloc,ibfloc,ic1fl)     
+               zdep(jfl) = (1.-zcfl)*gdepw(iafloc,ibfloc,icfl ,Kmm) + zcfl * gdepw(iafloc,ibfloc,ic1fl,Kmm)     
 
                !save temperature, salinity and density at this position
-               ztem(jfl) = tsn(iafloc,ibfloc,icfl,jp_tem)
-               zsal (jfl) = tsn(iafloc,ibfloc,icfl,jp_sal)
-               zrho (jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rau0
+               ztem(jfl) = ts(iafloc,ibfloc,icfl,jp_tem,Kmm)
+               zsal (jfl) = ts(iafloc,ibfloc,icfl,jp_sal,Kmm)
+               zrho (jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rho0
 
             ENDIF
@@ -137,9 +138,9 @@
             zlon(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)
-            zdep(jfl) = (1.-zcfl)*gdepw_n(iafloc,ibfloc,icfl ) + zcfl * gdepw_n(iafloc,ibfloc,ic1fl)
-
-            ztem(jfl) = tsn(iafloc,ibfloc,icfl,jp_tem)
-            zsal(jfl) = tsn(iafloc,ibfloc,icfl,jp_sal)
-            zrho(jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rau0
+            zdep(jfl) = (1.-zcfl)*gdepw(iafloc,ibfloc,icfl ,Kmm) + zcfl * gdepw(iafloc,ibfloc,ic1fl,Kmm)
+
+            ztem(jfl) = ts(iafloc,ibfloc,icfl,jp_tem,Kmm)
+            zsal(jfl) = ts(iafloc,ibfloc,icfl,jp_sal,Kmm)
+            zrho(jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rho0
           
          ENDIF
@@ -221,5 +222,5 @@
                clname=TRIM(clname)//".nc"
 
-               CALL fliocrfd( clname , (/ 'ntraj' , 't' /), (/ jpnfl , -1  /) , numflo )
+               CALL fliocrfd( clname , (/'ntraj' , '    t' /), (/ jpnfl , -1/) , numflo )
    
                CALL fliodefv( numflo, 'traj_lon'    , (/1,2/), v_t=flio_r8, long_name="Longitude"           , units="degrees_east"  )
@@ -244,5 +245,5 @@
             !-------------------------------
             irec =  INT( (kt-nn_it000+1)/nn_writefl ) +1
-            ztime = ( kt-nn_it000 + 1 ) * rdt
+            ztime = ( kt-nn_it000 + 1 ) * rn_Dt
 
             CALL flioputv( numflo , 'time_counter', ztime , start=(/irec/) )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ICB/icb_oce.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ICB/icb_oce.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ICB/icb_oce.F90	(revision 12928)
@@ -124,4 +124,8 @@
    LOGICAL , PUBLIC ::   ln_time_average_weight          !: Time average the weight on the ocean    !!gm I don't understand that !
    REAL(wp), PUBLIC ::   rn_speed_limit                  !: CFL speed limit for a berg
+   !
+   ! restart
+   CHARACTER(len=256), PUBLIC :: cn_icbrst_indir , cn_icbrst_in  !:  in: restart directory, restart name
+   CHARACTER(len=256), PUBLIC :: cn_icbrst_outdir, cn_icbrst_out !: out: restart directory, restart name
    !
    !                                     ! Mass thresholds between iceberg classes [kg]
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ICB/icbclv.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ICB/icbclv.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ICB/icbclv.F90	(revision 12928)
@@ -32,4 +32,6 @@
    PUBLIC   icb_clv      ! routine called in icbstp.F90 module
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -69,26 +71,22 @@
          !  where (berg_grid%calving==0.) berg_grid%stored_ice(:,:,jn)=0.
          !end do
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               IF( berg_grid%calving(ji,jj) /= 0._wp )                                          &    ! Need units of J
-                  berg_grid%stored_heat(ji,jj) = SUM( berg_grid%stored_ice(ji,jj,:) ) *         &    ! initial stored ice in kg
-                     &                   berg_grid%calving_hflx(ji,jj) * e1e2t(ji,jj) / berg_grid%calving(ji,jj)   ! J/s/m2 x m^2 
-                     !                                                                                             ! = J/s/calving in kg/s
-            END DO
-         END DO
+         DO_2D_00_00
+            IF( berg_grid%calving(ji,jj) /= 0._wp )                                          &    ! Need units of J
+               berg_grid%stored_heat(ji,jj) = SUM( berg_grid%stored_ice(ji,jj,:) ) *         &    ! initial stored ice in kg
+                  &                   berg_grid%calving_hflx(ji,jj) * e1e2t(ji,jj) / berg_grid%calving(ji,jj)   ! J/s/m2 x m^2 
+                  !                                                                                             ! = J/s/calving in kg/s
+         END_2D
       ENDIF
 
       ! assume that all calving flux must be distributed even if distribution array does not sum
       ! to one - this may not be what is intended, but it's what you've got
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            imx = berg_grid%maxclass(ji,jj)
-            zdist = SUM( rn_distribution(1:nclasses) ) / SUM( rn_distribution(1:imx) )
-            DO jn = 1, imx
-               berg_grid%stored_ice(ji,jj,jn) = berg_grid%stored_ice(ji,jj,jn)     &
-                  &                           + berg_dt * berg_grid%calving(ji,jj) * rn_distribution(jn) * zdist
-            END DO
+      DO_2D_11_11
+         imx = berg_grid%maxclass(ji,jj)
+         zdist = SUM( rn_distribution(1:nclasses) ) / SUM( rn_distribution(1:imx) )
+         DO jn = 1, imx
+            berg_grid%stored_ice(ji,jj,jn) = berg_grid%stored_ice(ji,jj,jn)     &
+               &                           + berg_dt * berg_grid%calving(ji,jj) * rn_distribution(jn) * zdist
          END DO
-      END DO
+      END_2D
 
       ! before changing the calving, save the amount we're about to use and do budget
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ICB/icbini.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ICB/icbini.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ICB/icbini.F90	(revision 12928)
@@ -39,4 +39,6 @@
    TYPE(FLD), PUBLIC, ALLOCATABLE     , DIMENSION(:)  ::   sf_icb          !: structure: file information, fields read
                                                                            !: used in icbini and icbstp
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -58,5 +60,5 @@
       !!              - setup either test icebergs or calving file
       !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in) ::   pdt   ! iceberg time-step (rdt*nn_fsbc)
+      REAL(wp), INTENT(in) ::   pdt   ! iceberg time-step (rn_Dt*nn_fsbc)
       INTEGER , INTENT(in) ::   kt    ! time step number
       !
@@ -121,10 +123,8 @@
       nicbfldproc(:) = -1
 
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            src_calving_hflx(ji,jj) = narea
-            src_calving     (ji,jj) = nicbpack * mjg(jj) + mig(ji)
-         END DO
-      END DO
+      DO_2D_11_11
+         src_calving_hflx(ji,jj) = narea
+         src_calving     (ji,jj) = nicbpack * mjg(jj) + mig(ji)
+      END_2D
       CALL lbc_lnk( 'icbini', src_calving_hflx, 'T', 1._wp )
       CALL lbc_lnk( 'icbini', src_calving     , 'T', 1._wp )
@@ -383,5 +383,6 @@
          &              rn_bits_erosion_fraction        , rn_sicn_shift       , ln_passive_mode      ,   &
          &              ln_time_average_weight          , nn_test_icebergs    , rn_test_box          ,   &
-         &              ln_use_calving , rn_speed_limit , cn_dir, sn_icb
+         &              ln_use_calving , rn_speed_limit , cn_dir, sn_icb      ,                          &
+         &              cn_icbrst_indir, cn_icbrst_in   , cn_icbrst_outdir    , cn_icbrst_out
       !!----------------------------------------------------------------------
 
@@ -404,8 +405,6 @@
 #endif   
       !                             !==  read namelist  ==!
-      REWIND( numnam_ref )              ! Namelist namberg in reference namelist : Iceberg parameters
       READ  ( numnam_ref, namberg, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namberg in reference namelist' )
-      REWIND( numnam_cfg )              ! Namelist namberg in configuration namelist : Iceberg parameters
       READ  ( numnam_cfg, namberg, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namberg in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ICB/icblbc.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ICB/icblbc.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ICB/icblbc.F90	(revision 12928)
@@ -63,4 +63,6 @@
    PUBLIC   icb_lbc_mpp
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ICB/icbrst.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ICB/icbrst.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ICB/icbrst.F90	(revision 12928)
@@ -69,10 +69,9 @@
       TYPE(point)                  ::   localpt   ! NOT a pointer but an actual local variable
       !!----------------------------------------------------------------------
-
       ! Find a restart file. Assume iceberg restarts in same directory as ocean restarts
       ! and are called TRIM(cn_ocerst)//'_icebergs'
-      cl_path = TRIM(cn_ocerst_indir)
+      cl_path = TRIM(cn_icbrst_indir)
       IF( cl_path(LEN_TRIM(cl_path):) /= '/' ) cl_path = TRIM(cl_path) // '/'
-      cl_filename = TRIM(cn_ocerst_in)//'_icebergs'
+      cl_filename = TRIM(cn_icbrst_in)
       CALL iom_open( TRIM(cl_path)//cl_filename, ncid )
 
@@ -192,4 +191,5 @@
       CHARACTER(len=256)     :: cl_path
       CHARACTER(len=256)     :: cl_filename
+      CHARACTER(len=256)     :: cl_kt
       TYPE(iceberg), POINTER :: this
       TYPE(point)  , POINTER :: pt
@@ -204,11 +204,18 @@
          ! Only operate on the restart timestep itself.
          ! Assume we write iceberg restarts to same directory as ocean restarts.
-         cl_path = TRIM(cn_ocerst_outdir)
+         !
+         ! directory name
+         cl_path = TRIM(cn_icbrst_outdir)
          IF( cl_path(LEN_TRIM(cl_path):) /= '/' ) cl_path = TRIM(cl_path) // '/'
+         !
+         ! file name
+         WRITE(cl_kt, '(i8.8)') kt
+         cl_filename = TRIM(cexper)//"_"//TRIM(ADJUSTL(cl_kt))//"_"//TRIM(cn_icbrst_out)
          IF( lk_mpp ) THEN
-            WRITE(cl_filename,'(A,"_icebergs_",I8.8,"_restart_",I4.4,".nc")') TRIM(cexper), kt, narea-1
+            WRITE(cl_filename,'(A,"_",I4.4,".nc")') TRIM(cl_filename), narea-1
          ELSE
-            WRITE(cl_filename,'(A,"_icebergs_",I8.8,"_restart.nc")') TRIM(cexper), kt
+            WRITE(cl_filename,'(A,".nc")') TRIM(cl_filename)
          ENDIF
+
          IF ( lwp .AND. nn_verbose_level >= 0) WRITE(numout,'(2a)') 'icebergs, write_restart: creating ',  &
            &                                                         TRIM(cl_path)//TRIM(cl_filename)
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ICB/icbthm.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ICB/icbthm.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ICB/icbthm.F90	(revision 12928)
@@ -20,4 +20,5 @@
    USE phycst         ! NEMO physical constants
    USE sbc_oce
+   USE lib_fortran, ONLY : DDPDD
 
    USE icb_oce        ! define iceberg arrays
@@ -55,5 +56,11 @@
       TYPE(iceberg), POINTER ::   this, next
       TYPE(point)  , POINTER ::   pt
+      !
+      COMPLEX(wp), DIMENSION(jpi,jpj) :: cicb_melt, cicb_hflx
       !!----------------------------------------------------------------------
+      !
+      !! initialiaze cicb_melt and cicb_heat
+      cicb_melt = CMPLX( 0.e0, 0.e0, wp ) 
+      cicb_hflx = CMPLX( 0.e0, 0.e0, wp ) 
       !
       z1_rday = 1._wp / rday
@@ -165,6 +172,12 @@
             z1_e1e2    = r1_e1e2t(ii,ij) * this%mass_scaling
             z1_dt_e1e2 = z1_dt * z1_e1e2
+            !
+            ! iceberg melt
+            !! the use of DDPDD function for the cumulative sum is needed for reproducibility
             zmelt    = ( zdM - ( zdMbitsE - zdMbitsM ) ) * z1_dt   ! kg/s
-            berg_grid%floating_melt(ii,ij) = berg_grid%floating_melt(ii,ij) + zmelt    * z1_e1e2    ! kg/m2/s
+            CALL DDPDD( CMPLX( zmelt * z1_e1e2, 0.e0, wp ), cicb_melt(ii,ij) )
+            !
+            ! iceberg heat flux
+            !! the use of DDPDD function for the cumulative sum is needed for reproducibility
             !! NB. The src_calving_hflx field is currently hardwired to zero in icb_stp, which means that the
             !!     heat density of the icebergs is zero and the heat content flux to the ocean from iceberg
@@ -172,5 +185,7 @@
             zheat_hcflux = zmelt * pt%heat_density       ! heat content flux : kg/s x J/kg = J/s
             zheat_latent = - zmelt * rLfus               ! latent heat flux:  kg/s x J/kg = J/s
-            berg_grid%calving_hflx (ii,ij) = berg_grid%calving_hflx (ii,ij) + ( zheat_hcflux + zheat_latent ) * z1_e1e2    ! W/m2
+            CALL DDPDD( CMPLX( ( zheat_hcflux + zheat_latent ) * z1_e1e2, 0.e0, wp ), cicb_hflx(ii,ij) )
+            !
+            ! diagnostics
             CALL icb_dia_melt( ii, ij, zMnew, zheat_hcflux, zheat_latent, this%mass_scaling,       &
                &                       zdM, zdMbitsE, zdMbitsM, zdMb, zdMe,   &
@@ -214,5 +229,8 @@
          !
       END DO
-
+      !
+      berg_grid%floating_melt = REAL(cicb_melt,wp)    ! kg/m2/s
+      berg_grid%calving_hflx  = REAL(cicb_hflx,wp)
+      !
       ! now use melt and associated heat flux in ocean (or not)
       !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ICB/icbtrj.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ICB/icbtrj.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ICB/icbtrj.F90	(revision 12928)
@@ -74,5 +74,5 @@
 
       ! compute end time step date
-      zfjulday = fjulday + rdt / rday * REAL( nitend - nit000 + 1 , wp)
+      zfjulday = fjulday + rn_Dt / rday * REAL( nitend - nit000 + 1 , wp)
       IF( ABS(zfjulday - REAL(NINT(zfjulday),wp)) < 0.1 / rday )   zfjulday = REAL(NINT(zfjulday),wp)   ! avoid truncation error
       CALL ju2ymds( zfjulday, iyear, imonth, iday, zsec )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/IOM/in_out_manager.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/IOM/in_out_manager.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/IOM/in_out_manager.F90	(revision 12928)
@@ -87,8 +87,11 @@
    LOGICAL ::   lrst_oce              !: logical to control the oce restart write 
    LOGICAL ::   lrst_ice              !: logical to control the ice restart write 
+   LOGICAL ::   lrst_abl              !: logical to control the abl restart write 
    INTEGER ::   numror = 0            !: logical unit for ocean restart (read). Init to 0 is needed for SAS (in daymod.F90)
    INTEGER ::   numrir                !: logical unit for ice   restart (read)
+   INTEGER ::   numrar                !: logical unit for abl   restart (read)
    INTEGER ::   numrow                !: logical unit for ocean restart (write)
    INTEGER ::   numriw                !: logical unit for ice   restart (write)
+   INTEGER ::   numraw                !: logical unit for abl   restart (write)
    INTEGER ::   nrst_lst              !: number of restart to output next
 
@@ -96,16 +99,22 @@
    !!                    output monitoring
    !!----------------------------------------------------------------------
-   LOGICAL ::   ln_ctl           !: run control for debugging
-   TYPE :: sn_ctl                !: optional use structure for finer control over output selection
+   TYPE :: sn_ctl                !: structure for control over output selection
+      LOGICAL :: l_glochk  = .FALSE.  !: range sanity checks are local (F) or global (T)
+                                      !  Use global setting for debugging only;
+                                      !  local breaches will still be reported
+                                      !  and stop the code in most cases.
+      LOGICAL :: l_allon   = .FALSE.  !: overall control; activate all following output options
       LOGICAL :: l_config  = .FALSE.  !: activate/deactivate finer control
-                                      !  Note if l_config is True then ln_ctl is ignored.
-                                      !  Otherwise setting ln_ctl True is equivalent to setting
-                                      !  all the following logicals in this structure True
+                                      !  Note if l_config is True then sn_cfctl%l_allon is ignored.
+                                      !  Otherwise setting sn_cfctl%l_allon T/F is equivalent to 
+                                      !  setting all the following logicals in this structure T/F
+                                      !  and disabling subsetting of processors
       LOGICAL :: l_runstat = .FALSE.  !: Produce/do not produce run.stat file (T/F)
       LOGICAL :: l_trcstat = .FALSE.  !: Produce/do not produce tracer.stat file (T/F)
       LOGICAL :: l_oceout  = .FALSE.  !: Produce all ocean.outputs    (T) or just one (F)
       LOGICAL :: l_layout  = .FALSE.  !: Produce all layout.dat files (T) or just one (F)
-      LOGICAL :: l_mppout  = .FALSE.  !: Produce/do not produce mpp.output_XXXX files (T/F)
-      LOGICAL :: l_mpptop  = .FALSE.  !: Produce/do not produce mpp.top.output_XXXX files (T/F)
+      LOGICAL :: l_prtctl  = .FALSE.  !: Produce/do not produce mpp.output_XXXX files (T/F)
+      LOGICAL :: l_prttrc  = .FALSE.  !: Produce/do not produce mpp.top.output_XXXX files (T/F)
+      LOGICAL :: l_oasout  = .FALSE.  !: Produce/do not write oasis setup info to ocean.output (T/F)
                                       !  Optional subsetting of processor report files
                                       !  Default settings of 0/1000000/1 should ensure all areas report.
@@ -139,18 +148,19 @@
    INTEGER ::   numnul          =   -1      !: logical unit for /dev/null
       !                                     !  early output can be collected; do not change
-   INTEGER ::   numnam_ref      =   -1      !: logical unit for reference namelist
-   INTEGER ::   numnam_cfg      =   -1      !: logical unit for configuration specific namelist
    INTEGER ::   numond          =   -1      !: logical unit for Output Namelist Dynamics
-   INTEGER ::   numnam_ice_ref  =   -1      !: logical unit for ice reference namelist
-   INTEGER ::   numnam_ice_cfg  =   -1      !: logical unit for ice reference namelist
    INTEGER ::   numoni          =   -1      !: logical unit for Output Namelist Ice
    INTEGER ::   numevo_ice      =   -1      !: logical unit for ice variables (temp. evolution)
    INTEGER ::   numrun          =   -1      !: logical unit for run statistics
    INTEGER ::   numdct_in       =   -1      !: logical unit for transports computing
-   INTEGER ::   numdct_vol      =   -1      !: logical unit for voulume transports output
-   INTEGER ::   numdct_heat     =   -1      !: logical unit for heat    transports output
-   INTEGER ::   numdct_salt     =   -1      !: logical unit for salt    transports output
+   INTEGER ::   numdct_vol      =   -1      !: logical unit for volume transports output
+   INTEGER ::   numdct_heat     =   -1      !: logical unit for heat   transports output
+   INTEGER ::   numdct_salt     =   -1      !: logical unit for salt   transports output
    INTEGER ::   numfl           =   -1      !: logical unit for floats ascii output
    INTEGER ::   numflo          =   -1      !: logical unit for floats ascii output
+      !
+   CHARACTER(LEN=:), ALLOCATABLE :: numnam_ref      !: character buffer for reference namelist
+   CHARACTER(LEN=:), ALLOCATABLE :: numnam_cfg      !: character buffer for configuration specific namelist
+   CHARACTER(LEN=:), ALLOCATABLE :: numnam_ice_ref  !: character buffer for ice reference namelist
+   CHARACTER(LEN=:), ALLOCATABLE :: numnam_ice_cfg  !: character buffer for ice configuration specific namelist
 
    !!----------------------------------------------------------------------
@@ -165,5 +175,5 @@
    CHARACTER(lc) ::   ctmp10                !: temporary character 10
    LOGICAL       ::   lwm      = .FALSE.    !: boolean : true on the 1st processor only (always)
-   LOGICAL       ::   lwp      = .FALSE.    !: boolean : true on the 1st processor only .OR. ln_ctl
+   LOGICAL       ::   lwp      = .FALSE.    !: boolean : true on the 1st processor only .OR. sn_cfctl%l_oceout=T
    LOGICAL       ::   lsp_area = .TRUE.     !: to make a control print over a specific area
    CHARACTER(lc) ::   cxios_context         !: context name used in xios
@@ -171,4 +181,6 @@
    CHARACTER(lc) ::   cwxios_context        !: context name used in xios to write restart file
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/IOM/iom.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/IOM/iom.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/IOM/iom.F90	(revision 12928)
@@ -29,6 +29,5 @@
    USE lib_mpp           ! MPP library
 #if defined key_iomput
-   USE sbc_oce  , ONLY :   nn_fsbc         ! ocean space and time domain
-   USE trc_oce  , ONLY :   nn_dttrc        !  !: frequency of step on passive tracers
+   USE sbc_oce  , ONLY :   nn_fsbc, ght_abl, ghw_abl, e3t_abl, e3w_abl, jpka, jpkam1
    USE icb_oce  , ONLY :   nclasses, class_num       !  !: iceberg classes
 #if defined key_si3
@@ -46,5 +45,5 @@
 #endif
    USE lib_fortran 
-   USE diurnal_bulk, ONLY : ln_diurnal_only, ln_diurnal
+   USE diu_bulk, ONLY : ln_diurnal_only, ln_diurnal
 
    IMPLICIT NONE
@@ -56,14 +55,14 @@
    LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .FALSE.       !: iom_put flag
 #endif
-   PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get
+   PUBLIC iom_init, iom_init_closedef, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_get_var
    PUBLIC iom_chkatt, iom_getatt, iom_putatt, iom_getszuld, iom_rstput, iom_delay_rst, iom_put
-   PUBLIC iom_use, iom_context_finalize, iom_miss_val
+   PUBLIC iom_use, iom_context_finalize, iom_update_file_name, iom_miss_val
 
    PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d
    PRIVATE iom_g0d, iom_g1d, iom_g2d, iom_g3d, iom_get_123d
-   PRIVATE iom_p1d, iom_p2d, iom_p3d
+   PRIVATE iom_p1d, iom_p2d, iom_p3d, iom_p4d
 #if defined key_iomput
    PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr
-   PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate
+   PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_sdate
    PRIVATE iom_set_rst_context, iom_set_rstw_active, iom_set_rstr_active
 # endif
@@ -83,7 +82,9 @@
    END INTERFACE
    INTERFACE iom_put
-      MODULE PROCEDURE iom_p0d, iom_p1d, iom_p2d, iom_p3d
+      MODULE PROCEDURE iom_p0d, iom_p1d, iom_p2d, iom_p3d, iom_p4d
    END INTERFACE iom_put
   
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -93,5 +94,5 @@
 CONTAINS
 
-   SUBROUTINE iom_init( cdname, fname, ld_tmppatch ) 
+   SUBROUTINE iom_init( cdname, fname, ld_tmppatch, ld_closedef ) 
       !!----------------------------------------------------------------------
       !!                     ***  ROUTINE   ***
@@ -103,4 +104,5 @@
       CHARACTER(len=*), OPTIONAL, INTENT(in)  :: fname
       LOGICAL         , OPTIONAL, INTENT(in)  :: ld_tmppatch
+      LOGICAL         , OPTIONAL, INTENT(in)  :: ld_closedef
 #if defined key_iomput
       !
@@ -108,11 +110,14 @@
       TYPE(xios_date)     :: start_date
       CHARACTER(len=lc) :: clname
-      INTEGER           :: ji, jkmin
+      INTEGER             :: irefyear, irefmonth, irefday
+      INTEGER           :: ji
       LOGICAL :: llrst_context              ! is context related to restart
       !
       REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds
+      REAL(wp), DIMENSION(2,jpkam1)         :: za_bnds   ! ABL vertical boundaries
       LOGICAL ::   ll_tmppatch = .TRUE.    !: seb: patch before we remove periodicity
       INTEGER ::   nldi_save, nlei_save    !:      and close boundaries in output files
       INTEGER ::   nldj_save, nlej_save    !:
+      LOGICAL ::   ll_closedef = .TRUE.
       !!----------------------------------------------------------------------
       !
@@ -129,4 +134,5 @@
          IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj
       ENDIF
+      IF ( PRESENT(ld_closedef) ) ll_closedef = ld_closedef
       !
       ALLOCATE( zt_bnds(2,jpk), zw_bnds(2,jpk) )
@@ -139,10 +145,14 @@
 
       ! Calendar type is now defined in xml file 
+      IF (.NOT.(xios_getvar('ref_year' ,irefyear ))) irefyear  = 1900
+      IF (.NOT.(xios_getvar('ref_month',irefmonth))) irefmonth = 01
+      IF (.NOT.(xios_getvar('ref_day'  ,irefday  ))) irefday   = 01
+
       SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
-      CASE ( 1)   ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(1900,01,01,00,00,00), &
+      CASE ( 1)   ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(irefyear,irefmonth,irefday,00,00,00), &
           &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) )
-      CASE ( 0)   ; CALL xios_define_calendar( TYPE = "NoLeap"   , time_origin = xios_date(1900,01,01,00,00,00), &
+      CASE ( 0)   ; CALL xios_define_calendar( TYPE = "NoLeap"   , time_origin = xios_date(irefyear,irefmonth,irefday,00,00,00), &
           &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) )
-      CASE (30)   ; CALL xios_define_calendar( TYPE = "D360"     , time_origin = xios_date(1900,01,01,00,00,00), &
+      CASE (30)   ; CALL xios_define_calendar( TYPE = "D360"     , time_origin = xios_date(irefyear,irefmonth,irefday,00,00,00), &
           &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) )
       END SELECT
@@ -195,21 +205,38 @@
       ! vertical grid definition
       IF(.NOT.llrst_context) THEN
-          CALL iom_set_axis_attr( "deptht",  paxis = gdept_1d )
-          CALL iom_set_axis_attr( "depthu",  paxis = gdept_1d )
-          CALL iom_set_axis_attr( "depthv",  paxis = gdept_1d )
-          CALL iom_set_axis_attr( "depthw",  paxis = gdepw_1d )
-
+          CALL iom_set_axis_attr(  "deptht", paxis = gdept_1d )
+          CALL iom_set_axis_attr(  "depthu", paxis = gdept_1d )
+          CALL iom_set_axis_attr(  "depthv", paxis = gdept_1d )
+          CALL iom_set_axis_attr(  "depthw", paxis = gdepw_1d )
+
+          ! ABL
+          IF( .NOT. ALLOCATED(ght_abl) ) THEN   ! force definition for xml files (xios) 
+             ALLOCATE( ght_abl(jpka), ghw_abl(jpka), e3t_abl(jpka), e3w_abl(jpka) )   ! default allocation needed by iom
+             ght_abl(:) = -1._wp   ;   ghw_abl(:) = -1._wp
+             e3t_abl(:) = -1._wp   ;   e3w_abl(:) = -1._wp
+          ENDIF
+          CALL iom_set_axis_attr( "ght_abl", ght_abl(2:jpka) )
+          CALL iom_set_axis_attr( "ghw_abl", ghw_abl(2:jpka) )
+          
           ! Add vertical grid bounds
-          jkmin = MIN(2,jpk)  ! in case jpk=1 (i.e. sas2D)
-          zt_bnds(2,:        ) = gdept_1d(:)
-          zt_bnds(1,jkmin:jpk) = gdept_1d(1:jpkm1)
-          zt_bnds(1,1        ) = gdept_1d(1) - e3w_1d(1)
-          zw_bnds(1,:        ) = gdepw_1d(:)
-          zw_bnds(2,1:jpkm1  ) = gdepw_1d(jkmin:jpk)
-          zw_bnds(2,jpk:     ) = gdepw_1d(jpk) + e3t_1d(jpk)
-          CALL iom_set_axis_attr( "deptht", bounds=zw_bnds )
-          CALL iom_set_axis_attr( "depthu", bounds=zw_bnds )
-          CALL iom_set_axis_attr( "depthv", bounds=zw_bnds )
-          CALL iom_set_axis_attr( "depthw", bounds=zt_bnds )
+          zt_bnds(2,:      ) = gdept_1d(:)
+          zt_bnds(1,2:jpk  ) = gdept_1d(1:jpkm1)
+          zt_bnds(1,1      ) = gdept_1d(1) - e3w_1d(1)
+          zw_bnds(1,:      ) = gdepw_1d(:)
+          zw_bnds(2,1:jpkm1) = gdepw_1d(2:jpk)
+          zw_bnds(2,jpk:   ) = gdepw_1d(jpk) + e3t_1d(jpk)
+          CALL iom_set_axis_attr(  "deptht", bounds=zw_bnds )
+          CALL iom_set_axis_attr(  "depthu", bounds=zw_bnds )
+          CALL iom_set_axis_attr(  "depthv", bounds=zw_bnds )
+          CALL iom_set_axis_attr(  "depthw", bounds=zt_bnds )
+
+          ! ABL
+          za_bnds(1,:) = ghw_abl(1:jpkam1)
+          za_bnds(2,:) = ghw_abl(2:jpka  )
+          CALL iom_set_axis_attr( "ght_abl", bounds=za_bnds )
+          za_bnds(1,:) = ght_abl(2:jpka  )
+          za_bnds(2,:) = ght_abl(2:jpka  ) + e3w_abl(2:jpka)
+          CALL iom_set_axis_attr( "ghw_abl", bounds=za_bnds )
+
           CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,jpnfl) /) )
 # if defined key_si3
@@ -223,5 +250,7 @@
           CALL iom_set_axis_attr( "icbcla", class_num )
           CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) )   ! strange syntaxe and idea...
+          CALL iom_set_axis_attr( "iax_26C", (/ REAL(26,wp) /) )   ! strange syntaxe and idea...
           CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) )   ! strange syntaxe and idea...
+          CALL iom_set_axis_attr( "basin"  , (/ (REAL(ji,wp), ji=1,5) /) )
       ENDIF
       !
@@ -243,9 +272,10 @@
       ENDIF
       !
-      ! end file definition
-      dtime%second = rdt
+      ! set time step length
+      dtime%second = rn_Dt
       CALL xios_set_timestep( dtime )
-      CALL xios_close_context_definition()
-      CALL xios_update_calendar( 0 )
+      !
+      ! conditional closure of context definition
+      IF ( ll_closedef ) CALL iom_init_closedef
       !
       DEALLOCATE( zt_bnds, zw_bnds )
@@ -258,4 +288,22 @@
       !
    END SUBROUTINE iom_init
+
+   SUBROUTINE iom_init_closedef
+      !!----------------------------------------------------------------------
+      !!            ***  SUBROUTINE iom_init_closedef  ***
+      !!----------------------------------------------------------------------
+      !!
+      !! ** Purpose : Closure of context definition
+      !!
+      !!----------------------------------------------------------------------
+
+#if defined key_iomput
+      CALL xios_close_context_definition()
+      CALL xios_update_calendar( 0 )
+#else
+      IF( .FALSE. )   WRITE(numout,*) 'iom_init_closedef: should not see this'   ! useless statement to avoid compilation warnings
+#endif
+
+   END SUBROUTINE iom_init_closedef
 
    SUBROUTINE iom_set_rstw_var_active(field)
@@ -361,5 +409,5 @@
    IF(cdmdl == "OPA") THEN
 !from restart.F90
-   CALL iom_set_rstw_var_active("rdt")
+   CALL iom_set_rstw_var_active("rn_Dt")
    IF ( .NOT. ln_diurnal_only ) THEN
         CALL iom_set_rstw_var_active('ub'  )
@@ -375,15 +423,4 @@
         CALL iom_set_rstw_var_active('sshn')
         CALL iom_set_rstw_var_active('rhop')
-     ! extra variable needed for the ice sheet coupling
-        IF ( ln_iscpl ) THEN
-             CALL iom_set_rstw_var_active('tmask')
-             CALL iom_set_rstw_var_active('umask')
-             CALL iom_set_rstw_var_active('vmask')
-             CALL iom_set_rstw_var_active('smask')
-             CALL iom_set_rstw_var_active('e3t_n')
-             CALL iom_set_rstw_var_active('e3u_n')
-             CALL iom_set_rstw_var_active('e3v_n')
-             CALL iom_set_rstw_var_active('gdepw_n')
-        END IF
       ENDIF
       IF(ln_diurnal) CALL iom_set_rstw_var_active('Dsst')
@@ -410,5 +447,5 @@
 
         i = 0
-        i = i + 1; fields(i)%vname="rdt";            fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="rn_Dt";            fields(i)%grid="grid_scalar"
         i = i + 1; fields(i)%vname="un";             fields(i)%grid="grid_N_3D"
         i = i + 1; fields(i)%vname="ub";             fields(i)%grid="grid_N_3D"
@@ -627,5 +664,5 @@
 
 
-   SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, ldstop, ldiof, kdlev )
+   SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, ldstop, ldiof, kdlev, cdcomp )
       !!---------------------------------------------------------------------
       !!                   ***  SUBROUTINE  iom_open  ***
@@ -640,4 +677,5 @@
       LOGICAL         , INTENT(in   ), OPTIONAL ::   ldiof    ! Interp On the Fly, needed for AGRIF (default = .FALSE.)
       INTEGER         , INTENT(in   ), OPTIONAL ::   kdlev    ! number of vertical levels
+      CHARACTER(len=3), INTENT(in   ), OPTIONAL ::   cdcomp   ! name of component calling iom_nf90_open
       !
       CHARACTER(LEN=256)    ::   clname    ! the name of the file based on cdname [[+clcpu]+clcpu]
@@ -694,6 +732,5 @@
       clname   = trim(cdname)
       IF ( .NOT. Agrif_Root() .AND. .NOT. lliof ) THEN
-!FUS         iln    = INDEX(clname,'/') 
-         iln    = INDEX(clname,'/',BACK=.true.)  ! FUS: to insert the nest index at the right location within the string, the last / has to be found (search from the right to left)
+         iln    = INDEX(clname,'/') 
          cltmpn = clname(1:iln)
          clname = clname(iln+1:LEN_TRIM(clname))
@@ -786,5 +823,5 @@
       ENDIF
       IF( istop == nstop ) THEN   ! no error within this routine
-         CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar, kdlev = kdlev )
+         CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar, kdlev = kdlev, cdcomp = cdcomp )
       ENDIF
       !
@@ -806,4 +843,6 @@
       CHARACTER(LEN=100)    ::   clinfo    ! info character
       !---------------------------------------------------------------------
+      !
+      IF( iom_open_init == 0 )   RETURN   ! avoid to use iom_file(jf)%nfid that us not yet initialized
       !
       clinfo = '                    iom_close ~~~  '
@@ -1140,8 +1179,10 @@
             WRITE(cldmspc , fmt='(i1)') idmspc
             !
-            IF(     idmspc <  irankpv ) THEN 
-               CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension',   &
-                  &                         'it is impossible to read a '//clrankpv//'D array from this file...' )
-            ELSEIF( idmspc == irankpv ) THEN
+            !!GS: we consider 2D data as 3D data with vertical dim size = 1
+            !IF(     idmspc <  irankpv ) THEN 
+            !   CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension',   &
+            !      &                         'it is impossible to read a '//clrankpv//'D array from this file...' )
+            !ELSEIF( idmspc == irankpv ) THEN
+            IF( idmspc == irankpv ) THEN
                IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown )   &
                   &   CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' )
@@ -1340,4 +1381,17 @@
    END SUBROUTINE iom_get_123d
 
+   SUBROUTINE iom_get_var( cdname, z2d)
+      CHARACTER(LEN=*), INTENT(in ) ::   cdname
+      REAL(wp), DIMENSION(jpi,jpj) ::   z2d 
+#if defined key_iomput
+      IF( xios_field_is_active( cdname, at_current_timestep_arg = .TRUE. ) ) THEN
+         z2d(:,:) = 0._wp
+         CALL xios_recv_field( cdname, z2d)
+      ENDIF
+#else
+      IF( .FALSE. )   WRITE(numout,*) cdname, z2d ! useless test to avoid compilation warnings
+#endif
+   END SUBROUTINE iom_get_var
+
 
    FUNCTION iom_getszuld ( kiomid )  
@@ -1709,4 +1763,15 @@
    END SUBROUTINE iom_p3d
 
+   SUBROUTINE iom_p4d( cdname, pfield4d )
+      CHARACTER(LEN=*)                , INTENT(in) ::   cdname
+      REAL(wp),       DIMENSION(:,:,:,:), INTENT(in) ::   pfield4d
+#if defined key_iomput
+      CALL xios_send_field(cdname, pfield4d)
+#else
+      IF( .FALSE. )   WRITE(numout,*) cdname, pfield4d   ! useless test to avoid compilation warnings
+#endif
+   END SUBROUTINE iom_p4d
+
+
 #if defined key_iomput
    !!----------------------------------------------------------------------
@@ -1941,6 +2006,6 @@
       !
       INTEGER :: ji, jj, jn, ni, nj
-      INTEGER :: icnr, jcnr                                    ! Offset such that the vertex coordinate (i+icnr,j+jcnr)
-      !                                                        ! represents the bottom-left corner of cell (i,j)
+      INTEGER :: icnr, jcnr                             ! Offset such that the vertex coordinate (i+icnr,j+jcnr)
+      !                                                 ! represents the bottom-left corner of cell (i,j)
       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds      ! Lat/lon coordinates of the vertices of cell (i,j)
       REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: z_fld       ! Working array to determine where to rotate cells
@@ -2051,12 +2116,11 @@
       ALLOCATE( zlon(ni*nj) )       ;       zlon(:) = 0._wp
       !
-      CALL dom_ngb( -168.53, 65.03, ix, iy, 'T' ) !  i-line that passes through Bering Strait: Reference latitude (used in plots)
-!      CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots)
+!      CALL dom_ngb( -168.53, 65.03, ix, iy, 'T' ) !  i-line that passes through Bering Strait: Reference latitude (used in plots)
+      CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots)
       CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj)
       CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)
       CALL iom_set_domain_attr("gznl", lonvalue = zlon,   &
          &                             latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))  
-      CALL iom_set_zoom_domain_attr("znl_T", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo)
-      CALL iom_set_zoom_domain_attr("znl_W", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo)
+      CALL iom_set_zoom_domain_attr("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo)
       !
       CALL iom_update_file_name('ptr')
@@ -2113,6 +2177,5 @@
       f_op%timestep = nn_fsbc  ;  f_of%timestep =  0  ; CALL iom_set_field_attr('SBC'             , freq_op=f_op, freq_offset=f_of)
       f_op%timestep = nn_fsbc  ;  f_of%timestep =  0  ; CALL iom_set_field_attr('SBC_scalar'      , freq_op=f_op, freq_offset=f_of)
-      f_op%timestep = nn_dttrc ;  f_of%timestep =  0  ; CALL iom_set_field_attr('ptrc_T'          , freq_op=f_op, freq_offset=f_of)
-      f_op%timestep = nn_dttrc ;  f_of%timestep =  0  ; CALL iom_set_field_attr('diad_T'          , freq_op=f_op, freq_offset=f_of)
+      f_op%timestep = nn_fsbc  ;  f_of%timestep =  0  ; CALL iom_set_field_attr('ABL'             , freq_op=f_op, freq_offset=f_of)
 
       ! output file names (attribut: name)
@@ -2239,6 +2302,4 @@
       CHARACTER(LEN=20)  ::   clfreq
       CHARACTER(LEN=20)  ::   cldate
-      CHARACTER(LEN=256) ::   cltmpn                 !FUS needed for correct path with AGRIF
-      INTEGER            ::   iln                    !FUS needed for correct path with AGRIF
       INTEGER            ::   idx
       INTEGER            ::   jn
@@ -2297,5 +2358,5 @@
             idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@')
             DO WHILE ( idx /= 0 ) 
-               cldate = iom_sdate( fjulday - rdt / rday )
+               cldate = iom_sdate( fjulday - rn_Dt / rday )
                clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+11:LEN_TRIM(clname))
                idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@')
@@ -2304,5 +2365,5 @@
             idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@')
             DO WHILE ( idx /= 0 ) 
-               cldate = iom_sdate( fjulday - rdt / rday, ldfull = .TRUE. )
+               cldate = iom_sdate( fjulday - rn_Dt / rday, ldfull = .TRUE. )
                clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+15:LEN_TRIM(clname))
                idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@')
@@ -2311,5 +2372,5 @@
             idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@')
             DO WHILE ( idx /= 0 ) 
-               cldate = iom_sdate( fjulday + rdt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. )
+               cldate = iom_sdate( fjulday + rn_Dt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. )
                clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+9:LEN_TRIM(clname))
                idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@')
@@ -2318,18 +2379,10 @@
             idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@')
             DO WHILE ( idx /= 0 ) 
-               cldate = iom_sdate( fjulday + rdt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. )
+               cldate = iom_sdate( fjulday + rn_Dt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. )
                clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+13:LEN_TRIM(clname))
                idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@')
             END DO
             !
-!FUS            IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname)
-!FUS see comment line 700 
-            IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' ) THEN
-             iln    = INDEX(clname,'/',BACK=.true.)
-             cltmpn = clname(1:iln)
-             clname = clname(iln+1:LEN_TRIM(clname))
-             clname = TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname)
-            ENDIF
-!FUS 
+            IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname)
             IF( jn == 1 )   CALL iom_set_file_attr( cdid, name        = clname )
             IF( jn == 2 )   CALL iom_set_file_attr( cdid, name_suffix = clname )
@@ -2410,4 +2463,9 @@
    END SUBROUTINE iom_context_finalize
 
+   SUBROUTINE iom_update_file_name( cdid )
+      CHARACTER(LEN=*), INTENT(in) ::   cdid
+      IF( .FALSE. )   WRITE(numout,*)  cdid   ! useless test to avoid compilation warnings
+   END SUBROUTINE iom_update_file_name
+
 #endif
 
@@ -2429,4 +2487,5 @@
 #else
       IF( .FALSE. )   WRITE(numout,*) cdname, pmiss_val   ! useless test to avoid compilation warnings
+      IF( .FALSE. )   pmiss_val = 0._wp                   ! useless assignment to avoid compilation warnings
 #endif
    END SUBROUTINE iom_miss_val
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/IOM/iom_def.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/IOM/iom_def.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/IOM/iom_def.F90	(revision 12928)
@@ -50,4 +50,5 @@
    TYPE, PUBLIC ::   file_descriptor
       CHARACTER(LEN=240)                        ::   name     !: name of the file
+      CHARACTER(LEN=3  )                        ::   comp     !: name of component opening the file ('OCE', 'ICE'...)
       INTEGER                                   ::   nfid     !: identifier of the file (0 if closed)
                                                               !: jpioipsl option has been removed)
@@ -64,5 +65,4 @@
       REAL(kind=wp), DIMENSION(jpmax_vars)      ::   scf      !: scale_factor of the variables
       REAL(kind=wp), DIMENSION(jpmax_vars)      ::   ofs      !: add_offset of the variables
-      INTEGER                                   ::   nlev     ! number of vertical levels
    END TYPE file_descriptor
    TYPE(file_descriptor), DIMENSION(jpmax_files), PUBLIC ::   iom_file !: array containing the info for all opened files
@@ -77,4 +77,6 @@
    TYPE(RST_FIELD), PUBLIC, SAVE :: rst_wfields(max_rst_fields), rst_rfields(max_rst_fields)
    !
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/IOM/iom_nf90.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/IOM/iom_nf90.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/IOM/iom_nf90.F90	(revision 12928)
@@ -19,4 +19,5 @@
    !!----------------------------------------------------------------------
    USE dom_oce         ! ocean space and time domain
+   USE sbc_oce, ONLY: ght_abl ! abl vertical level number and height
    USE lbclnk          ! lateal boundary condition / mpp exchanges
    USE iom_def         ! iom variables definitions
@@ -45,5 +46,5 @@
 CONTAINS
 
-   SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar, kdlev )
+   SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar, kdlev, cdcomp )
       !!---------------------------------------------------------------------
       !!                   ***  SUBROUTINE  iom_open  ***
@@ -56,8 +57,10 @@
       LOGICAL                , INTENT(in   )           ::   ldok        ! check the existence 
       INTEGER, DIMENSION(2,5), INTENT(in   ), OPTIONAL ::   kdompar     ! domain parameters: 
-      INTEGER                , INTENT(in   ), OPTIONAL ::   kdlev       ! size of the third dimension
+      INTEGER                , INTENT(in   ), OPTIONAL ::   kdlev       ! size of the ice/abl third dimension
+      CHARACTER(len=3)       , INTENT(in   ), OPTIONAL ::   cdcomp      ! name of component calling iom_nf90_open
 
       CHARACTER(LEN=256) ::   clinfo           ! info character
       CHARACTER(LEN=256) ::   cltmp            ! temporary character
+      CHARACTER(LEN=3  ) ::   clcomp           ! name of component calling iom_nf90_open
       INTEGER            ::   iln              ! lengths of character
       INTEGER            ::   istop            ! temporary storage of nstop
@@ -69,5 +72,4 @@
       INTEGER            ::   ihdf5            ! local variable for retrieval of value for NF90_HDF5
       LOGICAL            ::   llclobber        ! local definition of ln_clobber
-      INTEGER            ::   ilevels           ! vertical levels
       !---------------------------------------------------------------------
       !
@@ -76,6 +78,9 @@
       !
       !                 !number of vertical levels
-      IF( PRESENT(kdlev) ) THEN   ;   ilevels = kdlev    ! use input value (useful for sea-ice)
-      ELSE                        ;   ilevels = jpk      ! by default jpk
+      IF( PRESENT(cdcomp) )   THEN
+         IF( .NOT. PRESENT(kdlev) ) CALL ctl_stop( 'iom_nf90_open: cdcomp and kdlev must both be present' )
+         clcomp = cdcomp    ! use input value
+      ELSE
+         clcomp = 'OCE'     ! by default 
       ENDIF
       !
@@ -124,10 +129,14 @@
             CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL,                   idmy ), clinfo)
             ! define dimensions
-            CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'x',   kdompar(1,1), idmy ), clinfo)
-            CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'y',   kdompar(2,1), idmy ), clinfo)
-            CALL iom_nf90_check(NF90_DEF_DIM( if90id,      'nav_lev',            jpk, idmy ), clinfo)
-            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo)
-            IF( PRESENT(kdlev) )   &
-               CALL iom_nf90_check(NF90_DEF_DIM( if90id,    'numcat',          kdlev, idmy ), clinfo)
+                               CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'x',   kdompar(1,1), idmy ), clinfo)
+                               CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'y',   kdompar(2,1), idmy ), clinfo)
+            SELECT CASE (clcomp)
+            CASE ('OCE')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,      'nav_lev',            jpk, idmy ), clinfo)
+            CASE ('ICE')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,       'numcat',          kdlev, idmy ), clinfo)
+            CASE ('ABL')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,      'nav_lev',          kdlev, idmy ), clinfo)
+            CASE ('SED')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,       'numsed',          kdlev, idmy ), clinfo)
+            CASE DEFAULT   ;   CALL ctl_stop( 'iom_nf90_open unknown component type' )
+            END SELECT
+                               CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo)
             ! global attributes
             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total'   , jpnij              ), clinfo)
@@ -155,8 +164,8 @@
          ENDDO
          iom_file(kiomid)%name   = TRIM(cdname)
+         iom_file(kiomid)%comp   = clcomp
          iom_file(kiomid)%nfid   = if90id
          iom_file(kiomid)%nvars  = 0
          iom_file(kiomid)%irec   = -1   ! useless for NetCDF files, used to know if the file is in define mode 
-         iom_file(kiomid)%nlev   = ilevels
          CALL iom_nf90_check(NF90_Inquire(if90id, unlimitedDimId = iom_file(kiomid)%iduld), clinfo)
          IF( iom_file(kiomid)%iduld .GE. 0 ) THEN
@@ -196,6 +205,6 @@
       CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable
       INTEGER              , INTENT(in   )           ::   kiv   ! 
-      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of the dimensions
-      INTEGER,               INTENT(  out), OPTIONAL ::   kndims   ! size of the dimensions
+      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of each dimension
+      INTEGER              , INTENT(  out), OPTIONAL ::   kndims   ! number of dimensions
       LOGICAL              , INTENT(  out), OPTIONAL ::   lduld    ! true if the last dimension is unlimited (time)
       !
@@ -519,7 +528,5 @@
       INTEGER, DIMENSION(4) :: idimid               ! dimensions id
       CHARACTER(LEN=256)    :: clinfo               ! info character
-      CHARACTER(LEN= 12), DIMENSION(5) :: cltmp     ! temporary character
       INTEGER               :: if90id               ! nf90 file identifier
-      INTEGER               :: idmy                 ! dummy variable
       INTEGER               :: itype                ! variable type
       INTEGER, DIMENSION(4) :: ichunksz             ! NetCDF4 chunk sizes. Will be computed using
@@ -530,5 +537,4 @@
       !                                             ! when appropriate (currently chunking is applied to 4d fields only)
       INTEGER               :: idlv                 ! local variable
-      INTEGER               :: idim3                ! id of the third dimension
       !---------------------------------------------------------------------
       !
@@ -544,24 +550,20 @@
          ENDIF
          ! define the dimension variables if it is not already done
-         ! Warning: we must use the same character length in an array constructor (at least for gcc compiler)
-         cltmp = (/ 'nav_lon     ', 'nav_lat     ', 'nav_lev     ', 'time_counter', 'numcat      ' /)   
-         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(1)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(1) ), clinfo)
-         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(2)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(2) ), clinfo)
-         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(3)), NF90_FLOAT , (/ 3    /), iom_file(kiomid)%nvid(3) ), clinfo)
-         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(4)), NF90_DOUBLE, (/ 4    /), iom_file(kiomid)%nvid(4) ), clinfo)
+         DO jd = 1, 2
+            CALL iom_nf90_check(NF90_INQUIRE_DIMENSION(if90id,jd,iom_file(kiomid)%cn_var(jd),iom_file(kiomid)%dimsz(jd,jd)),clinfo)
+            CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(iom_file(kiomid)%cn_var(jd)), NF90_FLOAT , (/ 1, 2 /),   &
+               &                              iom_file(kiomid)%nvid(jd) ), clinfo)
+         END DO
+         iom_file(kiomid)%dimsz(2,1) = iom_file(kiomid)%dimsz(2,2)   ! second dim of first  variable
+         iom_file(kiomid)%dimsz(1,2) = iom_file(kiomid)%dimsz(1,1)   ! first  dim of second variable
+         DO jd = 3, 4
+            CALL iom_nf90_check(NF90_INQUIRE_DIMENSION(if90id,jd,iom_file(kiomid)%cn_var(jd),iom_file(kiomid)%dimsz(1,jd)), clinfo)
+            CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(iom_file(kiomid)%cn_var(jd)), NF90_FLOAT , (/ jd   /),   &
+               &                              iom_file(kiomid)%nvid(jd) ), clinfo)
+         END DO
          ! update informations structure related the dimension variable we just added...
          iom_file(kiomid)%nvars       = 4
          iom_file(kiomid)%luld(1:4)   = (/ .FALSE., .FALSE., .FALSE., .TRUE. /)
-         iom_file(kiomid)%cn_var(1:4) = cltmp(1:4)
          iom_file(kiomid)%ndims(1:4)  = (/ 2, 2, 1, 1 /)
-         IF( NF90_INQ_DIMID( if90id, 'numcat', idmy ) == nf90_noerr ) THEN   ! add a 5th variable corresponding to the 5th dimension
-            CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(5)), NF90_FLOAT , (/ 5 /), iom_file(kiomid)%nvid(5) ), clinfo)
-            iom_file(kiomid)%nvars     = 5
-            iom_file(kiomid)%luld(5)   = .FALSE.
-            iom_file(kiomid)%cn_var(5) = cltmp(5)
-            iom_file(kiomid)%ndims(5)  = 1
-         ENDIF
-         ! trick: defined to 0 to say that dimension variables are defined but not yet written
-         iom_file(kiomid)%dimsz(1, 1)  = 0   
          IF(lwp) WRITE(numout,*) TRIM(clinfo)//' define dimension variables done'
       ENDIF
@@ -584,14 +586,8 @@
          IF(     PRESENT(pv_r0d) ) THEN   ;   idims = 0
          ELSEIF( PRESENT(pv_r1d) ) THEN
-            IF( SIZE(pv_r1d,1) == jpk ) THEN   ;   idim3 = 3
-            ELSE                               ;   idim3 = 5
-            ENDIF
-                                              idims = 2   ;   idimid(1:idims) = (/idim3,4/)
-         ELSEIF( PRESENT(pv_r2d) ) THEN   ;   idims = 3   ;   idimid(1:idims) = (/1,2  ,4/)
+                                              idims = 2   ;   idimid(1:idims) = (/3,4/)
+         ELSEIF( PRESENT(pv_r2d) ) THEN   ;   idims = 3   ;   idimid(1:idims) = (/1,2,4/)
          ELSEIF( PRESENT(pv_r3d) ) THEN
-            IF( SIZE(pv_r3d,3) == jpk ) THEN   ;   idim3 = 3
-            ELSE                               ;   idim3 = 5
-            ENDIF
-                                              idims = 4   ;   idimid(1:idims) = (/1,2,idim3,4/)
+                                              idims = 4   ;   idimid(1:idims) = (/1,2,3,4/)
          ENDIF
          IF( PRESENT(ktype) ) THEN   ! variable external type
@@ -668,23 +664,19 @@
             ! =============
             ! trick: is defined to 0 => dimension variable are defined but not yet written
-            IF( iom_file(kiomid)%dimsz(1, 1) == 0 ) THEN
-               CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lon'     , idmy )         , clinfo )
-               CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, glamt(ix1:ix2, iy1:iy2) ), clinfo )
-               CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lat'     , idmy )         , clinfo )
-               CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, gphit(ix1:ix2, iy1:iy2) ), clinfo )
-               CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lev'     , idmy ), clinfo )
-               CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, gdept_1d       ), clinfo )
-               IF( NF90_INQ_VARID( if90id, 'numcat', idmy ) == nf90_noerr ) THEN
-                  CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, (/ (idlv, idlv = 1,iom_file(kiomid)%nlev) /)), clinfo )
-               ENDIF
-               ! +++ WRONG VALUE: to be improved but not really useful...
-               CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'time_counter', idmy ), clinfo )
-               CALL iom_nf90_check( NF90_PUT_VAR( if90id, idmy, kt                      ), clinfo )   
-               ! update the values of the variables dimensions size
-               CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 1, len = iom_file(kiomid)%dimsz(1,1) ), clinfo )
-               CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 2, len = iom_file(kiomid)%dimsz(2,1) ), clinfo )
-               iom_file(kiomid)%dimsz(1:2, 2) = iom_file(kiomid)%dimsz(1:2, 1)
-               CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 3, len = iom_file(kiomid)%dimsz(1,3) ), clinfo )
-               iom_file(kiomid)%dimsz(1  , 4) = 1   ! unlimited dimension
+            IF( iom_file(kiomid)%dimsz(1, 4) == 0 ) THEN   ! time_counter = 0
+               CALL iom_nf90_check(    NF90_PUT_VAR( if90id, 1,                            glamt(ix1:ix2, iy1:iy2) ), clinfo )
+               CALL iom_nf90_check(    NF90_PUT_VAR( if90id, 2,                            gphit(ix1:ix2, iy1:iy2) ), clinfo )
+               SELECT CASE (iom_file(kiomid)%comp)
+               CASE ('OCE')  
+                  CALL iom_nf90_check( NF90_PUT_VAR( if90id, 3,                                           gdept_1d ), clinfo )
+               CASE ('ABL')
+                  CALL iom_nf90_check( NF90_PUT_VAR( if90id, 3,                                            ght_abl ), clinfo )
+               CASE DEFAULT
+                  CALL iom_nf90_check( NF90_PUT_VAR( if90id, 3, (/ (idlv, idlv = 1,iom_file(kiomid)%dimsz(1,3)) /) ), clinfo )
+               END SELECT
+               ! "wrong" value: to be improved but not really useful...
+               CALL iom_nf90_check(   NF90_PUT_VAR( if90id, 4,                                                  kt ), clinfo )   
+               ! update the size of the variable corresponding to the unlimited dimension
+               iom_file(kiomid)%dimsz(1, 4) = 1   ! so we don't enter this IF case any more...
                IF(lwp) WRITE(numout,*) TRIM(clinfo)//' write dimension variables done'
             ENDIF
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/IOM/prtctl.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/IOM/prtctl.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/IOM/prtctl.F90	(revision 12928)
@@ -50,5 +50,5 @@
       !!                debugging a new parametrization in mono or mpp. 
       !!
-      !! ** Method  : 2 possibilities exist when setting the ln_ctl parameter to
+      !! ** Method  : 2 possibilities exist when setting the sn_cfctl%prtctl parameter to
       !!                .true. in the ocean namelist:
       !!              - to debug a MPI run .vs. a mono-processor one; 
@@ -64,5 +64,5 @@
       !!                name must be explicitly typed if used. For instance if the 3D
       !!                array tn(:,:,:) must be passed through the prt_ctl subroutine, 
-      !!                it must looks like: CALL prt_ctl(tab3d_1=tn).
+      !!                it must look like: CALL prt_ctl(tab3d_1=tn).
       !!
       !!                    tab2d_1 : first 2D array
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/IOM/restart.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/IOM/restart.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/IOM/restart.F90	(revision 12928)
@@ -27,5 +27,5 @@
    USE in_out_manager  ! I/O manager
    USE iom             ! I/O module
-   USE diurnal_bulk
+   USE diu_bulk
    USE lib_mpp         ! distribued memory computing library
 
@@ -38,6 +38,4 @@
    PUBLIC   rst_read_open   ! routine called in rst_read and (possibly) in dom_vvl_init
 
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -133,5 +131,5 @@
 
 
-   SUBROUTINE rst_write( kt )
+   SUBROUTINE rst_write( kt, Kbb, Kmm )
       !!---------------------------------------------------------------------
       !!                   ***  ROUTINE rstwrite  ***
@@ -142,34 +140,24 @@
       !!              file, save fields which are necessary for restart
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step
+      INTEGER, INTENT(in) ::   kt         ! ocean time-step
+      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices
       !!----------------------------------------------------------------------
                      IF(lwxios) CALL iom_swap(      cwxios_context          )
-                     CALL iom_rstput( kt, nitrst, numrow, 'rdt'    , rdt       , ldxios = lwxios)   ! dynamics time step
+                     CALL iom_rstput( kt, nitrst, numrow, 'rdt'    , rn_Dt       , ldxios = lwxios)   ! dynamics time step
                      CALL iom_delay_rst( 'WRITE', 'OCE', numrow )   ! save only ocean delayed global communication variables
 
       IF ( .NOT. ln_diurnal_only ) THEN
-                     CALL iom_rstput( kt, nitrst, numrow, 'ub'     , ub, ldxios = lwxios        )     ! before fields
-                     CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vb, ldxios = lwxios        )
-                     CALL iom_rstput( kt, nitrst, numrow, 'tb'     , tsb(:,:,:,jp_tem), ldxios = lwxios )
-                     CALL iom_rstput( kt, nitrst, numrow, 'sb'     , tsb(:,:,:,jp_sal), ldxios = lwxios )
-                     CALL iom_rstput( kt, nitrst, numrow, 'sshb'   , sshb, ldxios = lwxios      )
+                     CALL iom_rstput( kt, nitrst, numrow, 'ub'     , uu(:,:,:       ,Kbb), ldxios = lwxios        )     ! before fields
+                     CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vv(:,:,:       ,Kbb), ldxios = lwxios        )
+                     CALL iom_rstput( kt, nitrst, numrow, 'tb'     , ts(:,:,:,jp_tem,Kbb), ldxios = lwxios )
+                     CALL iom_rstput( kt, nitrst, numrow, 'sb'     , ts(:,:,:,jp_sal,Kbb), ldxios = lwxios )
+                     CALL iom_rstput( kt, nitrst, numrow, 'sshb'   ,ssh(:,:         ,Kbb), ldxios = lwxios      )
                      !
-                     CALL iom_rstput( kt, nitrst, numrow, 'un'     , un, ldxios = lwxios        )     ! now fields
-                     CALL iom_rstput( kt, nitrst, numrow, 'vn'     , vn, ldxios = lwxios        )
-                     CALL iom_rstput( kt, nitrst, numrow, 'tn'     , tsn(:,:,:,jp_tem), ldxios = lwxios )
-                     CALL iom_rstput( kt, nitrst, numrow, 'sn'     , tsn(:,:,:,jp_sal), ldxios = lwxios )
-                     CALL iom_rstput( kt, nitrst, numrow, 'sshn'   , sshn, ldxios = lwxios      )
+                     CALL iom_rstput( kt, nitrst, numrow, 'un'     , uu(:,:,:       ,Kmm), ldxios = lwxios        )     ! now fields
+                     CALL iom_rstput( kt, nitrst, numrow, 'vn'     , vv(:,:,:       ,Kmm), ldxios = lwxios        )
+                     CALL iom_rstput( kt, nitrst, numrow, 'tn'     , ts(:,:,:,jp_tem,Kmm), ldxios = lwxios )
+                     CALL iom_rstput( kt, nitrst, numrow, 'sn'     , ts(:,:,:,jp_sal,Kmm), ldxios = lwxios )
+                     CALL iom_rstput( kt, nitrst, numrow, 'sshn'   ,ssh(:,:         ,Kmm), ldxios = lwxios      )
                      CALL iom_rstput( kt, nitrst, numrow, 'rhop'   , rhop, ldxios = lwxios      )
-                  ! extra variable needed for the ice sheet coupling
-                  IF ( ln_iscpl ) THEN 
-                     CALL iom_rstput( kt, nitrst, numrow, 'tmask'  , tmask, ldxios = lwxios ) ! need to extrapolate T/S
-                     CALL iom_rstput( kt, nitrst, numrow, 'umask'  , umask, ldxios = lwxios ) ! need to correct barotropic velocity
-                     CALL iom_rstput( kt, nitrst, numrow, 'vmask'  , vmask, ldxios = lwxios ) ! need to correct barotropic velocity
-                     CALL iom_rstput( kt, nitrst, numrow, 'smask'  , ssmask, ldxios = lwxios) ! need to correct barotropic velocity
-                     CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:), ldxios = lwxios )   ! need to compute temperature correction
-                     CALL iom_rstput( kt, nitrst, numrow, 'e3u_n', e3u_n(:,:,:), ldxios = lwxios )   ! need to compute bt conservation
-                     CALL iom_rstput( kt, nitrst, numrow, 'e3v_n', e3v_n(:,:,:), ldxios = lwxios )   ! need to compute bt conservation
-                     CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', gdepw_n(:,:,:), ldxios = lwxios ) ! need to compute extrapolation if vvl
-                  END IF
       ENDIF
       
@@ -240,5 +228,5 @@
 
 
-   SUBROUTINE rst_read
+   SUBROUTINE rst_read( Kbb, Kmm )
       !!---------------------------------------------------------------------- 
       !!                   ***  ROUTINE rst_read  ***
@@ -248,4 +236,5 @@
       !! ** Method  :   Read in restart.nc file fields which are necessary for restart
       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices
       REAL(wp) ::   zrdt
       INTEGER  ::   jk
@@ -258,5 +247,11 @@
       IF( iom_varid( numror, 'rdt', ldstop = .FALSE. ) > 0 )   THEN
          CALL iom_get( numror, 'rdt', zrdt, ldxios = lrxios )
-         IF( zrdt /= rdt )   neuler = 0
+         IF( zrdt /= rn_Dt ) THEN
+            IF(lwp) WRITE( numout,*)
+            IF(lwp) WRITE( numout,*) 'rst_read:  rdt not equal to the read one'
+            IF(lwp) WRITE( numout,*)
+            IF(lwp) WRITE( numout,*) '      ==>>>   forced euler first time-step'
+            l_1st_euler =  .TRUE.
+         ENDIF
       ENDIF
 
@@ -267,41 +262,41 @@
       IF ( ln_diurnal_only ) THEN 
          IF(lwp) WRITE( numout, * ) &
-         &   "rst_read:- ln_diurnal_only set, setting rhop=rau0" 
-         rhop = rau0
+         &   "rst_read:- ln_diurnal_only set, setting rhop=rho0" 
+         rhop = rho0
          CALL iom_get( numror, jpdom_autoglo, 'tn'     , w3d, ldxios = lrxios ) 
-         tsn(:,:,1,jp_tem) = w3d(:,:,1)
+         ts(:,:,1,jp_tem,Kmm) = w3d(:,:,1)
          RETURN 
       ENDIF  
       
       IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN
-         CALL iom_get( numror, jpdom_autoglo, 'ub'     , ub, ldxios = lrxios                )   ! before fields
-         CALL iom_get( numror, jpdom_autoglo, 'vb'     , vb, ldxios = lrxios                )
-         CALL iom_get( numror, jpdom_autoglo, 'tb'     , tsb(:,:,:,jp_tem), ldxios = lrxios )
-         CALL iom_get( numror, jpdom_autoglo, 'sb'     , tsb(:,:,:,jp_sal), ldxios = lrxios )
-         CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb, ldxios = lrxios              )
+         CALL iom_get( numror, jpdom_autoglo, 'ub'     , uu(:,:,:       ,Kbb), ldxios = lrxios )   ! before fields
+         CALL iom_get( numror, jpdom_autoglo, 'vb'     , vv(:,:,:       ,Kbb), ldxios = lrxios )
+         CALL iom_get( numror, jpdom_autoglo, 'tb'     , ts(:,:,:,jp_tem,Kbb), ldxios = lrxios )
+         CALL iom_get( numror, jpdom_autoglo, 'sb'     , ts(:,:,:,jp_sal,Kbb), ldxios = lrxios )
+         CALL iom_get( numror, jpdom_autoglo, 'sshb'   ,ssh(:,:         ,Kbb), ldxios = lrxios )
       ELSE
-         neuler = 0
-      ENDIF
-      !
-      CALL iom_get( numror, jpdom_autoglo, 'un'     , un, ldxios = lrxios )   ! now    fields
-      CALL iom_get( numror, jpdom_autoglo, 'vn'     , vn, ldxios = lrxios )
-      CALL iom_get( numror, jpdom_autoglo, 'tn'     , tsn(:,:,:,jp_tem), ldxios = lrxios )
-      CALL iom_get( numror, jpdom_autoglo, 'sn'     , tsn(:,:,:,jp_sal), ldxios = lrxios )
-      CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn, ldxios = lrxios )
+         l_1st_euler =  .TRUE.      ! before field not found, forced euler 1st time-step
+      ENDIF
+      !
+      CALL iom_get( numror, jpdom_autoglo, 'un'     , uu(:,:,:       ,Kmm), ldxios = lrxios )       ! now    fields
+      CALL iom_get( numror, jpdom_autoglo, 'vn'     , vv(:,:,:       ,Kmm), ldxios = lrxios )
+      CALL iom_get( numror, jpdom_autoglo, 'tn'     , ts(:,:,:,jp_tem,Kmm), ldxios = lrxios )
+      CALL iom_get( numror, jpdom_autoglo, 'sn'     , ts(:,:,:,jp_sal,Kmm), ldxios = lrxios )
+      CALL iom_get( numror, jpdom_autoglo, 'sshn'   ,ssh(:,:         ,Kmm), ldxios = lrxios )
       IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN
          CALL iom_get( numror, jpdom_autoglo, 'rhop'   , rhop, ldxios = lrxios )   ! now    potential density
       ELSE
-         CALL eos( tsn, rhd, rhop, gdept_n(:,:,:) )   
-      ENDIF
-      !
-      IF( neuler == 0 ) THEN                                  ! Euler restart (neuler=0)
-         tsb  (:,:,:,:) = tsn  (:,:,:,:)                             ! all before fields set to now values
-         ub   (:,:,:)   = un   (:,:,:)
-         vb   (:,:,:)   = vn   (:,:,:)
-         sshb (:,:)     = sshn (:,:)
+         CALL eos( ts(:,:,:,:,Kmm), rhd, rhop, gdept(:,:,:,Kmm) )   
+      ENDIF
+      !
+      IF( l_1st_euler ) THEN                                  ! Euler restart 
+         ts   (:,:,:,:,Kbb) = ts   (:,:,:,:,Kmm)              ! all before fields set to now values
+         uu   (:,:,:  ,Kbb) = uu   (:,:,:  ,Kmm)
+         vv   (:,:,:  ,Kbb) = vv   (:,:,:  ,Kmm)
+         ssh  (:,:    ,Kbb) = ssh  (:,:    ,Kmm)
          !
          IF( .NOT.ln_linssh ) THEN
             DO jk = 1, jpk
-               e3t_b(:,:,jk) = e3t_n(:,:,jk)
+               e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm)
             END DO
          ENDIF
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isf_oce.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isf_oce.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isf_oce.F90	(revision 12928)
@@ -0,0 +1,266 @@
+MODULE isf_oce
+   !!======================================================================
+   !!                       ***  MODULE  sbcisf  ***
+   !! Surface module :  compute iceshelf melt and heat flux
+   !!======================================================================
+   !! History :  3.2  !  2011-02  (C.Harris  ) Original code isf cav
+   !!            X.X  !  2006-02  (C. Wang   ) Original code bg03
+   !!            3.4  !  2013-03  (P. Mathiot) Merging + parametrization
+   !!            4.1  !  2019-09  (P. Mathiot) Split param/explicit ice shelf and re-organisation
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   isf          : define and allocate ice shelf variables
+   !!----------------------------------------------------------------------
+
+   USE par_oce       , ONLY: jpi, jpj, jpk
+   USE in_out_manager, ONLY: wp, jpts ! I/O manager
+   USE lib_mpp       , ONLY: ctl_stop, mpp_sum      ! MPP library
+   USE fldread        ! read input fields
+
+   IMPLICIT NONE
+
+   PRIVATE
+
+   PUBLIC   isf_alloc, isf_alloc_par, isf_alloc_cav, isf_alloc_cpl, isf_dealloc_cpl
+   !
+   !-------------------------------------------------------
+   ! 0 :              namelist parameter
+   !-------------------------------------------------------
+   !
+   ! 0.1 -------- ice shelf cavity parameter --------------
+   CHARACTER(LEN=256), PUBLIC :: cn_isfdir
+   LOGICAL           , PUBLIC :: ln_isf
+   LOGICAL           , PUBLIC :: ln_isfdebug
+   !
+   ! 0.2 -------- ice shelf cavity opened namelist parameter -------------
+   LOGICAL           , PUBLIC :: ln_isfcav_mlt   !: logical for the use of ice shelf parametrisation
+   REAL(wp)          , PUBLIC :: rn_gammat0      !: temperature exchange coeficient    []
+   REAL(wp)          , PUBLIC :: rn_gammas0      !: salinity    exchange coeficient    []
+   REAL(wp)          , PUBLIC :: rn_htbl         !: Losch top boundary layer thickness [m]
+   REAL(wp)          , PUBLIC :: rn_isfload_T    !: 
+   REAL(wp)          , PUBLIC :: rn_isfload_S    !: 
+   CHARACTER(LEN=256), PUBLIC :: cn_gammablk     !: gamma formulation
+   CHARACTER(LEN=256), PUBLIC :: cn_isfcav_mlt   !: melt formulation (cavity/param)
+   CHARACTER(LEN=256), PUBLIC :: cn_isfload      !: ice shelf load computation method
+   TYPE(FLD_N)       , PUBLIC :: sn_isfcav_fwf   !: information about the isf melting file to be read
+   !
+   ! 0.3 -------- ice shelf cavity parametrised namelist parameter -------------
+   LOGICAL           , PUBLIC :: ln_isfpar_mlt   !: logical for the computation of melt inside the cavity
+   CHARACTER(LEN=256), PUBLIC :: cn_isfpar_mlt   !: melt formulation (cavity/param)
+   TYPE(FLD_N)       , PUBLIC :: sn_isfpar_fwf   !: information about the isf melting file to be read
+   TYPE(FLD_N)       , PUBLIC :: sn_isfpar_zmax  !: information about the grounding line depth file to be read
+   TYPE(FLD_N)       , PUBLIC :: sn_isfpar_zmin  !: information about the calving   line depth file to be read
+   TYPE(FLD_N)       , PUBLIC :: sn_isfpar_Leff  !: information about the effective length     file to be read
+   !
+   ! 0.4 -------- coupling namelist parameter -------------
+   LOGICAL, PUBLIC :: ln_isfcpl      !:
+   LOGICAL, PUBLIC :: ln_isfcpl_cons !:
+   INTEGER, PUBLIC :: nn_drown       !:
+   !
+   !-------------------------------------------------------
+   ! 1 :              ice shelf parameter
+   !-------------------------------------------------------
+   !
+   REAL(wp), PARAMETER, PUBLIC :: rLfusisf = 0.334e6_wp    !: latent heat of fusion of ice shelf     [J/kg]
+   REAL(wp), PARAMETER, PUBLIC :: rcpisf = 2000.0_wp       !: specific heat of ice shelf             [J/kg/K]
+   REAL(wp), PARAMETER, PUBLIC :: rkappa = 1.54e-6_wp      !: heat diffusivity through the ice-shelf [m2/s]
+   REAL(wp), PARAMETER, PUBLIC :: rhoisf = 920.0_wp        !: volumic mass of ice shelf              [kg/m3]
+   REAL(wp), PARAMETER, PUBLIC :: rtsurf = -20.0           !: surface temperature                    [C]
+   !
+   !-------------------------------------------------------
+   ! 2 :              ice shelf global variables
+   !-------------------------------------------------------
+   !
+   ! 2.1 -------- ice shelf cavity parameter --------------
+   LOGICAL , PUBLIC            :: l_isfoasis
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)    ::   risfload                    !: ice shelf load
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)    ::   fwfisf_oasis
+   !
+   ! 2.2 -------- ice shelf cavity melt namelist parameter -------------
+   INTEGER  , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   :: mskisf_cav                    !:
+   INTEGER  , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   :: misfkt_cav   , misfkb_cav     !: 
+   REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   :: rhisf_tbl_cav, rfrac_tbl_cav  !: 
+   REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   :: fwfisf_cav   , fwfisf_cav_b   !: before and now net fwf from the ice shelf        [kg/m2/s]
+   REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: risf_cav_tsc , risf_cav_tsc_b !: before and now T & S isf contents [K.m/s & PSU.m/s]  
+   TYPE(FLD), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)     :: sf_isfcav_fwf                 !:
+   !
+   REAL(wp) , PUBLIC                                      :: risf_lamb1, risf_lamb2, risf_lamb3  ! freezing point linearization coeficient
+   !
+   ! 2.3 -------- ice shelf param. melt namelist parameter -------------
+   INTEGER  , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   :: mskisf_par                    !:
+   INTEGER  , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   :: misfkt_par   , misfkb_par     !:
+   REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   :: rhisf_tbl_par, rfrac_tbl_par  !: 
+   REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   :: fwfisf_par   , fwfisf_par_b   !: before and now net fwf from the ice shelf        [kg/m2/s]
+   REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: risf_par_tsc , risf_par_tsc_b !: before and now T & S isf contents [K.m/s & PSU.m/s]  
+   TYPE(FLD), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)     :: sf_isfpar_fwf                 !:
+   !
+   REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   :: rhisf0_tbl_par                !: thickness of tbl (initial value)  [m]
+   REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   :: risfLeff                      !:
+   !
+   ! 2.4 -------- coupling namelist parameter -------------
+   INTEGER , PUBLIC                                        ::   nstp_iscpl   !:
+   REAL(wp), PUBLIC                                        ::   rdt_iscpl    !: 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   risfcpl_ssh, risfcpl_cons_ssh, risfcpl_cons_ssh_b               !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   risfcpl_vol, risfcpl_cons_vol, risfcpl_cons_vol_b  !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   risfcpl_tsc, risfcpl_cons_tsc, risfcpl_cons_tsc_b  !:
+   !
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE isf_alloc_par()
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE isf_alloc_par  ***
+      !!
+      !! ** Purpose : 
+      !!
+      !! ** Method  : 
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER :: ierr, ialloc
+      !!----------------------------------------------------------------------
+      ierr = 0       ! set to zero if no array to be allocated
+      !
+      ALLOCATE(risfLeff(jpi,jpj), STAT=ialloc)
+      ierr = ierr + ialloc
+      !
+      ALLOCATE(misfkt_par(jpi,jpj), misfkb_par(jpi,jpj), STAT=ialloc )
+      ierr = ierr + ialloc
+      !
+      ALLOCATE( rfrac_tbl_par(jpi,jpj), STAT=ialloc)
+      ierr = ierr + ialloc
+      !
+      ALLOCATE( rhisf_tbl_par(jpi,jpj), rhisf0_tbl_par(jpi,jpj), STAT=ialloc)
+      ierr = ierr + ialloc
+      !
+      ALLOCATE( mskisf_par(jpi,jpj), STAT=ialloc)
+      ierr = ierr + ialloc
+      !
+      CALL mpp_sum ( 'isf', ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'isf: failed to allocate arrays.' )
+      !
+   END SUBROUTINE isf_alloc_par
+
+   SUBROUTINE isf_alloc_cav()
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE isf_alloc_cav  ***
+      !!
+      !! ** Purpose : 
+      !!
+      !! ** Method  : 
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER :: ierr, ialloc
+      !!----------------------------------------------------------------------
+      ierr = 0       ! set to zero if no array to be allocated
+      !
+      ALLOCATE(misfkt_cav(jpi,jpj), misfkb_cav(jpi,jpj), STAT=ialloc )
+      ierr = ierr + ialloc
+      !
+      ALLOCATE( rfrac_tbl_cav(jpi,jpj), STAT=ialloc)
+      ierr = ierr + ialloc
+      !
+      ALLOCATE( rhisf_tbl_cav(jpi,jpj), STAT=ialloc)
+      ierr = ierr + ialloc
+      !
+      CALL mpp_sum ( 'isf', ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'isf: failed to allocate arrays.' )
+      !
+   END SUBROUTINE isf_alloc_cav
+
+   SUBROUTINE isf_alloc_cpl()
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE isf_alloc_cpl  ***
+      !!
+      !! ** Purpose : allocate array use for the ice sheet coupling
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER :: ierr, ialloc
+      !!----------------------------------------------------------------------
+      ierr = 0
+      !
+      ALLOCATE( risfcpl_ssh(jpi,jpj), risfcpl_tsc(jpi,jpj,jpk,jpts), risfcpl_vol(jpi,jpj,jpk), STAT=ialloc )
+      ierr = ierr + ialloc
+      !
+      risfcpl_tsc(:,:,:,:) = 0.0 ; risfcpl_vol(:,:,:) = 0.0 ; risfcpl_ssh(:,:) = 0.0
+
+      IF ( ln_isfcpl_cons) THEN
+         ALLOCATE( risfcpl_cons_tsc(jpi,jpj,jpk,jpts) , risfcpl_cons_vol(jpi,jpj,jpk) ,risfcpl_cons_ssh(jpi,jpj), STAT=ialloc )
+         ierr = ierr + ialloc
+         !
+         risfcpl_cons_tsc(:,:,:,:) = 0.0 ; risfcpl_cons_vol(:,:,:) = 0.0 ; risfcpl_cons_ssh(:,:) = 0.0
+         !
+      END IF
+      !
+      CALL mpp_sum ( 'isf', ierr )
+      IF( ierr /= 0 )   CALL ctl_stop('STOP','isfcpl: failed to allocate arrays.')
+      !
+   END SUBROUTINE isf_alloc_cpl
+
+   SUBROUTINE isf_dealloc_cpl()
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE isf_dealloc_cpl  ***
+      !!
+      !! ** Purpose : de-allocate useless public 3d array used for ice sheet coupling
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER :: ierr, ialloc
+      !!----------------------------------------------------------------------
+      ierr = 0
+      !
+      DEALLOCATE( risfcpl_ssh, risfcpl_tsc, risfcpl_vol, STAT=ialloc )
+      ierr = ierr + ialloc
+      !
+      CALL mpp_sum ( 'isf', ierr )
+      IF( ierr /= 0 )   CALL ctl_stop('STOP','isfcpl: failed to deallocate arrays.')
+      !
+   END SUBROUTINE isf_dealloc_cpl
+
+   SUBROUTINE isf_alloc()
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE isf_alloc  ***
+      !!
+      !! ** Purpose : allocate array used for the ice shelf cavity (cav and par)
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER :: ierr, ialloc
+      !!----------------------------------------------------------------------
+      !
+      ierr = 0       ! set to zero if no array to be allocated
+      !
+      ALLOCATE(fwfisf_par(jpi,jpj)  , fwfisf_par_b(jpi,jpj), &
+         &     fwfisf_cav(jpi,jpj)  , fwfisf_cav_b(jpi,jpj), &
+         &     fwfisf_oasis(jpi,jpj),            STAT=ialloc )
+      ierr = ierr + ialloc
+      !
+      ALLOCATE(risf_par_tsc(jpi,jpj,jpts), risf_par_tsc_b(jpi,jpj,jpts), STAT=ialloc )
+      ierr = ierr + ialloc
+      !
+      ALLOCATE(risf_cav_tsc(jpi,jpj,jpts), risf_cav_tsc_b(jpi,jpj,jpts), STAT=ialloc )
+      ierr = ierr + ialloc
+      !
+      ALLOCATE(risfload(jpi,jpj), STAT=ialloc)
+      ierr = ierr + ialloc
+      !
+      ALLOCATE( mskisf_cav(jpi,jpj), STAT=ialloc)
+      ierr = ierr + ialloc
+      !
+      CALL mpp_sum ( 'isf', ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'isf: failed to allocate arrays.' )
+      !
+      ! initalisation of fwf and tsc array to 0
+      risfload(:,:)       = 0.0_wp
+      fwfisf_oasis(:,:)   = 0.0_wp
+      fwfisf_par(:,:)     = 0.0_wp    ; fwfisf_par_b(:,:)     = 0.0_wp
+      fwfisf_cav(:,:)     = 0.0_wp    ; fwfisf_cav_b(:,:)     = 0.0_wp
+      risf_cav_tsc(:,:,:) = 0.0_wp    ; risf_cav_tsc_b(:,:,:) = 0.0_wp
+      risf_par_tsc(:,:,:) = 0.0_wp    ; risf_par_tsc_b(:,:,:) = 0.0_wp
+      !
+
+   END SUBROUTINE isf_alloc
+
+END MODULE isf_oce
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfcav.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfcav.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfcav.F90	(revision 12928)
@@ -0,0 +1,233 @@
+MODULE isfcav
+   !!======================================================================
+   !!                       ***  MODULE  isfcav  ***
+   !! Ice shelf cavity module :  update ice shelf melting under ice
+   !!                            shelf
+   !!======================================================================
+   !! History :  3.2  !  2011-02  (C.Harris  ) Original code isf cav
+   !!            3.4  !  2013-03  (P. Mathiot) Merging + parametrization
+   !!            4.1  !  2019-09  (P. Mathiot) Split ice shelf cavity and ice shelf parametrisation
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   isf_cav       : update ice shelf melting under ice shelf
+   !!----------------------------------------------------------------------
+   USE isf_oce        ! ice shelf public variables
+   !
+   USE isfrst   , ONLY: isfrst_write, isfrst_read ! ice shelf restart read/write subroutine
+   USE isfutils , ONLY: debug          ! ice shelf debug subroutine
+   USE isftbl   , ONLY: isf_tbl        ! ice shelf top boundary layer properties subroutine
+   USE isfcavmlt, ONLY: isfcav_mlt     ! ice shelf melt formulation subroutine
+   USE isfcavgam, ONLY: isfcav_gammats ! ice shelf melt exchange coeficient subroutine
+   USE isfdiags , ONLY: isf_diags_flx  ! ice shelf diags subroutine
+   !
+   USE oce      , ONLY: ts                              ! ocean tracers
+   USE par_oce  , ONLY: jpi,jpj                         ! ocean space and time domain
+   USE phycst   , ONLY: grav,rho0,rho0_rcp,r1_rho0_rcp  ! physical constants
+   USE eosbn2   , ONLY: ln_teos10                       ! use ln_teos10 or not
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O library
+   USE fldread        ! read input field at current time step
+   USE lbclnk         ! lbclnk
+
+   IMPLICIT NONE
+
+   PRIVATE
+
+   PUBLIC   isf_cav, isf_cav_init ! routine called in isfmlt
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE isf_cav( kt, Kmm, ptsc, pqfwf )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE isf_cav  ***
+      !!
+      !! ** Purpose :   handle surface boundary condition under ice shelf
+      !!
+      !! ** Method  :   based on Mathiot et al. (2017)
+      !!
+      !! ** Action  :   - compute geometry of the Losch top bournary layer (see Losch et al. 2008)
+      !!                - depending on the chooses option
+      !!                   - compute temperature/salt in the tbl
+      !!                   - compute exchange coeficient
+      !!                   - compute heat and fwf fluxes
+      !!                   - output
+      !!---------------------------------------------------------------------
+      !!-------------------------- OUT --------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(inout) :: pqfwf  ! ice shelf melt (>0 out)
+      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(inout) :: ptsc   ! T & S ice shelf cavity contents
+      !!-------------------------- IN  --------------------------------------
+      INTEGER, INTENT(in) ::   Kmm  ! ocean time level index
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+      !!---------------------------------------------------------------------
+      LOGICAL :: lit
+      INTEGER :: nit
+      REAL(wp) :: zerr
+      REAL(wp), DIMENSION(jpi,jpj) :: zqlat, zqoce, zqhc, zqh  ! heat fluxes
+      REAL(wp), DIMENSION(jpi,jpj) :: zqoce_b                  !
+      REAL(wp), DIMENSION(jpi,jpj) :: zgammat, zgammas         ! exchange coeficient
+      REAL(wp), DIMENSION(jpi,jpj) :: zttbl, zstbl             ! temp. and sal. in top boundary layer
+      !!---------------------------------------------------------------------
+      !
+      ! compute T/S/U/V for the top boundary layer
+      CALL isf_tbl(Kmm, ts(:,:,:,jp_tem,Kmm), zttbl(:,:),'T', misfkt_cav, rhisf_tbl_cav, misfkb_cav, rfrac_tbl_cav )
+      CALL isf_tbl(Kmm, ts(:,:,:,jp_sal,Kmm), zstbl(:,:),'T', misfkt_cav, rhisf_tbl_cav, misfkb_cav, rfrac_tbl_cav )
+      ! 
+      ! output T/S/U/V for the top boundary layer
+      CALL iom_put('ttbl_cav',zttbl(:,:) * mskisf_cav(:,:))
+      CALL iom_put('stbl'    ,zstbl(:,:) * mskisf_cav(:,:))
+      !
+      ! initialisation
+      IF (TRIM(cn_gammablk) == 'vel_stab' ) zqoce_b (:,:) = ptsc(:,:,jp_tem) * rho0_rcp ! last time step total heat fluxes (to speed up convergence)
+      !
+      ! compute ice shelf melting
+      nit = 1 ; lit = .TRUE.
+      DO WHILE ( lit )    ! maybe just a constant number of iteration as in blk_core is fine
+         !
+         ! compute gammat everywhere (2d)
+         ! useless if melt specified
+         IF ( TRIM(cn_isfcav_mlt) .NE. 'spe' ) THEN
+            CALL isfcav_gammats( Kmm, zttbl, zstbl, zqoce  , pqfwf,  &
+               &                                    zgammat, zgammas )
+         END IF
+         !   
+         ! compute tfrz, latent heat and melt (2d)
+         CALL isfcav_mlt(kt, zgammat, zgammas, zttbl, zstbl, &
+            &                         zqhc   , zqoce, pqfwf  )
+         !
+         ! define if we need to iterate
+         SELECT CASE ( cn_gammablk )
+         CASE ( 'spe','vel' )
+            ! no convergence needed
+            lit = .FALSE.
+         CASE ( 'vel_stab' )
+            ! compute error between 2 iterations
+            zerr = MAXVAL(ABS(zqoce(:,:) - zqoce_b(:,:)))
+            !
+            ! define if iteration needed
+            IF (nit >= 100) THEN              ! too much iteration
+               CALL ctl_stop( 'STOP', 'isf_cav: vel_stab gamma formulation had too many iterations ...' )
+            ELSE IF ( zerr <= 0.01_wp ) THEN  ! convergence is achieve
+               lit = .FALSE.
+            ELSE                              ! converge is not yet achieve
+               nit = nit + 1
+               zqoce_b(:,:) = zqoce(:,:)
+            END IF
+         END SELECT
+         !
+      END DO
+      !
+      ! compute heat and water flux ( > 0 out )
+      pqfwf(:,:) = pqfwf(:,:) * mskisf_cav(:,:)
+      zqoce(:,:) = zqoce(:,:) * mskisf_cav(:,:)
+      zqhc (:,:) = zqhc(:,:)  * mskisf_cav(:,:)
+      !
+      ! compute heat content flux ( > 0 out )
+      zqlat(:,:) = - pqfwf(:,:) * rLfusisf    ! 2d latent heat flux (W/m2)
+      !
+      ! total heat flux ( >0 out )
+      zqh(:,:) = ( zqhc (:,:) + zqoce(:,:) )
+      !
+      ! lbclnk on melt
+      CALL lbc_lnk_multi( 'isfmlt', zqh, 'T', 1., pqfwf, 'T', 1.)
+      !
+      ! output fluxes
+      CALL isf_diags_flx( Kmm, misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav, 'cav', pqfwf, zqoce, zqlat, zqhc)
+      !
+      ! set temperature content
+      ptsc(:,:,jp_tem) = - zqh(:,:) * r1_rho0_rcp
+      !
+      ! write restart variables (qoceisf, qhcisf, fwfisf for now and before)
+      IF (lrst_oce) CALL isfrst_write(kt, 'cav', ptsc, pqfwf)
+      !
+      IF ( ln_isfdebug ) THEN
+         CALL debug('isf_cav: ptsc T',ptsc(:,:,1))
+         CALL debug('isf_cav: ptsc S',ptsc(:,:,2))
+         CALL debug('isf_cav: pqfwf fwf',pqfwf(:,:))
+      END IF
+      !
+   END SUBROUTINE isf_cav
+
+   SUBROUTINE isf_cav_init
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE isf_cav_init ***
+      !!
+      !! ** Purpose : initialisation of variable needed to compute melt under an ice shelf
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER :: ierr
+      !!---------------------------------------------------------------------
+      !
+      !==============
+      ! 0: allocation
+      !==============
+      !
+      CALL isf_alloc_cav()
+      !
+      !==================
+      ! 1: initialisation
+      !==================
+      !
+      ! top and bottom level of the 'top boundary layer'
+      misfkt_cav(:,:)    = mikt(:,:) ; misfkb_cav(:,:)    = 1
+      !
+      ! thickness of 'tbl' and fraction of bottom cell affected by 'tbl'
+      rhisf_tbl_cav(:,:) = 0.0_wp    ; rfrac_tbl_cav(:,:) = 0.0_wp
+      !
+      ! cavity mask
+      mskisf_cav(:,:)    = (1._wp - tmask(:,:,1)) * ssmask(:,:)
+      !
+      !================
+      ! 2: read restart
+      !================
+      !
+      ! read cav variable from restart
+      IF ( ln_rstart ) CALL isfrst_read('cav', risf_cav_tsc, fwfisf_cav, risf_cav_tsc_b, fwfisf_cav_b)
+      !
+      !==========================================
+      ! 3: specific allocation and initialisation (depending of scheme choice)
+      !==========================================
+      !
+      SELECT CASE ( TRIM(cn_isfcav_mlt) )
+      CASE( 'spe' )
+
+         ALLOCATE( sf_isfcav_fwf(1), STAT=ierr )
+         ALLOCATE( sf_isfcav_fwf(1)%fnow(jpi,jpj,1), sf_isfcav_fwf(1)%fdta(jpi,jpj,1,2) )
+         CALL fld_fill( sf_isfcav_fwf, (/ sn_isfcav_fwf /), cn_isfdir, 'isf_cav_init', 'read fresh water flux isf data', 'namisf' )
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '  ==>> The ice shelf melt inside the cavity is read from forcing files'
+
+      CASE( '2eq' )
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '  ==>> The original ISOMIP melt formulation is used to compute melt under the ice shelves'
+
+      CASE( '3eq' )
+         ! coeficient for linearisation of potential tfreez
+         ! Crude approximation for pressure (but commonly used)
+         IF ( ln_teos10 ) THEN   ! linearisation from Jourdain et al. (2017)
+            risf_lamb1 =-0.0564_wp
+            risf_lamb2 = 0.0773_wp
+            risf_lamb3 =-7.8633e-8 * grav * rho0
+         ELSE                  ! linearisation from table 4 (Asay-Davis et al., 2015)
+            risf_lamb1 =-0.0573_wp
+            risf_lamb2 = 0.0832_wp
+            risf_lamb3 =-7.5300e-8 * grav * rho0
+         ENDIF
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '  ==>> The 3 equations melt formulation is used to compute melt under the ice shelves'
+
+      CASE DEFAULT
+         CALL ctl_stop(' cn_isfcav_mlt method unknown (spe, 2eq, 3eq), check namelist')
+      END SELECT
+      !
+   END SUBROUTINE isf_cav_init
+
+END MODULE isfcav
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfcavgam.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfcavgam.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfcavgam.F90	(revision 12928)
@@ -0,0 +1,257 @@
+MODULE isfcavgam
+   !!======================================================================
+   !!                       ***  MODULE  isfgammats  ***
+   !! Ice shelf gamma module :  compute exchange coeficient at the ice/ocean interface
+   !!======================================================================
+   !! History :  4.1  !  (P. Mathiot) original
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   isfcav_gammats       : compute exchange coeficient gamma 
+   !!----------------------------------------------------------------------
+   USE isf_oce
+   USE isfutils, ONLY: debug
+   USE isftbl  , ONLY: isf_tbl
+
+   USE oce     , ONLY: uu, vv, rn2         ! ocean dynamics and tracers
+   USE phycst  , ONLY: grav, vkarmn        ! physical constant
+   USE eosbn2  , ONLY: eos_rab             ! equation of state
+   USE zdfdrg  , ONLY: rCd0_top, r_ke0_top ! vertical physics: top/bottom drag coef.
+   USE iom     , ONLY: iom_put             !
+   USE lib_mpp , ONLY: ctl_stop
+
+   USE dom_oce        ! ocean space and time domain
+   USE in_out_manager ! I/O manager
+   !
+   IMPLICIT NONE
+   !
+   PRIVATE
+   !
+   PUBLIC   isfcav_gammats
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+   !
+   !!-----------------------------------------------------------------------------------------------------
+   !!                              PUBLIC SUBROUTINES 
+   !!-----------------------------------------------------------------------------------------------------
+   !
+   SUBROUTINE isfcav_gammats( Kmm, pttbl, pstbl, pqoce, pqfwf, pgt, pgs )
+      !!----------------------------------------------------------------------
+      !! ** Purpose    : compute the coefficient echange for heat and fwf flux
+      !!
+      !! ** Method     : select the gamma formulation
+      !!                 3 method available (cst, vel and vel_stab)
+      !!---------------------------------------------------------------------
+      !!-------------------------- OUT -------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: pgt  , pgs      ! gamma t and gamma s 
+      !!-------------------------- IN  -------------------------------------
+      INTEGER                                     :: Kmm             ! ocean time level index
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pqoce, pqfwf    ! isf heat and fwf
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pttbl, pstbl    ! top boundary layer tracer
+      !!---------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj)                :: zutbl, zvtbl    ! top boundary layer velocity
+      !!---------------------------------------------------------------------
+      !
+      !==========================================
+      ! 1.: compute velocity in the tbl if needed
+      !==========================================
+      !
+      SELECT CASE ( cn_gammablk )
+      CASE ( 'spe'  ) 
+         ! gamma is constant (specified in namelist)
+         ! nothing to do
+      CASE ('vel', 'vel_stab')
+         ! compute velocity in tbl
+         CALL isf_tbl(Kmm, uu(:,:,:,Kmm) ,zutbl(:,:),'U', miku, rhisf_tbl_cav)
+         CALL isf_tbl(Kmm, vv(:,:,:,Kmm) ,zvtbl(:,:),'V', mikv, rhisf_tbl_cav)
+         !
+         ! mask velocity in tbl with ice shelf mask
+         zutbl(:,:) = zutbl(:,:) * mskisf_cav(:,:)
+         zvtbl(:,:) = zvtbl(:,:) * mskisf_cav(:,:)
+         !
+         ! output
+         CALL iom_put('utbl',zutbl(:,:))
+         CALL iom_put('vtbl',zvtbl(:,:))
+      CASE DEFAULT
+         CALL ctl_stop('STOP','method to compute gamma (cn_gammablk) is unknown (should not see this)')
+      END SELECT
+      ! 
+      !==========================================
+      ! 2.: compute gamma
+      !==========================================
+      !
+      SELECT CASE ( cn_gammablk )
+      CASE ( 'spe'  ) ! gamma is constant (specified in namelist)
+         pgt(:,:) = rn_gammat0
+         pgs(:,:) = rn_gammas0
+      CASE ( 'vel' ) ! gamma is proportional to u*
+         CALL gammats_vel      (                   zutbl, zvtbl, rCd0_top, r_ke0_top,               pgt, pgs )
+      CASE ( 'vel_stab' ) ! gamma depends of stability of boundary layer and u*
+         CALL gammats_vel_stab (Kmm, pttbl, pstbl, zutbl, zvtbl, rCd0_top, r_ke0_top, pqoce, pqfwf, pgt, pgs )
+      CASE DEFAULT
+         CALL ctl_stop('STOP','method to compute gamma (cn_gammablk) is unknown (should not see this)')
+      END SELECT
+      !
+      !==========================================
+      ! 3.: output and debug
+      !==========================================
+      !
+      CALL iom_put('isfgammat', pgt(:,:))
+      CALL iom_put('isfgammas', pgs(:,:))
+      !
+      IF (ln_isfdebug) THEN
+         CALL debug( 'isfcav_gam pgt:', pgt(:,:) )
+         CALL debug( 'isfcav_gam pgs:', pgs(:,:) )
+      END IF
+      !
+   END SUBROUTINE isfcav_gammats
+   !
+   !!-----------------------------------------------------------------------------------------------------
+   !!                              PRIVATE SUBROUTINES 
+   !!-----------------------------------------------------------------------------------------------------
+   !
+   SUBROUTINE gammats_vel( putbl, pvtbl, pCd, pke2, &   ! <<== in
+      &                                  pgt, pgs   )   ! ==>> out gammats [m/s]
+      !!----------------------------------------------------------------------
+      !! ** Purpose    : compute the coefficient echange coefficient 
+      !!
+      !! ** Method     : gamma is velocity dependent ( gt= gt0 * Ustar )
+      !!
+      !! ** Reference  : Asay-Davis et al., Geosci. Model Dev., 9, 2471-2497, 2016
+      !!---------------------------------------------------------------------
+      !!-------------------------- OUT -------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: pgt, pgs     ! gammat and gammas [m/s]
+      !!-------------------------- IN  -------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: putbl, pvtbl ! velocity in the losch top boundary layer
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pCd          ! drag coefficient
+      REAL(wp),                     INTENT(in   ) :: pke2         ! background velocity
+      !!---------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj) :: zustar
+      !!---------------------------------------------------------------------
+      !
+      ! compute ustar (AD15 eq. 27)
+      zustar(:,:) = SQRT( pCd(:,:) * ( putbl(:,:) * putbl(:,:) + pvtbl(:,:) * pvtbl(:,:) + pke2 ) ) * mskisf_cav(:,:)
+      !
+      ! Compute gammats
+      pgt(:,:) = zustar(:,:) * rn_gammat0
+      pgs(:,:) = zustar(:,:) * rn_gammas0
+      !
+      ! output ustar
+      CALL iom_put('isfustar',zustar(:,:))
+      !
+   END SUBROUTINE gammats_vel
+
+   SUBROUTINE gammats_vel_stab( Kmm, pttbl, pstbl, putbl, pvtbl, pCd, pke2, pqoce, pqfwf, &  ! <<== in
+      &                                                                     pgt  , pgs    )  ! ==>> out gammats [m/s]
+      !!----------------------------------------------------------------------
+      !! ** Purpose    : compute the coefficient echange coefficient 
+      !!
+      !! ** Method     : gamma is velocity dependent and stability dependent
+      !!
+      !! ** Reference  : Holland and Jenkins, 1999, JPO, p1787-1800
+      !!---------------------------------------------------------------------
+      !!-------------------------- OUT -------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: pgt, pgs     ! gammat and gammas
+      !!-------------------------- IN  -------------------------------------
+      INTEGER                                     :: Kmm            ! ocean time level index
+      REAL(wp),                     INTENT(in   ) :: pke2           ! background velocity squared
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pqoce, pqfwf   ! surface heat flux and fwf flux
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pCd            ! drag coeficient
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: putbl, pvtbl   ! velocity in the losch top boundary layer
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pttbl, pstbl   ! tracer   in the losch top boundary layer
+      !!---------------------------------------------------------------------
+      INTEGER  :: ji, jj                     ! loop index
+      INTEGER  :: ikt                        ! local integer
+      REAL(wp) :: zdku, zdkv                 ! U, V shear 
+      REAL(wp) :: zPr, zSc, zRc              ! Prandtl, Scmidth and Richardson number 
+      REAL(wp) :: zmob, zmols                ! Monin Obukov length, coriolis factor at T point
+      REAL(wp) :: zbuofdep, zhnu             ! Bouyancy length scale, sublayer tickness
+      REAL(wp) :: zhmax                      ! limitation of mol
+      REAL(wp) :: zetastar                   ! stability parameter
+      REAL(wp) :: zgmolet, zgmoles, zgturb   ! contribution of modelecular sublayer and turbulence 
+      REAL(wp) :: zcoef                      ! temporary coef
+      REAL(wp) :: zdep
+      REAL(wp) :: zeps = 1.0e-20_wp    
+      REAL(wp), PARAMETER :: zxsiN = 0.052_wp   ! dimensionless constant
+      REAL(wp), PARAMETER :: znu   = 1.95e-6_wp ! kinamatic viscosity of sea water (m2.s-1)
+      REAL(wp), DIMENSION(2) :: zts, zab
+      REAL(wp), DIMENSION(jpi,jpj) :: zustar    ! friction velocity
+      !!---------------------------------------------------------------------
+      !
+      ! compute ustar
+      zustar(:,:) = SQRT( pCd * ( putbl(:,:) * putbl(:,:) + pvtbl(:,:) * pvtbl(:,:) + pke2 ) )
+      !
+      ! output ustar
+      CALL iom_put('isfustar',zustar(:,:))
+      !
+      ! compute Pr and Sc number (eq ??)
+      zPr =   13.8_wp
+      zSc = 2432.0_wp
+      !
+      ! compute gamma mole (eq ??)
+      zgmolet = 12.5_wp * zPr ** (2.0/3.0) - 6.0_wp
+      zgmoles = 12.5_wp * zSc ** (2.0/3.0) - 6.0_wp
+      !
+      ! compute gamma
+      DO ji = 2, jpi
+         DO jj = 2, jpj
+            ikt = mikt(ji,jj)
+
+            IF( zustar(ji,jj) == 0._wp ) THEN           ! only for kt = 1 I think
+               pgt = rn_gammat0
+               pgs = rn_gammas0
+            ELSE
+               ! compute Rc number (as done in zdfric.F90)
+!!gm better to do it like in the new zdfric.F90   i.e. avm weighted Ri computation
+               zcoef = 0.5_wp / e3w(ji,jj,ikt+1,Kmm)
+               !                                            ! shear of horizontal velocity
+               zdku = zcoef * (  uu(ji-1,jj  ,ikt  ,Kmm) + uu(ji,jj,ikt  ,Kmm)  &
+                  &             -uu(ji-1,jj  ,ikt+1,Kmm) - uu(ji,jj,ikt+1,Kmm)  )
+               zdkv = zcoef * (  vv(ji  ,jj-1,ikt  ,Kmm) + vv(ji,jj,ikt  ,Kmm)  &
+                  &             -vv(ji  ,jj-1,ikt+1,Kmm) - vv(ji,jj,ikt+1,Kmm)  )
+               !                                            ! richardson number (minimum value set to zero)
+               zRc = MAX(rn2(ji,jj,ikt+1), 0._wp) / MAX( zdku*zdku + zdkv*zdkv, zeps )
+
+               ! compute bouyancy 
+               zts(jp_tem) = pttbl(ji,jj)
+               zts(jp_sal) = pstbl(ji,jj)
+               zdep        = gdepw(ji,jj,ikt,Kmm)
+               !
+               CALL eos_rab( zts, zdep, zab, Kmm )
+               !
+               ! compute length scale (Eq ??)
+               zbuofdep = grav * ( zab(jp_tem) * pqoce(ji,jj) - zab(jp_sal) * pqfwf(ji,jj) )
+               !
+               ! compute Monin Obukov Length
+               ! Maximum boundary layer depth (Eq ??)
+               zhmax = gdept(ji,jj,mbkt(ji,jj),Kmm) - gdepw(ji,jj,mikt(ji,jj),Kmm) -0.001_wp
+               !
+               ! Compute Monin obukhov length scale at the surface and Ekman depth: (Eq ??)
+               zmob   = zustar(ji,jj) ** 3 / (vkarmn * (zbuofdep + zeps))
+               zmols  = SIGN(1._wp, zmob) * MIN(ABS(zmob), zhmax) * tmask(ji,jj,ikt)
+               !
+               ! compute eta* (stability parameter) (Eq ??)
+               zetastar = 1._wp / ( SQRT(1._wp + MAX(zxsiN * zustar(ji,jj) / ( ABS(ff_f(ji,jj)) * zmols * zRc ), 0._wp)))
+               !
+               ! compute the sublayer thickness (Eq ??)
+               zhnu = 5 * znu / zustar(ji,jj)
+               !
+               ! compute gamma turb (Eq ??)
+               zgturb = 1._wp / vkarmn * LOG(zustar(ji,jj) * zxsiN * zetastar * zetastar / ( ABS(ff_f(ji,jj)) * zhnu )) &
+               &      + 1._wp / ( 2 * zxsiN * zetastar ) - 1._wp / vkarmn
+               !
+               ! compute gammats
+               pgt(ji,jj) = zustar(ji,jj) / (zgturb + zgmolet)
+               pgs(ji,jj) = zustar(ji,jj) / (zgturb + zgmoles)
+            END IF
+         END DO
+      END DO
+
+   END SUBROUTINE gammats_vel_stab
+
+END MODULE isfcavgam
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfcavmlt.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfcavmlt.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfcavmlt.F90	(revision 12928)
@@ -0,0 +1,310 @@
+MODULE isfcavmlt
+   !!======================================================================
+   !!                       ***  MODULE  isfcavmlt  ***
+   !! ice shelf module :  update surface ocean boundary condition under ice
+   !!                   shelves
+   !!======================================================================
+   !! History :  4.0  !  2019-09  (P. Mathiot) Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   isfcav_mlt    : compute or read ice shelf fwf/heat fluxes in the ice shelf cavity
+   !!----------------------------------------------------------------------
+
+   USE isf_oce                  ! ice shelf
+   USE isftbl , ONLY: isf_tbl   ! ice shelf depth average
+   USE isfutils,ONLY: debug     ! debug subroutine
+
+   USE dom_oce                            ! ocean space and time domain
+   USE phycst , ONLY: rcp, rho0, rho0_rcp ! physical constants
+   USE eosbn2 , ONLY: eos_fzp             ! equation of state
+
+   USE in_out_manager              ! I/O manager
+   USE iom        , ONLY: iom_put  ! I/O library
+   USE fldread    , ONLY: fld_read, FLD, FLD_N !
+   USE lib_fortran, ONLY: glob_sum !
+   USE lib_mpp    , ONLY: ctl_stop !
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   isfcav_mlt
+
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+! -------------------------------------------------------------------------------------------------------
+! -------------------------------- PUBLIC SUBROUTINE ----------------------------------------------------
+! -------------------------------------------------------------------------------------------------------
+
+   SUBROUTINE isfcav_mlt(kt, pgt, pgs , pttbl, pstbl, &
+      &                           pqhc, pqoce, pqfwf  )
+      !!----------------------------------------------------------------------
+      !!
+      !!                          ***  ROUTINE isfcav_mlt  ***
+      !!
+      !! ** Purpose    : compute or read ice shelf fwf/heat fluxes in the ice shelf cavity
+      !!
+      !!-------------------------- OUT -------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: pqhc, pqoce, pqfwf  ! heat and fwf fluxes
+      !!-------------------------- IN  -------------------------------------
+      INTEGER, INTENT(in) :: kt
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pgt  , pgs    ! gamma t and gamma s
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pttbl, pstbl  ! top boundary layer tracer
+      !!---------------------------------------------------------------------
+      !
+      ! compute latent heat and melt (2d)
+      SELECT CASE ( cn_isfcav_mlt )
+      CASE ( 'spe' )   ! ice shelf melt specified (read input file, and heat fluxes derived from
+         CALL isfcav_mlt_spe( kt, pstbl,               &
+            &                  pqhc, pqoce, pqfwf  )
+      CASE ( '2eq' )   !  ISOMIP  formulation (2 equations) for volume flux (Hunter et al., 2006)
+         CALL isfcav_mlt_2eq( pgt, pttbl, pstbl,       &
+            &                  pqhc , pqoce, pqfwf )
+      CASE ( '3eq' )   ! ISOMIP+ formulation (3 equations) for volume flux (Asay-Davis et al., 2015)
+         CALL isfcav_mlt_3eq( pgt, pgs , pttbl, pstbl, &
+            &                  pqhc, pqoce, pqfwf  )
+      CASE ( 'oasis' ) ! fwf pass trough oasis
+         CALL isfcav_mlt_oasis( kt, pstbl,              &
+            &                   pqhc, pqoce, pqfwf  )
+      CASE DEFAULT
+         CALL ctl_stop('STOP', 'unknown isf melt formulation : cn_isfcav (should not see this)')
+      END SELECT
+      !
+      IF (ln_isfdebug) THEN
+         CALL debug( 'isfcav_mlt qhc  :', pqhc (:,:) )
+         CALL debug( 'isfcav_mlt qoce :', pqoce(:,:) )
+         CALL debug( 'isfcav_mlt qfwf :', pqfwf(:,:) )
+      END IF
+      !
+   END SUBROUTINE isfcav_mlt
+
+! -------------------------------------------------------------------------------------------------------
+! -------------------------------- PRIVATE SUBROUTINE ---------------------------------------------------
+! -------------------------------------------------------------------------------------------------------
+
+   SUBROUTINE isfcav_mlt_spe(kt, pstbl,          &  ! <<== in
+      &                      pqhc , pqoce, pqfwf )  ! ==>> out
+      !!----------------------------------------------------------------------
+      !!
+      !!                          ***  ROUTINE isfcav_mlt_spe  ***
+      !!
+      !! ** Purpose    : - read ice shelf melt from forcing file
+      !!                 - compute ocea-ice heat flux (assuming it is equal to latent heat)
+      !!                 - compute heat content flux
+      !!---------------------------------------------------------------------
+      !!-------------------------- OUT -------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: pqhc, pqoce, pqfwf  ! heat content, latent heat and fwf fluxes
+      !!-------------------------- IN  -------------------------------------
+      INTEGER                     , INTENT(in   ) :: kt                  ! current time step
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pstbl               ! salinity in tbl
+      !!--------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj) :: ztfrz                              ! tbl freezing temperature
+      !!--------------------------------------------------------------------
+      !
+      ! Compute freezing temperature
+      CALL eos_fzp( pstbl(:,:), ztfrz(:,:), risfdep(:,:) )
+      !
+      ! read input file
+      CALL fld_read ( kt, 1, sf_isfcav_fwf )
+      !
+      ! define fwf and qoce
+      ! ocean heat flux is assume to be equal to the latent heat
+      pqfwf(:,:) = - sf_isfcav_fwf(1)%fnow(:,:,1)      ! fwf                ( >0 out)
+      pqoce(:,:) = - pqfwf(:,:) * rLfusisf             ! ocean heat flux    ( >0 out)
+      pqhc (:,:) =   pqfwf(:,:) * ztfrz(:,:) * rcp     ! heat content flux  ( >0 out)
+      !
+      ! output freezing point at the interface
+      CALL iom_put('isftfrz_cav', ztfrz )
+      !
+   END SUBROUTINE isfcav_mlt_spe
+
+   SUBROUTINE isfcav_mlt_2eq(pgt , pttbl, pstbl, &  ! <<== in
+      &                      pqhc, pqoce, pqfwf  )  ! ==>> out
+      !!----------------------------------------------------------------------
+      !!
+      !!                          ***  ROUTINE isfcav_mlt_2eq  ***
+      !!
+      !! ** Purpose    : Compute ice shelf fwf/heqt fluxes using ISOMIP formulation (Hunter et al., 2006)
+      !!
+      !! ** Method     : The ice shelf melt latent heat is defined as being equal to the ocean/ice heat flux.
+      !!                 From this we can derived the fwf, ocean/ice heat flux and the heat content flux as being :
+      !!                   qfwf  = Gammat * Rau0 * Cp * ( Tw - Tfrz ) / Lf 
+      !!                   qhoce = qlat
+      !!                   qhc   = qfwf * Cp * Tfrz
+      !!
+      !! ** Reference  : Hunter,  J.  R.:  Specification  for  test  models  of  ice  shelf  cavities,  
+      !!                 Tech.  Rep.  June,  Antarctic  Climate  &  Ecosystems  Cooperative  Research  Centre,  available  at:  
+      !!                 http://staff.acecrc.org.au/~bkgalton/ISOMIP/test_cavities.pdf (last access: 21 July 2016), 2006.
+      !!
+      !!-------------------------- OUT -------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: pqhc, pqoce, pqfwf  ! hean content, ocean-ice heat and fwf fluxes
+      !!-------------------------- IN  -------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pgt           ! temperature exchange coeficient
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pttbl, pstbl  ! temperature and salinity in top boundary layer
+      !!--------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj) :: ztfrz         ! freezing temperature
+      REAL(wp), DIMENSION(jpi,jpj) :: zthd          ! thermal driving
+      !!--------------------------------------------------------------------
+      !
+      ! Calculate freezing temperature
+      CALL eos_fzp( pstbl(:,:), ztfrz(:,:), risfdep(:,:) )
+      !
+      ! thermal driving
+      zthd (:,:) = ( pttbl(:,:) - ztfrz(:,:) ) * mskisf_cav(:,:)
+      !
+      ! compute ocean-ice heat flux and then derive fwf assuming that ocean heat flux equal latent heat
+      pqfwf(:,:) = - pgt(:,:) * rho0_rcp * zthd(:,:) / rLfusisf    ! fresh water flux  ( > 0 out )
+      pqoce(:,:) = - pqfwf(:,:) * rLfusisf                         ! ocea-ice flux     ( > 0 out )
+      pqhc (:,:) =   pqfwf(:,:) * ztfrz(:,:) * rcp                 ! heat content flux ( > 0 out )
+      !
+      ! output thermal driving and freezinpoint at the ice shelf interface
+      CALL iom_put('isfthermald_cav', zthd )
+      CALL iom_put('isftfrz_cav'    , ztfrz )
+      !
+   END SUBROUTINE isfcav_mlt_2eq
+
+   SUBROUTINE isfcav_mlt_3eq(pgt, pgs , pttbl, pstbl, &  ! <<== in
+      &                           pqhc, pqoce, pqfwf  )  ! ==>> out
+      !!----------------------------------------------------------------------
+      !!
+      !!                          ***  ROUTINE isfcav_mlt_3eq  ***
+      !!
+      !! ** Purpose    : Compute ice shelf fwf/heqt fluxes using the 3 equation formulation 
+      !!
+      !! ** Method     : The melt rate is determined considering the heat balance, the salt balance
+      !!                 at the phase change interface and a linearisation of the equation of state.
+      !!
+      !! ** Reference  : - Holland, D. M. and Jenkins, A.,
+      !!                   Modeling Thermodynamic Ice-Ocean Interactions at the Base of an Ice Shelf,
+      !!                   J. Phys. Oceanogr., 29, 1999.
+      !!                 - Asay-Davis, X. S., Cornford, S. L., Durand, G., Galton-Fenzi, B. K., Gladstone, 
+      !!                   R. M., Gudmundsson, G. H., Hattermann, T., Holland, D. M., Holland, D., Holland, 
+      !!                   P. R., Martin, D. F., Mathiot, P., Pattyn, F., and Seroussi, H.:
+      !!                   Experimental design for three interrelated marine ice sheet and ocean model intercomparison projects: 
+      !!                   MISMIP v. 3 (MISMIP +), ISOMIP v. 2 (ISOMIP +) and MISOMIP v. 1 (MISOMIP1), 
+      !!                   Geosci. Model Dev., 9, 2471-2497, https://doi.org/10.5194/gmd-9-2471-2016, 2016. 
+      !!
+      !!-------------------------- OUT -------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: pqhc, pqoce, pqfwf  ! latent heat and fwf fluxes
+      !!-------------------------- IN  -------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pgt  , pgs          ! heat/salt exchange coeficient
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pttbl, pstbl        ! mean temperature and salinity in top boundary layer
+      !!--------------------------------------------------------------------
+      REAL(wp) :: zeps1,zeps2,zeps3,zeps4,zeps6,zeps7       ! dummy local scalar for quadratic equation resolution
+      REAL(wp) :: zaqe,zbqe,zcqe,zaqer,zdis,zsfrz,zcfac     ! dummy local scalar for quadratic equation resolution
+      REAL(wp) :: zeps = 1.e-20
+      REAL(wp), DIMENSION(jpi,jpj) :: ztfrz         ! freezing point
+      REAL(wp), DIMENSION(jpi,jpj) :: zqcon         ! conductive flux through the ice shelf
+      REAL(wp), DIMENSION(jpi,jpj) :: zthd          ! thermal driving
+      !
+      INTEGER  ::   ji, jj     ! dummy loop indices
+      !!--------------------------------------------------------------------
+      !
+      ! compute upward heat flux zhtflx and upward water flux zwflx
+      ! Resolution of a 3d equation from equation 24, 25 and 26 (note conduction through the ice has been added to Eq 24)
+      DO_2D_11_11
+         !
+         ! compute coeficient to solve the 2nd order equation
+         zeps1 = rho0_rcp * pgt(ji,jj)
+         zeps2 = rLfusisf * rho0 * pgs(ji,jj)
+         zeps3 = rhoisf * rcpisf * rkappa / MAX(risfdep(ji,jj),zeps)
+         zeps4 = risf_lamb2 + risf_lamb3 * risfdep(ji,jj)
+         zeps6 = zeps4 - pttbl(ji,jj)
+         zeps7 = zeps4 - rtsurf
+         !
+         ! solve the 2nd order equation to find zsfrz
+         zaqe  = risf_lamb1 * (zeps1 + zeps3)
+         zaqer = 0.5_wp / MIN(zaqe,-zeps)
+         zbqe  = zeps1 * zeps6 + zeps3 * zeps7 - zeps2
+         zcqe  = zeps2 * pstbl(ji,jj)
+         zdis  = zbqe * zbqe - 4.0_wp * zaqe * zcqe               
+         !
+         ! Presumably zdis can never be negative because gammas is very small compared to gammat
+         zsfrz=(-zbqe - SQRT(zdis)) * zaqer
+         IF ( zsfrz < 0.0_wp ) zsfrz=(-zbqe + SQRT(zdis)) * zaqer  ! check this if this if is needed
+         !
+         ! compute t freeze (eq. 25)
+         ztfrz(ji,jj) = zeps4 + risf_lamb1 * zsfrz
+         !
+         ! thermal driving
+         zthd(ji,jj) = ( pttbl(ji,jj) - ztfrz(ji,jj) )
+         !
+         ! compute the upward water and heat flux (eq. 24 and eq. 26)
+         pqfwf(ji,jj) = rho0     * pgs(ji,jj) * ( zsfrz - pstbl(ji,jj) ) / MAX(zsfrz,zeps) ! fresh water flux    (> 0 out)
+         pqoce(ji,jj) = rho0_rcp * pgt(ji,jj) * zthd (ji,jj)                               ! ocean-ice heat flux (> 0 out)
+         pqhc (ji,jj) = rcp      * pqfwf(ji,jj) * ztfrz(ji,jj)                             ! heat content   flux (> 0 out)
+         !
+         zqcon(ji,jj) = zeps3 * ( ztfrz(ji,jj) - rtsurf )
+         !
+      END_2D
+      !
+      ! output conductive heat flux through the ice
+      CALL iom_put('qconisf', zqcon(:,:) * mskisf_cav(:,:) )
+      !
+      ! output thermal driving and freezing point at the interface
+      CALL iom_put('isfthermald_cav', zthd (:,:) * mskisf_cav(:,:) )
+      CALL iom_put('isftfrz_cav'    , ztfrz(:,:) * mskisf_cav(:,:) )
+      !
+   END SUBROUTINE isfcav_mlt_3eq
+
+   SUBROUTINE isfcav_mlt_oasis(kt, pstbl,          &  ! <<== in
+      &                        pqhc , pqoce, pqfwf )  ! ==>> out
+      !!----------------------------------------------------------------------
+      !!                          ***  ROUTINE isfcav_mlt_oasis  ***
+      !!
+      !! ** Purpose    : scale the fwf read from input file by the total amount received by the sbccpl interface
+      !!
+      !! ** Purpose    : - read ice shelf melt from forcing file => pattern
+      !!                 - total amount of fwf is given by sbccpl (fwfisf_cpl)
+      !!                 - scale fwf and compute heat fluxes
+      !!
+      !!---------------------------------------------------------------------
+      !!-------------------------- OUT -------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: pqhc, pqoce, pqfwf  ! heat content, latent heat and fwf fluxes
+      !!-------------------------- IN  -------------------------------------
+      INTEGER                     , INTENT(in   ) :: kt                  ! current time step
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pstbl               ! salinity in tbl
+      !!--------------------------------------------------------------------
+      REAL(wp)                     :: zfwf_fld, zfwf_oasis               ! total fwf in the forcing fields (pattern) and from the oasis interface (amount)
+      REAL(wp), DIMENSION(jpi,jpj) :: ztfrz                              ! tbl freezing temperature
+      REAL(wp), DIMENSION(jpi,jpj) :: zfwf                               ! 2d fwf map after scaling
+      !!--------------------------------------------------------------------
+      !
+      ! Calculate freezing temperature
+      CALL eos_fzp( pstbl(:,:), ztfrz(:,:), risfdep(:,:) )
+      !
+      ! read input file
+      CALL fld_read ( kt, 1, sf_isfcav_fwf )
+      !
+      ! ice shelf 2d map
+      zfwf(:,:) = - sf_isfcav_fwf(1)%fnow(:,:,1)
+      !
+      ! compute glob sum from input file
+      ! (PM) should consider delay sum as in fwb (1 time step offset if I well understood)
+      zfwf_fld = glob_sum('isfcav_mlt', e1e2t(:,:) * zfwf(:,:))
+      !
+      ! compute glob sum from atm->oce ice shelf fwf
+      ! (PM) should consider delay sum as in fwb (1 time step offset if I well understood)
+      zfwf_oasis = glob_sum('isfcav_mlt', e1e2t(:,:) * fwfisf_oasis(:,:))
+      !
+      ! scale fwf
+      zfwf(:,:) = zfwf(:,:) * zfwf_oasis / zfwf_fld
+      ! 
+      ! define fwf and qoce
+      ! ocean heat flux is assume to be equal to the latent heat
+      pqfwf(:,:) =   zfwf(:,:)                         ! fwf                ( >0 out)
+      pqoce(:,:) = - pqfwf(:,:) * rLfusisf             ! ocean heat flux    ( >0 out)
+      pqhc (:,:) =   pqfwf(:,:) * ztfrz(:,:) * rcp     ! heat content flux  ( >0 out)
+      !
+      CALL iom_put('isftfrz_cav', ztfrz * mskisf_cav(:,:) )
+      !
+   END SUBROUTINE isfcav_mlt_oasis
+
+END MODULE isfcavmlt
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfcpl.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfcpl.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfcpl.F90	(revision 12928)
@@ -0,0 +1,748 @@
+MODULE isfcpl
+   !!======================================================================
+   !!                       ***  MODULE  isfcpl  ***
+   !!
+   !! iceshelf coupling module : module managing the coupling between NEMO and an ice sheet model
+   !!
+   !!======================================================================
+   !! History :  4.1  !  2019-07  (P. Mathiot) Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   isfrst : read/write iceshelf variables in/from restart
+   !!----------------------------------------------------------------------
+   USE isf_oce                          ! ice shelf variable
+   USE isfutils, ONLY : debug
+   USE lib_mpp , ONLY: mpp_sum, mpp_max ! mpp routine
+   USE domvvl  , ONLY: dom_vvl_zgr      ! vertical scale factor interpolation
+   USE domngb  , ONLY: dom_ngb          ! find the closest grid point from a given lon/lat position
+   !
+   USE oce            ! ocean dynamics and tracers
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O library
+   !
+   IMPLICIT NONE
+
+   PRIVATE
+
+   PUBLIC isfcpl_rst_write, isfcpl_init                    ! iceshelf restart read and write 
+   PUBLIC isfcpl_ssh, isfcpl_tra, isfcpl_vol, isfcpl_cons  ! iceshelf correction for ssh, tra, dyn and conservation 
+
+   TYPE isfcons
+      INTEGER :: ii     ! i global
+      INTEGER :: jj     ! j global
+      INTEGER :: kk     ! k level
+      REAL(wp):: dvol   ! volume increment
+      REAL(wp):: dsal   ! salt increment
+      REAL(wp):: dtem   ! heat increment
+      REAL(wp):: lon    ! lon
+      REAL(wp):: lat    ! lat
+      INTEGER :: ngb    ! 0/1 (valid location or not (ie on halo or no neigbourg))
+   END TYPE
+   !
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE isfcpl_init(Kbb, Kmm, Kaa)
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE iscpl_init  ***
+      !! 
+      !! ** Purpose : correct ocean state for new wet cell and horizontal divergence 
+      !!              correction for the dynamical adjustement
+      !!
+      !! ** Action : - compute ssh on new wet cell
+      !!             - compute T/S on new wet cell
+      !!             - compute horizontal divergence correction as a volume flux
+      !!             - compute the T/S/vol correction increment to keep trend to 0
+      !!
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) :: Kbb, Kmm, Kaa      ! ocean time level indices
+      !!---------------------------------------------------------------------
+      INTEGER :: id
+      !!----------------------------------------------------------------------
+      !
+      ! start on an euler time step
+      l_1st_euler = .TRUE.
+      ! 
+      ! allocation and initialisation to 0
+      CALL isf_alloc_cpl()
+      !
+      ! check presence of variable needed for coupling
+      ! iom_varid return 0 if not found
+      id = 1
+      id = id * iom_varid(numror, 'ssmask', ldstop = .false.)
+      id = id * iom_varid(numror, 'tmask' , ldstop = .false.)
+      id = id * iom_varid(numror, 'e3t_n' , ldstop = .false.)
+      id = id * iom_varid(numror, 'e3u_n' , ldstop = .false.)
+      id = id * iom_varid(numror, 'e3v_n' , ldstop = .false.)
+      IF(lwp) WRITE(numout,*) ' isfcpl_init:', id
+      IF (id == 0) THEN
+         IF(lwp) WRITE(numout,*) ' isfcpl_init: restart variables for ice sheet coupling are missing, skip coupling for this leg ' 
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~'
+         IF(lwp) WRITE(numout,*) ''
+      ELSE
+         ! extrapolation ssh
+         CALL isfcpl_ssh(Kbb, Kmm, Kaa)
+         !
+         ! extrapolation tracer properties
+         CALL isfcpl_tra(Kmm)
+         !
+         ! correction of the horizontal divergence and associated temp. and salt content flux
+         ! Need to : - include in the cpl cons the risfcpl_vol/tsc contribution
+         !           - decide how to manage thickness level change in conservation
+         CALL isfcpl_vol(Kmm)
+         !
+         ! apply the 'conservation' method
+         IF ( ln_isfcpl_cons ) CALL isfcpl_cons(Kmm)
+         !
+      END IF
+      !
+      ! mask velocity properly (mask used in restart not compatible with new mask)
+      uu(:,:,:,Kmm) = uu(:,:,:,Kmm) * umask(:,:,:)
+      vv(:,:,:,Kmm) = vv(:,:,:,Kmm) * vmask(:,:,:)
+      !
+      ! all before fields set to now values
+      ts  (:,:,:,:,Kbb) = ts  (:,:,:,:,Kmm)
+      uu   (:,:,:,Kbb)   = uu   (:,:,:,Kmm)
+      vv   (:,:,:,Kbb)   = vv   (:,:,:,Kmm)
+      ssh (:,:,Kbb)     = ssh (:,:,Kmm)
+      e3t(:,:,:,Kbb)   = e3t(:,:,:,Kmm)
+ 
+      ! prepare writing restart
+      IF( lwxios ) THEN
+         CALL iom_set_rstw_var_active('ssmask')
+         CALL iom_set_rstw_var_active('tmask')
+         CALL iom_set_rstw_var_active('e3t_n')
+         CALL iom_set_rstw_var_active('e3u_n')
+         CALL iom_set_rstw_var_active('e3v_n')
+      END IF
+      !
+   END SUBROUTINE isfcpl_init
+   ! 
+   SUBROUTINE isfcpl_rst_write(kt, Kmm)
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE iscpl_rst_write  ***
+      !! 
+      !! ** Purpose : write icesheet coupling variables in restart
+      !!
+      !!-------------------------- IN  --------------------------------------
+      INTEGER, INTENT(in) :: kt
+      INTEGER, INTENT(in) :: Kmm    ! ocean time level index
+      !!----------------------------------------------------------------------
+      !
+      IF( lwxios ) CALL iom_swap( cwxios_context )
+      CALL iom_rstput( kt, nitrst, numrow, 'tmask'  , tmask , ldxios = lwxios )
+      CALL iom_rstput( kt, nitrst, numrow, 'ssmask' , ssmask, ldxios = lwxios )
+      CALL iom_rstput( kt, nitrst, numrow, 'e3t_n'  , e3t(:,:,:,Kmm) , ldxios = lwxios )
+      CALL iom_rstput( kt, nitrst, numrow, 'e3u_n'  , e3u(:,:,:,Kmm) , ldxios = lwxios )
+      CALL iom_rstput( kt, nitrst, numrow, 'e3v_n'  , e3v(:,:,:,Kmm) , ldxios = lwxios )
+      CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', gdepw(:,:,:,Kmm) , ldxios = lwxios )
+      IF( lwxios ) CALL iom_swap( cxios_context )
+      !
+   END SUBROUTINE isfcpl_rst_write
+
+   SUBROUTINE isfcpl_ssh(Kbb, Kmm, Kaa)
+      !!---------------------------------------------------------------------- 
+      !!                   ***  ROUTINE iscpl_ssh  ***
+      !! 
+      !! ** Purpose :   basic guess of ssh in new wet cell
+      !! 
+      !! ** Method  :   basic extrapolation from neigbourg cells
+      !!
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER, INTENT(in) :: Kbb, Kmm, Kaa    ! ocean time level indices
+      !!----------------------------------------------------------------------
+      INTEGER :: ji, jj, jd, jk      !! loop index
+      INTEGER :: jip1, jim1, jjp1, jjm1
+      !!
+      REAL(wp):: zsummsk
+      REAL(wp), DIMENSION(jpi,jpj) :: zdssmask, zssmask0, zssmask_b, zssh
+      !!----------------------------------------------------------------------
+      !
+      CALL iom_get( numror, jpdom_autoglo, 'ssmask'  , zssmask_b, ldxios = lrxios   ) ! need to extrapolate T/S
+
+      ! compute new ssh if we open a full water column 
+      ! rude average of the closest neigbourgs (e1e2t not taking into account)
+      !
+      zssh(:,:)     = ssh(:,:,Kmm)
+      zssmask0(:,:) = zssmask_b(:,:)
+      !
+      DO jd = 1, nn_drown
+         !
+         zdssmask(:,:) = ssmask(:,:) - zssmask0(:,:)
+         DO_2D_00_00
+            jip1=ji+1; jim1=ji-1;
+            jjp1=jj+1; jjm1=jj-1;
+            !
+            zsummsk = zssmask0(jip1,jj) + zssmask0(jim1,jj) + zssmask0(ji,jjp1) + zssmask0(ji,jjm1)
+            !
+            IF (zdssmask(ji,jj) == 1._wp .AND. zsummsk /= 0._wp) THEN
+               ssh(ji,jj,Kmm)=( zssh(jip1,jj)*zssmask0(jip1,jj)     &
+               &           + zssh(jim1,jj)*zssmask0(jim1,jj)     &
+               &           + zssh(ji,jjp1)*zssmask0(ji,jjp1)     &
+               &           + zssh(ji,jjm1)*zssmask0(ji,jjm1)) / zsummsk
+               zssmask_b(ji,jj) = 1._wp
+            ENDIF
+         END_2D
+         !
+         zssh(:,:) = ssh(:,:,Kmm)
+         zssmask0(:,:) = zssmask_b(:,:)
+         !
+         CALL lbc_lnk_multi( 'iscplrst', zssh, 'T', 1., zssmask0, 'T', 1. )
+         !
+      END DO
+      !
+      ! update ssh(:,:,Kmm)
+      ssh(:,:,Kmm) = zssh(:,:) * ssmask(:,:)
+      !
+      ssh(:,:,Kbb) = ssh(:,:,Kmm)
+      !
+      IF ( ln_isfdebug ) CALL debug('isfcpl_ssh: sshn',ssh(:,:,Kmm))
+      !
+      ! recompute the vertical scale factor, depth and water thickness
+      IF(lwp) write(numout,*) 'isfcpl_ssh : recompute scale factor from ssh (new wet cell,Kmm)'
+      IF(lwp) write(numout,*) '~~~~~~~~~~~'
+      DO jk = 1, jpk
+         e3t(:,:,jk,Kmm) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) &
+             &                          / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   &
+             &          + e3t_0(:,:,jk)                               * (1._wp -tmask(:,:,jk))
+      END DO
+      e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm)
+      CALL dom_vvl_zgr(Kbb, Kmm, Kaa)
+      !
+   END SUBROUTINE isfcpl_ssh
+
+   SUBROUTINE isfcpl_tra(Kmm)
+      !!---------------------------------------------------------------------- 
+      !!                   ***  ROUTINE iscpl_tra  ***
+      !! 
+      !! ** Purpose :   compute new tn, sn in case of evolving geometry of ice shelves 
+      !! 
+      !! ** Method  :   tn, sn : basic extrapolation from neigbourg cells
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: Kmm    ! ocean time level index
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztmask_b
+      !REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: pdepw_b                         !! depth w before
+      !!
+      INTEGER :: ji, jj, jk, jd          !! loop index
+      INTEGER :: jip1, jim1, jjp1, jjm1, jkp1, jkm1
+      !!
+      REAL(wp):: zsummsk
+      REAL(wp):: zdz, zdzm1, zdzp1
+      !!
+      REAL(wp), DIMENSION(jpi,jpj)          :: zdmask 
+      REAL(wp), DIMENSION(jpi,jpj,jpk)      :: ztmask0, zwmaskn
+      REAL(wp), DIMENSION(jpi,jpj,jpk)      :: ztmask1, zwmaskb, ztmp3d
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts0
+      !!----------------------------------------------------------------------
+      ! 
+      CALL iom_get( numror, jpdom_autoglo, 'tmask'  , ztmask_b, ldxios = lrxios   ) ! need to extrapolate T/S
+      !CALL iom_get( numror, jpdom_autoglo, 'wmask'  , zwmask_b, ldxios = lrxios   ) ! need to extrapolate T/S
+      !CALL iom_get( numror, jpdom_autoglo, 'gdepw_n', zdepw_b(:,:,:), ldxios = lrxios ) ! need to interpol vertical profile (vvl)
+      !
+      ! 
+      ! compute new T/S (interpolation) if vvl only for common wet cell in before and after wmask
+      !PM: Is this IF needed since change to VVL by default
+      !bugged : to be corrected (PM)
+      ! back up original t/s/mask
+      !tsb (:,:,:,:) = ts(:,:,:,:,Kmm)
+      !
+     ! compute new T/S (interpolation) if vvl only for common wet cell in before and after wmask
+
+!      IF (.NOT.ln_linssh) THEN
+!         DO jk = 2,jpk-1
+!            DO jj = 1,jpj
+!               DO ji = 1,jpi
+!                  IF (wmask(ji,jj,jk) * zwmaskb(ji,jj,jk) == 1._wp .AND. (tmask(ji,jj,1)==0._wp .OR. ztmask_b(ji,jj,1)==0._wp) ) THEN
+!
+!                     !compute weight
+!                     zdzp1 = MAX(0._wp,pdepw_b(ji,jj,jk+1) - gdepw(ji,jj,jk+1,Kmm))
+!                     zdzm1 = MAX(0._wp,gdepw(ji,jj,jk  ,Kmm) - pdepw_b(ji,jj,jk  ))
+!                     zdz   = e3t(ji,jj,jk,Kmm) - zdzp1 - zdzm1 ! if isf : e3t = gdepw(ji,jj,jk+1,Kmm)- gdepw(ji,jj,jk,Kmm)
+!
+!                     IF (zdz .LT. 0._wp) THEN
+!                        CALL ctl_stop( 'STOP', 'rst_iscpl : unable to compute the interpolation' )
+!                     END IF
+!
+!                     ts(ji,jj,jk,jp_tem,Kmm) = ( zdzp1*ts(ji,jj,jk+1,jp_tem,Kbb) &
+!                        &                   + zdz  *ts(ji,jj,jk  ,jp_tem,Kbb) &
+!                        &                   + zdzm1*ts(ji,jj,jk-1,jp_tem,Kbb) )/e3t(ji,jj,jk,Kmm)
+!
+!                     ts(ji,jj,jk,jp_sal,Kmm) = ( zdzp1*ts(ji,jj,jk+1,jp_sal,Kbb) &
+!                        &                   + zdz  *ts(ji,jj,jk  ,jp_sal,Kbb) &
+!                        &                   + zdzm1*ts(ji,jj,jk-1,jp_sal,Kbb) )/e3t(ji,jj,jk,Kmm)
+!
+!                  END IF
+!               END DO
+!            END DO
+!         END DO
+!      END IF
+
+      zts0(:,:,:,:)  = ts(:,:,:,:,Kmm)
+      ztmask0(:,:,:) = ztmask_b(:,:,:)
+      ztmask1(:,:,:) = ztmask_b(:,:,:)
+      !
+      ! iterate the extrapolation processes nn_drown times
+      DO jd = 1,nn_drown ! resolution dependent (OK for ISOMIP+ case)
+         DO jk = 1,jpk-1
+            !
+            ! define new wet cell
+            zdmask(:,:) = tmask(:,:,jk) - ztmask0(:,:,jk);
+            !
+            DO_2D_00_00
+               jip1=ji+1; jim1=ji-1;
+               jjp1=jj+1; jjm1=jj-1;
+               !
+               ! check if a wet neigbourg cell is present
+               zsummsk = ztmask0(jip1,jj  ,jk) + ztmask0(jim1,jj  ,jk) &
+                       + ztmask0(ji  ,jjp1,jk) + ztmask0(ji  ,jjm1,jk)
+               !
+               ! if neigbourg wet cell available at the same level
+               IF ( zdmask(ji,jj) == 1._wp  .AND. zsummsk /= 0._wp ) THEN
+                  !
+                  ! horizontal basic extrapolation
+                  ts(ji,jj,jk,1,Kmm)=( zts0(jip1,jj  ,jk,1) * ztmask0(jip1,jj  ,jk) &
+                  &               + zts0(jim1,jj  ,jk,1) * ztmask0(jim1,jj  ,jk) &
+                  &               + zts0(ji  ,jjp1,jk,1) * ztmask0(ji  ,jjp1,jk) &
+                  &               + zts0(ji  ,jjm1,jk,1) * ztmask0(ji  ,jjm1,jk) ) / zsummsk
+                  ts(ji,jj,jk,2,Kmm)=( zts0(jip1,jj  ,jk,2) * ztmask0(jip1,jj  ,jk) &
+                  &               + zts0(jim1,jj  ,jk,2) * ztmask0(jim1,jj  ,jk) &
+                  &               + zts0(ji  ,jjp1,jk,2) * ztmask0(ji  ,jjp1,jk) &
+                  &               + zts0(ji  ,jjm1,jk,2) * ztmask0(ji  ,jjm1,jk) ) / zsummsk
+                  !
+                  ! update mask for next pass
+                  ztmask1(ji,jj,jk)=1
+                  !
+               ! in case no neigbourg wet cell available at the same level
+               ! check if a wet cell is available below
+               ELSEIF (zdmask(ji,jj) == 1._wp .AND. zsummsk == 0._wp) THEN
+                  !
+                  ! vertical extrapolation if horizontal extrapolation failed
+                  jkm1=max(1,jk-1) ; jkp1=min(jpk,jk+1)
+                  !
+                  ! check if a wet neigbourg cell is present
+                  zsummsk = ztmask0(ji,jj,jkm1) + ztmask0(ji,jj,jkp1)
+                  IF (zdmask(ji,jj) == 1._wp .AND. zsummsk /= 0._wp ) THEN
+                     ts(ji,jj,jk,1,Kmm)=( zts0(ji,jj,jkp1,1)*ztmask0(ji,jj,jkp1)     &
+                     &               + zts0(ji,jj,jkm1,1)*ztmask0(ji,jj,jkm1)) / zsummsk
+                     ts(ji,jj,jk,2,Kmm)=( zts0(ji,jj,jkp1,2)*ztmask0(ji,jj,jkp1)     &
+                     &               + zts0(ji,jj,jkm1,2)*ztmask0(ji,jj,jkm1)) / zsummsk
+                     !
+                     ! update mask for next pass
+                     ztmask1(ji,jj,jk)=1._wp
+                  END IF
+               END IF
+            END_2D
+         END DO
+         !
+         ! update temperature and salinity and mask
+         zts0(:,:,:,:)  = ts(:,:,:,:,Kmm)
+         ztmask0(:,:,:) = ztmask1(:,:,:)
+         !
+         CALL lbc_lnk_multi( 'iscplrst', zts0(:,:,:,jp_tem), 'T', 1., zts0(:,:,:,jp_sal), 'T', 1., ztmask0, 'T', 1.)
+         !
+      END DO  ! nn_drown
+      !
+      ! mask new ts(:,:,:,:,Kmm) field
+      ts(:,:,:,jp_tem,Kmm) = zts0(:,:,:,jp_tem) * tmask(:,:,:)
+      ts(:,:,:,jp_sal,Kmm) = zts0(:,:,:,jp_sal) * tmask(:,:,:)
+      !
+      ! sanity check
+      ! -----------------------------------------------------------------------------------------
+      ! case we open a cell but no neigbour cells available to get an estimate of T and S
+      DO_3D_11_11( 1,jpk-1 )
+         IF (tmask(ji,jj,jk) == 1._wp .AND. ts(ji,jj,jk,2,Kmm) == 0._wp)              &
+            &   CALL ctl_stop('STOP', 'failing to fill all new weet cell,     &
+            &                          try increase nn_drown or activate XXXX &
+            &                         in your domain cfg computation'         )
+      END_3D
+      ! 
+   END SUBROUTINE isfcpl_tra
+
+   SUBROUTINE isfcpl_vol(Kmm)
+      !!---------------------------------------------------------------------- 
+      !!                   ***  ROUTINE iscpl_vol  ***
+      !! 
+      !! ** Purpose : compute the correction of the local divergence to apply  
+      !!              during the first time step after the coupling.
+      !!
+      !! ** Method  : - compute horizontal vol div. before/after coupling
+      !!              - compute vertical input
+      !!              - compute correction
+      !!                
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER, INTENT(in) :: Kmm    ! ocean time level index
+      !!----------------------------------------------------------------------
+      INTEGER :: ji, jj, jk 
+      INTEGER :: ikb, ikt
+      !!
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zqvolb, zqvoln  ! vol flux div.         before/after coupling
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3u_b, ze3v_b  ! vertical scale factor before/after coupling
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztmask_b        ! mask                  before       coupling
+      !!----------------------------------------------------------------------
+      !
+      CALL iom_get( numror, jpdom_autoglo, 'tmask'  , ztmask_b, ldxios = lrxios )
+      CALL iom_get( numror, jpdom_autoglo, 'e3u_n'  , ze3u_b  , ldxios = lrxios )
+      CALL iom_get( numror, jpdom_autoglo, 'e3v_n'  , ze3v_b  , ldxios = lrxios )
+      !
+      ! 1.0: compute horizontal volume flux divergence difference before-after coupling
+      !
+      DO jk = 1, jpk                                 ! Horizontal slab
+         ! 1.1: get volume flux before coupling (>0 out)
+         DO_2D_00_00
+            zqvolb(ji,jj,jk) =  (   e2u(ji,jj) * ze3u_b(ji,jj,jk) * uu(ji,jj,jk,Kmm) - e2u(ji-1,jj  ) * ze3u_b(ji-1,jj  ,jk) * uu(ji-1,jj  ,jk,Kmm)    &
+               &                  + e1v(ji,jj) * ze3v_b(ji,jj,jk) * vv(ji,jj,jk,Kmm) - e1v(ji  ,jj-1) * ze3v_b(ji  ,jj-1,jk) * vv(ji  ,jj-1,jk,Kmm)  ) &
+               &                * ztmask_b(ji,jj,jk)
+         END_2D
+         !
+         ! 1.2: get volume flux after coupling (>0 out)
+         ! properly mask velocity 
+         ! (velocity are still mask with old mask at this stage)
+         uu(:,:,jk,Kmm) = uu(:,:,jk,Kmm) * umask(:,:,jk)
+         vv(:,:,jk,Kmm) = vv(:,:,jk,Kmm) * vmask(:,:,jk)
+         ! compute volume flux divergence after coupling
+         DO_2D_00_00
+            zqvoln(ji,jj,jk) = (   e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) - e2u(ji-1,jj  ) * e3u(ji-1,jj  ,jk,Kmm) * uu(ji-1,jj  ,jk,Kmm)    &
+               &                 + e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) - e1v(ji  ,jj-1) * e3v(ji  ,jj-1,jk,Kmm) * vv(ji  ,jj-1,jk,Kmm)  ) &
+               &               * tmask(ji,jj,jk)
+         END_2D
+         !
+         ! 1.3: get 3d volume flux difference (before - after cpl) (>0 out)
+         !      correction to add is _b - _n
+         risfcpl_vol(:,:,jk) = zqvolb(:,:,jk) - zqvoln(:,:,jk)
+      END DO
+      !
+      ! 2.0: include the contribution of the vertical velocity in the volume flux correction
+      !
+      DO_2D_00_00
+         !
+         ikt = mikt(ji,jj)
+         IF ( ikt > 1 .AND. ssmask(ji,jj) == 1 ) THEN
+            risfcpl_vol(ji,jj,ikt) = risfcpl_vol(ji,jj,ikt) + SUM(zqvolb(ji,jj,1:ikt-1))  ! test sign
+         ENDIF
+         !
+      END_2D
+      !
+      CALL lbc_lnk( 'iscpl', risfcpl_vol, 'T', 1. )
+      !
+      ! 3.0: set total correction (div, tr(:,:,:,:,Krhs), ssh)
+      !
+      ! 3.1: mask volume flux divergence correction
+      risfcpl_vol(:,:,:) = risfcpl_vol(:,:,:) * tmask(:,:,:)
+      !
+      ! 3.2: get 3d tr(:,:,:,:,Krhs) increment to apply at the first time step
+      ! temperature and salt content flux computed using local ts(:,:,:,:,Kmm) 
+      ! (very simple advection scheme)
+      ! (>0 out)
+      risfcpl_tsc(:,:,:,jp_tem) = -risfcpl_vol(:,:,:) * ts(:,:,:,jp_tem,Kmm)
+      risfcpl_tsc(:,:,:,jp_sal) = -risfcpl_vol(:,:,:) * ts(:,:,:,jp_sal,Kmm)
+      !
+      ! 3.3: ssh correction (for dynspg_ts)
+      risfcpl_ssh(:,:) = 0.0
+      DO jk = 1,jpk
+         risfcpl_ssh(:,:) = risfcpl_ssh(:,:) + risfcpl_vol(:,:,jk) * r1_e1e2t(:,:)
+      END DO
+
+   END SUBROUTINE isfcpl_vol
+
+   SUBROUTINE isfcpl_cons(Kmm)
+      !!---------------------------------------------------------------------- 
+      !!                   ***  ROUTINE iscpl_cons  ***
+      !! 
+      !! ** Purpose :   compute the corrective increment in volume/salt/heat to put back the vol/heat/salt
+      !!                removed or added during the coupling processes (wet or dry new cell)
+      !! 
+      !! ** Method  :   - compare volume/heat/salt before and after
+      !!                - look for the closest wet cells (share amoung neigbourgs if there are)
+      !!                - build the correction increment to applied at each time step
+      !!                
+      !!----------------------------------------------------------------------
+      !
+      TYPE(isfcons), DIMENSION(:),ALLOCATABLE :: zisfpts ! list of point receiving a correction
+      !
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: Kmm    ! ocean time level index
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji   , jj  , jk  , jproc          ! loop index
+      INTEGER  ::   jip1 , jim1, jjp1, jjm1           ! dummy indices
+      INTEGER  ::   iig  , ijg, ik                    ! dummy indices
+      INTEGER  ::   jisf                              ! start, end and current position in the increment array
+      INTEGER  ::   ingb, ifind                       ! 0/1 target found or need to be found 
+      INTEGER  ::   nisfl_area                        ! global number of cell concerned by the wet->dry case 
+      INTEGER, DIMENSION(jpnij) :: nisfl              ! local  number of cell concerned by the wet->dry case
+      !
+      REAL(wp) ::   z1_sum, z1_rdtiscpl
+      REAL(wp) ::   zdtem, zdsal, zdvol, zratio       ! tem, sal, vol increment
+      REAL(wp) ::   zlon , zlat                       ! target location  
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztmask_b    ! mask before
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t_b      ! scale factor before
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zt_b      ! scale factor before
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zs_b      ! scale factor before
+      !!----------------------------------------------------------------------
+
+      !==============================================================================
+      ! 1.0: initialisation
+      !==============================================================================
+
+      ! get restart variable
+      CALL iom_get( numror, jpdom_autoglo, 'tmask'  , ztmask_b(:,:,:), ldxios = lrxios   ) ! need to extrapolate T/S
+      CALL iom_get( numror, jpdom_autoglo, 'e3t_n'  , ze3t_b(:,:,:)  , ldxios = lrxios )
+      CALL iom_get( numror, jpdom_autoglo, 'tn'     , zt_b(:,:,:)    , ldxios = lrxios )
+      CALL iom_get( numror, jpdom_autoglo, 'sn'     , zs_b(:,:,:)    , ldxios = lrxios )
+
+      ! compute run length
+      nstp_iscpl  = nitend - nit000 + 1
+      rdt_iscpl   = nstp_iscpl * rn_Dt
+      z1_rdtiscpl = 1._wp / rdt_iscpl 
+
+      IF (lwp) WRITE(numout,*) '            nb of stp for cons  = ', nstp_iscpl
+      IF (lwp) WRITE(numout,*) '            coupling time step  = ', rdt_iscpl
+
+      ! initialisation correction
+      risfcpl_cons_vol = 0.0
+      risfcpl_cons_ssh = 0.0
+      risfcpl_cons_tsc = 0.0
+
+      !==============================================================================
+      ! 2.0: diagnose the heat, salt and volume input and compute the correction variable
+      !      for case where we wet a cell or cell still wet (no change in cell status)
+      !==============================================================================
+
+      DO jk = 1,jpk-1
+         DO jj = nldj,nlej
+            DO ji = nldi,nlei
+
+               ! volume diff
+               zdvol = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) - ze3t_b(ji,jj,jk) * ztmask_b(ji,jj,jk)
+
+               ! heat diff
+               zdtem = ts (ji,jj,jk,jp_tem,Kmm) *  e3t(ji,jj,jk,Kmm) *  tmask  (ji,jj,jk)   &
+                     - zt_b(ji,jj,jk)        * ze3t_b(ji,jj,jk) * ztmask_b(ji,jj,jk)
+
+               ! salt diff
+               zdsal = ts(ji,jj,jk,jp_sal,Kmm) *  e3t(ji,jj,jk,Kmm) *  tmask  (ji,jj,jk)   &
+                     - zs_b(ji,jj,jk)       * ze3t_b(ji,jj,jk) * ztmask_b(ji,jj,jk)
+            
+               ! volume, heat and salt differences in each cell (>0 means correction is an outward flux)
+               ! in addition to the geometry change unconservation, need to add the divergence correction as it is flux across the boundary
+               risfcpl_cons_vol(ji,jj,jk)        = (   zdvol * e1e2t(ji,jj) + risfcpl_vol(ji,jj,jk)        ) * z1_rdtiscpl
+               risfcpl_cons_tsc(ji,jj,jk,jp_sal) = ( - zdsal * e1e2t(ji,jj) + risfcpl_tsc(ji,jj,jk,jp_sal) ) * z1_rdtiscpl
+               risfcpl_cons_tsc(ji,jj,jk,jp_tem) = ( - zdtem * e1e2t(ji,jj) + risfcpl_tsc(ji,jj,jk,jp_tem) ) * z1_rdtiscpl
+
+            END DO
+         END DO
+      END DO
+      !
+      !==============================================================================
+      ! 3.0: diagnose the heat, salt and volume input and compute the correction variable
+      !      for case where we close a cell
+      !==============================================================================
+      !
+      ! compute the total number of point receiving a correction increment for each processor
+      ! local
+      nisfl(:)=0
+      DO jk = 1,jpk-1
+         DO jj = nldj,nlej
+            DO ji = nldi,nlei
+               jip1=MIN(ji+1,jpi) ; jim1=MAX(ji-1,1) ; jjp1=MIN(jj+1,jpj) ; jjm1=MAX(jj-1,1) ;
+               IF ( tmask(ji,jj,jk) == 0._wp .AND. ztmask_b(ji,jj,jk) == 1._wp ) nisfl(narea) = nisfl(narea) + MAX(SUM(tmask(jim1:jip1,jjm1:jjp1,jk)),1._wp)
+            ENDDO
+         ENDDO
+      ENDDO
+      !
+      ! global 
+      CALL mpp_sum('isfcpl',nisfl  )
+      !
+      ! allocate list of point receiving correction
+      ALLOCATE(zisfpts(nisfl(narea)))
+      !
+      zisfpts(:) = isfcons(0,0,0,-HUGE(1.0), -HUGE(1.0), -HUGE(1.0), -HUGE(1.0), -HUGE(1.0), 0)
+      !
+      ! start computing the correction and fill zisfpts
+      ! local
+      jisf = 0
+      DO jk = 1,jpk-1
+         DO jj = nldj,nlej
+            DO ji = nldi,nlei
+               IF ( tmask(ji,jj,jk) == 0._wp .AND. ztmask_b(ji,jj,jk) == 1._wp ) THEN
+
+                  jip1=MIN(ji+1,jpi) ; jim1=MAX(ji-1,1) ; jjp1=MIN(jj+1,jpj) ; jjm1=MAX(jj-1,1) ;
+
+                  zdvol = risfcpl_cons_vol(ji,jj,jk       )
+                  zdsal = risfcpl_cons_tsc(ji,jj,jk,jp_sal)
+                  zdtem = risfcpl_cons_tsc(ji,jj,jk,jp_tem)
+
+                  IF ( SUM( tmask(jim1:jip1,jjm1:jjp1,jk) ) > 0._wp ) THEN
+                     ! spread correction amoung neigbourg wet cells (horizontal direction first)
+                     ! as it is a rude correction corner and lateral cell have the same weight
+                     !
+                     z1_sum =  1._wp / SUM( tmask(jim1:jip1,jjm1:jjp1,jk) )
+                     !
+                     ! lateral cells
+                     IF (tmask(jip1,jj  ,jk) == 1) CALL update_isfpts(zisfpts, jisf, jip1, jj  , jk, zdvol, zdsal, zdtem, z1_sum)
+                     IF (tmask(jim1,jj  ,jk) == 1) CALL update_isfpts(zisfpts, jisf, jim1, jj  , jk, zdvol, zdsal, zdtem, z1_sum)
+                     IF (tmask(ji  ,jjp1,jk) == 1) CALL update_isfpts(zisfpts, jisf, ji  , jjp1, jk, zdvol, zdsal, zdtem, z1_sum)
+                     IF (tmask(ji  ,jjm1,jk) == 1) CALL update_isfpts(zisfpts, jisf, ji  , jjm1, jk, zdvol, zdsal, zdtem, z1_sum)
+                     !
+                     ! corner  cells
+                     IF (tmask(jip1,jjm1,jk) == 1) CALL update_isfpts(zisfpts, jisf, jip1, jjm1, jk, zdvol, zdsal, zdtem, z1_sum)
+                     IF (tmask(jim1,jjm1,jk) == 1) CALL update_isfpts(zisfpts, jisf, jim1, jjm1, jk, zdvol, zdsal, zdtem, z1_sum)
+                     IF (tmask(jim1,jjp1,jk) == 1) CALL update_isfpts(zisfpts, jisf, jim1, jjp1, jk, zdvol, zdsal, zdtem, z1_sum)
+                     IF (tmask(jip1,jjp1,jk) == 1) CALL update_isfpts(zisfpts, jisf, jip1, jjp1, jk, zdvol, zdsal, zdtem, z1_sum)
+                     !
+                  ELSE IF ( tmask(ji,jj,jk+1) == 1._wp ) THEN
+                     ! spread correction amoung neigbourg wet cells (vertical direction)
+                     CALL update_isfpts(zisfpts, jisf, ji  , jj  , jk+1, zdvol, zdsal, zdtem, 1., 0)
+                  ELSE
+                     ! need to find where to put correction in later on
+                     CALL update_isfpts(zisfpts, jisf, ji  , jj  , jk  , zdvol, zdsal, zdtem, 1., 1)
+                  END IF
+               END IF
+            END DO
+         END DO
+      END DO
+      !
+      ! share data among all processes because for some point we need to find the closest wet point (could be on other process)
+      DO jproc=1,jpnij
+         ! 
+         ! share total number of isf point treated for proc jproc
+         IF (jproc==narea) THEN
+            nisfl_area=nisfl(jproc)
+         ELSE
+            nisfl_area=0
+         END IF
+         CALL mpp_max('isfcpl',nisfl_area)
+         !
+         DO jisf = 1,nisfl_area
+            !
+            IF (jproc==narea) THEN
+               ! indices (conversion to global indices and sharing)
+               iig = zisfpts(jisf)%ii       ; ijg = zisfpts(jisf)%jj       ; ik = zisfpts(jisf)%kk
+               !
+               ! data
+               zdvol = zisfpts(jisf)%dvol   ; zdsal = zisfpts(jisf)%dsal   ; zdtem = zisfpts(jisf)%dtem
+               !
+               ! location
+               zlat = zisfpts(jisf)%lat     ; zlon = zisfpts(jisf)%lon
+               !
+               ! find flag
+               ingb = zisfpts(jisf)%ngb
+            ELSE
+               iig  =0   ; ijg  =0   ; ik   =0  
+               zdvol=-HUGE(1.0) ; zdsal=-HUGE(1.0) ; zdtem=-HUGE(1.0)
+               zlat =-HUGE(1.0) ; zlon =-HUGE(1.0)   
+               ingb = 0
+            END IF
+            !
+            ! share data (need synchronisation of data as get_correction call a global com)
+            CALL mpp_max('isfcpl',iig)   ; CALL mpp_max('isfcpl',ijg)   ; CALL mpp_max('isfcpl',ik)
+            CALL mpp_max('isfcpl',zdvol) ; CALL mpp_max('isfcpl',zdsal) ; CALL mpp_max('isfcpl',zdtem)
+            CALL mpp_max('isfcpl',zlat)  ; CALL mpp_max('isfcpl',zlon)
+            CALL mpp_max('isfcpl',ingb)
+            !
+            ! fill the 3d correction array
+            CALL get_correction(iig, ijg, ik, zlon, zlat, zdvol, zdsal, zdtem, ingb)
+         END DO
+      END DO
+      !
+      !==============================================================================
+      ! 4.0: finalisation and compute ssh equivalent of the volume correction
+      !==============================================================================
+      !
+      ! mask (>0 out)
+      risfcpl_cons_vol(:,:,:       ) = risfcpl_cons_vol(:,:,:       ) * tmask(:,:,:)
+      risfcpl_cons_tsc(:,:,:,jp_sal) = risfcpl_cons_tsc(:,:,:,jp_sal) * tmask(:,:,:)
+      risfcpl_cons_tsc(:,:,:,jp_tem) = risfcpl_cons_tsc(:,:,:,jp_tem) * tmask(:,:,:)
+      !
+      ! add lbclnk
+      CALL lbc_lnk_multi( 'iscplrst', risfcpl_cons_tsc(:,:,:,jp_tem), 'T', 1., risfcpl_cons_tsc(:,:,:,jp_sal), 'T', 1., &
+         &                            risfcpl_cons_vol(:,:,:)       , 'T', 1.)
+      !
+      ! ssh correction (for dynspg_ts)
+      DO jk = 1,jpk
+         risfcpl_cons_ssh(:,:) = risfcpl_cons_ssh(:,:) + risfcpl_cons_vol(:,:,jk)
+      END DO
+      risfcpl_cons_ssh(:,:) = risfcpl_cons_ssh(:,:) * r1_e1e2t(:,:)
+      !
+   END SUBROUTINE isfcpl_cons
+   !
+   SUBROUTINE update_isfpts(sisfpts, kpts, ki, kj, kk, pdvol, pdsal, pdtem, pratio, kfind)
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE update_isfpts  ***
+      !!
+      !! ** Purpose : if a cell become dry, we need to put the corrective increment elsewhere
+      !!
+      !! ** Action  : update the list of point
+      !!
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      TYPE(isfcons), DIMENSION(:), INTENT(inout) :: sisfpts
+      INTEGER,                     INTENT(inout) :: kpts
+      !!----------------------------------------------------------------------
+      INTEGER,      INTENT(in   )           :: ki, kj, kk                  !    target location (kfind=0) 
+      !                                                                    ! or source location (kfind=1)
+      INTEGER,      INTENT(in   ), OPTIONAL :: kfind                       ! 0  target cell already found
+      !                                                                    ! 1  target to be determined
+      REAL(wp),     INTENT(in   )           :: pdvol, pdsal, pdtem, pratio ! vol/sal/tem increment 
+      !                                                                    ! and ratio in case increment span over multiple cells.
+      !!----------------------------------------------------------------------
+      INTEGER :: ifind
+      !!----------------------------------------------------------------------
+      ! 
+      ! increment position
+      kpts = kpts + 1
+      !
+      ! define if we need to look for closest valid wet cell (no neighbours or neigbourg on halo)
+      IF ( PRESENT(kfind) ) THEN
+         ifind = kfind
+      ELSE
+         ifind = ( 1 - tmask_h(ki,kj) ) * tmask(ki,kj,kk)
+      END IF
+      !
+      ! update isfpts structure
+      sisfpts(kpts) = isfcons(mig(ki), mjg(kj), kk, pratio * pdvol, pratio * pdsal, pratio * pdtem, glamt(ki,kj), gphit(ki,kj), ifind )
+      !
+   END SUBROUTINE update_isfpts
+   !
+   SUBROUTINE get_correction( ki, kj, kk, plon, plat, pvolinc, psalinc, pteminc, kfind)
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE get_correction  ***
+      !!
+      !! ** Action : - Find the closest valid cell if needed (wet and not on the halo)
+      !!             - Scale the correction depending of pratio (case where multiple wet neigbourgs)
+      !!             - Fill the correction array
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER , INTENT(in) :: ki, kj, kk, kfind        ! target point indices
+      REAL(wp), INTENT(in) :: plon, plat               ! target point lon/lat
+      REAL(wp), INTENT(in) :: pvolinc, pteminc,psalinc ! correction increment for vol/temp/salt
+      !!----------------------------------------------------------------------
+      INTEGER :: jj, ji, iig, ijg
+      !!----------------------------------------------------------------------
+      !
+      ! define global indice of correction location
+      iig = ki ; ijg = kj
+      IF ( kfind == 1 ) CALL dom_ngb( plon, plat, iig, ijg,'T', kk)
+      !
+      ! fill the correction array
+      DO jj = mj0(ijg),mj1(ijg)
+         DO ji = mi0(iig),mi1(iig)
+            ! correct the vol_flx and corresponding heat/salt flx in the closest cell
+            risfcpl_cons_vol(ji,jj,kk)        =  risfcpl_cons_vol(ji,jj,kk       ) + pvolinc
+            risfcpl_cons_tsc(ji,jj,kk,jp_sal) =  risfcpl_cons_tsc(ji,jj,kk,jp_sal) + psalinc
+            risfcpl_cons_tsc(ji,jj,kk,jp_tem) =  risfcpl_cons_tsc(ji,jj,kk,jp_tem) + pteminc
+         END DO
+      END DO
+
+   END SUBROUTINE get_correction
+
+END MODULE isfcpl
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfdiags.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfdiags.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfdiags.F90	(revision 12928)
@@ -0,0 +1,115 @@
+MODULE isfdiags
+   !!======================================================================
+   !!                       ***  MODULE  isfdiags  ***
+   !! ice shelf diagnostics module :  manage the 2d and 3d flux outputs from the ice shelf module
+   !!======================================================================
+   !! History :  3.2  !  2011-02  (C.Harris  ) Original code isf cav
+   !!            X.X  !  2006-02  (C. Wang   ) Original code bg03
+   !!            3.4  !  2013-03  (P. Mathiot) Merging + parametrization
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   sbc_isf       : update sbc under ice shelf
+   !!----------------------------------------------------------------------
+
+   USE in_out_manager ! I/O manager
+   USE dom_oce
+   USE isf_oce        ! ice shelf variable
+   USE iom            ! 
+
+   IMPLICIT NONE
+
+   PRIVATE
+
+   PUBLIC   isf_diags_flx
+
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE isf_diags_flx(Kmm, ktop, kbot, phtbl, pfrac, cdisf, pqfwf, pqoce, pqlat, pqhc)
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE isf_diags_flx ***
+      !!
+      !! ** Purpose : manage the 2d and 3d flux outputs of the ice shelf module
+      !!              fwf, latent heat flux, heat content flux, oce->ice heat flux
+      !!
+      !!----------------------------------------------------------------------
+      !!-------------------------- OUT -------------------------------------
+      !!-------------------------- IN  -------------------------------------
+      INTEGER,                      INTENT(in) :: Kmm                       ! ocean time level index
+      INTEGER , DIMENSION(jpi,jpj), INTENT(in) :: ktop , kbot               ! top and bottom level of the tbl
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: phtbl, pfrac              ! thickness of the tbl and fraction of last cell affected by the tbl
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqfwf, pqoce, pqlat, pqhc ! 2d var to map in 3d
+      CHARACTER(LEN=3), INTENT(in) :: cdisf                                 ! parametrisation or interactive melt
+      !!---------------------------------------------------------------------
+      CHARACTER(LEN=256) :: cvarqfwf  , cvarqoce  , cvarqlat  , cvarqhc
+      CHARACTER(LEN=256) :: cvarqfwf3d, cvarqoce3d, cvarqlat3d, cvarqhc3d
+      !!---------------------------------------------------------------------
+      !
+      ! output melt
+      cvarqfwf = 'fwfisf_'//cdisf  ; cvarqfwf3d = 'fwfisf3d_'//cdisf
+      cvarqoce = 'qoceisf_'//cdisf ; cvarqoce3d = 'qoceisf3d_'//cdisf
+      cvarqlat = 'qlatisf_'//cdisf ; cvarqlat3d = 'qlatisf3d_'//cdisf 
+      cvarqhc  = 'qhcisf_'//cdisf  ; cvarqhc3d  = 'qhcisf3d_'//cdisf
+      !
+      ! output 2d melt rate, latent heat and heat content flux from the injected water
+      CALL iom_put( TRIM(cvarqfwf), pqfwf(:,:) )   ! mass         flux ( >0 out )
+      CALL iom_put( TRIM(cvarqoce), pqoce(:,:) )   ! oce to ice   flux ( >0 out )
+      CALL iom_put( TRIM(cvarqlat), pqlat(:,:) )   ! latent heat  flux ( >0 out )
+      CALL iom_put( TRIM(cvarqhc) , pqhc (:,:) )   ! heat content flux ( >0 out )
+      !
+      ! output 3d Diagnostics
+      IF ( iom_use( TRIM(cvarqfwf3d) ) ) CALL isf_diags_2dto3d( Kmm, ktop, kbot, phtbl, pfrac, TRIM(cvarqfwf3d) , pqfwf(:,:))
+      IF ( iom_use( TRIM(cvarqoce3d) ) ) CALL isf_diags_2dto3d( Kmm, ktop, kbot, phtbl, pfrac, TRIM(cvarqoce3d) , pqoce(:,:))
+      IF ( iom_use( TRIM(cvarqlat3d) ) ) CALL isf_diags_2dto3d( Kmm, ktop, kbot, phtbl, pfrac, TRIM(cvarqlat3d) , pqoce(:,:))
+      IF ( iom_use( TRIM(cvarqhc3d)  ) ) CALL isf_diags_2dto3d( Kmm, ktop, kbot, phtbl, pfrac, TRIM(cvarqhc3d)  , pqhc (:,:))
+      !
+   END SUBROUTINE
+
+   SUBROUTINE isf_diags_2dto3d(Kmm, ktop, kbot, phtbl, pfrac, cdvar, pvar2d)
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE isf_diags_2dto3d ***
+      !!
+      !! ** Purpose : compute the 3d flux outputs as they are injected into NEMO 
+      !!              (ie uniformaly spread into the top boundary layer or parametrisation layer)
+      !!
+      !!----------------------------------------------------------------------
+      !!-------------------------- OUT -------------------------------------
+      !!-------------------------- IN  -------------------------------------
+      INTEGER,                      INTENT(in) :: Kmm           ! ocean time level index
+      INTEGER , DIMENSION(jpi,jpj), INTENT(in) :: ktop , kbot   ! top and bottom level of the tbl
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: phtbl, pfrac  ! thickness of the tbl and fraction of last cell affected by the tbl
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pvar2d        ! 2d var to map in 3d
+      CHARACTER(LEN=*), INTENT(in) :: cdvar
+      !!---------------------------------------------------------------------
+      INTEGER  :: ji, jj, jk                       ! loop indices
+      INTEGER  :: ikt, ikb                         ! top and bottom level of the tbl
+      REAL(wp), DIMENSION(jpi,jpj)     :: zvar2d   !
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvar3d   ! 3d var to output
+      !!---------------------------------------------------------------------
+      !
+      ! compute 3d output
+      zvar2d(:,:) = pvar2d(:,:) / phtbl(:,:)
+      zvar3d(:,:,:) = 0._wp
+      !
+      DO_2D_11_11
+         ikt = ktop(ji,jj)
+         ikb = kbot(ji,jj)
+         DO jk = ikt, ikb - 1
+            zvar3d(ji,jj,jk) = zvar2d(ji,jj) * e3t(ji,jj,jk,Kmm)
+         END DO
+         zvar3d(ji,jj,ikb) = zvar2d(ji,jj) * e3t(ji,jj,ikb,Kmm) * pfrac(ji,jj)
+      END_2D
+      !
+      CALL iom_put( TRIM(cdvar) , zvar3d(:,:,:))
+      !
+   END SUBROUTINE isf_diags_2dto3d
+
+END MODULE isfdiags
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfdynatf.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfdynatf.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfdynatf.F90	(revision 12928)
@@ -0,0 +1,88 @@
+MODULE isfdynatf
+   !!=========================================================================
+   !!                       ***  MODULE  isfnxt  ***
+   !! Ice shelf update: compute the dynatf ice shelf contribution
+   !!=========================================================================
+   !! History :  OPA  !  2019-09  (P. Mathiot)  Original code
+   !!-------------------------------------------------------------------------
+  
+   !!-------------------------------------------------------------------------
+   !!   isfnxt       : apply correction needed for the ice shelf to ensure conservation
+   !!-------------------------------------------------------------------------
+
+   USE isf_oce
+
+   USE phycst , ONLY: r1_rho0         ! physical constant
+   USE dom_oce, ONLY: tmask, ssmask, ht, e3t, r1_e1e2t   ! time and space domain
+
+   USE in_out_manager
+
+   IMPLICIT NONE
+
+   PRIVATE
+
+   PUBLIC isf_dynatf
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+
+CONTAINS
+
+   SUBROUTINE isf_dynatf ( kt, Kmm, pe3t_f, pcoef )
+      !!--------------------------------------------------------------------
+      !!                  ***  ROUTINE isf_dynatf  ***
+      !!
+      !! ** Purpose : compute the ice shelf volume filter correction for cavity, param, ice sheet coupling case
+      !!
+      !!-------------------------- OUT -------------------------------------
+      INTEGER                         , INTENT(in   ) :: kt       ! ocean time step
+      INTEGER                         , INTENT(in   ) :: Kmm      ! ocean time level index
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pe3t_f   ! time filtered scale factor to be corrected
+      !
+      REAL(wp)                        , INTENT(in   ) :: pcoef    ! rn_atfp * rn_Dt * r1_rho0
+      !!--------------------------------------------------------------------
+      INTEGER :: jk  ! loop index
+      !!--------------------------------------------------------------------
+      !
+      ! ice shelf cavity
+      IF ( ln_isfcav_mlt ) CALL isf_dynatf_mlt(Kmm, pe3t_f, misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav, fwfisf_cav, fwfisf_cav_b, pcoef)
+      !
+      ! ice shelf parametrised
+      IF ( ln_isfpar_mlt ) CALL isf_dynatf_mlt(Kmm, pe3t_f, misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par, fwfisf_par, fwfisf_par_b, pcoef)
+      !
+      IF ( ln_isfcpl .AND. ln_rstart .AND. kt == nit000+1 ) THEN
+         DO jk = 1, jpkm1
+            pe3t_f(:,:,jk) =   pe3t_f(:,:,jk) - pcoef * risfcpl_vol(:,:,jk) * r1_e1e2t(:,:)
+         END DO
+      END IF
+      !
+   END SUBROUTINE isf_dynatf
+
+   SUBROUTINE isf_dynatf_mlt ( Kmm, pe3t_f, ktop, kbot, phtbl, pfrac, pfwf, pfwf_b, pcoef )
+      !!--------------------------------------------------------------------
+      !!                  ***  ROUTINE isf_dynatf_mlt  ***
+      !!
+      !! ** Purpose : compute the ice shelf volume filter correction for cavity or param
+      !!
+      !!-------------------------- IN  -------------------------------------
+      INTEGER                         , INTENT(in   ) :: Kmm             ! ocean time level index
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pe3t_f          ! time-filtered scale factor to be corrected
+      INTEGER , DIMENSION(jpi,jpj)    , INTENT(in   ) :: ktop , kbot     ! top and bottom level of tbl
+      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in   ) :: pfrac, phtbl    ! fraction of bottom cell included in tbl, tbl thickness
+      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in   ) :: pfwf , pfwf_b   ! now/before fwf
+      REAL(wp),                         INTENT(in   ) :: pcoef           ! rn_atfp * rn_Dt * r1_rho0
+      !!----------------------------------------------------------------------
+      INTEGER :: ji,jj,jk
+      REAL(wp), DIMENSION(jpi,jpj) :: zfwfinc
+      !!----------------------------------------------------------------------
+      !
+      ! compute fwf conservation correction
+      zfwfinc(:,:) = pcoef * ( pfwf_b(:,:) - pfwf(:,:) ) / ( ht(:,:) + 1._wp - ssmask(:,:) ) * r1_rho0
+      !
+      ! add the increment
+      DO jk = 1, jpkm1
+         pe3t_f(:,:,jk) = pe3t_f(:,:,jk) - tmask(:,:,jk) * zfwfinc(:,:) * e3t(:,:,jk,Kmm)
+      END DO
+      !
+   END SUBROUTINE isf_dynatf_mlt
+
+END MODULE isfdynatf
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfhdiv.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfhdiv.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfhdiv.F90	(revision 12928)
@@ -0,0 +1,141 @@
+MODULE isfhdiv
+   !!======================================================================
+   !!                       ***  MODULE  isfhdiv  ***
+   !! ice shelf horizontal divergence module :  update the horizontal divergence
+   !!                   with the ice shelf melt and coupling correction
+   !!======================================================================
+   !! History :  4.0  !  2019-09  (P. Mathiot) Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   isf_hdiv    : update the horizontal divergence with the ice shelf 
+   !!                 melt and coupling correction
+   !!----------------------------------------------------------------------
+
+   USE isf_oce                ! ice shelf
+
+   USE dom_oce                ! time and space domain
+   USE phycst , ONLY: r1_rho0 ! physical constant
+   USE in_out_manager         !
+
+   IMPLICIT NONE
+
+   PRIVATE
+
+   PUBLIC isf_hdiv
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+
+CONTAINS
+
+   SUBROUTINE isf_hdiv( kt, Kmm, phdiv )
+      !!----------------------------------------------------------------------
+      !!                  ***  SUBROUTINE isf_hdiv  ***
+      !!       
+      !! ** Purpose :   update the horizontal divergence with the ice shelf contribution
+      !!                (parametrisation, explicit, ice sheet coupling conservation
+      !!                 increment)
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT( inout ) ::   phdiv   ! horizontal divergence
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: kt
+      INTEGER, INTENT(in) :: Kmm      !  ocean time level index
+      !
+      IF ( ln_isf ) THEN
+         !
+         ! ice shelf cavity contribution
+         IF ( ln_isfcav_mlt ) CALL isf_hdiv_mlt(misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav, fwfisf_cav, fwfisf_cav_b, phdiv)
+         !
+         ! ice shelf parametrisation contribution
+         IF ( ln_isfpar_mlt ) CALL isf_hdiv_mlt(misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par, fwfisf_par, fwfisf_par_b, phdiv)
+         !
+         ! ice sheet coupling contribution 
+         IF ( ln_isfcpl .AND. kt /= 0 ) THEN
+            !
+            ! Dynamical stability at start up after change in under ice shelf cavity geometry is achieve by correcting the divergence.
+            ! This is achieved by applying a volume flux in order to keep the horizontal divergence after remapping 
+            ! the same as at the end of the latest time step. So correction need to be apply at nit000 (euler time step) and
+            ! half of it at nit000+1 (leap frog time step).
+            IF ( kt == nit000   ) CALL isf_hdiv_cpl(Kmm, risfcpl_vol       , phdiv)
+            IF ( kt == nit000+1 ) CALL isf_hdiv_cpl(Kmm, risfcpl_vol*0.5_wp, phdiv)
+            !
+            ! correct divergence every time step to remove any trend due to coupling
+            ! conservation option
+            IF ( ln_isfcpl_cons ) CALL isf_hdiv_cpl(Kmm, risfcpl_cons_vol, phdiv)
+            !
+         END IF
+         !
+      END IF
+      !
+   END SUBROUTINE isf_hdiv
+
+   SUBROUTINE isf_hdiv_mlt(ktop, kbot, phtbl, pfrac, pfwf, pfwf_b, phdiv)
+      !!----------------------------------------------------------------------
+      !!                  ***  SUBROUTINE sbc_isf_div  ***
+      !!       
+      !! ** Purpose :   update the horizontal divergence with the ice shelf inflow
+      !!
+      !! ** Method  :   pfwf is positive (outflow) and expressed as kg/m2/s
+      !!                increase the divergence
+      !!
+      !! ** Action  :   phdivn   increased by the ice shelf outflow
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phdiv
+      !!----------------------------------------------------------------------
+      INTEGER , DIMENSION(jpi,jpj), INTENT(in   ) :: ktop , kbot
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pfrac, phtbl
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pfwf , pfwf_b
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   ikt, ikb 
+      REAL(wp), DIMENSION(jpi,jpj) :: zhdiv
+      !!----------------------------------------------------------------------
+      !
+      !==   fwf distributed over several levels   ==!
+      !
+      ! compute integrated divergence correction
+      zhdiv(:,:) = 0.5_wp * ( pfwf(:,:) + pfwf_b(:,:) ) * r1_rho0 / phtbl(:,:)
+      !
+      ! update divergence at each level affected by ice shelf top boundary layer
+      DO_2D_11_11
+         ikt = ktop(ji,jj)
+         ikb = kbot(ji,jj)
+         ! level fully include in the ice shelf boundary layer
+         DO jk = ikt, ikb - 1
+            phdiv(ji,jj,jk) = phdiv(ji,jj,jk) + zhdiv(ji,jj)
+         END DO
+         ! level partially include in ice shelf boundary layer 
+         phdiv(ji,jj,ikb) = phdiv(ji,jj,ikb) + zhdiv(ji,jj) * pfrac(ji,jj)
+      END_2D
+      !
+   END SUBROUTINE isf_hdiv_mlt
+
+   SUBROUTINE isf_hdiv_cpl(Kmm, pqvol, phdiv)
+      !!----------------------------------------------------------------------
+      !!                  ***  SUBROUTINE isf_hdiv_cpl  ***
+      !!       
+      !! ** Purpose :   update the horizontal divergence with the ice shelf 
+      !!                coupling conservation increment
+      !!
+      !! ** Method  :   pqvol is positive (outflow) and expressed as m3/s
+      !!                increase the divergence
+      !!
+      !! ** Action  :   phdivn   increased by the ice shelf outflow
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phdiv
+      !!----------------------------------------------------------------------
+      INTEGER,                          INTENT(in)    :: Kmm     ! ocean time level index
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pqvol
+      !!----------------------------------------------------------------------
+      INTEGER :: jk
+      !!----------------------------------------------------------------------
+      !
+      DO jk=1,jpk 
+         phdiv(:,:,jk) =  phdiv(:,:,jk) + pqvol(:,:,jk) * r1_e1e2t(:,:) / e3t(:,:,jk,Kmm)
+      END DO
+      !
+   END SUBROUTINE isf_hdiv_cpl
+
+END MODULE isfhdiv
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfload.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfload.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfload.F90	(revision 12928)
@@ -0,0 +1,117 @@
+MODULE isfload
+   !!======================================================================
+   !!                       ***  MODULE  isfload  ***
+   !! isfload module :  compute ice shelf load (needed for the hpg)
+   !!======================================================================
+   !! History :  4.1  !  2019-09  (P. Mathiot) original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   isfload      : compute ice shelf load
+   !!----------------------------------------------------------------------
+
+   USE isf_oce, ONLY: cn_isfload, rn_isfload_T, rn_isfload_S ! ice shelf variables
+
+   USE dom_oce, ONLY: e3w, gdept, risfdep, mikt     ! vertical scale factor
+   USE eosbn2 , ONLY: eos                           ! eos routine
+
+   USE lib_mpp, ONLY: ctl_stop                               ! ctl_stop routine
+   USE in_out_manager                                        ! 
+
+   IMPLICIT NONE
+
+   PRIVATE
+
+   PUBLIC isf_load
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+
+CONTAINS
+
+   SUBROUTINE isf_load ( Kmm, pisfload )
+      !!--------------------------------------------------------------------
+      !!                  ***  SUBROUTINE isf_load  ***
+      !!
+      !! ** Purpose : compute the ice shelf load
+      !!
+      !!--------------------------------------------------------------------
+      !!-------------------------- OUT -------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: pisfload
+      !!-------------------------- IN  -------------------------------------
+      INTEGER,                      INTENT(in)    :: Kmm           ! ocean time level index
+      !!----------------------------------------------------------------------
+      !
+      ! quality test: ice shelf in a stratify/uniform ocean should not drive any flow.
+      !               the smaller the residual flow is, the better it is.
+      !
+      ! ice shelf cavity
+      SELECT CASE ( cn_isfload )
+      CASE ( 'uniform' )
+         CALL isf_load_uniform ( Kmm, pisfload )
+      CASE DEFAULT
+         CALL ctl_stop('STOP','method cn_isfload to compute ice shelf load does not exist (isomip), check your namelist')
+      END SELECT
+      !
+   END SUBROUTINE isf_load
+
+   SUBROUTINE isf_load_uniform( Kmm, pisfload )
+      !!--------------------------------------------------------------------
+      !!                  ***  SUBROUTINE isf_load  ***
+      !!
+      !! ** Purpose : compute the ice shelf load
+      !!
+      !! ** Method  : The ice shelf is assumed to be in hydro static equilibrium
+      !!              in water at -1.9 C and 34.4 PSU. Weight of the ice shelf is
+      !!              integrated from top to bottom.
+      !!
+      !!--------------------------------------------------------------------
+      !!-------------------------- OUT -------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: pisfload
+      !!-------------------------- IN  -------------------------------------
+      INTEGER,                      INTENT(in)    :: Kmm           ! ocean time level index
+      !!--------------------------------------------------------------------
+      INTEGER  :: ji, jj, jk
+      INTEGER  :: ikt
+      REAL(wp)                          :: znad        ! 
+      REAL(wp), DIMENSION(jpi,jpj)      :: zrhdtop_isf ! water density    displaced by the ice shelf (at the interface)
+      REAL(wp), DIMENSION(jpi,jpj,jpts) :: zts_top     ! water properties displaced by the ice shelf   
+      REAL(wp), DIMENSION(jpi,jpj,jpk)  :: zrhd        ! water density    displaced by the ice shelf
+      !!----------------------------------------------------------------------
+      !
+      znad = 1._wp                     !- To use density and not density anomaly
+      !
+      !                                !- assume water displaced by the ice shelf is at T=rn_isfload_T and S=rn_isfload_S (rude)
+      zts_top(:,:,jp_tem) = rn_isfload_T   ;   zts_top(:,:,jp_sal) = rn_isfload_S
+      !
+      DO jk = 1, jpk                   !- compute density of the water displaced by the ice shelf 
+         CALL eos( zts_top(:,:,:), gdept(:,:,jk,Kmm), zrhd(:,:,jk) )
+      END DO
+      !
+      !                                !- compute rhd at the ice/oce interface (ice shelf side)
+      CALL eos( zts_top , risfdep, zrhdtop_isf )
+      !
+      !                                !- Surface value + ice shelf gradient
+      pisfload(:,:) = 0._wp                       ! compute pressure due to ice shelf load 
+      DO_2D_11_11
+         ikt = mikt(ji,jj)
+         !
+         IF ( ikt > 1 ) THEN
+            !
+            ! top layer of the ice shelf
+            pisfload(ji,jj) = pisfload(ji,jj) + (znad + zrhd(ji,jj,1) ) * e3w(ji,jj,1,Kmm)
+            !
+            ! core layers of the ice shelf
+            DO jk = 2, ikt-1
+               pisfload(ji,jj) = pisfload(ji,jj) + (2._wp * znad + zrhd(ji,jj,jk-1) + zrhd(ji,jj,jk)) * e3w(ji,jj,jk,Kmm)
+            END DO
+            !
+            ! deepest part of the ice shelf (between deepest T point and ice/ocean interface
+            pisfload(ji,jj) = pisfload(ji,jj) + (2._wp * znad + zrhdtop_isf(ji,jj) + zrhd(ji,jj,ikt-1)) &
+               &                                              * ( risfdep(ji,jj) - gdept(ji,jj,ikt-1,Kmm) )
+            !
+         END IF
+      END_2D
+      !
+   END SUBROUTINE isf_load_uniform
+
+END MODULE isfload
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfpar.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfpar.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfpar.F90	(revision 12928)
@@ -0,0 +1,186 @@
+MODULE isfpar
+   !!======================================================================
+   !!                       ***  MODULE  isfpar  ***
+   !! ice shelf module :  update ocean boundary condition under ice
+   !!                   shelf
+   !!======================================================================
+   !! History :  3.2  !  2011-02  (C.Harris  ) Original code isf cav
+   !!            X.X  !  2006-02  (C. Wang   ) Original code bg03
+   !!            3.4  !  2013-03  (P. Mathiot) Merging + parametrization
+   !!            4.1  !  2019-09  (P. Mathiot) Restructuration
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   isfpar       : compute ice shelf melt using a prametrisation of ice shelf cavities
+   !!----------------------------------------------------------------------
+   USE isf_oce        ! ice shelf
+   !
+   USE isfrst   , ONLY: isfrst_write, isfrst_read ! ice shelf restart read/write subroutine
+   USE isftbl   , ONLY: isf_tbl_ktop, isf_tbl_lvl ! ice shelf top boundary layer properties subroutine
+   USE isfparmlt, ONLY: isfpar_mlt                ! ice shelf melt formulation subroutine
+   USE isfdiags , ONLY: isf_diags_flx             ! ice shelf diags subroutine
+   USE isfutils , ONLY: debug, read_2dcstdta      ! ice shelf debug subroutine
+   !
+   USE dom_oce  , ONLY: bathy          ! ocean space and time domain
+   USE par_oce  , ONLY: jpi,jpj        ! ocean space and time domain
+   USE phycst   , ONLY: r1_rho0_rcp    ! physical constants
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O library
+   USE fldread        ! read input field at current time step
+   USE lbclnk         ! lbc_lnk
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   isf_par, isf_par_init
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+ 
+   SUBROUTINE isf_par( kt, Kmm, ptsc, pqfwf )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE isf_par ***      
+      !!
+      !! ** Purpose : compute the heat and fresh water due to ice shelf melting/freezing using a parametrisation 
+      !!
+      !! ** Comment : in isf_par and all its call tree, 
+      !!              'tbl' means parametrisation layer (ie how the far field temperature/salinity is computed) 
+      !!              instead of in a proper top boundary layer as at the ice shelf ocean interface
+      !!              as the action to compute the properties of the tbl or the parametrisation layer are the same,
+      !!              (ie average T/S over a specific depth (can be across multiple levels))
+      !!              the name tbl was kept.
+      !!
+      !!---------------------------------------------------------------------
+      !!-------------------------- OUT --------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(inout) :: pqfwf
+      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(inout) :: ptsc
+      !!-------------------------- IN  --------------------------------------
+      INTEGER, INTENT(in) ::   kt                                     ! ocean time step
+      INTEGER, INTENT(in) ::   Kmm                                    ! ocean time level index
+      !!---------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj) :: zqoce, zqhc, zqlat, zqh
+      !!---------------------------------------------------------------------
+      !
+      ! compute heat content, latent heat and melt fluxes (2d)
+      CALL isfpar_mlt( kt, Kmm, zqhc, zqoce, pqfwf  )
+      !
+      ! compute heat and water flux ( > 0 out )
+      pqfwf(:,:) = pqfwf(:,:) * mskisf_par(:,:)
+      zqoce(:,:) = zqoce(:,:) * mskisf_par(:,:)
+      zqhc (:,:) = zqhc(:,:)  * mskisf_par(:,:)
+      !
+      ! compute heat content flux ( > 0 out )
+      zqlat(:,:) = pqfwf(:,:) * rLfusisf    ! 2d latent heat flux (W/m2)
+      !
+      ! total heat flux ( > 0 out )
+      zqh(:,:) = ( zqhc (:,:) + zqoce(:,:) )
+      !
+      ! lbclnk on melt and heat fluxes
+      CALL lbc_lnk_multi( 'isfmlt', zqh, 'T', 1., pqfwf, 'T', 1.)
+      !
+      ! output fluxes
+      CALL isf_diags_flx( Kmm, misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par, 'par', pqfwf, zqoce, zqlat, zqhc)
+      !
+      ! set temperature content
+      ptsc(:,:,jp_tem) = zqh(:,:) * r1_rho0_rcp
+      !
+      ! write restart variables (qoceisf, qhcisf, fwfisf for now and before)
+      IF (lrst_oce) CALL isfrst_write(kt, 'par', ptsc, pqfwf)
+      !
+      IF ( ln_isfdebug ) THEN
+         CALL debug('isf_par: ptsc T',ptsc(:,:,1))
+         CALL debug('isf_par: ptsc S',ptsc(:,:,2))
+         CALL debug('isf_par: pqfwf fwf',pqfwf(:,:))
+      END IF
+      !
+   END SUBROUTINE isf_par
+
+   SUBROUTINE isf_par_init
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE isf_par_init  ***
+      !!
+      !! ** Purpose : initialisation of the variable needed for the parametrisation of ice shelf melt
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER               :: ierr
+      REAL(wp), DIMENSION(jpi,jpj) :: ztblmax, ztblmin
+      !!----------------------------------------------------------------------
+      !
+      ! allocation
+      CALL isf_alloc_par()
+      !
+      ! initialisation
+      misfkt_par(:,:)     = 1         ; misfkb_par(:,:)       = 1         
+      rhisf_tbl_par(:,:)  = 1e-20     ; rfrac_tbl_par(:,:)    = 0.0_wp
+      !
+      ! define isf tbl tickness, top and bottom indice
+      CALL read_2dcstdta(TRIM(sn_isfpar_zmax%clname), TRIM(sn_isfpar_zmax%clvar), ztblmax)
+      CALL read_2dcstdta(TRIM(sn_isfpar_zmin%clname), TRIM(sn_isfpar_zmin%clvar), ztblmin)
+      !
+      ! mask ice shelf parametrisation location
+      ztblmax(:,:) = ztblmax(:,:) * ssmask(:,:)
+      ztblmin(:,:) = ztblmin(:,:) * ssmask(:,:)
+      !
+      ! if param used under an ice shelf overwrite ztblmin by the ice shelf draft
+      WHERE ( risfdep > 0._wp .AND. ztblmin > 0._wp )
+         ztblmin(:,:) = risfdep(:,:)
+      END WHERE
+      !
+      ! ensure ztblmax <= bathy
+      WHERE ( ztblmax(:,:) > bathy(:,:) )
+         ztblmax(:,:) = bathy(:,:)
+      END WHERE
+      !
+      ! compute ktop and update ztblmin to gdepw_0(misfkt_par) 
+      CALL isf_tbl_ktop(ztblmin, misfkt_par) !   out: misfkt_par
+      !                                      ! inout: ztblmin
+      !
+      ! initial tbl thickness
+      rhisf0_tbl_par(:,:) = ztblmax(:,:) - ztblmin(:,:)
+      !
+      ! define iceshelf parametrisation mask
+      mskisf_par = 0
+      WHERE ( rhisf0_tbl_par(:,:) > 0._wp )
+         mskisf_par(:,:) = 1._wp
+      END WHERE
+      !
+      ! read par variable from restart
+      IF ( ln_rstart ) CALL isfrst_read('par', risf_par_tsc, fwfisf_par, risf_par_tsc_b, fwfisf_par_b)
+      !
+      SELECT CASE ( TRIM(cn_isfpar_mlt) )
+         !
+      CASE ( 'spe' )
+         !
+         ALLOCATE( sf_isfpar_fwf(1), STAT=ierr )
+         ALLOCATE( sf_isfpar_fwf(1)%fnow(jpi,jpj,1), sf_isfpar_fwf(1)%fdta(jpi,jpj,1,2) )
+         CALL fld_fill( sf_isfpar_fwf, (/ sn_isfpar_fwf /), cn_isfdir, 'isf_par_init', 'read fresh water flux isf data', 'namisf' )
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '      ==>>>   ice melt read from forcing field (cn_isfmlt_par = spe)'
+         !
+      CASE ( 'bg03' )
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '      ==>>>   bg03 parametrisation (cn_isfmlt_par = bg03)'
+         !
+         ! read effective length
+         CALL read_2dcstdta(TRIM(sn_isfpar_Leff%clname), TRIM(sn_isfpar_Leff%clvar), risfLeff)
+         risfLeff = risfLeff*1000.0_wp           !: convertion in m
+         !
+      CASE ( 'oasis' )
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '      ==>>>    isf melt provided by OASIS (cn_isfmlt_par = oasis)'
+         !
+      CASE DEFAULT
+         CALL ctl_stop( 'sbc_isf_init: wrong value of nn_isf' )
+      END SELECT
+      !
+   END SUBROUTINE isf_par_init
+
+END MODULE isfpar
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfparmlt.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfparmlt.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfparmlt.F90	(revision 12928)
@@ -0,0 +1,224 @@
+MODULE isfparmlt
+   !!======================================================================
+   !!                       ***  MODULE  isfparmlt  ***
+   !! Ice shelf parametrisation module :  update surface ocean boundary condition under ice
+   !!                   shelf using an ice shelf melt parametrisation
+   !!======================================================================
+   !! History :  4.0  ! original code
+   !!----------------------------------------------------------------------
+
+   USE isf_oce                  ! ice shelf
+   USE isftbl , ONLY: isf_tbl   ! ice shelf depth average
+
+   USE dom_oce                  ! ocean space and time domain
+   USE oce    , ONLY: ts        ! ocean dynamics and tracers
+   USE phycst , ONLY: rcp, rho0 ! physical constants
+   USE eosbn2 , ONLY: eos_fzp   ! equation of state
+
+   USE in_out_manager              ! I/O manager
+   USE iom        , ONLY: iom_put  ! I/O library
+   USE fldread    , ONLY: fld_read, FLD, FLD_N !
+   USE lib_fortran, ONLY: glob_sum !
+   USE lib_mpp    , ONLY: ctl_stop !
+
+   IMPLICIT NONE
+
+   PRIVATE
+
+   PUBLIC  isfpar_mlt 
+   
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+! -------------------------------------------------------------------------------------------------------
+! -------------------------------- PUBLIC SUBROUTINE ----------------------------------------------------
+! -------------------------------------------------------------------------------------------------------
+
+  SUBROUTINE isfpar_mlt( kt, Kmm, pqhc, pqoce, pqfwf )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE isfpar_mlt  ***
+      !!
+      !! ** Purpose : Compute Salt and Heat fluxes related to ice_shelf 
+      !!              melting and freezing 
+      !!
+      !! ** Method  :  2 parameterizations are available according
+      !!                        1 : Specified melt flux
+      !!                        2 : Beckmann & Goose parameterization
+      !!
+      !!-------------------------- OUT -------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pqfwf, pqoce, pqhc  ! fresh water, ice-ocean heat and heat content fluxes
+      !!-------------------------- IN  -------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+      INTEGER, INTENT(in) ::   Kmm  ! ocean time level index
+      !!---------------------------------------------------------------------
+      !
+      ! Choose among the available ice shelf parametrisation
+      SELECT CASE ( cn_isfpar_mlt )
+      CASE ( 'spe' )    ! specified runoff in depth (Mathiot et al., 2017 in preparation)
+         CALL isfpar_mlt_spe(kt, Kmm, pqhc, pqoce, pqfwf)
+      CASE ( 'bg03' )    ! Beckmann and Goosse parametrisation 
+         CALL isfpar_mlt_bg03(kt, Kmm, pqhc, pqoce, pqfwf)
+      CASE ( 'oasis' )
+         CALL isfpar_mlt_oasis( kt, Kmm, pqhc, pqoce, pqfwf)
+      CASE DEFAULT
+         CALL ctl_stop('STOP', 'unknown isf melt formulation : cn_isfpar (should not see this)')
+      END SELECT
+      !
+   END SUBROUTINE isfpar_mlt
+
+! -------------------------------------------------------------------------------------------------------
+! -------------------------------- PRIVATE SUBROUTINE ---------------------------------------------------
+! -------------------------------------------------------------------------------------------------------
+
+   SUBROUTINE isfpar_mlt_spe(kt, Kmm, pqhc, pqoce, pqfwf)
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE isfpar_mlt_spe  ***
+      !!
+      !! ** Purpose : prescribed ice shelf melting in case ice shelf cavities are closed.
+      !!              data read into a forcing files.
+      !!
+      !!-------------------------- OUT -------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pqhc, pqfwf, pqoce  ! fresh water and ice-ocean heat fluxes
+      !!-------------------------- IN  -------------------------------------
+      INTEGER,  INTENT(in) :: kt
+      INTEGER,  INTENT(in) :: Kmm    !  ocean time level index
+      !!--------------------------------------------------------------------
+      INTEGER :: jk
+      REAL(wp), DIMENSION(jpi,jpj,jpk)  :: ztfrz3d
+      REAL(wp), DIMENSION(jpi,jpj)      :: ztfrz
+      !!--------------------------------------------------------------------
+      !
+      ! 0. ------------Read specified runoff
+      CALL fld_read ( kt, 1, sf_isfpar_fwf   )
+      !
+      ! compute ptfrz
+      ! 1. ------------Mean freezing point
+      DO jk = 1,jpk
+         CALL eos_fzp(ts(:,:,jk,jp_sal,Kmm), ztfrz3d(:,:,jk), gdept(:,:,jk,Kmm))
+      END DO
+      CALL isf_tbl(Kmm, ztfrz3d, ztfrz, 'T', misfkt_par, rhisf_tbl_par, misfkb_par, rfrac_tbl_par )
+      !
+      pqfwf(:,:) = - sf_isfpar_fwf(1)%fnow(:,:,1)      ! fresh water flux from the isf (fwfisf <0 mean melting) 
+      pqoce(:,:) =   pqfwf(:,:) * rLfusisf             ! ocean/ice shelf flux assume to be equal to latent heat flux
+      pqhc (:,:) =   pqfwf(:,:) * ztfrz(:,:) * rcp     ! heat content flux 
+      !
+      CALL iom_put('isftfrz_par', ztfrz )
+      !
+   END SUBROUTINE isfpar_mlt_spe
+
+   SUBROUTINE isfpar_mlt_bg03(kt, Kmm, pqhc, pqoce, pqfwf)
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE isfpar_mlt_bg03  ***
+      !!
+      !! ** Purpose : compute an estimate of ice shelf melting and 
+      !!              latent, ocean-ice and heat content heat fluxes
+      !!              in case cavities are closed based on the far fields T and S properties. 
+      !!
+      !! ** Method  : The ice shelf melt is computed as proportional to the differences between the 
+      !!              mean temperature and mean freezing point in front of the ice shelf averaged 
+      !!              over the ice shelf min ice shelf draft and max ice shelf draft and the freezing point
+      !!
+      !! ** Reference : Beckmann and Goosse (2003), "A parameterization of ice shelf-ocean
+      !!                interaction for climate models", Ocean Modelling 5(2003) 157-170.
+      !!----------------------------------------------------------------------
+      !!-------------------------- OUT -------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pqhc, pqfwf, pqoce  ! fresh water and ice-ocean heat fluxes
+      !!-------------------------- IN  -------------------------------------
+      INTEGER,  INTENT(in) :: kt
+      INTEGER,  INTENT(in) :: Kmm    !  ocean time level index
+      !!--------------------------------------------------------------------
+      INTEGER :: jk
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztfrz3d        ! freezing point
+      REAL(wp), DIMENSION(jpi,jpj)     :: ztfrz          ! freezing point
+      REAL(wp), DIMENSION(jpi,jpj)     :: ztavg          ! temperature avg
+      !!----------------------------------------------------------------------
+      !
+      ! 0. ------------Mean freezing point
+      DO jk = 1,jpk
+         CALL eos_fzp(ts(:,:,jk,jp_sal,Kmm), ztfrz3d(:,:,jk), gdept(:,:,jk,Kmm))
+      END DO
+      CALL isf_tbl(Kmm, ztfrz3d, ztfrz, 'T', misfkt_par, rhisf_tbl_par, misfkb_par, rfrac_tbl_par )
+      !
+      ! 1. ------------Mean temperature
+      CALL isf_tbl(Kmm, ts(:,:,jk,jp_tem,Kmm), ztavg, 'T', misfkt_par, rhisf_tbl_par, misfkb_par, rfrac_tbl_par )
+      !
+      ! 2. ------------Net heat flux and fresh water flux due to the ice shelf
+      pqoce(:,:) =   rho0 * rcp * rn_gammat0 * risfLeff(:,:) * e1t(:,:) * ( ztavg(:,:) - ztfrz(:,:) ) * r1_e1e2t(:,:)
+      pqfwf(:,:) = - pqoce(:,:) / rLfusisf             ! derived from the latent heat flux
+      pqhc (:,:) =   pqfwf(:,:) * ztfrz(:,:) * rcp     ! heat content flux 
+      !
+      ! 3. ------------BG03 output
+      ! output ttbl
+      CALL iom_put('ttbl_par', ztavg(:,:) * mskisf_par(:,:) )
+      !
+      ! output thermal driving
+      CALL iom_put('isfthermald_par',( ztfrz(:,:) - ztavg(:,:) ) * mskisf_par(:,:))
+      !
+      ! output freezing point used to define the thermal driving and heat content fluxes
+      CALL iom_put('isftfrz_par', ztfrz )
+      !
+   END SUBROUTINE isfpar_mlt_bg03
+
+   SUBROUTINE isfpar_mlt_oasis(kt, Kmm, pqhc , pqoce, pqfwf )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE isfpar_mlt_oasis  ***
+      !!
+      !! ** Purpose    : scale the fwf read from input file by the total amount received by the sbccpl interface
+      !!
+      !! ** Purpose    : - read ice shelf melt from forcing file and scale it by the input file total amount => pattern
+      !!                 - compute total amount of fwf given by sbccpl (fwfisf_oasis)
+      !!                 - scale fwf and compute heat fluxes
+      !!
+      !!---------------------------------------------------------------------
+      !!-------------------------- OUT -------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: pqhc, pqoce, pqfwf  ! heat content, latent heat and fwf fluxes
+      !!-------------------------- IN  -------------------------------------
+      INTEGER                     , INTENT(in   ) :: kt                  ! current time step
+      INTEGER                     , INTENT(in   ) :: Kmm                 !  ocean time level index
+      !!--------------------------------------------------------------------
+      INTEGER                           :: jk                            ! loop index
+      REAL(wp)                          :: zfwf_fld, zfwf_oasis          ! total fwf in the forcing fields (pattern) and from the cpl interface (amount)
+      REAL(wp), DIMENSION(jpi,jpj)      :: ztfrz                         ! tbl freezing temperature
+      REAL(wp), DIMENSION(jpi,jpj)      :: zfwf                          ! 2d fwf map after scaling
+      REAL(wp), DIMENSION(jpi,jpj,jpk)  :: ztfrz3d
+      !!--------------------------------------------------------------------
+      !
+      ! 0. ------------Read specified runoff
+      CALL fld_read ( kt, 1, sf_isfpar_fwf   )
+      !
+      ! 1. ------------Mean freezing point (needed for heat content flux)
+      DO jk = 1,jpk
+         CALL eos_fzp(ts(:,:,jk,jp_sal,Kmm), ztfrz3d(:,:,jk), gdept(:,:,jk,Kmm))
+      END DO
+      CALL isf_tbl(Kmm, ztfrz3d, ztfrz, 'T', misfkt_par, rhisf_tbl_par, misfkb_par, rfrac_tbl_par )
+      !
+      ! 2. ------------Scale isf melt pattern with total amount from oasis
+      ! ice shelf 2d map
+      zfwf(:,:) = - sf_isfpar_fwf(1)%fnow(:,:,1)
+      !
+      ! compute glob sum from input file
+      ! (PM) should we consider delay sum as in fwb ? (it will offset by 1 time step if I understood well)
+      zfwf_fld = glob_sum('isfcav_mlt', e1e2t(:,:) * zfwf(:,:))
+      !
+      ! compute glob sum from atm->oce ice shelf fwf
+      ! (PM) should we consider delay sum as in fwb ?
+      zfwf_oasis = glob_sum('isfcav_mlt', e1e2t(:,:) * fwfisf_oasis(:,:))
+      !
+      ! scale fwf
+      zfwf(:,:) = zfwf(:,:) * zfwf_oasis / zfwf_fld
+      ! 
+      ! 3. -----------Define fwf and qoce
+      ! ocean heat flux is assume to be equal to the latent heat
+      pqfwf(:,:) =   zfwf(:,:)                         ! fwf                ( >0 out )
+      pqoce(:,:) = - pqfwf(:,:) * rLfusisf             ! ocean heat flux    ( >0 out ) (assumed to be the latent heat flux)
+      pqhc (:,:) =   pqfwf(:,:) * ztfrz(:,:) * rcp     ! heat content flux  ( >0 out )
+      !
+      CALL iom_put('isftfrz_par', ztfrz )
+      !
+   END SUBROUTINE isfpar_mlt_oasis
+
+END MODULE isfparmlt
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfrst.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfrst.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfrst.F90	(revision 12928)
@@ -0,0 +1,105 @@
+MODULE isfrst
+   !!======================================================================
+   !!                       ***  MODULE  isfrst  ***
+   !! iceshelf restart module :read/write iceshelf variables from/in restart
+   !!======================================================================
+   !! History :  4.1  !  2019-07  (P. Mathiot) Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   isfrst : read/write iceshelf variables in/from restart
+   !!----------------------------------------------------------------------
+   !
+   USE par_oce, ONLY: jpi,jpj,jpk,jpts ! time and space domain
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O library
+   !
+   IMPLICIT NONE
+
+   PRIVATE
+
+   PUBLIC isfrst_read, isfrst_write ! iceshelf restart read and write 
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+   ! 
+   SUBROUTINE isfrst_read(cdisf, ptsc, pfwf, ptsc_b, pfwf_b )
+      !!---------------------------------------------------------------------
+      !!
+      !!   isfrst_read : read iceshelf variables from restart
+      !!
+      !!-------------------------- OUT --------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(  out) :: pfwf_b
+      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(  out) :: ptsc_b
+      !!-------------------------- IN  --------------------------------------
+      CHARACTER(LEN=3)                 , INTENT(in   ) :: cdisf
+      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(in   ) :: pfwf
+      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) :: ptsc
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=256) :: cfwf_b, chc_b, csc_b
+      !!----------------------------------------------------------------------
+      !
+      ! define variable name
+      cfwf_b = 'fwfisf_'//TRIM(cdisf)//'_b'
+      chc_b  = 'isf_hc_'//TRIM(cdisf)//'_b'
+      csc_b  = 'isf_sc_'//TRIM(cdisf)//'_b'
+      !
+      ! read restart
+      IF( iom_varid( numror, cfwf_b, ldstop = .FALSE. ) > 0 ) THEN
+         IF(lwp) WRITE(numout,*) '          nit000-1 isf tracer content forcing fields read in the restart file'
+         CALL iom_get( numror, jpdom_autoglo, cfwf_b, pfwf_b(:,:)        , ldxios = lrxios )   ! before ice shelf melt
+         CALL iom_get( numror, jpdom_autoglo, chc_b , ptsc_b (:,:,jp_tem), ldxios = lrxios )   ! before ice shelf heat flux
+         CALL iom_get( numror, jpdom_autoglo, csc_b , ptsc_b (:,:,jp_sal), ldxios = lrxios )   ! before ice shelf heat flux
+      ELSE
+         pfwf_b(:,:)   = pfwf(:,:)
+         ptsc_b(:,:,:) = ptsc(:,:,:)
+      ENDIF
+      !
+      IF( lwxios ) THEN
+         CALL iom_set_rstw_var_active(TRIM(chc_b ))
+         CALL iom_set_rstw_var_active(TRIM(csc_b ))
+         CALL iom_set_rstw_var_active(TRIM(cfwf_b))
+      ENDIF
+
+   END SUBROUTINE isfrst_read
+   ! 
+   SUBROUTINE isfrst_write(kt, cdisf, ptsc, pfwf )
+      !!---------------------------------------------------------------------
+      !!
+      !!   isfrst_write : write iceshelf variables in restart
+      !!
+      !!-------------------------- IN  --------------------------------------
+      INTEGER                          , INTENT(in   ) :: kt
+      CHARACTER(LEN=3)                 , INTENT(in   ) :: cdisf
+      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(in   ) :: pfwf
+      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) :: ptsc
+      !!---------------------------------------------------------------------
+      CHARACTER(LEN=256) :: cfwf_b, chc_b, csc_b
+      !!---------------------------------------------------------------------
+      !
+      ! ocean output print
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'isf : isf fwf and heat fluxes written in ocean restart file ',   &
+         &                    'at it= ', kt,' date= ', ndastp
+      IF(lwp) WRITE(numout,*) '~~~~'
+      !
+      ! define variable name
+      cfwf_b = 'fwfisf_'//TRIM(cdisf)//'_b'
+      chc_b  = 'isf_hc_'//TRIM(cdisf)//'_b'
+      csc_b  = 'isf_sc_'//TRIM(cdisf)//'_b'
+      !
+      ! write restart variable
+      IF( lwxios ) CALL iom_swap( cwxios_context )
+      CALL iom_rstput( kt, nitrst, numrow, cfwf_b, pfwf(:,:)       , ldxios = lwxios )
+      CALL iom_rstput( kt, nitrst, numrow, chc_b , ptsc(:,:,jp_tem), ldxios = lwxios )
+      CALL iom_rstput( kt, nitrst, numrow, csc_b , ptsc(:,:,jp_sal), ldxios = lwxios )
+      IF( lwxios ) CALL iom_swap( cxios_context )
+      !
+   END SUBROUTINE isfrst_write
+   !
+END MODULE isfrst
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfstp.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfstp.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfstp.F90	(revision 12928)
@@ -0,0 +1,303 @@
+MODULE isfstp
+   !!======================================================================
+   !!                       ***  MODULE  isfstp  ***
+   !! Surface module :  compute iceshelf load, melt and heat flux
+   !!======================================================================
+   !! History :  3.2  !  2011-02  (C.Harris  ) Original code isf cav
+   !!            X.X  !  2006-02  (C. Wang   ) Original code bg03
+   !!            3.4  !  2013-03  (P. Mathiot) Merging + parametrization
+   !!            4.1  !  2019-09  (P. Mathiot) Split param/explicit ice shelf and re-organisation
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   isfstp       : compute iceshelf melt and heat flux
+   !!----------------------------------------------------------------------
+   !
+   USE isf_oce                                      ! isf variables
+   USE isfload, ONLY: isf_load                      ! ice shelf load
+   USE isftbl , ONLY: isf_tbl_lvl                   ! ice shelf boundary layer
+   USE isfpar , ONLY: isf_par, isf_par_init         ! ice shelf parametrisation
+   USE isfcav , ONLY: isf_cav, isf_cav_init         ! ice shelf cavity
+   USE isfcpl , ONLY: isfcpl_rst_write, isfcpl_init ! isf variables
+
+   USE dom_oce, ONLY: ht, e3t, ln_isfcav, ln_linssh     ! ocean space and time domain
+   USE domvvl,  ONLY: ln_vvl_zstar                      ! zstar logical
+   USE zdfdrg,  ONLY: r_Cdmin_top, r_ke0_top            ! vertical physics: top/bottom drag coef.
+   !
+   USE lib_mpp, ONLY: ctl_stop, ctl_nam
+   USE fldread, ONLY: FLD, FLD_N
+   USE in_out_manager ! I/O manager
+   USE timing
+
+   IMPLICIT NONE
+
+   PRIVATE
+
+   PUBLIC   isf_stp, isf_init, isf_nam  ! routine called in sbcmod and divhor
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id$
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+ 
+  SUBROUTINE isf_stp( kt, Kmm )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE isf_stp  ***
+      !!
+      !! ** Purpose : compute total heat flux and total fwf due to ice shelf melt
+      !!
+      !! ** Method  : For each case (parametrisation or explicity cavity) :
+      !!              - define the before fields
+      !!              - compute top boundary layer properties
+      !!                (in case of parametrisation, this is the 
+      !!                 depth range model array used to compute mean far fields properties)
+      !!              - compute fluxes
+      !!              - write restart variables
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+      INTEGER, INTENT(in) ::   Kmm  ! ocean time level index
+      !!---------------------------------------------------------------------
+      !
+      IF( ln_timing )   CALL timing_start('isf')
+      !
+      !=======================================================================
+      ! 1.: compute melt and associated heat fluxes in the ice shelf cavities
+      !=======================================================================
+      !
+      IF ( ln_isfcav_mlt ) THEN
+         !
+         ! 1.1: before time step 
+         IF ( kt /= nit000 ) THEN 
+            risf_cav_tsc_b (:,:,:) = risf_cav_tsc (:,:,:)
+            fwfisf_cav_b(:,:)      = fwfisf_cav(:,:)
+         END IF
+         !
+         ! 1.2: compute misfkb, rhisf_tbl, rfrac (deepest level, thickness, fraction of deepest cell affected by tbl)
+         rhisf_tbl_cav(:,:) = rn_htbl * mskisf_cav(:,:)
+         CALL isf_tbl_lvl(ht, e3t(:,:,:,Kmm), misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav)
+         !
+         ! 1.3: compute ice shelf melt
+         CALL isf_cav( kt, Kmm, risf_cav_tsc, fwfisf_cav)
+         !
+      END IF
+      ! 
+      !=================================================================================
+      ! 2.: compute melt and associated heat fluxes for not resolved ice shelf cavities
+      !=================================================================================
+      !
+      IF ( ln_isfpar_mlt ) THEN
+         !
+         ! 2.1: before time step 
+         IF ( kt /= nit000 ) THEN 
+            risf_par_tsc_b(:,:,:) = risf_par_tsc(:,:,:)
+            fwfisf_par_b  (:,:)   = fwfisf_par  (:,:)
+         END IF
+         !
+         ! 2.2: compute misfkb, rhisf_tbl, rfrac (deepest level, thickness, fraction of deepest cell affected by tbl)
+         ! by simplicity, we assume the top level where param applied do not change with time (done in init part)
+         rhisf_tbl_par(:,:) = rhisf0_tbl_par(:,:)
+         CALL isf_tbl_lvl(ht, e3t(:,:,:,Kmm), misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par)
+         !
+         ! 2.3: compute ice shelf melt
+         CALL isf_par( kt, Kmm, risf_par_tsc, fwfisf_par)
+         !
+      END IF
+      !
+      !==================================================================================
+      ! 3.: output specific restart variable in case of coupling with an ice sheet model
+      !==================================================================================
+      !
+      IF ( ln_isfcpl .AND. lrst_oce ) CALL isfcpl_rst_write(kt, Kmm)
+      !
+      IF( ln_timing )   CALL timing_stop('isf')
+      !
+   END SUBROUTINE isf_stp
+
+   SUBROUTINE isf_init(Kbb, Kmm, Kaa)
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE isfstp_init  ***
+      !!
+      !! ** Purpose :   Initialisation of the ice shelf public variables
+      !!
+      !! ** Method  :   Read the namisf namelist, check option compatibility and set derived parameters
+      !!
+      !! ** Action  : - read namisf parameters
+      !!              - allocate memory
+      !!              - output print
+      !!              - ckeck option compatibility
+      !!              - call cav/param/isfcpl init routine
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: Kbb, Kmm, Kaa      ! ocean time level indices
+      !
+      ! constrain: l_isfoasis need to be known
+      !
+      ! Read namelist
+      CALL isf_nam()
+      !
+      ! Allocate public array
+      CALL isf_alloc()
+      !
+      ! check option compatibility
+      CALL isf_ctl()
+      !
+      ! compute ice shelf load
+      IF ( ln_isfcav ) CALL isf_load( Kmm, risfload )
+      !
+      ! terminate routine now if no ice shelf melt formulation specify
+      IF ( ln_isf ) THEN
+         !
+         !---------------------------------------------------------------------------------------------------------------------
+         ! initialisation melt in the cavity
+         IF ( ln_isfcav_mlt ) CALL isf_cav_init()
+         !
+         !---------------------------------------------------------------------------------------------------------------------
+         ! initialisation parametrised melt
+         IF ( ln_isfpar_mlt ) CALL isf_par_init()
+         !
+         !---------------------------------------------------------------------------------------------------------------------
+         ! initialisation ice sheet coupling
+         IF( ln_isfcpl ) CALL isfcpl_init(Kbb, Kmm, Kaa)
+         !
+      END IF
+         
+  END SUBROUTINE isf_init
+
+  SUBROUTINE isf_ctl()
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE isf_ctl  ***
+      !!
+      !! ** Purpose :   output print and option compatibility check
+      !!
+      !!----------------------------------------------------------------------
+      IF (lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'isf_init : ice shelf initialisation'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namisf :'
+         !
+         WRITE(numout,*) '   ice shelf cavity (open or parametrised)  ln_isf = ', ln_isf
+         WRITE(numout,*)
+         !
+         IF ( ln_isf ) THEN
+            WRITE(numout,*) '      Add debug print in isf module           ln_isfdebug     = ', ln_isfdebug
+            WRITE(numout,*)
+            WRITE(numout,*) '      melt inside the cavity                  ln_isfcav_mlt   = ', ln_isfcav_mlt
+            IF ( ln_isfcav_mlt) THEN
+               WRITE(numout,*) '         melt formulation                         cn_isfcav_mlt= ', TRIM(cn_isfcav_mlt)
+               WRITE(numout,*) '         thickness of the top boundary layer      rn_htbl      = ', rn_htbl
+               WRITE(numout,*) '         gamma formulation                        cn_gammablk  = ', TRIM(cn_gammablk) 
+               IF ( TRIM(cn_gammablk) .NE. 'spe' ) THEN 
+                  WRITE(numout,*) '         gammat coefficient                       rn_gammat0   = ', rn_gammat0  
+                  WRITE(numout,*) '         gammas coefficient                       rn_gammas0   = ', rn_gammas0  
+                  WRITE(numout,*) '         top background ke used (from namdrg_top) rn_ke0       = ', r_ke0_top
+                  WRITE(numout,*) '         top drag coef.    used (from namdrg_top) rn_Cd0       = ', r_Cdmin_top
+               END IF
+            END IF
+            WRITE(numout,*) ''
+            !
+            WRITE(numout,*) '      ice shelf melt parametrisation          ln_isfpar_mlt   = ', ln_isfpar_mlt
+            IF ( ln_isfpar_mlt ) THEN
+               WRITE(numout,*) '         isf parametrisation formulation         cn_isfpar_mlt   = ', TRIM(cn_isfpar_mlt)
+            END IF
+            WRITE(numout,*) ''
+            !
+            WRITE(numout,*) '      Coupling to an ice sheet model          ln_isfcpl       = ', ln_isfcpl
+            IF ( ln_isfcpl ) THEN
+               WRITE(numout,*) '         conservation activated ln_isfcpl_cons     = ', ln_isfcpl_cons
+               WRITE(numout,*) '         number of call of the extrapolation loop  = ', nn_drown
+            ENDIF
+            WRITE(numout,*) ''
+            !
+         ELSE
+            !
+            IF ( ln_isfcav ) THEN
+               WRITE(numout,*) ''
+               WRITE(numout,*) '   W A R N I N G: ice shelf cavities are open BUT no melt will be computed or read from file !'
+               WRITE(numout,*) ''
+            END IF
+            !
+         END IF
+
+         IF (ln_isfcav) THEN
+            WRITE(numout,*) '      Ice shelf load method                   cn_isfload        = ', TRIM(cn_isfload)
+            WRITE(numout,*) '         Temperature used to compute the ice shelf load            = ', rn_isfload_T
+            WRITE(numout,*) '         Salinity    used to compute the ice shelf load            = ', rn_isfload_S
+         END IF
+         WRITE(numout,*) ''
+         FLUSH(numout)
+
+      END IF
+      !
+
+      !---------------------------------------------------------------------------------------------------------------------
+      ! sanity check  ! issue ln_isfcav not yet known as well as l_isfoasis  => move this call in isf_stp ?
+      ! melt in the cavity without cavity
+      IF ( ln_isfcav_mlt .AND. (.NOT. ln_isfcav) ) &
+          &   CALL ctl_stop('ice shelf melt in the cavity activated (ln_isfcav_mlt) but no cavity detected in domcfg (ln_isfcav), STOP' )
+      !
+      ! ice sheet coupling without cavity
+      IF ( ln_isfcpl .AND. (.NOT. ln_isfcav) ) &
+         &   CALL ctl_stop('coupling with an ice sheet model detected (ln_isfcpl) but no cavity detected in domcfg (ln_isfcav), STOP' )
+      !
+      IF ( ln_isfcpl .AND. ln_isfcpl_cons .AND. ln_linssh ) &
+         &   CALL ctl_stop( 'The coupling between NEMO and an ice sheet model with the conservation option does not work with the linssh option' )
+      !
+      IF ( l_isfoasis .AND. .NOT. ln_isf ) CALL ctl_stop( ' OASIS send ice shelf fluxes to NEMO but NEMO does not have the isf module activated' )
+      !
+      IF ( l_isfoasis .AND. ln_isf ) THEN
+         !
+         CALL ctl_stop( 'namelist combination ln_cpl and ln_isf not tested' )
+         !
+         ! NEMO coupled to ATMO model with isf cavity need oasis method for melt computation 
+         IF ( ln_isfcav_mlt .AND. TRIM(cn_isfcav_mlt) /= 'oasis' ) CALL ctl_stop( 'cn_isfcav_mlt = oasis is the only option availble if fwf send by oasis' )
+         IF ( ln_isfpar_mlt .AND. TRIM(cn_isfpar_mlt) /= 'oasis' ) CALL ctl_stop( 'cn_isfpar_mlt = oasis is the only option availble if fwf send by oasis' )
+         !
+         ! oasis melt computation not tested (coded but not tested)
+         IF ( ln_isfcav_mlt .OR. ln_isfpar_mlt ) THEN
+            IF ( TRIM(cn_isfcav_mlt) == 'oasis' ) CALL ctl_stop( 'cn_isfcav_mlt = oasis not tested' )
+            IF ( TRIM(cn_isfpar_mlt) == 'oasis' ) CALL ctl_stop( 'cn_isfpar_mlt = oasis not tested' )
+         END IF
+         !
+         ! oasis melt computation with cavity open and cavity parametrised (not coded)
+         IF ( ln_isfcav_mlt .AND. ln_isfpar_mlt ) THEN
+            IF ( TRIM(cn_isfpar_mlt) == 'oasis' .AND. TRIM(cn_isfcav_mlt) == 'oasis' ) CALL ctl_stop( 'cn_isfpar_mlt = oasis and cn_isfcav_mlt = oasis not coded' )
+         END IF
+         !
+         ! compatibility ice shelf and vvl
+         IF( .NOT. ln_vvl_zstar .AND. ln_isf ) CALL ctl_stop( 'Only vvl_zstar has been tested with ice shelf cavity' )
+         !
+      END IF
+   END SUBROUTINE isf_ctl
+   !
+   SUBROUTINE isf_nam
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE isf_nam  ***
+      !!
+      !! ** Purpose :   Read ice shelf namelist cfg and ref
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER               :: ios                  ! Local integer output status for namelist read
+      !!----------------------------------------------------------------------
+      NAMELIST/namisf/ ln_isf        ,                                                           & 
+         &             cn_gammablk   , rn_gammat0    , rn_gammas0    , rn_htbl, sn_isfcav_fwf,   &
+         &             ln_isfcav_mlt , cn_isfcav_mlt , sn_isfcav_fwf ,                           &
+         &             ln_isfpar_mlt , cn_isfpar_mlt , sn_isfpar_fwf ,                           &
+         &             sn_isfpar_zmin, sn_isfpar_zmax, sn_isfpar_Leff,                           &
+         &             ln_isfcpl     , nn_drown      , ln_isfcpl_cons, ln_isfdebug,              &
+         &             cn_isfload    , rn_isfload_T  , rn_isfload_S  , cn_isfdir
+      !!----------------------------------------------------------------------
+      !
+      READ  ( numnam_ref, namisf, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namisf in reference namelist' )
+      !
+      READ  ( numnam_cfg, namisf, IOSTAT = ios, ERR = 902 )
+902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namisf in configuration namelist' )
+      IF(lwm) WRITE ( numond, namisf )
+
+   END SUBROUTINE isf_nam
+   !!
+   !!======================================================================
+END MODULE isfstp
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isftbl.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isftbl.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isftbl.F90	(revision 12928)
@@ -0,0 +1,263 @@
+MODULE isftbl
+   !!======================================================================
+   !!                       ***  MODULE  isftbl  ***
+   !! isftbl module :  compute properties of top boundary layer
+   !!======================================================================
+   !! History :  4.1  !  2019-09  (P. Mathiot) original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   isftbl       : routine to compute : 
+   !!                  - geometry of the ice shelf tbl (isf_tbl_lvl, isftbl_ktop, isftbl_kbot)
+   !!                    (top and bottom level, thickness and fraction of deepest level affected)
+   !!                  - tbl averaged properties (isf_tbl, isf_tbl_avg)
+   !!----------------------------------------------------------------------
+
+   USE isf_oce ! ice shelf variables
+
+   USE dom_oce ! vertical scale factor and depth
+
+   IMPLICIT NONE
+
+   PRIVATE
+
+   PUBLIC isf_tbl, isf_tbl_avg, isf_tbl_lvl, isf_tbl_ktop, isf_tbl_kbot
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+
+CONTAINS
+
+   SUBROUTINE isf_tbl( Kmm, pvarin, pvarout, cd_ptin, ktop, phtbl, kbot, pfrac )
+      !!--------------------------------------------------------------------
+      !!                  ***  SUBROUTINE isf_tbl  ***
+      !!
+      !! ** Purpose : compute mean T/S/U/V in the boundary layer at T- point
+      !!
+      !! ** Method : Average properties over a specific thickness
+      !!
+      !! ** Reference : inspired from : Losch, Modeling ice shelf cavities in a z coordinate ocean general circulation model
+      !!                https://doi.org/10.1029/2007JC004368 , 2008
+      !!
+      !!-------------------------- OUT -------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj)          , INTENT(  out) :: pvarout ! 2d average of pvarin
+      !!-------------------------- IN  -------------------------------------
+      INTEGER                               , INTENT(in   ) :: Kmm           ! ocean time level index
+      CHARACTER(len=1)                      , INTENT(in   ) :: cd_ptin       ! point of variable in/out
+      REAL(wp), DIMENSION(jpi,jpj,jpk)      , INTENT(in   ) :: pvarin        ! 3d variable to average over the tbl
+      INTEGER,  DIMENSION(jpi,jpj)          , INTENT(in   ) :: ktop          ! top level
+      REAL(wp), DIMENSION(jpi,jpj)          , INTENT(in   ) :: phtbl         ! tbl thickness
+      !!-------------------------- IN OPTIONAL -----------------------------
+      INTEGER,  DIMENSION(jpi,jpj), OPTIONAL, INTENT(in   ) :: kbot          ! bottom level
+      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in   ) :: pfrac         ! fraction of bottom cell affected by tbl
+      !!--------------------------------------------------------------------
+      INTEGER ::   ji, jj                     ! loop index
+      INTEGER , DIMENSION(jpi,jpj) :: ikbot   ! bottom level of the tbl
+      REAL(wp), DIMENSION(jpi,jpj) :: zvarout ! 2d average of pvarin
+      REAL(wp), DIMENSION(jpi,jpj) :: zhtbl   ! thickness of the tbl
+      REAL(wp), DIMENSION(jpi,jpj) :: zfrac   ! thickness of the tbl
+      !!--------------------------------------------------------------------
+      ! 
+      SELECT CASE ( cd_ptin )
+      CASE ( 'U' )
+         !
+         ! copy phtbl (phtbl is INTENT in as we don't want to change it)
+         zhtbl = phtbl
+         !
+         ! compute tbl lvl and thickness
+         CALL isf_tbl_lvl( hu(:,:,Kmm), e3u(:,:,:,Kmm), ktop, ikbot, zhtbl, zfrac )
+         !
+         ! compute tbl property at U point
+         CALL isf_tbl_avg( miku, ikbot, zhtbl, zfrac, e3u(:,:,:,Kmm), pvarin, zvarout )
+         !
+         ! compute tbl property at T point
+         pvarout(1,:) = 0._wp
+         DO_2D_11_01
+            pvarout(ji,jj) = 0.5_wp * (zvarout(ji,jj) + zvarout(ji-1,jj))
+         END_2D
+         ! lbclnk not needed as a final communication is done after the computation of fwf
+         ! 
+      CASE ( 'V' )
+         !
+         ! copy phtbl (phtbl is INTENT in as we don't want to change it)
+         zhtbl = phtbl
+         !
+         ! compute tbl lvl and thickness
+         CALL isf_tbl_lvl( hv(:,:,Kmm), e3v(:,:,:,Kmm), ktop, ikbot, zhtbl, zfrac )
+         !
+         ! compute tbl property at V point
+         CALL isf_tbl_avg( mikv, ikbot, zhtbl, zfrac, e3v(:,:,:,Kmm), pvarin, zvarout )
+         !
+         ! pvarout is an averaging of wet point
+         pvarout(:,1) = 0._wp
+         DO_2D_01_11
+            pvarout(ji,jj) = 0.5_wp * (zvarout(ji,jj) + zvarout(ji,jj-1))
+         END_2D
+         ! lbclnk not needed as a final communication is done after the computation of fwf
+         !
+      CASE ( 'T' )
+         !
+         ! compute tbl property at T point
+         CALL isf_tbl_avg( ktop, kbot, phtbl, pfrac, e3t(:,:,:,Kmm), pvarin, pvarout )
+         !
+      END SELECT
+      !
+   END SUBROUTINE isf_tbl
+
+   SUBROUTINE isf_tbl_avg( ktop, kbot, phtbl, pfrac, pe3, pvarin, pvarout )
+      !!--------------------------------------------------------------------
+      !!                  ***  ROUTINE isf_tbl_avg  ***
+      !!
+      !! ** Purpose : compute mean property in the boundary layer
+      !!
+      !! ** Method  : Depth average is made between the top level ktop and the bottom level kbot
+      !!              over a thickness phtbl. The bottom level is partially counted (pfrac).
+      !!
+      !!-------------------------- OUT -------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(  out) :: pvarout      ! tbl property averaged over phtbl between level ktop and kbot
+      !!-------------------------- IN  -------------------------------------
+      INTEGER,  DIMENSION(jpi,jpj)    , INTENT(in   ) :: ktop, kbot   ! top and bottom level of the top boundary layer
+      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in   ) :: phtbl, pfrac ! fraction of bottom level to be affected by the tbl
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pe3          ! vertical scale factor
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pvarin       ! tbl property to average between ktop, kbot over phtbl
+      !!--------------------------------------------------------------------
+      INTEGER  :: ji,jj,jk                    ! loop indices
+      INTEGER  :: ikt, ikb                    ! top and bottom levels
+      !!--------------------------------------------------------------------
+      !
+      ! compute tbl top.bottom level and thickness
+      DO_2D_11_11
+         !
+         ! tbl top/bottom indices initialisation
+         ikt = ktop(ji,jj) ; ikb = kbot(ji,jj)
+         !
+         ! level fully include in the ice shelf boundary layer
+         pvarout(ji,jj) = SUM( pvarin(ji,jj,ikt:ikb-1) * pe3(ji,jj,ikt:ikb-1) ) / phtbl(ji,jj)
+         !
+         ! level partially include in ice shelf boundary layer 
+         pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,ikb) * pe3(ji,jj,ikb) / phtbl(ji,jj) * pfrac(ji,jj)
+         !
+      END_2D
+
+   END SUBROUTINE isf_tbl_avg
+
+   SUBROUTINE isf_tbl_lvl( phw, pe3, ktop, kbot, phtbl, pfrac )
+      !!--------------------------------------------------------------------
+      !!                  ***  ROUTINE isf_tbl_lvl  ***
+      !!
+      !! ** Purpose : - compute bottom level off the top boundary layer
+      !!              - thickness of the top boundary layer
+      !!              - fraction of the bottom level affected by the tbl
+      !!
+      !!-------------------------- OUT --------------------------------------
+      INTEGER,  DIMENSION(jpi,jpj)    , INTENT(  out) :: kbot   ! bottom level of the top boundary layer
+      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(  out) :: pfrac  ! fraction of bottom level in the tbl
+      !!-------------------------- IN  --------------------------------------
+      INTEGER,  DIMENSION(jpi,jpj)    , INTENT(in   ) :: ktop   ! top level of the top boundary layer
+      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in   ) :: phw    ! water column thickness
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pe3    ! vertical scale factor
+      !!-------------------------- INOUT ------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(inout) :: phtbl  ! top boundary layer thickness
+      !!---------------------------------------------------------------------
+      INTEGER :: ji,jj,jk
+      INTEGER :: ikt, ikb
+      !!---------------------------------------------------------------------
+      !
+      ! get htbl
+      DO_2D_11_11
+         !
+         ! tbl top/bottom indices initialisation
+         ikt = ktop(ji,jj)
+         !
+         ! limit the tbl to water thickness.
+         phtbl(ji,jj) = MIN( phtbl(ji,jj), phw(ji,jj) )
+         !
+         ! thickness of boundary layer must be at least the top level thickness
+         phtbl(ji,jj) = MAX( phtbl(ji,jj), pe3(ji,jj,ikt) )
+         !
+      END_2D
+      !
+      ! get ktbl
+      CALL isf_tbl_kbot(ktop, phtbl, pe3, kbot)
+      !
+      ! get pfrac
+      DO_2D_11_11
+         !
+         ! tbl top/bottom indices initialisation
+         ikt = ktop(ji,jj) ; ikb = kbot(ji,jj)
+         !
+         ! proportion of the bottom cell included in ice shelf boundary layer 
+         pfrac(ji,jj) = ( phtbl(ji,jj) - SUM( pe3(ji,jj,ikt:ikb-1) ) ) / pe3(ji,jj,ikb)
+         !
+      END_2D
+      !
+   END SUBROUTINE isf_tbl_lvl
+   !
+   SUBROUTINE isf_tbl_kbot(ktop, phtbl, pe3, kbot)
+      !!--------------------------------------------------------------------
+      !!                  ***  ROUTINE isf_tbl_bot  ***
+      !!
+      !! ** Purpose : compute bottom level of the isf top boundary layer
+      !!
+      !!-------------------------- OUT -------------------------------------
+      INTEGER,  DIMENSION(jpi,jpj)    , INTENT(  out) :: kbot   ! bottom level of the top boundary layer
+      !!-------------------------- IN  -------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in   ) :: phtbl  ! top boundary layer thickness
+      INTEGER,  DIMENSION(jpi,jpj)    , INTENT(in   ) :: ktop   ! top level of the top boundary layer
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pe3    ! vertical scale factor
+      !!--------------------------------------------------------------------
+      INTEGER :: ji, jj
+      INTEGER :: ikt, ikb
+      !!--------------------------------------------------------------------
+      !
+      ! phtbl need to be bounded by water column thickness before
+      ! test: if htbl = water column thickness, should return mbathy
+      ! test: if htbl = 0 should return ktop (phtbl cap to e3t(ji,jj,1))
+      !
+      ! get ktbl
+      DO_2D_11_11
+         !
+         ! determine the deepest level influenced by the boundary layer
+         ikt = ktop(ji,jj)
+         ikb = ikt
+         DO WHILE ( SUM(pe3(ji,jj,ikt:ikb-1)) < phtbl(ji,jj ) ) ;  ikb = ikb + 1 ;  END DO
+         kbot(ji,jj) = ikb - 1
+         !
+      END_2D
+      !
+   END SUBROUTINE isf_tbl_kbot
+      !
+   SUBROUTINE isf_tbl_ktop(pdep, ktop)
+      !!--------------------------------------------------------------------
+      !!                  ***  ROUTINE isf_tbl_top  ***
+      !!
+      !! ** Purpose : compute top level of the isf top boundary layer in case of an ice shelf parametrisation
+      !!
+      !!-------------------------- OUT -------------------------------------
+      INTEGER,  DIMENSION(jpi,jpj), INTENT(  out) :: ktop        ! top level affected by the ice shelf parametrisation
+      !!-------------------------- IN  -------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pdep        ! top depth of the parametrisation influence
+      !!--------------------------------------------------------------------
+      INTEGER :: ji,jj
+      INTEGER :: ikt
+      !!--------------------------------------------------------------------
+      !
+      ! if we need to recompute the top level at every time stepcompute top level (z*, z~) 
+      ! in case of weak ht variation we can assume the top level of htbl to be constant
+      ! => only done using gdepw_0
+      ! be sure pdep is already correctly bounded
+      ! test: this routine run on isfdraft should return mikt
+      ! test: this routine run with pdep = 0 should return 1
+      !
+      DO_2D_11_11
+         ! comput ktop
+         ikt = 2
+         DO WHILE ( gdepw_0(ji,jj,ikt) <= pdep(ji,jj ) ) ;  ikt = ikt + 1 ;  END DO
+         ktop(ji,jj) = ikt - 1
+         !
+         ! update pdep
+         pdep(ji,jj) = gdepw_0(ji,jj,ktop(ji,jj))
+      END_2D
+      !
+   END SUBROUTINE isf_tbl_ktop
+
+END MODULE isftbl
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfutils.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfutils.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ISF/isfutils.F90	(revision 12928)
@@ -0,0 +1,162 @@
+MODULE isfutils
+   !!======================================================================
+   !!                       ***  MODULE  isfutils  ***
+   !! istutils module : miscelenious useful routines
+   !!======================================================================
+   !! History :  4.1  !  2019-09  (P. Mathiot) original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   isfutils       : - read_2dcstdta to read a constant input file with iom_get
+   !!                    - debug to print array sum, min, max in ocean.output
+   !!----------------------------------------------------------------------
+
+   USE iom           , ONLY: iom_open, iom_get, iom_close, jpdom_data        ! read input file
+   USE lib_fortran   , ONLY: glob_sum, glob_min, glob_max                    ! compute global value
+   USE par_oce       , ONLY: jpi,jpj,jpk, jpnij                              ! domain size
+   USE dom_oce       , ONLY: nldi, nlei, nldj, nlej, narea, tmask_h, tmask_i ! local domain
+   USE in_out_manager, ONLY: i8, wp, lwp, numout                             ! miscelenious
+   USE lib_mpp
+
+   IMPLICIT NONE
+
+   PRIVATE
+
+   INTERFACE debug
+      MODULE PROCEDURE debug2d, debug3d
+   END INTERFACE debug
+
+   PUBLIC read_2dcstdta, debug
+
+CONTAINS
+
+   SUBROUTINE read_2dcstdta(cdfile, cdvar, pvar)
+      !!--------------------------------------------------------------------
+      !!                  ***  ROUTINE read_2dcstdta  ***
+      !!
+      !! ** Purpose : read input file
+      !!
+      !!-------------------------- OUT -------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: pvar     ! output variable
+      !!-------------------------- IN  -------------------------------------
+      CHARACTER(len=*)            , INTENT(in   ) :: cdfile   ! input file name
+      CHARACTER(len=*)            , INTENT(in   ) :: cdvar    ! variable name
+      !!--------------------------------------------------------------------
+      INTEGER :: inum
+      !!--------------------------------------------------------------------
+
+      CALL iom_open( TRIM(cdfile), inum )
+      CALL iom_get( inum, jpdom_data, TRIM(cdvar), pvar)
+      CALL iom_close(inum)
+
+   END SUBROUTINE read_2dcstdta
+
+   SUBROUTINE debug2d(cdtxt,pvar)
+      !!--------------------------------------------------------------------
+      !!                  ***  ROUTINE isf_debug2d  ***
+      !!
+      !! ** Purpose : add debug print for 2d variables
+      !!
+      !!-------------------------- IN  -------------------------------------
+      CHARACTER(LEN=*)            , INTENT(in   ) :: cdtxt
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pvar
+      !!--------------------------------------------------------------------
+      REAL(wp)    :: zmin, zmax, zsum
+      INTEGER(i8) :: imodd, ip
+      INTEGER     :: imods
+      INTEGER     :: isums, idums
+      INTEGER     :: ji,jj,jk
+      INTEGER, DIMENSION(jpnij) :: itmps
+      !!--------------------------------------------------------------------
+      !
+      ! global min/max/sum to check data range and NaN
+      zsum = glob_sum( 'debug', pvar(:,:) )
+      zmin = glob_min( 'debug', pvar(:,:) )
+      zmax = glob_max( 'debug', pvar(:,:) )
+      !
+      ! basic check sum to check reproducibility
+      ! TRANSFER function find out the integer corresponding to pvar(i,j) bit pattern
+      ! MOD allow us to keep only the latest digits during the sum
+      ! imod is not choosen to be very large as at the end there is a classic mpp_sum
+      imodd=65521 ! highest prime number < 2**16 with i8 type
+      imods=65521 ! highest prime number < 2**16 with default integer for mpp_sum subroutine
+      isums=0 ; itmps(:)=0 ;
+      !
+      ! local MOD sum
+      DO jj=nldj,nlej
+         DO ji=nldi,nlei
+            idums = ABS(MOD(TRANSFER(pvar(ji,jj), ip),imodd))
+            itmps(narea) = MOD(itmps(narea) + idums, imods)
+         END DO
+      END DO
+      !
+      ! global MOD sum
+      CALL mpp_max('debug',itmps(:))
+      DO jk = 1,jpnij
+         isums = MOD(isums + itmps(jk),imods)
+      END DO
+      !
+      ! print out
+      IF (lwp) THEN
+         WRITE(numout,*) TRIM(cdtxt),' (min, max, sum, tag) : ',zmin, zmax, zsum, isums
+         CALL FLUSH(numout)
+      END IF
+      !
+   END SUBROUTINE debug2d
+
+   SUBROUTINE debug3d(cdtxt,pvar)
+      !!--------------------------------------------------------------------
+      !!                  ***  ROUTINE isf_debug3d  ***
+      !!
+      !! ** Purpose : add debug print for 3d variables
+      !!
+      !!-------------------------- IN  -------------------------------------
+      CHARACTER(LEN=*)                , INTENT(in   ) :: cdtxt
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pvar
+      !!--------------------------------------------------------------------
+      REAL(wp)    :: zmin, zmax, zsum
+      INTEGER(i8) :: imodd, ip
+      INTEGER     :: imods
+      INTEGER     :: isums, idums
+      INTEGER     :: ji,jj,jk
+      INTEGER, DIMENSION(jpnij) :: itmps
+      !!--------------------------------------------------------------------
+      !
+      ! global min/max/sum to check data range and NaN
+      zsum = glob_sum( 'debug', pvar(:,:,:) )
+      zmin = glob_min( 'debug', pvar(:,:,:) )
+      zmax = glob_max( 'debug', pvar(:,:,:) )
+      !
+      ! basic check sum to check reproducibility
+      ! TRANSFER function find out the integer corresponding to pvar(i,j) bit pattern
+      ! MOD allow us to keep only the latest digits during the sum
+      ! imod is not choosen to be very large as at the end there is a classic mpp_sum
+      imodd=65521 ! highest prime number < 2**16 with i8 type
+      imods=65521 ! highest prime number < 2**16 with default integer for mpp_sum subroutine
+      itmps=0; isums=0
+      !
+      ! local MOD sum
+      DO jk=1,jpk
+         DO jj=nldj,nlej
+            DO ji=nldi,nlei
+               idums = ABS(MOD(TRANSFER(pvar(ji,jj,jk), ip),imodd))
+               itmps(narea) = MOD(itmps(narea) + idums, imods)
+            END DO
+         END DO
+      END DO
+      !
+      ! global MOD sum
+      CALL mpp_max('debug',itmps)
+      DO jk = 1,jpnij
+         isums = MOD(isums+itmps(jk),imods)
+      END DO
+      !
+      ! print out
+      IF (lwp) THEN
+         WRITE(numout,*) TRIM(cdtxt),' (min, max, sum, tag) : ',zmin, zmax, zsum, isums
+         CALL FLUSH(numout)
+      END IF
+      !
+   END SUBROUTINE debug3d
+
+END MODULE isfutils
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/LBC/lbclnk.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/LBC/lbclnk.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/LBC/lbclnk.F90	(revision 12928)
@@ -62,4 +62,6 @@
    INTEGER, PUBLIC, PARAMETER ::   jpfillmpi     = 5
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/LBC/lib_mpp.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/LBC/lib_mpp.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/LBC/lib_mpp.F90	(revision 12928)
@@ -32,4 +32,5 @@
    !!   ctl_opn       : Open file and check if required file is available.
    !!   ctl_nam       : Prints informations when an error occurs while reading a namelist
+   !!   load_nml      : Read, condense and buffer namelist file into character array for use as an internal file
    !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
@@ -50,4 +51,5 @@
    !!   mpp_ini_north : initialisation of north fold
    !!   mpp_lbc_north_icb : alternative to mpp_nfd for extra outer halo with icebergs
+   !!   mpp_bcast_nml : broadcast/receive namelist character buffer from reading process to all others
    !!----------------------------------------------------------------------
    USE dom_oce        ! ocean space and time domain
@@ -57,5 +59,5 @@
    PRIVATE
    !
-   PUBLIC   ctl_stop, ctl_warn, ctl_opn, ctl_nam
+   PUBLIC   ctl_stop, ctl_warn, ctl_opn, ctl_nam, load_nml
    PUBLIC   mpp_start, mppstop, mppsync, mpp_comm_free
    PUBLIC   mpp_ini_north
@@ -66,4 +68,5 @@
    PUBLIC   mppsend, mpprecv                          ! needed by TAM and ICB routines
    PUBLIC   mpp_report
+   PUBLIC   mpp_bcast_nml
    PUBLIC   tic_tac
 #if ! defined key_mpp_mpi
@@ -139,5 +142,4 @@
    INTEGER, PUBLIC                               ::   ncom_stp = 0                 !: copy of time step # istp
    INTEGER, PUBLIC                               ::   ncom_fsbc = 1                !: copy of sbc time step # nn_fsbc
-   INTEGER, PUBLIC                               ::   ncom_dttrc = 1               !: copy of top time step # nn_dttrc
    INTEGER, PUBLIC                               ::   ncom_freq                    !: frequency of comm diagnostic
    INTEGER, PUBLIC , DIMENSION(:,:), ALLOCATABLE ::   ncomm_sequence               !: size of communicated arrays (halos)
@@ -170,4 +172,6 @@
    LOGICAL, PUBLIC ::   l_north_nogather = .FALSE.  !: internal control of northfold comms
    
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -398,5 +402,6 @@
 # if defined key_mpi2
       IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.)
-      CALL  mpi_allreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ndelayid(idvar), ierr )
+      CALL  mpi_allreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ierr )
+      ndelayid(idvar) = 1
       IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.)
 # else
@@ -465,5 +470,6 @@
 # if defined key_mpi2
       IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.)
-      CALL  mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ndelayid(idvar), ierr )
+      CALL  mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ierr )
+      ndelayid(idvar) = 1
       IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.)
 # else
@@ -499,4 +505,29 @@
 #endif
    END SUBROUTINE mpp_delay_rcv
+
+   SUBROUTINE mpp_bcast_nml( cdnambuff , kleng )
+      CHARACTER(LEN=:)    , ALLOCATABLE, INTENT(INOUT) :: cdnambuff
+      INTEGER                          , INTENT(INOUT) :: kleng
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_bcast_nml  ***
+      !!
+      !! ** Purpose :   broadcast namelist character buffer
+      !!
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER ::   iflag
+      !!----------------------------------------------------------------------
+      !
+#if defined key_mpp_mpi
+      call MPI_BCAST(kleng, 1, MPI_INT, 0, mpi_comm_oce, iflag)
+      call MPI_BARRIER(mpi_comm_oce, iflag)
+!$AGRIF_DO_NOT_TREAT
+      IF ( .NOT. ALLOCATED(cdnambuff) ) ALLOCATE( CHARACTER(LEN=kleng) :: cdnambuff )
+!$AGRIF_END_DO_NOT_TREAT
+      call MPI_BCAST(cdnambuff, kleng, MPI_CHARACTER, 0, mpi_comm_oce, iflag)
+      call MPI_BARRIER(mpi_comm_oce, iflag)
+#endif
+      !
+   END SUBROUTINE mpp_bcast_nml
 
    
@@ -921,5 +952,4 @@
       !
       ! find the smallest common frequency: default = frequency product, if multiple, choose the larger of the 2 frequency
-      IF( ncom_dttrc /= 1 )   CALL ctl_stop( 'STOP', 'mpp_report, ncom_dttrc /= 1 not coded...' ) 
       ncom_freq = ncom_fsbc
       !
@@ -1068,5 +1098,5 @@
 
    !!----------------------------------------------------------------------
-   !!   ctl_stop, ctl_warn, get_unit, ctl_opn, ctl_nam   routines
+   !!   ctl_stop, ctl_warn, get_unit, ctl_opn, ctl_nam, load_nml   routines
    !!----------------------------------------------------------------------
 
@@ -1204,5 +1234,5 @@
          &  OPEN(UNIT=knum,FILE='NUL', FORM=cdform, ACCESS=cdacce, STATUS=cdstat                      , ERR=100, IOSTAT=iost )   
       IF( iost == 0 ) THEN
-         IF(ldwp) THEN
+         IF(ldwp .AND. kout > 0) THEN
             WRITE(kout,*) '     file   : ', TRIM(clfile),' open ok'
             WRITE(kout,*) '     unit   = ', knum
@@ -1279,4 +1309,86 @@
    END FUNCTION get_unit
 
+   SUBROUTINE load_nml( cdnambuff , cdnamfile, kout, ldwp)
+      CHARACTER(LEN=:)    , ALLOCATABLE, INTENT(INOUT) :: cdnambuff
+      CHARACTER(LEN=*), INTENT(IN )                :: cdnamfile
+      CHARACTER(LEN=256)                           :: chline
+      CHARACTER(LEN=1)                             :: csp
+      INTEGER, INTENT(IN)                          :: kout
+      LOGICAL, INTENT(IN)                          :: ldwp  !: .true. only for the root broadcaster
+      INTEGER                                      :: itot, iun, iltc, inl, ios, itotsav
+      !
+      !csp = NEW_LINE('A')
+      ! a new line character is the best seperator but some systems (e.g.Cray)
+      ! seem to terminate namelist reads from internal files early if they 
+      ! encounter new-lines. Use a single space for safety.
+      csp = ' '
+      !
+      ! Check if the namelist buffer has already been allocated. Return if it has.
+      !
+      IF ( ALLOCATED( cdnambuff ) ) RETURN
+      IF( ldwp ) THEN
+         !
+         ! Open namelist file
+         !
+         CALL ctl_opn( iun, cdnamfile, 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, kout, ldwp )
+         !
+         ! First pass: count characters excluding comments and trimable white space
+         !
+         itot=0
+     10  READ(iun,'(A256)',END=20,ERR=20) chline
+         iltc = LEN_TRIM(chline)
+         IF ( iltc.GT.0 ) THEN
+          inl = INDEX(chline, '!') 
+          IF( inl.eq.0 ) THEN
+           itot = itot + iltc + 1                                ! +1 for the newline character
+          ELSEIF( inl.GT.0 .AND. LEN_TRIM( chline(1:inl-1) ).GT.0 ) THEN
+           itot = itot + inl                                  !  includes +1 for the newline character
+          ENDIF
+         ENDIF
+         GOTO 10
+     20  CONTINUE
+         !
+         ! Allocate text cdnambuff for condensed namelist
+         !
+!$AGRIF_DO_NOT_TREAT
+         ALLOCATE( CHARACTER(LEN=itot) :: cdnambuff )
+!$AGRIF_END_DO_NOT_TREAT
+         itotsav = itot
+         !
+         ! Second pass: read and transfer pruned characters into cdnambuff
+         !
+         REWIND(iun)
+         itot=1
+     30  READ(iun,'(A256)',END=40,ERR=40) chline
+         iltc = LEN_TRIM(chline)
+         IF ( iltc.GT.0 ) THEN
+          inl = INDEX(chline, '!')
+          IF( inl.eq.0 ) THEN
+           inl = iltc
+          ELSE
+           inl = inl - 1
+          ENDIF
+          IF( inl.GT.0 .AND. LEN_TRIM( chline(1:inl) ).GT.0 ) THEN
+             cdnambuff(itot:itot+inl-1) = chline(1:inl)
+             WRITE( cdnambuff(itot+inl:itot+inl), '(a)' ) csp
+             itot = itot + inl + 1
+          ENDIF
+         ENDIF
+         GOTO 30
+     40  CONTINUE
+         itot = itot - 1
+         IF( itotsav .NE. itot ) WRITE(*,*) 'WARNING in load_nml. Allocated ',itotsav,' for read buffer; but used ',itot
+         !
+         ! Close namelist file
+         !
+         CLOSE(iun)
+         !write(*,'(32A)') cdnambuff
+      ENDIF
+#if defined key_mpp_mpi
+      CALL mpp_bcast_nml( cdnambuff, itot )
+#endif
+  END SUBROUTINE load_nml
+
+
    !!----------------------------------------------------------------------
 END MODULE lib_mpp
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/LBC/mppini.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/LBC/mppini.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/LBC/mppini.F90	(revision 12928)
@@ -171,13 +171,11 @@
       !!----------------------------------------------------------------------
       !
-      llwrtlay = lwp .OR. ln_ctl .OR. sn_cfctl%l_layout
+      llwrtlay = lwm .OR. sn_cfctl%l_layout
       !
       !  0. read namelists parameters
       ! -----------------------------------
       !
-      REWIND( numnam_ref )              ! Namelist nammpp in reference namelist
       READ  ( numnam_ref, nammpp, IOSTAT = ios, ERR = 901 )
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nammpp in reference namelist' )
-      REWIND( numnam_cfg )              ! Namelist nammpp in confguration namelist
       READ  ( numnam_cfg, nammpp, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nammpp in configuration namelist' )   
@@ -197,8 +195,6 @@
 
       ! do we need to take into account bdy_msk?
-      REWIND( numnam_ref )              ! Namelist nambdy in reference namelist : BDY
       READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903)
 903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist (mppini)' )
-      REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist : BDY
       READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 904 )
 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist (mppini)' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/LDF/ldfc1d_c2d.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/LDF/ldfc1d_c2d.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/LDF/ldfc1d_c2d.F90	(revision 12928)
@@ -30,4 +30,6 @@
    REAL(wp) ::   r1_12 = 1._wp / 12._wp   ! =1/12
  
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -78,26 +80,18 @@
             pah1(:,:,jk) = pahs1(:,:) * (  zratio + zc * ( 1._wp + TANH( - ( gdept_0(:,:,jk) - zh ) * zw) )  )
          END DO
-         DO jk = jpkm1, 1, -1                ! pah2 at F-point (zdep2 is an approximation in zps-coord.)
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  zdep2 = (  gdept_0(ji,jj+1,jk) + gdept_0(ji+1,jj+1,jk)   &
-                     &     + gdept_0(ji,jj  ,jk) + gdept_0(ji+1,jj  ,jk)  ) * r1_4
-                  pah2(ji,jj,jk) = pahs2(ji,jj) * (  zratio + zc * ( 1._wp + TANH( - ( zdep2 - zh ) * zw) )  )
-               END DO
-            END DO
-         END DO
+         DO_3DS_10_10( jpkm1, 1, -1 )
+            zdep2 = (  gdept_0(ji,jj+1,jk) + gdept_0(ji+1,jj+1,jk)   &
+               &     + gdept_0(ji,jj  ,jk) + gdept_0(ji+1,jj  ,jk)  ) * r1_4
+            pah2(ji,jj,jk) = pahs2(ji,jj) * (  zratio + zc * ( 1._wp + TANH( - ( zdep2 - zh ) * zw) )  )
+         END_3D
          CALL lbc_lnk( 'ldfc1d_c2d', pah2, 'F', 1. )   ! Lateral boundary conditions
          !
       CASE( 'TRA' )                     ! U- and V-points (zdep1 & 2 are an approximation in zps-coord.)
-         DO jk = jpkm1, 1, -1
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  zdep1 = (  gdept_0(ji,jj,jk) + gdept_0(ji+1,jj,jk)  ) * 0.5_wp
-                  zdep2 = (  gdept_0(ji,jj,jk) + gdept_0(ji,jj+1,jk)  ) * 0.5_wp
-                  pah1(ji,jj,jk) = pahs1(ji,jj) * (  zratio + zc * ( 1._wp + TANH( - ( zdep1 - zh ) * zw) )  )
-                  pah2(ji,jj,jk) = pahs2(ji,jj) * (  zratio + zc * ( 1._wp + TANH( - ( zdep2 - zh ) * zw) )  )
-               END DO
-            END DO
-         END DO
+         DO_3DS_10_10( jpkm1, 1, -1 )
+            zdep1 = (  gdept_0(ji,jj,jk) + gdept_0(ji+1,jj,jk)  ) * 0.5_wp
+            zdep2 = (  gdept_0(ji,jj,jk) + gdept_0(ji,jj+1,jk)  ) * 0.5_wp
+            pah1(ji,jj,jk) = pahs1(ji,jj) * (  zratio + zc * ( 1._wp + TANH( - ( zdep1 - zh ) * zw) )  )
+            pah2(ji,jj,jk) = pahs2(ji,jj) * (  zratio + zc * ( 1._wp + TANH( - ( zdep2 - zh ) * zw) )  )
+         END_3D
          ! Lateral boundary conditions
          CALL lbc_lnk_multi( 'ldfc1d_c2d', pah1, 'U', 1. , pah2, 'V', 1. )   
@@ -141,17 +135,13 @@
       !
       CASE( 'DYN' )                       ! T- and F-points
-         DO jj = 1, jpj
-            DO ji = 1, jpi 
-               pah1(ji,jj,1) = pUfac * MAX( e1t(ji,jj) , e2t(ji,jj) )**knn
-               pah2(ji,jj,1) = pUfac * MAX( e1f(ji,jj) , e2f(ji,jj) )**knn
-            END DO
-         END DO
+         DO_2D_11_11
+            pah1(ji,jj,1) = pUfac * MAX( e1t(ji,jj) , e2t(ji,jj) )**knn
+            pah2(ji,jj,1) = pUfac * MAX( e1f(ji,jj) , e2f(ji,jj) )**knn
+         END_2D
       CASE( 'TRA' )                       ! U- and V-points
-         DO jj = 1, jpj 
-            DO ji = 1, jpi 
-               pah1(ji,jj,1) = pUfac * MAX( e1u(ji,jj), e2u(ji,jj) )**knn
-               pah2(ji,jj,1) = pUfac * MAX( e1v(ji,jj), e2v(ji,jj) )**knn
-            END DO
-         END DO
+         DO_2D_11_11
+            pah1(ji,jj,1) = pUfac * MAX( e1u(ji,jj), e2u(ji,jj) )**knn
+            pah2(ji,jj,1) = pUfac * MAX( e1v(ji,jj), e2v(ji,jj) )**knn
+         END_2D
       CASE DEFAULT                        ! error
          CALL ctl_stop( 'ldf_c2d: ', cd_type, ' Unknown, i.e. /= DYN or TRA' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/LDF/ldfdyn.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/LDF/ldfdyn.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/LDF/ldfdyn.F90	(revision 12928)
@@ -73,5 +73,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -115,9 +115,7 @@
       !!----------------------------------------------------------------------
       !
-      REWIND( numnam_ref )              ! Namelist namdyn_ldf in reference namelist : Lateral physics
       READ  ( numnam_ref, namdyn_ldf, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_ldf in reference namelist' )
 
-      REWIND( numnam_cfg )              ! Namelist namdyn_ldf in configuration namelist : Lateral physics
       READ  ( numnam_cfg, namdyn_ldf, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_ldf in configuration namelist' )
@@ -313,10 +311,8 @@
             IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_dyn_init: failed to allocate Smagorinsky arrays')
             !
-            DO jj = 1, jpj             ! Set local gridscale values
-               DO ji = 1, jpi
-                  esqt(ji,jj) = ( 2._wp * e1e2t(ji,jj) / ( e1t(ji,jj) + e2t(ji,jj) ) )**2 
-                  esqf(ji,jj) = ( 2._wp * e1e2f(ji,jj) / ( e1f(ji,jj) + e2f(ji,jj) ) )**2 
-               END DO
-            END DO
+            DO_2D_11_11
+               esqt(ji,jj) = ( 2._wp * e1e2t(ji,jj) / ( e1t(ji,jj) + e2t(ji,jj) ) )**2 
+               esqf(ji,jj) = ( 2._wp * e1e2f(ji,jj) / ( e1f(ji,jj) + e2f(ji,jj) ) )**2 
+            END_2D
             !
          CASE DEFAULT
@@ -339,5 +335,5 @@
 
 
-   SUBROUTINE ldf_dyn( kt )
+   SUBROUTINE ldf_dyn( kt, Kbb )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE ldf_dyn  ***
@@ -357,4 +353,5 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! time step index
+      INTEGER, INTENT(in) ::   Kbb  ! ocean time level indices
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -371,39 +368,31 @@
          IF( ln_dynldf_lap   ) THEN        ! laplacian operator : |u| e /12 = |u/144| e
             DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     zu2pv2_ij    = ub(ji  ,jj  ,jk) * ub(ji  ,jj  ,jk) + vb(ji  ,jj  ,jk) * vb(ji  ,jj  ,jk)
-                     zu2pv2_ij_m1 = ub(ji-1,jj  ,jk) * ub(ji-1,jj  ,jk) + vb(ji  ,jj-1,jk) * vb(ji  ,jj-1,jk)
-                     zemax = MAX( e1t(ji,jj) , e2t(ji,jj) )
-                     ahmt(ji,jj,jk) = SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * r1_288 ) * zemax * tmask(ji,jj,jk)      ! 288= 12*12 * 2
-                  END DO
-               END DO
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1
-                     zu2pv2_ij_p1 = ub(ji  ,jj+1,jk) * ub(ji  ,jj+1,jk) + vb(ji+1,jj  ,jk) * vb(ji+1,jj  ,jk)
-                     zu2pv2_ij    = ub(ji  ,jj  ,jk) * ub(ji  ,jj  ,jk) + vb(ji  ,jj  ,jk) * vb(ji  ,jj  ,jk)
-                     zemax = MAX( e1f(ji,jj) , e2f(ji,jj) )
-                     ahmf(ji,jj,jk) = SQRT( (zu2pv2_ij + zu2pv2_ij_p1) * r1_288 ) * zemax * fmask(ji,jj,jk)      ! 288= 12*12 * 2
-                  END DO
-               END DO
+               DO_2D_00_00
+                  zu2pv2_ij    = uu(ji  ,jj  ,jk,Kbb) * uu(ji  ,jj  ,jk,Kbb) + vv(ji  ,jj  ,jk,Kbb) * vv(ji  ,jj  ,jk,Kbb)
+                  zu2pv2_ij_m1 = uu(ji-1,jj  ,jk,Kbb) * uu(ji-1,jj  ,jk,Kbb) + vv(ji  ,jj-1,jk,Kbb) * vv(ji  ,jj-1,jk,Kbb)
+                  zemax = MAX( e1t(ji,jj) , e2t(ji,jj) )
+                  ahmt(ji,jj,jk) = SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * r1_288 ) * zemax * tmask(ji,jj,jk)      ! 288= 12*12 * 2
+               END_2D
+               DO_2D_10_10
+                  zu2pv2_ij_p1 = uu(ji  ,jj+1,jk, Kbb) * uu(ji  ,jj+1,jk, Kbb) + vv(ji+1,jj  ,jk, Kbb) * vv(ji+1,jj  ,jk, Kbb)
+                  zu2pv2_ij    = uu(ji  ,jj  ,jk, Kbb) * uu(ji  ,jj  ,jk, Kbb) + vv(ji  ,jj  ,jk, Kbb) * vv(ji  ,jj  ,jk, Kbb)
+                  zemax = MAX( e1f(ji,jj) , e2f(ji,jj) )
+                  ahmf(ji,jj,jk) = SQRT( (zu2pv2_ij + zu2pv2_ij_p1) * r1_288 ) * zemax * fmask(ji,jj,jk)      ! 288= 12*12 * 2
+               END_2D
             END DO
          ELSEIF( ln_dynldf_blp ) THEN      ! bilaplacian operator : sqrt( |u| e^3 /12 ) = sqrt( |u/144| e ) * e
             DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     zu2pv2_ij    = ub(ji  ,jj  ,jk) * ub(ji  ,jj  ,jk) + vb(ji  ,jj  ,jk) * vb(ji  ,jj  ,jk)
-                     zu2pv2_ij_m1 = ub(ji-1,jj  ,jk) * ub(ji-1,jj  ,jk) + vb(ji  ,jj-1,jk) * vb(ji  ,jj-1,jk)
-                     zemax = MAX( e1t(ji,jj) , e2t(ji,jj) )
-                     ahmt(ji,jj,jk) = SQRT(  SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * r1_288 ) * zemax  ) * zemax * tmask(ji,jj,jk)
-                  END DO
-               END DO
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1
-                     zu2pv2_ij_p1 = ub(ji  ,jj+1,jk) * ub(ji  ,jj+1,jk) + vb(ji+1,jj  ,jk) * vb(ji+1,jj  ,jk)
-                     zu2pv2_ij    = ub(ji  ,jj  ,jk) * ub(ji  ,jj  ,jk) + vb(ji  ,jj  ,jk) * vb(ji  ,jj  ,jk)
-                     zemax = MAX( e1f(ji,jj) , e2f(ji,jj) )
-                     ahmf(ji,jj,jk) = SQRT(  SQRT( (zu2pv2_ij + zu2pv2_ij_p1) * r1_288 ) * zemax  ) * zemax * fmask(ji,jj,jk)
-                  END DO
-               END DO
+               DO_2D_00_00
+                  zu2pv2_ij    = uu(ji  ,jj  ,jk,Kbb) * uu(ji  ,jj  ,jk,Kbb) + vv(ji  ,jj  ,jk,Kbb) * vv(ji  ,jj  ,jk,Kbb)
+                  zu2pv2_ij_m1 = uu(ji-1,jj  ,jk,Kbb) * uu(ji-1,jj  ,jk,Kbb) + vv(ji  ,jj-1,jk,Kbb) * vv(ji  ,jj-1,jk,Kbb)
+                  zemax = MAX( e1t(ji,jj) , e2t(ji,jj) )
+                  ahmt(ji,jj,jk) = SQRT(  SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * r1_288 ) * zemax  ) * zemax * tmask(ji,jj,jk)
+               END_2D
+               DO_2D_10_10
+                  zu2pv2_ij_p1 = uu(ji  ,jj+1,jk, Kbb) * uu(ji  ,jj+1,jk, Kbb) + vv(ji+1,jj  ,jk, Kbb) * vv(ji+1,jj  ,jk, Kbb)
+                  zu2pv2_ij    = uu(ji  ,jj  ,jk, Kbb) * uu(ji  ,jj  ,jk, Kbb) + vv(ji  ,jj  ,jk, Kbb) * vv(ji  ,jj  ,jk, Kbb)
+                  zemax = MAX( e1f(ji,jj) , e2f(ji,jj) )
+                  ahmf(ji,jj,jk) = SQRT(  SQRT( (zu2pv2_ij + zu2pv2_ij_p1) * r1_288 ) * zemax  ) * zemax * fmask(ji,jj,jk)
+               END_2D
             END DO
          ENDIF
@@ -417,25 +406,25 @@
             !
             zcmsmag   = (rn_csmc/rpi)**2                                            ! (C_smag/pi)^2
-            zstabf_lo = rn_minfac * rn_minfac / ( 2._wp * 4._wp * zcmsmag )         ! lower limit stability factor scaling
-            zstabf_up = rn_maxfac / ( 4._wp * zcmsmag * 2._wp * rdt )               ! upper limit stability factor scaling
+            zstabf_lo = rn_minfac * rn_minfac / ( 2._wp * 12._wp * 12._wp * zcmsmag ) ! lower limit stability factor scaling
+            zstabf_up = rn_maxfac / ( 4._wp * zcmsmag * 2._wp * rn_Dt )               ! upper limit stability factor scaling
             IF( ln_dynldf_blp ) zstabf_lo = ( 16._wp / 9._wp ) * zstabf_lo          ! provide |U|L^3/12 lower limit instead 
             !                                                                       ! of |U|L^3/16 in blp case
             DO jk = 1, jpkm1
                !
-               DO jj = 2, jpjm1
-                  DO ji = 2, jpim1
-                     zdb =   ( ub(ji,jj,jk) * r1_e2u(ji,jj) - ub(ji-1,jj,jk) * r1_e2u(ji-1,jj) ) * r1_e1t(ji,jj) * e2t(ji,jj)  &
-                        &  - ( vb(ji,jj,jk) * r1_e1v(ji,jj) - vb(ji,jj-1,jk) * r1_e1v(ji,jj-1) ) * r1_e2t(ji,jj) * e1t(ji,jj)
-                     dtensq(ji,jj,jk) = zdb * zdb * tmask(ji,jj,jk)
-                  END DO
-               END DO
+               DO_2D_00_00
+                  zdb =    ( uu(ji,jj,jk,Kbb) * r1_e2u(ji,jj) -  uu(ji-1,jj,jk,Kbb) * r1_e2u(ji-1,jj) )  &
+                       &                      * r1_e1t(ji,jj) * e2t(ji,jj)                           &
+                       & - ( vv(ji,jj,jk,Kbb) * r1_e1v(ji,jj) -  vv(ji,jj-1,jk,Kbb) * r1_e1v(ji,jj-1) )  &
+                       &                      * r1_e2t(ji,jj) * e1t(ji,jj)
+                  dtensq(ji,jj,jk) = zdb * zdb * tmask(ji,jj,jk)
+               END_2D
                !
-               DO jj = 1, jpjm1
-                  DO ji = 1, jpim1
-                     zdb =   ( ub(ji,jj+1,jk) * r1_e1u(ji,jj+1) - ub(ji,jj,jk) * r1_e1u(ji,jj) ) * r1_e2f(ji,jj) * e1f(ji,jj)  &
-                        &  + ( vb(ji+1,jj,jk) * r1_e2v(ji+1,jj) - vb(ji,jj,jk) * r1_e2v(ji,jj) ) * r1_e1f(ji,jj) * e2f(ji,jj)
-                     dshesq(ji,jj,jk) = zdb * zdb * fmask(ji,jj,jk)
-                  END DO
-               END DO
+               DO_2D_10_10
+                  zdb =   (  uu(ji,jj+1,jk,Kbb) * r1_e1u(ji,jj+1) -  uu(ji,jj,jk,Kbb) * r1_e1u(ji,jj) )  &
+                       &                        * r1_e2f(ji,jj)   * e1f(ji,jj)                       &
+                       & + ( vv(ji+1,jj,jk,Kbb) * r1_e2v(ji+1,jj) -  vv(ji,jj,jk,Kbb) * r1_e2v(ji,jj) )  &
+                       &                        * r1_e1f(ji,jj)   * e2f(ji,jj)
+                  dshesq(ji,jj,jk) = zdb * zdb * fmask(ji,jj,jk)
+               END_2D
                !
             END DO
@@ -445,35 +434,31 @@
             DO jk = 1, jpkm1
               !
-               DO jj = 2, jpjm1                                ! T-point value
-                  DO ji = fs_2, fs_jpim1
-                     !
-                     zu2pv2_ij    = ub(ji  ,jj  ,jk) * ub(ji  ,jj  ,jk) + vb(ji  ,jj  ,jk) * vb(ji  ,jj  ,jk)
-                     zu2pv2_ij_m1 = ub(ji-1,jj  ,jk) * ub(ji-1,jj  ,jk) + vb(ji  ,jj-1,jk) * vb(ji  ,jj-1,jk)
-                     !
-                     zdelta         = zcmsmag * esqt(ji,jj)                                        ! L^2 * (C_smag/pi)^2
-                     ahmt(ji,jj,jk) = zdelta * SQRT(          dtensq(ji  ,jj,jk) +                         &
-                        &                            r1_4 * ( dshesq(ji  ,jj,jk) + dshesq(ji  ,jj-1,jk) +  &
-                        &                                     dshesq(ji-1,jj,jk) + dshesq(ji-1,jj-1,jk) ) )
-                     ahmt(ji,jj,jk) = MAX( ahmt(ji,jj,jk), SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * zdelta * zstabf_lo ) ) ! Impose lower limit == minfac  * |U|L/2
-                     ahmt(ji,jj,jk) = MIN( ahmt(ji,jj,jk),                                    zdelta * zstabf_up )   ! Impose upper limit == maxfac  * L^2/(4*2dt)
-                     !
-                  END DO
-               END DO
+               DO_2D_00_00
+                  !
+                  zu2pv2_ij    = uu(ji  ,jj  ,jk,Kbb) * uu(ji  ,jj  ,jk,Kbb) + vv(ji  ,jj  ,jk,Kbb) * vv(ji  ,jj  ,jk,Kbb)
+                  zu2pv2_ij_m1 = uu(ji-1,jj  ,jk,Kbb) * uu(ji-1,jj  ,jk,Kbb) + vv(ji  ,jj-1,jk,Kbb) * vv(ji  ,jj-1,jk,Kbb)
+                  !
+                  zdelta         = zcmsmag * esqt(ji,jj)                                        ! L^2 * (C_smag/pi)^2
+                  ahmt(ji,jj,jk) = zdelta * SQRT(          dtensq(ji  ,jj,jk) +                         &
+                     &                            r1_4 * ( dshesq(ji  ,jj,jk) + dshesq(ji  ,jj-1,jk) +  &
+                     &                                     dshesq(ji-1,jj,jk) + dshesq(ji-1,jj-1,jk) ) )
+                  ahmt(ji,jj,jk) = MAX( ahmt(ji,jj,jk), SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * zdelta * zstabf_lo ) ) ! Impose lower limit == minfac  * |U|L/2
+                  ahmt(ji,jj,jk) = MIN( ahmt(ji,jj,jk),                                    zdelta * zstabf_up )   ! Impose upper limit == maxfac  * L^2/(4*2dt)
+                  !
+               END_2D
                !
-               DO jj = 1, jpjm1                                ! F-point value
-                  DO ji = 1, fs_jpim1
-                     !
-                     zu2pv2_ij_p1 = ub(ji  ,jj+1,jk) * ub(ji  ,jj+1,jk) + vb(ji+1,jj  ,jk) * vb(ji+1,jj  ,jk)
-                     zu2pv2_ij    = ub(ji  ,jj  ,jk) * ub(ji  ,jj  ,jk) + vb(ji  ,jj  ,jk) * vb(ji  ,jj  ,jk)
-                     !
-                     zdelta         = zcmsmag * esqf(ji,jj)                                        ! L^2 * (C_smag/pi)^2
-                     ahmf(ji,jj,jk) = zdelta * SQRT(          dshesq(ji  ,jj,jk) +                         &
-                        &                            r1_4 * ( dtensq(ji  ,jj,jk) + dtensq(ji  ,jj+1,jk) +  &
-                        &                                     dtensq(ji+1,jj,jk) + dtensq(ji+1,jj+1,jk) ) )
-                     ahmf(ji,jj,jk) = MAX( ahmf(ji,jj,jk), SQRT( (zu2pv2_ij + zu2pv2_ij_p1) * zdelta * zstabf_lo ) ) ! Impose lower limit == minfac  * |U|L/2
-                     ahmf(ji,jj,jk) = MIN( ahmf(ji,jj,jk),                                    zdelta * zstabf_up )   ! Impose upper limit == maxfac  * L^2/(4*2dt)
-                     !
-                  END DO
-               END DO
+               DO_2D_10_10
+                  !
+                  zu2pv2_ij_p1 = uu(ji  ,jj+1,jk, kbb) * uu(ji  ,jj+1,jk, kbb) + vv(ji+1,jj  ,jk, kbb) * vv(ji+1,jj  ,jk, kbb)
+                  zu2pv2_ij    = uu(ji  ,jj  ,jk, kbb) * uu(ji  ,jj  ,jk, kbb) + vv(ji  ,jj  ,jk, kbb) * vv(ji  ,jj  ,jk, kbb)
+                  !
+                  zdelta         = zcmsmag * esqf(ji,jj)                                        ! L^2 * (C_smag/pi)^2
+                  ahmf(ji,jj,jk) = zdelta * SQRT(          dshesq(ji  ,jj,jk) +                         &
+                     &                            r1_4 * ( dtensq(ji  ,jj,jk) + dtensq(ji  ,jj+1,jk) +  &
+                     &                                     dtensq(ji+1,jj,jk) + dtensq(ji+1,jj+1,jk) ) )
+                  ahmf(ji,jj,jk) = MAX( ahmf(ji,jj,jk), SQRT( (zu2pv2_ij + zu2pv2_ij_p1) * zdelta * zstabf_lo ) ) ! Impose lower limit == minfac  * |U|L/2
+                  ahmf(ji,jj,jk) = MIN( ahmf(ji,jj,jk),                                    zdelta * zstabf_up )   ! Impose upper limit == maxfac  * L^2/(4*2dt)
+                  !
+               END_2D
                !
             END DO
@@ -486,14 +471,10 @@
             !                          ! effective default limits are 1/12 |U|L^3 < B_hm < 1//(32*2dt) L^4
             DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     ahmt(ji,jj,jk) = SQRT( r1_8 * esqt(ji,jj) * ahmt(ji,jj,jk) )
-                  END DO
-               END DO
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1
-                     ahmf(ji,jj,jk) = SQRT( r1_8 * esqf(ji,jj) * ahmf(ji,jj,jk) )
-                  END DO
-               END DO
+               DO_2D_00_00
+                  ahmt(ji,jj,jk) = SQRT( r1_8 * esqt(ji,jj) * ahmt(ji,jj,jk) )
+               END_2D
+               DO_2D_10_10
+                  ahmf(ji,jj,jk) = SQRT( r1_8 * esqf(ji,jj) * ahmf(ji,jj,jk) )
+               END_2D
             END DO
             !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/LDF/ldfslp.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/LDF/ldfslp.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/LDF/ldfslp.F90	(revision 12928)
@@ -21,4 +21,5 @@
    !!----------------------------------------------------------------------
    USE oce            ! ocean dynamics and tracers
+   USE isf_oce        ! ice shelf
    USE dom_oce        ! ocean space and time domain
 !   USE ldfdyn         ! lateral diffusion: eddy viscosity coef.
@@ -73,5 +74,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -81,5 +82,5 @@
 CONTAINS
 
-   SUBROUTINE ldf_slp( kt, prd, pn2 )
+   SUBROUTINE ldf_slp( kt, prd, pn2, Kbb, Kmm )
       !!----------------------------------------------------------------------
       !!                 ***  ROUTINE ldf_slp  ***
@@ -107,4 +108,5 @@
       !!----------------------------------------------------------------------
       INTEGER , INTENT(in)                   ::   kt    ! ocean time-step index
+      INTEGER , INTENT(in)                   ::   Kbb, Kmm   ! ocean time level indices
       REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   prd   ! in situ density
       REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   pn2   ! Brunt-Vaisala frequency (locally ref.)
@@ -134,27 +136,19 @@
       zwz(:,:,:) = 0._wp
       !
-      DO jk = 1, jpk             !==   i- & j-gradient of density   ==!
-         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
+      DO_3D_10_10( 1, jpk )
+         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_3D
       IF( ln_zps ) THEN                           ! partial steps correction at the bottom ocean level
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj)
-               zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj)
-            END DO
-         END DO
+         DO_2D_10_10
+            zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj)
+            zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj)
+         END_2D
       ENDIF
       IF( ln_zps .AND. ln_isfcav ) THEN           ! partial steps correction at the bottom ocean level
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               IF( miku(ji,jj) > 1 )   zgru(ji,jj,miku(ji,jj)) = grui(ji,jj) 
-               IF( mikv(ji,jj) > 1 )   zgrv(ji,jj,mikv(ji,jj)) = grvi(ji,jj)
-            END DO
-         END DO
+         DO_2D_10_10
+            IF( miku(ji,jj) > 1 )   zgru(ji,jj,miku(ji,jj)) = grui(ji,jj) 
+            IF( mikv(ji,jj) > 1 )   zgrv(ji,jj,mikv(ji,jj)) = grvi(ji,jj)
+         END_2D
       ENDIF
       !
@@ -171,5 +165,5 @@
       !
       !                          !==   Slopes just below the mixed layer   ==!
-      CALL ldf_slp_mxl( prd, pn2, zgru, zgrv, zdzr )        ! output: uslpml, vslpml, wslpiml, wslpjml
+      CALL ldf_slp_mxl( prd, pn2, zgru, zgrv, zdzr, Kmm )        ! output: uslpml, vslpml, wslpiml, wslpjml
 
 
@@ -178,78 +172,74 @@
       !
       IF ( ln_isfcav ) THEN
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zslpml_hmlpu(ji,jj) = uslpml(ji,jj) / ( MAX(hmlpt  (ji,jj), hmlpt  (ji+1,jj  ), 5._wp) &
-                  &                                  - MAX(risfdep(ji,jj), risfdep(ji+1,jj  )       ) ) 
-               zslpml_hmlpv(ji,jj) = vslpml(ji,jj) / ( MAX(hmlpt  (ji,jj), hmlpt  (ji  ,jj+1), 5._wp) &
-                  &                                  - MAX(risfdep(ji,jj), risfdep(ji  ,jj+1)       ) )
-            END DO
-         END DO
+         DO_2D_00_00
+            zslpml_hmlpu(ji,jj) = uslpml(ji,jj) / ( MAX(hmlpt  (ji,jj), hmlpt  (ji+1,jj  ), 5._wp) &
+               &                                  - MAX(risfdep(ji,jj), risfdep(ji+1,jj  )       ) ) 
+            zslpml_hmlpv(ji,jj) = vslpml(ji,jj) / ( MAX(hmlpt  (ji,jj), hmlpt  (ji  ,jj+1), 5._wp) &
+               &                                  - MAX(risfdep(ji,jj), risfdep(ji  ,jj+1)       ) )
+         END_2D
       ELSE
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zslpml_hmlpu(ji,jj) = uslpml(ji,jj) / MAX(hmlpt(ji,jj), hmlpt(ji+1,jj  ), 5._wp)
-               zslpml_hmlpv(ji,jj) = vslpml(ji,jj) / MAX(hmlpt(ji,jj), hmlpt(ji  ,jj+1), 5._wp)
-            END DO
-         END DO
+         DO_2D_00_00
+            zslpml_hmlpu(ji,jj) = uslpml(ji,jj) / MAX(hmlpt(ji,jj), hmlpt(ji+1,jj  ), 5._wp)
+            zslpml_hmlpv(ji,jj) = vslpml(ji,jj) / MAX(hmlpt(ji,jj), hmlpt(ji  ,jj+1), 5._wp)
+         END_2D
       END IF
 
-      DO jk = 2, jpkm1                            !* Slopes 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 = zgru(ji,jj,jk) * r1_e1u(ji,jj)
-               zav = zgrv(ji,jj,jk) * r1_e2v(ji,jj)
-               zbu = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji+1,jj  ,jk) )
-               zbv = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(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, - z1_slpmax * ABS( zau ) , -7.e+3_wp/e3u_n(ji,jj,jk)* ABS( zau )  )
-               zbv = MIN(  zbv, - z1_slpmax * ABS( zav ) , -7.e+3_wp/e3v_n(ji,jj,jk)* ABS( zav )  )
-               !                                      ! uslp and vslp output in zwz and zww, resp.
-               zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) )
-               zfj = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) )
-               ! thickness of water column between surface and level k at u/v point
-               zdepu = 0.5_wp * ( ( gdept_n (ji,jj,jk) + gdept_n (ji+1,jj,jk) )                            &
-                                - 2 * MAX( risfdep(ji,jj), risfdep(ji+1,jj) ) - e3u_n(ji,jj,miku(ji,jj))   )
-               zdepv = 0.5_wp * ( ( gdept_n (ji,jj,jk) + gdept_n (ji,jj+1,jk) )                            &
-                                - 2 * MAX( risfdep(ji,jj), risfdep(ji,jj+1) ) - e3v_n(ji,jj,mikv(ji,jj))   )
-               !
-               zwz(ji,jj,jk) = ( ( 1._wp - zfi) * zau / ( zbu - zeps )                                     &
-                  &                      + zfi  * zdepu * zslpml_hmlpu(ji,jj) ) * umask(ji,jj,jk)
-               zww(ji,jj,jk) = ( ( 1._wp - zfj) * zav / ( zbv - zeps )                                     &
-                  &                      + zfj  * zdepv * zslpml_hmlpv(ji,jj) ) * vmask(ji,jj,jk)
+      DO_3D_00_00( 2, jpkm1 )
+         !                                      ! horizontal and vertical density gradient at u- and v-points
+         zau = zgru(ji,jj,jk) * r1_e1u(ji,jj)
+         zav = zgrv(ji,jj,jk) * r1_e2v(ji,jj)
+         zbu = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji+1,jj  ,jk) )
+         zbv = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(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, - z1_slpmax * ABS( zau ) , -7.e+3_wp/e3u(ji,jj,jk,Kmm)* ABS( zau )  )
+         zbv = MIN(  zbv, - z1_slpmax * ABS( zav ) , -7.e+3_wp/e3v(ji,jj,jk,Kmm)* ABS( zav )  )
+         !                                      ! Fred Dupont: add a correction for bottom partial steps:
+         !                                      !              max slope = 1/2 * e3 / e1
+         IF (ln_zps .AND. jk==mbku(ji,jj)) &
+            zbu = MIN(  zbu, - z1_slpmax * ABS( zau ) , - 2._wp * e1u(ji,jj) / e3u(ji,jj,jk,Kmm)* ABS( zau )  )
+         IF (ln_zps .AND. jk==mbkv(ji,jj)) &
+            zbv = MIN(  zbv, - z1_slpmax * ABS( zav ) , - 2._wp * e2v(ji,jj) / e3v(ji,jj,jk,Kmm)* ABS( zav )  )
+         !                                      ! uslp and vslp output in zwz and zww, resp.
+         zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) )
+         zfj = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) )
+         ! thickness of water column between surface and level k at u/v point
+         zdepu = 0.5_wp * ( ( gdept (ji,jj,jk,Kmm) + gdept (ji+1,jj,jk,Kmm) )                            &
+                          - 2 * MAX( risfdep(ji,jj), risfdep(ji+1,jj) ) - e3u(ji,jj,miku(ji,jj),Kmm)   )
+         zdepv = 0.5_wp * ( ( gdept (ji,jj,jk,Kmm) + gdept (ji,jj+1,jk,Kmm) )                            &
+                          - 2 * MAX( risfdep(ji,jj), risfdep(ji,jj+1) ) - e3v(ji,jj,mikv(ji,jj),Kmm)   )
+         !
+         zwz(ji,jj,jk) = ( ( 1._wp - zfi) * zau / ( zbu - zeps )                                     &
+            &                      + zfi  * zdepu * zslpml_hmlpu(ji,jj) ) * umask(ji,jj,jk)
+         zww(ji,jj,jk) = ( ( 1._wp - zfj) * zav / ( zbv - zeps )                                     &
+            &                      + zfj  * zdepv * zslpml_hmlpv(ji,jj) ) * vmask(ji,jj,jk)
 !!gm  modif to suppress omlmask.... (as in Griffies case)
 !               !                                         ! jk must be >= ML level for zf=1. otherwise  zf=0.
 !               zfi = REAL( 1 - 1/(1 + jk / MAX( nmln(ji+1,jj), nmln(ji,jj) ) ), wp )
 !               zfj = REAL( 1 - 1/(1 + jk / MAX( nmln(ji,jj+1), nmln(ji,jj) ) ), wp )
-!               zci = 0.5 * ( gdept_n(ji+1,jj,jk)+gdept_n(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 10. ) )
-!               zcj = 0.5 * ( gdept_n(ji,jj+1,jk)+gdept_n(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 10. ) )
+!               zci = 0.5 * ( gdept(ji+1,jj,jk,Kmm)+gdept(ji,jj,jk,Kmm) ) / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 10. ) )
+!               zcj = 0.5 * ( gdept(ji,jj+1,jk,Kmm)+gdept(ji,jj,jk,Kmm) ) / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 10. ) )
 !               zwz(ji,jj,jk) = ( zfi * zai / ( zbi - zeps ) + ( 1._wp - zfi ) * wslpiml(ji,jj) * zci ) * tmask(ji,jj,jk)
 !               zww(ji,jj,jk) = ( zfj * zaj / ( zbj - zeps ) + ( 1._wp - zfj ) * wslpjml(ji,jj) * zcj ) * tmask(ji,jj,jk)
 !!gm end modif
-            END DO
-         END DO
-      END DO
+      END_3D
       CALL lbc_lnk_multi( 'ldfslp', zwz, 'U', -1.,  zww, 'V', -1. )      ! lateral boundary conditions
       !
       !                                            !* horizontal Shapiro filter
       DO jk = 2, jpkm1
-         DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only
-            DO ji = 2, jpim1
-               uslp(ji,jj,jk) = z1_16 * (        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)                       )
-               vslp(ji,jj,jk) = z1_16 * (        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_2D_00_00
+            uslp(ji,jj,jk) = z1_16 * (        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)                       )
+            vslp(ji,jj,jk) = z1_16 * (        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_2D
          DO jj = 3, jpj-2                               ! other rows
-            DO ji = fs_2, fs_jpim1   ! vector opt.
+            DO ji = 2, jpim1   ! vector opt.
                uslp(ji,jj,jk) = z1_16 * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      &
                   &                       +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      &
@@ -265,12 +255,10 @@
          END DO
          !                                        !* decrease along coastal boundaries
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               uslp(ji,jj,jk) = uslp(ji,jj,jk) * ( umask(ji,jj+1,jk) + umask(ji,jj-1,jk  ) ) * 0.5_wp   &
-                  &                            * ( umask(ji,jj  ,jk) + umask(ji,jj  ,jk+1) ) * 0.5_wp
-               vslp(ji,jj,jk) = vslp(ji,jj,jk) * ( vmask(ji+1,jj,jk) + vmask(ji-1,jj,jk  ) ) * 0.5_wp   &
-                  &                            * ( vmask(ji  ,jj,jk) + vmask(ji  ,jj,jk+1) ) * 0.5_wp
-            END DO
-         END DO
+         DO_2D_00_00
+            uslp(ji,jj,jk) = uslp(ji,jj,jk) * ( umask(ji,jj+1,jk) + umask(ji,jj-1,jk  ) ) * 0.5_wp   &
+               &                            * ( umask(ji,jj  ,jk) + umask(ji,jj  ,jk+1) ) * 0.5_wp
+            vslp(ji,jj,jk) = vslp(ji,jj,jk) * ( vmask(ji+1,jj,jk) + vmask(ji-1,jj,jk  ) ) * 0.5_wp   &
+               &                            * ( vmask(ji  ,jj,jk) + vmask(ji  ,jj,jk+1) ) * 0.5_wp
+         END_2D
       END DO
 
@@ -279,28 +267,26 @@
       ! ===========================      | wslpj = mij( d/dj( prd ) / d/dz( prd )
       !
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               !                                  !* Local vertical density gradient evaluated from N^2
-               zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. )
-               !                                  !* Slopes at w point
-               !                                        ! i- & j-gradient of density at w-points
-               zci = MAX(  umask(ji-1,jj,jk  ) + umask(ji,jj,jk  )           &
-                  &      + umask(ji-1,jj,jk-1) + umask(ji,jj,jk-1) , zeps  ) * e1t(ji,jj)
-               zcj = MAX(  vmask(ji,jj-1,jk  ) + vmask(ji,jj,jk-1)           &
-                  &      + vmask(ji,jj-1,jk-1) + vmask(ji,jj,jk  ) , zeps  ) * e2t(ji,jj)
-               zai =    (  zgru (ji-1,jj,jk  ) + zgru (ji,jj,jk-1)           &
-                  &      + zgru (ji-1,jj,jk-1) + zgru (ji,jj,jk  )   ) / zci * wmask (ji,jj,jk)
-               zaj =    (  zgrv (ji,jj-1,jk  ) + zgrv (ji,jj,jk-1)           &
-                  &      + zgrv (ji,jj-1,jk-1) + zgrv (ji,jj,jk  )   ) / zcj * wmask (ji,jj,jk)
-               !                                        ! bound the slopes: abs(zw.)<= 1/100 and zb..<0.
-               !                                        ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
-               zbi = MIN( zbw ,- 100._wp* ABS( zai ) , -7.e+3_wp/e3w_n(ji,jj,jk)* ABS( zai )  )
-               zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/e3w_n(ji,jj,jk)* ABS( zaj )  )
-               !                                        ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.)
-               zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) )   ! zfk=1 in the ML otherwise zfk=0
-               zck = ( gdepw_n(ji,jj,jk) - gdepw_n(ji,jj,mikt(ji,jj) ) ) / MAX( hmlp(ji,jj) - gdepw_n(ji,jj,mikt(ji,jj)), 10._wp )
-               zwz(ji,jj,jk) = (  zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk  ) * wmask(ji,jj,jk)
-               zww(ji,jj,jk) = (  zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk  ) * wmask(ji,jj,jk)
+      DO_3D_00_00( 2, jpkm1 )
+         !                                  !* Local vertical density gradient evaluated from N^2
+         zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. )
+         !                                  !* Slopes at w point
+         !                                        ! i- & j-gradient of density at w-points
+         zci = MAX(  umask(ji-1,jj,jk  ) + umask(ji,jj,jk  )           &
+            &      + umask(ji-1,jj,jk-1) + umask(ji,jj,jk-1) , zeps  ) * e1t(ji,jj)
+         zcj = MAX(  vmask(ji,jj-1,jk  ) + vmask(ji,jj,jk-1)           &
+            &      + vmask(ji,jj-1,jk-1) + vmask(ji,jj,jk  ) , zeps  ) * e2t(ji,jj)
+         zai =    (  zgru (ji-1,jj,jk  ) + zgru (ji,jj,jk-1)           &
+            &      + zgru (ji-1,jj,jk-1) + zgru (ji,jj,jk  )   ) / zci * wmask (ji,jj,jk)
+         zaj =    (  zgrv (ji,jj-1,jk  ) + zgrv (ji,jj,jk-1)           &
+            &      + zgrv (ji,jj-1,jk-1) + zgrv (ji,jj,jk  )   ) / zcj * wmask (ji,jj,jk)
+         !                                        ! bound the slopes: abs(zw.)<= 1/100 and zb..<0.
+         !                                        ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+         zbi = MIN( zbw ,- 100._wp* ABS( zai ) , -7.e+3_wp/e3w(ji,jj,jk,Kmm)* ABS( zai )  )
+         zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/e3w(ji,jj,jk,Kmm)* ABS( zaj )  )
+         !                                        ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.)
+         zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) )   ! zfk=1 in the ML otherwise zfk=0
+         zck = ( gdepw(ji,jj,jk,Kmm) - gdepw(ji,jj,mikt(ji,jj),Kmm) ) / MAX( hmlp(ji,jj) - gdepw(ji,jj,mikt(ji,jj),Kmm), 10._wp )
+         zwz(ji,jj,jk) = (  zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk  ) * wmask(ji,jj,jk)
+         zww(ji,jj,jk) = (  zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk  ) * wmask(ji,jj,jk)
 
 !!gm  modif to suppress omlmask....  (as in Griffies operator)
@@ -311,29 +297,25 @@
 !               zww(ji,jj,jk) = ( zfk * zaj / ( zbj - zeps ) + ( 1._wp - zfk ) * wslpjml(ji,jj) * zck ) * tmask(ji,jj,jk)
 !!gm end modif
-            END DO
-         END DO
-      END DO
+      END_3D
       CALL lbc_lnk_multi( 'ldfslp', zwz, 'T', -1.,  zww, 'T', -1. )      ! lateral boundary conditions
       !
       !                                           !* horizontal Shapiro filter
       DO jk = 2, jpkm1
-         DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only
-            DO ji = 2, jpim1
-               zcofw = wmask(ji,jj,jk) * z1_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_2D_00_00
+            zcofw = wmask(ji,jj,jk) * z1_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_2D
          DO jj = 3, jpj-2                               ! other rows
-            DO ji = fs_2, fs_jpim1   ! vector opt.
+            DO ji = 2, jpim1   ! vector opt.
                zcofw = wmask(ji,jj,jk) * z1_16
                wslpi(ji,jj,jk) = (         zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     &
@@ -351,12 +333,10 @@
          END DO
          !                                        !* decrease in vicinity of topography
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zck =   ( umask(ji,jj,jk) + umask(ji-1,jj,jk) )   &
-                  &  * ( vmask(ji,jj,jk) + vmask(ji,jj-1,jk) ) * 0.25
-               wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * zck
-               wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * zck
-            END DO
-         END DO
+         DO_2D_00_00
+            zck =   ( umask(ji,jj,jk) + umask(ji-1,jj,jk) )   &
+               &  * ( vmask(ji,jj,jk) + vmask(ji,jj-1,jk) ) * 0.25
+            wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * zck
+            wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * zck
+         END_2D
       END DO
 
@@ -365,5 +345,5 @@
       CALL lbc_lnk_multi( 'ldfslp', uslp , 'U', -1. , vslp , 'V', -1. , wslpi, 'W', -1., wslpj, 'W', -1. )
 
-      IF(ln_ctl) THEN
+      IF(sn_cfctl%l_prtctl) THEN
          CALL prt_ctl(tab3d_1=uslp , clinfo1=' slp  - u : ', tab3d_2=vslp,  clinfo2=' v : ', kdim=jpk)
          CALL prt_ctl(tab3d_1=wslpi, clinfo1=' slp  - wi: ', tab3d_2=wslpj, clinfo2=' wj: ', kdim=jpk)
@@ -375,5 +355,5 @@
 
 
-   SUBROUTINE ldf_slp_triad ( kt )
+   SUBROUTINE ldf_slp_triad ( kt, Kbb, Kmm )
       !!----------------------------------------------------------------------
       !!                 ***  ROUTINE ldf_slp_triad  ***
@@ -390,4 +370,5 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT( in ) ::   kt             ! ocean time-step index
+      INTEGER , INTENT(in)  ::   Kbb, Kmm       ! ocean time level indices
       !!
       INTEGER  ::   ji, jj, jk, jl, ip, jp, kp  ! dummy loop indices
@@ -402,5 +383,4 @@
       REAL(wp) ::   zbeta0, ze3_e1, ze3_e2
       REAL(wp), DIMENSION(jpi,jpj)     ::   z1_mlbw
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zalbet
       REAL(wp), DIMENSION(jpi,jpj,jpk,0:1) ::   zdxrho , zdyrho, zdzrho     ! Horizontal and vertical density gradients
       REAL(wp), DIMENSION(jpi,jpj,0:1,0:1) ::   zti_mlb, ztj_mlb            ! for Griffies operator only
@@ -416,31 +396,25 @@
          !
          ip = jl   ;   jp = jl                ! guaranteed nonzero gradients ( absolute value larger than repsln)
-         DO jk = 1, jpkm1                     ! done each pair of triad
-            DO jj = 1, jpjm1                  ! NB: not masked ==>  a minimum value is set
-               DO ji = 1, fs_jpim1            ! vector opt.
-                  zdit = ( tsb(ji+1,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )    ! i-gradient of T & S at u-point
-                  zdis = ( tsb(ji+1,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
-                  zdjt = ( tsb(ji,jj+1,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )    ! j-gradient of T & S at v-point
-                  zdjs = ( tsb(ji,jj+1,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
-                  zdxrho_raw = ( - rab_b(ji+ip,jj   ,jk,jp_tem) * zdit + rab_b(ji+ip,jj   ,jk,jp_sal) * zdis ) * r1_e1u(ji,jj)
-                  zdyrho_raw = ( - rab_b(ji   ,jj+jp,jk,jp_tem) * zdjt + rab_b(ji   ,jj+jp,jk,jp_sal) * zdjs ) * r1_e2v(ji,jj)
-                  zdxrho(ji+ip,jj   ,jk,1-ip) = SIGN(  MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw  )   ! keep the sign
-                  zdyrho(ji   ,jj+jp,jk,1-jp) = SIGN(  MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw  )
-               END DO
-            END DO
-         END DO
+         DO_3D_10_10( 1, jpkm1 )
+            zdit = ( ts(ji+1,jj,jk,jp_tem,Kbb) - ts(ji,jj,jk,jp_tem,Kbb) )    ! i-gradient of T & S at u-point
+            zdis = ( ts(ji+1,jj,jk,jp_sal,Kbb) - ts(ji,jj,jk,jp_sal,Kbb) )
+            zdjt = ( ts(ji,jj+1,jk,jp_tem,Kbb) - ts(ji,jj,jk,jp_tem,Kbb) )    ! j-gradient of T & S at v-point
+            zdjs = ( ts(ji,jj+1,jk,jp_sal,Kbb) - ts(ji,jj,jk,jp_sal,Kbb) )
+            zdxrho_raw = ( - rab_b(ji+ip,jj   ,jk,jp_tem) * zdit + rab_b(ji+ip,jj   ,jk,jp_sal) * zdis ) * r1_e1u(ji,jj)
+            zdyrho_raw = ( - rab_b(ji   ,jj+jp,jk,jp_tem) * zdjt + rab_b(ji   ,jj+jp,jk,jp_sal) * zdjs ) * r1_e2v(ji,jj)
+            zdxrho(ji+ip,jj   ,jk,1-ip) = SIGN(  MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw  )   ! keep the sign
+            zdyrho(ji   ,jj+jp,jk,1-jp) = SIGN(  MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw  )
+         END_3D
          !
          IF( ln_zps .AND. l_grad_zps ) THEN     ! partial steps: correction of i- & j-grad on bottom
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  iku  = mbku(ji,jj)          ;   ikv  = mbkv(ji,jj)             ! last ocean level (u- & v-points)
-                  zdit = gtsu(ji,jj,jp_tem)   ;   zdjt = gtsv(ji,jj,jp_tem)      ! i- & j-gradient of Temperature
-                  zdis = gtsu(ji,jj,jp_sal)   ;   zdjs = gtsv(ji,jj,jp_sal)      ! i- & j-gradient of Salinity
-                  zdxrho_raw = ( - rab_b(ji+ip,jj   ,iku,jp_tem) * zdit + rab_b(ji+ip,jj   ,iku,jp_sal) * zdis ) * r1_e1u(ji,jj)
-                  zdyrho_raw = ( - rab_b(ji   ,jj+jp,ikv,jp_tem) * zdjt + rab_b(ji   ,jj+jp,ikv,jp_sal) * zdjs ) * r1_e2v(ji,jj)
-                  zdxrho(ji+ip,jj   ,iku,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw )   ! keep the sign
-                  zdyrho(ji   ,jj+jp,ikv,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw )
-               END DO
-            END DO
+            DO_2D_10_10
+               iku  = mbku(ji,jj)          ;   ikv  = mbkv(ji,jj)             ! last ocean level (u- & v-points)
+               zdit = gtsu(ji,jj,jp_tem)   ;   zdjt = gtsv(ji,jj,jp_tem)      ! i- & j-gradient of Temperature
+               zdis = gtsu(ji,jj,jp_sal)   ;   zdjs = gtsv(ji,jj,jp_sal)      ! i- & j-gradient of Salinity
+               zdxrho_raw = ( - rab_b(ji+ip,jj   ,iku,jp_tem) * zdit + rab_b(ji+ip,jj   ,iku,jp_sal) * zdis ) * r1_e1u(ji,jj)
+               zdyrho_raw = ( - rab_b(ji   ,jj+jp,ikv,jp_tem) * zdjt + rab_b(ji   ,jj+jp,ikv,jp_sal) * zdjs ) * r1_e2v(ji,jj)
+               zdxrho(ji+ip,jj   ,iku,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw )   ! keep the sign
+               zdyrho(ji   ,jj+jp,ikv,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw )
+            END_2D
          ENDIF
          !
@@ -448,29 +422,23 @@
 
       DO kp = 0, 1                            !==  unmasked before density i- j-, k-gradients  ==!
-         DO jk = 1, jpkm1                     ! done each pair of triad
-            DO jj = 1, jpj                    ! NB: not masked ==>  a minimum value is set
-               DO ji = 1, jpi                 ! vector opt.
-                  IF( jk+kp > 1 ) THEN        ! k-gradient of T & S a jk+kp
-                     zdkt = ( tsb(ji,jj,jk+kp-1,jp_tem) - tsb(ji,jj,jk+kp,jp_tem) )
-                     zdks = ( tsb(ji,jj,jk+kp-1,jp_sal) - tsb(ji,jj,jk+kp,jp_sal) )
-                  ELSE
-                     zdkt = 0._wp                                             ! 1st level gradient set to zero
-                     zdks = 0._wp
-                  ENDIF
-                  zdzrho_raw = ( - rab_b(ji,jj,jk+kp,jp_tem) * zdkt & 
-                             &   + rab_b(ji,jj,jk+kp,jp_sal) * zdks &
-                             & ) / e3w_n(ji,jj,jk+kp)  
-                  zdzrho(ji,jj,jk,kp) = - MIN( - repsln , zdzrho_raw )    ! force zdzrho >= repsln
-                 END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, jpkm1 )
+            IF( jk+kp > 1 ) THEN        ! k-gradient of T & S a jk+kp
+               zdkt = ( ts(ji,jj,jk+kp-1,jp_tem,Kbb) - ts(ji,jj,jk+kp,jp_tem,Kbb) )
+               zdks = ( ts(ji,jj,jk+kp-1,jp_sal,Kbb) - ts(ji,jj,jk+kp,jp_sal,Kbb) )
+            ELSE
+               zdkt = 0._wp                                             ! 1st level gradient set to zero
+               zdks = 0._wp
+            ENDIF
+            zdzrho_raw = ( - rab_b(ji,jj,jk   ,jp_tem) * zdkt & 
+                       &   + rab_b(ji,jj,jk   ,jp_sal) * zdks &
+                       & ) / e3w(ji,jj,jk+kp,Kmm)  
+            zdzrho(ji,jj,jk,kp) = - MIN( - repsln , zdzrho_raw )    ! force zdzrho >= repsln
+         END_3D
       END DO
       !
-      DO jj = 1, jpj                          !==  Reciprocal depth of the w-point below ML base  ==!
-         DO ji = 1, jpi
-            jk = MIN( nmln(ji,jj), mbkt(ji,jj) ) + 1     ! MIN in case ML depth is the ocean depth
-            z1_mlbw(ji,jj) = 1._wp / gdepw_n(ji,jj,jk)
-         END DO
-      END DO
+      DO_2D_11_11
+         jk = MIN( nmln(ji,jj), mbkt(ji,jj) ) + 1     ! MIN in case ML depth is the ocean depth
+         z1_mlbw(ji,jj) = 1._wp / gdepw(ji,jj,jk,Kmm)
+      END_2D
       !
       !                                       !==  intialisations to zero  ==!
@@ -489,30 +457,28 @@
       DO jl = 0, 1                            ! calculate slope of the 4 triads immediately ONE level below mixed-layer base
          DO kp = 0, 1                         ! with only the slope-max limit   and   MASKED
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1
-                  ip = jl   ;   jp = jl
-                  !
-                  jk = nmln(ji+ip,jj) + 1
-                  IF( jk > mbkt(ji+ip,jj) ) THEN   ! ML reaches bottom
-                     zti_mlb(ji+ip,jj   ,1-ip,kp) = 0.0_wp
-                  ELSE                             
-                     ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth)
-                     zti_g_raw = (  zdxrho(ji+ip,jj,jk-kp,1-ip) / zdzrho(ji+ip,jj,jk-kp,kp)      &
-                        &          - ( gdept_n(ji+1,jj,jk-kp) - gdept_n(ji,jj,jk-kp) ) * r1_e1u(ji,jj)  ) * umask(ji,jj,jk)
-                     ze3_e1    =  e3w_n(ji+ip,jj,jk-kp) * r1_e1u(ji,jj) 
-                     zti_mlb(ji+ip,jj   ,1-ip,kp) = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e1  , ABS( zti_g_raw ) ), zti_g_raw )
-                  ENDIF
-                  !
-                  jk = nmln(ji,jj+jp) + 1
-                  IF( jk >  mbkt(ji,jj+jp) ) THEN  !ML reaches bottom
-                     ztj_mlb(ji   ,jj+jp,1-jp,kp) = 0.0_wp
-                  ELSE
-                     ztj_g_raw = (  zdyrho(ji,jj+jp,jk-kp,1-jp) / zdzrho(ji,jj+jp,jk-kp,kp)      &
-                        &      - ( gdept_n(ji,jj+1,jk-kp) - gdept_n(ji,jj,jk-kp) ) / e2v(ji,jj)  ) * vmask(ji,jj,jk)
-                     ze3_e2    =  e3w_n(ji,jj+jp,jk-kp) / e2v(ji,jj)
-                     ztj_mlb(ji   ,jj+jp,1-jp,kp) = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e2  , ABS( ztj_g_raw ) ), ztj_g_raw )
-                  ENDIF
-               END DO
-            END DO
+            DO_2D_10_10
+               ip = jl   ;   jp = jl
+               !
+               jk = nmln(ji+ip,jj) + 1
+               IF( jk > mbkt(ji+ip,jj) ) THEN   ! ML reaches bottom
+                  zti_mlb(ji+ip,jj   ,1-ip,kp) = 0.0_wp
+               ELSE                             
+                  ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth)
+                  zti_g_raw = (  zdxrho(ji+ip,jj,jk-kp,1-ip) / zdzrho(ji+ip,jj,jk-kp,kp)      &
+                     &          - ( gdept(ji+1,jj,jk-kp,Kmm) - gdept(ji,jj,jk-kp,Kmm) ) * r1_e1u(ji,jj)  ) * umask(ji,jj,jk)
+                  ze3_e1    =  e3w(ji+ip,jj,jk-kp,Kmm) * r1_e1u(ji,jj) 
+                  zti_mlb(ji+ip,jj   ,1-ip,kp) = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e1  , ABS( zti_g_raw ) ), zti_g_raw )
+               ENDIF
+               !
+               jk = nmln(ji,jj+jp) + 1
+               IF( jk >  mbkt(ji,jj+jp) ) THEN  !ML reaches bottom
+                  ztj_mlb(ji   ,jj+jp,1-jp,kp) = 0.0_wp
+               ELSE
+                  ztj_g_raw = (  zdyrho(ji,jj+jp,jk-kp,1-jp) / zdzrho(ji,jj+jp,jk-kp,kp)      &
+                     &      - ( gdept(ji,jj+1,jk-kp,Kmm) - gdept(ji,jj,jk-kp,Kmm) ) / e2v(ji,jj)  ) * vmask(ji,jj,jk)
+                  ze3_e2    =  e3w(ji,jj+jp,jk-kp,Kmm) / e2v(ji,jj)
+                  ztj_mlb(ji   ,jj+jp,1-jp,kp) = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e2  , ABS( ztj_g_raw ) ), ztj_g_raw )
+               ENDIF
+            END_2D
          END DO
       END DO
@@ -528,81 +494,79 @@
                ! Must mask contribution to slope from dz/dx at constant s for triads jk=1,kp=0 that poke up though ocean surface
                znot_thru_surface = REAL( 1-1/(jk+kp), wp )  !jk+kp=1,=0.; otherwise=1.0
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1         ! vector opt.
-                     !
-                     ! Calculate slope relative to geopotentials used for GM skew fluxes
-                     ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth)
-                     ! Limit by slope *relative to geopotentials* by rn_slpmax, and mask by psi-point
-                     ! masked by umask taken at the level of dz(rho)
-                     !
-                     ! raw slopes: unmasked unbounded slopes (relative to geopotential (zti_g) and model surface (zti)
-                     !
-                     zti_raw   = zdxrho(ji+ip,jj   ,jk,1-ip) / zdzrho(ji+ip,jj   ,jk,kp)                   ! unmasked
-                     ztj_raw   = zdyrho(ji   ,jj+jp,jk,1-jp) / zdzrho(ji   ,jj+jp,jk,kp)
-                     !
-                     ! Must mask contribution to slope for triad jk=1,kp=0 that poke up though ocean surface
-                     zti_coord = znot_thru_surface * ( gdept_n(ji+1,jj  ,jk) - gdept_n(ji,jj,jk) ) * r1_e1u(ji,jj)
-                     ztj_coord = znot_thru_surface * ( gdept_n(ji  ,jj+1,jk) - gdept_n(ji,jj,jk) ) * r1_e2v(ji,jj)     ! unmasked
-                     zti_g_raw = zti_raw - zti_coord      ! ref to geopot surfaces
-                     ztj_g_raw = ztj_raw - ztj_coord
-                     ! additional limit required in bilaplacian case
-                     ze3_e1    = e3w_n(ji+ip,jj   ,jk+kp) * r1_e1u(ji,jj)
-                     ze3_e2    = e3w_n(ji   ,jj+jp,jk+kp) * r1_e2v(ji,jj)
-                     ! NB: hard coded factor 5 (can be a namelist parameter...)
-                     zti_g_lim = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e1, ABS( zti_g_raw ) ), zti_g_raw )
-                     ztj_g_lim = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e2, ABS( ztj_g_raw ) ), ztj_g_raw )
-                     !
-                     ! Below  ML use limited zti_g as is & mask
-                     ! Inside ML replace by linearly reducing sx_mlb towards surface & mask
-                     !
-                     zfacti = REAL( 1 - 1/(1 + (jk+kp-1)/nmln(ji+ip,jj)), wp )  ! k index of uppermost point(s) of triad is jk+kp-1
-                     zfactj = REAL( 1 - 1/(1 + (jk+kp-1)/nmln(ji,jj+jp)), wp )  ! must be .ge. nmln(ji,jj) for zfact=1
-                     !                                                          !                   otherwise  zfact=0
-                     zti_g_lim =          ( zfacti   * zti_g_lim                       &
-                        &      + ( 1._wp - zfacti ) * zti_mlb(ji+ip,jj,1-ip,kp)   &
-                        &                           * gdepw_n(ji+ip,jj,jk+kp) * z1_mlbw(ji+ip,jj) ) * umask(ji,jj,jk+kp)
-                     ztj_g_lim =          ( zfactj   * ztj_g_lim                       &
-                        &      + ( 1._wp - zfactj ) * ztj_mlb(ji,jj+jp,1-jp,kp)   &
-                        &                           * gdepw_n(ji,jj+jp,jk+kp) * z1_mlbw(ji,jj+jp) ) * vmask(ji,jj,jk+kp)
-                     !
-                     triadi_g(ji+ip,jj   ,jk,1-ip,kp) = zti_g_lim
-                     triadj_g(ji   ,jj+jp,jk,1-jp,kp) = ztj_g_lim
-                     !
-                     ! Get coefficients of isoneutral diffusion tensor
-                     ! 1. Utilise gradients *relative* to s-coordinate, so add t-point slopes (*subtract* depth gradients)
-                     ! 2. We require that isoneutral diffusion  gives no vertical buoyancy flux
-                     !     i.e. 33 term = (real slope* 31, 13 terms)
-                     ! To do this, retain limited sx**2  in vertical flux, but divide by real slope for 13/31 terms
-                     ! Equivalent to tapering A_iso = sx_limited**2/(real slope)**2
-                     !
-                     zti_lim  = ( zti_g_lim + zti_coord ) * umask(ji,jj,jk+kp)    ! remove coordinate slope => relative to coordinate surfaces
-                     ztj_lim  = ( ztj_g_lim + ztj_coord ) * vmask(ji,jj,jk+kp)
-                     !
-                     IF( ln_triad_iso ) THEN
-                        zti_raw = zti_lim*zti_lim / zti_raw
-                        ztj_raw = ztj_lim*ztj_lim / ztj_raw
-                        zti_raw = SIGN( MIN( ABS(zti_lim), ABS( zti_raw ) ), zti_raw )
-                        ztj_raw = SIGN( MIN( ABS(ztj_lim), ABS( ztj_raw ) ), ztj_raw )
-                        zti_lim = zfacti * zti_lim + ( 1._wp - zfacti ) * zti_raw
-                        ztj_lim = zfactj * ztj_lim + ( 1._wp - zfactj ) * ztj_raw
-                     ENDIF
-                     !                                      ! switching triad scheme 
-                     zisw = (1._wp - rn_sw_triad ) + rn_sw_triad    &
-                        &            * 2._wp * ABS( 0.5_wp - kp - ( 0.5_wp - ip ) * SIGN( 1._wp , zdxrho(ji+ip,jj,jk,1-ip) )  )
-                     zjsw = (1._wp - rn_sw_triad ) + rn_sw_triad    &
-                        &            * 2._wp * ABS( 0.5_wp - kp - ( 0.5_wp - jp ) * SIGN( 1._wp , zdyrho(ji,jj+jp,jk,1-jp) )  )
-                     !
-                     triadi(ji+ip,jj   ,jk,1-ip,kp) = zti_lim * zisw
-                     triadj(ji   ,jj+jp,jk,1-jp,kp) = ztj_lim * zjsw
-                     !
-                     zbu  = e1e2u(ji   ,jj   ) * e3u_n(ji   ,jj   ,jk   )
-                     zbv  = e1e2v(ji   ,jj   ) * e3v_n(ji   ,jj   ,jk   )
-                     zbti = e1e2t(ji+ip,jj   ) * e3w_n(ji+ip,jj   ,jk+kp)
-                     zbtj = e1e2t(ji   ,jj+jp) * e3w_n(ji   ,jj+jp,jk+kp)
-                     !
-                     wslp2(ji+ip,jj,jk+kp) = wslp2(ji+ip,jj,jk+kp) + 0.25_wp * zbu / zbti * zti_g_lim*zti_g_lim      ! masked
-                     wslp2(ji,jj+jp,jk+kp) = wslp2(ji,jj+jp,jk+kp) + 0.25_wp * zbv / zbtj * ztj_g_lim*ztj_g_lim
-                  END DO
-               END DO
+               DO_2D_10_10
+                  !
+                  ! Calculate slope relative to geopotentials used for GM skew fluxes
+                  ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth)
+                  ! Limit by slope *relative to geopotentials* by rn_slpmax, and mask by psi-point
+                  ! masked by umask taken at the level of dz(rho)
+                  !
+                  ! raw slopes: unmasked unbounded slopes (relative to geopotential (zti_g) and model surface (zti)
+                  !
+                  zti_raw   = zdxrho(ji+ip,jj   ,jk,1-ip) / zdzrho(ji+ip,jj   ,jk,kp)                   ! unmasked
+                  ztj_raw   = zdyrho(ji   ,jj+jp,jk,1-jp) / zdzrho(ji   ,jj+jp,jk,kp)
+                  !
+                  ! Must mask contribution to slope for triad jk=1,kp=0 that poke up though ocean surface
+                  zti_coord = znot_thru_surface * ( gdept(ji+1,jj  ,jk,Kmm) - gdept(ji,jj,jk,Kmm) ) * r1_e1u(ji,jj)
+                  ztj_coord = znot_thru_surface * ( gdept(ji  ,jj+1,jk,Kmm) - gdept(ji,jj,jk,Kmm) ) * r1_e2v(ji,jj)     ! unmasked
+                  zti_g_raw = zti_raw - zti_coord      ! ref to geopot surfaces
+                  ztj_g_raw = ztj_raw - ztj_coord
+                  ! additional limit required in bilaplacian case
+                  ze3_e1    = e3w(ji+ip,jj   ,jk+kp,Kmm) * r1_e1u(ji,jj)
+                  ze3_e2    = e3w(ji   ,jj+jp,jk+kp,Kmm) * r1_e2v(ji,jj)
+                  ! NB: hard coded factor 5 (can be a namelist parameter...)
+                  zti_g_lim = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e1, ABS( zti_g_raw ) ), zti_g_raw )
+                  ztj_g_lim = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e2, ABS( ztj_g_raw ) ), ztj_g_raw )
+                  !
+                  ! Below  ML use limited zti_g as is & mask
+                  ! Inside ML replace by linearly reducing sx_mlb towards surface & mask
+                  !
+                  zfacti = REAL( 1 - 1/(1 + (jk+kp-1)/nmln(ji+ip,jj)), wp )  ! k index of uppermost point(s) of triad is jk+kp-1
+                  zfactj = REAL( 1 - 1/(1 + (jk+kp-1)/nmln(ji,jj+jp)), wp )  ! must be .ge. nmln(ji,jj) for zfact=1
+                  !                                                          !                   otherwise  zfact=0
+                  zti_g_lim =          ( zfacti   * zti_g_lim                       &
+                     &      + ( 1._wp - zfacti ) * zti_mlb(ji+ip,jj,1-ip,kp)   &
+                     &                           * gdepw(ji+ip,jj,jk+kp,Kmm) * z1_mlbw(ji+ip,jj) ) * umask(ji,jj,jk+kp)
+                  ztj_g_lim =          ( zfactj   * ztj_g_lim                       &
+                     &      + ( 1._wp - zfactj ) * ztj_mlb(ji,jj+jp,1-jp,kp)   &
+                     &                           * gdepw(ji,jj+jp,jk+kp,Kmm) * z1_mlbw(ji,jj+jp) ) * vmask(ji,jj,jk+kp)
+                  !
+                  triadi_g(ji+ip,jj   ,jk,1-ip,kp) = zti_g_lim
+                  triadj_g(ji   ,jj+jp,jk,1-jp,kp) = ztj_g_lim
+                  !
+                  ! Get coefficients of isoneutral diffusion tensor
+                  ! 1. Utilise gradients *relative* to s-coordinate, so add t-point slopes (*subtract* depth gradients)
+                  ! 2. We require that isoneutral diffusion  gives no vertical buoyancy flux
+                  !     i.e. 33 term = (real slope* 31, 13 terms)
+                  ! To do this, retain limited sx**2  in vertical flux, but divide by real slope for 13/31 terms
+                  ! Equivalent to tapering A_iso = sx_limited**2/(real slope)**2
+                  !
+                  zti_lim  = ( zti_g_lim + zti_coord ) * umask(ji,jj,jk+kp)    ! remove coordinate slope => relative to coordinate surfaces
+                  ztj_lim  = ( ztj_g_lim + ztj_coord ) * vmask(ji,jj,jk+kp)
+                  !
+                  IF( ln_triad_iso ) THEN
+                     zti_raw = zti_lim*zti_lim / zti_raw
+                     ztj_raw = ztj_lim*ztj_lim / ztj_raw
+                     zti_raw = SIGN( MIN( ABS(zti_lim), ABS( zti_raw ) ), zti_raw )
+                     ztj_raw = SIGN( MIN( ABS(ztj_lim), ABS( ztj_raw ) ), ztj_raw )
+                     zti_lim = zfacti * zti_lim + ( 1._wp - zfacti ) * zti_raw
+                     ztj_lim = zfactj * ztj_lim + ( 1._wp - zfactj ) * ztj_raw
+                  ENDIF
+                  !                                      ! switching triad scheme 
+                  zisw = (1._wp - rn_sw_triad ) + rn_sw_triad    &
+                     &            * 2._wp * ABS( 0.5_wp - kp - ( 0.5_wp - ip ) * SIGN( 1._wp , zdxrho(ji+ip,jj,jk,1-ip) )  )
+                  zjsw = (1._wp - rn_sw_triad ) + rn_sw_triad    &
+                     &            * 2._wp * ABS( 0.5_wp - kp - ( 0.5_wp - jp ) * SIGN( 1._wp , zdyrho(ji,jj+jp,jk,1-jp) )  )
+                  !
+                  triadi(ji+ip,jj   ,jk,1-ip,kp) = zti_lim * zisw
+                  triadj(ji   ,jj+jp,jk,1-jp,kp) = ztj_lim * zjsw
+                  !
+                  zbu  = e1e2u(ji   ,jj   ) * e3u(ji   ,jj   ,jk   ,Kmm)
+                  zbv  = e1e2v(ji   ,jj   ) * e3v(ji   ,jj   ,jk   ,Kmm)
+                  zbti = e1e2t(ji+ip,jj   ) * e3w(ji+ip,jj   ,jk+kp,Kmm)
+                  zbtj = e1e2t(ji   ,jj+jp) * e3w(ji   ,jj+jp,jk+kp,Kmm)
+                  !
+                  wslp2(ji+ip,jj,jk+kp) = wslp2(ji+ip,jj,jk+kp) + 0.25_wp * zbu / zbti * zti_g_lim*zti_g_lim      ! masked
+                  wslp2(ji,jj+jp,jk+kp) = wslp2(ji,jj+jp,jk+kp) + 0.25_wp * zbv / zbtj * ztj_g_lim*ztj_g_lim
+               END_2D
             END DO
          END DO
@@ -618,5 +582,5 @@
 
 
-   SUBROUTINE ldf_slp_mxl( prd, pn2, p_gru, p_grv, p_dzr )
+   SUBROUTINE ldf_slp_mxl( prd, pn2, p_gru, p_grv, p_dzr, Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE ldf_slp_mxl  ***
@@ -638,4 +602,5 @@
       REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   p_gru, p_grv   ! i- & j-gradient of density (u- & v-pts)
       REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   p_dzr          ! z-gradient of density      (T-point)
+      INTEGER , INTENT(in)                   ::   Kmm            ! ocean time level indices
       !!
       INTEGER  ::   ji , jj , jk                   ! dummy loop indices
@@ -658,14 +623,10 @@
       !
       !                                            !==   surface mixed layer mask   !
-      DO jk = 1, jpk                               ! =1 inside the mixed layer, =0 otherwise
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ik = nmln(ji,jj) - 1
-               IF( jk <= ik ) THEN   ;   omlmask(ji,jj,jk) = 1._wp
-               ELSE                  ;   omlmask(ji,jj,jk) = 0._wp
-               ENDIF
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpk )
+         ik = nmln(ji,jj) - 1
+         IF( jk <= ik ) THEN   ;   omlmask(ji,jj,jk) = 1._wp
+         ELSE                  ;   omlmask(ji,jj,jk) = 0._wp
+         ENDIF
+      END_3D
 
 
@@ -680,48 +641,46 @@
       !-----------------------------------------------------------------------
       !
-      DO jj = 2, jpjm1
-         DO ji = 2, jpim1
-            !                        !==   Slope at u- & v-points just below the Mixed Layer   ==!
-            !
-            !                        !- vertical density gradient for u- and v-slopes (from dzr at T-point)
-            iku = MIN(  MAX( 1, nmln(ji,jj) , nmln(ji+1,jj) ) , jpkm1  )   ! ML (MAX of T-pts, bound by jpkm1)
-            ikv = MIN(  MAX( 1, nmln(ji,jj) , nmln(ji,jj+1) ) , jpkm1  )   !
-            zbu = 0.5_wp * ( p_dzr(ji,jj,iku) + p_dzr(ji+1,jj  ,iku) )
-            zbv = 0.5_wp * ( p_dzr(ji,jj,ikv) + p_dzr(ji  ,jj+1,ikv) )
-            !                        !- horizontal density gradient at u- & v-points
-            zau = p_gru(ji,jj,iku) * r1_e1u(ji,jj)
-            zav = p_grv(ji,jj,ikv) * r1_e2v(ji,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 , - z1_slpmax * ABS( zau ) , -7.e+3_wp/e3u_n(ji,jj,iku)* ABS( zau )  )
-            zbv = MIN(  zbv , - z1_slpmax * ABS( zav ) , -7.e+3_wp/e3v_n(ji,jj,ikv)* ABS( zav )  )
-            !                        !- Slope at u- & v-points (uslpml, vslpml)
-            uslpml(ji,jj) = zau / ( zbu - zeps ) * umask(ji,jj,iku)
-            vslpml(ji,jj) = zav / ( zbv - zeps ) * vmask(ji,jj,ikv)
-            !
-            !                        !==   i- & j-slopes at w-points just below the Mixed Layer   ==!
-            !
-            ik   = MIN( nmln(ji,jj) + 1, jpk )
-            ikm1 = MAX( 1, ik-1 )
-            !                        !- vertical density gradient for w-slope (from N^2)
-            zbw = zm1_2g * pn2 (ji,jj,ik) * ( prd (ji,jj,ik) + prd (ji,jj,ikm1) + 2. )
-            !                        !- horizontal density i- & j-gradient at w-points
-            zci = MAX(   umask(ji-1,jj,ik  ) + umask(ji,jj,ik  )           &
-               &       + umask(ji-1,jj,ikm1) + umask(ji,jj,ikm1) , zeps  ) * e1t(ji,jj)
-            zcj = MAX(   vmask(ji,jj-1,ik  ) + vmask(ji,jj,ik  )           &
-               &       + vmask(ji,jj-1,ikm1) + vmask(ji,jj,ikm1) , zeps  ) * e2t(ji,jj)
-            zai =    (   p_gru(ji-1,jj,ik  ) + p_gru(ji,jj,ik)             &
-               &       + p_gru(ji-1,jj,ikm1) + p_gru(ji,jj,ikm1  )  ) / zci  * tmask(ji,jj,ik)
-            zaj =    (   p_grv(ji,jj-1,ik  ) + p_grv(ji,jj,ik  )           &
-               &       + p_grv(ji,jj-1,ikm1) + p_grv(ji,jj,ikm1)  ) / zcj  * tmask(ji,jj,ik)
-            !                        !- bound the slopes: abs(zw.)<= 1/100 and zb..<0.
-            !                           kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
-            zbi = MIN(  zbw , -100._wp* ABS( zai ) , -7.e+3_wp/e3w_n(ji,jj,ik)* ABS( zai )  )
-            zbj = MIN(  zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/e3w_n(ji,jj,ik)* ABS( zaj )  )
-            !                        !- i- & j-slope at w-points (wslpiml, wslpjml)
-            wslpiml(ji,jj) = zai / ( zbi - zeps ) * tmask (ji,jj,ik)
-            wslpjml(ji,jj) = zaj / ( zbj - zeps ) * tmask (ji,jj,ik)
-         END DO
-      END DO
+      DO_2D_00_00
+         !                        !==   Slope at u- & v-points just below the Mixed Layer   ==!
+         !
+         !                        !- vertical density gradient for u- and v-slopes (from dzr at T-point)
+         iku = MIN(  MAX( 1, nmln(ji,jj) , nmln(ji+1,jj) ) , jpkm1  )   ! ML (MAX of T-pts, bound by jpkm1)
+         ikv = MIN(  MAX( 1, nmln(ji,jj) , nmln(ji,jj+1) ) , jpkm1  )   !
+         zbu = 0.5_wp * ( p_dzr(ji,jj,iku) + p_dzr(ji+1,jj  ,iku) )
+         zbv = 0.5_wp * ( p_dzr(ji,jj,ikv) + p_dzr(ji  ,jj+1,ikv) )
+         !                        !- horizontal density gradient at u- & v-points
+         zau = p_gru(ji,jj,iku) * r1_e1u(ji,jj)
+         zav = p_grv(ji,jj,ikv) * r1_e2v(ji,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 , - z1_slpmax * ABS( zau ) , -7.e+3_wp/e3u(ji,jj,iku,Kmm)* ABS( zau )  )
+         zbv = MIN(  zbv , - z1_slpmax * ABS( zav ) , -7.e+3_wp/e3v(ji,jj,ikv,Kmm)* ABS( zav )  )
+         !                        !- Slope at u- & v-points (uslpml, vslpml)
+         uslpml(ji,jj) = zau / ( zbu - zeps ) * umask(ji,jj,iku)
+         vslpml(ji,jj) = zav / ( zbv - zeps ) * vmask(ji,jj,ikv)
+         !
+         !                        !==   i- & j-slopes at w-points just below the Mixed Layer   ==!
+         !
+         ik   = MIN( nmln(ji,jj) + 1, jpk )
+         ikm1 = MAX( 1, ik-1 )
+         !                        !- vertical density gradient for w-slope (from N^2)
+         zbw = zm1_2g * pn2 (ji,jj,ik) * ( prd (ji,jj,ik) + prd (ji,jj,ikm1) + 2. )
+         !                        !- horizontal density i- & j-gradient at w-points
+         zci = MAX(   umask(ji-1,jj,ik  ) + umask(ji,jj,ik  )           &
+            &       + umask(ji-1,jj,ikm1) + umask(ji,jj,ikm1) , zeps  ) * e1t(ji,jj)
+         zcj = MAX(   vmask(ji,jj-1,ik  ) + vmask(ji,jj,ik  )           &
+            &       + vmask(ji,jj-1,ikm1) + vmask(ji,jj,ikm1) , zeps  ) * e2t(ji,jj)
+         zai =    (   p_gru(ji-1,jj,ik  ) + p_gru(ji,jj,ik)             &
+            &       + p_gru(ji-1,jj,ikm1) + p_gru(ji,jj,ikm1  )  ) / zci  * tmask(ji,jj,ik)
+         zaj =    (   p_grv(ji,jj-1,ik  ) + p_grv(ji,jj,ik  )           &
+            &       + p_grv(ji,jj-1,ikm1) + p_grv(ji,jj,ikm1)  ) / zcj  * tmask(ji,jj,ik)
+         !                        !- bound the slopes: abs(zw.)<= 1/100 and zb..<0.
+         !                           kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+         zbi = MIN(  zbw , -100._wp* ABS( zai ) , -7.e+3_wp/e3w(ji,jj,ik,Kmm)* ABS( zai )  )
+         zbj = MIN(  zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/e3w(ji,jj,ik,Kmm)* ABS( zaj )  )
+         !                        !- i- & j-slope at w-points (wslpiml, wslpjml)
+         wslpiml(ji,jj) = zai / ( zbi - zeps ) * tmask (ji,jj,ik)
+         wslpjml(ji,jj) = zaj / ( zbj - zeps ) * tmask (ji,jj,ik)
+      END_2D
       !!gm this lbc_lnk should be useless....
       CALL lbc_lnk_multi( 'ldfslp', uslpml , 'U', -1. , vslpml , 'V', -1. , wslpiml, 'W', -1. , wslpjml, 'W', -1. ) 
@@ -785,9 +744,9 @@
 !            DO jk = 1, jpk
 !               DO jj = 2, jpjm1
-!                  DO ji = fs_2, fs_jpim1   ! vector opt.
-!                     uslp (ji,jj,jk) = - ( gdept_n(ji+1,jj,jk) - gdept_n(ji ,jj ,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk)
-!                     vslp (ji,jj,jk) = - ( gdept_n(ji,jj+1,jk) - gdept_n(ji ,jj ,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk)
-!                     wslpi(ji,jj,jk) = - ( gdepw_n(ji+1,jj,jk) - gdepw_n(ji-1,jj,jk) ) * r1_e1t(ji,jj) * wmask(ji,jj,jk) * 0.5
-!                     wslpj(ji,jj,jk) = - ( gdepw_n(ji,jj+1,jk) - gdepw_n(ji,jj-1,jk) ) * r1_e2t(ji,jj) * wmask(ji,jj,jk) * 0.5
+!                  DO ji = 2, jpim1   ! vector opt.
+!                     uslp (ji,jj,jk) = - ( gdept(ji+1,jj,jk,Kmm) - gdept(ji ,jj ,jk,Kmm) ) * r1_e1u(ji,jj) * umask(ji,jj,jk)
+!                     vslp (ji,jj,jk) = - ( gdept(ji,jj+1,jk,Kmm) - gdept(ji ,jj ,jk,Kmm) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk)
+!                     wslpi(ji,jj,jk) = - ( gdepw(ji+1,jj,jk,Kmm) - gdepw(ji-1,jj,jk,Kmm) ) * r1_e1t(ji,jj) * wmask(ji,jj,jk) * 0.5
+!                     wslpj(ji,jj,jk) = - ( gdepw(ji,jj+1,jk,Kmm) - gdepw(ji,jj-1,jk,Kmm) ) * r1_e2t(ji,jj) * wmask(ji,jj,jk) * 0.5
 !                  END DO
 !               END DO
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/LDF/ldftra.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/LDF/ldftra.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/LDF/ldftra.F90	(revision 12928)
@@ -94,5 +94,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -152,8 +152,6 @@
       ! =================================
       !
-      REWIND( numnam_ref )              ! Namelist namtra_ldf in reference namelist : Lateral physics on tracers
       READ  ( numnam_ref, namtra_ldf, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_ldf in reference namelist' )
-      REWIND( numnam_cfg )              ! Namelist namtra_ldf in configuration namelist : Lateral physics on tracers
       READ  ( numnam_cfg, namtra_ldf, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_ldf in configuration namelist' )
@@ -382,5 +380,5 @@
 
 
-   SUBROUTINE ldf_tra( kt )
+   SUBROUTINE ldf_tra( kt, Kbb, Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE ldf_tra  ***
@@ -403,4 +401,5 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! time step
+      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -411,5 +410,5 @@
          !                                ! =F(growth rate of baroclinic instability)
          !                                ! max value aeiv_0 ; decreased to 0 within 20N-20S
-         CALL ldf_eiv( kt, aei0, aeiu, aeiv )
+         CALL ldf_eiv( kt, aei0, aeiu, aeiv, Kmm )
       ENDIF
       !
@@ -424,5 +423,5 @@
             ahtv(:,:,1) = aeiv(:,:,1)
          ELSE                                            ! compute aht. 
-            CALL ldf_eiv( kt, aht0, ahtu, ahtv )
+            CALL ldf_eiv( kt, aht0, ahtu, ahtv, Kmm )
          ENDIF
          !
@@ -430,14 +429,12 @@
          zaht_min = 0.2_wp * aht0                                       ! minimum value for aht
          zDaht    = aht0 - zaht_min                                      
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               !!gm CAUTION : here we assume lat/lon grid in 20deg N/S band (like all ORCA cfg)
-               !!     ==>>>   The Coriolis value is identical for t- & u_points, and for v- and f-points
-               zaht = ( 1._wp -  MIN( 1._wp , ABS( ff_t(ji,jj) * z1_f20 ) ) ) * zDaht
-               zahf = ( 1._wp -  MIN( 1._wp , ABS( ff_f(ji,jj) * z1_f20 ) ) ) * zDaht
-               ahtu(ji,jj,1) = (  MAX( zaht_min, ahtu(ji,jj,1) ) + zaht  )     ! min value zaht_min
-               ahtv(ji,jj,1) = (  MAX( zaht_min, ahtv(ji,jj,1) ) + zahf  )     ! increase within 20S-20N
-            END DO
-         END DO
+         DO_2D_11_11
+            !!gm CAUTION : here we assume lat/lon grid in 20deg N/S band (like all ORCA cfg)
+            !!     ==>>>   The Coriolis value is identical for t- & u_points, and for v- and f-points
+            zaht = ( 1._wp -  MIN( 1._wp , ABS( ff_t(ji,jj) * z1_f20 ) ) ) * zDaht
+            zahf = ( 1._wp -  MIN( 1._wp , ABS( ff_f(ji,jj) * z1_f20 ) ) ) * zDaht
+            ahtu(ji,jj,1) = (  MAX( zaht_min, ahtu(ji,jj,1) ) + zaht  )     ! min value zaht_min
+            ahtv(ji,jj,1) = (  MAX( zaht_min, ahtv(ji,jj,1) ) + zahf  )     ! increase within 20S-20N
+         END_2D
          DO jk = 1, jpkm1                             ! deeper value = surface value + mask for all levels
             ahtu(:,:,jk) = ahtu(:,:,1) * umask(:,:,jk)
@@ -448,11 +445,11 @@
          IF( ln_traldf_lap     ) THEN          !   laplacian operator |u| e /12
             DO jk = 1, jpkm1
-               ahtu(:,:,jk) = ABS( ub(:,:,jk) ) * e1u(:,:) * r1_12   ! n.b. ub,vb are masked
-               ahtv(:,:,jk) = ABS( vb(:,:,jk) ) * e2v(:,:) * r1_12
+               ahtu(:,:,jk) = ABS( uu(:,:,jk,Kbb) ) * e1u(:,:) * r1_12   ! n.b. uu,vv are masked
+               ahtv(:,:,jk) = ABS( vv(:,:,jk,Kbb) ) * e2v(:,:) * r1_12
             END DO
          ELSEIF( ln_traldf_blp ) THEN      ! bilaplacian operator      sqrt( |u| e^3 /12 ) = sqrt( |u| e /12 ) * e
             DO jk = 1, jpkm1
-               ahtu(:,:,jk) = SQRT(  ABS( ub(:,:,jk) ) * e1u(:,:) * r1_12  ) * e1u(:,:)
-               ahtv(:,:,jk) = SQRT(  ABS( vb(:,:,jk) ) * e2v(:,:) * r1_12  ) * e2v(:,:)
+               ahtu(:,:,jk) = SQRT(  ABS( uu(:,:,jk,Kbb) ) * e1u(:,:) * r1_12  ) * e1u(:,:)
+               ahtv(:,:,jk) = SQRT(  ABS( vv(:,:,jk,Kbb) ) * e2v(:,:) * r1_12  ) * e2v(:,:)
             END DO
          ENDIF
@@ -510,9 +507,7 @@
       ENDIF
       !
-      REWIND( numnam_ref )              ! Namelist namtra_eiv in reference namelist : eddy induced velocity param.
       READ  ( numnam_ref, namtra_eiv, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_eiv in reference namelist' )
       !
-      REWIND( numnam_cfg )              ! Namelist namtra_eiv in configuration namelist : eddy induced velocity param.
       READ  ( numnam_cfg, namtra_eiv, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_eiv in configuration namelist' )
@@ -625,5 +620,5 @@
 
 
-   SUBROUTINE ldf_eiv( kt, paei0, paeiu, paeiv )
+   SUBROUTINE ldf_eiv( kt, paei0, paeiu, paeiv, Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE ldf_eiv  ***
@@ -637,4 +632,5 @@
       !!----------------------------------------------------------------------
       INTEGER                         , INTENT(in   ) ::   kt             ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   Kmm            ! ocean time level indices
       REAL(wp)                        , INTENT(inout) ::   paei0          ! max value            [m2/s]
       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   paeiu, paeiv   ! eiv coefficient      [m2/s]
@@ -651,68 +647,54 @@
       !                       ! Compute lateral diffusive coefficient at T-point
       IF( ln_traldf_triad ) THEN
-         DO jk = 1, jpk
-            DO jj = 2, jpjm1
-               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( rn2b(ji,jj,jk), 0._wp )
-                  zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * e3w_n(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 = e3w_n(ji,jj,jk) * tmask(ji,jj,jk)
-                  zah(ji,jj) = zah(ji,jj) + zn2 * wslp2(ji,jj,jk) * ze3w
-                  zhw(ji,jj) = zhw(ji,jj) + ze3w
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpk )
+            ! 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( rn2b(ji,jj,jk), 0._wp )
+            zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * e3w(ji,jj,jk,Kmm)
+            ! 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 = e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk)
+            zah(ji,jj) = zah(ji,jj) + zn2 * wslp2(ji,jj,jk) * ze3w
+            zhw(ji,jj) = zhw(ji,jj) + ze3w
+         END_3D
       ELSE
-         DO jk = 1, jpk
-            DO jj = 2, jpjm1
-               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( rn2b(ji,jj,jk), 0._wp )
-                  zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * e3w_n(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 = e3w_n(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
-         END DO
-      ENDIF
-
-      DO jj = 2, jpjm1
-         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 betwenn 2 km and  40km
-            zRo(ji,jj) = MAX(  2.e3 , MIN( .4 * zn(ji,jj) / zfw, 40.e3 )  )
-            ! Compute aeiw by multiplying Ro^2 and T^-1
-            zaeiw(ji,jj) = zRo(ji,jj) * zRo(ji,jj) * SQRT( zah(ji,jj) / zhw(ji,jj) ) * tmask(ji,jj,1)
-         END DO
-      END DO
+         DO_3D_00_00( 1, jpk )
+            ! 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( rn2b(ji,jj,jk), 0._wp )
+            zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * e3w(ji,jj,jk,Kmm)
+            ! 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 = e3w(ji,jj,jk,Kmm) * wmask(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_3D
+      ENDIF
+
+      DO_2D_00_00
+         zfw = MAX( ABS( 2. * omega * SIN( rad * gphit(ji,jj) ) ) , 1.e-10 )
+         ! Rossby radius at w-point taken betwenn 2 km and  40km
+         zRo(ji,jj) = MAX(  2.e3 , MIN( .4 * zn(ji,jj) / zfw, 40.e3 )  )
+         ! Compute aeiw by multiplying Ro^2 and T^-1
+         zaeiw(ji,jj) = zRo(ji,jj) * zRo(ji,jj) * SQRT( zah(ji,jj) / zhw(ji,jj) ) * tmask(ji,jj,1)
+      END_2D
 
       !                                         !==  Bound on eiv coeff.  ==!
       z1_f20 = 1._wp / (  2._wp * omega * sin( rad * 20._wp )  )
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            zzaei = MIN( 1._wp, ABS( ff_t(ji,jj) * z1_f20 ) ) * zaeiw(ji,jj)     ! tropical decrease
-            zaeiw(ji,jj) = MIN( zzaei , paei0 )                                  ! Max value = paei0
-         END DO
-      END DO
+      DO_2D_00_00
+         zzaei = MIN( 1._wp, ABS( ff_t(ji,jj) * z1_f20 ) ) * zaeiw(ji,jj)     ! tropical decrease
+         zaeiw(ji,jj) = MIN( zzaei , paei0 )                                  ! Max value = paei0
+      END_2D
       CALL lbc_lnk( 'ldftra', zaeiw(:,:), 'W', 1. )       ! lateral boundary condition
       !               
-      DO jj = 2, jpjm1                          !== aei at u- and v-points  ==!
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            paeiu(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji+1,jj  ) ) * umask(ji,jj,1)
-            paeiv(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji  ,jj+1) ) * vmask(ji,jj,1)
-         END DO 
-      END DO 
+      DO_2D_00_00
+         paeiu(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji+1,jj  ) ) * umask(ji,jj,1)
+         paeiv(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji  ,jj+1) ) * vmask(ji,jj,1)
+      END_2D
       CALL lbc_lnk_multi( 'ldftra', paeiu(:,:,1), 'U', 1. , paeiv(:,:,1), 'V', 1. )      ! lateral boundary condition
 
@@ -725,5 +707,5 @@
 
 
-   SUBROUTINE ldf_eiv_trp( kt, kit000, pun, pvn, pwn, cdtype )
+   SUBROUTINE ldf_eiv_trp( kt, kit000, pu, pv, pw, cdtype, Kmm, Krhs )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE ldf_eiv_trp  ***
@@ -741,12 +723,13 @@
       !!                                    velocity and heat transport (call ldf_eiv_dia)
       !!
-      !! ** Action  : pun, pvn increased by the eiv transport
-      !!----------------------------------------------------------------------
-      INTEGER                         , INTENT(in   ) ::   kt       ! ocean time-step index
-      INTEGER                         , INTENT(in   ) ::   kit000   ! first time step index
-      CHARACTER(len=3)                , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun      ! in : 3 ocean transport components   [m3/s]
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pvn      ! out: 3 ocean transport components   [m3/s]
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pwn      ! increased by the eiv                [m3/s]
+      !! ** Action  : pu, pv increased by the eiv transport
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) ::   kt        ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   kit000    ! first time step index
+      INTEGER                         , INTENT(in   ) ::   Kmm, Krhs ! ocean time level indices
+      CHARACTER(len=3)                , INTENT(in   ) ::   cdtype    ! =TRA or TRC (tracer indicator)
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu      ! in : 3 ocean transport components   [m3/s]
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pv      ! out: 3 ocean transport components   [m3/s]
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pw      ! increased by the eiv                [m3/s]
       !!
       INTEGER  ::   ji, jj, jk                 ! dummy loop indices
@@ -766,39 +749,27 @@
       zpsi_uw(:,:,jpk) = 0._wp   ;   zpsi_vw(:,:,jpk) = 0._wp
       !
-      DO jk = 2, jpkm1
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zpsi_uw(ji,jj,jk) = - r1_4 * e2u(ji,jj) * ( wslpi(ji,jj,jk  ) + wslpi(ji+1,jj,jk) )   &
-                  &                                    * ( aeiu (ji,jj,jk-1) + aeiu (ji  ,jj,jk) ) * umask(ji,jj,jk)
-               zpsi_vw(ji,jj,jk) = - r1_4 * e1v(ji,jj) * ( wslpj(ji,jj,jk  ) + wslpj(ji,jj+1,jk) )   &
-                  &                                    * ( aeiv (ji,jj,jk-1) + aeiv (ji,jj  ,jk) ) * vmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-      !
-      DO jk = 1, jpkm1
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.               
-               pun(ji,jj,jk) = pun(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) )
-               pvn(ji,jj,jk) = pvn(ji,jj,jk) - ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) )
-            END DO
-         END DO
-      END DO
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               pwn(ji,jj,jk) = pwn(ji,jj,jk) + (  zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj  ,jk)   &
-                  &                             + zpsi_vw(ji,jj,jk) - zpsi_vw(ji  ,jj-1,jk) )
-            END DO
-         END DO
-      END DO
+      DO_3D_10_10( 2, jpkm1 )
+         zpsi_uw(ji,jj,jk) = - r1_4 * e2u(ji,jj) * ( wslpi(ji,jj,jk  ) + wslpi(ji+1,jj,jk) )   &
+            &                                    * ( aeiu (ji,jj,jk-1) + aeiu (ji  ,jj,jk) ) * wumask(ji,jj,jk)
+         zpsi_vw(ji,jj,jk) = - r1_4 * e1v(ji,jj) * ( wslpj(ji,jj,jk  ) + wslpj(ji,jj+1,jk) )   &
+            &                                    * ( aeiv (ji,jj,jk-1) + aeiv (ji,jj  ,jk) ) * wvmask(ji,jj,jk)
+      END_3D
+      !
+      DO_3D_10_10( 1, jpkm1 )
+         pu(ji,jj,jk) = pu(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) )
+         pv(ji,jj,jk) = pv(ji,jj,jk) - ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) )
+      END_3D
+      DO_3D_00_00( 1, jpkm1 )
+         pw(ji,jj,jk) = pw(ji,jj,jk) + (  zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj  ,jk)   &
+            &                             + zpsi_vw(ji,jj,jk) - zpsi_vw(ji  ,jj-1,jk) )
+      END_3D
       !
       !                              ! diagnose the eddy induced velocity and associated heat transport
-      IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' )   CALL ldf_eiv_dia( zpsi_uw, zpsi_vw )
+      IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' )   CALL ldf_eiv_dia( zpsi_uw, zpsi_vw, Kmm )
       !
     END SUBROUTINE ldf_eiv_trp
 
 
-   SUBROUTINE ldf_eiv_dia( psi_uw, psi_vw )
+   SUBROUTINE ldf_eiv_dia( psi_uw, psi_vw, Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE ldf_eiv_dia  ***
@@ -811,4 +782,5 @@
       !!----------------------------------------------------------------------
       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   psi_uw, psi_vw   ! streamfunction   [m3/s]
+      INTEGER                         , INTENT(in   ) ::   Kmm   ! ocean time level indices
       !
       INTEGER  ::   ji, jj, jk    ! dummy loop indices
@@ -831,38 +803,45 @@
       !
       DO jk = 1, jpkm1                                         ! e2u e3u u_eiv = -dk[psi_uw]
-         zw3d(:,:,jk) = ( psi_uw(:,:,jk+1) - psi_uw(:,:,jk) ) / ( e2u(:,:) * e3u_n(:,:,jk) )
+         zw3d(:,:,jk) = ( psi_uw(:,:,jk+1) - psi_uw(:,:,jk) ) / ( e2u(:,:) * e3u(:,:,jk,Kmm) )
       END DO
       CALL iom_put( "uoce_eiv", zw3d )
       !
       DO jk = 1, jpkm1                                         ! e1v e3v v_eiv = -dk[psi_vw]
-         zw3d(:,:,jk) = ( psi_vw(:,:,jk+1) - psi_vw(:,:,jk) ) / ( e1v(:,:) * e3v_n(:,:,jk) )
+         zw3d(:,:,jk) = ( psi_vw(:,:,jk+1) - psi_vw(:,:,jk) ) / ( e1v(:,:) * e3v(:,:,jk,Kmm) )
       END DO
       CALL iom_put( "voce_eiv", zw3d )
       !
-      DO jk = 1, jpkm1                                         ! e1 e2 w_eiv = dk[psix] + dk[psix]
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1  ! vector opt.
-               zw3d(ji,jj,jk) = (  psi_vw(ji,jj,jk) - psi_vw(ji  ,jj-1,jk)    &
-                  &              + psi_uw(ji,jj,jk) - psi_uw(ji-1,jj  ,jk)  ) / e1e2t(ji,jj)
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 1, jpkm1 )
+         zw3d(ji,jj,jk) = (  psi_vw(ji,jj,jk) - psi_vw(ji  ,jj-1,jk)    &
+            &              + psi_uw(ji,jj,jk) - psi_uw(ji-1,jj  ,jk)  ) / e1e2t(ji,jj)
+      END_3D
       CALL lbc_lnk( 'ldftra', zw3d, 'T', 1. )      ! lateral boundary condition
       CALL iom_put( "woce_eiv", zw3d )
       !
-      !
-      zztmp = 0.5_wp * rau0 * rcp 
+      IF( iom_use('weiv_masstr') ) THEN   ! vertical mass transport & its square value
+         zw2d(:,:) = rho0 * e1e2t(:,:)
+         DO jk = 1, jpk
+            zw3d(:,:,jk) = zw3d(:,:,jk) * zw2d(:,:)
+         END DO
+         CALL iom_put( "weiv_masstr" , zw3d )  
+      ENDIF
+      !
+      IF( iom_use('ueiv_masstr') ) THEN
+         zw3d(:,:,:) = 0.e0
+         DO jk = 1, jpkm1
+            zw3d(:,:,jk) = rho0 * ( psi_uw(:,:,jk+1) - psi_uw(:,:,jk) ) 
+         END DO
+         CALL iom_put( "ueiv_masstr", zw3d )                  ! mass transport in i-direction
+      ENDIF
+      !
+      zztmp = 0.5_wp * rho0 * rcp 
       IF( iom_use('ueiv_heattr') .OR. iom_use('ueiv_heattr3d') ) THEN
         zw2d(:,:)   = 0._wp 
         zw3d(:,:,:) = 0._wp 
-        DO jk = 1, jpkm1
-           DO jj = 2, jpjm1
-              DO ji = fs_2, fs_jpim1   ! vector opt.
-                 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_uw(ji,jj,jk+1)      - psi_uw(ji,jj,jk)          )   &
-                    &                            * ( tsn   (ji,jj,jk,jp_tem) + tsn   (ji+1,jj,jk,jp_tem) ) 
-                 zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk)
-              END DO
-           END DO
-        END DO
+        DO_3D_00_00( 1, jpkm1 )
+           zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_uw(ji,jj,jk+1)          - psi_uw(ji  ,jj,jk)            )   &
+              &                            * ( ts    (ji,jj,jk,jp_tem,Kmm) + ts    (ji+1,jj,jk,jp_tem,Kmm) ) 
+           zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk)
+        END_3D
         CALL lbc_lnk( 'ldftra', zw2d, 'U', -1. )
         CALL lbc_lnk( 'ldftra', zw3d, 'U', -1. )
@@ -870,20 +849,25 @@
         CALL iom_put( "ueiv_heattr3d", zztmp * zw3d )                  ! heat transport in i-direction
       ENDIF
+      !
+      IF( iom_use('veiv_masstr') ) THEN
+         zw3d(:,:,:) = 0.e0
+         DO jk = 1, jpkm1
+            zw3d(:,:,jk) = rho0 * ( psi_vw(:,:,jk+1) - psi_vw(:,:,jk) ) 
+         END DO
+         CALL iom_put( "veiv_masstr", zw3d )                  ! mass transport in i-direction
+      ENDIF
+      !
       zw2d(:,:)   = 0._wp 
       zw3d(:,:,:) = 0._wp 
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_vw(ji,jj,jk+1)      - psi_vw(ji,jj,jk)          )   &
-                  &                            * ( tsn   (ji,jj,jk,jp_tem) + tsn   (ji,jj+1,jk,jp_tem) ) 
-               zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 1, jpkm1 )
+         zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_vw(ji,jj,jk+1)          - psi_vw(ji,jj  ,jk)            )   &
+            &                            * ( ts    (ji,jj,jk,jp_tem,Kmm) + ts    (ji,jj+1,jk,jp_tem,Kmm) ) 
+         zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk)
+      END_3D
       CALL lbc_lnk( 'ldftra', zw2d, 'V', -1. )
       CALL iom_put( "veiv_heattr", zztmp * zw2d )                  !  heat transport in j-direction
       CALL iom_put( "veiv_heattr", zztmp * zw3d )                  !  heat transport in j-direction
       !
-      IF( ln_diaptr )  CALL dia_ptr_hst( jp_tem, 'eiv', 0.5 * zw3d )
+      IF( iom_use( 'sophteiv' ) )   CALL dia_ptr_hst( jp_tem, 'eiv', 0.5 * zw3d )
       !
       zztmp = 0.5_wp * 0.5
@@ -891,34 +875,26 @@
         zw2d(:,:) = 0._wp 
         zw3d(:,:,:) = 0._wp 
-        DO jk = 1, jpkm1
-           DO jj = 2, jpjm1
-              DO ji = fs_2, fs_jpim1   ! vector opt.
-                 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) * ( psi_uw(ji,jj,jk+1)      - psi_uw(ji,jj,jk)          )   &
-                    &                            * ( tsn   (ji,jj,jk,jp_sal) + tsn   (ji+1,jj,jk,jp_sal) ) 
-                 zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk)
-              END DO
-           END DO
-        END DO
+        DO_3D_00_00( 1, jpkm1 )
+           zw3d(ji,jj,jk) = zw3d(ji,jj,jk) * ( psi_uw(ji,jj,jk+1)          - psi_uw(ji  ,jj,jk)            )   &
+              &                            * ( ts    (ji,jj,jk,jp_sal,Kmm) + ts    (ji+1,jj,jk,jp_sal,Kmm) ) 
+           zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk)
+        END_3D
         CALL lbc_lnk( 'ldftra', zw2d, 'U', -1. )
         CALL lbc_lnk( 'ldftra', zw3d, 'U', -1. )
         CALL iom_put( "ueiv_salttr", zztmp * zw2d )                  ! salt transport in i-direction
-        CALL iom_put( "ueiv_salttr3d", zztmp * zw3d )                  ! salt transport in i-direction
+        CALL iom_put( "ueiv_salttr3d", zztmp * zw3d )                ! salt transport in i-direction
       ENDIF
       zw2d(:,:) = 0._wp 
       zw3d(:,:,:) = 0._wp 
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_vw(ji,jj,jk+1)      - psi_vw(ji,jj,jk)          )   &
-                  &                            * ( tsn   (ji,jj,jk,jp_sal) + tsn   (ji,jj+1,jk,jp_sal) ) 
-               zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 1, jpkm1 )
+         zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_vw(ji,jj,jk+1)          - psi_vw(ji,jj  ,jk)            )   &
+            &                            * ( ts    (ji,jj,jk,jp_sal,Kmm) + ts    (ji,jj+1,jk,jp_sal,Kmm) ) 
+         zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk)
+      END_3D
       CALL lbc_lnk( 'ldftra', zw2d, 'V', -1. )
       CALL iom_put( "veiv_salttr", zztmp * zw2d )                  !  salt transport in j-direction
       CALL iom_put( "veiv_salttr", zztmp * zw3d )                  !  salt transport in j-direction
       !
-      IF( ln_diaptr ) CALL dia_ptr_hst( jp_sal, 'eiv', 0.5 * zw3d )
+      IF( iom_use( 'sopsteiv' ) ) CALL dia_ptr_hst( jp_sal, 'eiv', 0.5 * zw3d )
       !
       !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/OBS/diaobs.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/OBS/diaobs.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/OBS/diaobs.F90	(revision 12928)
@@ -103,5 +103,5 @@
 CONTAINS
 
-   SUBROUTINE dia_obs_init
+   SUBROUTINE dia_obs_init( Kmm )
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE dia_obs_init  ***
@@ -114,5 +114,6 @@
       !!
       !!----------------------------------------------------------------------
-      INTEGER, PARAMETER ::   jpmaxnfiles = 1000    ! Maximum number of files for each obs type
+      INTEGER, INTENT(in)                ::   Kmm                      ! ocean time level indices
+      INTEGER, PARAMETER                 ::   jpmaxnfiles = 1000       ! Maximum number of files for each obs type
       INTEGER, DIMENSION(:), ALLOCATABLE ::   ifilesprof, ifilessurf   ! Number of profile & surface files
       INTEGER :: ios             ! Local integer output status for namelist read
@@ -201,8 +202,6 @@
 
       ! Read namelist namobs : control observation diagnostics
-      REWIND( numnam_ref )   ! Namelist namobs in reference namelist
       READ  ( numnam_ref, namobs, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namobs in reference namelist' )
-      REWIND( numnam_cfg )   ! Namelist namobs in configuration namelist
       READ  ( numnam_cfg, namobs, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namobs in configuration namelist' )
@@ -429,5 +428,5 @@
                &               jpi, jpj, jpk, &
                &               zmask1, zglam1, zgphi1, zmask2, zglam2, zgphi2,  &
-               &               ln_nea, ln_bound_reject, &
+               &               ln_nea, ln_bound_reject, Kmm, &
                &               kdailyavtypes = nn_profdavtypes )
          END DO
@@ -459,5 +458,5 @@
             !
             IF( TRIM(cobstypessurf(jtype)) == 'sla' ) THEN
-               CALL obs_rea_mdt( surfdataqc(jtype), n2dintsurf(jtype) )
+               CALL obs_rea_mdt( surfdataqc(jtype), n2dintsurf(jtype), Kmm )
                IF( ln_altbias )   &
                   & CALL obs_rea_altbias ( surfdataqc(jtype), n2dintsurf(jtype), cn_altbiasfile )
@@ -483,5 +482,5 @@
 
 
-   SUBROUTINE dia_obs( kstp )
+   SUBROUTINE dia_obs( kstp, Kmm )
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE dia_obs  ***
@@ -496,7 +495,7 @@
       !! ** Action  :
       !!----------------------------------------------------------------------
-      USE dom_oce, ONLY : gdept_n, gdept_1d   ! Ocean space and time domain variables
+      USE dom_oce, ONLY : gdept, gdept_1d     ! Ocean space domain variables (Kmm time-level only)
       USE phycst , ONLY : rday                ! Physical constants
-      USE oce    , ONLY : tsn, un, vn, sshn   ! Ocean dynamics and tracers variables
+      USE oce    , ONLY : ts, uu, vv, ssh     ! Ocean dynamics and tracers variables (Kmm time-level only)
       USE phycst , ONLY : rday                ! Physical constants
 #if defined  key_si3
@@ -511,4 +510,5 @@
       !! * Arguments
       INTEGER, INTENT(IN) :: kstp  ! Current timestep
+      INTEGER, INTENT(in) :: Kmm   ! ocean time level indices
       !! * Local declarations
       INTEGER :: idaystp           ! Number of timesteps per day
@@ -539,5 +539,5 @@
       ENDIF
 
-      idaystp = NINT( rday / rdt )
+      idaystp = NINT( rday / rn_Dt )
 
       !-----------------------------------------------------------------------
@@ -551,6 +551,6 @@
             SELECT CASE ( TRIM(cobstypesprof(jtype)) )
             CASE('prof')
-               zprofvar1(:,:,:) = tsn(:,:,:,jp_tem)
-               zprofvar2(:,:,:) = tsn(:,:,:,jp_sal)
+               zprofvar1(:,:,:) = ts(:,:,:,jp_tem,Kmm)
+               zprofvar2(:,:,:) = ts(:,:,:,jp_sal,Kmm)
                zprofmask1(:,:,:) = tmask(:,:,:)
                zprofmask2(:,:,:) = tmask(:,:,:)
@@ -560,6 +560,6 @@
                zgphi2(:,:) = gphit(:,:)
             CASE('vel')
-               zprofvar1(:,:,:) = un(:,:,:)
-               zprofvar2(:,:,:) = vn(:,:,:)
+               zprofvar1(:,:,:) = uu(:,:,:,Kmm)
+               zprofvar2(:,:,:) = vv(:,:,:,Kmm)
                zprofmask1(:,:,:) = umask(:,:,:)
                zprofmask2(:,:,:) = vmask(:,:,:)
@@ -575,5 +575,5 @@
                &               nit000, idaystp,                         &
                &               zprofvar1, zprofvar2,                    &
-               &               gdept_n(:,:,:), gdepw_n(:,:,:),            & 
+               &               gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm),      & 
                &               zprofmask1, zprofmask2,                  &
                &               zglam1, zglam2, zgphi1, zgphi2,          &
@@ -594,9 +594,9 @@
             SELECT CASE ( TRIM(cobstypessurf(jtype)) )
             CASE('sst')
-               zsurfvar(:,:) = tsn(:,:,1,jp_tem)
+               zsurfvar(:,:) = ts(:,:,1,jp_tem,Kmm)
             CASE('sla')
-               zsurfvar(:,:) = sshn(:,:)
+               zsurfvar(:,:) = ssh(:,:,Kmm)
             CASE('sss')
-               zsurfvar(:,:) = tsn(:,:,1,jp_sal)
+               zsurfvar(:,:) = ts(:,:,1,jp_sal,Kmm)
             CASE('sic')
                IF ( kstp == 0 ) THEN
@@ -774,5 +774,5 @@
          & rday
       USE dom_oce, ONLY : &           ! Ocean space and time domain variables
-         & rdt
+         & rn_Dt
 
       IMPLICIT NONE
@@ -805,5 +805,5 @@
       !! Compute number of days + number of hours + min since initial time
       !!----------------------------------------------------------------------
-      zdayfrc = kstp * rdt / rday
+      zdayfrc = kstp * rn_Dt / rday
       zdayfrc = zdayfrc - aint(zdayfrc)
       imin = imin + int( zdayfrc * 24 * 60 ) 
@@ -816,5 +816,5 @@
         iday=iday+1
       END DO 
-      iday = iday + kstp * rdt / rday 
+      iday = iday + kstp * rn_Dt / rday 
 
       !-----------------------------------------------------------------------
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/OBS/obs_averg_h2d.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/OBS/obs_averg_h2d.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/OBS/obs_averg_h2d.F90	(revision 12928)
@@ -52,5 +52,5 @@
    SUBROUTINE obs_avg_h2d_init( kpk, kpk2, kmaxifp, kmaxjfp, k2dint, plam,  pphi, &
       &                         pglam, pgphi, pglamf, pgphif, pmask, plamscl, pphiscl, lindegrees, &
-      &                         pweig, pobsmask, iminpoints )
+      &                         pweig, iminpoints )
       !!-----------------------------------------------------------------------
       !!
@@ -98,6 +98,4 @@
       REAL(KIND=wp), DIMENSION(kmaxifp,kmaxjfp,kpk2), INTENT(OUT) ::  &
          & pweig                ! Weights for averaging
-      REAL(KIND=wp), DIMENSION(kpk2), INTENT(OUT) ::  &
-         & pobsmask             ! Vertical mask for observations
       INTEGER, INTENT(IN), OPTIONAL :: &
          & iminpoints           ! Reject point which is not surrounded
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/OBS/obs_oper.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/OBS/obs_oper.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/OBS/obs_oper.F90	(revision 12928)
@@ -31,4 +31,6 @@
    INTEGER, PARAMETER, PUBLIC ::   imaxavtypes = 20   !: Max number of daily avgd obs types
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -187,26 +189,18 @@
          ! Initialize daily mean for first timestep of the day
          IF ( idayend == 1 .OR. kt == 0 ) THEN
-            DO jk = 1, jpk
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     prodatqc%vdmean(ji,jj,jk,1) = 0.0
-                     prodatqc%vdmean(ji,jj,jk,2) = 0.0
-                  END DO
-               END DO
-            END DO
-         ENDIF
-
-         DO jk = 1, jpk
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  ! Increment field 1 for computing daily mean
-                  prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) &
-                     &                        + pvar1(ji,jj,jk)
-                  ! Increment field 2 for computing daily mean
-                  prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) &
-                     &                        + pvar2(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+            DO_3D_11_11( 1, jpk )
+               prodatqc%vdmean(ji,jj,jk,1) = 0.0
+               prodatqc%vdmean(ji,jj,jk,2) = 0.0
+            END_3D
+         ENDIF
+
+         DO_3D_11_11( 1, jpk )
+            ! Increment field 1 for computing daily mean
+            prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) &
+               &                        + pvar1(ji,jj,jk)
+            ! Increment field 2 for computing daily mean
+            prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) &
+               &                        + pvar2(ji,jj,jk)
+         END_3D
 
          ! Compute the daily mean at the end of day
@@ -215,14 +209,10 @@
             IF (lwp) WRITE(numout,*) 'Calculating prodatqc%vdmean on time-step: ',kt
             CALL FLUSH(numout)
-            DO jk = 1, jpk
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) &
-                        &                        * zdaystp
-                     prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) &
-                        &                        * zdaystp
-                  END DO
-               END DO
-            END DO
+            DO_3D_11_11( 1, jpk )
+               prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) &
+                  &                        * zdaystp
+               prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) &
+                  &                        * zdaystp
+            END_3D
          ENDIF
 
@@ -342,5 +332,5 @@
             CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,     &
                &                   zglam2(:,:,iobs), zgphi2(:,:,iobs), &
-               &                   zmask2(:,:,1,iobs), zweig2, zmsk_2 )
+               &                   zmask2(:,:,1,iobs), zweig2, zmsk_2)
  
          ENDIF
@@ -760,11 +750,9 @@
          ! Initialize night-time mean for first timestep of the day
          IF ( idayend == 1 .OR. kt == 0 ) THEN
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  surfdataqc%vdmean(ji,jj) = 0.0
-                  zmeanday(ji,jj) = 0.0
-                  icount_night(ji,jj) = 0
-               END DO
-            END DO
+            DO_2D_11_11
+               surfdataqc%vdmean(ji,jj) = 0.0
+               zmeanday(ji,jj) = 0.0
+               icount_night(ji,jj) = 0
+            END_2D
          ENDIF
 
@@ -773,13 +761,11 @@
          imask_night(:,:) = INT( zouttmp(:,:) )
 
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ! Increment the temperature field for computing night mean and counter
-               surfdataqc%vdmean(ji,jj) = surfdataqc%vdmean(ji,jj)  &
-                      &                    + psurf(ji,jj) * REAL( imask_night(ji,jj) )
-               zmeanday(ji,jj)          = zmeanday(ji,jj) + psurf(ji,jj)
-               icount_night(ji,jj)      = icount_night(ji,jj) + imask_night(ji,jj)
-            END DO
-         END DO
+         DO_2D_11_11
+            ! Increment the temperature field for computing night mean and counter
+            surfdataqc%vdmean(ji,jj) = surfdataqc%vdmean(ji,jj)  &
+                   &                    + psurf(ji,jj) * REAL( imask_night(ji,jj) )
+            zmeanday(ji,jj)          = zmeanday(ji,jj) + psurf(ji,jj)
+            icount_night(ji,jj)      = icount_night(ji,jj) + imask_night(ji,jj)
+         END_2D
 
          ! Compute the night-time mean at the end of the day
@@ -787,17 +773,15 @@
          IF ( idayend == 0 ) THEN
             IF (lwp) WRITE(numout,*) 'Calculating surfdataqc%vdmean on time-step: ',kt
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  ! Test if "no night" point
-                  IF ( icount_night(ji,jj) > 0 ) THEN
-                     surfdataqc%vdmean(ji,jj) = surfdataqc%vdmean(ji,jj) &
-                       &                        / REAL( icount_night(ji,jj) )
-                  ELSE
-                     !At locations where there is no night (e.g. poles),
-                     ! calculate daily mean instead of night-time mean.
-                     surfdataqc%vdmean(ji,jj) = zmeanday(ji,jj) * zdaystp
-                  ENDIF
-               END DO
-            END DO
+            DO_2D_11_11
+               ! Test if "no night" point
+               IF ( icount_night(ji,jj) > 0 ) THEN
+                  surfdataqc%vdmean(ji,jj) = surfdataqc%vdmean(ji,jj) &
+                    &                        / REAL( icount_night(ji,jj) )
+               ELSE
+                  !At locations where there is no night (e.g. poles),
+                  ! calculate daily mean instead of night-time mean.
+                  surfdataqc%vdmean(ji,jj) = zmeanday(ji,jj) * zdaystp
+               ENDIF
+            END_2D
          ENDIF
 
@@ -924,5 +908,5 @@
                &                   zglamf(:,:,iobs), zgphif(:,:,iobs), &
                &                   zmask(:,:,iobs), plamscl, pphiscl, &
-               &                   lindegrees, zweig, zobsmask )
+               &                   lindegrees, zweig )
 
             ! Average the model SST to the observation footprint
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/OBS/obs_prep.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/OBS/obs_prep.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/OBS/obs_prep.F90	(revision 12928)
@@ -244,5 +244,5 @@
       &                     kpi, kpj, kpk, &
       &                     zmask1, pglam1, pgphi1, zmask2, pglam2, pgphi2,  &
-      &                     ld_nea, ld_bound_reject, kdailyavtypes,  kqc_cutoff )
+      &                     ld_nea, ld_bound_reject, Kmm, kdailyavtypes,  kqc_cutoff )
 
 !!----------------------------------------------------------------------
@@ -274,4 +274,5 @@
       LOGICAL, INTENT(IN) :: ld_bound_reject      ! Switch for rejecting observations near the boundary
       INTEGER, INTENT(IN) :: kpi, kpj, kpk        ! Local domain sizes
+      INTEGER, INTENT(IN) :: Kmm                  ! time-level index
       INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: &
          & kdailyavtypes                          ! Types for daily averages
@@ -420,5 +421,5 @@
          &                 inlav1obs,             ld_nea,               &
          &                 ibdyv1obs,             ld_bound_reject,      &
-         &                 iqc_cutoff       )
+         &                 iqc_cutoff,            Kmm                 )
 
       CALL obs_mpp_sum_integer( iosdv1obs, iosdv1obsmpp )
@@ -442,5 +443,5 @@
          &                 inlav2obs,             ld_nea,               &
          &                 ibdyv2obs,             ld_bound_reject,      &
-         &                 iqc_cutoff       )
+         &                 iqc_cutoff,            Kmm                 )
 
       CALL obs_mpp_sum_integer( iosdv2obs, iosdv2obsmpp )
@@ -612,5 +613,5 @@
       !! * Modules used
       USE dom_oce, ONLY : &  ! Geographical information
-         & rdt
+         & rn_Dt
       USE phycst, ONLY : &   ! Physical constants
          & rday,  &             
@@ -661,5 +662,5 @@
 
       ! Intialize the number of time steps per day
-      idaystp = NINT( rday / rdt )
+      idaystp = NINT( rday / rn_Dt )
 
       !---------------------------------------------------------------------
@@ -731,5 +732,5 @@
 
          ! Add in the number of time steps to the observation minute
-         zminstp = rmmss / rdt
+         zminstp = rmmss / rn_Dt
          zhoustp = rhhmm * zminstp
 
@@ -1094,5 +1095,5 @@
       &                       klanobs, knlaobs, ld_nea,         &
       &                       kbdyobs, ld_bound_reject,         &
-      &                       kqc_cutoff                        )
+      &                       kqc_cutoff,       Kmm             )
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE obs_coo_spc_3d  ***
@@ -1116,9 +1117,9 @@
       !!----------------------------------------------------------------------
       !! * Modules used
-      USE dom_oce, ONLY : &       ! Geographical information
+      USE dom_oce, ONLY : &       ! Geographical information 
          & gdepw_1d,      &
          & gdepw_0,       &                       
-         & gdepw_n,       &
-         & gdept_n,       &
+         & gdepw,         &
+         & gdept,         &
          & ln_zco,        &
          & ln_zps             
@@ -1160,4 +1161,5 @@
       LOGICAL, INTENT(IN) :: ld_bound_reject  ! Flag observations near open boundary
       INTEGER, INTENT(IN) :: kqc_cutoff     ! Cutoff QC value
+      INTEGER, INTENT(IN) :: Kmm            ! time-level index
 
       !! * Local declarations
@@ -1230,5 +1232,5 @@
       CALL obs_int_comm_2d( 2, 2, kprofno, kpi, kpj, igrdi, igrdj, plam, zglam )
       CALL obs_int_comm_2d( 2, 2, kprofno, kpi, kpj, igrdi, igrdj, pphi, zgphi )
-      CALL obs_int_comm_3d( 2, 2, kprofno, kpi, kpj, kpk, igrdi, igrdj, gdepw_n(:,:,:), &
+      CALL obs_int_comm_3d( 2, 2, kprofno, kpi, kpj, kpk, igrdi, igrdj, gdepw(:,:,:,Kmm), &
         &                     zgdepw )
 
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/OBS/obs_read_altbias.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/OBS/obs_read_altbias.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/OBS/obs_read_altbias.F90	(revision 12928)
@@ -29,5 +29,5 @@
       & gphit
    USE oce, ONLY : &           ! Model variables
-      & sshn
+      & ssh
    USE obs_inter_h2d
    USE obs_utils               ! Various observation tools
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/OBS/obs_readmdt.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/OBS/obs_readmdt.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/OBS/obs_readmdt.F90	(revision 12928)
@@ -25,5 +25,5 @@
       &                    tmask, tmask_i, e1e2t, gphit, glamt
    USE obs_const, ONLY :   obfillflt      ! Fillvalue
-   USE oce      , ONLY :   sshn           ! Model variables
+   USE oce      , ONLY :   ssh            ! Model variables
 
    IMPLICIT NONE
@@ -37,4 +37,6 @@
    REAL(wp), PUBLIC :: rn_mdtcutoff = 65.0_wp  ! MDT cutoff for computed correction
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -44,5 +46,5 @@
 CONTAINS
 
-   SUBROUTINE obs_rea_mdt( sladata, k2dint )
+   SUBROUTINE obs_rea_mdt( sladata, k2dint, Kmm )
       !!---------------------------------------------------------------------
       !!
@@ -59,4 +61,5 @@
       TYPE(obs_surf), INTENT(inout) ::   sladata   ! SLA data
       INTEGER       , INTENT(in)    ::   k2dint    ! ?
+      INTEGER       , INTENT(in)    ::   Kmm       ! ?
       !
       CHARACTER(LEN=12), PARAMETER ::   cpname  = 'obs_rea_mdt'
@@ -106,5 +109,5 @@
       ! Remove the offset between the MDT used with the sla and the model MDT
       IF( nn_msshc == 1 .OR. nn_msshc == 2 ) &
-         & CALL obs_offset_mdt( jpi, jpj, z_mdt, zfill )
+         & CALL obs_offset_mdt( jpi, jpj, z_mdt, zfill, Kmm )
 
       ! Intepolate the MDT already on the model grid at the observation point
@@ -169,5 +172,5 @@
 
 
-   SUBROUTINE obs_offset_mdt( kpi, kpj, mdt, zfill )
+   SUBROUTINE obs_offset_mdt( kpi, kpj, mdt, zfill, Kmm )
       !!---------------------------------------------------------------------
       !!
@@ -183,4 +186,5 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(IN) ::  kpi, kpj
+      INTEGER, INTENT(IN) ::  Kmm
       REAL(wp), DIMENSION(kpi,kpj), INTENT(INOUT) ::   mdt     ! MDT used on the model grid
       REAL(wp)                    , INTENT(IN   ) ::   zfill 
@@ -211,12 +215,10 @@
       zeta2 = 0.0
 
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-          zdxdy = e1e2t(ji,jj) * zpromsk(ji,jj)
-          zarea = zarea + zdxdy
-          zeta1 = zeta1 + mdt(ji,jj) * zdxdy
-          zeta2 = zeta2 + sshn (ji,jj) * zdxdy
-        END DO      
-      END DO
+      DO_2D_11_11
+       zdxdy = e1e2t(ji,jj) * zpromsk(ji,jj)
+       zarea = zarea + zdxdy
+       zeta1 = zeta1 + mdt(ji,jj) * zdxdy
+       zeta2 = zeta2 + ssh(ji,jj,Kmm) * zdxdy
+      END_2D
 
       CALL mpp_sum( 'obs_readmdt', zeta1 )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/OBS/obs_sstbias.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/OBS/obs_sstbias.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/OBS/obs_sstbias.F90	(revision 12928)
@@ -28,5 +28,5 @@
       & glamt
    USE oce, ONLY : &           ! Model variables
-      & sshn
+      & ssh
    USE obs_inter_h2d
    USE obs_utils               ! Various observation tools
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/OBS/obs_write.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/OBS/obs_write.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/OBS/obs_write.F90	(revision 12928)
@@ -46,4 +46,6 @@
    END TYPE obswriinfo
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/abl.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/abl.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/abl.F90	(revision 12928)
@@ -0,0 +1,31 @@
+MODULE abl
+   !!======================================================================
+   !!                      ***  MODULE  abl  ***
+   !! Abl        :  ABL dynamics and active tracers defined in memory
+   !!======================================================================
+   USE par_kind        ! abl parameters
+
+   IMPLICIT NONE
+   PRIVATE
+   !! --------------------------                            !
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:,:)   ::   u_abl        !: i-horizontal velocity   [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:,:)   ::   v_abl        !: j-horizontal velocity   [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:,:,:) ::   tq_abl       !: 4D T-q fields           [Kelvin,kg/kg]
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)     ::   avm_abl      !: turbulent viscosity   [m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)     ::   avt_abl      !: turbulent diffusivity [m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)     ::   mxl_abl      !: mixing length         [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:,:)   ::   tke_abl      !: turbulent kinetic energy [m2/s2]
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)       ::   fft_abl      !: Coriolis parameter    [1/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)       ::   pblh         !: PBL height            [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)       ::   rest_eq
+   !
+   INTEGER , PUBLIC :: nt_n, nt_a       !: now / after indices (equal 1 or 2)
+   !
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id: abl.F90 4990 2014-12-15 16:42:49Z timgraham $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+END MODULE abl
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/cpl_oasis3.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/cpl_oasis3.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/cpl_oasis3.F90	(revision 12928)
@@ -114,5 +114,5 @@
       !------------------------------------------------------------------
       CALL oasis_init_comp ( ncomp_id, TRIM(cd_modname), nerror )
-      IF ( nerror /= OASIS_Ok ) &
+      IF( nerror /= OASIS_Ok ) &
          CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp')
 
@@ -122,5 +122,5 @@
 
       CALL oasis_get_localcomm ( kl_comm, nerror )
-      IF ( nerror /= OASIS_Ok ) &
+      IF( nerror /= OASIS_Ok ) &
          CALL oasis_abort (ncomp_id, 'cpl_init','Failure in oasis_get_localcomm' )
       !
@@ -149,5 +149,5 @@
 
       ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define
-      IF ( ltmp_wapatch ) THEN
+      IF( ltmp_wapatch ) THEN
          nldi_save = nldi   ;   nlei_save = nlei
          nldj_save = nldj   ;   nlej_save = nlej
@@ -203,5 +203,5 @@
       paral(5) = jpiglo                                         ! global extent in x
       
-      IF( ln_ctl ) THEN
+      IF( sn_cfctl%l_oasout ) THEN
          WRITE(numout,*) ' multiexchg: paral (1:5)', paral
          WRITE(numout,*) ' multiexchg: jpi, jpj =', jpi, jpj
@@ -217,5 +217,5 @@
       !
       DO ji = 1, ksnd
-         IF ( ssnd(ji)%laction ) THEN
+         IF( ssnd(ji)%laction ) THEN
 
             IF( ssnd(ji)%nct > nmaxcat ) THEN
@@ -228,5 +228,5 @@
                DO jm = 1, kcplmodel
 
-                  IF ( ssnd(ji)%nct .GT. 1 ) THEN
+                  IF( ssnd(ji)%nct .GT. 1 ) THEN
                      WRITE(cli2,'(i2.2)') jc
                      zclname = TRIM(ssnd(ji)%clname)//'_cat'//cli2
@@ -234,5 +234,5 @@
                      zclname = ssnd(ji)%clname
                   ENDIF
-                  IF ( kcplmodel  > 1 ) THEN
+                  IF( kcplmodel  > 1 ) THEN
                      WRITE(cli2,'(i2.2)') jm
                      zclname = 'model'//cli2//'_'//TRIM(zclname)
@@ -241,15 +241,15 @@
                   IF( agrif_fixed() /= 0 ) THEN 
                      zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname)
-                  END IF
-#endif
-                  IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_Out
+                  ENDIF
+#endif
+                  IF( sn_cfctl%l_oasout ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_Out
                   CALL oasis_def_var (ssnd(ji)%nid(jc,jm), zclname, id_part   , (/ 2, 1 /),   &
                      &                OASIS_Out          , ishape , OASIS_REAL, nerror )
-                  IF ( nerror /= OASIS_Ok ) THEN
+                  IF( nerror /= OASIS_Ok ) THEN
                      WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname)
                      CALL oasis_abort ( ssnd(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' )
                   ENDIF
-                  IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple"
-                  IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple"
+                  IF( sn_cfctl%l_oasout .AND. ssnd(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple"
+                  IF( sn_cfctl%l_oasout .AND. ssnd(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple"
                END DO
             END DO
@@ -262,5 +262,5 @@
       !
       DO ji = 1, krcv
-         IF ( srcv(ji)%laction ) THEN 
+         IF( srcv(ji)%laction ) THEN 
             
             IF( srcv(ji)%nct > nmaxcat ) THEN
@@ -273,5 +273,5 @@
                DO jm = 1, kcplmodel
                   
-                  IF ( srcv(ji)%nct .GT. 1 ) THEN
+                  IF( srcv(ji)%nct .GT. 1 ) THEN
                      WRITE(cli2,'(i2.2)') jc
                      zclname = TRIM(srcv(ji)%clname)//'_cat'//cli2
@@ -279,5 +279,5 @@
                      zclname = srcv(ji)%clname
                   ENDIF
-                  IF ( kcplmodel  > 1 ) THEN
+                  IF( kcplmodel  > 1 ) THEN
                      WRITE(cli2,'(i2.2)') jm
                      zclname = 'model'//cli2//'_'//TRIM(zclname)
@@ -286,15 +286,15 @@
                   IF( agrif_fixed() /= 0 ) THEN 
                      zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname)
-                  END IF
-#endif
-                  IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In
+                  ENDIF
+#endif
+                  IF( sn_cfctl%l_oasout ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In
                   CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part   , (/ 2, 1 /),   &
                      &                OASIS_In           , ishape , OASIS_REAL, nerror )
-                  IF ( nerror /= OASIS_Ok ) THEN
+                  IF( nerror /= OASIS_Ok ) THEN
                      WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname)
                      CALL oasis_abort ( srcv(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' )
                   ENDIF
-                  IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple"
-                  IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple"
+                  IF( sn_cfctl%l_oasout .AND. srcv(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple"
+                  IF( sn_cfctl%l_oasout .AND. srcv(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple"
 
                END DO
@@ -306,9 +306,15 @@
       ! End of definition phase
       !------------------------------------------------------------------
-      
+      !     
+#if defined key_agrif
+      IF( agrif_fixed() == Agrif_Nb_Fine_Grids() ) THEN
+#endif
       CALL oasis_enddef(nerror)
       IF( nerror /= OASIS_Ok )   CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef')
-      !
-      IF ( ltmp_wapatch ) THEN
+#if defined key_agrif
+      ENDIF
+#endif
+      !
+      IF( ltmp_wapatch ) THEN
          nldi = nldi_save   ;   nlei = nlei_save
          nldj = nldj_save   ;   nlej = nlej_save
@@ -332,5 +338,5 @@
       !!--------------------------------------------------------------------
       ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define
-      IF ( ltmp_wapatch ) THEN
+      IF( ltmp_wapatch ) THEN
          nldi_save = nldi   ;   nlei_save = nlei
          nldj_save = nldj   ;   nlej_save = nlej
@@ -349,5 +355,5 @@
                CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo )
                
-               IF ( ln_ctl ) THEN        
+               IF ( sn_cfctl%l_oasout ) THEN        
                   IF ( kinfo == OASIS_Sent     .OR. kinfo == OASIS_ToRest .OR.   &
                      & kinfo == OASIS_SentOut  .OR. kinfo == OASIS_ToRestOut ) THEN
@@ -357,7 +363,7 @@
                      WRITE(numout,*) 'oasis_put:  kstep ', kstep
                      WRITE(numout,*) 'oasis_put:   info ', kinfo
-                     WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(:,:,jc))
-                     WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:,:,jc))
-                     WRITE(numout,*) '     -     Sum value is ', SUM(pdata(:,:,jc))
+                     WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(nldi:nlei,nldj:nlej,jc))
+                     WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(nldi:nlei,nldj:nlej,jc))
+                     WRITE(numout,*) '     -     Sum value is ',    SUM(pdata(nldi:nlei,nldj:nlej,jc))
                      WRITE(numout,*) '****************'
                   ENDIF
@@ -368,5 +374,5 @@
          ENDDO
       ENDDO
-      IF ( ltmp_wapatch ) THEN
+      IF( ltmp_wapatch ) THEN
          nldi = nldi_save   ;   nlei = nlei_save
          nldj = nldj_save   ;   nlej = nlej_save
@@ -393,5 +399,5 @@
       !!--------------------------------------------------------------------
       ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define
-      IF ( ltmp_wapatch ) THEN
+      IF( ltmp_wapatch ) THEN
          nldi_save = nldi   ;   nlei_save = nlei
          nldj_save = nldj   ;   nlej_save = nlej
@@ -403,5 +409,5 @@
       !
       DO jc = 1, srcv(kid)%nct
-         IF ( ltmp_wapatch ) THEN
+         IF( ltmp_wapatch ) THEN
             IF( nimpp           ==      1 ) nldi = 1
             IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi
@@ -420,7 +426,7 @@
                   &        kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut
                
-               IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm)
+               IF ( sn_cfctl%l_oasout )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm)
                
-               IF ( llaction ) THEN
+               IF( llaction ) THEN
                   
                   kinfo = OASIS_Rcv
@@ -432,5 +438,5 @@
                   ENDIF
                   
-                  IF ( ln_ctl ) THEN        
+                  IF ( sn_cfctl%l_oasout ) THEN        
                      WRITE(numout,*) '****************'
                      WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname
@@ -438,7 +444,7 @@
                      WRITE(numout,*) 'oasis_get:   kstep', kstep
                      WRITE(numout,*) 'oasis_get:   info ', kinfo
-                     WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(:,:,jc))
-                     WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:,:,jc))
-                     WRITE(numout,*) '     -     Sum value is ', SUM(pdata(:,:,jc))
+                     WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(nldi:nlei,nldj:nlej,jc))
+                     WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(nldi:nlei,nldj:nlej,jc))
+                     WRITE(numout,*) '     -     Sum value is ',    SUM(pdata(nldi:nlei,nldj:nlej,jc))
                      WRITE(numout,*) '****************'
                   ENDIF
@@ -450,5 +456,5 @@
          ENDDO
 
-         IF ( ltmp_wapatch ) THEN
+         IF( ltmp_wapatch ) THEN
             nldi = nldi_save   ;   nlei = nlei_save
             nldj = nldj_save   ;   nlej = nlej_save
@@ -483,5 +489,5 @@
       !
       DO ji = 1, nsnd
-         IF (ssnd(ji)%laction ) THEN
+         IF(ssnd(ji)%laction ) THEN
             DO jm = 1, ncplmodel
                IF( ssnd(ji)%nid(1,jm) /= -1 ) THEN
@@ -495,5 +501,5 @@
       ENDDO
       DO ji = 1, nrcv
-         IF (srcv(ji)%laction ) THEN
+         IF(srcv(ji)%laction ) THEN
             DO jm = 1, ncplmodel
                IF( srcv(ji)%nid(1,jm) /= -1 ) THEN
@@ -529,5 +535,5 @@
       !
       DEALLOCATE( exfld )
-      IF (nstop == 0) THEN
+      IF(nstop == 0) THEN
          CALL oasis_terminate( nerror )         
       ELSE
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/cyclone.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/cyclone.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/cyclone.F90	(revision 12928)
@@ -37,5 +37,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -137,5 +137,5 @@
             zhemi = SIGN( 1. , zrlat )
             zinfl = 15.* rad                             ! clim inflow angle in Tropical Cyclones
-         IF ( vortex == 0 ) THEN
+         IF( vortex == 0 ) THEN
 
             ! Vortex Holland reconstruct wind at each lon-lat position
@@ -147,54 +147,52 @@
             zb = 2.
 
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-
-                  ! calc distance between TC center and any point following great circle
-                  ! source : http://www.movable-type.co.uk/scripts/latlong.html
-                  zzrglam = rad * glamt(ji,jj) - zrlon
-                  zzrgphi = rad * gphit(ji,jj)
-                  zdist = ra * ACOS(  SIN( zrlat ) * SIN( zzrgphi )   &
-                     &              + COS( zrlat ) * COS( zzrgphi ) * COS( zzrglam ) )
-
-                 IF (zdist < zrout2) THEN ! calculation of wind only to a given max radius
-                  ! shape of the wind profile
-                  zztmp = ( zrmw / ( zdist + 1.e-12 ) )**zb
-                  zztmp =  zvmax * SQRT( zztmp * EXP(1. - zztmp) )    
-
-                  IF (zdist > zrout1) THEN ! bring to zero between r_out1 and r_out2
-                     zztmp = zztmp * ( (zrout2-zdist)*1.e-6 )
-                  ENDIF
-
-                  ! !!! KILL EQ WINDS
-                  ! IF (SIGN( 1. , zrlat ) /= zhemi) THEN
-                  !    zztmp = 0.                              ! winds in other hemisphere
-                  !    IF (ABS(gphit(ji,jj)) <= 5.) zztmp=0.   ! kill between 5N-5S
-                  ! ENDIF
-                  ! IF (ABS(gphit(ji,jj)) <= 10. .and. ABS(gphit(ji,jj)) > 5.) THEN
-                  !    zztmp = zztmp * ( 1./5. * (ABS(gphit(ji,jj)) - 5.) ) 
-                  !    !linear to zero between 10 and 5
-                  ! ENDIF
-                  ! !!! / KILL EQ
-
-                  IF (ABS(gphit(ji,jj)) >= 55.) zztmp = 0. ! kill weak spurious winds at high latitude
-
-                  zwnd_t =   COS( zinfl ) * zztmp    
-                  zwnd_r = - SIN( zinfl ) * zztmp
-
-                  ! Project radial-tangential components on zonal-meridional components
-                  ! -------------------------------------------------------------------
-                  
-                  ! ztheta = azimuthal angle of the great circle between two points
-                  zztmp = COS( zrlat ) * SIN( zzrgphi ) &
-                     &  - SIN( zrlat ) * COS( zzrgphi ) * COS( zzrglam )
-                  ztheta = ATAN2(        COS( zzrgphi ) * SIN( zzrglam ) , zztmp )
-
-                  zwnd_x(ji,jj) = zwnd_x(ji,jj) - zhemi * COS(ztheta)*zwnd_t + SIN(ztheta)*zwnd_r
-                  zwnd_y(ji,jj) = zwnd_y(ji,jj) + zhemi * SIN(ztheta)*zwnd_t + COS(ztheta)*zwnd_r
-                 ENDIF
-               END DO
-            END DO
+            DO_2D_11_11
+
+               ! calc distance between TC center and any point following great circle
+               ! source : http://www.movable-type.co.uk/scripts/latlong.html
+               zzrglam = rad * glamt(ji,jj) - zrlon
+               zzrgphi = rad * gphit(ji,jj)
+               zdist = ra * ACOS(  SIN( zrlat ) * SIN( zzrgphi )   &
+                  &              + COS( zrlat ) * COS( zzrgphi ) * COS( zzrglam ) )
+
+              IF(zdist < zrout2) THEN ! calculation of wind only to a given max radius
+               ! shape of the wind profile
+               zztmp = ( zrmw / ( zdist + 1.e-12 ) )**zb
+               zztmp =  zvmax * SQRT( zztmp * EXP(1. - zztmp) )    
+
+               IF(zdist > zrout1) THEN ! bring to zero between r_out1 and r_out2
+                  zztmp = zztmp * ( (zrout2-zdist)*1.e-6 )
+               ENDIF
+
+               ! !!! KILL EQ WINDS
+               ! IF(SIGN( 1. , zrlat ) /= zhemi) THEN
+               !    zztmp = 0.                              ! winds in other hemisphere
+               !    IF(ABS(gphit(ji,jj)) <= 5.) zztmp=0.   ! kill between 5N-5S
+               ! ENDIF
+               ! IF(ABS(gphit(ji,jj)) <= 10. .and. ABS(gphit(ji,jj)) > 5.) THEN
+               !    zztmp = zztmp * ( 1./5. * (ABS(gphit(ji,jj)) - 5.) ) 
+               !    !linear to zero between 10 and 5
+               ! ENDIF
+               ! !!! / KILL EQ
+
+               IF(ABS(gphit(ji,jj)) >= 55.) zztmp = 0. ! kill weak spurious winds at high latitude
+
+               zwnd_t =   COS( zinfl ) * zztmp    
+               zwnd_r = - SIN( zinfl ) * zztmp
+
+               ! Project radial-tangential components on zonal-meridional components
+               ! -------------------------------------------------------------------
+               
+               ! ztheta = azimuthal angle of the great circle between two points
+               zztmp = COS( zrlat ) * SIN( zzrgphi ) &
+                  &  - SIN( zrlat ) * COS( zzrgphi ) * COS( zzrglam )
+               ztheta = ATAN2(        COS( zzrgphi ) * SIN( zzrglam ) , zztmp )
+
+               zwnd_x(ji,jj) = zwnd_x(ji,jj) - zhemi * COS(ztheta)*zwnd_t + SIN(ztheta)*zwnd_r
+               zwnd_y(ji,jj) = zwnd_y(ji,jj) + zhemi * SIN(ztheta)*zwnd_t + COS(ztheta)*zwnd_r
+              ENDIF
+            END_2D
          
-         ELSE IF ( vortex == 1 ) THEN
+         ELSE IF( vortex == 1 ) THEN
 
             ! Vortex Willoughby reconstruct wind at each lon-lat position
@@ -206,59 +204,57 @@
             zn   =   2.1340 + 0.0077*zvmax - 0.4522*LOG(zrmw/1000.) - 0.0038*ABS( ztct(jtc,jp_lat) )            
             zA   =   0.5913 + 0.0029*zvmax - 0.1361*LOG(zrmw/1000.) - 0.0042*ABS( ztct(jtc,jp_lat) )  
-            IF (zA < 0) THEN 
+            IF(zA < 0) THEN 
                zA=0
             ENDIF           
         
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                                  
-                  zzrglam = rad * glamt(ji,jj) - zrlon
-                  zzrgphi = rad * gphit(ji,jj)
-                  zdist = ra * ACOS(  SIN( zrlat ) * SIN( zzrgphi )   &
-                     &              + COS( zrlat ) * COS( zzrgphi ) * COS( zzrglam ) )
-
-                 IF (zdist < zrout2) THEN ! calculation of wind only to a given max radius
+            DO_2D_11_11
+                               
+               zzrglam = rad * glamt(ji,jj) - zrlon
+               zzrgphi = rad * gphit(ji,jj)
+               zdist = ra * ACOS(  SIN( zrlat ) * SIN( zzrgphi )   &
+                  &              + COS( zrlat ) * COS( zzrgphi ) * COS( zzrglam ) )
+
+              IF(zdist < zrout2) THEN ! calculation of wind only to a given max radius
+            
+               ! shape of the wind profile                     
+               IF(zdist <= zrmw) THEN     ! inside the Radius of Maximum Wind
+                  zztmp  = zvmax * (zdist/zrmw)**zn
+               ELSE 
+                  zztmp  = zvmax * ( (1-zA) * EXP(- (zdist-zrmw)/zXX1 ) + zA * EXP(- (zdist-zrmw)/zXX2 ) )
+               ENDIF
+
+               IF(zdist > zrout1) THEN ! bring to zero between r_out1 and r_out2
+                  zztmp = zztmp * ( (zrout2-zdist)*1.e-6 )
+               ENDIF
+
+               ! !!! KILL EQ WINDS
+               ! IF(SIGN( 1. , zrlat ) /= zhemi) THEN
+               !    zztmp = 0.                              ! winds in other hemisphere
+               !    IF(ABS(gphit(ji,jj)) <= 5.) zztmp=0.   ! kill between 5N-5S
+               ! ENDIF
+               ! IF(ABS(gphit(ji,jj)) <= 10. .and. ABS(gphit(ji,jj)) > 5.) THEN
+               !    zztmp = zztmp * ( 1./5. * (ABS(gphit(ji,jj)) - 5.) ) 
+               !    !linear to zero between 10 and 5
+               ! ENDIF
+               ! !!! / KILL EQ
+
+               IF(ABS(gphit(ji,jj)) >= 55.) zztmp = 0. ! kill weak spurious winds at high latitude
+
+               zwnd_t =   COS( zinfl ) * zztmp    
+               zwnd_r = - SIN( zinfl ) * zztmp
+
+               ! Project radial-tangential components on zonal-meridional components
+               ! -------------------------------------------------------------------
                
-                  ! shape of the wind profile                     
-                  IF (zdist <= zrmw) THEN     ! inside the Radius of Maximum Wind
-                     zztmp  = zvmax * (zdist/zrmw)**zn
-                  ELSE 
-                     zztmp  = zvmax * ( (1-zA) * EXP(- (zdist-zrmw)/zXX1 ) + zA * EXP(- (zdist-zrmw)/zXX2 ) )
-                  ENDIF
-
-                  IF (zdist > zrout1) THEN ! bring to zero between r_out1 and r_out2
-                     zztmp = zztmp * ( (zrout2-zdist)*1.e-6 )
-                  ENDIF
-
-                  ! !!! KILL EQ WINDS
-                  ! IF (SIGN( 1. , zrlat ) /= zhemi) THEN
-                  !    zztmp = 0.                              ! winds in other hemisphere
-                  !    IF (ABS(gphit(ji,jj)) <= 5.) zztmp=0.   ! kill between 5N-5S
-                  ! ENDIF
-                  ! IF (ABS(gphit(ji,jj)) <= 10. .and. ABS(gphit(ji,jj)) > 5.) THEN
-                  !    zztmp = zztmp * ( 1./5. * (ABS(gphit(ji,jj)) - 5.) ) 
-                  !    !linear to zero between 10 and 5
-                  ! ENDIF
-                  ! !!! / KILL EQ
-
-                  IF (ABS(gphit(ji,jj)) >= 55.) zztmp = 0. ! kill weak spurious winds at high latitude
-
-                  zwnd_t =   COS( zinfl ) * zztmp    
-                  zwnd_r = - SIN( zinfl ) * zztmp
-
-                  ! Project radial-tangential components on zonal-meridional components
-                  ! -------------------------------------------------------------------
-                  
-                  ! ztheta = azimuthal angle of the great circle between two points
-                  zztmp = COS( zrlat ) * SIN( zzrgphi ) &
-                     &  - SIN( zrlat ) * COS( zzrgphi ) * COS( zzrglam )
-                  ztheta = ATAN2(        COS( zzrgphi ) * SIN( zzrglam ) , zztmp )
-
-                  zwnd_x(ji,jj) = zwnd_x(ji,jj) - zhemi * COS(ztheta)*zwnd_t + SIN(ztheta)*zwnd_r
-                  zwnd_y(ji,jj) = zwnd_y(ji,jj) + zhemi * SIN(ztheta)*zwnd_t + COS(ztheta)*zwnd_r
-                  
-                 ENDIF
-               END DO
-            END DO
+               ! ztheta = azimuthal angle of the great circle between two points
+               zztmp = COS( zrlat ) * SIN( zzrgphi ) &
+                  &  - SIN( zrlat ) * COS( zzrgphi ) * COS( zzrglam )
+               ztheta = ATAN2(        COS( zzrgphi ) * SIN( zzrglam ) , zztmp )
+
+               zwnd_x(ji,jj) = zwnd_x(ji,jj) - zhemi * COS(ztheta)*zwnd_t + SIN(ztheta)*zwnd_r
+               zwnd_y(ji,jj) = zwnd_y(ji,jj) + zhemi * SIN(ztheta)*zwnd_t + COS(ztheta)*zwnd_r
+               
+              ENDIF
+            END_2D
          ENDIF                                         ! / vortex Holland or Wiloughby
          ENDIF                                           ! / cyclone is defined in this slot ? yes--> begin
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/fldread.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/fldread.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/fldread.F90	(revision 12928)
@@ -13,9 +13,9 @@
    !!   fld_read      : read input fields used for the computation of the surface boundary condition
    !!   fld_init      : initialization of field read
-   !!   fld_rec       : determined the record(s) to be read
+   !!   fld_def       : define the record(s) of the file and its name
    !!   fld_get       : read the data
    !!   fld_map       : read global data from file and map onto local data using a general mapping (use for open boundaries)
    !!   fld_rot       : rotate the vector fields onto the local grid direction
-   !!   fld_clopn     : update the data file name and close/open the files
+   !!   fld_clopn     : close/open the files
    !!   fld_fill      : fill the data structure with the associated information read in namelist
    !!   wgt_list      : manage the weights used for interpolation
@@ -25,5 +25,6 @@
    !!   seaoverland   : create shifted matrices for seaoverland application
    !!   fld_interp    : apply weights to input gridded data to create data on model grid
-   !!   ksec_week     : function returning the first 3 letters of the first day of the weekly file
+   !!   fld_filename  : define the filename according to a given date
+   !!   ksec_week     : function returning seconds between 00h of the beginning of the week and half of the current time step
    !!----------------------------------------------------------------------
    USE oce            ! ocean dynamics and tracers
@@ -44,5 +45,5 @@
    PUBLIC   fld_map    ! routine called by tides_init
    PUBLIC   fld_read, fld_fill   ! called by sbc... modules
-   PUBLIC   fld_clopn
+   PUBLIC   fld_def
 
    TYPE, PUBLIC ::   FLD_N      !: Namelist field informations
@@ -72,6 +73,7 @@
       INTEGER , DIMENSION(2)          ::   nrec_b       ! before record (1: index, 2: second since Jan. 1st 00h of nit000 year)
       INTEGER , DIMENSION(2)          ::   nrec_a       ! after  record (1: index, 2: second since Jan. 1st 00h of nit000 year)
-      REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:  ) ::   fnow   ! input fields interpolated to now time step
-      REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:,:) ::   fdta   ! 2 consecutive record of input fields
+      INTEGER , ALLOCATABLE, DIMENSION(:      ) ::   nrecsec   ! 
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:  ) ::   fnow   ! input fields interpolated to now time step
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   fdta   ! 2 consecutive record of input fields
       CHARACTER(len = 256)            ::   wgtname      ! current name of the NetCDF weight file acting as a key
       !                                                 ! into the WGTLIST structure
@@ -118,8 +120,11 @@
    TYPE( WGT ), DIMENSION(tot_wgts)   ::   ref_wgts     ! array of wgts
    INTEGER                            ::   nxt_wgt = 1  ! point to next available space in ref_wgts array
+   INTEGER                            ::   nflag = 0
    REAL(wp), PARAMETER                ::   undeff_lsm = -999.00_wp
 
 !$AGRIF_END_DO_NOT_TREAT
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -129,5 +134,5 @@
 CONTAINS
 
-   SUBROUTINE fld_read( kt, kn_fsbc, sd, kit, kt_offset )
+   SUBROUTINE fld_read( kt, kn_fsbc, sd, kit, pt_offset, Kmm )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE fld_read  ***
@@ -145,19 +150,12 @@
       TYPE(FLD), INTENT(inout), DIMENSION(:) ::   sd        ! input field related variables
       INTEGER  , INTENT(in   ), OPTIONAL     ::   kit       ! subcycle timestep for timesplitting option
-      INTEGER  , INTENT(in   ), OPTIONAL     ::   kt_offset ! provide fields at time other than "now"
-      !                                                     !   kt_offset = -1 => fields at "before" time level
-      !                                                     !   kt_offset = +1 => fields at "after"  time level
-      !                                                     !   etc.
-      !!
-      INTEGER  ::   itmp         ! local variable
+      REAL(wp) , INTENT(in   ), OPTIONAL     ::   pt_offset ! provide fields at time other than "now"
+      INTEGER  , INTENT(in   ), OPTIONAL     ::   Kmm       ! ocean time level index
+      !!
       INTEGER  ::   imf          ! size of the structure sd
       INTEGER  ::   jf           ! dummy indices
-      INTEGER  ::   isecend      ! number of second since Jan. 1st 00h of nit000 year at nitend
       INTEGER  ::   isecsbc      ! number of seconds between Jan. 1st 00h of nit000 year and the middle of sbc time step
-      INTEGER  ::   it_offset    ! local time offset variable
-      LOGICAL  ::   llnxtyr      ! open next year  file?
-      LOGICAL  ::   llnxtmth     ! open next month file?
-      LOGICAL  ::   llstop       ! stop is the file does not exist
       LOGICAL  ::   ll_firstcall ! true if this is the first call to fld_read for this set of fields
+      REAL(wp) ::   zt_offset    ! local time offset variable
       REAL(wp) ::   ztinta       ! ratio applied to after  records when doing time interpolation
       REAL(wp) ::   ztintb       ! ratio applied to before records when doing time interpolation
@@ -167,14 +165,15 @@
       IF( PRESENT(kit) )   ll_firstcall = ll_firstcall .and. kit == 1
 
-      IF ( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc
-      ELSE                                      ;   it_offset = 0
-      ENDIF
-      IF( PRESENT(kt_offset) )   it_offset = kt_offset
-
-      ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 
-      IF( present(kit) ) THEN   ! ignore kn_fsbc in this case
-         isecsbc = nsec_year + nsec1jan000 + (kit+it_offset)*NINT( rdt/REAL(nn_baro,wp) )
+      IF( nn_components == jp_iam_sas ) THEN   ;   zt_offset = REAL( nn_fsbc, wp )
+      ELSE                                     ;   zt_offset = 0.
+      ENDIF
+      IF( PRESENT(pt_offset) )   zt_offset = pt_offset
+
+      ! Note that all varibles starting by nsec_* are shifted time by +1/2 time step to be centrered
+      IF( PRESENT(kit) ) THEN   ! ignore kn_fsbc in this case
+         isecsbc = nsec_year + nsec1jan000 + NINT( (     REAL(      kit,wp) + zt_offset ) * rn_Dt / REAL(nn_e,wp) )
       ELSE                      ! middle of sbc time step
-         isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdt) + it_offset * NINT(rdt)
+         ! note: we use kn_fsbc-1 because nsec_year is defined at the middle of the current time step
+         isecsbc = nsec_year + nsec1jan000 + NINT( ( 0.5*REAL(kn_fsbc-1,wp) + zt_offset ) * rn_Dt )
       ENDIF
       imf = SIZE( sd )
@@ -183,5 +182,5 @@
          DO jf = 1, imf 
             IF( TRIM(sd(jf)%clrootname) == 'NOT USED' )   CYCLE
-            CALL fld_init( kn_fsbc, sd(jf) )       ! read each before field (put them in after as they will be swapped)
+            CALL fld_init( isecsbc, sd(jf) )       ! read each before field (put them in after as they will be swapped)
          END DO
          IF( lwp ) CALL wgt_print()                ! control print
@@ -192,90 +191,8 @@
          !
          DO jf = 1, imf                            ! ---   loop over field   --- !
-
+            !
             IF( TRIM(sd(jf)%clrootname) == 'NOT USED' )   CYCLE
-                      
-            IF( isecsbc > sd(jf)%nrec_a(2) .OR. ll_firstcall ) THEN    ! read/update the after data?
-
-               sd(jf)%nrec_b(:) = sd(jf)%nrec_a(:)                                  ! swap before record informations
-               sd(jf)%rotn(1) = sd(jf)%rotn(2)                                      ! swap before rotate informations
-               IF( sd(jf)%ln_tint )   sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2)   ! swap before record field
-
-               CALL fld_rec( kn_fsbc, sd(jf), kt_offset = it_offset, kit = kit )    ! update after record informations
-
-               ! if kn_fsbc*rdt is larger than freqh (which is kind of odd),
-               ! it is possible that the before value is no more the good one... we have to re-read it
-               ! if before is not the last record of the file currently opened and after is the first record to be read
-               ! in a new file which means after = 1 (the file to be opened corresponds to the current time)
-               ! or after = nreclast + 1 (the file to be opened corresponds to a future time step)
-               IF( .NOT. ll_firstcall .AND. sd(jf)%ln_tint .AND. sd(jf)%nrec_b(1) /= sd(jf)%nreclast &
-                  &                   .AND. MOD( sd(jf)%nrec_a(1), sd(jf)%nreclast ) == 1 ) THEN
-                  itmp = sd(jf)%nrec_a(1)                       ! temporary storage
-                  sd(jf)%nrec_a(1) = sd(jf)%nreclast            ! read the last record of the file currently opened
-                  CALL fld_get( sd(jf) )                        ! read after data
-                  sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2)   ! re-swap before record field
-                  sd(jf)%nrec_b(1) = sd(jf)%nrec_a(1)           ! update before record informations
-                  sd(jf)%nrec_b(2) = sd(jf)%nrec_a(2) - NINT( sd(jf)%freqh * 3600. )  ! assume freq to be in hours in this case
-                  sd(jf)%rotn(1)   = sd(jf)%rotn(2)             ! update before rotate informations
-                  sd(jf)%nrec_a(1) = itmp                       ! move back to after record 
-               ENDIF
-
-               CALL fld_clopn( sd(jf) )   ! Do we need to open a new year/month/week/day file?
-               
-               IF( sd(jf)%ln_tint ) THEN
-                  
-                  ! if kn_fsbc*rdt is larger than freqh (which is kind of odd),
-                  ! it is possible that the before value is no more the good one... we have to re-read it
-                  ! if before record is not just just before the after record...
-                  IF( .NOT. ll_firstcall .AND. MOD( sd(jf)%nrec_a(1), sd(jf)%nreclast ) /= 1 &
-                     &                   .AND. sd(jf)%nrec_b(1) /= sd(jf)%nrec_a(1) - 1 ) THEN   
-                     sd(jf)%nrec_a(1) = sd(jf)%nrec_a(1) - 1       ! move back to before record
-                     CALL fld_get( sd(jf) )                        ! read after data
-                     sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2)   ! re-swap before record field
-                     sd(jf)%nrec_b(1) = sd(jf)%nrec_a(1)           ! update before record informations
-                     sd(jf)%nrec_b(2) = sd(jf)%nrec_a(2) - NINT( sd(jf)%freqh * 3600. )  ! assume freq to be in hours in this case
-                     sd(jf)%rotn(1)   = sd(jf)%rotn(2)             ! update before rotate informations
-                     sd(jf)%nrec_a(1) = sd(jf)%nrec_a(1) + 1       ! move back to after record
-                  ENDIF
-               ENDIF ! temporal interpolation?
-
-               ! do we have to change the year/month/week/day of the forcing field?? 
-               ! if we do time interpolation we will need to open next year/month/week/day file before the end of the current
-               ! one. If so, we are still before the end of the year/month/week/day when calling fld_rec so sd(jf)%nrec_a(1)
-               ! will be larger than the record number that should be read for current year/month/week/day
-               ! do we need next file data?
-               ! This applies to both cases with or without time interpolation
-               IF( sd(jf)%nrec_a(1) > sd(jf)%nreclast ) THEN
-                  
-                  sd(jf)%nrec_a(1) = sd(jf)%nrec_a(1) - sd(jf)%nreclast   ! 
-                  
-                  IF( .NOT. ( sd(jf)%ln_clim .AND. sd(jf)%cltype == 'yearly' ) ) THEN   ! close/open the current/new file
-                     
-                     llnxtmth = sd(jf)%cltype == 'monthly' .OR. nday == nmonth_len(nmonth)      ! open next month file?
-                     llnxtyr  = sd(jf)%cltype == 'yearly'  .OR. (nmonth == 12 .AND. llnxtmth)   ! open next year  file?
-
-                     ! if the run finishes at the end of the current year/month/week/day, we will allow next
-                     ! year/month/week/day file to be not present. If the run continue further than the current
-                     ! year/month/week/day, next year/month/week/day file must exist
-                     isecend = nsec_year + nsec1jan000 + (nitend - kt) * NINT(rdt)   ! second at the end of the run
-                     llstop = isecend > sd(jf)%nrec_a(2)                             ! read more than 1 record of next year
-                     ! we suppose that the date of next file is next day (should be ok even for weekly files...)
-                     CALL fld_clopn( sd(jf), nyear  + COUNT((/llnxtyr /))                                           ,         &
-                        &                    nmonth + COUNT((/llnxtmth/)) - 12                 * COUNT((/llnxtyr /)),         &
-                        &                    nday   + 1                   - nmonth_len(nmonth) * COUNT((/llnxtmth/)), llstop )
-
-                     IF( sd(jf)%num <= 0 .AND. .NOT. llstop ) THEN    ! next year file does not exist
-                        CALL ctl_warn('next year/month/week/day file: '//TRIM(sd(jf)%clname)//     &
-                           &     ' not present -> back to current year/month/day')
-                        CALL fld_clopn( sd(jf) )               ! back to the current year/month/day
-                        sd(jf)%nrec_a(1) = sd(jf)%nreclast     ! force to read the last record in the current year file
-                     ENDIF
-                     
-                  ENDIF
-               ENDIF   ! open need next file?
-                  
-               ! read after data
-               CALL fld_get( sd(jf) )
-               
-            ENDIF   ! read new data?
+            CALL fld_update( isecsbc, sd(jf), Kmm )
+            !
          END DO                                    ! --- end loop over field --- !
 
@@ -292,5 +209,5 @@
                   WRITE(numout, clfmt)  TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday,   &            
                      & sd(jf)%nrec_b(1), sd(jf)%nrec_a(1), REAL(sd(jf)%nrec_b(2),wp)/rday, REAL(sd(jf)%nrec_a(2),wp)/rday
-                  WRITE(numout, *) '      it_offset is : ',it_offset
+                  WRITE(numout, *) '      zt_offset is : ',zt_offset
                ENDIF
                ! temporal interpolation weights
@@ -316,121 +233,29 @@
 
 
-   SUBROUTINE fld_init( kn_fsbc, sdjf )
+   SUBROUTINE fld_init( ksecsbc, sdjf )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE fld_init  ***
       !!
-      !! ** Purpose :  - first call to fld_rec to define before values
-      !!               - if time interpolation, read before data 
-      !!----------------------------------------------------------------------
-      INTEGER  , INTENT(in   ) ::   kn_fsbc      ! sbc computation period (in time step) 
+      !! ** Purpose :  - first call(s) to fld_def to define before values
+      !!               - open file
+      !!----------------------------------------------------------------------
+      INTEGER  , INTENT(in   ) ::   ksecsbc   ! 
       TYPE(FLD), INTENT(inout) ::   sdjf         ! input field related variables
-      !!
-      LOGICAL :: llprevyr              ! are we reading previous year  file?
-      LOGICAL :: llprevmth             ! are we reading previous month file?
-      LOGICAL :: llprevweek            ! are we reading previous week  file?
-      LOGICAL :: llprevday             ! are we reading previous day   file?
-      LOGICAL :: llprev                ! llprevyr .OR. llprevmth .OR. llprevweek .OR. llprevday
-      INTEGER :: idvar                 ! variable id 
-      INTEGER :: inrec                 ! number of record existing for this variable
-      INTEGER :: iyear, imonth, iday   ! first day of the current file in yyyy mm dd
-      INTEGER :: isec_week             ! number of seconds since start of the weekly file
-      CHARACTER(LEN=1000) ::   clfmt   ! write format
-      !!---------------------------------------------------------------------
-      !
-      llprevyr   = .FALSE.
-      llprevmth  = .FALSE.
-      llprevweek = .FALSE.
-      llprevday  = .FALSE.
-      isec_week  = 0
-      !
-      ! define record informations
-      CALL fld_rec( kn_fsbc, sdjf, ldbefore = .TRUE. )  ! return before values in sdjf%nrec_a (as we will swap it later)
-      !
-      ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 
-      !
-      IF( sdjf%ln_tint ) THEN ! we need to read the previous record and we will put it in the current record structure
-         !
-         IF( sdjf%nrec_a(1) == 0  ) THEN   ! we redefine record sdjf%nrec_a(1) with the last record of previous year file
-            IF    ( NINT(sdjf%freqh) == -12 ) THEN   ! yearly mean
-               IF( sdjf%cltype == 'yearly' ) THEN             ! yearly file
-                  sdjf%nrec_a(1) = 1                                                       ! force to read the unique record
-                  llprevyr  = .NOT. sdjf%ln_clim                                           ! use previous year  file?
-               ELSE
-                  CALL ctl_stop( "fld_init: yearly mean file must be in a yearly type of file: "//TRIM(sdjf%clrootname) )
-               ENDIF
-            ELSEIF( NINT(sdjf%freqh) ==  -1 ) THEN   ! monthly mean
-               IF( sdjf%cltype == 'monthly' ) THEN            ! monthly file
-                  sdjf%nrec_a(1) = 1                                                       ! force to read the unique record
-                  llprevmth = .TRUE.                                                       ! use previous month file?
-                  llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file?
-               ELSE                                           ! yearly file
-                  sdjf%nrec_a(1) = 12                                                      ! force to read december mean
-                  llprevyr = .NOT. sdjf%ln_clim                                            ! use previous year  file?
-               ENDIF
-            ELSE                                     ! higher frequency mean (in hours) 
-               IF    ( sdjf%cltype      == 'monthly' ) THEN   ! monthly file
-                  sdjf%nrec_a(1) = NINT( 24. * REAL(nmonth_len(nmonth-1),wp) / sdjf%freqh )! last record of previous month
-                  llprevmth = .TRUE.                                                       ! use previous month file?
-                  llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file?
-               ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ! weekly file
-                  llprevweek = .TRUE.                                                      ! use previous week  file?
-                  sdjf%nrec_a(1) = NINT( 24. * 7. / sdjf%freqh )                           ! last record of previous week
-                  isec_week = NINT(rday) * 7                                               ! add a shift toward previous week
-               ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ! daily file
-                  sdjf%nrec_a(1) = NINT( 24. / sdjf%freqh )                                ! last record of previous day
-                  llprevday = .TRUE.                                                       ! use previous day   file?
-                  llprevmth = llprevday .AND. nday   == 1                                  ! use previous month file?
-                  llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file?
-               ELSE                                           ! yearly file
-                  sdjf%nrec_a(1) = NINT( 24. * REAL(nyear_len(0),wp) / sdjf%freqh )        ! last record of previous year 
-                  llprevyr = .NOT. sdjf%ln_clim                                            ! use previous year  file?
-               ENDIF
-            ENDIF
-         ENDIF
-         !
-         IF ( sdjf%cltype(1:4) == 'week' ) THEN
-            isec_week = isec_week + ksec_week( sdjf%cltype(6:8) )   ! second since the beginning of the week
-            llprevmth = isec_week > nsec_month                      ! longer time since the beginning of the week than the month
-            llprevyr  = llprevmth .AND. nmonth == 1
-         ENDIF
-         llprev = llprevyr .OR. llprevmth .OR. llprevweek .OR. llprevday
-         !
-         iyear  = nyear  - COUNT((/llprevyr /))
-         imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /))
-         iday   = nday   - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday)
-         !
-         CALL fld_clopn( sdjf, iyear, imonth, iday, .NOT. llprev )
-         !
-         ! if previous year/month/day file does not exist, we switch to the current year/month/day
-         IF( llprev .AND. sdjf%num <= 0 ) THEN
-            CALL ctl_warn( 'previous year/month/week/day file: '//TRIM(sdjf%clrootname)//   &
-               &           ' not present -> back to current year/month/week/day' )
-            ! we force to read the first record of the current year/month/day instead of last record of previous year/month/day
-            llprev = .FALSE.
-            sdjf%nrec_a(1) = 1
-            CALL fld_clopn( sdjf )
-         ENDIF
-         !
-         IF( llprev ) THEN   ! check if the record sdjf%nrec_a(1) exists in the file
-            idvar = iom_varid( sdjf%num, sdjf%clvar )                                        ! id of the variable sdjf%clvar
-            IF( idvar <= 0 )   RETURN
-            inrec = iom_file( sdjf%num )%dimsz( iom_file( sdjf%num )%ndims(idvar), idvar )   ! size of the last dim of idvar
-            sdjf%nrec_a(1) = MIN( sdjf%nrec_a(1), inrec )   ! make sure we select an existing record
-         ENDIF
-         !
-         ! read before data in after arrays(as we will swap it later)
-         CALL fld_get( sdjf )
-         !
-         clfmt = "('   fld_init : time-interpolation for ', a, ' read previous record = ', i6, ' at time = ', f7.2, ' days')"
-         IF(lwp) WRITE(numout, clfmt) TRIM(sdjf%clvar), sdjf%nrec_a(1), REAL(sdjf%nrec_a(2),wp)/rday
-         !
-      ENDIF
+      !!---------------------------------------------------------------------
+      !
+      IF( nflag == 0 )   nflag = -( HUGE(0) - 10 )
+      !
+      CALL fld_def( sdjf )
+      IF( sdjf%ln_tint .AND. ksecsbc < sdjf%nrecsec(1) )   CALL fld_def( sdjf, ldprev = .TRUE. )
+      !
+      CALL fld_clopn( sdjf )
+      sdjf%nrec_a(:) = (/ 1, nflag /)  ! default definition to force flp_update to read the file.
       !
    END SUBROUTINE fld_init
 
 
-   SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore, kit, kt_offset )
-      !!---------------------------------------------------------------------
-      !!                    ***  ROUTINE fld_rec  ***
+   SUBROUTINE fld_update( ksecsbc, sdjf, Kmm )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE fld_update  ***
       !!
       !! ** Purpose : Compute
@@ -441,162 +266,74 @@
       !!                  nrec_b(2) and nrec_a(2): time of the beginning and end of the record
       !!----------------------------------------------------------------------
-      INTEGER  , INTENT(in   )           ::   kn_fsbc   ! sbc computation period (in time step) 
-      TYPE(FLD), INTENT(inout)           ::   sdjf      ! input field related variables
-      LOGICAL  , INTENT(in   ), OPTIONAL ::   ldbefore  ! sent back before record values (default = .FALSE.)
-      INTEGER  , INTENT(in   ), OPTIONAL ::   kit       ! index of barotropic subcycle
-      !                                                 ! used only if sdjf%ln_tint = .TRUE.
-      INTEGER  , INTENT(in   ), OPTIONAL ::   kt_offset ! Offset of required time level compared to "now"
-      !                                                 !   time level in units of time steps.
-      !
-      LOGICAL  ::   llbefore    ! local definition of ldbefore
-      INTEGER  ::   iendrec     ! end of this record (in seconds)
-      INTEGER  ::   imth        ! month number
-      INTEGER  ::   ifreq_sec   ! frequency mean (in seconds)
-      INTEGER  ::   isec_week   ! number of seconds since the start of the weekly file
-      INTEGER  ::   it_offset   ! local time offset variable
-      REAL(wp) ::   ztmp        ! temporary variable
-      !!----------------------------------------------------------------------
-      !
-      ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 
-      !
-      IF( PRESENT(ldbefore) ) THEN   ;   llbefore = ldbefore .AND. sdjf%ln_tint   ! needed only if sdjf%ln_tint = .TRUE.
-      ELSE                           ;   llbefore = .FALSE.
-      ENDIF
-      !
-      IF ( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc
-      ELSE                                      ;   it_offset = 0
-      ENDIF
-      IF( PRESENT(kt_offset) )      it_offset = kt_offset
-      IF( PRESENT(kit) ) THEN   ;   it_offset = ( kit + it_offset ) * NINT( rdt/REAL(nn_baro,wp) )
-      ELSE                      ;   it_offset =         it_offset   * NINT(       rdt            )
-      ENDIF
-      !
-      !                                           ! =========== !
-      IF    ( NINT(sdjf%freqh) == -12 ) THEN      ! yearly mean
-         !                                        ! =========== !
-         !
-         IF( sdjf%ln_tint ) THEN                  ! time interpolation, shift by 1/2 record
-            !
-            !                  INT( ztmp )
-            !                     /|\
-            !                    1 |    *----
-            !                    0 |----(              
-            !                      |----+----|--> time
-            !                      0   /|\   1   (nday/nyear_len(1))
-            !                           |   
-            !                           |   
-            !       forcing record :    1 
-            !                            
-            ztmp =  REAL( nsec_year, wp ) / ( REAL( nyear_len(1), wp ) * rday ) + 0.5 &
-               &  + REAL( it_offset, wp ) / ( REAL( nyear_len(1), wp ) * rday )
-            sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))
-            ! swap at the middle of the year
-            IF( llbefore ) THEN   ;   sdjf%nrec_a(2) = nsec1jan000 - (1 - INT(ztmp)) * NINT(0.5 * rday) * nyear_len(0) + &
-                                    & INT(ztmp) * NINT( 0.5 * rday) * nyear_len(1) 
-            ELSE                  ;   sdjf%nrec_a(2) = nsec1jan000 + (1 - INT(ztmp)) * NINT(0.5 * rday) * nyear_len(1) + &
-                                    & INT(ztmp) * INT(rday) * nyear_len(1) + INT(ztmp) * NINT( 0.5 * rday) * nyear_len(2) 
+      INTEGER  ,           INTENT(in   ) ::   ksecsbc   ! 
+      TYPE(FLD),           INTENT(inout) ::   sdjf      ! input field related variables
+      INTEGER  , OPTIONAL, INTENT(in   ) ::   Kmm    ! ocean time level index
+      !
+      INTEGER  ::   ja     ! end of this record (in seconds)
+      !!----------------------------------------------------------------------
+      !
+      IF( ksecsbc > sdjf%nrec_a(2) ) THEN     ! --> we need to update after data
+        
+         ! find where is the new after record... (it is not necessary sdjf%nrec_a(1)+1 )
+         ja = sdjf%nrec_a(1)
+         DO WHILE ( ksecsbc >= sdjf%nrecsec(ja) .AND. ja < sdjf%nreclast )   ! Warning: make sure ja <= sdjf%nreclast in this test
+            ja = ja + 1
+         END DO
+         IF( ksecsbc > sdjf%nrecsec(ja) )   ja = ja + 1   ! in case ksecsbc > sdjf%nrecsec(sdjf%nreclast)
+
+         ! if ln_tint and if the new after is not ja+1, we need also to update after data before the swap
+         ! so, after the swap, sdjf%nrec_b(2) will still be the closest value located just before ksecsbc
+         IF( sdjf%ln_tint .AND. ( ja > sdjf%nrec_a(1) + 1 .OR. sdjf%nrec_a(2) == nflag ) ) THEN
+            sdjf%nrec_a(:) = (/ ja-1, sdjf%nrecsec(ja-1) /)   ! update nrec_a with before information
+            CALL fld_get( sdjf, Kmm )                         ! read after data that will be used as before data
+         ENDIF
+            
+         ! if after is in the next file...
+         IF( ja > sdjf%nreclast ) THEN
+            
+            CALL fld_def( sdjf )
+            IF( ksecsbc > sdjf%nrecsec(sdjf%nreclast) )   CALL fld_def( sdjf, ldnext = .TRUE. )
+            CALL fld_clopn( sdjf )           ! open next file
+            
+            ! find where is after in this new file
+            ja = 1
+            DO WHILE ( ksecsbc > sdjf%nrecsec(ja) .AND. ja < sdjf%nreclast )
+               ja = ja + 1
+            END DO
+            IF( ksecsbc > sdjf%nrecsec(ja) )   ja = ja + 1   ! in case ksecsbc > sdjf%nrecsec(sdjf%nreclast)
+            
+            IF( ja > sdjf%nreclast ) THEN
+               CALL ctl_stop( "STOP", "fld_def: need next-next file? we should not be there... file: "//TRIM(sdjf%clrootname) )
             ENDIF
-         ELSE                                     ! no time interpolation
-            sdjf%nrec_a(1) = 1
-            sdjf%nrec_a(2) = NINT(rday) * nyear_len(1) + nsec1jan000   ! swap at the end    of the year
-            sdjf%nrec_b(2) = nsec1jan000                               ! beginning of the year (only for print)
-         ENDIF
-         !
-         !                                        ! ============ !
-      ELSEIF( NINT(sdjf%freqh) ==  -1 ) THEN      ! monthly mean !
-         !                                        ! ============ !
-         !
-         IF( sdjf%ln_tint ) THEN                  ! time interpolation, shift by 1/2 record
-            !
-            !                  INT( ztmp )
-            !                     /|\
-            !                    1 |    *----
-            !                    0 |----(              
-            !                      |----+----|--> time
-            !                      0   /|\   1   (nday/nmonth_len(nmonth))
-            !                           |   
-            !                           |   
-            !       forcing record :  nmonth 
-            !                            
-            ztmp =  REAL( nsec_month, wp ) / ( REAL( nmonth_len(nmonth), wp ) * rday ) + 0.5 &
-           &      + REAL(  it_offset, wp ) / ( REAL( nmonth_len(nmonth), wp ) * rday )
-            imth = nmonth + INT( ztmp ) - COUNT((/llbefore/))
-            IF( sdjf%cltype == 'monthly' ) THEN   ;   sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))
-            ELSE                                  ;   sdjf%nrec_a(1) = imth
+            
+            ! if ln_tint and if after is not the first record, we must (potentially again) update after data before the swap
+            IF( sdjf%ln_tint .AND. ja > 1 ) THEN
+               IF( sdjf%nrecsec(0) /= nflag ) THEN                  ! no trick used: after file is not the current file
+                  sdjf%nrec_a(:) = (/ ja-1, sdjf%nrecsec(ja-1) /)   ! update nrec_a with before information
+                  CALL fld_get( sdjf, Kmm )                         ! read after data that will be used as before data
+               ENDIF
             ENDIF
-            sdjf%nrec_a(2) = nmonth_half(   imth ) + nsec1jan000   ! swap at the middle of the month
-         ELSE                                    ! no time interpolation
-            IF( sdjf%cltype == 'monthly' ) THEN   ;   sdjf%nrec_a(1) = 1
-            ELSE                                  ;   sdjf%nrec_a(1) = nmonth
-            ENDIF
-            sdjf%nrec_a(2) =  nmonth_end(nmonth  ) + nsec1jan000   ! swap at the end    of the month
-            sdjf%nrec_b(2) =  nmonth_end(nmonth-1) + nsec1jan000   ! beginning of the month (only for print)
-         ENDIF
-         !
-         !                                        ! ================================ !
-      ELSE                                        ! higher frequency mean (in hours)
-         !                                        ! ================================ !
-         !
-         ifreq_sec = NINT( sdjf%freqh * 3600. )                                         ! frequency mean (in seconds)
-         IF( sdjf%cltype(1:4) == 'week' )   isec_week = ksec_week( sdjf%cltype(6:8) )   ! since the first day of the current week
-         ! number of second since the beginning of the file
-         IF(     sdjf%cltype      == 'monthly' ) THEN   ;   ztmp = REAL(nsec_month,wp)  ! since the first day of the current month
-         ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ;   ztmp = REAL(isec_week ,wp)  ! since the first day of the current week
-         ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ;   ztmp = REAL(nsec_day  ,wp)  ! since 00h of the current day
-         ELSE                                           ;   ztmp = REAL(nsec_year ,wp)  ! since 00h on Jan 1 of the current year
-         ENDIF
-         ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rdt + REAL( it_offset, wp )        ! centrered in the middle of sbc time step
-         ztmp = ztmp + 0.01 * rdt                                                       ! avoid truncation error 
-         IF( sdjf%ln_tint ) THEN                 ! time interpolation, shift by 1/2 record
-            !
-            !          INT( ztmp/ifreq_sec + 0.5 )
-            !                     /|\
-            !                    2 |        *-----(
-            !                    1 |  *-----(
-            !                    0 |--(              
-            !                      |--+--|--+--|--+--|--> time
-            !                      0 /|\ 1 /|\ 2 /|\ 3    (ztmp/ifreq_sec)
-            !                         |     |     |
-            !                         |     |     |
-            !       forcing record :  1     2     3
-            !                   
-            ztmp= ztmp / REAL(ifreq_sec, wp) + 0.5
-         ELSE                                    ! no time interpolation
-            !
-            !           INT( ztmp/ifreq_sec )
-            !                     /|\
-            !                    2 |           *-----(
-            !                    1 |     *-----(
-            !                    0 |-----(              
-            !                      |--+--|--+--|--+--|--> time
-            !                      0 /|\ 1 /|\ 2 /|\ 3    (ztmp/ifreq_sec)
-            !                         |     |     |
-            !                         |     |     |
-            !       forcing record :  1     2     3
-            !                            
-            ztmp= ztmp / REAL(ifreq_sec, wp)
-         ENDIF
-         sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))   ! record number to be read
-
-         iendrec = ifreq_sec * sdjf%nrec_a(1) + nsec1jan000       ! end of this record (in second)
-         ! add the number of seconds between 00h Jan 1 and the end of previous month/week/day (ok if nmonth=1)
-         IF( sdjf%cltype      == 'monthly' )   iendrec = iendrec + NINT(rday) * SUM(nmonth_len(1:nmonth -1))
-         IF( sdjf%cltype(1:4) == 'week'    )   iendrec = iendrec + ( nsec_year - isec_week )
-         IF( sdjf%cltype      == 'daily'   )   iendrec = iendrec + NINT(rday) * ( nday_year - 1 )
-         IF( sdjf%ln_tint ) THEN
-             sdjf%nrec_a(2) = iendrec - ifreq_sec / 2        ! swap at the middle of the record
+            
+         ENDIF
+
+         IF( sdjf%ln_tint ) THEN 
+            ! Swap data
+            sdjf%nrec_b(:)     = sdjf%nrec_a(:)                     ! swap before record informations
+            sdjf%rotn(1)       = sdjf%rotn(2)                       ! swap before rotate informations
+            sdjf%fdta(:,:,:,1) = sdjf%fdta(:,:,:,2)                 ! swap before record field
          ELSE
-             sdjf%nrec_a(2) = iendrec                        ! swap at the end    of the record
-             sdjf%nrec_b(2) = iendrec - ifreq_sec            ! beginning of the record (only for print)
-         ENDIF
-         !
-      ENDIF
-      !
-      IF( .NOT. sdjf%ln_tint ) sdjf%nrec_a(2) = sdjf%nrec_a(2) - 1   ! last second belongs to bext record : *----(
-      !
-   END SUBROUTINE fld_rec
-
-
-   SUBROUTINE fld_get( sdjf )
+            sdjf%nrec_b(:) = (/ ja-1, sdjf%nrecsec(ja-1) /)         ! only for print 
+         ENDIF
+            
+         ! read new after data
+         sdjf%nrec_a(:) = (/ ja, sdjf%nrecsec(ja) /)                ! update nrec_a as it is used by fld_get
+         CALL fld_get( sdjf, Kmm )                                  ! read after data (with nrec_a informations)
+        
+      ENDIF
+      !
+   END SUBROUTINE fld_update
+
+
+   SUBROUTINE fld_get( sdjf, Kmm )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE fld_get  ***
@@ -604,5 +341,6 @@
       !! ** Purpose :   read the data
       !!----------------------------------------------------------------------
-      TYPE(FLD)        , INTENT(inout) ::   sdjf   ! input field related variables
+      TYPE(FLD),           INTENT(inout) ::   sdjf   ! input field related variables
+      INTEGER  , OPTIONAL, INTENT(in   ) ::   Kmm    ! ocean time level index
       !
       INTEGER ::   ipk      ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk )
@@ -618,7 +356,7 @@
       IF( ASSOCIATED(sdjf%imap) ) THEN
          IF( sdjf%ln_tint ) THEN   ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1),   &
-            &                                        sdjf%imap, sdjf%igrd, sdjf%ibdy, sdjf%ltotvel, sdjf%lzint )
+            &                                        sdjf%imap, sdjf%igrd, sdjf%ibdy, sdjf%ltotvel, sdjf%lzint, Kmm )
          ELSE                      ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1),   &
-            &                                        sdjf%imap, sdjf%igrd, sdjf%ibdy, sdjf%ltotvel, sdjf%lzint )
+            &                                        sdjf%imap, sdjf%igrd, sdjf%ibdy, sdjf%ltotvel, sdjf%lzint, Kmm )
          ENDIF
       ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN
@@ -656,5 +394,5 @@
             ENDIF
          CASE DEFAULT
-            IF (lk_c1d .AND. lmoor ) THEN
+            IF(lk_c1d .AND. lmoor ) THEN
                IF( sdjf%ln_tint ) THEN
                   CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, sdjf%fdta(2,2,:,2), sdjf%nrec_a(1) )
@@ -677,5 +415,5 @@
 
    
-   SUBROUTINE fld_map( knum, cdvar, pdta, krec, kmap, kgrd, kbdy, ldtotvel, ldzint )
+   SUBROUTINE fld_map( knum, cdvar, pdta, krec, kmap, kgrd, kbdy, ldtotvel, ldzint, Kmm )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE fld_map  ***
@@ -694,4 +432,5 @@
       LOGICAL, OPTIONAL         , INTENT(in   ) ::   ldtotvel     ! true if total ( = barotrop + barocline) velocity
       LOGICAL, OPTIONAL         , INTENT(in   ) ::   ldzint       ! true if 3D variable requires a vertical interpolation
+      INTEGER, OPTIONAL         , INTENT(in   ) ::   Kmm          ! ocean time level index 
       !!
       INTEGER                                   ::   ipi          ! length of boundary data on local process
@@ -758,5 +497,5 @@
                
                CALL iom_getatt(knum, '_FillValue', zfv, cdvar=cdvar )
-               CALL fld_bdy_interp(zdta_read, zdta_read_z, zdta_read_dz, pdta, kgrd, kbdy, zfv, ldtotvel)
+               CALL fld_bdy_interp(zdta_read, zdta_read_z, zdta_read_dz, pdta, kgrd, kbdy, zfv, ldtotvel, Kmm)
                DEALLOCATE( zdta_read, zdta_read_z, zdta_read_dz )
                
@@ -822,6 +561,5 @@
    END SUBROUTINE fld_map_core
    
-   
-   SUBROUTINE fld_bdy_interp(pdta_read, pdta_read_z, pdta_read_dz, pdta, kgrd, kbdy, pfv, ldtotvel)
+   SUBROUTINE fld_bdy_interp(pdta_read, pdta_read_z, pdta_read_dz, pdta, kgrd, kbdy, pfv, ldtotvel, Kmm )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE fld_bdy_interp  ***
@@ -833,6 +571,6 @@
 
       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pdta_read       ! data read in bdy file
-      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdta_read_z     ! depth of the data read in bdy file
-      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdta_read_dz    ! thickness of the levels in bdy file
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pdta_read_z     ! depth of the data read in bdy file
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pdta_read_dz    ! thickness of the levels in bdy file
       REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pdta            ! output field on model grid (2 dimensional)
       REAL(wp)                  , INTENT(in   ) ::   pfv             ! fillvalue of the data read in bdy file
@@ -840,12 +578,13 @@
       INTEGER                   , INTENT(in   ) ::   kgrd            ! grid type (t, u, v)
       INTEGER                   , INTENT(in   ) ::   kbdy            ! bdy number
-      !!
-      INTEGER                                   ::   ipi             ! length of boundary data on local process
-      INTEGER                                   ::   ipkb            ! number of vertical levels in boundary data file
-      INTEGER                                   ::   jb, ji, jj, jk, jkb   ! loop counters
-      REAL(wp)                                  ::   zcoef
-      REAL(wp)                                  ::   zl, zi, zh      ! tmp variable for current depth and interpolation factor
-      REAL(wp)                                  ::   zfv_alt, ztrans, ztrans_new ! fillvalue and alternative -ABS(pfv)
-      REAL(wp), DIMENSION(jpk)                  ::   zdepth, zdhalf  ! level and half-level depth
+      INTEGER, OPTIONAL         , INTENT(in   ) ::   Kmm             ! ocean time level index
+      !!
+      INTEGER                  ::   ipi                 ! length of boundary data on local process
+      INTEGER                  ::   ipkb                ! number of vertical levels in boundary data file
+      INTEGER                  ::   ipkmax              ! number of vertical levels in boundary data file where no mask
+      INTEGER                  ::   jb, ji, jj, jk, jkb ! loop counters
+      REAL(wp)                 ::   zcoef, zi           ! 
+      REAL(wp)                 ::   ztrans, ztrans_new  ! transports
+      REAL(wp), DIMENSION(jpk) ::   zdepth, zdhalf      ! level and half-level depth
       !!---------------------------------------------------------------------
      
@@ -853,47 +592,22 @@
       ipkb = SIZE( pdta_read, 3 )
       
-      zfv_alt = -ABS(pfv)  ! set _FillValue < 0 as we make use of MAXVAL and MAXLOC later
-      !
-      WHERE( pdta_read == pfv )
-         pdta_read_z  = zfv_alt ! safety: put fillvalue into external depth field so consistent with data
-         pdta_read_dz = 0._wp   ! safety: put 0._wp into external thickness factors to ensure transport is correct
-      ENDWHERE
-      
       DO jb = 1, ipi
          ji = idx_bdy(kbdy)%nbi(jb,kgrd)
          jj = idx_bdy(kbdy)%nbj(jb,kgrd)
-         zh  = SUM(pdta_read_dz(jb,1,:) )
-         !
-         ! Warnings to flag differences in the input and model topgraphy - is this useful/necessary?
+         !
+         ! --- max jk where input data /= FillValue --- !
+         ipkmax = 1
+         DO jkb = 2, ipkb
+            IF( pdta_read(jb,1,jkb) /= pfv )   ipkmax = MAX( ipkmax, jkb )
+         END DO
+         !
+         ! --- calculate depth at t,u,v points --- !
          SELECT CASE( kgrd )                         
-         CASE(1)
-            IF( ABS( (zh - ht_n(ji,jj)) / ht_n(ji,jj)) * tmask(ji,jj,1) > 0.01_wp ) THEN
-               WRITE(ctmp1,"(I10.10)") jb 
-               CALL ctl_warn('fld_bdy_interp: T depths differ between grids at BDY point '//TRIM(ctmp1)//' by more than 1%')
-               !   IF(lwp) WRITE(numout,*) 'DEPTHT', zh, sum(e3t_n(ji,jj,:), mask=tmask(ji,jj,:)==1),  ht_n(ji,jj), jb, jb, ji, jj
-            ENDIF
-         CASE(2)
-            IF( ABS( (zh - hu_n(ji,jj)) * r1_hu_n(ji,jj)) * umask(ji,jj,1) > 0.01_wp ) THEN
-               WRITE(ctmp1,"(I10.10)") jb 
-               CALL ctl_warn('fld_bdy_interp: U depths differ between grids at BDY point '//TRIM(ctmp1)//' by more than 1%')
-               !   IF(lwp) WRITE(numout,*) 'DEPTHU', zh, SUM(e3u_n(ji,jj,:), mask=umask(ji,jj,:)==1),  SUM(umask(ji,jj,:)), &
-               !      &                hu_n(ji,jj), jb, jb, ji, jj, narea-1, pdta_read(jb,1,:)
-            ENDIF
-         CASE(3)
-            IF( ABS( (zh - hv_n(ji,jj)) * r1_hv_n(ji,jj)) * vmask(ji,jj,1) > 0.01_wp ) THEN
-               WRITE(ctmp1,"(I10.10)") jb
-               CALL ctl_warn('fld_bdy_interp: V depths differ between grids at BDY point '//TRIM(ctmp1)//' by more than 1%')
-            ENDIF
-         END SELECT
-         !
-         SELECT CASE( kgrd )                         
-         CASE(1)
-            ! depth of T points:
-            zdepth(:) = gdept_n(ji,jj,:)
-         CASE(2)
-            ! depth of U points: we must not use gdept_n as we don't want to do a communication
-            !   --> copy what is done for gdept_n in domvvl...
+         CASE(1)            ! depth of T points:
+            zdepth(:) = gdept(ji,jj,:,Kmm)
+         CASE(2)            ! depth of U points: we must not use gdept_n as we don't want to do a communication
+            !                 --> copy what is done for gdept_n in domvvl...
             zdhalf(1) = 0.0_wp
-            zdepth(1) = 0.5_wp * e3uw_n(ji,jj,1)
+            zdepth(1) = 0.5_wp * e3uw(ji,jj,1,Kmm)
             DO jk = 2, jpk                               ! vertical sum
                !    zcoef = umask - wumask    ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt
@@ -902,13 +616,12 @@
                !!gm ???????   BUG ?  gdept_n as well as gde3w_n  does not include the thickness of ISF ??
                zcoef = ( umask(ji,jj,jk) - wumask(ji,jj,jk) )
-               zdhalf(jk) = zdhalf(jk-1) + e3u_n(ji,jj,jk-1)
-               zdepth(jk) =      zcoef  * ( zdhalf(jk  ) + 0.5 * e3uw_n(ji,jj,jk))  &
-                  &         + (1-zcoef) * ( zdepth(jk-1) +       e3uw_n(ji,jj,jk))
+               zdhalf(jk) = zdhalf(jk-1) + e3u(ji,jj,jk-1,Kmm)
+               zdepth(jk) =          zcoef  * ( zdhalf(jk  ) + 0.5_wp * e3uw(ji,jj,jk,Kmm))  &
+                  &         + (1._wp-zcoef) * ( zdepth(jk-1) +          e3uw(ji,jj,jk,Kmm))
             END DO
-         CASE(3)
-            ! depth of V points: we must not use gdept_n as we don't want to do a communication
-            !   --> copy what is done for gdept_n in domvvl...
+         CASE(3)            ! depth of V points: we must not use gdept_n as we don't want to do a communication
+            !                 --> copy what is done for gdept_n in domvvl...
             zdhalf(1) = 0.0_wp
-            zdepth(1) = 0.5_wp * e3vw_n(ji,jj,1)
+            zdepth(1) = 0.5_wp * e3vw(ji,jj,1,Kmm)
             DO jk = 2, jpk                               ! vertical sum
                !    zcoef = vmask - wvmask    ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt
@@ -917,21 +630,21 @@
                !!gm ???????   BUG ?  gdept_n as well as gde3w_n  does not include the thickness of ISF ??
                zcoef = ( vmask(ji,jj,jk) - wvmask(ji,jj,jk) )
-               zdhalf(jk) = zdhalf(jk-1) + e3v_n(ji,jj,jk-1)
-               zdepth(jk) =      zcoef  * ( zdhalf(jk  ) + 0.5 * e3vw_n(ji,jj,jk))  &
-                  &         + (1-zcoef) * ( zdepth(jk-1) +       e3vw_n(ji,jj,jk))
+               zdhalf(jk) = zdhalf(jk-1) + e3v(ji,jj,jk-1,Kmm)
+               zdepth(jk) =          zcoef  * ( zdhalf(jk  ) + 0.5_wp * e3vw(ji,jj,jk,Kmm))  &
+                  &         + (1._wp-zcoef) * ( zdepth(jk-1) +          e3vw(ji,jj,jk,Kmm))
             END DO
          END SELECT
-         !
-         DO jk = 1, jpk                      
-            IF(     zdepth(jk) < pdta_read_z(jb,1,          1) ) THEN                ! above the first level of external data
-               pdta(jb,1,jk) =  pdta_read(jb,1,1)
-            ELSEIF( zdepth(jk) > pdta_read_z(jb,1,ipkb) ) THEN                       ! below the last level of external data 
-               pdta(jb,1,jk) =  pdta_read(jb,1,MAXLOC(pdta_read_z(jb,1,:),1))
-            ELSE                                                             ! inbetween: vertical interpolation between jkb & jkb+1
-               DO jkb = 1, ipkb-1                                            ! when  gdept_n(jkb) < zdepth(jk) < gdept_n(jkb+1)
-                  IF( ( ( zdepth(jk) - pdta_read_z(jb,1,jkb) ) * ( zdepth(jk) - pdta_read_z(jb,1,jkb+1) ) <= 0._wp ) &
-                     &    .AND. ( pdta_read_z(jb,1,jkb+1) /= zfv_alt) ) THEN   ! linear interpolation between 2 levels
+         !         
+         ! --- interpolate bdy data on the model grid --- !
+         DO jk = 1, jpk
+            IF(     zdepth(jk) <= pdta_read_z(jb,1,1)      ) THEN   ! above the first level of external data
+               pdta(jb,1,jk) = pdta_read(jb,1,1)
+            ELSEIF( zdepth(jk) >  pdta_read_z(jb,1,ipkmax) ) THEN   ! below the last level of external data /= FillValue
+               pdta(jb,1,jk) = pdta_read(jb,1,ipkmax)
+            ELSE                                                    ! inbetween: vertical interpolation between jkb & jkb+1
+               DO jkb = 1, ipkmax-1
+                  IF( ( ( zdepth(jk) - pdta_read_z(jb,1,jkb) ) * ( zdepth(jk) - pdta_read_z(jb,1,jkb+1) ) ) <= 0._wp ) THEN ! linear interpolation between 2 levels
                      zi = ( zdepth(jk) - pdta_read_z(jb,1,jkb) ) / ( pdta_read_z(jb,1,jkb+1) - pdta_read_z(jb,1,jkb) )
-                     pdta(jb,1,jk) = pdta_read(jb,1,jkb) + ( pdta_read  (jb,1,jkb+1) - pdta_read  (jb,1,jkb) ) * zi
+                     pdta(jb,1,jk) = pdta_read(jb,1,jkb) + zi * ( pdta_read(jb,1,jkb+1) - pdta_read(jb,1,jkb) )
                   ENDIF
                END DO
@@ -940,50 +653,59 @@
          !
       END DO   ! ipi
-      
-      IF(kgrd == 2) THEN                                  ! do we need to adjust the transport term?
+
+      ! --- mask data and adjust transport --- !
+      SELECT CASE( kgrd )                         
+
+      CASE(1)                                 ! mask data (probably unecessary)
          DO jb = 1, ipi
             ji = idx_bdy(kbdy)%nbi(jb,kgrd)
             jj = idx_bdy(kbdy)%nbj(jb,kgrd)
-            zh  = SUM(pdta_read_dz(jb,1,:) )
+            DO jk = 1, jpk                      
+               pdta(jb,1,jk) = pdta(jb,1,jk) * tmask(ji,jj,jk)
+            END DO
+         END DO
+         
+      CASE(2)                                 ! adjust the U-transport term
+         DO jb = 1, ipi
+            ji = idx_bdy(kbdy)%nbi(jb,kgrd)
+            jj = idx_bdy(kbdy)%nbj(jb,kgrd)
             ztrans = 0._wp
+            DO jkb = 1, ipkb                              ! calculate transport on input grid
+               IF( pdta_read(jb,1,jkb) /= pfv )   ztrans = ztrans + pdta_read(jb,1,jkb) * pdta_read_dz(jb,1,jkb)
+            ENDDO
             ztrans_new = 0._wp
-            DO jkb = 1, ipkb                              ! calculate transport on input grid
-               ztrans     = ztrans     + pdta_read(jb,1,jkb) * pdta_read_dz(jb, 1,jkb)
-            ENDDO
             DO jk = 1, jpk                                ! calculate transport on model grid
-               ztrans_new = ztrans_new +      pdta(jb,1,jk ) *        e3u_n(ji,jj,jk ) * umask(ji,jj,jk)
+               ztrans_new = ztrans_new +      pdta(jb,1,jk ) * e3u(ji,jj,jk,Kmm ) * umask(ji,jj,jk)
             ENDDO
             DO jk = 1, jpk                                ! make transport correction
                IF(ldtotvel) THEN ! bdy data are total velocity so adjust bt transport term to match input data
-                  pdta(jb,1,jk) = ( pdta(jb,1,jk) + ( ztrans - ztrans_new ) * r1_hu_n(ji,jj) ) * umask(ji,jj,jk)
-               ELSE ! we're just dealing with bc velocity so bt transport term should sum to zero
-                  pdta(jb,1,jk) =   pdta(jb,1,jk) + (  0._wp - ztrans_new ) * r1_hu_n(ji,jj)   * umask(ji,jj,jk)
+                  pdta(jb,1,jk) = ( pdta(jb,1,jk) + ( ztrans - ztrans_new ) * r1_hu(ji,jj,Kmm) ) * umask(ji,jj,jk)
+               ELSE              ! we're just dealing with bc velocity so bt transport term should sum to zero
+                  pdta(jb,1,jk) =   pdta(jb,1,jk) + (  0._wp - ztrans_new ) * r1_hu(ji,jj,Kmm)   * umask(ji,jj,jk)
                ENDIF
             ENDDO
          ENDDO
-      ENDIF
-      
-      IF(kgrd == 3) THEN                                  ! do we need to adjust the transport term?
+
+      CASE(3)                                 ! adjust the V-transport term
          DO jb = 1, ipi
             ji = idx_bdy(kbdy)%nbi(jb,kgrd)
             jj = idx_bdy(kbdy)%nbj(jb,kgrd)
-            zh  = SUM(pdta_read_dz(jb,1,:) )
             ztrans = 0._wp
+            DO jkb = 1, ipkb                              ! calculate transport on input grid
+               IF( pdta_read(jb,1,jkb) /= pfv )   ztrans = ztrans + pdta_read(jb,1,jkb) * pdta_read_dz(jb,1,jkb)
+            ENDDO
             ztrans_new = 0._wp
-            DO jkb = 1, ipkb                              ! calculate transport on input grid
-               ztrans     = ztrans     + pdta_read(jb,1,jkb) * pdta_read_dz(jb, 1,jkb)
-            ENDDO
             DO jk = 1, jpk                                ! calculate transport on model grid
-               ztrans_new = ztrans_new +      pdta(jb,1,jk ) *        e3v_n(ji,jj,jk ) * vmask(ji,jj,jk)
+               ztrans_new = ztrans_new +      pdta(jb,1,jk ) * e3v(ji,jj,jk,Kmm ) * vmask(ji,jj,jk)
             ENDDO
             DO jk = 1, jpk                                ! make transport correction
                IF(ldtotvel) THEN ! bdy data are total velocity so adjust bt transport term to match input data
-                  pdta(jb,1,jk) = ( pdta(jb,1,jk) + ( ztrans - ztrans_new ) * r1_hv_n(ji,jj) ) * vmask(ji,jj,jk)
-               ELSE ! we're just dealing with bc velocity so bt transport term should sum to zero
-                  pdta(jb,1,jk) =   pdta(jb,1,jk) + (  0._wp - ztrans_new ) * r1_hv_n(ji,jj)   * vmask(ji,jj,jk)
+                  pdta(jb,1,jk) = ( pdta(jb,1,jk) + ( ztrans - ztrans_new ) * r1_hv(ji,jj,Kmm) ) * vmask(ji,jj,jk)
+               ELSE              ! we're just dealing with bc velocity so bt transport term should sum to zero
+                  pdta(jb,1,jk) =   pdta(jb,1,jk) + (  0._wp - ztrans_new ) * r1_hv(ji,jj,Kmm)   * vmask(ji,jj,jk)
                ENDIF
             ENDDO
          ENDDO
-      ENDIF
+      END SELECT
       
    END SUBROUTINE fld_bdy_interp
@@ -1030,6 +752,6 @@
                            sd(ju)%fdta(:,:,jk,jn) = utmp(:,:)   ;   sd(iv)%fdta(:,:,jk,jn) = vtmp(:,:)
                         ELSE 
-                           CALL rot_rep( sd(ju)%fnow(:,:,jk  ), sd(iv)%fnow(:,:,jk  ), 'T', 'en->i', utmp(:,:) )
-                           CALL rot_rep( sd(ju)%fnow(:,:,jk  ), sd(iv)%fnow(:,:,jk  ), 'T', 'en->j', vtmp(:,:) )
+                           CALL rot_rep( sd(ju)%fnow(:,:,jk   ), sd(iv)%fnow(:,:,jk   ), 'T', 'en->i', utmp(:,:) )
+                           CALL rot_rep( sd(ju)%fnow(:,:,jk   ), sd(iv)%fnow(:,:,jk   ), 'T', 'en->j', vtmp(:,:) )
                            sd(ju)%fnow(:,:,jk   ) = utmp(:,:)   ;   sd(iv)%fnow(:,:,jk   ) = vtmp(:,:)
                         ENDIF
@@ -1047,93 +769,199 @@
 
 
-   SUBROUTINE fld_clopn( sdjf, kyear, kmonth, kday, ldstop )
+   SUBROUTINE fld_def( sdjf, ldprev, ldnext )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE fld_def  ***
+      !!
+      !! ** Purpose :   define the record(s) of the file and its name
+      !!----------------------------------------------------------------------
+      TYPE(FLD)        , INTENT(inout) ::   sdjf       ! input field related variables
+      LOGICAL, OPTIONAL, INTENT(in   ) ::   ldprev     ! 
+      LOGICAL, OPTIONAL, INTENT(in   ) ::   ldnext     ! 
+      !
+      INTEGER  :: jt
+      INTEGER  :: idaysec               ! number of seconds in 1 day = NINT(rday)
+      INTEGER  :: iyr, imt, idy, isecwk
+      INTEGER  :: indexyr, indexmt
+      INTEGER  :: ireclast
+      INTEGER  :: ishift, istart
+      INTEGER, DIMENSION(2)  :: isave
+      REAL(wp) :: zfreqs
+      LOGICAL  :: llprev, llnext, llstop
+      LOGICAL  :: llprevmt, llprevyr
+      LOGICAL  :: llnextmt, llnextyr
+      !!----------------------------------------------------------------------
+      idaysec = NINT(rday)
+      !
+      IF( PRESENT(ldprev) ) THEN   ;   llprev = ldprev
+      ELSE                         ;   llprev = .FALSE.
+      ENDIF
+      IF( PRESENT(ldnext) ) THEN   ;   llnext = ldnext
+      ELSE                         ;   llnext = .FALSE.
+      ENDIF
+
+      ! current file parameters
+      IF( sdjf%cltype(1:4) == 'week' ) THEN          ! find the day of the beginning of the current week
+         isecwk = ksec_week( sdjf%cltype(6:8) )     ! seconds between the beginning of the week and half of current time step
+         llprevmt = isecwk > nsec_month               ! longer time since beginning of the current week than the current month
+         llprevyr = llprevmt .AND. nmonth == 1
+         iyr = nyear  - COUNT((/llprevyr/))
+         imt = nmonth - COUNT((/llprevmt/)) + 12 * COUNT((/llprevyr/))
+         idy = nday + nmonth_len(nmonth-1) * COUNT((/llprevmt/)) - isecwk / idaysec
+         isecwk = nsec_year - isecwk              ! seconds between 00h jan 1st of current year and current week beginning
+      ELSE
+         iyr = nyear
+         imt = nmonth
+         idy = nday
+         isecwk  = 0
+      ENDIF
+
+      ! previous file parameters
+      IF( llprev ) THEN
+         IF( sdjf%cltype(1:4) == 'week'    ) THEN     ! find the day of the beginning of previous week
+            isecwk = isecwk + 7 * idaysec         ! seconds between the beginning of previous week and half of the time step
+            llprevmt = isecwk > nsec_month            ! longer time since beginning of the previous week than the current month
+            llprevyr = llprevmt .AND. nmonth == 1
+            iyr = nyear  - COUNT((/llprevyr/))
+            imt = nmonth - COUNT((/llprevmt/)) + 12 * COUNT((/llprevyr/))
+            idy = nday + nmonth_len(nmonth-1) * COUNT((/llprevmt/)) - isecwk / idaysec
+            isecwk = nsec_year - isecwk           ! seconds between 00h jan 1st of current year and previous week beginning
+         ELSE
+            idy = nday   - COUNT((/ sdjf%cltype == 'daily'                 /))
+            imt = nmonth - COUNT((/ sdjf%cltype == 'monthly' .OR. idy == 0 /))
+            iyr = nyear  - COUNT((/ sdjf%cltype == 'yearly'  .OR. imt == 0 /))
+            IF( idy == 0 ) idy = nmonth_len(imt)
+            IF( imt == 0 ) imt = 12
+            isecwk = 0
+         ENDIF
+      ENDIF
+
+      ! next file parameters
+      IF( llnext ) THEN
+         IF( sdjf%cltype(1:4) == 'week'    ) THEN     ! find the day of the beginning of next week
+            isecwk = 7 * idaysec - isecwk         ! seconds between half of the time step and the beginning of next week
+            llnextmt = isecwk > ( nmonth_len(nmonth)*idaysec - nsec_month )   ! larger than the seconds to the end of the month
+            llnextyr = llnextmt .AND. nmonth == 12
+            iyr = nyear  + COUNT((/llnextyr/))
+            imt = nmonth + COUNT((/llnextmt/)) - 12 * COUNT((/llnextyr/))
+            idy = nday - nmonth_len(nmonth) * COUNT((/llnextmt/)) + isecwk / idaysec + 1
+            isecwk = nsec_year + isecwk           ! seconds between 00h jan 1st of current year and next week beginning
+         ELSE
+            idy = nday   + COUNT((/ sdjf%cltype == 'daily'                                 /))
+            imt = nmonth + COUNT((/ sdjf%cltype == 'monthly' .OR. idy > nmonth_len(nmonth) /))
+            iyr = nyear  + COUNT((/ sdjf%cltype == 'yearly'  .OR. imt == 13                /))
+            IF( idy > nmonth_len(nmonth) )   idy = 1
+            IF( imt == 13                )   imt = 1
+            isecwk = 0
+         ENDIF
+      ENDIF
+      !
+      ! find the last record to be read -> update sdjf%nreclast
+      indexyr = iyr - nyear + 1                 ! which  year are we looking for? previous(0), current(1) or next(2)?
+      indexmt = imt + 12 * ( indexyr - 1 )      ! which month are we looking for (relatively to current year)? 
+      !
+      ! Last record to be read in the current file
+      ! Predefine the number of record in the file according of its type.
+      ! We could compare this number with the number of records in the file and make a stop if the 2 numbers do not match...
+      ! However this would be much less fexible (e.g. for tests) and will force to rewite input files according to nleapy...
+      IF    ( NINT(sdjf%freqh) == -12 ) THEN            ;   ireclast = 1    ! yearly mean: consider only 1 record
+      ELSEIF( NINT(sdjf%freqh) ==  -1 ) THEN                                ! monthly mean:
+         IF(     sdjf%cltype      == 'monthly' ) THEN   ;   ireclast = 1    !  consider that the file has  1 record
+         ELSE                                           ;   ireclast = 12   !  consider that the file has 12 record
+         ENDIF
+      ELSE                                                                  ! higher frequency mean (in hours)
+         IF(     sdjf%cltype      == 'monthly' ) THEN   ;   ireclast = NINT( 24. * REAL(nmonth_len(indexmt), wp) / sdjf%freqh )
+         ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ;   ireclast = NINT( 24. * 7.                            / sdjf%freqh )
+         ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ;   ireclast = NINT( 24.                                 / sdjf%freqh )
+         ELSE                                           ;   ireclast = NINT( 24. * REAL( nyear_len(indexyr), wp) / sdjf%freqh )
+         ENDIF
+      ENDIF
+
+      sdjf%nreclast = ireclast
+      ! Allocate arrays for beginning/middle/end of each record (seconds since Jan. 1st 00h of nit000 year)
+      IF( ALLOCATED(sdjf%nrecsec) )   DEALLOCATE( sdjf%nrecsec )
+      ALLOCATE( sdjf%nrecsec( 0:ireclast ) )
+      !
+      IF    ( NINT(sdjf%freqh) == -12 ) THEN                                     ! yearly mean and yearly file
+         SELECT CASE( indexyr )
+         CASE(0)   ;   sdjf%nrecsec(0) = nsec1jan000 - nyear_len( 0 ) * idaysec
+         CASE(1)   ;   sdjf%nrecsec(0) = nsec1jan000
+         CASE(2)   ;   sdjf%nrecsec(0) = nsec1jan000 + nyear_len( 1 ) * idaysec
+         ENDSELECT
+         sdjf%nrecsec(1) = sdjf%nrecsec(0) + nyear_len( indexyr ) * idaysec
+      ELSEIF( NINT(sdjf%freqh) ==  -1 ) THEN                                     ! monthly mean:
+         IF(     sdjf%cltype      == 'monthly' ) THEN                            !    monthly file
+            sdjf%nrecsec(0   ) = nsec1jan000 + nmonth_beg(indexmt  )
+            sdjf%nrecsec(1   ) = nsec1jan000 + nmonth_beg(indexmt+1)
+         ELSE                                                                    !    yearly  file
+            ishift = 12 * ( indexyr - 1 )
+            sdjf%nrecsec(0:12) = nsec1jan000 + nmonth_beg(1+ishift:13+ishift)
+         ENDIF
+      ELSE                                                                       ! higher frequency mean (in hours)
+         IF(     sdjf%cltype      == 'monthly' ) THEN   ;   istart = nsec1jan000 + nmonth_beg(indexmt)
+         ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ;   istart = nsec1jan000 + isecwk
+         ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ;   istart = nsec1jan000 + nmonth_beg(indexmt) + ( idy - 1 ) * idaysec
+         ELSEIF( indexyr          == 0         ) THEN   ;   istart = nsec1jan000 - nyear_len( 0 ) * idaysec
+         ELSEIF( indexyr          == 2         ) THEN   ;   istart = nsec1jan000 + nyear_len( 1 ) * idaysec
+         ELSE                                           ;   istart = nsec1jan000
+         ENDIF
+         zfreqs = sdjf%freqh * rhhmm * rmmss
+         DO jt = 0, sdjf%nreclast
+            sdjf%nrecsec(jt) = istart + NINT( zfreqs * REAL(jt,wp) )
+         END DO
+      ENDIF
+      !
+      IF( sdjf%ln_tint ) THEN   ! record time defined in the middle of the record, computed using an implementation
+                                ! of the rounded average that is valid over the full integer range
+         sdjf%nrecsec(1:sdjf%nreclast) = sdjf%nrecsec(0:sdjf%nreclast-1) / 2 + sdjf%nrecsec(1:sdjf%nreclast) / 2 + &
+            & MAX( MOD( sdjf%nrecsec(0:sdjf%nreclast-1), 2 ), MOD( sdjf%nrecsec(1:sdjf%nreclast), 2 ) )
+      END IF
+      !
+      sdjf%clname = fld_filename( sdjf, idy, imt, iyr )
+      !
+   END SUBROUTINE fld_def
+
+   
+   SUBROUTINE fld_clopn( sdjf )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE fld_clopn  ***
       !!
-      !! ** Purpose :   update the file name and close/open the files
-      !!----------------------------------------------------------------------
-      TYPE(FLD)        , INTENT(inout) ::   sdjf     ! input field related variables
-      INTEGER, OPTIONAL, INTENT(in   ) ::   kyear    ! year value
-      INTEGER, OPTIONAL, INTENT(in   ) ::   kmonth   ! month value
-      INTEGER, OPTIONAL, INTENT(in   ) ::   kday     ! day value
-      LOGICAL, OPTIONAL, INTENT(in   ) ::   ldstop   ! stop if open to read a non-existing file (default = .TRUE.)
-      !
-      LOGICAL  :: llprevyr              ! are we reading previous year  file?
-      LOGICAL  :: llprevmth             ! are we reading previous month file?
-      INTEGER  :: iyear, imonth, iday   ! first day of the current file in yyyy mm dd
-      INTEGER  :: isec_week             ! number of seconds since start of the weekly file
-      INTEGER  :: indexyr               ! year undex (O/1/2: previous/current/next)
-      REAL(wp) :: zyear_len, zmonth_len ! length (days) of iyear and imonth             ! 
-      CHARACTER(len = 256) ::   clname  ! temporary file name
-      !!----------------------------------------------------------------------
-      IF( PRESENT(kyear) ) THEN                             ! use given values 
-         iyear = kyear
-         imonth = kmonth
-         iday = kday
-         IF ( sdjf%cltype(1:4) == 'week' ) THEN             ! find the day of the beginning of the week
-            isec_week = ksec_week( sdjf%cltype(6:8) )- (86400 * 8 )  
-            llprevmth  = isec_week > nsec_month             ! longer time since beginning of the week than the month
-            llprevyr   = llprevmth .AND. nmonth == 1
-            iyear  = nyear  - COUNT((/llprevyr /))
-            imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /))
-            iday   = nday   + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday)
-         ENDIF
-      ELSE                                                  ! use current day values
-         IF ( sdjf%cltype(1:4) == 'week' ) THEN             ! find the day of the beginning of the week
-            isec_week  = ksec_week( sdjf%cltype(6:8) )      ! second since the beginning of the week
-            llprevmth  = isec_week > nsec_month             ! longer time since beginning of the week than the month
-            llprevyr   = llprevmth .AND. nmonth == 1
-         ELSE
-            isec_week  = 0
-            llprevmth  = .FALSE.
-            llprevyr   = .FALSE.
-         ENDIF
-         iyear  = nyear  - COUNT((/llprevyr /))
-         imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /))
-         iday   = nday   + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday)
-      ENDIF
-
-      ! build the new filename if not climatological data
-      clname=TRIM(sdjf%clrootname)
-      !
-      ! note that sdjf%ln_clim is is only acting on the presence of the year in the file name
-      IF( .NOT. sdjf%ln_clim ) THEN   
-                                         WRITE(clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), iyear    ! add year
-         IF( sdjf%cltype /= 'yearly' )   WRITE(clname, '(a,"m" ,i2.2)' ) TRIM( clname          ), imonth   ! add month
-      ELSE
-         ! build the new filename if climatological data
-         IF( sdjf%cltype /= 'yearly' )   WRITE(clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), imonth   ! add month
-      ENDIF
-      IF( sdjf%cltype == 'daily' .OR. sdjf%cltype(1:4) == 'week' ) &
-            &                            WRITE(clname, '(a,"d" ,i2.2)' ) TRIM( clname          ), iday     ! add day
-      !
-      IF( TRIM(clname) /= TRIM(sdjf%clname) .OR. sdjf%num == 0 ) THEN   ! new file to be open 
-         !
-         sdjf%clname = TRIM(clname)
-         IF( sdjf%num /= 0 )   CALL iom_close( sdjf%num )   ! close file if already open
-         CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof =  LEN(TRIM(sdjf%wgtname)) > 0 )
-         !
-         ! find the last record to be read -> update sdjf%nreclast
-         indexyr = iyear - nyear + 1
-         zyear_len = REAL(nyear_len( indexyr ), wp)
-         SELECT CASE ( indexyr )
-         CASE ( 0 )   ;   zmonth_len = 31.   ! previous year -> imonth = 12
-         CASE ( 1 )   ;   zmonth_len = REAL(nmonth_len(imonth), wp)
-         CASE ( 2 )   ;   zmonth_len = 31.   ! next     year -> imonth = 1
-         END SELECT
-         !
-         ! last record to be read in the current file
-         IF    ( sdjf%freqh == -12. ) THEN                 ;   sdjf%nreclast = 1    !  yearly mean
-         ELSEIF( sdjf%freqh ==  -1. ) THEN                                          ! monthly mean
-            IF(     sdjf%cltype      == 'monthly' ) THEN   ;   sdjf%nreclast = 1
-            ELSE                                           ;   sdjf%nreclast = 12
-            ENDIF
-         ELSE                                                                       ! higher frequency mean (in hours)
-            IF(     sdjf%cltype      == 'monthly' ) THEN   ;   sdjf%nreclast = NINT( 24. * zmonth_len / sdjf%freqh )
-            ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ;   sdjf%nreclast = NINT( 24. * 7.         / sdjf%freqh )
-            ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ;   sdjf%nreclast = NINT( 24.              / sdjf%freqh )
-            ELSE                                           ;   sdjf%nreclast = NINT( 24. * zyear_len  / sdjf%freqh )
-            ENDIF
-         ENDIF
+      !! ** Purpose :   close/open the files
+      !!----------------------------------------------------------------------
+      TYPE(FLD)        , INTENT(inout) ::   sdjf       ! input field related variables
+      !
+      INTEGER, DIMENSION(2)  :: isave
+      LOGICAL  :: llprev, llnext, llstop
+      !!----------------------------------------------------------------------
+      !
+      llprev = sdjf%nrecsec(sdjf%nreclast) < nsec000_1jan000   ! file ends before the beginning of the job -> file may not exist
+      llnext = sdjf%nrecsec(       0     ) > nsecend_1jan000   ! file begins after the end of the job -> file may not exist 
+
+      llstop = sdjf%ln_clim .OR. .NOT. ( llprev .OR. llnext )
+
+      IF( sdjf%num <= 0 .OR. .NOT. sdjf%ln_clim  ) THEN
+         IF( sdjf%num > 0 )   CALL iom_close( sdjf%num )   ! close file if already open
+         CALL iom_open( sdjf%clname, sdjf%num, ldstop = llstop, ldiof = LEN(TRIM(sdjf%wgtname)) > 0 )
+      ENDIF
+      !
+      IF( sdjf%num <= 0 .AND. .NOT. llstop ) THEN   ! file not found but we do accept this...
+         !
+         IF( llprev ) THEN   ! previous file does not exist : go back to current and accept to read only the first record
+            CALL ctl_warn('previous file: '//TRIM(sdjf%clname)//' not found -> go back to current year/month/week/day file')
+            isave(1:2) = sdjf%nrecsec(sdjf%nreclast-1:sdjf%nreclast)   ! save previous file info
+            CALL fld_def( sdjf )   ! go back to current file
+            sdjf%nreclast = 1   ! force to use only the first record (do as if other were not existing...)
+            sdjf%nrecsec(0:1) = isave(1:2)
+         ENDIF
+         !
+         IF( llnext ) THEN   ! next     file does not exist : go back to current and accept to read only the last  record 
+            CALL ctl_warn('next file: '//TRIM(sdjf%clname)//' not found -> go back to current year/month/week/day file')
+            isave(1:2) = sdjf%nrecsec(0:1)    ! save next file info
+            CALL fld_def( sdjf )   ! go back to current file
+            ! -> read last record but keep record info from the first record of next file
+            sdjf%nrecsec(sdjf%nreclast-1:sdjf%nreclast) = isave(1:2)
+            sdjf%nrecsec(0:sdjf%nreclast-2) = nflag
+         ENDIF
+         !
+         CALL iom_open( sdjf%clname, sdjf%num, ldiof = LEN(TRIM(sdjf%wgtname)) > 0 )   
          !
       ENDIF
@@ -1317,6 +1145,6 @@
       CALL iom_open( sd%clname, inum, ldiof =  LEN(TRIM(sd%wgtname)) > 0 )
 
-      !! get dimensions
-      IF ( SIZE(sd%fnow, 3) > 1 ) THEN
+      !! get dimensions: we consider 2D data as 3D data with vertical dim size = 1
+      IF( SIZE(sd%fnow, 3) > 0 ) THEN
          ALLOCATE( ddims(4) )
       ELSE
@@ -1331,5 +1159,5 @@
 
       CALL iom_open ( sd%wgtname, inum )   ! interpolation weights
-      IF ( inum > 0 ) THEN
+      IF( inum > 0 ) THEN
 
          !! determine whether we have an east-west cyclic grid
@@ -1640,10 +1468,5 @@
          
          ref_wgts(kw)%fly_dta(:,:,:) = 0.0
-         SELECT CASE( SIZE(ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:),3) )
-         CASE(1)
-              CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,1), nrec, rec1, recn)
-         CASE DEFAULT
-              CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:), nrec, rec1, recn)
-         END SELECT 
+         CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:), nrec, rec1, recn)
       ENDIF
       
@@ -1663,5 +1486,5 @@
       END DO
 
-      IF (ref_wgts(kw)%numwgt .EQ. 16) THEN
+      IF(ref_wgts(kw)%numwgt .EQ. 16) THEN
 
         !! fix up halo points that we couldnt read from file
@@ -1689,20 +1512,10 @@
            IF( jpi1 == 2 ) THEN
               rec1(1) = ref_wgts(kw)%ddims(1) - ref_wgts(kw)%overlap
-              SELECT CASE( SIZE( ref_wgts(kw)%col(:,jpj1:jpj2,:),3) )
-              CASE(1)
-                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,1), nrec, rec1, recn)
-              CASE DEFAULT
-                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, rec1, recn)
-              END SELECT      
+              CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, rec1, recn)
               ref_wgts(kw)%fly_dta(jpi1-1,jpj1:jpj2,:) = ref_wgts(kw)%col(1,jpj1:jpj2,:)
            ENDIF
            IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN
               rec1(1) = 1 + ref_wgts(kw)%overlap
-              SELECT CASE( SIZE( ref_wgts(kw)%col(:,jpj1:jpj2,:),3) )
-              CASE(1)
-                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,1), nrec, rec1, recn)
-              CASE DEFAULT
-                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, rec1, recn)
-              END SELECT
+              CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, rec1, recn)
               ref_wgts(kw)%fly_dta(jpi2+1,jpj1:jpj2,:) = ref_wgts(kw)%col(1,jpj1:jpj2,:)
            ENDIF
@@ -1746,14 +1559,46 @@
          END DO
          !
-      END IF
+      ENDIF
       !
    END SUBROUTINE fld_interp
 
 
+   FUNCTION fld_filename( sdjf, kday, kmonth, kyear )
+      !!---------------------------------------------------------------------
+      !!                    ***  FUNCTION fld_filename *** 
+      !!
+      !! ** Purpose :   define the filename according to a given date
+      !!---------------------------------------------------------------------
+      TYPE(FLD), INTENT(in) ::   sdjf         ! input field related variables
+      INTEGER  , INTENT(in) ::   kday, kmonth, kyear
+      !
+      CHARACTER(len = 256) ::   clname, fld_filename
+      !!---------------------------------------------------------------------
+
+      
+      ! build the new filename if not climatological data
+      clname=TRIM(sdjf%clrootname)
+      !
+      ! note that sdjf%ln_clim is is only acting on the presence of the year in the file name
+      IF( .NOT. sdjf%ln_clim ) THEN   
+                                         WRITE(clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear    ! add year
+         IF( sdjf%cltype /= 'yearly' )   WRITE(clname, '(a, "m",i2.2)' ) TRIM( clname          ), kmonth   ! add month
+      ELSE
+         ! build the new filename if climatological data
+         IF( sdjf%cltype /= 'yearly' )   WRITE(clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), kmonth   ! add month
+      ENDIF
+      IF(    sdjf%cltype == 'daily' .OR. sdjf%cltype(1:4) == 'week' ) &
+         &                               WRITE(clname, '(a,"d" ,i2.2)' ) TRIM( clname          ), kday     ! add day
+
+      fld_filename = clname
+      
+   END FUNCTION fld_filename
+
+
    FUNCTION ksec_week( cdday )
       !!---------------------------------------------------------------------
-      !!                    ***  FUNCTION kshift_week *** 
-      !!
-      !! ** Purpose :   return the first 3 letters of the first day of the weekly file
+      !!                    ***  FUNCTION ksec_week *** 
+      !!
+      !! ** Purpose :   seconds between 00h of the beginning of the week and half of the current time step
       !!---------------------------------------------------------------------
       CHARACTER(len=*), INTENT(in)   ::   cdday   ! first 3 letters of the first day of the weekly file
@@ -1771,5 +1616,5 @@
       ishift = ijul * NINT(rday)
       ! 
-      ksec_week = nsec_week + ishift
+      ksec_week = nsec_monday + ishift
       ksec_week = MOD( ksec_week, 7*NINT(rday) )
       ! 
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/geo2ocean.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/geo2ocean.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/geo2ocean.F90	(revision 12928)
@@ -43,5 +43,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -160,90 +160,88 @@
       ! (computation done on the north stereographic polar plane)
       !
-      DO jj = 2, jpjm1
-         DO ji = fs_2, jpi   ! vector opt.
-            !                  
-            zlam = plamt(ji,jj)     ! north pole direction & modulous (at t-point)
-            zphi = pphit(ji,jj)
-            zxnpt = 0. - 2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
-            zynpt = 0. - 2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
-            znnpt = zxnpt*zxnpt + zynpt*zynpt
-            !
-            zlam = plamu(ji,jj)     ! north pole direction & modulous (at u-point)
-            zphi = pphiu(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
-            !
-            zlam = plamv(ji,jj)     ! north pole direction & modulous (at v-point)
-            zphi = pphiv(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
-            !
-            zlam = plamf(ji,jj)     ! north pole direction & modulous (at f-point)
-            zphi = pphif(ji,jj)
-            zxnpf = 0. - 2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
-            zynpf = 0. - 2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
-            znnpf = zxnpf*zxnpf + zynpf*zynpf
-            !
-            zlam = plamv(ji,jj  )   ! j-direction: v-point segment direction (around t-point)
-            zphi = pphiv(ji,jj  )
-            zlan = plamv(ji,jj-1)
-            zphh = pphiv(ji,jj-1)
-            zxvvt =  2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
-               &  -  2. * COS( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
-            zyvvt =  2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
-               &  -  2. * SIN( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
-            znvvt = SQRT( znnpt * ( zxvvt*zxvvt + zyvvt*zyvvt )  )
-            znvvt = MAX( znvvt, 1.e-14 )
-            !
-            zlam = plamf(ji,jj  )   ! j-direction: f-point segment direction (around u-point)
-            zphi = pphif(ji,jj  )
-            zlan = plamf(ji,jj-1)
-            zphh = pphif(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. )
-            znffu = SQRT( znnpu * ( zxffu*zxffu + zyffu*zyffu )  )
-            znffu = MAX( znffu, 1.e-14 )
-            !
-            zlam = plamf(ji  ,jj)   ! i-direction: f-point segment direction (around v-point)
-            zphi = pphif(ji  ,jj)
-            zlan = plamf(ji-1,jj)
-            zphh = pphif(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. )
-            znffv = SQRT( znnpv * ( zxffv*zxffv + zyffv*zyffv )  )
-            znffv = MAX( znffv, 1.e-14 )
-            !
-            zlam = plamu(ji,jj+1)   ! j-direction: u-point segment direction (around f-point)
-            zphi = pphiu(ji,jj+1)
-            zlan = plamu(ji,jj  )
-            zphh = pphiu(ji,jj  )
-            zxuuf =  2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
-               &  -  2. * COS( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
-            zyuuf =  2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
-               &  -  2. * SIN( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
-            znuuf = SQRT( znnpf * ( zxuuf*zxuuf + zyuuf*zyuuf )  )
-            znuuf = MAX( znuuf, 1.e-14 )
-            !
-            !                       ! cosinus and sinus using dot and cross products
-            gsint(ji,jj) = ( zxnpt*zyvvt - zynpt*zxvvt ) / znvvt
-            gcost(ji,jj) = ( zxnpt*zxvvt + zynpt*zyvvt ) / znvvt
-            !
-            gsinu(ji,jj) = ( zxnpu*zyffu - zynpu*zxffu ) / znffu
-            gcosu(ji,jj) = ( zxnpu*zxffu + zynpu*zyffu ) / znffu
-            !
-            gsinf(ji,jj) = ( zxnpf*zyuuf - zynpf*zxuuf ) / znuuf
-            gcosf(ji,jj) = ( zxnpf*zxuuf + zynpf*zyuuf ) / znuuf
-            !
-            gsinv(ji,jj) = ( zxnpv*zxffv + zynpv*zyffv ) / znffv
-            gcosv(ji,jj) =-( zxnpv*zyffv - zynpv*zxffv ) / znffv     ! (caution, rotation of 90 degres)
-            !
-         END DO
-      END DO
+      DO_2D_00_01
+         !                  
+         zlam = plamt(ji,jj)     ! north pole direction & modulous (at t-point)
+         zphi = pphit(ji,jj)
+         zxnpt = 0. - 2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
+         zynpt = 0. - 2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
+         znnpt = zxnpt*zxnpt + zynpt*zynpt
+         !
+         zlam = plamu(ji,jj)     ! north pole direction & modulous (at u-point)
+         zphi = pphiu(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
+         !
+         zlam = plamv(ji,jj)     ! north pole direction & modulous (at v-point)
+         zphi = pphiv(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
+         !
+         zlam = plamf(ji,jj)     ! north pole direction & modulous (at f-point)
+         zphi = pphif(ji,jj)
+         zxnpf = 0. - 2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
+         zynpf = 0. - 2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
+         znnpf = zxnpf*zxnpf + zynpf*zynpf
+         !
+         zlam = plamv(ji,jj  )   ! j-direction: v-point segment direction (around t-point)
+         zphi = pphiv(ji,jj  )
+         zlan = plamv(ji,jj-1)
+         zphh = pphiv(ji,jj-1)
+         zxvvt =  2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
+            &  -  2. * COS( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
+         zyvvt =  2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
+            &  -  2. * SIN( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
+         znvvt = SQRT( znnpt * ( zxvvt*zxvvt + zyvvt*zyvvt )  )
+         znvvt = MAX( znvvt, 1.e-14 )
+         !
+         zlam = plamf(ji,jj  )   ! j-direction: f-point segment direction (around u-point)
+         zphi = pphif(ji,jj  )
+         zlan = plamf(ji,jj-1)
+         zphh = pphif(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. )
+         znffu = SQRT( znnpu * ( zxffu*zxffu + zyffu*zyffu )  )
+         znffu = MAX( znffu, 1.e-14 )
+         !
+         zlam = plamf(ji  ,jj)   ! i-direction: f-point segment direction (around v-point)
+         zphi = pphif(ji  ,jj)
+         zlan = plamf(ji-1,jj)
+         zphh = pphif(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. )
+         znffv = SQRT( znnpv * ( zxffv*zxffv + zyffv*zyffv )  )
+         znffv = MAX( znffv, 1.e-14 )
+         !
+         zlam = plamu(ji,jj+1)   ! j-direction: u-point segment direction (around f-point)
+         zphi = pphiu(ji,jj+1)
+         zlan = plamu(ji,jj  )
+         zphh = pphiu(ji,jj  )
+         zxuuf =  2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
+            &  -  2. * COS( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
+         zyuuf =  2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
+            &  -  2. * SIN( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
+         znuuf = SQRT( znnpf * ( zxuuf*zxuuf + zyuuf*zyuuf )  )
+         znuuf = MAX( znuuf, 1.e-14 )
+         !
+         !                       ! cosinus and sinus using dot and cross products
+         gsint(ji,jj) = ( zxnpt*zyvvt - zynpt*zxvvt ) / znvvt
+         gcost(ji,jj) = ( zxnpt*zxvvt + zynpt*zyvvt ) / znvvt
+         !
+         gsinu(ji,jj) = ( zxnpu*zyffu - zynpu*zxffu ) / znffu
+         gcosu(ji,jj) = ( zxnpu*zxffu + zynpu*zyffu ) / znffu
+         !
+         gsinf(ji,jj) = ( zxnpf*zyuuf - zynpf*zxuuf ) / znuuf
+         gcosf(ji,jj) = ( zxnpf*zxuuf + zynpf*zyuuf ) / znuuf
+         !
+         gsinv(ji,jj) = ( zxnpv*zxffv + zynpv*zyffv ) / znffv
+         gcosv(ji,jj) =-( zxnpv*zyffv - zynpv*zxffv ) / znffv     ! (caution, rotation of 90 degres)
+         !
+      END_2D
 
       ! =============== !
@@ -251,24 +249,22 @@
       ! =============== !
 
-      DO jj = 2, jpjm1
-         DO ji = fs_2, jpi   ! vector opt.
-            IF( MOD( ABS( plamv(ji,jj) - plamv(ji,jj-1) ), 360. ) < 1.e-8 ) THEN
-               gsint(ji,jj) = 0.
-               gcost(ji,jj) = 1.
-            ENDIF
-            IF( MOD( ABS( plamf(ji,jj) - plamf(ji,jj-1) ), 360. ) < 1.e-8 ) THEN
-               gsinu(ji,jj) = 0.
-               gcosu(ji,jj) = 1.
-            ENDIF
-            IF(      ABS( pphif(ji,jj) - pphif(ji-1,jj) )         < 1.e-8 ) THEN
-               gsinv(ji,jj) = 0.
-               gcosv(ji,jj) = 1.
-            ENDIF
-            IF( MOD( ABS( plamu(ji,jj) - plamu(ji,jj+1) ), 360. ) < 1.e-8 ) THEN
-               gsinf(ji,jj) = 0.
-               gcosf(ji,jj) = 1.
-            ENDIF
-         END DO
-      END DO
+      DO_2D_00_01
+         IF( MOD( ABS( plamv(ji,jj) - plamv(ji,jj-1) ), 360. ) < 1.e-8 ) THEN
+            gsint(ji,jj) = 0.
+            gcost(ji,jj) = 1.
+         ENDIF
+         IF( MOD( ABS( plamf(ji,jj) - plamf(ji,jj-1) ), 360. ) < 1.e-8 ) THEN
+            gsinu(ji,jj) = 0.
+            gcosu(ji,jj) = 1.
+         ENDIF
+         IF(      ABS( pphif(ji,jj) - pphif(ji-1,jj) )         < 1.e-8 ) THEN
+            gsinv(ji,jj) = 0.
+            gcosv(ji,jj) = 1.
+         ENDIF
+         IF( MOD( ABS( plamu(ji,jj) - plamu(ji,jj+1) ), 360. ) < 1.e-8 ) THEN
+            gsinf(ji,jj) = 0.
+            gcosf(ji,jj) = 1.
+         ENDIF
+      END_2D
 
       ! =========================== !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbc_ice.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbc_ice.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbc_ice.F90	(revision 12928)
@@ -70,5 +70,4 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wndm_ice       !: wind speed module at T-point                 [m/s]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sstfrz         !: wind speed module at T-point                 [m/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tsfc_ice       !: sea ice surface skin temperature (on categories)
 #endif
 
@@ -132,5 +131,5 @@
          &      qemp_ice(jpi,jpj)     , qevap_ice(jpi,jpj,jpl) , qemp_oce   (jpi,jpj)     ,   &
          &      qns_oce (jpi,jpj)     , qsr_oce  (jpi,jpj)     , emp_oce    (jpi,jpj)     ,   &
-         &      emp_ice (jpi,jpj)     , tsfc_ice (jpi,jpj,jpl) , sstfrz     (jpi,jpj)     , STAT= ierr(2) )
+         &      emp_ice (jpi,jpj)     , sstfrz   (jpi,jpj)     , STAT= ierr(2) )
 #endif
 
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbc_oce.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbc_oce.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbc_oce.F90	(revision 12928)
@@ -2,5 +2,5 @@
    !!======================================================================
    !!                       ***  MODULE  sbc_oce  ***
-   !! Surface module :   variables defined in core memory 
+   !! Surface module :   variables defined in core memory
    !!======================================================================
    !! History :  3.0  ! 2006-06  (G. Madec)  Original code
@@ -9,6 +9,7 @@
    !!             -   ! 2010-11  (G. Madec) ice-ocean stress always computed at each ocean time-step
    !!            3.3  ! 2010-10  (J. Chanut, C. Bricaud)  add the surface pressure forcing
-   !!            4.0  ! 2012-05  (C. Rousset) add attenuation coef for use in ice model 
+   !!            4.0  ! 2012-05  (C. Rousset) add attenuation coef for use in ice model
    !!            4.0  ! 2016-06  (L. Brodeau) new unified bulk routine (based on AeroBulk)
+   !!            4.0  ! 2019-03  (F. Lemarié, G. Samson) add compatibility with ABL mode
    !!----------------------------------------------------------------------
 
@@ -26,5 +27,5 @@
    PUBLIC   sbc_oce_alloc   ! routine called in sbcmod.F90
    PUBLIC   sbc_tau2wnd     ! routine called in several sbc modules
-   
+
    !!----------------------------------------------------------------------
    !!           Namelist for the Ocean Surface Boundary Condition
@@ -34,4 +35,5 @@
    LOGICAL , PUBLIC ::   ln_flx         !: flux      formulation
    LOGICAL , PUBLIC ::   ln_blk         !: bulk formulation
+   LOGICAL , PUBLIC ::   ln_abl         !: Atmospheric boundary layer model
 #if defined key_oasis3
    LOGICAL , PUBLIC ::   lk_oasis = .TRUE.  !: OASIS used
@@ -43,6 +45,5 @@
    LOGICAL , PUBLIC ::   ln_dm2dc       !: Daily mean to Diurnal Cycle short wave (qsr)
    LOGICAL , PUBLIC ::   ln_rnf         !: runoffs / runoff mouths
-   LOGICAL , PUBLIC ::   ln_isf         !: ice shelf melting
-   LOGICAL , PUBLIC ::   ln_ssr         !: Sea Surface restoring on SST and/or SSS      
+   LOGICAL , PUBLIC ::   ln_ssr         !: Sea Surface restoring on SST and/or SSS
    LOGICAL , PUBLIC ::   ln_apr_dyn     !: Atmospheric pressure forcing used on dynamics (ocean & ice)
    INTEGER , PUBLIC ::   nn_ice         !: flag for ice in the surface boundary condition (=0/1/2/3)
@@ -50,7 +51,7 @@
    !                                             !: =F levitating ice (no presure effect) with mass and salt exchanges
    !                                             !: =T embedded sea-ice (pressure effect + mass and salt exchanges)
-   INTEGER , PUBLIC ::   nn_components  !: flag for sbc module (including sea-ice) coupling mode (see component definition below) 
-   INTEGER , PUBLIC ::   nn_fwb         !: FreshWater Budget: 
-   !                                             !:  = 0 unchecked 
+   INTEGER , PUBLIC ::   nn_components  !: flag for sbc module (including sea-ice) coupling mode (see component definition below)
+   INTEGER , PUBLIC ::   nn_fwb         !: FreshWater Budget:
+   !                                             !:  = 0 unchecked
    !                                             !:  = 1 global mean of e-p-r set to zero at each nn_fsbc time step
    !                                             !:  = 2 annual global mean of e-p-r set to zero
@@ -77,15 +78,16 @@
    INTEGER , PUBLIC, PARAMETER ::   jp_flx     = 2        !: flux                          formulation
    INTEGER , PUBLIC, PARAMETER ::   jp_blk     = 3        !: bulk                          formulation
-   INTEGER , PUBLIC, PARAMETER ::   jp_purecpl = 4        !: Pure ocean-atmosphere Coupled formulation
-   INTEGER , PUBLIC, PARAMETER ::   jp_none    = 5        !: for OPA when doing coupling via SAS module
-   
-   !!----------------------------------------------------------------------
-   !!           Stokes drift parametrization definition 
+   INTEGER , PUBLIC, PARAMETER ::   jp_abl     = 4        !: Atmospheric boundary layer    formulation
+   INTEGER , PUBLIC, PARAMETER ::   jp_purecpl = 5        !: Pure ocean-atmosphere Coupled formulation
+   INTEGER , PUBLIC, PARAMETER ::   jp_none    = 6        !: for OPA when doing coupling via SAS module
+
+   !!----------------------------------------------------------------------
+   !!           Stokes drift parametrization definition
    !!----------------------------------------------------------------------
    INTEGER , PUBLIC, PARAMETER ::   jp_breivik_2014 = 0     !: Breivik  2014: v_z=v_0*[exp(2*k*z)/(1-8*k*z)]
-   INTEGER , PUBLIC, PARAMETER ::   jp_li_2017      = 1     !: Li et al 2017: Stokes drift based on Phillips spectrum (Breivik 2016) 
-                                                            !  with depth averaged profile
-   INTEGER , PUBLIC, PARAMETER ::   jp_peakfr       = 2     !: Li et al 2017: using the peak wave number read from wave model instead 
-                                                            !  of the inverse depth scale
+   INTEGER , PUBLIC, PARAMETER ::   jp_li_2017      = 1     !: Li et al 2017: Stokes drift based on Phillips spectrum (Breivik 2016)
+   !  with depth averaged profile
+   INTEGER , PUBLIC, PARAMETER ::   jp_peakfr       = 2     !: Li et al 2017: using the peak wave number read from wave model instead
+   !  of the inverse depth scale
    LOGICAL , PUBLIC            ::   ll_st_bv2014  = .FALSE. !  logical indicator, .true. if Breivik 2014 parameterisation is active.
    LOGICAL , PUBLIC            ::   ll_st_li2017  = .FALSE. !  logical indicator, .true. if Li 2017 parameterisation is active.
@@ -96,22 +98,22 @@
    !!           component definition
    !!----------------------------------------------------------------------
-   INTEGER , PUBLIC, PARAMETER ::   jp_iam_nemo = 0      !: Initial single executable configuration 
-                                                         !  (no internal OASIS coupling)
+   INTEGER , PUBLIC, PARAMETER ::   jp_iam_nemo = 0      !: Initial single executable configuration
+   !  (no internal OASIS coupling)
    INTEGER , PUBLIC, PARAMETER ::   jp_iam_opa  = 1      !: Multi executable configuration - OPA component
-                                                         !  (internal OASIS coupling)
+   !  (internal OASIS coupling)
    INTEGER , PUBLIC, PARAMETER ::   jp_iam_sas  = 2      !: Multi executable configuration - SAS component
-                                                         !  (internal OASIS coupling)
+   !  (internal OASIS coupling)
    !!----------------------------------------------------------------------
    !!              Ocean Surface Boundary Condition fields
    !!----------------------------------------------------------------------
-   INTEGER , PUBLIC ::  ncpl_qsr_freq            !: qsr coupling frequency per days from atmosphere
-   !
-   LOGICAL , PUBLIC ::   lhftau = .FALSE.        !: HF tau used in TKE: mean(stress module) - module(mean stress)
+   INTEGER , PUBLIC ::  ncpl_qsr_freq = 0        !: qsr coupling frequency per days from atmosphere (used by top)
+   !
    !!                                   !!   now    ! before   !!
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau   , utau_b   !: sea surface i-stress (ocean referential)     [N/m2]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vtau   , vtau_b   !: sea surface j-stress (ocean referential)     [N/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   taum              !: module of sea surface stress (at T-point)    [N/m2] 
-   !! wndm is used onmpute surface gases exchanges in ice-free ocean or leads
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   taum              !: module of sea surface stress (at T-point)    [N/m2]
+   !! wndm is used compute surface gases exchanges in ice-free ocean or leads
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wndm              !: wind speed module at T-point (=|U10m-Uoce|)  [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rhoa              !: air density at "rn_zu" m above the sea       [kg/m3]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr               !: sea heat flux:     solar                     [W/m2]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qns    , qns_b    !: sea heat flux: non solar                     [W/m2]
@@ -122,8 +124,6 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emp_tot           !: total E-P over ocean and ice                 [Kg/m2/s]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fmmflx            !: freshwater budget: freezing/melting          [Kg/m2/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rnf    , rnf_b    !: river runoff        [Kg/m2/s]  
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fwfisf , fwfisf_b !: ice shelf melting   [Kg/m2/s]  
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fwficb , fwficb_b !: iceberg melting [Kg/m2/s]  
-
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rnf    , rnf_b    !: river runoff                                 [Kg/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fwficb , fwficb_b !: iceberg melting                              [Kg/m2/s]
    !!
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  sbc_tsc, sbc_tsc_b  !: sbc content trend                      [K.m/s] jpi,jpj,jpts
@@ -137,4 +137,12 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask          !: coupling mask for ln_mixcpl (warning: allocated in sbccpl)
 
+   !!---------------------------------------------------------------------
+   !! ABL Vertical Domain size
+   !!---------------------------------------------------------------------
+   INTEGER , PUBLIC            ::   jpka   = 2     !: ABL number of vertical levels (default definition)
+   INTEGER , PUBLIC            ::   jpkam1 = 1     !: jpka-1
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   ght_abl, ghw_abl          !: ABL geopotential height (needed for iom)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   e3t_abl, e3w_abl          !: ABL vertical scale factors (needed for iom)
+
    !!----------------------------------------------------------------------
    !!                     Sea Surface Mean fields
@@ -146,9 +154,10 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sss_m     !: mean (nn_fsbc time-step) surface sea salinity            [psu]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssh_m     !: mean (nn_fsbc time-step) sea surface height                [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tsk_m     !: mean (nn_fsbc time-step) SKIN surface sea temp.      [Celsius]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3t_m     !: mean (nn_fsbc time-step) sea surface layer thickness       [m]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   frq_m     !: mean (nn_fsbc time-step) fraction of solar net radiation absorbed in the 1st T level [-]
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -167,22 +176,22 @@
       !
       ALLOCATE( utau(jpi,jpj) , utau_b(jpi,jpj) , taum(jpi,jpj) ,     &
-         &      vtau(jpi,jpj) , vtau_b(jpi,jpj) , wndm(jpi,jpj) , STAT=ierr(1) ) 
-         !
+         &      vtau(jpi,jpj) , vtau_b(jpi,jpj) , wndm(jpi,jpj) , rhoa(jpi,jpj) , STAT=ierr(1) )
+      !
       ALLOCATE( qns_tot(jpi,jpj) , qns  (jpi,jpj) , qns_b(jpi,jpj),        &
          &      qsr_tot(jpi,jpj) , qsr  (jpi,jpj) ,                        &
          &      emp    (jpi,jpj) , emp_b(jpi,jpj) ,                        &
          &      sfx    (jpi,jpj) , sfx_b(jpi,jpj) , emp_tot(jpi,jpj), fmmflx(jpi,jpj), STAT=ierr(2) )
-         !
-      ALLOCATE( fwfisf  (jpi,jpj), rnf  (jpi,jpj) , sbc_tsc  (jpi,jpj,jpts) , qsr_hc  (jpi,jpj,jpk) ,  &
-         &      fwfisf_b(jpi,jpj), rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) ,  &
+      !
+      ALLOCATE( rnf  (jpi,jpj) , sbc_tsc  (jpi,jpj,jpts) , qsr_hc  (jpi,jpj,jpk) ,  &
+         &      rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) ,  &
          &      fwficb  (jpi,jpj), fwficb_b(jpi,jpj), STAT=ierr(3) )
-         !
+      !
       ALLOCATE( tprecip(jpi,jpj) , sprecip(jpi,jpj) , fr_i(jpi,jpj) ,     &
-         &      atm_co2(jpi,jpj) ,                                        &
+         &      atm_co2(jpi,jpj) , tsk_m(jpi,jpj) ,                       &
          &      ssu_m  (jpi,jpj) , sst_m(jpi,jpj) , frq_m(jpi,jpj) ,      &
          &      ssv_m  (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) )
-         !
+      !
       ALLOCATE( e3t_m(jpi,jpj) , STAT=ierr(5) )
-         !
+      !
       sbc_oce_alloc = MAXVAL( ierr )
       CALL mpp_sum ( 'sbc_oce', sbc_oce_alloc )
@@ -195,6 +204,6 @@
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE sbc_tau2wnd  ***
-      !!                   
-      !! ** Purpose : Estimation of wind speed as a function of wind stress   
+      !!
+      !! ** Purpose : Estimation of wind speed as a function of wind stress
       !!
       !! ** Method  : |tau|=rhoa*Cd*|U|^2
@@ -207,13 +216,11 @@
       INTEGER  ::   ji, jj                ! dummy indices
       !!---------------------------------------------------------------------
-      zcoef = 0.5 / ( zrhoa * zcdrag ) 
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vect. opt.
-            ztx = utau(ji-1,jj  ) + utau(ji,jj) 
-            zty = vtau(ji  ,jj-1) + vtau(ji,jj) 
-            ztau = SQRT( ztx * ztx + zty * zty )
-            wndm(ji,jj) = SQRT ( ztau * zcoef ) * tmask(ji,jj,1)
-         END DO
-      END DO
+      zcoef = 0.5 / ( zrhoa * zcdrag )
+      DO_2D_00_00
+         ztx = utau(ji-1,jj  ) + utau(ji,jj)
+         zty = vtau(ji  ,jj-1) + vtau(ji,jj)
+         ztau = SQRT( ztx * ztx + zty * zty )
+         wndm(ji,jj) = SQRT ( ztau * zcoef ) * tmask(ji,jj,1)
+      END_2D
       CALL lbc_lnk( 'sbc_oce', wndm(:,:) , 'T', 1. )
       !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcabl.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcabl.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcabl.F90	(revision 12928)
@@ -0,0 +1,51 @@
+MODULE sbcabl
+   !!======================================================================
+   !!                       ***  MODULE  sbcabl  ***
+   !! Ocean forcing:  momentum, heat and freshwater flux formulation 
+   !!                 derived from an ABL model 
+   !!=====================================================================
+   !! History :  4.0  !  2019-03  (F. Lemarié & G. Samson)  Original code
+   !!----------------------------------------------------------------------
+   USE sbc_oce, ONLY :   ght_abl, ghw_abl, e3t_abl, e3w_abl
+   USE lib_mpp, ONLY :   ctl_stop
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sbc_abl_init       ! routine called in sbcmod module
+   PUBLIC   sbc_abl            ! routine called in sbcmod module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO-consortium (2014)
+   !! $Id: sbcabl.F90 6416 2016-04-01 12:22:17Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE sbc_abl_init
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE sbc_abl_init  ***
+      !!
+      !! ** Purposes :   dummy routine for compilation 
+      !!
+      !!----------------------------------------------------------------------
+      CALL ctl_stop( 'STOP', 'ln_abl = .true. but ABL source directory was not included',   &
+	     & '(Either switch to ln_abl = .false. or modify your cfg.txt file and recompile)' )
+	  !!
+   END SUBROUTINE sbc_abl_init
+
+   
+   SUBROUTINE sbc_abl( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE sbc_abl  ***
+      !!
+      !! ** Purposes :   dummy routine for compilation 
+      !!
+      !!---------------------------------------------------------------------
+      INTEGER ,         INTENT(in) ::   kt   ! ocean time step
+      !!
+   END SUBROUTINE sbc_abl
+
+
+   !!======================================================================
+END MODULE sbcabl
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcapr.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcapr.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcapr.F90	(revision 12928)
@@ -36,5 +36,5 @@
    
    REAL(wp) ::   tarea                ! whole domain mean masked ocean surface
-   REAL(wp) ::   r1_grau              ! = 1.e0 / (grav * rau0)
+   REAL(wp) ::   r1_grau              ! = 1.e0 / (grav * rho0)
    
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_apr   ! structure of input fields (file informations, fields read)
@@ -69,9 +69,7 @@
       NAMELIST/namsbc_apr/ cn_dir, sn_apr, ln_ref_apr, rn_pref, ln_apr_obc
       !!----------------------------------------------------------------------
-      REWIND( numnam_ref )              ! Namelist namsbc_apr in reference namelist : File for atmospheric pressure forcing
       READ  ( numnam_ref, namsbc_apr, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_apr in reference namelist' )
 
-      REWIND( numnam_cfg )              ! Namelist namsbc_apr in configuration namelist : File for atmospheric pressure forcing
       READ  ( numnam_cfg, namsbc_apr, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_apr in configuration namelist' )
@@ -100,8 +98,8 @@
       ENDIF
       !
-      r1_grau = 1.e0 / (grav * rau0)               !* constant for optimization
+      r1_grau = 1.e0 / (grav * rho0)               !* constant for optimization
       !
       !                                            !* control check
-      IF ( ln_apr_obc  ) THEN
+      IF( ln_apr_obc  ) THEN
          IF(lwp) WRITE(numout,*) '         Inverse barometer added to OBC ssh data'
       ENDIF
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcblk.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcblk.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcblk.F90	(revision 12928)
@@ -15,7 +15,8 @@
    !!            3.7  !  2014-06  (L. Brodeau)  simplification and optimization of CORE bulk
    !!            4.0  !  2016-06  (L. Brodeau)  sbcblk_core becomes sbcblk and is not restricted to the CORE algorithm anymore
-   !!                 !                        ==> based on AeroBulk (http://aerobulk.sourceforge.net/)
+   !!                 !                        ==> based on AeroBulk (https://github.com/brodeau/aerobulk/)
    !!            4.0  !  2016-10  (G. Madec)  introduce a sbc_blk_init routine
-   !!            4.0  !  2016-10  (M. Vancoppenolle)  Introduce conduction flux emulator (M. Vancoppenolle) 
+   !!            4.0  !  2016-10  (M. Vancoppenolle)  Introduce conduction flux emulator (M. Vancoppenolle)
+   !!            4.0  !  2019-03  (F. Lemarié & G. Samson)  add ABL compatibility (ln_abl=TRUE)
    !!----------------------------------------------------------------------
 
@@ -23,15 +24,12 @@
    !!   sbc_blk_init  : initialisation of the chosen bulk formulation as ocean surface boundary condition
    !!   sbc_blk       : bulk formulation as ocean surface boundary condition
-   !!   blk_oce       : computes momentum, heat and freshwater fluxes over ocean
-   !!   rho_air       : density of (moist) air (depends on T_air, q_air and SLP
-   !!   cp_air        : specific heat of (moist) air (depends spec. hum. q_air)
-   !!   q_sat         : saturation humidity as a function of SLP and temperature
-   !!   L_vap         : latent heat of vaporization of water as a function of temperature
-   !!             sea-ice case only : 
-   !!   blk_ice_tau   : provide the air-ice stress
-   !!   blk_ice_flx   : provide the heat and mass fluxes at air-ice interface
+   !!   blk_oce_1     : computes pieces of momentum, heat and freshwater fluxes over ocean for ABL model  (ln_abl=TRUE)
+   !!   blk_oce_2     : finalizes momentum, heat and freshwater fluxes computation over ocean after the ABL step  (ln_abl=TRUE)
+   !!             sea-ice case only :
+   !!   blk_ice_1   : provide the air-ice stress
+   !!   blk_ice_2   : provide the heat and mass fluxes at air-ice interface
    !!   blk_ice_qcn   : provide ice surface temperature and snow/ice conduction flux (emulating conduction flux)
    !!   Cdn10_Lupkes2012 : Lupkes et al. (2012) air-ice drag
-   !!   Cdn10_Lupkes2015 : Lupkes et al. (2015) air-ice drag 
+   !!   Cdn10_Lupkes2015 : Lupkes et al. (2015) air-ice drag
    !!----------------------------------------------------------------------
    USE oce            ! ocean dynamics and tracers
@@ -46,11 +44,11 @@
    USE lib_fortran    ! to use key_nosignedzero
 #if defined key_si3
-   USE ice     , ONLY :   u_ice, v_ice, jpl, a_i_b, at_i_b, t_su, rn_cnd_s, hfx_err_dif
+   USE ice     , ONLY :   jpl, a_i_b, at_i_b, rn_cnd_s, hfx_err_dif
    USE icethd_dh      ! for CALL ice_thd_snwblow
 #endif
-   USE sbcblk_algo_ncar     ! => turb_ncar     : NCAR - CORE (Large & Yeager, 2009) 
-   USE sbcblk_algo_coare    ! => turb_coare    : COAREv3.0 (Fairall et al. 2003) 
-   USE sbcblk_algo_coare3p5 ! => turb_coare3p5 : COAREv3.5 (Edson et al. 2013)
-   USE sbcblk_algo_ecmwf    ! => turb_ecmwf    : ECMWF (IFS cycle 31) 
+   USE sbcblk_algo_ncar     ! => turb_ncar     : NCAR - CORE (Large & Yeager, 2009)
+   USE sbcblk_algo_coare3p0 ! => turb_coare3p0 : COAREv3.0 (Fairall et al. 2003)
+   USE sbcblk_algo_coare3p6 ! => turb_coare3p6 : COAREv3.6 (Fairall et al. 2018 + Edson et al. 2013)
+   USE sbcblk_algo_ecmwf    ! => turb_ecmwf    : ECMWF (IFS cycle 45r1)
    !
    USE iom            ! I/O manager library
@@ -60,4 +58,7 @@
    USE prtctl         ! Print control
 
+   USE sbcblk_phy     ! a catalog of functions for physical/meteorological parameters in the marine boundary layer, rho_air, q_sat, etc...
+
+
    IMPLICIT NONE
    PRIVATE
@@ -65,65 +66,57 @@
    PUBLIC   sbc_blk_init  ! called in sbcmod
    PUBLIC   sbc_blk       ! called in sbcmod
+   PUBLIC   blk_oce_1     ! called in sbcabl
+   PUBLIC   blk_oce_2     ! called in sbcabl
 #if defined key_si3
-   PUBLIC   blk_ice_tau   ! routine called in icesbc
-   PUBLIC   blk_ice_flx   ! routine called in icesbc
+   PUBLIC   blk_ice_1     ! routine called in icesbc
+   PUBLIC   blk_ice_2     ! routine called in icesbc
    PUBLIC   blk_ice_qcn   ! routine called in icesbc
-#endif 
-
-!!Lolo: should ultimately be moved in the module with all physical constants ?
-!!gm  : In principle, yes.
-   REAL(wp), PARAMETER ::   Cp_dry = 1005.0       !: Specic heat of dry air, constant pressure      [J/K/kg]
-   REAL(wp), PARAMETER ::   Cp_vap = 1860.0       !: Specic heat of water vapor, constant pressure  [J/K/kg]
-   REAL(wp), PARAMETER ::   R_dry = 287.05_wp     !: Specific gas constant for dry air              [J/K/kg]
-   REAL(wp), PARAMETER ::   R_vap = 461.495_wp    !: Specific gas constant for water vapor          [J/K/kg]
-   REAL(wp), PARAMETER ::   reps0 = R_dry/R_vap   !: ratio of gas constant for dry air and water vapor => ~ 0.622
-   REAL(wp), PARAMETER ::   rctv0 = R_vap/R_dry   !: for virtual temperature (== (1-eps)/eps) => ~ 0.608
-
-   INTEGER , PARAMETER ::   jpfld   =10           ! maximum number of files to read
-   INTEGER , PARAMETER ::   jp_wndi = 1           ! index of 10m wind velocity (i-component) (m/s)    at T-point
-   INTEGER , PARAMETER ::   jp_wndj = 2           ! index of 10m wind velocity (j-component) (m/s)    at T-point
-   INTEGER , PARAMETER ::   jp_tair = 3           ! index of 10m air temperature             (Kelvin)
-   INTEGER , PARAMETER ::   jp_humi = 4           ! index of specific humidity               ( % )
-   INTEGER , PARAMETER ::   jp_qsr  = 5           ! index of solar heat                      (W/m2)
-   INTEGER , PARAMETER ::   jp_qlw  = 6           ! index of Long wave                       (W/m2)
-   INTEGER , PARAMETER ::   jp_prec = 7           ! index of total precipitation (rain+snow) (Kg/m2/s)
-   INTEGER , PARAMETER ::   jp_snow = 8           ! index of snow (solid prcipitation)       (kg/m2/s)
-   INTEGER , PARAMETER ::   jp_slp  = 9           ! index of sea level pressure              (Pa)
-   INTEGER , PARAMETER ::   jp_tdif =10           ! index of tau diff associated to HF tau   (N/m2)   at T-point
-
-   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf   ! structure of input fields (file informations, fields read)
-
-   !                                             !!! Bulk parameters
-   REAL(wp), PARAMETER ::   cpa    = 1000.5         ! specific heat of air (only used for ice fluxes now...)
-   REAL(wp), PARAMETER ::   Ls     =    2.839e6     ! latent heat of sublimation
-   REAL(wp), PARAMETER ::   Stef   =    5.67e-8     ! Stefan Boltzmann constant
-   REAL(wp), PARAMETER ::   Cd_ice =    1.4e-3      ! transfer coefficient over ice
-   REAL(wp), PARAMETER ::   albo   =    0.066       ! ocean albedo assumed to be constant
-   !
+#endif
+
+   INTEGER , PUBLIC            ::   jpfld         ! maximum number of files to read
+   INTEGER , PUBLIC, PARAMETER ::   jp_wndi = 1   ! index of 10m wind velocity (i-component) (m/s)    at T-point
+   INTEGER , PUBLIC, PARAMETER ::   jp_wndj = 2   ! index of 10m wind velocity (j-component) (m/s)    at T-point
+   INTEGER , PUBLIC, PARAMETER ::   jp_tair = 3   ! index of 10m air temperature             (Kelvin)
+   INTEGER , PUBLIC, PARAMETER ::   jp_humi = 4   ! index of specific humidity               ( % )
+   INTEGER , PUBLIC, PARAMETER ::   jp_qsr  = 5   ! index of solar heat                      (W/m2)
+   INTEGER , PUBLIC, PARAMETER ::   jp_qlw  = 6   ! index of Long wave                       (W/m2)
+   INTEGER , PUBLIC, PARAMETER ::   jp_prec = 7   ! index of total precipitation (rain+snow) (Kg/m2/s)
+   INTEGER , PUBLIC, PARAMETER ::   jp_snow = 8   ! index of snow (solid prcipitation)       (kg/m2/s)
+   INTEGER , PUBLIC, PARAMETER ::   jp_slp  = 9   ! index of sea level pressure              (Pa)
+   INTEGER , PUBLIC, PARAMETER ::   jp_hpgi =10   ! index of ABL geostrophic wind or hpg (i-component) (m/s) at T-point
+   INTEGER , PUBLIC, PARAMETER ::   jp_hpgj =11   ! index of ABL geostrophic wind or hpg (j-component) (m/s) at T-point
+
+   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   sf   ! structure of input atmospheric fields (file informations, fields read)
+
    !                           !!* Namelist namsbc_blk : bulk parameters
    LOGICAL  ::   ln_NCAR        ! "NCAR"      algorithm   (Large and Yeager 2008)
    LOGICAL  ::   ln_COARE_3p0   ! "COARE 3.0" algorithm   (Fairall et al. 2003)
-   LOGICAL  ::   ln_COARE_3p5   ! "COARE 3.5" algorithm   (Edson et al. 2013)
-   LOGICAL  ::   ln_ECMWF       ! "ECMWF"     algorithm   (IFS cycle 31)
+   LOGICAL  ::   ln_COARE_3p6   ! "COARE 3.6" algorithm   (Edson et al. 2013)
+   LOGICAL  ::   ln_ECMWF       ! "ECMWF"     algorithm   (IFS cycle 45r1)
    !
-   LOGICAL  ::   ln_taudif      ! logical flag to use the "mean of stress module - module of mean stress" data
-   REAL(wp) ::   rn_pfac        ! multiplication factor for precipitation
-   REAL(wp) ::   rn_efac        ! multiplication factor for evaporation
-   REAL(wp) ::   rn_vfac        ! multiplication factor for ice/ocean velocity in the calculation of wind stress
-   REAL(wp) ::   rn_zqt         ! z(q,t) : height of humidity and temperature measurements
-   REAL(wp) ::   rn_zu          ! z(u)   : height of wind measurements
-!!gm ref namelist initialize it so remove the setting to false below
-   LOGICAL  ::   ln_Cd_L12 = .FALSE. !  Modify the drag ice-atm depending on ice concentration (from Lupkes et al. JGR2012)
-   LOGICAL  ::   ln_Cd_L15 = .FALSE. !  Modify the drag ice-atm depending on ice concentration (from Lupkes et al. JGR2015)
+   LOGICAL  ::   ln_Cd_L12      ! ice-atm drag = F( ice concentration )                        (Lupkes et al. JGR2012)
+   LOGICAL  ::   ln_Cd_L15      ! ice-atm drag = F( ice concentration, atmospheric stability ) (Lupkes et al. JGR2015)
    !
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Cd_atm                    ! transfer coefficient for momentum      (tau)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Ch_atm                    ! transfer coefficient for sensible heat (Q_sens)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Ce_atm                    ! tansfert coefficient for evaporation   (Q_lat)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_zu                      ! air temperature at wind speed height (needed by Lupkes 2015 bulk scheme)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_zu                      ! air spec. hum.  at wind speed height (needed by Lupkes 2015 bulk scheme)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   cdn_oce, chn_oce, cen_oce ! needed by Lupkes 2015 bulk scheme
-
-   LOGICAL  ::   ln_humi_dpt = .FALSE.                                        ! calculate specific hunidity from dewpoint
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qair                      ! specific humidity of air at input height
+   REAL(wp)         ::   rn_pfac   ! multiplication factor for precipitation
+   REAL(wp), PUBLIC ::   rn_efac   ! multiplication factor for evaporation
+   REAL(wp), PUBLIC ::   rn_vfac   ! multiplication factor for ice/ocean velocity in the calculation of wind stress
+   REAL(wp)         ::   rn_zqt    ! z(q,t) : height of humidity and temperature measurements
+   REAL(wp)         ::   rn_zu     ! z(u)   : height of wind measurements
+   !
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   Cd_ice , Ch_ice , Ce_ice   ! transfert coefficients over ice
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   Cdn_oce, Chn_oce, Cen_oce  ! neutral coeffs over ocean (L15 bulk scheme)
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   t_zu, q_zu                 ! air temp. and spec. hum. at wind speed height (L15 bulk scheme)
+
+   LOGICAL  ::   ln_skin_cs     ! use the cool-skin (only available in ECMWF and COARE algorithms) !LB
+   LOGICAL  ::   ln_skin_wl     ! use the warm-layer parameterization (only available in ECMWF and COARE algorithms) !LB
+   LOGICAL  ::   ln_humi_sph    ! humidity read in files ("sn_humi") is specific humidity [kg/kg] if .true. !LB
+   LOGICAL  ::   ln_humi_dpt    ! humidity read in files ("sn_humi") is dew-point temperature [K] if .true. !LB
+   LOGICAL  ::   ln_humi_rlh    ! humidity read in files ("sn_humi") is relative humidity     [%] if .true. !LB
+   !
+   INTEGER  ::   nhumi          ! choice of the bulk algorithm
+   !                            ! associated indices:
+   INTEGER, PARAMETER :: np_humi_sph = 1
+   INTEGER, PARAMETER :: np_humi_dpt = 2
+   INTEGER, PARAMETER :: np_humi_rlh = 3
 
    INTEGER  ::   nblk           ! choice of the bulk algorithm
@@ -131,9 +124,9 @@
    INTEGER, PARAMETER ::   np_NCAR      = 1   ! "NCAR" algorithm        (Large and Yeager 2008)
    INTEGER, PARAMETER ::   np_COARE_3p0 = 2   ! "COARE 3.0" algorithm   (Fairall et al. 2003)
-   INTEGER, PARAMETER ::   np_COARE_3p5 = 3   ! "COARE 3.5" algorithm   (Edson et al. 2013)
-   INTEGER, PARAMETER ::   np_ECMWF     = 4   ! "ECMWF" algorithm       (IFS cycle 31)
+   INTEGER, PARAMETER ::   np_COARE_3p6 = 3   ! "COARE 3.6" algorithm   (Edson et al. 2013)
+   INTEGER, PARAMETER ::   np_ECMWF     = 4   ! "ECMWF" algorithm       (IFS cycle 45r1)
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -147,6 +140,7 @@
       !!             ***  ROUTINE sbc_blk_alloc ***
       !!-------------------------------------------------------------------
-      ALLOCATE( Cd_atm (jpi,jpj), Ch_atm (jpi,jpj), Ce_atm (jpi,jpj), t_zu(jpi,jpj), q_zu(jpi,jpj), &
-         &      cdn_oce(jpi,jpj), chn_oce(jpi,jpj), cen_oce(jpi,jpj), qair(jpi,jpj), STAT=sbc_blk_alloc )
+      ALLOCATE( t_zu(jpi,jpj)   , q_zu(jpi,jpj)   ,                                      &
+         &      Cdn_oce(jpi,jpj), Chn_oce(jpi,jpj), Cen_oce(jpi,jpj),                    &
+         &      Cd_ice (jpi,jpj), Ch_ice (jpi,jpj), Ce_ice (jpi,jpj), STAT=sbc_blk_alloc )
       !
       CALL mpp_sum ( 'sbcblk', sbc_blk_alloc )
@@ -161,20 +155,21 @@
       !! ** Purpose :   choose and initialize a bulk formulae formulation
       !!
-      !! ** Method  : 
+      !! ** Method  :
       !!
       !!----------------------------------------------------------------------
-      INTEGER  ::   ifpr, jfld            ! dummy loop indice and argument
+      INTEGER  ::   jfpr                  ! dummy loop indice and argument
       INTEGER  ::   ios, ierror, ioptio   ! Local integer
       !!
       CHARACTER(len=100)            ::   cn_dir                ! Root directory for location of atmospheric forcing files
-      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                 ! array of namelist informations on the fields to read
+      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::   slf_i        ! array of namelist informations on the fields to read
       TYPE(FLD_N) ::   sn_wndi, sn_wndj, sn_humi, sn_qsr       ! informations about the fields to be read
       TYPE(FLD_N) ::   sn_qlw , sn_tair, sn_prec, sn_snow      !       "                        "
-      TYPE(FLD_N) ::   sn_slp , sn_tdif                        !       "                        "
+      TYPE(FLD_N) ::   sn_slp , sn_hpgi, sn_hpgj               !       "                        "
       NAMELIST/namsbc_blk/ sn_wndi, sn_wndj, sn_humi, sn_qsr, sn_qlw ,                &   ! input fields
-         &                 sn_tair, sn_prec, sn_snow, sn_slp, sn_tdif,                &
-         &                 ln_NCAR, ln_COARE_3p0, ln_COARE_3p5, ln_ECMWF, ln_humi_dpt,&   ! bulk algorithm
-         &                 cn_dir , ln_taudif, rn_zqt, rn_zu,                         & 
-         &                 rn_pfac, rn_efac, rn_vfac, ln_Cd_L12, ln_Cd_L15
+         &                 sn_tair, sn_prec, sn_snow, sn_slp, sn_hpgi, sn_hpgj,       &
+         &                 ln_NCAR, ln_COARE_3p0, ln_COARE_3p6, ln_ECMWF,             &   ! bulk algorithm
+         &                 cn_dir , rn_zqt, rn_zu,                                    &
+         &                 rn_pfac, rn_efac, rn_vfac, ln_Cd_L12, ln_Cd_L15,           &
+         &                 ln_skin_cs, ln_skin_wl, ln_humi_sph, ln_humi_dpt, ln_humi_rlh  ! cool-skin / warm-layer !LB
       !!---------------------------------------------------------------------
       !
@@ -182,10 +177,8 @@
       IF( sbc_blk_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_blk : unable to allocate standard arrays' )
       !
-      !                             !** read bulk namelist  
-      REWIND( numnam_ref )                !* Namelist namsbc_blk in reference namelist : bulk parameters
+      !                             !** read bulk namelist
       READ  ( numnam_ref, namsbc_blk, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_blk in reference namelist' )
       !
-      REWIND( numnam_cfg )                !* Namelist namsbc_blk in configuration namelist : bulk parameters
       READ  ( numnam_cfg, namsbc_blk, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_blk in configuration namelist' )
@@ -195,15 +188,51 @@
       !                             !** initialization of the chosen bulk formulae (+ check)
       !                                   !* select the bulk chosen in the namelist and check the choice
-                                                               ioptio = 0
-      IF( ln_NCAR      ) THEN   ;   nblk =  np_NCAR        ;   ioptio = ioptio + 1   ;   ENDIF
-      IF( ln_COARE_3p0 ) THEN   ;   nblk =  np_COARE_3p0   ;   ioptio = ioptio + 1   ;   ENDIF
-      IF( ln_COARE_3p5 ) THEN   ;   nblk =  np_COARE_3p5   ;   ioptio = ioptio + 1   ;   ENDIF
-      IF( ln_ECMWF     ) THEN   ;   nblk =  np_ECMWF       ;   ioptio = ioptio + 1   ;   ENDIF
-      !
+      ioptio = 0
+      IF( ln_NCAR      ) THEN
+         nblk =  np_NCAR        ;   ioptio = ioptio + 1
+      ENDIF
+      IF( ln_COARE_3p0 ) THEN
+         nblk =  np_COARE_3p0   ;   ioptio = ioptio + 1
+      ENDIF
+      IF( ln_COARE_3p6 ) THEN
+         nblk =  np_COARE_3p6   ;   ioptio = ioptio + 1
+      ENDIF
+      IF( ln_ECMWF     ) THEN
+         nblk =  np_ECMWF       ;   ioptio = ioptio + 1
+      ENDIF
       IF( ioptio /= 1 )   CALL ctl_stop( 'sbc_blk_init: Choose one and only one bulk algorithm' )
+
+      !                             !** initialization of the cool-skin / warm-layer parametrization
+      IF( ln_skin_cs .OR. ln_skin_wl ) THEN
+         !! Some namelist sanity tests:
+         IF( ln_NCAR )      &
+            & CALL ctl_stop( 'sbc_blk_init: Cool-skin/warm-layer param. not compatible with NCAR algorithm' )
+         IF( nn_fsbc /= 1 ) &
+            & CALL ctl_stop( 'sbc_blk_init: Please set "nn_fsbc" to 1 when using cool-skin/warm-layer param.')
+      END IF
+
+      IF( ln_skin_wl ) THEN
+         !! Check if the frequency of downwelling solar flux input makes sense and if ln_dm2dc=T if it is daily!
+         IF( (sn_qsr%freqh  < 0.).OR.(sn_qsr%freqh  > 24.) ) &
+            & CALL ctl_stop( 'sbc_blk_init: Warm-layer param. (ln_skin_wl) not compatible with freq. of solar flux > daily' )
+         IF( (sn_qsr%freqh == 24.).AND.(.NOT. ln_dm2dc) ) &
+            & CALL ctl_stop( 'sbc_blk_init: Please set ln_dm2dc=T for warm-layer param. (ln_skin_wl) to work properly' )
+      END IF
+
+      ioptio = 0
+      IF( ln_humi_sph ) THEN
+         nhumi =  np_humi_sph    ;   ioptio = ioptio + 1
+      ENDIF
+      IF( ln_humi_dpt ) THEN
+         nhumi =  np_humi_dpt    ;   ioptio = ioptio + 1
+      ENDIF
+      IF( ln_humi_rlh ) THEN
+         nhumi =  np_humi_rlh    ;   ioptio = ioptio + 1
+      ENDIF
+      IF( ioptio /= 1 )   CALL ctl_stop( 'sbc_blk_init: Choose one and only one type of air humidity' )
       !
       IF( ln_dm2dc ) THEN                 !* check: diurnal cycle on Qsr
          IF( sn_qsr%freqh /= 24. )   CALL ctl_stop( 'sbc_blk_init: ln_dm2dc=T only with daily short-wave input' )
-         IF( sn_qsr%ln_tint ) THEN 
+         IF( sn_qsr%ln_tint ) THEN
             CALL ctl_warn( 'sbc_blk_init: ln_dm2dc=T daily qsr time interpolation done by sbcdcy module',   &
                &           '              ==> We force time interpolation = .false. for qsr' )
@@ -213,56 +242,85 @@
       !                                   !* set the bulk structure
       !                                      !- store namelist information in an array
+      IF( ln_blk ) jpfld = 9
+      IF( ln_abl ) jpfld = 11
+      ALLOCATE( slf_i(jpfld) )
+      !
       slf_i(jp_wndi) = sn_wndi   ;   slf_i(jp_wndj) = sn_wndj
       slf_i(jp_qsr ) = sn_qsr    ;   slf_i(jp_qlw ) = sn_qlw
       slf_i(jp_tair) = sn_tair   ;   slf_i(jp_humi) = sn_humi
       slf_i(jp_prec) = sn_prec   ;   slf_i(jp_snow) = sn_snow
-      slf_i(jp_slp)  = sn_slp    ;   slf_i(jp_tdif) = sn_tdif
-      !
-      lhftau = ln_taudif                     !- add an extra field if HF stress is used
-      jfld = jpfld - COUNT( (/.NOT.lhftau/) )
+      slf_i(jp_slp ) = sn_slp
+      IF( ln_abl ) THEN
+         slf_i(jp_hpgi) = sn_hpgi   ;   slf_i(jp_hpgj) = sn_hpgj
+      END IF
       !
       !                                      !- allocate the bulk structure
-      ALLOCATE( sf(jfld), STAT=ierror )
+      ALLOCATE( sf(jpfld), STAT=ierror )
       IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_blk_init: unable to allocate sf structure' )
-      DO ifpr= 1, jfld
-         ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) )
-         IF( slf_i(ifpr)%ln_tint )   ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) )
-         IF( slf_i(ifpr)%freqh > 0. .AND. MOD( NINT(3600. * slf_i(ifpr)%freqh), nn_fsbc * NINT(rdt) ) /= 0 )   &
-            &  CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rdt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.',   &
-            &                 '               This is not ideal. You should consider changing either rdt or nn_fsbc value...' )
-
-      END DO
+      !
       !                                      !- fill the bulk structure with namelist informations
       CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_init', 'surface boundary condition -- bulk formulae', 'namsbc_blk' )
       !
-      IF ( ln_wave ) THEN
-      !Activated wave module but neither drag nor stokes drift activated
-         IF ( .NOT.(ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor ) )   THEN
+      DO jfpr= 1, jpfld
+         !
+         IF( TRIM(sf(jfpr)%clrootname) == 'NOT USED' ) THEN    !--  not used field  --!   (only now allocated and set to zero)
+            ALLOCATE( sf(jfpr)%fnow(jpi,jpj,1) )
+            sf(jfpr)%fnow(:,:,1) = 0._wp
+         ELSE                                                  !-- used field  --!
+            IF(   ln_abl    .AND.                                                      &
+               &    ( jfpr == jp_wndi .OR. jfpr == jp_wndj .OR. jfpr == jp_humi .OR.   &
+               &      jfpr == jp_hpgi .OR. jfpr == jp_hpgj .OR. jfpr == jp_tair     )  ) THEN   ! ABL: some fields are 3D input
+               ALLOCATE( sf(jfpr)%fnow(jpi,jpj,jpka) )
+               IF( sf(jfpr)%ln_tint )   ALLOCATE( sf(jfpr)%fdta(jpi,jpj,jpka,2) )
+            ELSE                                                                                ! others or Bulk fields are 2D fiels
+               ALLOCATE( sf(jfpr)%fnow(jpi,jpj,1) )
+               IF( sf(jfpr)%ln_tint )   ALLOCATE( sf(jfpr)%fdta(jpi,jpj,1,2) )
+            ENDIF
+            !
+            IF( sf(jfpr)%freqh > 0. .AND. MOD( NINT(3600. * sf(jfpr)%freqh), nn_fsbc * NINT(rn_Dt) ) /= 0 )   &
+               &  CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rn_Dt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.',   &
+               &                 '               This is not ideal. You should consider changing either rn_Dt or nn_fsbc value...' )
+         ENDIF
+      END DO
+      !
+      IF( ln_wave ) THEN
+         !Activated wave module but neither drag nor stokes drift activated
+         IF( .NOT.(ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor ) )   THEN
             CALL ctl_stop( 'STOP',  'Ask for wave coupling but ln_cdgw=F, ln_sdw=F, ln_tauwoc=F, ln_stcor=F' )
-      !drag coefficient read from wave model definable only with mfs bulk formulae and core 
-         ELSEIF (ln_cdgw .AND. .NOT. ln_NCAR )       THEN       
-             CALL ctl_stop( 'drag coefficient read from wave model definable only with NCAR and CORE bulk formulae')
-         ELSEIF (ln_stcor .AND. .NOT. ln_sdw)                             THEN
-             CALL ctl_stop( 'Stokes-Coriolis term calculated only if activated Stokes Drift ln_sdw=T')
+            !drag coefficient read from wave model definable only with mfs bulk formulae and core
+         ELSEIF(ln_cdgw .AND. .NOT. ln_NCAR )       THEN
+            CALL ctl_stop( 'drag coefficient read from wave model definable only with NCAR and CORE bulk formulae')
+         ELSEIF(ln_stcor .AND. .NOT. ln_sdw)                             THEN
+            CALL ctl_stop( 'Stokes-Coriolis term calculated only if activated Stokes Drift ln_sdw=T')
          ENDIF
       ELSE
-      IF ( ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor )                & 
-         &   CALL ctl_stop( 'Not Activated Wave Module (ln_wave=F) but asked coupling ',    &
-         &                  'with drag coefficient (ln_cdgw =T) '  ,                        &
-         &                  'or Stokes Drift (ln_sdw=T) ' ,                                 &
-         &                  'or ocean stress modification due to waves (ln_tauwoc=T) ',      &  
-         &                  'or Stokes-Coriolis term (ln_stcori=T)'  )
-      ENDIF 
-      !
-      !           
+         IF( ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor )                &
+            &   CALL ctl_stop( 'Not Activated Wave Module (ln_wave=F) but asked coupling ',    &
+            &                  'with drag coefficient (ln_cdgw =T) '  ,                        &
+            &                  'or Stokes Drift (ln_sdw=T) ' ,                                 &
+            &                  'or ocean stress modification due to waves (ln_tauwoc=T) ',      &
+            &                  'or Stokes-Coriolis term (ln_stcori=T)'  )
+      ENDIF
+      !
+      IF( ln_abl ) THEN       ! ABL: read 3D fields for wind, temperature, humidity and pressure gradient
+         rn_zqt = ght_abl(2)          ! set the bulk altitude to ABL first level
+         rn_zu  = ght_abl(2)
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '   ABL formulation: overwrite rn_zqt & rn_zu with ABL first level altitude'
+      ENDIF
+      !
+      ! set transfer coefficients to default sea-ice values
+      Cd_ice(:,:) = rCd_ice
+      Ch_ice(:,:) = rCd_ice
+      Ce_ice(:,:) = rCd_ice
+      !
       IF(lwp) THEN                     !** Control print
          !
-         WRITE(numout,*)                  !* namelist 
+         WRITE(numout,*)                  !* namelist
          WRITE(numout,*) '   Namelist namsbc_blk (other than data information):'
          WRITE(numout,*) '      "NCAR"      algorithm   (Large and Yeager 2008)     ln_NCAR      = ', ln_NCAR
          WRITE(numout,*) '      "COARE 3.0" algorithm   (Fairall et al. 2003)       ln_COARE_3p0 = ', ln_COARE_3p0
-         WRITE(numout,*) '      "COARE 3.5" algorithm   (Edson et al. 2013)         ln_COARE_3p5 = ', ln_COARE_3p0
-         WRITE(numout,*) '      "ECMWF"     algorithm   (IFS cycle 31)              ln_ECMWF     = ', ln_ECMWF
-         WRITE(numout,*) '      add High freq.contribution to the stress module     ln_taudif    = ', ln_taudif
+         WRITE(numout,*) '      "COARE 3.6" algorithm (Fairall 2018 + Edson al 2013)ln_COARE_3p6 = ', ln_COARE_3p6
+         WRITE(numout,*) '      "ECMWF"     algorithm   (IFS cycle 45r1)            ln_ECMWF     = ', ln_ECMWF
          WRITE(numout,*) '      Air temperature and humidity reference height (m)   rn_zqt       = ', rn_zqt
          WRITE(numout,*) '      Wind vector reference height (m)                    rn_zu        = ', rn_zu
@@ -278,6 +336,17 @@
          CASE( np_NCAR      )   ;   WRITE(numout,*) '   ==>>>   "NCAR" algorithm        (Large and Yeager 2008)'
          CASE( np_COARE_3p0 )   ;   WRITE(numout,*) '   ==>>>   "COARE 3.0" algorithm   (Fairall et al. 2003)'
-         CASE( np_COARE_3p5 )   ;   WRITE(numout,*) '   ==>>>   "COARE 3.5" algorithm   (Edson et al. 2013)'
-         CASE( np_ECMWF     )   ;   WRITE(numout,*) '   ==>>>   "ECMWF" algorithm       (IFS cycle 31)'
+         CASE( np_COARE_3p6 )   ;   WRITE(numout,*) '   ==>>>   "COARE 3.6" algorithm (Fairall 2018+Edson et al. 2013)'
+         CASE( np_ECMWF     )   ;   WRITE(numout,*) '   ==>>>   "ECMWF" algorithm       (IFS cycle 45r1)'
+         END SELECT
+         !
+         WRITE(numout,*)
+         WRITE(numout,*) '      use cool-skin  parameterization (SSST)  ln_skin_cs  = ', ln_skin_cs
+         WRITE(numout,*) '      use warm-layer parameterization (SSST)  ln_skin_wl  = ', ln_skin_wl
+         !
+         WRITE(numout,*)
+         SELECT CASE( nhumi )              !* Print the choice of air humidity
+         CASE( np_humi_sph )   ;   WRITE(numout,*) '   ==>>>   air humidity is SPECIFIC HUMIDITY     [kg/kg]'
+         CASE( np_humi_dpt )   ;   WRITE(numout,*) '   ==>>>   air humidity is DEW-POINT TEMPERATURE [K]'
+         CASE( np_humi_rlh )   ;   WRITE(numout,*) '   ==>>>   air humidity is RELATIVE HUMIDITY     [%]'
          END SELECT
          !
@@ -294,15 +363,16 @@
       !!              (momentum, heat, freshwater and runoff)
       !!
-      !! ** Method  : (1) READ each fluxes in NetCDF files:
-      !!      the 10m wind velocity (i-component) (m/s)    at T-point
-      !!      the 10m wind velocity (j-component) (m/s)    at T-point
-      !!      the 10m or 2m specific humidity     ( % )
-      !!      the solar heat                      (W/m2)
-      !!      the Long wave                       (W/m2)
-      !!      the 10m or 2m air temperature       (Kelvin)
-      !!      the total precipitation (rain+snow) (Kg/m2/s)
-      !!      the snow (solid prcipitation)       (kg/m2/s)
-      !!      the tau diff associated to HF tau   (N/m2)   at T-point   (ln_taudif=T)
-      !!              (2) CALL blk_oce
+      !! ** Method  :
+      !!              (1) READ each fluxes in NetCDF files:
+      !!      the wind velocity (i-component) at z=rn_zu  (m/s) at T-point
+      !!      the wind velocity (j-component) at z=rn_zu  (m/s) at T-point
+      !!      the specific humidity           at z=rn_zqt (kg/kg)
+      !!      the air temperature             at z=rn_zqt (Kelvin)
+      !!      the solar heat                              (W/m2)
+      !!      the Long wave                               (W/m2)
+      !!      the total precipitation (rain+snow)         (Kg/m2/s)
+      !!      the snow (solid precipitation)              (kg/m2/s)
+      !!      ABL dynamical forcing (i/j-components of either hpg or geostrophic winds)
+      !!              (2) CALL blk_oce_1 and blk_oce_2
       !!
       !!      C A U T I O N : never mask the surface stress fields
@@ -321,26 +391,73 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! ocean time step
-      !!---------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj) ::   zssq, zcd_du, zsen, zevp
+      REAL(wp) :: ztmp
+      !!----------------------------------------------------------------------
       !
       CALL fld_read( kt, nn_fsbc, sf )             ! input fields provided at the current time-step
-      !
+
+      ! Sanity/consistence test on humidity at first time step to detect potential screw-up:
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*) ''
+#if defined key_agrif
+         IF(lwp) WRITE(numout,*) ' === AGRIF => Sanity/consistence test on air humidity SKIPPED! :( ==='
+#else
+         ztmp = SUM(tmask(:,:,1)) ! number of ocean points on local proc domain
+         IF( ztmp > 8._wp ) THEN ! test only on proc domains with at least 8 ocean points!
+            ztmp = SUM(sf(jp_humi)%fnow(:,:,1)*tmask(:,:,1))/ztmp ! mean humidity over ocean on proc
+            SELECT CASE( nhumi )
+            CASE( np_humi_sph ) ! specific humidity => expect: 0. <= something < 0.065 [kg/kg] (0.061 is saturation at 45degC !!!)
+               IF(  (ztmp < 0._wp) .OR. (ztmp > 0.065)  ) ztmp = -1._wp
+            CASE( np_humi_dpt ) ! dew-point temperature => expect: 110. <= something < 320. [K]
+               IF( (ztmp < 110._wp).OR.(ztmp > 320._wp) ) ztmp = -1._wp
+            CASE( np_humi_rlh ) ! relative humidity => expect: 0. <= something < 100. [%]
+               IF(  (ztmp < 0._wp) .OR.(ztmp > 100._wp) ) ztmp = -1._wp
+            END SELECT
+            IF(ztmp < 0._wp) THEN
+               IF (lwp) WRITE(numout,'("   Mean humidity value found on proc #",i6.6," is: ",f10.5)') narea, ztmp
+               CALL ctl_stop( 'STOP', 'Something is wrong with air humidity!!!', &
+                  &   ' ==> check the unit in your input files'       , &
+                  &   ' ==> check consistence of namelist choice: specific? relative? dew-point?', &
+                  &   ' ==> ln_humi_sph -> [kg/kg] | ln_humi_rlh -> [%] | ln_humi_dpt -> [K] !!!' )
+            END IF
+         END IF
+         IF(lwp) WRITE(numout,*) ' === Sanity/consistence test on air humidity sucessfuly passed! ==='
+#endif
+         IF(lwp) WRITE(numout,*) ''
+      END IF !IF( kt == nit000 )
       !                                            ! compute the surface ocean fluxes using bulk formulea
-      ! ..... if dewpoint supplied instead of specific humidaity, calculate specific humidity
-      IF(ln_humi_dpt) THEN
-         qair(:,:) = q_sat( sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1) )
-      ELSE
-         qair(:,:) = sf(jp_humi)%fnow(:,:,1)
-      END IF
-      
-      IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce( kt, sf, sst_m, ssu_m, ssv_m )
-
+      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN
+         CALL blk_oce_1( kt, sf(jp_wndi)%fnow(:,:,1), sf(jp_wndj)%fnow(:,:,1),   &   !   <<= in
+            &                sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1),   &   !   <<= in
+            &                sf(jp_slp )%fnow(:,:,1), sst_m, ssu_m, ssv_m,       &   !   <<= in
+            &                sf(jp_qsr )%fnow(:,:,1), sf(jp_qlw )%fnow(:,:,1),   &   !   <<= in (wl/cs)
+            &                tsk_m, zssq, zcd_du, zsen, zevp )                       !   =>> out
+
+         CALL blk_oce_2(     sf(jp_tair)%fnow(:,:,1), sf(jp_qsr )%fnow(:,:,1),   &   !   <<= in
+            &                sf(jp_qlw )%fnow(:,:,1), sf(jp_prec)%fnow(:,:,1),   &   !   <<= in
+            &                sf(jp_snow)%fnow(:,:,1), tsk_m,                     &   !   <<= in
+            &                zsen, zevp )                                            !   <=> in out
+      ENDIF
+      !
 #if defined key_cice
       IF( MOD( kt - 1, nn_fsbc ) == 0 )   THEN
          qlw_ice(:,:,1)   = sf(jp_qlw )%fnow(:,:,1)
-         IF( ln_dm2dc ) THEN ; qsr_ice(:,:,1) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) )
-         ELSE                ; qsr_ice(:,:,1) =          sf(jp_qsr)%fnow(:,:,1) 
-         ENDIF 
+         IF( ln_dm2dc ) THEN
+            qsr_ice(:,:,1) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) )
+         ELSE
+            qsr_ice(:,:,1) =          sf(jp_qsr)%fnow(:,:,1)
+         ENDIF
          tatm_ice(:,:)    = sf(jp_tair)%fnow(:,:,1)
-         qatm_ice(:,:)    = qair(:,:)
+
+         SELECT CASE( nhumi )
+         CASE( np_humi_sph )
+            qatm_ice(:,:) =           sf(jp_humi)%fnow(:,:,1)
+         CASE( np_humi_dpt )
+            qatm_ice(:,:) = q_sat(    sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1) )
+         CASE( np_humi_rlh )
+            qatm_ice(:,:) = q_air_rh( 0.01_wp*sf(jp_humi)%fnow(:,:,1), sf(jp_tair)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1)) !LB: 0.01 => RH is % percent in file
+         END SELECT
+
          tprecip(:,:)     = sf(jp_prec)%fnow(:,:,1) * rn_pfac
          sprecip(:,:)     = sf(jp_snow)%fnow(:,:,1) * rn_pfac
@@ -353,13 +470,248 @@
 
 
-   SUBROUTINE blk_oce( kt, sf, pst, pu, pv )
-      !!---------------------------------------------------------------------
-      !!                     ***  ROUTINE blk_oce  ***
-      !!
-      !! ** Purpose :   provide the momentum, heat and freshwater fluxes at
-      !!      the ocean surface at each time step
-      !!
-      !! ** Method  :   bulk formulea for the ocean using atmospheric
-      !!      fields read in sbc_read
+   SUBROUTINE blk_oce_1( kt, pwndi, pwndj , ptair, phumi, &  ! inp
+      &                  pslp , pst   , pu   , pv,        &  ! inp
+      &                  pqsr , pqlw  ,                   &  ! inp
+      &                  ptsk, pssq , pcd_du, psen , pevp   )  ! out
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE blk_oce_1  ***
+      !!
+      !! ** Purpose :   if ln_blk=T, computes surface momentum, heat and freshwater fluxes
+      !!                if ln_abl=T, computes Cd x |U|, Ch x |U|, Ce x |U| for ABL integration
+      !!
+      !! ** Method  :   bulk formulae using atmospheric fields from :
+      !!                if ln_blk=T, atmospheric fields read in sbc_read
+      !!                if ln_abl=T, the ABL model at previous time-step
+      !!
+      !! ** Outputs : - pssq    : surface humidity used to compute latent heat flux (kg/kg)
+      !!              - pcd_du  : Cd x |dU| at T-points  (m/s)
+      !!              - psen    : Ch x |dU| at T-points  (m/s)
+      !!              - pevp    : Ce x |dU| at T-points  (m/s)
+      !!---------------------------------------------------------------------
+      INTEGER , INTENT(in   )                 ::   kt     ! time step index
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pwndi  ! atmospheric wind at U-point              [m/s]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pwndj  ! atmospheric wind at V-point              [m/s]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   phumi  ! specific humidity at T-points            [kg/kg]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   ptair  ! potential temperature at T-points        [Kelvin]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pslp   ! sea-level pressure                       [Pa]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pst    ! surface temperature                      [Celsius]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pu     ! surface current at U-point (i-component) [m/s]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pv     ! surface current at V-point (j-component) [m/s]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pqsr   !
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pqlw   !
+      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   ptsk   ! skin temp. (or SST if CS & WL not used)  [Celsius]
+      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pssq   ! specific humidity at pst                 [kg/kg]
+      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pcd_du ! Cd x |dU| at T-points                    [m/s]
+      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   psen   ! Ch x |dU| at T-points                    [m/s]
+      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pevp   ! Ce x |dU| at T-points                    [m/s]
+      !
+      INTEGER  ::   ji, jj               ! dummy loop indices
+      REAL(wp) ::   zztmp                ! local variable
+      REAL(wp), DIMENSION(jpi,jpj) ::   zwnd_i, zwnd_j    ! wind speed components at T-point
+      REAL(wp), DIMENSION(jpi,jpj) ::   zU_zu             ! bulk wind speed at height zu  [m/s]
+      REAL(wp), DIMENSION(jpi,jpj) ::   ztpot             ! potential temperature of air at z=rn_zqt [K]
+      REAL(wp), DIMENSION(jpi,jpj) ::   zqair             ! specific humidity     of air at z=rn_zqt [kg/kg]
+      REAL(wp), DIMENSION(jpi,jpj) ::   zcd_oce           ! momentum transfert coefficient over ocean
+      REAL(wp), DIMENSION(jpi,jpj) ::   zch_oce           ! sensible heat transfert coefficient over ocean
+      REAL(wp), DIMENSION(jpi,jpj) ::   zce_oce           ! latent   heat transfert coefficient over ocean
+      REAL(wp), DIMENSION(jpi,jpj) ::   zqla              ! latent heat flux
+      REAL(wp), DIMENSION(jpi,jpj) ::   zztmp1, zztmp2
+      !!---------------------------------------------------------------------
+      !
+      ! local scalars ( place there for vector optimisation purposes)
+      !                           ! Temporary conversion from Celcius to Kelvin (and set minimum value far above 0 K)
+      ptsk(:,:) = pst(:,:) + rt0  ! by default: skin temperature = "bulk SST" (will remain this way if NCAR algorithm used!)
+
+      ! ----------------------------------------------------------------------------- !
+      !      0   Wind components and module at T-point relative to the moving ocean   !
+      ! ----------------------------------------------------------------------------- !
+
+      ! ... components ( U10m - U_oce ) at T-point (unmasked)
+#if defined key_cyclone
+      zwnd_i(:,:) = 0._wp
+      zwnd_j(:,:) = 0._wp
+      CALL wnd_cyc( kt, zwnd_i, zwnd_j )    ! add analytical tropical cyclone (Vincent et al. JGR 2012)
+      DO_2D_00_00
+         pwndi(ji,jj) = pwndi(ji,jj) + zwnd_i(ji,jj)
+         pwndj(ji,jj) = pwndj(ji,jj) + zwnd_j(ji,jj)
+      END_2D
+#endif
+      DO_2D_00_00
+         zwnd_i(ji,jj) = (  pwndi(ji,jj) - rn_vfac * 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  )
+         zwnd_j(ji,jj) = (  pwndj(ji,jj) - rn_vfac * 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  )
+      END_2D
+      CALL lbc_lnk_multi( 'sbcblk', zwnd_i, 'T', -1., zwnd_j, 'T', -1. )
+      ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked)
+      wndm(:,:) = SQRT(  zwnd_i(:,:) * zwnd_i(:,:)   &
+         &             + zwnd_j(:,:) * zwnd_j(:,:)  ) * tmask(:,:,1)
+
+      ! ----------------------------------------------------------------------------- !
+      !      I   Solar FLUX                                                           !
+      ! ----------------------------------------------------------------------------- !
+
+      ! ocean albedo assumed to be constant + modify now Qsr to include the diurnal cycle                    ! Short Wave
+      zztmp = 1. - albo
+      IF( ln_dm2dc ) THEN
+         qsr(:,:) = zztmp * sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1)
+      ELSE
+         qsr(:,:) = zztmp *          sf(jp_qsr)%fnow(:,:,1)   * tmask(:,:,1)
+      ENDIF
+
+
+      ! ----------------------------------------------------------------------------- !
+      !     II   Turbulent FLUXES                                                     !
+      ! ----------------------------------------------------------------------------- !
+
+      ! specific humidity at SST
+      pssq(:,:) = rdct_qsat_salt * q_sat( ptsk(:,:), pslp(:,:) )
+
+      IF( ln_skin_cs .OR. ln_skin_wl ) THEN
+         !! Backup "bulk SST" and associated spec. hum.
+         zztmp1(:,:) = ptsk(:,:)
+         zztmp2(:,:) = pssq(:,:)
+      ENDIF
+
+      ! specific humidity of air at "rn_zqt" m above the sea
+      SELECT CASE( nhumi )
+      CASE( np_humi_sph )
+         zqair(:,:) = phumi(:,:)      ! what we read in file is already a spec. humidity!
+      CASE( np_humi_dpt )
+         !IF(lwp) WRITE(numout,*) ' *** blk_oce => computing q_air out of d_air and slp !' !LBrm
+         zqair(:,:) = q_sat( phumi(:,:), pslp(:,:) )
+      CASE( np_humi_rlh )
+         !IF(lwp) WRITE(numout,*) ' *** blk_oce => computing q_air out of RH, t_air and slp !' !LBrm
+         zqair(:,:) = q_air_rh( 0.01_wp*phumi(:,:), ptair(:,:), pslp(:,:) ) !LB: 0.01 => RH is % percent in file
+      END SELECT
+      !
+      ! potential temperature of air at "rn_zqt" m above the sea
+      IF( ln_abl ) THEN
+         ztpot = ptair(:,:)
+      ELSE
+         ! Estimate of potential temperature at z=rn_zqt, based on adiabatic lapse-rate
+         !    (see Josey, Gulev & Yu, 2013) / doi=10.1016/B978-0-12-391851-2.00005-2
+         !    (since reanalysis products provide T at z, not theta !)
+         !#LB: because AGRIF hates functions that return something else than a scalar, need to
+         !     use scalar version of gamma_moist() ...
+         DO_2D_11_11
+            ztpot(ji,jj) = ptair(ji,jj) + gamma_moist( ptair(ji,jj), zqair(ji,jj) ) * rn_zqt
+         END_2D
+      ENDIF
+
+
+
+      !! Time to call the user-selected bulk parameterization for
+      !!  ==  transfer coefficients  ==!   Cd, Ch, Ce at T-point, and more...
+      SELECT CASE( nblk )
+
+      CASE( np_NCAR      )
+         CALL turb_ncar    ( rn_zqt, rn_zu, ptsk, ztpot, pssq, zqair, wndm,                              &
+            &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce )
+
+      CASE( np_COARE_3p0 )
+         CALL turb_coare3p0 ( kt, rn_zqt, rn_zu, ptsk, ztpot, pssq, zqair, wndm, ln_skin_cs, ln_skin_wl, &
+            &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,   &
+            &                Qsw=qsr(:,:), rad_lw=pqlw(:,:), slp=pslp(:,:) )
+
+      CASE( np_COARE_3p6 )
+         CALL turb_coare3p6 ( kt, rn_zqt, rn_zu, ptsk, ztpot, pssq, zqair, wndm, ln_skin_cs, ln_skin_wl, &
+            &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,   &
+            &                Qsw=qsr(:,:), rad_lw=pqlw(:,:), slp=pslp(:,:) )
+
+      CASE( np_ECMWF     )
+         CALL turb_ecmwf   ( kt, rn_zqt, rn_zu, ptsk, ztpot, pssq, zqair, wndm, ln_skin_cs, ln_skin_wl,  &
+            &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,   &
+            &                Qsw=qsr(:,:), rad_lw=pqlw(:,:), slp=pslp(:,:) )
+
+      CASE DEFAULT
+         CALL ctl_stop( 'STOP', 'sbc_oce: non-existing bulk formula selected' )
+
+      END SELECT
+
+      IF( ln_skin_cs .OR. ln_skin_wl ) THEN
+         !! ptsk and pssq have been updated!!!
+         !!
+         !! In the presence of sea-ice we forget about the cool-skin/warm-layer update of ptsk and pssq:
+         WHERE ( fr_i(:,:) > 0.001_wp )
+            ! sea-ice present, we forget about the update, using what we backed up before call to turb_*()
+            ptsk(:,:) = zztmp1(:,:)
+            pssq(:,:) = zztmp2(:,:)
+         END WHERE
+      END IF
+
+      !  Turbulent fluxes over ocean  => BULK_FORMULA @ sbcblk_phy.F90
+      ! -------------------------------------------------------------
+
+      IF( ln_abl ) THEN         !==  ABL formulation  ==!   multiplication by rho_air and turbulent fluxes computation done in ablstp
+         DO_2D_11_11
+            zztmp = zU_zu(ji,jj)
+            wndm(ji,jj)   = zztmp                   ! Store zU_zu in wndm to compute ustar2 in ablmod
+            pcd_du(ji,jj) = zztmp * zcd_oce(ji,jj)
+            psen(ji,jj)   = zztmp * zch_oce(ji,jj)
+            pevp(ji,jj)   = zztmp * zce_oce(ji,jj)
+            rhoa(ji,jj)   = rho_air( ptair(ji,jj), phumi(ji,jj), pslp(ji,jj) )
+         END_2D
+      ELSE                      !==  BLK formulation  ==!   turbulent fluxes computation
+         CALL BULK_FORMULA( rn_zu, ptsk(:,:), pssq(:,:), t_zu(:,:), q_zu(:,:), &
+            &               zcd_oce(:,:), zch_oce(:,:), zce_oce(:,:),          &
+            &               wndm(:,:), zU_zu(:,:), pslp(:,:),                  &
+            &               taum(:,:), psen(:,:), zqla(:,:),                   &
+            &               pEvap=pevp(:,:), prhoa=rhoa(:,:), pfact_evap=rn_efac )
+
+         zqla(:,:) = zqla(:,:) * tmask(:,:,1)
+         psen(:,:) = psen(:,:) * tmask(:,:,1)
+         taum(:,:) = taum(:,:) * tmask(:,:,1)
+         pevp(:,:) = pevp(:,:) * tmask(:,:,1)
+
+         ! Tau i and j component on T-grid points, using array "zcd_oce" as a temporary array...
+         zcd_oce = 0._wp
+         WHERE ( wndm > 0._wp ) zcd_oce = taum / wndm
+         zwnd_i = zcd_oce * zwnd_i
+         zwnd_j = zcd_oce * zwnd_j
+
+         CALL iom_put( "taum_oce", taum )   ! output wind stress module
+
+         ! ... utau, vtau at U- and V_points, resp.
+         !     Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines
+         !     Note that coastal wind stress is not used in the code... so this extra care has no effect
+         DO_2D_00_00
+            utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( zwnd_i(ji,jj) + zwnd_i(ji+1,jj  ) ) &
+               &          * MAX(tmask(ji,jj,1),tmask(ji+1,jj,1))
+            vtau(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( zwnd_j(ji,jj) + zwnd_j(ji  ,jj+1) ) &
+               &          * MAX(tmask(ji,jj,1),tmask(ji,jj+1,1))
+         END_2D
+         CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1., vtau, 'V', -1. )
+
+         IF(sn_cfctl%l_prtctl) THEN
+            CALL prt_ctl( tab2d_1=wndm  , clinfo1=' blk_oce_1: wndm   : ')
+            CALL prt_ctl( tab2d_1=utau  , clinfo1=' blk_oce_1: utau   : ', mask1=umask,   &
+               &          tab2d_2=vtau  , clinfo2='            vtau   : ', mask2=vmask )
+         ENDIF
+         !
+      ENDIF !IF( ln_abl )
+      
+      ptsk(:,:) = ( ptsk(:,:) - rt0 ) * tmask(:,:,1)  ! Back to Celsius
+            
+      IF( ln_skin_cs .OR. ln_skin_wl ) THEN
+         CALL iom_put( "t_skin" ,  ptsk        )  ! T_skin in Celsius
+         CALL iom_put( "dt_skin" , ptsk - pst  )  ! T_skin - SST temperature difference...
+      ENDIF
+
+      IF(sn_cfctl%l_prtctl) THEN
+         CALL prt_ctl( tab2d_1=pevp  , clinfo1=' blk_oce_1: pevp   : ' )
+         CALL prt_ctl( tab2d_1=psen  , clinfo1=' blk_oce_1: psen   : ' )
+         CALL prt_ctl( tab2d_1=pssq  , clinfo1=' blk_oce_1: pssq   : ' )
+      ENDIF
+      !
+   END SUBROUTINE blk_oce_1
+
+
+   SUBROUTINE blk_oce_2( ptair, pqsr, pqlw, pprec,   &   ! <<= in
+      &                  psnow, ptsk, psen, pevp     )   ! <<= in
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE blk_oce_2  ***
+      !!
+      !! ** Purpose :   finalize the momentum, heat and freshwater fluxes computation
+      !!                at the ocean surface at each time step knowing Cd, Ch, Ce and
+      !!                atmospheric variables (from ABL or external data)
       !!
       !! ** Outputs : - utau    : i-component of the stress at U-point  (N/m2)
@@ -370,325 +722,94 @@
       !!              - qns     : Non Solar heat flux over the ocean    (W/m2)
       !!              - emp     : evaporation minus precipitation       (kg/m2/s)
-      !!
-      !!  ** Nota  :   sf has to be a dummy argument for AGRIF on NEC
-      !!---------------------------------------------------------------------
-      INTEGER  , INTENT(in   )                 ::   kt    ! time step index
-      TYPE(fld), INTENT(inout), DIMENSION(:)   ::   sf    ! input data
-      REAL(wp) , INTENT(in)   , DIMENSION(:,:) ::   pst   ! surface temperature                      [Celcius]
-      REAL(wp) , INTENT(in)   , DIMENSION(:,:) ::   pu    ! surface current at U-point (i-component) [m/s]
-      REAL(wp) , INTENT(in)   , DIMENSION(:,:) ::   pv    ! surface current at V-point (j-component) [m/s]
+      !!---------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptair
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   pqsr
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   pqlw
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   pprec
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   psnow
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptsk   ! SKIN surface temperature   [Celsius]
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   psen
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   pevp
       !
       INTEGER  ::   ji, jj               ! dummy loop indices
-      REAL(wp) ::   zztmp                ! local variable
-      REAL(wp), DIMENSION(jpi,jpj) ::   zwnd_i, zwnd_j    ! wind speed components at T-point
-      REAL(wp), DIMENSION(jpi,jpj) ::   zsq               ! specific humidity at pst
-      REAL(wp), DIMENSION(jpi,jpj) ::   zqlw, zqsb        ! long wave and sensible heat fluxes
-      REAL(wp), DIMENSION(jpi,jpj) ::   zqla, zevap       ! latent heat fluxes and evaporation
-      REAL(wp), DIMENSION(jpi,jpj) ::   zst               ! surface temperature in Kelvin
-      REAL(wp), DIMENSION(jpi,jpj) ::   zU_zu             ! bulk wind speed at height zu  [m/s]
-      REAL(wp), DIMENSION(jpi,jpj) ::   ztpot             ! potential temperature of air at z=rn_zqt [K]
-      REAL(wp), DIMENSION(jpi,jpj) ::   zrhoa             ! density of air   [kg/m^3]
+      REAL(wp) ::   zztmp,zz1,zz2,zz3    ! local variable
+      REAL(wp), DIMENSION(jpi,jpj) ::   ztskk             ! skin temp. in Kelvin 
+      REAL(wp), DIMENSION(jpi,jpj) ::   zqlw              ! long wave and sensible heat fluxes      
+      REAL(wp), DIMENSION(jpi,jpj) ::   zqla              ! latent heat fluxes and evaporation
       !!---------------------------------------------------------------------
       !
       ! local scalars ( place there for vector optimisation purposes)
-      zst(:,:) = pst(:,:) + rt0      ! convert SST from Celcius to Kelvin (and set minimum value far above 0 K)
-
+
+
+      ztskk(:,:) = ptsk(:,:) + rt0  ! => ptsk in Kelvin rather than Celsius
+      
       ! ----------------------------------------------------------------------------- !
-      !      0   Wind components and module at T-point relative to the moving ocean   !
+      !     III    Net longwave radiative FLUX                                        !
       ! ----------------------------------------------------------------------------- !
 
-      ! ... components ( U10m - U_oce ) at T-point (unmasked)
-!!gm    move zwnd_i (_j) set to zero  inside the key_cyclone ???
-      zwnd_i(:,:) = 0._wp
-      zwnd_j(:,:) = 0._wp
-#if defined key_cyclone
-      CALL wnd_cyc( kt, zwnd_i, zwnd_j )    ! add analytical tropical cyclone (Vincent et al. JGR 2012)
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vect. opt.
-            sf(jp_wndi)%fnow(ji,jj,1) = sf(jp_wndi)%fnow(ji,jj,1) + zwnd_i(ji,jj)
-            sf(jp_wndj)%fnow(ji,jj,1) = sf(jp_wndj)%fnow(ji,jj,1) + zwnd_j(ji,jj)
-         END DO
-      END DO
-#endif
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vect. opt.
-            zwnd_i(ji,jj) = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  )
-            zwnd_j(ji,jj) = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  )
-         END DO
-      END DO
-      CALL lbc_lnk_multi( 'sbcblk', zwnd_i, 'T', -1., zwnd_j, 'T', -1. )
-      ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked)
-      wndm(:,:) = SQRT(  zwnd_i(:,:) * zwnd_i(:,:)   &
-         &             + zwnd_j(:,:) * zwnd_j(:,:)  ) * tmask(:,:,1)
+      !! LB: now moved after Turbulent fluxes because must use the skin temperature rather that the SST
+      !! (ztskk is skin temperature if ln_skin_cs==.TRUE. .OR. ln_skin_wl==.TRUE.)
+      zqlw(:,:) = emiss_w * ( pqlw(:,:) - stefan*ztskk(:,:)*ztskk(:,:)*ztskk(:,:)*ztskk(:,:) ) * tmask(:,:,1)   ! Net radiative longwave flux
+
+      !  Latent flux over ocean
+      ! -----------------------
+
+      ! use scalar version of L_vap() for AGRIF compatibility
+      DO_2D_11_11
+         zqla(ji,jj) = - L_vap( ztskk(ji,jj) ) * pevp(ji,jj)    ! Latent Heat flux !!GS: possibility to add a global qla to avoid recomputation after abl update
+      END_2D
+
+      IF(sn_cfctl%l_prtctl) THEN
+         CALL prt_ctl( tab2d_1=zqla  , clinfo1=' blk_oce_2: zqla   : ' )
+         CALL prt_ctl( tab2d_1=zqlw  , clinfo1=' blk_oce_2: zqlw   : ', tab2d_2=qsr, clinfo2=' qsr : ' )
+
+      ENDIF
 
       ! ----------------------------------------------------------------------------- !
-      !      I   Radiative FLUXES                                                     !
+      !     IV    Total FLUXES                                                       !
       ! ----------------------------------------------------------------------------- !
-
-      ! ocean albedo assumed to be constant + modify now Qsr to include the diurnal cycle                    ! Short Wave
-      zztmp = 1. - albo
-      IF( ln_dm2dc ) THEN   ;   qsr(:,:) = zztmp * sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1)
-      ELSE                  ;   qsr(:,:) = zztmp *          sf(jp_qsr)%fnow(:,:,1)   * tmask(:,:,1)
-      ENDIF
-
-      zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave
-
-      ! ----------------------------------------------------------------------------- !
-      !     II    Turbulent FLUXES                                                    !
-      ! ----------------------------------------------------------------------------- !
-
-      ! ... specific humidity at SST and IST tmask(
-      zsq(:,:) = 0.98 * q_sat( zst(:,:), sf(jp_slp)%fnow(:,:,1) )
-      !!
-      !! Estimate of potential temperature at z=rn_zqt, based on adiabatic lapse-rate
-      !!    (see Josey, Gulev & Yu, 2013) / doi=10.1016/B978-0-12-391851-2.00005-2
-      !!    (since reanalysis products provide T at z, not theta !)
-      ztpot(:,:) = sf(jp_tair)%fnow(:,:,1) + gamma_moist( sf(jp_tair)%fnow(:,:,1), qair(:,:) ) * rn_zqt
-
-      SELECT CASE( nblk )        !==  transfer coefficients  ==!   Cd, Ch, Ce at T-point
-      !
-      CASE( np_NCAR      )   ;   CALL turb_ncar    ( rn_zqt, rn_zu, zst, ztpot, zsq, qair, wndm,   &  ! NCAR-COREv2
-         &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce )
-      CASE( np_COARE_3p0 )   ;   CALL turb_coare   ( rn_zqt, rn_zu, zst, ztpot, zsq, qair, wndm,   &  ! COARE v3.0
-         &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce )
-      CASE( np_COARE_3p5 )   ;   CALL turb_coare3p5( rn_zqt, rn_zu, zst, ztpot, zsq, qair, wndm,   &  ! COARE v3.5
-         &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce )
-      CASE( np_ECMWF     )   ;   CALL turb_ecmwf   ( rn_zqt, rn_zu, zst, ztpot, zsq, qair, wndm,   &  ! ECMWF
-         &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce )
-      CASE DEFAULT
-         CALL ctl_stop( 'STOP', 'sbc_oce: non-existing bulk formula selected' )
-      END SELECT
-
-      !                          ! Compute true air density :
-      IF( ABS(rn_zu - rn_zqt) > 0.01 ) THEN     ! At zu: (probably useless to remove zrho*grav*rn_zu from SLP...)
-         zrhoa(:,:) = rho_air( t_zu(:,:)              , q_zu(:,:)              , sf(jp_slp)%fnow(:,:,1) )
-      ELSE                                      ! At zt:
-         zrhoa(:,:) = rho_air( sf(jp_tair)%fnow(:,:,1), qair(:,:), sf(jp_slp)%fnow(:,:,1) )
-      END IF
-
-!!      CALL iom_put( "Cd_oce", Cd_atm)  ! output value of pure ocean-atm. transfer coef.
-!!      CALL iom_put( "Ch_oce", Ch_atm)  ! output value of pure ocean-atm. transfer coef.
-
-      DO jj = 1, jpj             ! tau module, i and j component
-         DO ji = 1, jpi
-            zztmp = zrhoa(ji,jj)  * zU_zu(ji,jj) * Cd_atm(ji,jj)   ! using bulk wind speed
-            taum  (ji,jj) = zztmp * wndm  (ji,jj)
-            zwnd_i(ji,jj) = zztmp * zwnd_i(ji,jj)
-            zwnd_j(ji,jj) = zztmp * zwnd_j(ji,jj)
-         END DO
-      END DO
-
-      !                          ! add the HF tau contribution to the wind stress module
-      IF( lhftau )   taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:,1)
-
-      CALL iom_put( "taum_oce", taum )   ! output wind stress module
-
-      ! ... utau, vtau at U- and V_points, resp.
-      !     Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines
-      !     Note the use of MAX(tmask(i,j),tmask(i+1,j) is to mask tau over ice shelves
-      DO jj = 1, jpjm1
-         DO ji = 1, fs_jpim1
-            utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( zwnd_i(ji,jj) + zwnd_i(ji+1,jj  ) ) &
-               &          * MAX(tmask(ji,jj,1),tmask(ji+1,jj,1))
-            vtau(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( zwnd_j(ji,jj) + zwnd_j(ji  ,jj+1) ) &
-               &          * MAX(tmask(ji,jj,1),tmask(ji,jj+1,1))
-         END DO
-      END DO
-      CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1., vtau, 'V', -1. )
-
-      !  Turbulent fluxes over ocean
-      ! -----------------------------
-
-      ! zqla used as temporary array, for rho*U (common term of bulk formulae):
-      zqla(:,:) = zrhoa(:,:) * zU_zu(:,:) * tmask(:,:,1)
-
-      IF( ABS( rn_zu - rn_zqt) < 0.01_wp ) THEN
-         !! q_air and t_air are given at 10m (wind reference height)
-         zevap(:,:) = rn_efac*MAX( 0._wp,             zqla(:,:)*Ce_atm(:,:)*(zsq(:,:) - qair(:,:)) ) ! Evaporation, using bulk wind speed
-         zqsb (:,:) = cp_air(qair(:,:))*zqla(:,:)*Ch_atm(:,:)*(zst(:,:) - ztpot(:,:)             )   ! Sensible Heat, using bulk wind speed
-      ELSE
-         !! q_air and t_air are not given at 10m (wind reference height)
-         ! Values of temp. and hum. adjusted to height of wind during bulk algorithm iteration must be used!!!
-         zevap(:,:) = rn_efac*MAX( 0._wp,             zqla(:,:)*Ce_atm(:,:)*(zsq(:,:) - q_zu(:,:) ) ) ! Evaporation, using bulk wind speed
-         zqsb (:,:) = cp_air(qair(:,:))*zqla(:,:)*Ch_atm(:,:)*(zst(:,:) - t_zu(:,:) )   ! Sensible Heat, using bulk wind speed
-      ENDIF
-
-      zqla(:,:) = L_vap(zst(:,:)) * zevap(:,:)     ! Latent Heat flux
-
-
-      IF(ln_ctl) THEN
-         CALL prt_ctl( tab2d_1=zqla  , clinfo1=' blk_oce: zqla   : ', tab2d_2=Ce_atm , clinfo2=' Ce_oce  : ' )
-         CALL prt_ctl( tab2d_1=zqsb  , clinfo1=' blk_oce: zqsb   : ', tab2d_2=Ch_atm , clinfo2=' Ch_oce  : ' )
-         CALL prt_ctl( tab2d_1=zqlw  , clinfo1=' blk_oce: zqlw   : ', tab2d_2=qsr, clinfo2=' qsr : ' )
-         CALL prt_ctl( tab2d_1=zsq   , clinfo1=' blk_oce: zsq    : ', tab2d_2=zst, clinfo2=' zst : ' )
-         CALL prt_ctl( tab2d_1=utau  , clinfo1=' blk_oce: utau   : ', mask1=umask,   &
-            &          tab2d_2=vtau  , clinfo2=           ' vtau : ', mask2=vmask )
-         CALL prt_ctl( tab2d_1=wndm  , clinfo1=' blk_oce: wndm   : ')
-         CALL prt_ctl( tab2d_1=zst   , clinfo1=' blk_oce: zst    : ')
-      ENDIF
-
-      ! ----------------------------------------------------------------------------- !
-      !     III    Total FLUXES                                                       !
-      ! ----------------------------------------------------------------------------- !
-      !
-      emp (:,:) = (  zevap(:,:)                                          &   ! mass flux (evap. - precip.)
-         &         - sf(jp_prec)%fnow(:,:,1) * rn_pfac  ) * tmask(:,:,1)
-      !
-      qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                &   ! Downward Non Solar
-         &     - sf(jp_snow)%fnow(:,:,1) * rn_pfac * rLfus                        &   ! remove latent melting heat for solid precip
-         &     - zevap(:,:) * pst(:,:) * rcp                                      &   ! remove evap heat content at SST
-         &     + ( sf(jp_prec)%fnow(:,:,1) - sf(jp_snow)%fnow(:,:,1) ) * rn_pfac  &   ! add liquid precip heat content at Tair
-         &     * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp                          &
-         &     + sf(jp_snow)%fnow(:,:,1) * rn_pfac                                &   ! add solid  precip heat content at min(Tair,Tsnow)
-         &     * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi
+      !
+      emp (:,:) = (  pevp(:,:)                                       &   ! mass flux (evap. - precip.)
+         &         - pprec(:,:) * rn_pfac  ) * tmask(:,:,1)
+      !
+      qns(:,:) = zqlw(:,:) + psen(:,:) + zqla(:,:)                   &   ! Downward Non Solar
+         &     - psnow(:,:) * rn_pfac * rLfus                        &   ! remove latent melting heat for solid precip
+         &     - pevp(:,:) * ptsk(:,:) * rcp                         &   ! remove evap heat content at SST
+         &     + ( pprec(:,:) - psnow(:,:) ) * rn_pfac               &   ! add liquid precip heat content at Tair
+         &     * ( ptair(:,:) - rt0 ) * rcp                          &
+         &     + psnow(:,:) * rn_pfac                                &   ! add solid  precip heat content at min(Tair,Tsnow)
+         &     * ( MIN( ptair(:,:), rt0 ) - rt0 ) * rcpi
       qns(:,:) = qns(:,:) * tmask(:,:,1)
       !
 #if defined key_si3
-      qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                ! non solar without emp (only needed by SI3)
+      qns_oce(:,:) = zqlw(:,:) + psen(:,:) + zqla(:,:)                             ! non solar without emp (only needed by SI3)
       qsr_oce(:,:) = qsr(:,:)
 #endif
       !
+      CALL iom_put( "rho_air"  , rhoa*tmask(:,:,1) )       ! output air density [kg/m^3]
+      CALL iom_put( "evap_oce" , pevp )                    ! evaporation
+      CALL iom_put( "qlw_oce"  , zqlw )                    ! output downward longwave heat over the ocean
+      CALL iom_put( "qsb_oce"  , psen )                    ! output downward sensible heat over the ocean
+      CALL iom_put( "qla_oce"  , zqla )                    ! output downward latent   heat over the ocean
+      tprecip(:,:) = pprec(:,:) * rn_pfac * tmask(:,:,1)   ! output total precipitation [kg/m2/s]
+      sprecip(:,:) = psnow(:,:) * rn_pfac * tmask(:,:,1)   ! output solid precipitation [kg/m2/s]
+      CALL iom_put( 'snowpre', sprecip )                   ! Snow
+      CALL iom_put( 'precip' , tprecip )                   ! Total precipitation
+      !
       IF ( nn_ice == 0 ) THEN
-         CALL iom_put( "qlw_oce" ,   zqlw )                 ! output downward longwave heat over the ocean
-         CALL iom_put( "qsb_oce" , - zqsb )                 ! output downward sensible heat over the ocean
-         CALL iom_put( "qla_oce" , - zqla )                 ! output downward latent   heat over the ocean
-         CALL iom_put( "qemp_oce",   qns-zqlw+zqsb+zqla )   ! output downward heat content of E-P over the ocean
-         CALL iom_put( "qns_oce" ,   qns  )                 ! output downward non solar heat over the ocean
-         CALL iom_put( "qsr_oce" ,   qsr  )                 ! output downward solar heat over the ocean
-         CALL iom_put( "qt_oce"  ,   qns+qsr )              ! output total downward heat over the ocean
-         tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac * tmask(:,:,1) ! output total precipitation [kg/m2/s]
-         sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac * tmask(:,:,1) ! output solid precipitation [kg/m2/s]
-         CALL iom_put( 'snowpre', sprecip )                 ! Snow
-         CALL iom_put( 'precip' , tprecip )                 ! Total precipitation
-      ENDIF
-      !
-      IF(ln_ctl) THEN
-         CALL prt_ctl(tab2d_1=zqsb , clinfo1=' blk_oce: zqsb   : ', tab2d_2=zqlw , clinfo2=' zqlw  : ')
-         CALL prt_ctl(tab2d_1=zqla , clinfo1=' blk_oce: zqla   : ', tab2d_2=qsr  , clinfo2=' qsr   : ')
-         CALL prt_ctl(tab2d_1=pst  , clinfo1=' blk_oce: pst    : ', tab2d_2=emp  , clinfo2=' emp   : ')
-         CALL prt_ctl(tab2d_1=utau , clinfo1=' blk_oce: utau   : ', mask1=umask,   &
-            &         tab2d_2=vtau , clinfo2=              ' vtau  : ' , mask2=vmask )
-      ENDIF
-      !
-   END SUBROUTINE blk_oce
-
-
-
-   FUNCTION rho_air( ptak, pqa, pslp )
-      !!-------------------------------------------------------------------------------
-      !!                           ***  FUNCTION rho_air  ***
-      !!
-      !! ** Purpose : compute density of (moist) air using the eq. of state of the atmosphere
-      !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
-      !!-------------------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak      ! air temperature             [K]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqa       ! air specific humidity   [kg/kg]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pslp      ! pressure in                [Pa]
-      REAL(wp), DIMENSION(jpi,jpj)             ::   rho_air   ! density of moist air   [kg/m^3]
-      !!-------------------------------------------------------------------------------
-      !
-      rho_air = pslp / (  R_dry*ptak * ( 1._wp + rctv0*pqa )  )
-      !
-   END FUNCTION rho_air
-
-
-   FUNCTION cp_air( pqa )
-      !!-------------------------------------------------------------------------------
-      !!                           ***  FUNCTION cp_air  ***
-      !!
-      !! ** Purpose : Compute specific heat (Cp) of moist air
-      !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
-      !!-------------------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqa      ! air specific humidity         [kg/kg]
-      REAL(wp), DIMENSION(jpi,jpj)             ::   cp_air   ! specific heat of moist air   [J/K/kg]
-      !!-------------------------------------------------------------------------------
-      !
-      Cp_air = Cp_dry + Cp_vap * pqa
-      !
-   END FUNCTION cp_air
-
-
-   FUNCTION q_sat( ptak, pslp )
-      !!----------------------------------------------------------------------------------
-      !!                           ***  FUNCTION q_sat  ***
-      !!
-      !! ** Purpose : Specific humidity at saturation in [kg/kg]
-      !!              Based on accurate estimate of "e_sat"
-      !!              aka saturation water vapor (Goff, 1957)
-      !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
-      !!----------------------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak    ! air temperature                       [K]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pslp    ! sea level atmospheric pressure       [Pa]
-      REAL(wp), DIMENSION(jpi,jpj)             ::   q_sat   ! Specific humidity at saturation   [kg/kg]
-      !
-      INTEGER  ::   ji, jj         ! dummy loop indices
-      REAL(wp) ::   ze_sat, ztmp   ! local scalar
-      !!----------------------------------------------------------------------------------
-      !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            !
-            ztmp = rt0 / ptak(ji,jj)
-            !
-            ! Vapour pressure at saturation [hPa] : WMO, (Goff, 1957)
-            ze_sat = 10.**( 10.79574*(1. - ztmp) - 5.028*LOG10(ptak(ji,jj)/rt0)        &
-               &    + 1.50475*10.**(-4)*(1. - 10.**(-8.2969*(ptak(ji,jj)/rt0 - 1.)) )  &
-               &    + 0.42873*10.**(-3)*(10.**(4.76955*(1. - ztmp)) - 1.) + 0.78614  )
-               !
-            q_sat(ji,jj) = reps0 * ze_sat/( 0.01_wp*pslp(ji,jj) - (1._wp - reps0)*ze_sat )   ! 0.01 because SLP is in [Pa]
-            !
-         END DO
-      END DO
-      !
-   END FUNCTION q_sat
-
-
-   FUNCTION gamma_moist( ptak, pqa )
-      !!----------------------------------------------------------------------------------
-      !!                           ***  FUNCTION gamma_moist  ***
-      !!
-      !! ** Purpose : Compute the moist adiabatic lapse-rate.
-      !!     => http://glossary.ametsoc.org/wiki/Moist-adiabatic_lapse_rate
-      !!     => http://www.geog.ucsb.edu/~joel/g266_s10/lecture_notes/chapt03/oh10_3_01/oh10_3_01.html
-      !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
-      !!----------------------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak          ! air temperature       [K]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqa           ! specific humidity [kg/kg]
-      REAL(wp), DIMENSION(jpi,jpj)             ::   gamma_moist   ! moist adiabatic lapse-rate
-      !
-      INTEGER  ::   ji, jj         ! dummy loop indices
-      REAL(wp) :: zrv, ziRT        ! local scalar
-      !!----------------------------------------------------------------------------------
-      !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zrv = pqa(ji,jj) / (1. - pqa(ji,jj))
-            ziRT = 1. / (R_dry*ptak(ji,jj))    ! 1/RT
-            gamma_moist(ji,jj) = grav * ( 1. + rLevap*zrv*ziRT ) / ( Cp_dry + rLevap*rLevap*zrv*reps0*ziRT/ptak(ji,jj) )
-         END DO
-      END DO
-      !
-   END FUNCTION gamma_moist
-
-
-   FUNCTION L_vap( psst )
-      !!---------------------------------------------------------------------------------
-      !!                           ***  FUNCTION L_vap  ***
-      !!
-      !! ** Purpose : Compute the latent heat of vaporization of water from temperature
-      !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
-      !!----------------------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj)             ::   L_vap   ! latent heat of vaporization   [J/kg]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   psst   ! water temperature                [K]
-      !!----------------------------------------------------------------------------------
-      !
-      L_vap = (  2.501 - 0.00237 * ( psst(:,:) - rt0)  ) * 1.e6
-      !
-   END FUNCTION L_vap
+         CALL iom_put( "qemp_oce" , qns-zqlw-psen-zqla )   ! output downward heat content of E-P over the ocean
+         CALL iom_put( "qns_oce"  ,   qns  )               ! output downward non solar heat over the ocean
+         CALL iom_put( "qsr_oce"  ,   qsr  )               ! output downward solar heat over the ocean
+         CALL iom_put( "qt_oce"   ,   qns+qsr )            ! output total downward heat over the ocean
+      ENDIF
+      !
+      IF(sn_cfctl%l_prtctl) THEN
+         CALL prt_ctl(tab2d_1=zqlw , clinfo1=' blk_oce_2: zqlw  : ')
+         CALL prt_ctl(tab2d_1=zqla , clinfo1=' blk_oce_2: zqla  : ', tab2d_2=qsr  , clinfo2=' qsr   : ')
+         CALL prt_ctl(tab2d_1=emp  , clinfo1=' blk_oce_2: emp   : ')
+      ENDIF
+      !
+   END SUBROUTINE blk_oce_2
+
 
 #if defined key_si3
@@ -696,14 +817,15 @@
    !!   'key_si3'                                       SI3 sea-ice model
    !!----------------------------------------------------------------------
-   !!   blk_ice_tau : provide the air-ice stress
-   !!   blk_ice_flx : provide the heat and mass fluxes at air-ice interface
+   !!   blk_ice_1   : provide the air-ice stress
+   !!   blk_ice_2   : provide the heat and mass fluxes at air-ice interface
    !!   blk_ice_qcn : provide ice surface temperature and snow/ice conduction flux (emulating conduction flux)
    !!   Cdn10_Lupkes2012 : Lupkes et al. (2012) air-ice drag
-   !!   Cdn10_Lupkes2015 : Lupkes et al. (2015) air-ice drag 
+   !!   Cdn10_Lupkes2015 : Lupkes et al. (2015) air-ice drag
    !!----------------------------------------------------------------------
 
-   SUBROUTINE blk_ice_tau
-      !!---------------------------------------------------------------------
-      !!                     ***  ROUTINE blk_ice_tau  ***
+   SUBROUTINE blk_ice_1( pwndi, pwndj, ptair, phumi, pslp , puice, pvice, ptsui,  &   ! inputs
+      &                  putaui, pvtaui, pseni, pevpi, pssqi, pcd_dui             )   ! optional outputs
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE blk_ice_1  ***
       !!
       !! ** Purpose :   provide the surface boundary condition over sea-ice
@@ -713,16 +835,26 @@
       !!                NB: ice drag coefficient is assumed to be a constant
       !!---------------------------------------------------------------------
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pslp    ! sea-level pressure [Pa]
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pwndi   ! atmospheric wind at T-point [m/s]
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pwndj   ! atmospheric wind at T-point [m/s]
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   ptair   ! atmospheric wind at T-point [m/s]
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   phumi   ! atmospheric wind at T-point [m/s]
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   puice   ! sea-ice velocity on I or C grid [m/s]
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pvice   ! "
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   ptsui   ! sea-ice surface temperature [K]
+      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   putaui  ! if ln_blk
+      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pvtaui  ! if ln_blk
+      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pseni   ! if ln_abl
+      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pevpi   ! if ln_abl
+      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pssqi   ! if ln_abl
+      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pcd_dui ! if ln_abl
+      !
       INTEGER  ::   ji, jj    ! dummy loop indices
-      REAL(wp) ::   zwndi_f , zwndj_f, zwnorm_f   ! relative wind module and components at F-point
       REAL(wp) ::   zwndi_t , zwndj_t             ! relative wind components at T-point
-      REAL(wp), DIMENSION(jpi,jpj) ::   zrhoa     ! transfer coefficient for momentum      (tau)
-      !!---------------------------------------------------------------------
-      !
-      ! set transfer coefficients to default sea-ice values
-      Cd_atm(:,:) = Cd_ice
-      Ch_atm(:,:) = Cd_ice
-      Ce_atm(:,:) = Cd_ice
-
-      wndm_ice(:,:) = 0._wp      !!gm brutal....
+      REAL(wp) ::   zootm_su                      ! sea-ice surface mean temperature
+      REAL(wp) ::   zztmp1, zztmp2                ! temporary arrays
+      REAL(wp), DIMENSION(jpi,jpj) ::   zcd_dui   ! transfer coefficient for momentum      (tau)
+      !!---------------------------------------------------------------------
+      !
 
       ! ------------------------------------------------------------ !
@@ -730,59 +862,68 @@
       ! ------------------------------------------------------------ !
       ! C-grid ice dynamics :   U & V-points (same as ocean)
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vect. opt.
-            zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( u_ice(ji-1,jj  ) + u_ice(ji,jj) )  )
-            zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( v_ice(ji  ,jj-1) + v_ice(ji,jj) )  )
-            wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
-         END DO
-      END DO
+      DO_2D_00_00
+         zwndi_t = (  pwndi(ji,jj) - rn_vfac * 0.5_wp * ( puice(ji-1,jj  ) + puice(ji,jj) )  )
+         zwndj_t = (  pwndj(ji,jj) - rn_vfac * 0.5_wp * ( pvice(ji  ,jj-1) + pvice(ji,jj) )  )
+         wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
+      END_2D
       CALL lbc_lnk( 'sbcblk', wndm_ice, 'T',  1. )
       !
       ! Make ice-atm. drag dependent on ice concentration
       IF    ( ln_Cd_L12 ) THEN   ! calculate new drag from Lupkes(2012) equations
-         CALL Cdn10_Lupkes2012( Cd_atm )
-         Ch_atm(:,:) = Cd_atm(:,:)       ! momentum and heat transfer coef. are considered identical
+         CALL Cdn10_Lupkes2012( Cd_ice )
+         Ch_ice(:,:) = Cd_ice(:,:)       ! momentum and heat transfer coef. are considered identical
+         Ce_ice(:,:) = Cd_ice(:,:)
       ELSEIF( ln_Cd_L15 ) THEN   ! calculate new drag from Lupkes(2015) equations
-         CALL Cdn10_Lupkes2015( Cd_atm, Ch_atm ) 
-      ENDIF
-
-!!      CALL iom_put( "Cd_ice", Cd_atm)  ! output value of pure ice-atm. transfer coef.
-!!      CALL iom_put( "Ch_ice", Ch_atm)  ! output value of pure ice-atm. transfer coef.
+         CALL Cdn10_Lupkes2015( ptsui, pslp, Cd_ice, Ch_ice )
+         Ce_ice(:,:) = Ch_ice(:,:)       ! sensible and latent heat transfer coef. are considered identical
+      ENDIF
+
+      !! IF ( iom_use("Cd_ice") ) CALL iom_put("Cd_ice", Cd_ice)   ! output value of pure ice-atm. transfer coef.
+      !! IF ( iom_use("Ch_ice") ) CALL iom_put("Ch_ice", Ch_ice)   ! output value of pure ice-atm. transfer coef.
 
       ! local scalars ( place there for vector optimisation purposes)
-      ! Computing density of air! Way denser that 1.2 over sea-ice !!!
-      zrhoa (:,:) =  rho_air(sf(jp_tair)%fnow(:,:,1), qair(:,:), sf(jp_slp)%fnow(:,:,1))
-
-      !!gm brutal....
-      utau_ice  (:,:) = 0._wp
-      vtau_ice  (:,:) = 0._wp
-      !!gm end
-
-      ! ------------------------------------------------------------ !
-      !    Wind stress relative to the moving ice ( U10m - U_ice )   !
-      ! ------------------------------------------------------------ !
-      ! C-grid ice dynamics :   U & V-points (same as ocean)
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vect. opt.
-            utau_ice(ji,jj) = 0.5 * zrhoa(ji,jj) * Cd_atm(ji,jj) * ( wndm_ice(ji+1,jj  ) + wndm_ice(ji,jj) )            &
-               &          * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * u_ice(ji,jj) )
-            vtau_ice(ji,jj) = 0.5 * zrhoa(ji,jj) * Cd_atm(ji,jj) * ( wndm_ice(ji,jj+1  ) + wndm_ice(ji,jj) )            &
-               &          * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * v_ice(ji,jj) )
-         END DO
-      END DO
-      CALL lbc_lnk_multi( 'sbcblk', utau_ice, 'U', -1., vtau_ice, 'V', -1. )
-      !
-      !
-      IF(ln_ctl) THEN
-         CALL prt_ctl(tab2d_1=utau_ice  , clinfo1=' blk_ice: utau_ice : ', tab2d_2=vtau_ice  , clinfo2=' vtau_ice : ')
-         CALL prt_ctl(tab2d_1=wndm_ice  , clinfo1=' blk_ice: wndm_ice : ')
-      ENDIF
-      !
-   END SUBROUTINE blk_ice_tau
-
-
-   SUBROUTINE blk_ice_flx( ptsu, phs, phi, palb )
-      !!---------------------------------------------------------------------
-      !!                     ***  ROUTINE blk_ice_flx  ***
+      zcd_dui(:,:) = wndm_ice(:,:) * Cd_ice(:,:)
+
+      IF( ln_blk ) THEN
+         ! ------------------------------------------------------------- !
+         !    Wind stress relative to the moving ice ( U10m - U_ice )    !
+         ! ------------------------------------------------------------- !
+         zztmp1 = rn_vfac * 0.5_wp
+         DO_2D_01_01    ! at T point 
+            putaui(ji,jj) = rhoa(ji,jj) * zcd_dui(ji,jj) * ( pwndi(ji,jj) - zztmp1 * ( puice(ji-1,jj  ) + puice(ji,jj) ) )
+            pvtaui(ji,jj) = rhoa(ji,jj) * zcd_dui(ji,jj) * ( pwndj(ji,jj) - zztmp1 * ( pvice(ji  ,jj-1) + pvice(ji,jj) ) )
+         END_2D
+         !
+         DO_2D_00_00    ! U & V-points (same as ocean).
+            ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and  rheology 
+            zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj  ,1) )
+            zztmp2 = 0.5_wp * ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji  ,jj+1,1) )
+            putaui(ji,jj) = zztmp1 * ( putaui(ji,jj) + putaui(ji+1,jj  ) )
+            pvtaui(ji,jj) = zztmp2 * ( pvtaui(ji,jj) + pvtaui(ji  ,jj+1) )
+         END_2D
+         CALL lbc_lnk_multi( 'sbcblk', putaui, 'U', -1., pvtaui, 'V', -1. )
+         !
+         IF(sn_cfctl%l_prtctl)  CALL prt_ctl( tab2d_1=putaui  , clinfo1=' blk_ice: putaui : '   &
+            &                               , tab2d_2=pvtaui  , clinfo2='          pvtaui : ' )
+      ELSE
+         zztmp1 = 11637800.0_wp
+         zztmp2 =    -5897.8_wp
+         DO_2D_11_11
+            pcd_dui(ji,jj) = zcd_dui (ji,jj)
+            pseni  (ji,jj) = wndm_ice(ji,jj) * Ch_ice(ji,jj)
+            pevpi  (ji,jj) = wndm_ice(ji,jj) * Ce_ice(ji,jj)
+            zootm_su       = zztmp2 / ptsui(ji,jj)   ! ptsui is in K (it can't be zero ??)
+            pssqi  (ji,jj) = zztmp1 * EXP( zootm_su ) / rhoa(ji,jj)
+         END_2D
+      ENDIF
+      !
+      IF(sn_cfctl%l_prtctl)  CALL prt_ctl(tab2d_1=wndm_ice  , clinfo1=' blk_ice: wndm_ice : ')
+      !
+   END SUBROUTINE blk_ice_1
+
+
+   SUBROUTINE blk_ice_2( ptsu, phs, phi, palb, ptair, phumi, pslp, pqlw, pprec, psnow  )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE blk_ice_2  ***
       !!
       !! ** Purpose :   provide the heat and mass fluxes at air-ice interface
@@ -794,13 +935,19 @@
       !! caution : the net upward water flux has with mm/day unit
       !!---------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   ptsu   ! sea ice surface temperature
+      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   ptsu   ! sea ice surface temperature [K]
       REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phs    ! snow thickness
       REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phi    ! ice thickness
       REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   palb   ! ice albedo (all skies)
+      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   ptair
+      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   phumi
+      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   pslp
+      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   pqlw
+      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   pprec
+      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   psnow
       !!
       INTEGER  ::   ji, jj, jl               ! dummy loop indices
       REAL(wp) ::   zst3                     ! local variable
       REAL(wp) ::   zcoef_dqlw, zcoef_dqla   !   -      -
-      REAL(wp) ::   zztmp, z1_rLsub           !   -      -
+      REAL(wp) ::   zztmp, zztmp2, z1_rLsub  !   -      -
       REAL(wp) ::   zfr1, zfr2               ! local variables
       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z1_st         ! inverse of surface temperature
@@ -810,15 +957,25 @@
       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z_dqsb        ! sensible  heat sensitivity over ice
       REAL(wp), DIMENSION(jpi,jpj)     ::   zevap, zsnw   ! evaporation and snw distribution after wind blowing (SI3)
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zrhoa
-      !!---------------------------------------------------------------------
-      !
-      zcoef_dqlw = 4.0 * 0.95 * Stef             ! local scalars
-      zcoef_dqla = -Ls * 11637800. * (-5897.8)
-      !
-      zrhoa(:,:) = rho_air( sf(jp_tair)%fnow(:,:,1), qair(:,:), sf(jp_slp)%fnow(:,:,1) )
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zqair         ! specific humidity of air at z=rn_zqt [kg/kg] !LB
+      REAL(wp), DIMENSION(jpi,jpj)     ::   ztmp, ztmp2
+      !!---------------------------------------------------------------------
+      !
+      zcoef_dqlw = 4._wp * 0.95_wp * stefan             ! local scalars
+      zcoef_dqla = -rLsub * 11637800._wp * (-5897.8_wp) !LB: BAD!
+      !
+      SELECT CASE( nhumi )
+      CASE( np_humi_sph )
+         zqair(:,:) =  phumi(:,:)      ! what we read in file is already a spec. humidity!
+      CASE( np_humi_dpt )
+         zqair(:,:) = q_sat( phumi(:,:), pslp )
+      CASE( np_humi_rlh )
+         zqair(:,:) = q_air_rh( 0.01_wp*phumi(:,:), ptair(:,:), pslp(:,:) ) !LB: 0.01 => RH is % percent in file
+      END SELECT
       !
       zztmp = 1. / ( 1. - albo )
-      WHERE( ptsu(:,:,:) /= 0._wp )   ;   z1_st(:,:,:) = 1._wp / ptsu(:,:,:)
-      ELSEWHERE                       ;   z1_st(:,:,:) = 0._wp
+      WHERE( ptsu(:,:,:) /= 0._wp )
+         z1_st(:,:,:) = 1._wp / ptsu(:,:,:)
+      ELSEWHERE
+         z1_st(:,:,:) = 0._wp
       END WHERE
       !                                     ! ========================== !
@@ -834,5 +991,5 @@
                qsr_ice(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj)
                ! Long  Wave (lw)
-               z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * ptsu(ji,jj,jl) * zst3 ) * tmask(ji,jj,1)
+               z_qlw(ji,jj,jl) = 0.95 * ( pqlw(ji,jj) - stefan * ptsu(ji,jj,jl) * zst3 ) * tmask(ji,jj,1)
                ! lw sensitivity
                z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3
@@ -842,14 +999,15 @@
                ! ----------------------------!
 
-               ! ... turbulent heat fluxes with Ch_atm recalculated in blk_ice_tau
+               ! ... turbulent heat fluxes with Ch_ice recalculated in blk_ice_1
                ! Sensible Heat
-               z_qsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * Ch_atm(ji,jj) * wndm_ice(ji,jj) * (ptsu(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1))
+               z_qsb(ji,jj,jl) = rhoa(ji,jj) * rCp_air * Ch_ice(ji,jj) * wndm_ice(ji,jj) * (ptsu(ji,jj,jl) - ptair(ji,jj))
                ! Latent Heat
-               qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, zrhoa(ji,jj) * Ls  * Ch_atm(ji,jj) * wndm_ice(ji,jj) *  &
-                  &                ( 11637800. * EXP( -5897.8 * z1_st(ji,jj,jl) ) / zrhoa(ji,jj) - qair(ji,jj) ) )
+               zztmp2 = EXP( -5897.8 * z1_st(ji,jj,jl) )
+               qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa(ji,jj) * rLsub  * Ce_ice(ji,jj) * wndm_ice(ji,jj) *  &
+                  &                ( 11637800. * zztmp2 / rhoa(ji,jj) - zqair(ji,jj) ) )
                ! Latent heat sensitivity for ice (Dqla/Dt)
                IF( qla_ice(ji,jj,jl) > 0._wp ) THEN
-                  dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * Ch_atm(ji,jj) * wndm_ice(ji,jj) *  &
-                     &                 z1_st(ji,jj,jl)*z1_st(ji,jj,jl) * EXP(-5897.8 * z1_st(ji,jj,jl))
+                  dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * Ce_ice(ji,jj) * wndm_ice(ji,jj) *  &
+                     &                 z1_st(ji,jj,jl) * z1_st(ji,jj,jl) * zztmp2
                ELSE
                   dqla_ice(ji,jj,jl) = 0._wp
@@ -857,5 +1015,5 @@
 
                ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice)
-               z_dqsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * Ch_atm(ji,jj) * wndm_ice(ji,jj)
+               z_dqsb(ji,jj,jl) = rhoa(ji,jj) * rCp_air * Ch_ice(ji,jj) * wndm_ice(ji,jj)
 
                ! ----------------------------!
@@ -872,8 +1030,8 @@
       END DO
       !
-      tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac * tmask(:,:,1)  ! total precipitation [kg/m2/s]
-      sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac * tmask(:,:,1)  ! solid precipitation [kg/m2/s]
-      CALL iom_put( 'snowpre', sprecip )                    ! Snow precipitation
-      CALL iom_put( 'precip' , tprecip )                    ! Total precipitation
+      tprecip(:,:) = pprec(:,:) * rn_pfac * tmask(:,:,1)  ! total precipitation [kg/m2/s]
+      sprecip(:,:) = psnow(:,:) * rn_pfac * tmask(:,:,1)  ! solid precipitation [kg/m2/s]
+      CALL iom_put( 'snowpre', sprecip )                  ! Snow precipitation
+      CALL iom_put( 'precip' , tprecip )                  ! Total precipitation
 
       ! --- evaporation --- !
@@ -881,5 +1039,5 @@
       evap_ice (:,:,:) = rn_efac * qla_ice (:,:,:) * z1_rLsub    ! sublimation
       devap_ice(:,:,:) = rn_efac * dqla_ice(:,:,:) * z1_rLsub    ! d(sublimation)/dT
-      zevap    (:,:)   = rn_efac * ( emp(:,:) + tprecip(:,:) )   ! evaporation over ocean
+      zevap    (:,:)   = emp(:,:) + tprecip(:,:)   ! evaporation over ocean  !LB: removed rn_efac here, correct???
 
       ! --- evaporation minus precipitation --- !
@@ -892,9 +1050,9 @@
       ! --- heat flux associated with emp --- !
       qemp_oce(:,:) = - ( 1._wp - at_i_b(:,:) ) * zevap(:,:) * sst_m(:,:) * rcp                  & ! evap at sst
-         &          + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp  & ! liquid precip at Tair
+         &          + ( tprecip(:,:) - sprecip(:,:) ) * ( ptair(:,:) - rt0 ) * rcp               & ! liquid precip at Tair
          &          +   sprecip(:,:) * ( 1._wp - zsnw ) *                                        & ! solid precip at min(Tair,Tsnow)
-         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus )
+         &              ( ( MIN( ptair(:,:), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus )
       qemp_ice(:,:) =   sprecip(:,:) * zsnw *                                                    & ! solid precip (only)
-         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus )
+         &              ( ( MIN( ptair(:,:), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus )
 
       ! --- total solar and non solar fluxes --- !
@@ -904,10 +1062,10 @@
 
       ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- !
-      qprec_ice(:,:) = rhos * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus )
+      qprec_ice(:,:) = rhos * ( ( MIN( ptair(:,:), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus )
 
       ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) ---
       DO jl = 1, jpl
          qevap_ice(:,:,jl) = 0._wp ! should be -evap_ice(:,:,jl)*( ( Tice - rt0 ) * rcpi * tmask(:,:,1) )
-         !                         ! But we do not have Tice => consider it at 0degC => evap=0 
+         !                         ! But we do not have Tice => consider it at 0degC => evap=0
       END DO
 
@@ -916,13 +1074,35 @@
       zfr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )            ! zfr2 such that zfr1 + zfr2 to equal 1
       !
-      WHERE    ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) <  0.1_wp )       ! linear decrease from hi=0 to 10cm  
+      WHERE    ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) <  0.1_wp )       ! linear decrease from hi=0 to 10cm
          qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) )
       ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp )       ! constant (zfr1) when hi>10cm
          qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1
       ELSEWHERE                                                         ! zero when hs>0
-         qtr_ice_top(:,:,:) = 0._wp 
+         qtr_ice_top(:,:,:) = 0._wp
       END WHERE
       !
-      IF(ln_ctl) THEN
+
+      IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') ) THEN
+         ztmp(:,:) = zevap(:,:) * ( 1._wp - at_i_b(:,:) )
+         IF( iom_use('evap_ao_cea'  ) )  CALL iom_put( 'evap_ao_cea'  , ztmp(:,:) * tmask(:,:,1) )   ! ice-free oce evap (cell average)
+         IF( iom_use('hflx_evap_cea') )  CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * sst_m(:,:) * rcp * tmask(:,:,1) )   ! heat flux from evap (cell average)
+      ENDIF
+      IF( iom_use('hflx_rain_cea') ) THEN
+         ztmp(:,:) = rcp * ( SUM( (ptsu-rt0) * a_i_b, dim=3 ) + sst_m(:,:) * ( 1._wp - at_i_b(:,:) ) )
+         IF( iom_use('hflx_rain_cea') )  CALL iom_put( 'hflx_rain_cea', ( tprecip(:,:) - sprecip(:,:) ) * ztmp(:,:) )   ! heat flux from rain (cell average)
+      ENDIF
+      IF( iom_use('hflx_snow_cea') .OR. iom_use('hflx_snow_ao_cea') .OR. iom_use('hflx_snow_ai_cea')  )  THEN
+         WHERE( SUM( a_i_b, dim=3 ) > 1.e-10 )
+            ztmp(:,:) = rcpi * SUM( (ptsu-rt0) * a_i_b, dim=3 ) / SUM( a_i_b, dim=3 )
+         ELSEWHERE
+            ztmp(:,:) = rcp * sst_m(:,:)
+         ENDWHERE
+         ztmp2(:,:) = sprecip(:,:) * ( ztmp(:,:) - rLfus )
+         IF( iom_use('hflx_snow_cea')    ) CALL iom_put('hflx_snow_cea'   , ztmp2(:,:) ) ! heat flux from snow (cell average)
+         IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', ztmp2(:,:) * ( 1._wp - zsnw(:,:) ) ) ! heat flux from snow (over ocean)
+         IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', ztmp2(:,:) *           zsnw(:,:)   ) ! heat flux from snow (over ice)
+      ENDIF
+      !
+      IF(sn_cfctl%l_prtctl) THEN
          CALL prt_ctl(tab3d_1=qla_ice , clinfo1=' blk_ice: qla_ice  : ', tab3d_2=z_qsb   , clinfo2=' z_qsb    : ', kdim=jpl)
          CALL prt_ctl(tab3d_1=z_qlw   , clinfo1=' blk_ice: z_qlw    : ', tab3d_2=dqla_ice, clinfo2=' dqla_ice : ', kdim=jpl)
@@ -933,6 +1113,6 @@
       ENDIF
       !
-   END SUBROUTINE blk_ice_flx
-   
+   END SUBROUTINE blk_ice_2
+
 
    SUBROUTINE blk_ice_qcn( ld_virtual_itd, ptsu, ptb, phs, phi )
@@ -943,5 +1123,5 @@
       !!                to force sea ice / snow thermodynamics
       !!                in the case conduction flux is emulated
-      !!                
+      !!
       !! ** Method  :   compute surface energy balance assuming neglecting heat storage
       !!                following the 0-layer Semtner (1976) approach
@@ -968,5 +1148,5 @@
       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zgfac   ! enhanced conduction factor
       !!---------------------------------------------------------------------
-      
+
       ! -------------------------------------!
       !      I   Enhanced conduction factor  !
@@ -976,5 +1156,5 @@
       !
       zgfac(:,:,:) = 1._wp
-      
+
       IF( ld_virtual_itd ) THEN
          !
@@ -982,16 +1162,14 @@
          zfac2 = EXP(1._wp) * 0.5_wp * zepsilon
          zfac3 = 2._wp / zepsilon
-         !   
-         DO jl = 1, jpl                
-            DO jj = 1 , jpj
-               DO ji = 1, jpi
-                  zhe = ( rn_cnd_s * phi(ji,jj,jl) + rcnd_i * phs(ji,jj,jl) ) * zfac                            ! Effective thickness
-                  IF( zhe >=  zfac2 )   zgfac(ji,jj,jl) = MIN( 2._wp, 0.5_wp * ( 1._wp + LOG( zhe * zfac3 ) ) ) ! Enhanced conduction factor
-               END DO
-            END DO
+         !
+         DO jl = 1, jpl
+            DO_2D_11_11
+               zhe = ( rn_cnd_s * phi(ji,jj,jl) + rcnd_i * phs(ji,jj,jl) ) * zfac                            ! Effective thickness
+               IF( zhe >=  zfac2 )   zgfac(ji,jj,jl) = MIN( 2._wp, 0.5_wp * ( 1._wp + LOG( zhe * zfac3 ) ) ) ! Enhanced conduction factor
+            END_2D
          END DO
-         !      
-      ENDIF
-      
+         !
+      ENDIF
+
       ! -------------------------------------------------------------!
       !      II   Surface temperature and conduction flux            !
@@ -1001,45 +1179,43 @@
       !
       DO jl = 1, jpl
-         DO jj = 1 , jpj
-            DO ji = 1, jpi
-               !                    
-               zkeff_h = zfac * zgfac(ji,jj,jl) / &                                    ! Effective conductivity of the snow-ice system divided by thickness
-                  &      ( rcnd_i * phs(ji,jj,jl) + rn_cnd_s * MAX( 0.01, phi(ji,jj,jl) ) )
-               ztsu    = ptsu(ji,jj,jl)                                                ! Store current iteration temperature
-               ztsu0   = ptsu(ji,jj,jl)                                                ! Store initial surface temperature
-               zqa0    = qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + qns_ice(ji,jj,jl) ! Net initial atmospheric heat flux
-               !
-               DO iter = 1, nit     ! --- Iterative loop
-                  zqc   = zkeff_h * ( ztsu - ptb(ji,jj) )                              ! Conduction heat flux through snow-ice system (>0 downwards)
-                  zqnet = zqa0 + dqns_ice(ji,jj,jl) * ( ztsu - ptsu(ji,jj,jl) ) - zqc  ! Surface energy budget
-                  ztsu  = ztsu - zqnet / ( dqns_ice(ji,jj,jl) - zkeff_h )              ! Temperature update
-               END DO
-               !
-               ptsu   (ji,jj,jl) = MIN( rt0, ztsu )
-               qcn_ice(ji,jj,jl) = zkeff_h * ( ptsu(ji,jj,jl) - ptb(ji,jj) )
-               qns_ice(ji,jj,jl) = qns_ice(ji,jj,jl) + dqns_ice(ji,jj,jl) * ( ptsu(ji,jj,jl) - ztsu0 )
-               qml_ice(ji,jj,jl) = ( qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + qns_ice(ji,jj,jl) - qcn_ice(ji,jj,jl) )  &
-                             &   * MAX( 0._wp , SIGN( 1._wp, ptsu(ji,jj,jl) - rt0 ) )
-
-               ! --- Diagnose the heat loss due to changing non-solar flux (as in icethd_zdf_bl99) --- !
-               hfx_err_dif(ji,jj) = hfx_err_dif(ji,jj) - ( dqns_ice(ji,jj,jl) * ( ptsu(ji,jj,jl) - ztsu0 ) ) * a_i_b(ji,jj,jl) 
-
+         DO_2D_11_11
+            !
+            zkeff_h = zfac * zgfac(ji,jj,jl) / &                                    ! Effective conductivity of the snow-ice system divided by thickness
+               &      ( rcnd_i * phs(ji,jj,jl) + rn_cnd_s * MAX( 0.01, phi(ji,jj,jl) ) )
+            ztsu    = ptsu(ji,jj,jl)                                                ! Store current iteration temperature
+            ztsu0   = ptsu(ji,jj,jl)                                                ! Store initial surface temperature
+            zqa0    = qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + qns_ice(ji,jj,jl) ! Net initial atmospheric heat flux
+            !
+            DO iter = 1, nit     ! --- Iterative loop
+               zqc   = zkeff_h * ( ztsu - ptb(ji,jj) )                              ! Conduction heat flux through snow-ice system (>0 downwards)
+               zqnet = zqa0 + dqns_ice(ji,jj,jl) * ( ztsu - ptsu(ji,jj,jl) ) - zqc  ! Surface energy budget
+               ztsu  = ztsu - zqnet / ( dqns_ice(ji,jj,jl) - zkeff_h )              ! Temperature update
             END DO
-         END DO
-         !
-      END DO 
-      !      
+            !
+            ptsu   (ji,jj,jl) = MIN( rt0, ztsu )
+            qcn_ice(ji,jj,jl) = zkeff_h * ( ptsu(ji,jj,jl) - ptb(ji,jj) )
+            qns_ice(ji,jj,jl) = qns_ice(ji,jj,jl) + dqns_ice(ji,jj,jl) * ( ptsu(ji,jj,jl) - ztsu0 )
+            qml_ice(ji,jj,jl) = ( qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + qns_ice(ji,jj,jl) - qcn_ice(ji,jj,jl) )  &
+               &   * MAX( 0._wp , SIGN( 1._wp, ptsu(ji,jj,jl) - rt0 ) )
+
+            ! --- Diagnose the heat loss due to changing non-solar flux (as in icethd_zdf_bl99) --- !
+            hfx_err_dif(ji,jj) = hfx_err_dif(ji,jj) - ( dqns_ice(ji,jj,jl) * ( ptsu(ji,jj,jl) - ztsu0 ) ) * a_i_b(ji,jj,jl)
+
+         END_2D
+         !
+      END DO
+      !
    END SUBROUTINE blk_ice_qcn
-   
-
-   SUBROUTINE Cdn10_Lupkes2012( Cd )
+
+
+   SUBROUTINE Cdn10_Lupkes2012( pcd )
       !!----------------------------------------------------------------------
       !!                      ***  ROUTINE  Cdn10_Lupkes2012  ***
       !!
-      !! ** Purpose :    Recompute the neutral air-ice drag referenced at 10m 
+      !! ** Purpose :    Recompute the neutral air-ice drag referenced at 10m
       !!                 to make it dependent on edges at leads, melt ponds and flows.
       !!                 After some approximations, this can be resumed to a dependency
       !!                 on ice concentration.
-      !!                
+      !!
       !! ** Method :     The parameterization is taken from Lupkes et al. (2012) eq.(50)
       !!                 with the highest level of approximation: level4, eq.(59)
@@ -1053,5 +1229,5 @@
       !!
       !!                 This new drag has a parabolic shape (as a function of A) starting at
-      !!                 Cdw(say 1.5e-3) for A=0, reaching 1.97e-3 for A~0.5 
+      !!                 Cdw(say 1.5e-3) for A=0, reaching 1.97e-3 for A~0.5
       !!                 and going down to Cdi(say 1.4e-3) for A=1
       !!
@@ -1063,5 +1239,5 @@
       !!
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   Cd
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pcd
       REAL(wp), PARAMETER ::   zCe   = 2.23e-03_wp
       REAL(wp), PARAMETER ::   znu   = 1._wp
@@ -1078,23 +1254,23 @@
 
       ! ice-atm drag
-      Cd(:,:) = Cd_ice +  &                                                         ! pure ice drag
-         &      zCe    * ( 1._wp - at_i_b(:,:) )**zcoef * at_i_b(:,:)**(zmu-1._wp)  ! change due to sea-ice morphology
-      
+      pcd(:,:) = rCd_ice +  &                                                         ! pure ice drag
+         &      zCe     * ( 1._wp - at_i_b(:,:) )**zcoef * at_i_b(:,:)**(zmu-1._wp)  ! change due to sea-ice morphology
+
    END SUBROUTINE Cdn10_Lupkes2012
 
 
-   SUBROUTINE Cdn10_Lupkes2015( Cd, Ch )
+   SUBROUTINE Cdn10_Lupkes2015( ptm_su, pslp, pcd, pch )
       !!----------------------------------------------------------------------
       !!                      ***  ROUTINE  Cdn10_Lupkes2015  ***
       !!
       !! ** pUrpose :    Alternative turbulent transfert coefficients formulation
-      !!                 between sea-ice and atmosphere with distinct momentum 
-      !!                 and heat coefficients depending on sea-ice concentration 
+      !!                 between sea-ice and atmosphere with distinct momentum
+      !!                 and heat coefficients depending on sea-ice concentration
       !!                 and atmospheric stability (no meltponds effect for now).
-      !!                
+      !!
       !! ** Method :     The parameterization is adapted from Lupkes et al. (2015)
       !!                 and ECHAM6 atmospheric model. Compared to Lupkes2012 scheme,
       !!                 it considers specific skin and form drags (Andreas et al. 2010)
-      !!                 to compute neutral transfert coefficients for both heat and 
+      !!                 to compute neutral transfert coefficients for both heat and
       !!                 momemtum fluxes. Atmospheric stability effect on transfert
       !!                 coefficient is also taken into account following Louis (1979).
@@ -1105,7 +1281,9 @@
       !!----------------------------------------------------------------------
       !
-      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   Cd
-      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   Ch
-      REAL(wp), DIMENSION(jpi,jpj)            ::   ztm_su, zst, zqo_sat, zqi_sat
+      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   ptm_su ! sea-ice surface temperature [K]
+      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   pslp   ! sea-level pressure [Pa]
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pcd    ! momentum transfert coefficient
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pch    ! heat transfert coefficient
+      REAL(wp), DIMENSION(jpi,jpj)            ::   zst, zqo_sat, zqi_sat
       !
       ! ECHAM6 constants
@@ -1135,69 +1313,62 @@
       !!----------------------------------------------------------------------
 
-      ! mean temperature
-      WHERE( at_i_b(:,:) > 1.e-20 )   ;   ztm_su(:,:) = SUM( t_su(:,:,:) * a_i_b(:,:,:) , dim=3 ) / at_i_b(:,:)
-      ELSEWHERE                       ;   ztm_su(:,:) = rt0
-      ENDWHERE
-      
       ! Momentum Neutral Transfert Coefficients (should be a constant)
       zCdn_form_tmp = zce10 * ( LOG( 10._wp / z0_form_ice + 1._wp ) / LOG( rn_zu / z0_form_ice + 1._wp ) )**2   ! Eq. 40
       zCdn_skin_ice = ( vkarmn                                      / LOG( rn_zu / z0_skin_ice + 1._wp ) )**2   ! Eq. 7
-      zCdn_ice      = zCdn_skin_ice   ! Eq. 7 (cf Lupkes email for details)
+      zCdn_ice      = zCdn_skin_ice   ! Eq. 7
       !zCdn_ice     = 1.89e-3         ! old ECHAM5 value (cf Eq. 32)
 
       ! Heat Neutral Transfert Coefficients
-      zChn_skin_ice = vkarmn**2 / ( LOG( rn_zu / z0_ice + 1._wp ) * LOG( rn_zu * z1_alpha / z0_skin_ice + 1._wp ) )   ! Eq. 50 + Eq. 52 (cf Lupkes email for details)
-     
+      zChn_skin_ice = vkarmn**2 / ( LOG( rn_zu / z0_ice + 1._wp ) * LOG( rn_zu * z1_alpha / z0_skin_ice + 1._wp ) )   ! Eq. 50 + Eq. 52
+
       ! Atmospheric and Surface Variables
       zst(:,:)     = sst_m(:,:) + rt0                                        ! convert SST from Celcius to Kelvin
-      zqo_sat(:,:) = 0.98_wp * q_sat( zst(:,:)   , sf(jp_slp)%fnow(:,:,1) )  ! saturation humidity over ocean [kg/kg]
-      zqi_sat(:,:) = 0.98_wp * q_sat( ztm_su(:,:), sf(jp_slp)%fnow(:,:,1) )  ! saturation humidity over ice   [kg/kg]
-      !
-      DO jj = 2, jpjm1           ! reduced loop is necessary for reproducibility
-         DO ji = fs_2, fs_jpim1
-            ! Virtual potential temperature [K]
-            zthetav_os = zst(ji,jj)    * ( 1._wp + rctv0 * zqo_sat(ji,jj) )   ! over ocean
-            zthetav_is = ztm_su(ji,jj) * ( 1._wp + rctv0 * zqi_sat(ji,jj) )   ! ocean ice
-            zthetav_zu = t_zu (ji,jj)  * ( 1._wp + rctv0 * q_zu(ji,jj)    )   ! at zu
-            
-            ! Bulk Richardson Number (could use Ri_bulk function from aerobulk instead)
-            zrib_o = grav / zthetav_os * ( zthetav_zu - zthetav_os ) * rn_zu / MAX( 0.5, wndm(ji,jj)     )**2   ! over ocean
-            zrib_i = grav / zthetav_is * ( zthetav_zu - zthetav_is ) * rn_zu / MAX( 0.5, wndm_ice(ji,jj) )**2   ! over ice
-            
-            ! Momentum and Heat Neutral Transfert Coefficients
-            zCdn_form_ice = zCdn_form_tmp * at_i_b(ji,jj) * ( 1._wp - at_i_b(ji,jj) )**zbeta  ! Eq. 40
-            zChn_form_ice = zCdn_form_ice / ( 1._wp + ( LOG( z1_alphaf ) / vkarmn ) * SQRT( zCdn_form_ice ) )               ! Eq. 53 
-                       
-            ! Momentum and Heat Stability functions (possibility to use psi_m_ecmwf instead)
-            z0w = rn_zu * EXP( -1._wp * vkarmn / SQRT( Cdn_oce(ji,jj) ) ) ! over water
-            z0i = z0_skin_ice                                             ! over ice (cf Lupkes email for details)
-            IF( zrib_o <= 0._wp ) THEN
-               zfmw = 1._wp - zam * zrib_o / ( 1._wp + 3._wp * zc2 * Cdn_oce(ji,jj) * SQRT( -zrib_o * ( rn_zu / z0w + 1._wp ) ) )  ! Eq. 10
-               zfhw = ( 1._wp + ( zbetah * ( zthetav_os - zthetav_zu )**r1_3 / ( Chn_oce(ji,jj) * MAX(0.01, wndm(ji,jj)) )   &     ! Eq. 26
-                  &             )**zgamma )**z1_gamma
-            ELSE
-               zfmw = 1._wp / ( 1._wp + zam * zrib_o / SQRT( 1._wp + zrib_o ) )   ! Eq. 12
-               zfhw = 1._wp / ( 1._wp + zah * zrib_o / SQRT( 1._wp + zrib_o ) )   ! Eq. 28
-            ENDIF
-            
-            IF( zrib_i <= 0._wp ) THEN
-               zfmi = 1._wp - zam * zrib_i / (1._wp + 3._wp * zc2 * zCdn_ice * SQRT( -zrib_i * ( rn_zu / z0i + 1._wp)))   ! Eq.  9
-               zfhi = 1._wp - zah * zrib_i / (1._wp + 3._wp * zc2 * zCdn_ice * SQRT( -zrib_i * ( rn_zu / z0i + 1._wp)))   ! Eq. 25
-            ELSE
-               zfmi = 1._wp / ( 1._wp + zam * zrib_i / SQRT( 1._wp + zrib_i ) )   ! Eq. 11
-               zfhi = 1._wp / ( 1._wp + zah * zrib_i / SQRT( 1._wp + zrib_i ) )   ! Eq. 27
-            ENDIF
-            
-            ! Momentum Transfert Coefficients (Eq. 38)
-            Cd(ji,jj) = zCdn_skin_ice *   zfmi +  &
-               &        zCdn_form_ice * ( zfmi * at_i_b(ji,jj) + zfmw * ( 1._wp - at_i_b(ji,jj) ) ) / MAX( 1.e-06, at_i_b(ji,jj) )
-            
-            ! Heat Transfert Coefficients (Eq. 49)
-            Ch(ji,jj) = zChn_skin_ice *   zfhi +  &
-               &        zChn_form_ice * ( zfhi * at_i_b(ji,jj) + zfhw * ( 1._wp - at_i_b(ji,jj) ) ) / MAX( 1.e-06, at_i_b(ji,jj) )
-            !
-         END DO
-      END DO
-      CALL lbc_lnk_multi( 'sbcblk', Cd, 'T',  1., Ch, 'T', 1. )
+      zqo_sat(:,:) = rdct_qsat_salt * q_sat( zst(:,:)   , pslp(:,:) )   ! saturation humidity over ocean [kg/kg]
+      zqi_sat(:,:) =                  q_sat( ptm_su(:,:), pslp(:,:) )   ! saturation humidity over ice   [kg/kg]
+      !
+      DO_2D_00_00
+         ! Virtual potential temperature [K]
+         zthetav_os = zst(ji,jj)    * ( 1._wp + rctv0 * zqo_sat(ji,jj) )   ! over ocean
+         zthetav_is = ptm_su(ji,jj) * ( 1._wp + rctv0 * zqi_sat(ji,jj) )   ! ocean ice
+         zthetav_zu = t_zu (ji,jj)  * ( 1._wp + rctv0 * q_zu(ji,jj)    )   ! at zu
+
+         ! Bulk Richardson Number (could use Ri_bulk function from aerobulk instead)
+         zrib_o = grav / zthetav_os * ( zthetav_zu - zthetav_os ) * rn_zu / MAX( 0.5, wndm(ji,jj)     )**2   ! over ocean
+         zrib_i = grav / zthetav_is * ( zthetav_zu - zthetav_is ) * rn_zu / MAX( 0.5, wndm_ice(ji,jj) )**2   ! over ice
+
+         ! Momentum and Heat Neutral Transfert Coefficients
+         zCdn_form_ice = zCdn_form_tmp * at_i_b(ji,jj) * ( 1._wp - at_i_b(ji,jj) )**zbeta  ! Eq. 40
+         zChn_form_ice = zCdn_form_ice / ( 1._wp + ( LOG( z1_alphaf ) / vkarmn ) * SQRT( zCdn_form_ice ) )               ! Eq. 53
+
+         ! Momentum and Heat Stability functions (possibility to use psi_m_ecmwf instead ?)
+         z0w = rn_zu * EXP( -1._wp * vkarmn / SQRT( Cdn_oce(ji,jj) ) ) ! over water
+         z0i = z0_skin_ice                                             ! over ice
+         IF( zrib_o <= 0._wp ) THEN
+            zfmw = 1._wp - zam * zrib_o / ( 1._wp + 3._wp * zc2 * Cdn_oce(ji,jj) * SQRT( -zrib_o * ( rn_zu / z0w + 1._wp ) ) )  ! Eq. 10
+            zfhw = ( 1._wp + ( zbetah * ( zthetav_os - zthetav_zu )**r1_3 / ( Chn_oce(ji,jj) * MAX(0.01, wndm(ji,jj)) )   &     ! Eq. 26
+               &             )**zgamma )**z1_gamma
+         ELSE
+            zfmw = 1._wp / ( 1._wp + zam * zrib_o / SQRT( 1._wp + zrib_o ) )   ! Eq. 12
+            zfhw = 1._wp / ( 1._wp + zah * zrib_o / SQRT( 1._wp + zrib_o ) )   ! Eq. 28
+         ENDIF
+
+         IF( zrib_i <= 0._wp ) THEN
+            zfmi = 1._wp - zam * zrib_i / (1._wp + 3._wp * zc2 * zCdn_ice * SQRT( -zrib_i * ( rn_zu / z0i + 1._wp)))   ! Eq.  9
+            zfhi = 1._wp - zah * zrib_i / (1._wp + 3._wp * zc2 * zCdn_ice * SQRT( -zrib_i * ( rn_zu / z0i + 1._wp)))   ! Eq. 25
+         ELSE
+            zfmi = 1._wp / ( 1._wp + zam * zrib_i / SQRT( 1._wp + zrib_i ) )   ! Eq. 11
+            zfhi = 1._wp / ( 1._wp + zah * zrib_i / SQRT( 1._wp + zrib_i ) )   ! Eq. 27
+         ENDIF
+
+         ! Momentum Transfert Coefficients (Eq. 38)
+         pcd(ji,jj) = zCdn_skin_ice *   zfmi +  &
+            &        zCdn_form_ice * ( zfmi * at_i_b(ji,jj) + zfmw * ( 1._wp - at_i_b(ji,jj) ) ) / MAX( 1.e-06, at_i_b(ji,jj) )
+
+         ! Heat Transfert Coefficients (Eq. 49)
+         pch(ji,jj) = zChn_skin_ice *   zfhi +  &
+            &        zChn_form_ice * ( zfhi * at_i_b(ji,jj) + zfhw * ( 1._wp - at_i_b(ji,jj) ) ) / MAX( 1.e-06, at_i_b(ji,jj) )
+         !
+      END_2D
+      CALL lbc_lnk_multi( 'sbcblk', pcd, 'T',  1., pch, 'T', 1. )
       !
    END SUBROUTINE Cdn10_Lupkes2015
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcblk_algo_coare.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcblk_algo_coare.F90	(revision 12384)
+++ 	(revision )
@@ -1,448 +1,0 @@
-MODULE sbcblk_algo_coare
-   !!======================================================================
-   !!                       ***  MODULE  sbcblk_algo_coare  ***
-   !! Computes turbulent components of surface fluxes
-   !!         according to Fairall et al. 2003 (COARE v3)
-   !!
-   !!   * bulk transfer coefficients C_D, C_E and C_H
-   !!   * air temp. and spec. hum. adjusted from zt (2m) to zu (10m) if needed
-   !!   * the effective bulk wind speed at 10m U_blk
-   !!   => all these are used in bulk formulas in sbcblk.F90
-   !!
-   !!    Using the bulk formulation/param. of COARE v3, Fairall et al. 2003
-   !!
-   !!
-   !!       Routine turb_coare maintained and developed in AeroBulk
-   !!                     (http://aerobulk.sourceforge.net/)
-   !!
-   !!            Author: Laurent Brodeau, 2016, brodeau@gmail.com
-   !!
-   !!======================================================================
-   !! History :  3.6  !  2016-02  (L.Brodeau)   Original code
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   turb_coare  : computes the bulk turbulent transfer coefficients
-   !!                   adjusts t_air and q_air from zt to zu m
-   !!                   returns the effective bulk wind speed at 10m
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and tracers
-   USE dom_oce        ! ocean space and time domain
-   USE phycst         ! physical constants
-   USE sbc_oce        ! Surface boundary condition: ocean fields
-   USE sbcwave, ONLY  :  cdn_wave ! wave module
-#if defined key_si3 || defined key_cice
-   USE sbc_ice        ! Surface boundary condition: ice fields
-#endif
-   !
-   USE in_out_manager ! I/O manager
-   USE iom            ! I/O manager library
-   USE lib_mpp        ! distribued memory computing library
-   USE prtctl         ! Print control
-   USE lib_fortran    ! to use key_nosignedzero
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC ::   TURB_COARE   ! called by sbcblk.F90
-
-   !                                              !! COARE own values for given constants:
-   REAL(wp), PARAMETER ::   zi0     = 600._wp      ! scale height of the atmospheric boundary layer...
-   REAL(wp), PARAMETER ::   Beta0   =   1.250_wp   ! gustiness parameter
-   REAL(wp), PARAMETER ::   rctv0   =   0.608_wp   ! constant to obtain virtual temperature...
-
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE turb_coare( zt, zu, sst, t_zt, ssq, q_zt, U_zu, &
-      &                   Cd, Ch, Ce, t_zu, q_zu, U_blk,      &
-      &                   Cdn, Chn, Cen                       )
-      !!----------------------------------------------------------------------
-      !!                      ***  ROUTINE  turb_coare  ***
-      !!
-      !!            2015: L. Brodeau (brodeau@gmail.com)
-      !!
-      !! ** Purpose :   Computes turbulent transfert coefficients of surface
-      !!                fluxes according to Fairall et al. (2003)
-      !!                If relevant (zt /= zu), adjust temperature and humidity from height zt to zu
-      !!
-      !! ** Method : Monin Obukhov Similarity Theory
-      !!----------------------------------------------------------------------
-      !!
-      !! INPUT :
-      !! -------
-      !!    *  zt   : height for temperature and spec. hum. of air            [m]
-      !!    *  zu   : height for wind speed (generally 10m)                   [m]
-      !!    *  U_zu : scalar wind speed at 10m                                [m/s]
-      !!    *  sst  : SST                                                     [K]
-      !!    *  t_zt : potential air temperature at zt                         [K]
-      !!    *  ssq  : specific humidity at saturation at SST                  [kg/kg]
-      !!    *  q_zt : specific humidity of air at zt                          [kg/kg]
-      !!
-      !!
-      !! OUTPUT :
-      !! --------
-      !!    *  Cd     : drag coefficient
-      !!    *  Ch     : sensible heat coefficient
-      !!    *  Ce     : evaporation coefficient
-      !!    *  t_zu   : pot. air temperature adjusted at wind height zu       [K]
-      !!    *  q_zu   : specific humidity of air        //                    [kg/kg]
-      !!    *  U_blk  : bulk wind at 10m                                      [m/s]
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in   )                     ::   zt       ! height for t_zt and q_zt                    [m]
-      REAL(wp), INTENT(in   )                     ::   zu       ! height for U_zu                             [m]
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   sst      ! sea surface temperature                [Kelvin]
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   t_zt     ! potential air temperature              [Kelvin]
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   ssq      ! sea surface specific humidity           [kg/kg]
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity at zt             [kg/kg]
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   U_zu     ! relative wind module at zu                [m/s]
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cd       ! transfer coefficient for momentum         (tau)
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ch       ! transfer coefficient for sensible heat (Q_sens)
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ce       ! transfert coefficient for evaporation   (Q_lat)
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   t_zu     ! pot. air temp. adjusted at zu               [K]
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg]
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind at 10m                          [m/s]
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cdn, Chn, Cen ! neutral transfer coefficients
-      !
-      INTEGER :: j_itt
-      LOGICAL ::   l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U
-      INTEGER , PARAMETER ::   nb_itt = 4       ! number of itterations
-
-      REAL(wp), DIMENSION(jpi,jpj) ::  &
-         &  u_star, t_star, q_star, &
-         &  dt_zu, dq_zu,    &
-         &  znu_a,           & !: Nu_air, Viscosity of air
-         &  z0, z0t
-      REAL(wp), DIMENSION(jpi,jpj) ::   zeta_u        ! stability parameter at height zu
-      REAL(wp), DIMENSION(jpi,jpj) ::   ztmp0, ztmp1, ztmp2
-      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zeta_t        ! stability parameter at height zt
-      !!----------------------------------------------------------------------
-      !
-      l_zt_equal_zu = .FALSE.
-      IF( ABS(zu - zt) < 0.01 ) l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision
-
-      IF( .NOT. l_zt_equal_zu )  ALLOCATE( zeta_t(jpi,jpj) )
-
-      !! First guess of temperature and humidity at height zu:
-      t_zu = MAX(t_zt , 0.0)    ! who knows what's given on masked-continental regions...
-      q_zu = MAX(q_zt , 1.e-6)  !               "
-
-      !! Pot. temp. difference (and we don't want it to be 0!)
-      dt_zu = t_zu - sst ;  dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6), dt_zu )
-      dq_zu = q_zu - ssq ;  dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9), dq_zu )
-
-      znu_a = visc_air(t_zt) ! Air viscosity (m^2/s) at zt given from temperature in (K)
-
-      ztmp2 = 0.5*0.5  ! initial guess for wind gustiness contribution
-      U_blk = SQRT(U_zu*U_zu + ztmp2)
-
-      ztmp2   = 10000.     ! optimization: ztmp2 == 1/z0 (with z0 first guess == 0.0001)
-      ztmp0   = LOG(zu*ztmp2)
-      ztmp1   = LOG(10.*ztmp2)
-      u_star = 0.035*U_blk*ztmp1/ztmp0       ! (u* = 0.035*Un10)
-
-
-      z0     = alfa_charn(U_blk)*u_star*u_star/grav + 0.11*znu_a/u_star
-      z0t    = 0.1*EXP(vkarmn/(0.00115/(vkarmn/ztmp1)))   !  WARNING: 1/z0t !
-
-      ztmp2  = vkarmn/ztmp0
-      Cd     = ztmp2*ztmp2    ! first guess of Cd
-
-      ztmp0 = vkarmn*vkarmn/LOG(zt*z0t)/Cd
-
-      !Ribcu = -zu/(zi0*0.004*Beta0**3) !! Saturation Rib, zi0 = tropicalbound. layer depth
-      ztmp2  = grav*zu*(dt_zu + rctv0*t_zu*dq_zu)/(t_zu*U_blk*U_blk)  !! Ribu Bulk Richardson number
-      ztmp1 = 0.5 + sign(0.5 , ztmp2)
-      ztmp0 = ztmp0*ztmp2
-      !!             Ribu < 0                                 Ribu > 0   Beta = 1.25
-      zeta_u = (1.-ztmp1) * (ztmp0/(1.+ztmp2/(-zu/(zi0*0.004*Beta0**3)))) &
-         &  +     ztmp1   * (ztmp0*(1. + 27./9.*ztmp2/ztmp0))
-
-      !! First guess M-O stability dependent scaling params.(u*,t*,q*) to estimate z0 and z/L
-      ztmp0  =  vkarmn/(LOG(zu*z0t) - psi_h_coare(zeta_u))
-
-      u_star = U_blk*vkarmn/(LOG(zu) - LOG(z0)  - psi_m_coare(zeta_u))
-      t_star = dt_zu*ztmp0
-      q_star = dq_zu*ztmp0
-
-      ! What's need to be done if zt /= zu:
-      IF( .NOT. l_zt_equal_zu ) THEN
-
-         zeta_t = zt*zeta_u/zu
-
-         !! First update of values at zu (or zt for wind)
-         ztmp0 = psi_h_coare(zeta_u) - psi_h_coare(zeta_t)
-         ztmp1 = log(zt/zu) + ztmp0
-         t_zu = t_zt - t_star/vkarmn*ztmp1
-         q_zu = q_zt - q_star/vkarmn*ztmp1
-         q_zu = (0.5 + sign(0.5,q_zu))*q_zu !Makes it impossible to have negative humidity :
-
-         dt_zu = t_zu - sst  ; dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6), dt_zu )
-         dq_zu = q_zu - ssq  ; dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9), dq_zu )
-
-      END IF
-
-      !! ITERATION BLOCK
-      DO j_itt = 1, nb_itt
-
-         !!Inverse of Monin-Obukov length (1/L) :
-         ztmp0 = One_on_L(t_zu, q_zu, u_star, t_star, q_star)  ! 1/L == 1/[Monin-Obukhov length]
-
-         ztmp1 = u_star*u_star   ! u*^2
-
-         !! Update wind at 10m taking into acount convection-related wind gustiness:
-         ! Ug = Beta*w*  (Beta = 1.25, Fairall et al. 2003, Eq.8):
-         ztmp2 = Beta0*Beta0*ztmp1*(MAX(-zi0*ztmp0/vkarmn,0.))**(2./3.)   ! => ztmp2 == Ug^2
-         !!   ! Only true when unstable (L<0) => when ztmp0 < 0 => explains "-" before 600.
-         U_blk = MAX(sqrt(U_zu*U_zu + ztmp2), 0.2)        ! include gustiness in bulk wind speed
-         ! => 0.2 prevents U_blk to be 0 in stable case when U_zu=0.
-
-         !! Updating Charnock parameter, increases with the wind (Fairall et al., 2003 p. 577-578)
-         ztmp2 = alfa_charn(U_blk)  ! alpha Charnock parameter
-
-         !! Roughness lengthes z0, z0t (z0q = z0t) :
-         z0   = ztmp2*ztmp1/grav + 0.11*znu_a/u_star ! Roughness length (eq.6)
-         ztmp1 = z0*u_star/znu_a                             ! Re_r: roughness Reynolds number
-         z0t  = min( 1.1E-4 , 5.5E-5*ztmp1**(-0.6) )         ! Scalar roughness for both theta and q (eq.28)
-
-         !! Stability parameters:
-         zeta_u = zu*ztmp0 ; zeta_u = sign( min(abs(zeta_u),50.0), zeta_u )
-         IF( .NOT. l_zt_equal_zu ) THEN
-            zeta_t = zt*ztmp0 ;  zeta_t = sign( min(abs(zeta_t),50.0), zeta_t )
-         END IF
-
-         !! Turbulent scales at zu=10m :
-         ztmp0   = psi_h_coare(zeta_u)
-         ztmp1   = vkarmn/(LOG(zu) -LOG(z0t) - ztmp0)
-
-         t_star = dt_zu*ztmp1
-         q_star = dq_zu*ztmp1
-         u_star = U_blk*vkarmn/(LOG(zu) -LOG(z0) - psi_m_coare(zeta_u))
-
-         IF( .NOT. l_zt_equal_zu ) THEN
-            ! What's need to be done if zt /= zu
-            !! Re-updating temperature and humidity at zu :
-            ztmp2 = ztmp0 - psi_h_coare(zeta_t)
-            ztmp1 = log(zt/zu) + ztmp2
-            t_zu = t_zt - t_star/vkarmn*ztmp1
-            q_zu = q_zt - q_star/vkarmn*ztmp1
-            dt_zu = t_zu - sst ;  dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6), dt_zu )
-            dq_zu = q_zu - ssq ;  dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9), dq_zu )
-         END IF
-
-      END DO
-      !
-      ! compute transfer coefficients at zu :
-      ztmp0 = u_star/U_blk
-      Cd   = ztmp0*ztmp0
-      Ch   = ztmp0*t_star/dt_zu
-      Ce   = ztmp0*q_star/dq_zu
-      !
-      ztmp1 = zu + z0
-      Cdn = vkarmn*vkarmn / (log(ztmp1/z0 )*log(ztmp1/z0 ))
-      Chn = vkarmn*vkarmn / (log(ztmp1/z0t)*log(ztmp1/z0t))
-      Cen = Chn
-      !
-      IF( .NOT. l_zt_equal_zu ) DEALLOCATE( zeta_t )
-      !
-   END SUBROUTINE turb_coare
-
-
-   FUNCTION alfa_charn( pwnd )
-      !!-------------------------------------------------------------------
-      !! Compute the Charnock parameter as a function of the wind speed
-      !!
-      !! (Fairall et al., 2003 p.577-578)
-      !!
-      !! Wind below 10 m/s :  alfa = 0.011
-      !! Wind between 10 and 18 m/s : linear increase from 0.011 to 0.018
-      !! Wind greater than 18 m/s :  alfa = 0.018
-      !!
-      !! Author: L. Brodeau, june 2016 / AeroBulk  (https://sourceforge.net/p/aerobulk)
-      !!-------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj) :: alfa_charn
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pwnd   ! wind speed
-      !
-      INTEGER  ::   ji, jj         ! dummy loop indices
-      REAL(wp) :: zw, zgt10, zgt18
-      !!-------------------------------------------------------------------
-      !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            !
-            zw = pwnd(ji,jj)   ! wind speed
-            !
-            ! Charnock's constant, increases with the wind :
-            zgt10 = 0.5 + SIGN(0.5,(zw - 10.)) ! If zw<10. --> 0, else --> 1
-            zgt18 = 0.5 + SIGN(0.5,(zw - 18.)) ! If zw<18. --> 0, else --> 1
-            !
-            alfa_charn(ji,jj) =  (1. - zgt10)*0.011    &    ! wind is lower than 10 m/s
-               &     + zgt10*((1. - zgt18)*(0.011 + (0.018 - 0.011) &
-               &      *(zw - 10.)/(18. - 10.)) + zgt18*( 0.018 ) )    ! Hare et al. (1999)
-            !
-         END DO
-      END DO
-      !
-   END FUNCTION alfa_charn
-
-
-   FUNCTION One_on_L( ptha, pqa, pus, pts, pqs )
-      !!------------------------------------------------------------------------
-      !!
-      !! Evaluates the 1./(Monin Obukhov length) from air temperature and
-      !!  specific humidity, and frictional scales u*, t* and q*
-      !!
-      !! Author: L. Brodeau, june 2016 / AeroBulk
-      !!         (https://sourceforge.net/p/aerobulk)
-      !!------------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj)             :: One_on_L         !: 1./(Monin Obukhov length) [m^-1]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptha,  &  !: average potetntial air temperature [K]
-         &                                        pqa,   &  !: average specific humidity of air   [kg/kg]
-         &                                      pus, pts, pqs   !: frictional velocity, temperature and humidity
-      !
-      INTEGER  ::   ji, jj         ! dummy loop indices
-      REAL(wp) ::     zqa          ! local scalar
-      !!-------------------------------------------------------------------
-      !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            !
-            zqa = (1. + rctv0*pqa(ji,jj))
-            !
-            One_on_L(ji,jj) =  grav*vkarmn*(pts(ji,jj)*zqa + rctv0*ptha(ji,jj)*pqs(ji,jj)) &
-               &                      / ( pus(ji,jj)*pus(ji,jj) * ptha(ji,jj)*zqa )
-            !
-         END DO
-      END DO
-      !
-   END FUNCTION One_on_L
-
-
-   FUNCTION psi_m_coare( pzeta )
-      !!----------------------------------------------------------------------------------
-      !! ** Purpose: compute the universal profile stability function for momentum
-      !!             COARE 3.0, Fairall et al. 2003
-      !!             pzeta : stability paramenter, z/L where z is altitude
-      !!                     measurement and L is M-O length
-      !!       Stability function for wind speed and scalars matching Kansas and free
-      !!       convection forms with weighting f convective form, follows Fairall et
-      !!       al (1996) with profile constants from Grachev et al (2000) BLM stable
-      !!       form from Beljaars and Holtslag (1991)
-      !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
-      !!----------------------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj) :: psi_m_coare
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
-      !
-      INTEGER  ::   ji, jj    ! dummy loop indices
-      REAL(wp) :: zta, zphi_m, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab
-      !!----------------------------------------------------------------------------------
-      !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            !
-            zta = pzeta(ji,jj)
-            !
-            zphi_m = ABS(1. - 15.*zta)**.25    !!Kansas unstable
-            !
-            zpsi_k = 2.*LOG((1. + zphi_m)/2.) + LOG((1. + zphi_m*zphi_m)/2.)   &
-               & - 2.*ATAN(zphi_m) + 0.5*rpi
-            !
-            zphi_c = ABS(1. - 10.15*zta)**.3333                   !!Convective
-            !
-            zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) &
-               &     - 1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447
-            !
-            zf = zta*zta
-            zf = zf/(1. + zf)
-            zc = MIN(50., 0.35*zta)
-            zstab = 0.5 + SIGN(0.5, zta)
-            !
-            psi_m_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & ! (zta < 0)
-               &                -   zstab     * ( 1. + 1.*zta     &                ! (zta > 0)
-               &                         + 0.6667*(zta - 14.28)/EXP(zc) + 8.525 )   !     "
-            !
-         END DO
-      END DO
-      !
-   END FUNCTION psi_m_coare
-
-
-   FUNCTION psi_h_coare( pzeta )
-      !!---------------------------------------------------------------------
-      !! Universal profile stability function for temperature and humidity
-      !! COARE 3.0, Fairall et al. 2003
-      !!
-      !! pzeta : stability paramenter, z/L where z is altitude measurement
-      !!         and L is M-O length
-      !!
-      !! Stability function for wind speed and scalars matching Kansas and free
-      !! convection forms with weighting f convective form, follows Fairall et
-      !! al (1996) with profile constants from Grachev et al (2000) BLM stable
-      !! form from Beljaars and Holtslag (1991)
-      !!
-      !! Author: L. Brodeau, june 2016 / AeroBulk
-      !!         (https://sourceforge.net/p/aerobulk)
-      !!----------------------------------------------------------------
-      !!
-      REAL(wp), DIMENSION(jpi,jpj) :: psi_h_coare
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
-      !
-      INTEGER  ::   ji, jj     ! dummy loop indices
-      REAL(wp) :: zta, zphi_h, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab
-      !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            !
-            zta = pzeta(ji,jj)
-            !
-            zphi_h = (ABS(1. - 15.*zta))**.5  !! Kansas unstable   (zphi_h = zphi_m**2 when unstable, zphi_m when stable)
-            !
-            zpsi_k = 2.*LOG((1. + zphi_h)/2.)
-            !
-            zphi_c = (ABS(1. - 34.15*zta))**.3333   !! Convective
-            !
-            zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) &
-               &    -1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447
-            !
-            zf = zta*zta
-            zf = zf/(1. + zf)
-            zc = MIN(50.,0.35*zta)
-            zstab = 0.5 + SIGN(0.5, zta)
-            !
-            psi_h_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) &
-               &                -   zstab     * ( (ABS(1. + 2.*zta/3.))**1.5     &
-               &                           + .6667*(zta - 14.28)/EXP(zc) + 8.525 )
-            !
-         END DO
-      END DO
-      !
-   END FUNCTION psi_h_coare
-
-
-   FUNCTION visc_air( ptak )
-      !!---------------------------------------------------------------------
-      !! Air kinetic viscosity (m^2/s) given from temperature in degrees...
-      !!
-      !! Author: L. Brodeau, june 2016 / AeroBulk
-      !!         (https://sourceforge.net/p/aerobulk)
-      !!---------------------------------------------------------------------
-      !!
-      REAL(wp), DIMENSION(jpi,jpj) :: visc_air
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptak  ! air temperature in (K)
-      !
-      INTEGER  ::   ji, jj         ! dummy loop indices
-      REAL(wp) ::   ztc, ztc2      ! local scalar
-      !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            ztc  = ptak(ji,jj) - rt0   ! air temp, in deg. C
-            ztc2 = ztc*ztc
-            visc_air(ji,jj) = 1.326E-5*(1. + 6.542E-3*ztc + 8.301E-6*ztc2 - 4.84E-9*ztc2*ztc)
-         END DO
-      END DO
-      !
-   END FUNCTION visc_air
-
-
-END MODULE sbcblk_algo_coare
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcblk_algo_coare3p0.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcblk_algo_coare3p0.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcblk_algo_coare3p0.F90	(revision 12928)
@@ -0,0 +1,510 @@
+MODULE sbcblk_algo_coare3p0
+   !!======================================================================
+   !!                   ***  MODULE  sbcblk_algo_coare3p0  ***
+   !!
+   !!                After Fairall et al, 2003
+   !! Computes:
+   !!   * bulk transfer coefficients C_D, C_E and C_H
+   !!   * air temp. and spec. hum. adjusted from zt (2m) to zu (10m) if needed
+   !!   * the effective bulk wind speed at 10m U_blk
+   !!   => all these are used in bulk formulas in sbcblk.F90
+   !!
+   !!       Routine turb_coare3p0 maintained and developed in AeroBulk
+   !!                     (https://github.com/brodeau/aerobulk)
+   !!
+   !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk)
+   !!----------------------------------------------------------------------
+   !! History :  4.0  !  2016-02  (L.Brodeau)   Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   turb_coare3p0  : computes the bulk turbulent transfer coefficients
+   !!                   adjusts t_air and q_air from zt to zu m
+   !!                   returns the effective bulk wind speed at 10m
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE iom             ! I/O manager library
+   USE lib_mpp         ! distribued memory computing library
+   USE in_out_manager  ! I/O manager
+   USE prtctl          ! Print control
+   USE sbcwave, ONLY   :  cdn_wave ! wave module
+#if defined key_si3 || defined key_cice
+   USE sbc_ice         ! Surface boundary condition: ice fields
+#endif
+   USE lib_fortran     ! to use key_nosignedzero
+
+   USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE sbcblk_phy      ! all thermodynamics functions, rho_air, q_sat, etc... !LB
+   USE sbcblk_skin_coare ! cool-skin/warm layer scheme (CSWL_ECMWF) !LB
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC :: SBCBLK_ALGO_COARE3P0_INIT, TURB_COARE3P0
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+
+   !! COARE own values for given constants:
+   REAL(wp), PARAMETER :: zi0   = 600._wp     ! scale height of the atmospheric boundary layer...
+   REAL(wp), PARAMETER :: Beta0 =  1.25_wp    ! gustiness parameter
+
+   INTEGER , PARAMETER ::   nb_itt = 10             ! number of itterations
+
+   !!----------------------------------------------------------------------
+CONTAINS
+
+
+   SUBROUTINE sbcblk_algo_coare3p0_init(l_use_cs, l_use_wl)
+      !!---------------------------------------------------------------------
+      !!                  ***  FUNCTION sbcblk_algo_coare3p0_init  ***
+      !!
+      !! INPUT :
+      !! -------
+      !!    * l_use_cs : use the cool-skin parameterization
+      !!    * l_use_wl : use the warm-layer parameterization
+      !!---------------------------------------------------------------------
+      LOGICAL , INTENT(in) ::   l_use_cs ! use the cool-skin parameterization
+      LOGICAL , INTENT(in) ::   l_use_wl ! use the warm-layer parameterization
+      INTEGER :: ierr
+      !!---------------------------------------------------------------------
+      IF( l_use_wl ) THEN
+         ierr = 0
+         ALLOCATE ( Tau_ac(jpi,jpj) , Qnt_ac(jpi,jpj), dT_wl(jpi,jpj), Hz_wl(jpi,jpj), STAT=ierr )
+         IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_COARE3P0_INIT => allocation of Tau_ac, Qnt_ac, dT_wl & Hz_wl failed!' )
+         Tau_ac(:,:) = 0._wp
+         Qnt_ac(:,:) = 0._wp
+         dT_wl(:,:)  = 0._wp
+         Hz_wl(:,:)  = Hwl_max
+      ENDIF
+      IF( l_use_cs ) THEN
+         ierr = 0
+         ALLOCATE ( dT_cs(jpi,jpj), STAT=ierr )
+         IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_COARE3P0_INIT => allocation of dT_cs failed!' )
+         dT_cs(:,:) = -0.25_wp  ! First guess of skin correction
+      ENDIF
+   END SUBROUTINE sbcblk_algo_coare3p0_init
+
+
+
+   SUBROUTINE turb_coare3p0( kt, zt, zu, T_s, t_zt, q_s, q_zt, U_zu, l_use_cs, l_use_wl, &
+      &                      Cd, Ch, Ce, t_zu, q_zu, U_blk,                              &
+      &                      Cdn, Chn, Cen,                                              &
+      &                      Qsw, rad_lw, slp, pdT_cs,                                   & ! optionals for cool-skin (and warm-layer)
+      &                      pdT_wl, pHz_wl )                                                 ! optionals for warm-layer only
+      !!----------------------------------------------------------------------
+      !!                      ***  ROUTINE  turb_coare3p0  ***
+      !!
+      !! ** Purpose :   Computes turbulent transfert coefficients of surface
+      !!                fluxes according to Fairall et al. (2003)
+      !!                If relevant (zt /= zu), adjust temperature and humidity from height zt to zu
+      !!                Returns the effective bulk wind speed at zu to be used in the bulk formulas
+      !!
+      !!                Applies the cool-skin warm-layer correction of the SST to T_s
+      !!                if the net shortwave flux at the surface (Qsw), the downwelling longwave
+      !!                radiative fluxes at the surface (rad_lw), and the sea-leve pressure (slp)
+      !!                are provided as (optional) arguments!
+      !!
+      !! INPUT :
+      !! -------
+      !!    *  kt   : current time step (starts at 1)
+      !!    *  zt   : height for temperature and spec. hum. of air            [m]
+      !!    *  zu   : height for wind speed (usually 10m)                     [m]
+      !!    *  t_zt : potential air temperature at zt                         [K]
+      !!    *  q_zt : specific humidity of air at zt                          [kg/kg]
+      !!    *  U_zu : scalar wind speed at zu                                 [m/s]
+      !!    * l_use_cs : use the cool-skin parameterization
+      !!    * l_use_wl : use the warm-layer parameterization
+      !!
+      !! INPUT/OUTPUT:
+      !! -------------
+      !!    *  T_s  : always "bulk SST" as input                              [K]
+      !!              -> unchanged "bulk SST" as output if CSWL not used      [K]
+      !!              -> skin temperature as output if CSWL used              [K]
+      !!
+      !!    *  q_s  : SSQ aka saturation specific humidity at temp. T_s       [kg/kg]
+      !!              -> doesn't need to be given a value if skin temp computed (in case l_use_cs=True or l_use_wl=True)
+      !!              -> MUST be given the correct value if not computing skint temp. (in case l_use_cs=False or l_use_wl=False)
+      !!
+      !! OPTIONAL INPUT:
+      !! ---------------
+      !!    *  Qsw    : net solar flux (after albedo) at the surface (>0)     [W/m^2]
+      !!    *  rad_lw : downwelling longwave radiation at the surface  (>0)   [W/m^2]
+      !!    *  slp    : sea-level pressure                                    [Pa]
+      !!
+      !! OPTIONAL OUTPUT:
+      !! ----------------
+      !!    * pdT_cs  : SST increment "dT" for cool-skin correction           [K]
+      !!    * pdT_wl  : SST increment "dT" for warm-layer correction          [K]
+      !!    * pHz_wl  : thickness of warm-layer                               [m]
+      !!
+      !! OUTPUT :
+      !! --------
+      !!    *  Cd     : drag coefficient
+      !!    *  Ch     : sensible heat coefficient
+      !!    *  Ce     : evaporation coefficient
+      !!    *  t_zu   : pot. air temperature adjusted at wind height zu       [K]
+      !!    *  q_zu   : specific humidity of air        //                    [kg/kg]
+      !!    *  U_blk  : bulk wind speed at zu                                 [m/s]
+      !!
+      !!
+      !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/)
+      !!----------------------------------------------------------------------------------
+      INTEGER,  INTENT(in   )                     ::   kt       ! current time step
+      REAL(wp), INTENT(in   )                     ::   zt       ! height for t_zt and q_zt                    [m]
+      REAL(wp), INTENT(in   )                     ::   zu       ! height for U_zu                             [m]
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) ::   T_s      ! sea surface temperature                [Kelvin]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   t_zt     ! potential air temperature              [Kelvin]
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) ::   q_s      ! sea surface specific humidity           [kg/kg]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity at zt             [kg/kg]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   U_zu     ! relative wind module at zu                [m/s]
+      LOGICAL , INTENT(in   )                     ::   l_use_cs ! use the cool-skin parameterization
+      LOGICAL , INTENT(in   )                     ::   l_use_wl ! use the warm-layer parameterization
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cd       ! transfer coefficient for momentum         (tau)
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ch       ! transfer coefficient for sensible heat (Q_sens)
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ce       ! transfert coefficient for evaporation   (Q_lat)
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   t_zu     ! pot. air temp. adjusted at zu               [K]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind speed at zu                     [m/s]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cdn, Chn, Cen ! neutral transfer coefficients
+      !
+      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   Qsw      !             [W/m^2]
+      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   rad_lw   !             [W/m^2]
+      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   slp      !             [Pa]
+      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   pdT_cs
+      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   pdT_wl   !             [K]
+      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   pHz_wl   !             [m]
+      !
+      INTEGER :: j_itt
+      LOGICAL :: l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U
+      !
+      REAL(wp), DIMENSION(jpi,jpj) :: u_star, t_star, q_star
+      REAL(wp), DIMENSION(jpi,jpj) :: dt_zu, dq_zu
+      REAL(wp), DIMENSION(jpi,jpj) :: znu_a         !: Nu_air, Viscosity of air
+      REAL(wp), DIMENSION(jpi,jpj) :: z0, z0t
+      REAL(wp), DIMENSION(jpi,jpj) :: zeta_u        ! stability parameter at height zu
+      REAL(wp), DIMENSION(jpi,jpj) :: ztmp0, ztmp1, ztmp2
+      !
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zeta_t  ! stability parameter at height zt
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zsst    ! to back up the initial bulk SST
+      !
+      CHARACTER(len=40), PARAMETER :: crtnm = 'turb_coare3p0@sbcblk_algo_coare3p0'
+      !!----------------------------------------------------------------------------------
+      IF( kt == nit000 ) CALL SBCBLK_ALGO_COARE3P0_INIT(l_use_cs, l_use_wl)
+
+      l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision
+      IF( .NOT. l_zt_equal_zu )  ALLOCATE( zeta_t(jpi,jpj) )
+
+      !! Initializations for cool skin and warm layer:
+      IF( l_use_cs .AND. (.NOT.(PRESENT(Qsw) .AND. PRESENT(rad_lw) .AND. PRESENT(slp))) ) &
+         &   CALL ctl_stop( '['//TRIM(crtnm)//'] => ' , 'you need to provide Qsw, rad_lw & slp to use cool-skin param!' )
+
+      IF( l_use_wl .AND. (.NOT.(PRESENT(Qsw) .AND. PRESENT(rad_lw) .AND. PRESENT(slp))) ) &
+         &   CALL ctl_stop( '['//TRIM(crtnm)//'] => ' , 'you need to provide Qsw, rad_lw & slp to use warm-layer param!' )
+
+      IF( l_use_cs .OR. l_use_wl ) THEN
+         ALLOCATE ( zsst(jpi,jpj) )
+         zsst = T_s ! backing up the bulk SST
+         IF( l_use_cs ) T_s = T_s - 0.25_wp   ! First guess of correction
+         q_s    = rdct_qsat_salt*q_sat(MAX(T_s, 200._wp), slp) ! First guess of q_s
+      ENDIF
+
+
+      !! First guess of temperature and humidity at height zu:
+      t_zu = MAX( t_zt ,  180._wp )   ! who knows what's given on masked-continental regions...
+      q_zu = MAX( q_zt , 1.e-6_wp )   !               "
+
+      !! Pot. temp. difference (and we don't want it to be 0!)
+      dt_zu = t_zu - T_s ;   dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6_wp), dt_zu )
+      dq_zu = q_zu - q_s ;   dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9_wp), dq_zu )
+
+      znu_a = visc_air(t_zu) ! Air viscosity (m^2/s) at zt given from temperature in (K)
+
+      U_blk = SQRT(U_zu*U_zu + 0.5_wp*0.5_wp) ! initial guess for wind gustiness contribution
+
+      ztmp0   = LOG(    zu*10000._wp) ! optimization: 10000. == 1/z0 (with z0 first guess == 0.0001)
+      ztmp1   = LOG(10._wp*10000._wp) !       "                    "               "
+      u_star = 0.035_wp*U_blk*ztmp1/ztmp0       ! (u* = 0.035*Un10)
+
+      z0     = alfa_charn_3p0(U_zu)*u_star*u_star/grav + 0.11_wp*znu_a/u_star
+      z0     = MIN( MAX(ABS(z0), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on)
+
+      z0t    = 1._wp / ( 0.1_wp*EXP(vkarmn/(0.00115/(vkarmn/ztmp1))) )
+      z0t    = MIN( MAX(ABS(z0t), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on)
+
+      Cd     = (vkarmn/ztmp0)**2    ! first guess of Cd
+
+      ztmp0 = vkarmn*vkarmn/LOG(zt/z0t)/Cd
+
+      ztmp2 = Ri_bulk( zu, T_s, t_zu, q_s, q_zu, U_blk ) ! Bulk Richardson Number (BRN)
+
+      !! First estimate of zeta_u, depending on the stability, ie sign of BRN (ztmp2):
+      ztmp1 = 0.5 + SIGN( 0.5_wp , ztmp2 )
+      ztmp0 = ztmp0*ztmp2
+      zeta_u = (1._wp-ztmp1) * (ztmp0/(1._wp+ztmp2/(-zu/(zi0*0.004_wp*Beta0**3)))) & !  BRN < 0
+         &  +     ztmp1   * (ztmp0*(1._wp + 27._wp/9._wp*ztmp2/ztmp0))               !  BRN > 0
+      !#LB: should make sure that the "ztmp0" of "27./9.*ztmp2/ztmp0" is "ztmp0*ztmp2" and not "ztmp0==vkarmn*vkarmn/LOG(zt/z0t)/Cd" !
+
+      !! First guess M-O stability dependent scaling params.(u*,t*,q*) to estimate z0 and z/L
+      ztmp0  = vkarmn/(LOG(zu/z0t) - psi_h_coare(zeta_u))
+
+      u_star = MAX ( U_blk*vkarmn/(LOG(zu) - LOG(z0)  - psi_m_coare(zeta_u)) , 1.E-9 )  !  (MAX => prevents FPE from stupid values from masked region later on)
+      t_star = dt_zu*ztmp0
+      q_star = dq_zu*ztmp0
+
+      ! What needs to be done if zt /= zu:
+      IF( .NOT. l_zt_equal_zu ) THEN
+         !! First update of values at zu (or zt for wind)
+         zeta_t = zt*zeta_u/zu
+         ztmp0 = psi_h_coare(zeta_u) - psi_h_coare(zeta_t)
+         ztmp1 = LOG(zt/zu) + ztmp0
+         t_zu = t_zt - t_star/vkarmn*ztmp1
+         q_zu = q_zt - q_star/vkarmn*ztmp1
+         q_zu = (0.5_wp + SIGN(0.5_wp,q_zu))*q_zu !Makes it impossible to have negative humidity :
+         !
+         dt_zu = t_zu - T_s  ; dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6_wp), dt_zu )
+         dq_zu = q_zu - q_s  ; dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9_wp), dq_zu )
+      ENDIF
+
+      !! ITERATION BLOCK
+      DO j_itt = 1, nb_itt
+
+         !!Inverse of Monin-Obukov length (1/L) :
+         ztmp0 = One_on_L(t_zu, q_zu, u_star, t_star, q_star)  ! 1/L == 1/[Monin-Obukhov length]
+         ztmp0 = SIGN( MIN(ABS(ztmp0),200._wp), ztmp0 ) ! (prevents FPE from stupid values from masked region later on...)
+
+         ztmp1 = u_star*u_star   ! u*^2
+
+         !! Update wind at zu with convection-related wind gustiness in unstable conditions (Fairall et al. 2003, Eq.8):
+         ztmp2 = Beta0*Beta0*ztmp1*(MAX(-zi0*ztmp0/vkarmn,0._wp))**(2._wp/3._wp) ! square of wind gustiness contribution, ztmp2 == Ug^2
+         !!   ! Only true when unstable (L<0) => when ztmp0 < 0 => explains "-" before zi0
+         U_blk = MAX(SQRT(U_zu*U_zu + ztmp2), 0.2_wp)        ! include gustiness in bulk wind speed
+         ! => 0.2 prevents U_blk to be 0 in stable case when U_zu=0.
+
+         !! Stability parameters:
+         zeta_u = zu*ztmp0
+         zeta_u = SIGN( MIN(ABS(zeta_u),50.0_wp), zeta_u )
+         IF( .NOT. l_zt_equal_zu ) THEN
+            zeta_t = zt*ztmp0
+            zeta_t = SIGN( MIN(ABS(zeta_t),50.0_wp), zeta_t )
+         ENDIF
+
+         !! Adjustment the wind at 10m (not needed in the current algo form):
+         !IF( zu \= 10._wp ) U10 = U_zu + u_star/vkarmn*(LOG(10._wp/zu) - psi_m_coare(10._wp*ztmp0) + psi_m_coare(zeta_u))
+
+         !! Roughness lengthes z0, z0t (z0q = z0t) :
+         ztmp2 = u_star/vkarmn*LOG(10./z0)                                 ! Neutral wind speed at 10m
+         z0    = alfa_charn_3p0(ztmp2)*ztmp1/grav + 0.11_wp*znu_a/u_star   ! Roughness length (eq.6) [ ztmp1==u*^2 ]
+         z0     = MIN( MAX(ABS(z0), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on)
+
+         ztmp1 = ( znu_a / (z0*u_star) )**0.6_wp    ! (1./Re_r)^0.72 (Re_r: roughness Reynolds number) COARE3.6-specific!
+         z0t   = MIN( 1.1E-4_wp , 5.5E-5_wp*ztmp1 ) ! Scalar roughness for both theta and q (eq.28) #LB: some use 1.15 not 1.1 !!!
+         z0t   = MIN( MAX(ABS(z0t), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on)
+
+         !! Turbulent scales at zu :
+         ztmp0   = psi_h_coare(zeta_u)
+         ztmp1   = vkarmn/(LOG(zu) - LOG(z0t) - ztmp0) ! #LB: in ztmp0, some use psi_h_coare(zeta_t) rather than psi_h_coare(zeta_t) ???
+
+         t_star = dt_zu*ztmp1
+         q_star = dq_zu*ztmp1
+         u_star = MAX( U_blk*vkarmn/(LOG(zu) - LOG(z0) - psi_m_coare(zeta_u)) , 1.E-9 )  !  (MAX => prevents FPE from stupid values from masked region later on)
+
+         IF( .NOT. l_zt_equal_zu ) THEN
+            !! Re-updating temperature and humidity at zu if zt /= zu :
+            ztmp1 = LOG(zt/zu) + ztmp0 - psi_h_coare(zeta_t)
+            t_zu = t_zt - t_star/vkarmn*ztmp1
+            q_zu = q_zt - q_star/vkarmn*ztmp1
+         ENDIF
+
+
+         IF( l_use_cs ) THEN
+            !! Cool-skin contribution
+
+            CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, U_blk, slp, rad_lw, &
+               &                   ztmp1, zeta_u,  Qlat=ztmp2)  ! Qnsol -> ztmp1 / Tau -> zeta_u
+
+            CALL CS_COARE( Qsw, ztmp1, u_star, zsst, ztmp2 )  ! ! Qnsol -> ztmp1 / Qlat -> ztmp2
+
+            T_s(:,:) = zsst(:,:) + dT_cs(:,:)*tmask(:,:,1)
+            IF( l_use_wl ) T_s(:,:) = T_s(:,:) + dT_wl(:,:)*tmask(:,:,1)
+            q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:))
+
+         ENDIF
+
+         IF( l_use_wl ) THEN
+            !! Warm-layer contribution
+            CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, U_blk, slp, rad_lw, &
+               &                   ztmp1, zeta_u)  ! Qnsol -> ztmp1 / Tau -> zeta_u
+            !! In WL_COARE or , Tau_ac and Qnt_ac must be updated at the final itteration step => add a flag to do this!
+            CALL WL_COARE( Qsw, ztmp1, zeta_u, zsst, MOD(nb_itt,j_itt) )
+
+            !! Updating T_s and q_s !!!
+            T_s(:,:) = zsst(:,:) + dT_wl(:,:)*tmask(:,:,1)
+            IF( l_use_cs ) T_s(:,:) = T_s(:,:) + dT_cs(:,:)*tmask(:,:,1)
+            q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:))
+         ENDIF
+
+         IF( l_use_cs .OR. l_use_wl .OR. (.NOT. l_zt_equal_zu) ) THEN
+            dt_zu = t_zu - T_s ;  dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6_wp), dt_zu )
+            dq_zu = q_zu - q_s ;  dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9_wp), dq_zu )
+         ENDIF
+
+      END DO !DO j_itt = 1, nb_itt
+
+      ! compute transfer coefficients at zu :
+      ztmp0 = u_star/U_blk
+      Cd   = ztmp0*ztmp0
+      Ch   = ztmp0*t_star/dt_zu
+      Ce   = ztmp0*q_star/dq_zu
+
+      ztmp1 = zu + z0
+      Cdn = vkarmn*vkarmn / (log(ztmp1/z0 )*log(ztmp1/z0 ))
+      Chn = vkarmn*vkarmn / (log(ztmp1/z0t)*log(ztmp1/z0t))
+      Cen = Chn
+
+      IF( .NOT. l_zt_equal_zu ) DEALLOCATE( zeta_t )
+
+      IF( l_use_cs .AND. PRESENT(pdT_cs) ) pdT_cs = dT_cs
+      IF( l_use_wl .AND. PRESENT(pdT_wl) ) pdT_wl = dT_wl
+      IF( l_use_wl .AND. PRESENT(pHz_wl) ) pHz_wl = Hz_wl
+
+      IF( l_use_cs .OR. l_use_wl ) DEALLOCATE ( zsst )
+
+   END SUBROUTINE turb_coare3p0
+
+
+   FUNCTION alfa_charn_3p0( pwnd )
+      !!-------------------------------------------------------------------
+      !! Compute the Charnock parameter as a function of the wind speed
+      !!
+      !! (Fairall et al., 2003 p.577-578)
+      !!
+      !! Wind below 10 m/s :  alfa = 0.011
+      !! Wind between 10 and 18 m/s : linear increase from 0.011 to 0.018
+      !! Wind greater than 18 m/s :  alfa = 0.018
+      !!
+      !! Author: L. Brodeau, June 2016 / AeroBulk  (https://github.com/brodeau/aerobulk/)
+      !!-------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj) :: alfa_charn_3p0
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pwnd   ! wind speed
+      !
+      INTEGER  ::   ji, jj         ! dummy loop indices
+      REAL(wp) :: zw, zgt10, zgt18
+      !!-------------------------------------------------------------------
+      !
+      DO_2D_11_11
+      !
+      zw = pwnd(ji,jj)   ! wind speed
+      !
+      ! Charnock's constant, increases with the wind :
+      zgt10 = 0.5 + SIGN(0.5_wp,(zw - 10))  ! If zw<10. --> 0, else --> 1
+      zgt18 = 0.5 + SIGN(0.5_wp,(zw - 18.)) ! If zw<18. --> 0, else --> 1
+      !
+      alfa_charn_3p0(ji,jj) =  (1. - zgt10)*0.011    &    ! wind is lower than 10 m/s
+         &     + zgt10*((1. - zgt18)*(0.011 + (0.018 - 0.011) &
+         &      *(zw - 10.)/(18. - 10.)) + zgt18*( 0.018 ) )    ! Hare et al. (1999)
+      !
+      END_2D
+      !
+   END FUNCTION alfa_charn_3p0
+
+   FUNCTION psi_m_coare( pzeta )
+      !!----------------------------------------------------------------------------------
+      !! ** Purpose: compute the universal profile stability function for momentum
+      !!             COARE 3.0, Fairall et al. 2003
+      !!             pzeta : stability paramenter, z/L where z is altitude
+      !!                     measurement and L is M-O length
+      !!       Stability function for wind speed and scalars matching Kansas and free
+      !!       convection forms with weighting f convective form, follows Fairall et
+      !!       al (1996) with profile constants from Grachev et al (2000) BLM stable
+      !!       form from Beljaars and Holtslag (1991)
+      !!
+      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
+      !!----------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj) :: psi_m_coare
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
+      !
+      INTEGER  ::   ji, jj    ! dummy loop indices
+      REAL(wp) :: zta, zphi_m, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab
+      !!----------------------------------------------------------------------------------
+      !
+      DO_2D_11_11
+      !
+      zta = pzeta(ji,jj)
+      !
+      zphi_m = ABS(1. - 15.*zta)**.25    !!Kansas unstable
+      !
+      zpsi_k = 2.*LOG((1. + zphi_m)/2.) + LOG((1. + zphi_m*zphi_m)/2.)   &
+         & - 2.*ATAN(zphi_m) + 0.5*rpi
+      !
+      zphi_c = ABS(1. - 10.15*zta)**.3333                   !!Convective
+      !
+      zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) &
+         &     - 1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447
+      !
+      zf = zta*zta
+      zf = zf/(1. + zf)
+      zc = MIN(50._wp, 0.35_wp*zta)
+      zstab = 0.5 + SIGN(0.5_wp, zta)
+      !
+      psi_m_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & ! (zta < 0)
+         &                -   zstab     * ( 1. + 1.*zta     &                ! (zta > 0)
+         &                         + 0.6667*(zta - 14.28)/EXP(zc) + 8.525 )   !     "
+      !
+      END_2D
+      !
+   END FUNCTION psi_m_coare
+
+
+   FUNCTION psi_h_coare( pzeta )
+      !!---------------------------------------------------------------------
+      !! Universal profile stability function for temperature and humidity
+      !! COARE 3.0, Fairall et al. 2003
+      !!
+      !! pzeta : stability paramenter, z/L where z is altitude measurement
+      !!         and L is M-O length
+      !!
+      !! Stability function for wind speed and scalars matching Kansas and free
+      !! convection forms with weighting f convective form, follows Fairall et
+      !! al (1996) with profile constants from Grachev et al (2000) BLM stable
+      !! form from Beljaars and Holtslag (1991)
+      !!
+      !! Author: L. Brodeau, June 2016 / AeroBulk
+      !!         (https://github.com/brodeau/aerobulk/)
+      !!----------------------------------------------------------------
+      !!
+      REAL(wp), DIMENSION(jpi,jpj) :: psi_h_coare
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
+      !
+      INTEGER  ::   ji, jj     ! dummy loop indices
+      REAL(wp) :: zta, zphi_h, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab
+      !
+      DO_2D_11_11
+      !
+      zta = pzeta(ji,jj)
+      !
+      zphi_h = (ABS(1. - 15.*zta))**.5  !! Kansas unstable   (zphi_h = zphi_m**2 when unstable, zphi_m when stable)
+      !
+      zpsi_k = 2.*LOG((1. + zphi_h)/2.)
+      !
+      zphi_c = (ABS(1. - 34.15*zta))**.3333   !! Convective
+      !
+      zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) &
+         &    -1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447
+      !
+      zf = zta*zta
+      zf = zf/(1. + zf)
+      zc = MIN(50._wp,0.35_wp*zta)
+      zstab = 0.5 + SIGN(0.5_wp, zta)
+      !
+      psi_h_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) &
+         &                -   zstab     * ( (ABS(1. + 2.*zta/3.))**1.5     &
+         &                           + .6667*(zta - 14.28)/EXP(zc) + 8.525 )
+      !
+      END_2D
+      !
+   END FUNCTION psi_h_coare
+
+   !!======================================================================
+END MODULE sbcblk_algo_coare3p0
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcblk_algo_coare3p5.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcblk_algo_coare3p5.F90	(revision 12384)
+++ 	(revision )
@@ -1,417 +1,0 @@
-MODULE sbcblk_algo_coare3p5
-   !!======================================================================
-   !!                       ***  MODULE  sbcblk_algo_coare3p5  ***
-   !! Computes turbulent components of surface fluxes
-   !!         according to Edson et al. 2013 (COARE v3.5) /JPO
-   !!
-   !!   * bulk transfer coefficients C_D, C_E and C_H
-   !!   * air temp. and spec. hum. adjusted from zt (2m) to zu (10m) if needed
-   !!   * the effective bulk wind speed at 10m U_blk
-   !!   => all these are used in bulk formulas in sbcblk.F90
-   !!
-   !!    Using the bulk formulation/param. of COARE v3.5, Edson et al. 2013
-   !!
-   !!
-   !!       Routine turb_coare3p5 maintained and developed in AeroBulk
-   !!                     (http://aerobulk.sourceforge.net/)
-   !!
-   !!            Author: Laurent Brodeau, 2016, brodeau@gmail.com
-   !!
-   !!======================================================================
-   !! History :  3.6  !  2016-02  (L.Brodeau)  Original code
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   turb_coare3p5  : computes the bulk turbulent transfer coefficients
-   !!                   adjusts t_air and q_air from zt to zu m
-   !!                   returns the effective bulk wind speed at 10m
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE phycst          ! physical constants
-   USE sbc_oce         ! Surface boundary condition: ocean fields
-   USE sbcwave, ONLY   :  cdn_wave ! wave module
-#if defined key_si3 || defined key_cice
-   USE sbc_ice         ! Surface boundary condition: ice fields
-#endif
-   !
-   USE iom             ! I/O manager library
-   USE lib_mpp         ! distribued memory computing library
-   USE in_out_manager  ! I/O manager
-   USE prtctl          ! Print control
-   USE lib_fortran     ! to use key_nosignedzero
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC ::   TURB_COARE3P5   ! called by sbcblk.F90
-
-   !                                   ! COARE own values for given constants:
-   REAL(wp), PARAMETER ::   charn0_max =   0.028   ! value above which the Charnock paramter levels off for winds > 18
-   REAL(wp), PARAMETER ::   zi0        = 600.      ! scale height of the atmospheric boundary layer...1
-   REAL(wp), PARAMETER ::   Beta0      =   1.25    ! gustiness parameter
-   REAL(wp), PARAMETER ::   rctv0      =   0.608   ! constant to obtain virtual temperature...
-
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE turb_coare3p5( zt, zu, sst, t_zt, ssq, q_zt, U_zu,  &
-      &                      Cd, Ch, Ce, t_zu, q_zu, U_blk,       &
-      &                      Cdn, Chn, Cen                        )
-      !!----------------------------------------------------------------------------------
-      !!                      ***  ROUTINE  turb_coare3p5  ***
-      !!
-      !! ** Purpose :   Computes turbulent transfert coefficients of surface
-      !!                fluxes according to Fairall et al. (2003)
-      !!                If relevant (zt /= zu), adjust temperature and humidity from height zt to zu
-      !!
-      !! ** Method : Monin Obukhov Similarity Theory
-      !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
-      !!
-      !! INPUT :
-      !! -------
-      !!    *  zt   : height for temperature and spec. hum. of air            [m]
-      !!    *  zu   : height for wind speed (generally 10m)                   [m]
-      !!    *  U_zu : scalar wind speed at 10m                                [m/s]
-      !!    *  sst  : SST                                                     [K]
-      !!    *  t_zt : potential air temperature at zt                         [K]
-      !!    *  ssq  : specific humidity at saturation at SST                  [kg/kg]
-      !!    *  q_zt : specific humidity of air at zt                          [kg/kg]
-      !!
-      !!
-      !! OUTPUT :
-      !! --------
-      !!    *  Cd     : drag coefficient
-      !!    *  Ch     : sensible heat coefficient
-      !!    *  Ce     : evaporation coefficient
-      !!    *  t_zu   : pot. air temperature adjusted at wind height zu       [K]
-      !!    *  q_zu   : specific humidity of air        //                    [kg/kg]
-      !!    *  U_blk  : bulk wind at 10m                                      [m/s]
-      !!
-      !!----------------------------------------------------------------------------------
-      REAL(wp), INTENT(in   )                     ::   zt       ! height for t_zt and q_zt                   [m]
-      REAL(wp), INTENT(in   )                     ::   zu       ! height for U_zu                              [m]
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   sst      ! sea surface temperature              [Kelvin]
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   t_zt     ! potential air temperature            [Kelvin]
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   ssq      ! sea surface specific humidity         [kg/kg]
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity                 [kg/kg]
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   U_zu     ! relative wind module at zu            [m/s]
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cd       ! transfer coefficient for momentum         (tau)
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ch       ! transfer coefficient for sensible heat (Q_sens)
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ce       ! transfert coefficient for evaporation   (Q_lat)
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   t_zu     ! pot. air temp. adjusted at zu             [K]
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu             [kg/kg]
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind at 10m                          [m/s]
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cdn, Chn, Cen ! neutral transfer coefficients
-      !
-      INTEGER :: j_itt
-      LOGICAL ::   l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U
-      INTEGER , PARAMETER ::   nb_itt = 4       ! number of itterations
-      !
-      REAL(wp), DIMENSION(jpi,jpj) ::  &
-         &  u_star, t_star, q_star, &
-         &  dt_zu, dq_zu,    &
-         &  znu_a,           & !: Nu_air, Viscosity of air
-         &  z0, z0t
-      REAL(wp), DIMENSION(jpi,jpj) ::   zeta_u        ! stability parameter at height zu
-      REAL(wp), DIMENSION(jpi,jpj) ::   ztmp0, ztmp1, ztmp2
-      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zeta_t        ! stability parameter at height zt
-      !!----------------------------------------------------------------------------------
-      !
-      l_zt_equal_zu = .FALSE.
-      IF( ABS(zu - zt) < 0.01 ) l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision
-
-      IF( .NOT. l_zt_equal_zu )   ALLOCATE( zeta_t(jpi,jpj) )
-
-      !! First guess of temperature and humidity at height zu:
-      t_zu = MAX(t_zt , 0.0)    ! who knows what's given on masked-continental regions...
-      q_zu = MAX(q_zt , 1.E-6)  !               "
-
-      !! Pot. temp. difference (and we don't want it to be 0!)
-      dt_zu = t_zu - sst ;  dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6), dt_zu )
-      dq_zu = q_zu - ssq ;  dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9), dq_zu )
-
-      znu_a = visc_air(t_zt) ! Air viscosity (m^2/s) at zt given from temperature in (K)
-
-      ztmp2 = 0.5*0.5  ! initial guess for wind gustiness contribution
-      U_blk = SQRT(U_zu*U_zu + ztmp2)
-
-      ztmp2   = 10000.     ! optimization: ztmp2 == 1/z0 (with z0 first guess == 0.0001)
-      ztmp0   = LOG(zu*ztmp2)
-      ztmp1   = LOG(10.*ztmp2)
-      u_star = 0.035*U_blk*ztmp1/ztmp0       ! (u* = 0.035*Un10)
-
-      !! COARE 3.5 first guess of UN10 is U_zu
-      ztmp2 = MIN( 0.0017*U_zu - 0.005 , charn0_max)  ! alpha Charnock parameter (Eq. 13 Edson al. 2013)
-      ztmp2 = MAX( ztmp2 , 0. )                       ! alpha Charnock parameter (Eq. 13 Edson al. 2013)
-      z0     = ztmp2*u_star*u_star/grav + 0.11*znu_a/u_star
-      z0t    = 0.1*EXP(vkarmn/(0.00115/(vkarmn/ztmp1)))   !  WARNING: 1/z0t !
-
-      ztmp2  = vkarmn/ztmp0
-      Cd     = ztmp2*ztmp2    ! first guess of Cd
-
-      ztmp0 = vkarmn*vkarmn/LOG(zt*z0t)/Cd
-
-      !Ribcu = -zu/(zi0*0.004*Beta0**3) !! Saturation Rib, zi0 = tropicalbound. layer depth
-      ztmp2  = grav*zu*(dt_zu + rctv0*t_zu*dq_zu)/(t_zu*U_blk*U_blk)  !! Ribu Bulk Richardson number
-      ztmp1 = 0.5 + sign(0.5 , ztmp2)
-      ztmp0 = ztmp0*ztmp2
-      !!             Ribu < 0                                 Ribu > 0   Beta = 1.25
-      zeta_u = (1.-ztmp1) * (ztmp0/(1.+ztmp2/(-zu/(zi0*0.004*Beta0**3)))) &
-         &  +     ztmp1   * (ztmp0*(1. + 27./9.*ztmp2/ztmp0))
-
-      !! First guess M-O stability dependent scaling params.(u*,t*,q*) to estimate z0 and z/L
-      ztmp0  =  vkarmn/(LOG(zu*z0t) - psi_h_coare(zeta_u))
-
-      u_star = U_blk*vkarmn/(LOG(zu) - LOG(z0)  - psi_m_coare(zeta_u))
-      t_star = dt_zu*ztmp0
-      q_star = dq_zu*ztmp0
-
-      ! What's need to be done if zt /= zu:
-      IF( .NOT. l_zt_equal_zu ) THEN
-
-         zeta_t = zt*zeta_u/zu
-
-         !! First update of values at zu (or zt for wind)
-         ztmp0 = psi_h_coare(zeta_u) - psi_h_coare(zeta_t)
-         ztmp1 = log(zt/zu) + ztmp0
-         t_zu = t_zt - t_star/vkarmn*ztmp1
-         q_zu = q_zt - q_star/vkarmn*ztmp1
-         q_zu = (0.5 + sign(0.5,q_zu))*q_zu !Makes it impossible to have negative humidity :
-
-         dt_zu = t_zu - sst  ; dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6), dt_zu )
-         dq_zu = q_zu - ssq  ; dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9), dq_zu )
-
-      END IF
-
-      !! ITERATION BLOCK
-      DO j_itt = 1, nb_itt
-
-         !!Inverse of Monin-Obukov length (1/L) :
-         ztmp0 = One_on_L(t_zu, q_zu, u_star, t_star, q_star)  ! 1/L == 1/[Monin-Obukhov length]
-
-         ztmp1 = u_star*u_star   ! u*^2
-
-         !! Update wind at 10m taking into acount convection-related wind gustiness:
-         ! Ug = Beta*w*  (Beta = 1.25, Fairall et al. 2003, Eq.8):
-         ztmp2 = Beta0*Beta0*ztmp1*(MAX(-zi0*ztmp0/vkarmn,0.))**(2./3.)   ! => ztmp2 == Ug^2
-         !!   ! Only true when unstable (L<0) => when ztmp0 < 0 => explains "-" before 600.
-         U_blk = MAX(sqrt(U_zu*U_zu + ztmp2), 0.2)        ! include gustiness in bulk wind speed
-         ! => 0.2 prevents U_blk to be 0 in stable case when U_zu=0.
-
-         !! COARE 3.5: Charnock parameter is computed from the neutral wind speed at 10m: Eq. 13 (Edson al. 2013)
-         ztmp2 = u_star/vkarmn*LOG(10./z0)   ! UN10 Neutral wind at 10m!
-         ztmp2 = MIN( 0.0017*ztmp2 - 0.005 , charn0_max)  ! alpha Charnock parameter (Eq. 13 Edson al. 2013)
-         ztmp2 = MAX( ztmp2 , 0. )
-
-         !! Roughness lengthes z0, z0t (z0q = z0t) :
-         z0   = ztmp2*ztmp1/grav + 0.11*znu_a/u_star ! Roughness length (eq.6)
-         ztmp1 = z0*u_star/znu_a                             ! Re_r: roughness Reynolds number
-         !z0t  = MIN( 1.1E-4 , 5.5E-5*ztmp1**(-0.6) )   ! COARE 3.0
-         !! Chris Fairall and Jim Edsson, private communication, March 2016 / COARE 3.5 :
-         z0t   = MIN( 1.6e-4 , 5.8E-5*ztmp1**(-0.72)) ! These thermal roughness lengths give Stanton and
-         !z0q = z0t                                   ! Dalton numbers that closely approximate COARE3.0
-
-         !! Stability parameters:
-         zeta_u = zu*ztmp0 ; zeta_u = sign( min(abs(zeta_u),50.0), zeta_u )
-         IF( .NOT. l_zt_equal_zu ) THEN
-            zeta_t = zt*ztmp0 ;  zeta_t = sign( min(abs(zeta_t),50.0), zeta_t )
-         END IF
-
-         !! Turbulent scales at zu=10m :
-         ztmp0   = psi_h_coare(zeta_u)
-         ztmp1   = vkarmn/(LOG(zu) -LOG(z0t) - ztmp0)
-
-         t_star = dt_zu*ztmp1
-         q_star = dq_zu*ztmp1
-         u_star = U_blk*vkarmn/(LOG(zu) -LOG(z0) - psi_m_coare(zeta_u))
-
-         IF( .NOT. l_zt_equal_zu ) THEN
-            ! What's need to be done if zt /= zu
-            !! Re-updating temperature and humidity at zu :
-            ztmp2 = ztmp0 - psi_h_coare(zeta_t)
-            ztmp1 = log(zt/zu) + ztmp2
-            t_zu = t_zt - t_star/vkarmn*ztmp1
-            q_zu = q_zt - q_star/vkarmn*ztmp1
-            dt_zu = t_zu - sst ;  dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6), dt_zu )
-            dq_zu = q_zu - ssq ;  dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9), dq_zu )
-         END IF
-
-      END DO
-      !
-      ! compute transfer coefficients at zu :
-      ztmp0 = u_star/U_blk
-      Cd   = ztmp0*ztmp0
-      Ch   = ztmp0*t_star/dt_zu
-      Ce   = ztmp0*q_star/dq_zu
-      !
-      ztmp1 = zu + z0
-      Cdn = vkarmn*vkarmn / (log(ztmp1/z0 )*log(ztmp1/z0 ))
-      Chn = vkarmn*vkarmn / (log(ztmp1/z0t)*log(ztmp1/z0t))
-      Cen = Chn
-      !
-      IF( .NOT. l_zt_equal_zu ) DEALLOCATE( zeta_t )
-      !
-   END SUBROUTINE turb_coare3p5
-
-
-
-   FUNCTION One_on_L( ptha, pqa, pus, pts, pqs )
-      !!------------------------------------------------------------------------
-      !!
-      !! Evaluates the 1./(Monin Obukhov length) from air temperature and
-      !!  specific humidity, and frictional scales u*, t* and q*
-      !!
-      !! Author: L. Brodeau, june 2016 / AeroBulk
-      !!         (https://sourceforge.net/p/aerobulk)
-      !!------------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj)             :: One_on_L         !: 1./(Monin Obukhov length) [m^-1]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptha,  &  !: average potetntial air temperature [K]
-         &                                        pqa,   &  !: average specific humidity of air   [kg/kg]
-         &                                      pus, pts, pqs   !: frictional velocity, temperature and humidity
-      !
-      INTEGER  ::   ji, jj         ! dummy loop indices
-      REAL(wp) ::     zqa          ! local scalar
-      !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            !
-            zqa = (1. + rctv0*pqa(ji,jj))
-            !
-            One_on_L(ji,jj) =  grav*vkarmn*(pts(ji,jj)*zqa + rctv0*ptha(ji,jj)*pqs(ji,jj)) &
-               &                      / ( pus(ji,jj)*pus(ji,jj) * ptha(ji,jj)*zqa )
-            !
-         END DO
-      END DO
-      !
-   END FUNCTION One_on_L
-
-
-   FUNCTION psi_m_coare( pzeta )
-      !!----------------------------------------------------------------------------------
-      !! ** Purpose: compute the universal profile stability function for momentum
-      !!             COARE 3.0, Fairall et al. 2003
-      !!             pzeta : stability paramenter, z/L where z is altitude
-      !!                     measurement and L is M-O length
-      !!       Stability function for wind speed and scalars matching Kansas and free
-      !!       convection forms with weighting f convective form, follows Fairall et
-      !!       al (1996) with profile constants from Grachev et al (2000) BLM stable
-      !!       form from Beljaars and Holtslag (1991)
-      !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
-      !!----------------------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj) :: psi_m_coare
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
-      !
-      INTEGER  ::   ji, jj    ! dummy loop indices
-      REAL(wp) :: zta, zphi_m, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab
-      !!----------------------------------------------------------------------------------
-      !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            !
-            zta = pzeta(ji,jj)
-            !
-            zphi_m = ABS(1. - 15.*zta)**.25    !!Kansas unstable
-            !
-            zpsi_k = 2.*LOG((1. + zphi_m)/2.) + LOG((1. + zphi_m*zphi_m)/2.)   &
-               & - 2.*ATAN(zphi_m) + 0.5*rpi
-            !
-            zphi_c = ABS(1. - 10.15*zta)**.3333                   !!Convective
-            !
-            zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) &
-               &     - 1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447
-            !
-            zf = zta*zta
-            zf = zf/(1. + zf)
-            zc = MIN(50., 0.35*zta)
-            zstab = 0.5 + SIGN(0.5, zta)
-            !
-            psi_m_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & ! (zta < 0)
-               &                -   zstab     * ( 1. + 1.*zta     &                ! (zta > 0)
-               &                         + 0.6667*(zta - 14.28)/EXP(zc) + 8.525 )   !     "
-            !
-         END DO
-      END DO
-      !
-   END FUNCTION psi_m_coare
-
-
-   FUNCTION psi_h_coare( pzeta )
-      !!---------------------------------------------------------------------
-      !! Universal profile stability function for temperature and humidity
-      !! COARE 3.0, Fairall et al. 2003
-      !!
-      !! pzeta : stability paramenter, z/L where z is altitude measurement
-      !!         and L is M-O length
-      !!
-      !! Stability function for wind speed and scalars matching Kansas and free
-      !! convection forms with weighting f convective form, follows Fairall et
-      !! al (1996) with profile constants from Grachev et al (2000) BLM stable
-      !! form from Beljaars and Holtslag (1991)
-      !!
-      !! Author: L. Brodeau, june 2016 / AeroBulk
-      !!         (https://sourceforge.net/p/aerobulk)
-      !!----------------------------------------------------------------
-      !!
-      REAL(wp), DIMENSION(jpi,jpj) :: psi_h_coare
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
-      !
-      INTEGER  ::   ji, jj     ! dummy loop indices
-      REAL(wp) :: zta, zphi_h, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab
-      !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            !
-            zta = pzeta(ji,jj)
-            !
-            zphi_h = (ABS(1. - 15.*zta))**.5  !! Kansas unstable   (zphi_h = zphi_m**2 when unstable, zphi_m when stable)
-            !
-            zpsi_k = 2.*LOG((1. + zphi_h)/2.)
-            !
-            zphi_c = (ABS(1. - 34.15*zta))**.3333   !! Convective
-            !
-            zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) &
-               &    -1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447
-            !
-            zf = zta*zta
-            zf = zf/(1. + zf)
-            zc = MIN(50.,0.35*zta)
-            zstab = 0.5 + SIGN(0.5, zta)
-            !
-            psi_h_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) &
-               &                -   zstab     * ( (ABS(1. + 2.*zta/3.))**1.5     &
-               &                           + .6667*(zta - 14.28)/EXP(zc) + 8.525 )
-            !
-         END DO
-      END DO
-      !
-   END FUNCTION psi_h_coare
-
-
-   FUNCTION visc_air( ptak )
-      !!---------------------------------------------------------------------
-      !! Air kinetic viscosity (m^2/s) given from temperature in degrees...
-      !!
-      !! Author: L. Brodeau, june 2016 / AeroBulk
-      !!         (https://sourceforge.net/p/aerobulk)
-      !!---------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj)             ::   visc_air
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak       ! air temperature   [K]
-      !
-      INTEGER  ::   ji, jj         ! dummy loop indices
-      REAL(wp) ::   ztc, ztc2      ! local scalar
-      !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            ztc  = ptak(ji,jj) - rt0   ! air temp, in deg. C
-            ztc2 = ztc*ztc
-            visc_air(ji,jj) = 1.326E-5*(1. + 6.542E-3*ztc + 8.301E-6*ztc2 - 4.84E-9*ztc2*ztc)
-         END DO
-      END DO
-      !
-   END FUNCTION visc_air
-
-   !!======================================================================
-END MODULE sbcblk_algo_coare3p5
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcblk_algo_coare3p6.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcblk_algo_coare3p6.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcblk_algo_coare3p6.F90	(revision 12928)
@@ -0,0 +1,510 @@
+MODULE sbcblk_algo_coare3p6
+   !!======================================================================
+   !!                   ***  MODULE  sbcblk_algo_coare3p6  ***
+   !!
+   !!                After Fairall et al 2018 & Edson et al 2013
+   !! Computes:
+   !!   * bulk transfer coefficients C_D, C_E and C_H
+   !!   * air temp. and spec. hum. adjusted from zt (2m) to zu (10m) if needed
+   !!   * the effective bulk wind speed at 10m U_blk
+   !!   => all these are used in bulk formulas in sbcblk.F90
+   !!
+   !!       Routine turb_coare3p6 maintained and developed in AeroBulk
+   !!                     (https://github.com/brodeau/aerobulk)
+   !!
+   !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk)
+   !!----------------------------------------------------------------------
+   !! History :  4.0  !  2016-02  (L.Brodeau)   Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   turb_coare3p6  : computes the bulk turbulent transfer coefficients
+   !!                   adjusts t_air and q_air from zt to zu m
+   !!                   returns the effective bulk wind speed at 10m
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE iom             ! I/O manager library
+   USE lib_mpp         ! distribued memory computing library
+   USE in_out_manager  ! I/O manager
+   USE prtctl          ! Print control
+   USE sbcwave, ONLY   :  cdn_wave ! wave module
+#if defined key_si3 || defined key_cice
+   USE sbc_ice         ! Surface boundary condition: ice fields
+#endif
+   USE lib_fortran     ! to use key_nosignedzero
+
+   USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE sbcblk_phy      ! all thermodynamics functions, rho_air, q_sat, etc... !LB
+   USE sbcblk_skin_coare ! cool-skin/warm layer scheme (CSWL_ECMWF) !LB
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC :: SBCBLK_ALGO_COARE3P6_INIT, TURB_COARE3P6
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+
+   !! COARE own values for given constants:
+   REAL(wp), PARAMETER :: zi0   = 600._wp     ! scale height of the atmospheric boundary layer...
+   REAL(wp), PARAMETER :: Beta0 =  1.2_wp     ! gustiness parameter
+
+   INTEGER , PARAMETER ::   nb_itt = 10             ! number of itterations
+
+   !!----------------------------------------------------------------------
+CONTAINS
+
+
+   SUBROUTINE sbcblk_algo_coare3p6_init(l_use_cs, l_use_wl)
+      !!---------------------------------------------------------------------
+      !!                  ***  FUNCTION sbcblk_algo_coare3p6_init  ***
+      !!
+      !! INPUT :
+      !! -------
+      !!    * l_use_cs : use the cool-skin parameterization
+      !!    * l_use_wl : use the warm-layer parameterization
+      !!---------------------------------------------------------------------
+      LOGICAL , INTENT(in) ::   l_use_cs ! use the cool-skin parameterization
+      LOGICAL , INTENT(in) ::   l_use_wl ! use the warm-layer parameterization
+      INTEGER :: ierr
+      !!---------------------------------------------------------------------
+      IF( l_use_wl ) THEN
+         ierr = 0
+         ALLOCATE ( Tau_ac(jpi,jpj) , Qnt_ac(jpi,jpj), dT_wl(jpi,jpj), Hz_wl(jpi,jpj), STAT=ierr )
+         IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_COARE3P6_INIT => allocation of Tau_ac, Qnt_ac, dT_wl & Hz_wl failed!' )
+         Tau_ac(:,:) = 0._wp
+         Qnt_ac(:,:) = 0._wp
+         dT_wl(:,:)  = 0._wp
+         Hz_wl(:,:)  = Hwl_max
+      ENDIF
+      IF( l_use_cs ) THEN
+         ierr = 0
+         ALLOCATE ( dT_cs(jpi,jpj), STAT=ierr )
+         IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_COARE3P6_INIT => allocation of dT_cs failed!' )
+         dT_cs(:,:) = -0.25_wp  ! First guess of skin correction
+      ENDIF
+   END SUBROUTINE sbcblk_algo_coare3p6_init
+
+
+
+   SUBROUTINE turb_coare3p6( kt, zt, zu, T_s, t_zt, q_s, q_zt, U_zu, l_use_cs, l_use_wl, &
+      &                      Cd, Ch, Ce, t_zu, q_zu, U_blk,                              &
+      &                      Cdn, Chn, Cen,                                              &
+      &                      Qsw, rad_lw, slp, pdT_cs,                                   & ! optionals for cool-skin (and warm-layer)
+      &                      pdT_wl, pHz_wl )                                                 ! optionals for warm-layer only
+      !!----------------------------------------------------------------------
+      !!                      ***  ROUTINE  turb_coare3p6  ***
+      !!
+      !! ** Purpose :   Computes turbulent transfert coefficients of surface
+      !!                fluxes according to Fairall et al. (2003)
+      !!                If relevant (zt /= zu), adjust temperature and humidity from height zt to zu
+      !!                Returns the effective bulk wind speed at zu to be used in the bulk formulas
+      !!
+      !!                Applies the cool-skin warm-layer correction of the SST to T_s
+      !!                if the net shortwave flux at the surface (Qsw), the downwelling longwave
+      !!                radiative fluxes at the surface (rad_lw), and the sea-leve pressure (slp)
+      !!                are provided as (optional) arguments!
+      !!
+      !! INPUT :
+      !! -------
+      !!    *  kt   : current time step (starts at 1)
+      !!    *  zt   : height for temperature and spec. hum. of air            [m]
+      !!    *  zu   : height for wind speed (usually 10m)                     [m]
+      !!    *  t_zt : potential air temperature at zt                         [K]
+      !!    *  q_zt : specific humidity of air at zt                          [kg/kg]
+      !!    *  U_zu : scalar wind speed at zu                                 [m/s]
+      !!    * l_use_cs : use the cool-skin parameterization
+      !!    * l_use_wl : use the warm-layer parameterization
+      !!
+      !! INPUT/OUTPUT:
+      !! -------------
+      !!    *  T_s  : always "bulk SST" as input                              [K]
+      !!              -> unchanged "bulk SST" as output if CSWL not used      [K]
+      !!              -> skin temperature as output if CSWL used              [K]
+      !!
+      !!    *  q_s  : SSQ aka saturation specific humidity at temp. T_s       [kg/kg]
+      !!              -> doesn't need to be given a value if skin temp computed (in case l_use_cs=True or l_use_wl=True)
+      !!              -> MUST be given the correct value if not computing skint temp. (in case l_use_cs=False or l_use_wl=False)
+      !!
+      !! OPTIONAL INPUT:
+      !! ---------------
+      !!    *  Qsw    : net solar flux (after albedo) at the surface (>0)     [W/m^2]
+      !!    *  rad_lw : downwelling longwave radiation at the surface  (>0)   [W/m^2]
+      !!    *  slp    : sea-level pressure                                    [Pa]
+      !!
+      !! OPTIONAL OUTPUT:
+      !! ----------------
+      !!    * pdT_cs  : SST increment "dT" for cool-skin correction           [K]
+      !!    * pdT_wl  : SST increment "dT" for warm-layer correction          [K]
+      !!    * pHz_wl  : thickness of warm-layer                               [m]
+      !!
+      !! OUTPUT :
+      !! --------
+      !!    *  Cd     : drag coefficient
+      !!    *  Ch     : sensible heat coefficient
+      !!    *  Ce     : evaporation coefficient
+      !!    *  t_zu   : pot. air temperature adjusted at wind height zu       [K]
+      !!    *  q_zu   : specific humidity of air        //                    [kg/kg]
+      !!    *  U_blk  : bulk wind speed at zu                                 [m/s]
+      !!
+      !!
+      !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/)
+      !!----------------------------------------------------------------------------------
+      INTEGER,  INTENT(in   )                     ::   kt       ! current time step
+      REAL(wp), INTENT(in   )                     ::   zt       ! height for t_zt and q_zt                    [m]
+      REAL(wp), INTENT(in   )                     ::   zu       ! height for U_zu                             [m]
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) ::   T_s      ! sea surface temperature                [Kelvin]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   t_zt     ! potential air temperature              [Kelvin]
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) ::   q_s      ! sea surface specific humidity           [kg/kg]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity at zt             [kg/kg]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   U_zu     ! relative wind module at zu                [m/s]
+      LOGICAL , INTENT(in   )                     ::   l_use_cs ! use the cool-skin parameterization
+      LOGICAL , INTENT(in   )                     ::   l_use_wl ! use the warm-layer parameterization
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cd       ! transfer coefficient for momentum         (tau)
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ch       ! transfer coefficient for sensible heat (Q_sens)
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ce       ! transfert coefficient for evaporation   (Q_lat)
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   t_zu     ! pot. air temp. adjusted at zu               [K]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind speed at zu                     [m/s]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cdn, Chn, Cen ! neutral transfer coefficients
+      !
+      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   Qsw      !             [W/m^2]
+      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   rad_lw   !             [W/m^2]
+      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   slp      !             [Pa]
+      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   pdT_cs
+      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   pdT_wl   !             [K]
+      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   pHz_wl   !             [m]
+      !
+      INTEGER :: j_itt
+      LOGICAL :: l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U
+      !
+      REAL(wp), DIMENSION(jpi,jpj) :: u_star, t_star, q_star
+      REAL(wp), DIMENSION(jpi,jpj) :: dt_zu, dq_zu
+      REAL(wp), DIMENSION(jpi,jpj) :: znu_a         !: Nu_air, Viscosity of air
+      REAL(wp), DIMENSION(jpi,jpj) :: z0, z0t
+      REAL(wp), DIMENSION(jpi,jpj) :: zeta_u        ! stability parameter at height zu
+      REAL(wp), DIMENSION(jpi,jpj) :: ztmp0, ztmp1, ztmp2
+      !
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zeta_t  ! stability parameter at height zt
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zsst    ! to back up the initial bulk SST
+      !
+      CHARACTER(len=40), PARAMETER :: crtnm = 'turb_coare3p6@sbcblk_algo_coare3p6'
+      !!----------------------------------------------------------------------------------
+      IF( kt == nit000 ) CALL SBCBLK_ALGO_COARE3P6_INIT(l_use_cs, l_use_wl)
+
+      l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision
+      IF( .NOT. l_zt_equal_zu )  ALLOCATE( zeta_t(jpi,jpj) )
+
+      !! Initializations for cool skin and warm layer:
+      IF( l_use_cs .AND. (.NOT.(PRESENT(Qsw) .AND. PRESENT(rad_lw) .AND. PRESENT(slp))) ) &
+         &   CALL ctl_stop( '['//TRIM(crtnm)//'] => ' , 'you need to provide Qsw, rad_lw & slp to use cool-skin param!' )
+
+      IF( l_use_wl .AND. (.NOT.(PRESENT(Qsw) .AND. PRESENT(rad_lw) .AND. PRESENT(slp))) ) &
+         &   CALL ctl_stop( '['//TRIM(crtnm)//'] => ' , 'you need to provide Qsw, rad_lw & slp to use warm-layer param!' )
+
+      IF( l_use_cs .OR. l_use_wl ) THEN
+         ALLOCATE ( zsst(jpi,jpj) )
+         zsst = T_s ! backing up the bulk SST
+         IF( l_use_cs ) T_s = T_s - 0.25_wp   ! First guess of correction
+         q_s    = rdct_qsat_salt*q_sat(MAX(T_s, 200._wp), slp) ! First guess of q_s
+      ENDIF
+
+
+      !! First guess of temperature and humidity at height zu:
+      t_zu = MAX( t_zt ,  180._wp )   ! who knows what's given on masked-continental regions...
+      q_zu = MAX( q_zt , 1.e-6_wp )   !               "
+
+      !! Pot. temp. difference (and we don't want it to be 0!)
+      dt_zu = t_zu - T_s ;   dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6_wp), dt_zu )
+      dq_zu = q_zu - q_s ;   dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9_wp), dq_zu )
+
+      znu_a = visc_air(t_zu) ! Air viscosity (m^2/s) at zt given from temperature in (K)
+
+      U_blk = SQRT(U_zu*U_zu + 0.5_wp*0.5_wp) ! initial guess for wind gustiness contribution
+
+      ztmp0   = LOG(    zu*10000._wp) ! optimization: 10000. == 1/z0 (with z0 first guess == 0.0001)
+      ztmp1   = LOG(10._wp*10000._wp) !       "                    "               "
+      u_star = 0.035_wp*U_blk*ztmp1/ztmp0       ! (u* = 0.035*Un10)
+
+      z0     = alfa_charn_3p6(U_zu)*u_star*u_star/grav + 0.11_wp*znu_a/u_star
+      z0     = MIN( MAX(ABS(z0), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on)
+
+      z0t    = 1._wp / ( 0.1_wp*EXP(vkarmn/(0.00115/(vkarmn/ztmp1))) )
+      z0t    = MIN( MAX(ABS(z0t), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on)
+
+      Cd     = (vkarmn/ztmp0)**2    ! first guess of Cd
+
+      ztmp0 = vkarmn*vkarmn/LOG(zt/z0t)/Cd
+
+      ztmp2 = Ri_bulk( zu, T_s, t_zu, q_s, q_zu, U_blk ) ! Bulk Richardson Number (BRN)
+
+      !! First estimate of zeta_u, depending on the stability, ie sign of BRN (ztmp2):
+      ztmp1 = 0.5 + SIGN( 0.5_wp , ztmp2 )
+      ztmp0 = ztmp0*ztmp2
+      zeta_u = (1._wp-ztmp1) * (ztmp0/(1._wp+ztmp2/(-zu/(zi0*0.004_wp*Beta0**3)))) & !  BRN < 0
+         &  +     ztmp1   * (ztmp0*(1._wp + 27._wp/9._wp*ztmp2/ztmp0))               !  BRN > 0
+      !#LB: should make sure that the "ztmp0" of "27./9.*ztmp2/ztmp0" is "ztmp0*ztmp2" and not "ztmp0==vkarmn*vkarmn/LOG(zt/z0t)/Cd" !
+
+      !! First guess M-O stability dependent scaling params.(u*,t*,q*) to estimate z0 and z/L
+      ztmp0  = vkarmn/(LOG(zu/z0t) - psi_h_coare(zeta_u))
+
+      u_star = MAX ( U_blk*vkarmn/(LOG(zu) - LOG(z0)  - psi_m_coare(zeta_u)) , 1.E-9 )  !  (MAX => prevents FPE from stupid values from masked region later on)
+      t_star = dt_zu*ztmp0
+      q_star = dq_zu*ztmp0
+
+      ! What needs to be done if zt /= zu:
+      IF( .NOT. l_zt_equal_zu ) THEN
+         !! First update of values at zu (or zt for wind)
+         zeta_t = zt*zeta_u/zu
+         ztmp0 = psi_h_coare(zeta_u) - psi_h_coare(zeta_t)
+         ztmp1 = LOG(zt/zu) + ztmp0
+         t_zu = t_zt - t_star/vkarmn*ztmp1
+         q_zu = q_zt - q_star/vkarmn*ztmp1
+         q_zu = (0.5_wp + SIGN(0.5_wp,q_zu))*q_zu !Makes it impossible to have negative humidity :
+         !
+         dt_zu = t_zu - T_s  ; dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6_wp), dt_zu )
+         dq_zu = q_zu - q_s  ; dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9_wp), dq_zu )
+      ENDIF
+
+      !! ITERATION BLOCK
+      DO j_itt = 1, nb_itt
+
+         !!Inverse of Monin-Obukov length (1/L) :
+         ztmp0 = One_on_L(t_zu, q_zu, u_star, t_star, q_star)  ! 1/L == 1/[Monin-Obukhov length]
+         ztmp0 = SIGN( MIN(ABS(ztmp0),200._wp), ztmp0 ) ! (prevents FPE from stupid values from masked region later on...)
+
+         ztmp1 = u_star*u_star   ! u*^2
+
+         !! Update wind at zu with convection-related wind gustiness in unstable conditions (Fairall et al. 2003, Eq.8):
+         ztmp2 = Beta0*Beta0*ztmp1*(MAX(-zi0*ztmp0/vkarmn,0._wp))**(2._wp/3._wp) ! square of wind gustiness contribution, ztmp2 == Ug^2
+         !!   ! Only true when unstable (L<0) => when ztmp0 < 0 => explains "-" before zi0
+         U_blk = MAX(SQRT(U_zu*U_zu + ztmp2), 0.2_wp)        ! include gustiness in bulk wind speed
+         ! => 0.2 prevents U_blk to be 0 in stable case when U_zu=0.
+
+         !! Stability parameters:
+         zeta_u = zu*ztmp0
+         zeta_u = SIGN( MIN(ABS(zeta_u),50.0_wp), zeta_u )
+         IF( .NOT. l_zt_equal_zu ) THEN
+            zeta_t = zt*ztmp0
+            zeta_t = SIGN( MIN(ABS(zeta_t),50.0_wp), zeta_t )
+         ENDIF
+
+         !! Adjustment the wind at 10m (not needed in the current algo form):
+         !IF( zu \= 10._wp ) U10 = U_zu + u_star/vkarmn*(LOG(10._wp/zu) - psi_m_coare(10._wp*ztmp0) + psi_m_coare(zeta_u))
+
+         !! Roughness lengthes z0, z0t (z0q = z0t) :
+         ztmp2 = u_star/vkarmn*LOG(10./z0)                                 ! Neutral wind speed at 10m
+         z0    = alfa_charn_3p6(ztmp2)*ztmp1/grav + 0.11_wp*znu_a/u_star   ! Roughness length (eq.6) [ ztmp1==u*^2 ]
+         z0     = MIN( MAX(ABS(z0), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on)
+
+         ztmp1 = ( znu_a / (z0*u_star) )**0.72_wp     ! COARE3.6-specific! (1./Re_r)^0.72 (Re_r: roughness Reynolds number) COARE3.6-specific!
+         z0t   = MIN( 1.6E-4_wp , 5.8E-5_wp*ztmp1 )   ! COARE3.6-specific!
+         z0t   = MIN( MAX(ABS(z0t), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on)
+
+         !! Turbulent scales at zu :
+         ztmp0   = psi_h_coare(zeta_u)
+         ztmp1   = vkarmn/(LOG(zu) - LOG(z0t) - ztmp0) ! #LB: in ztmp0, some use psi_h_coare(zeta_t) rather than psi_h_coare(zeta_t) ???
+
+         t_star = dt_zu*ztmp1
+         q_star = dq_zu*ztmp1
+         u_star = MAX( U_blk*vkarmn/(LOG(zu) - LOG(z0) - psi_m_coare(zeta_u)) , 1.E-9 )  !  (MAX => prevents FPE from stupid values from masked region later on)
+
+         IF( .NOT. l_zt_equal_zu ) THEN
+            !! Re-updating temperature and humidity at zu if zt /= zu :
+            ztmp1 = LOG(zt/zu) + ztmp0 - psi_h_coare(zeta_t)
+            t_zu = t_zt - t_star/vkarmn*ztmp1
+            q_zu = q_zt - q_star/vkarmn*ztmp1
+         ENDIF
+
+
+         IF( l_use_cs ) THEN
+            !! Cool-skin contribution
+
+            CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, U_blk, slp, rad_lw, &
+               &                   ztmp1, zeta_u,  Qlat=ztmp2)  ! Qnsol -> ztmp1 / Tau -> zeta_u
+
+            CALL CS_COARE( Qsw, ztmp1, u_star, zsst, ztmp2 )  ! ! Qnsol -> ztmp1 / Qlat -> ztmp2
+
+            T_s(:,:) = zsst(:,:) + dT_cs(:,:)*tmask(:,:,1)
+            IF( l_use_wl ) T_s(:,:) = T_s(:,:) + dT_wl(:,:)*tmask(:,:,1)
+            q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:))
+
+         ENDIF
+
+         IF( l_use_wl ) THEN
+            !! Warm-layer contribution
+            CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, U_blk, slp, rad_lw, &
+               &                   ztmp1, zeta_u)  ! Qnsol -> ztmp1 / Tau -> zeta_u
+            !! In WL_COARE or , Tau_ac and Qnt_ac must be updated at the final itteration step => add a flag to do this!
+            CALL WL_COARE( Qsw, ztmp1, zeta_u, zsst, MOD(nb_itt,j_itt) )
+
+            !! Updating T_s and q_s !!!
+            T_s(:,:) = zsst(:,:) + dT_wl(:,:)*tmask(:,:,1)
+            IF( l_use_cs ) T_s(:,:) = T_s(:,:) + dT_cs(:,:)*tmask(:,:,1)
+            q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:))
+         ENDIF
+
+         IF( l_use_cs .OR. l_use_wl .OR. (.NOT. l_zt_equal_zu) ) THEN
+            dt_zu = t_zu - T_s ;  dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6_wp), dt_zu )
+            dq_zu = q_zu - q_s ;  dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9_wp), dq_zu )
+         ENDIF
+
+      END DO !DO j_itt = 1, nb_itt
+
+      ! compute transfer coefficients at zu :
+      ztmp0 = u_star/U_blk
+      Cd   = ztmp0*ztmp0
+      Ch   = ztmp0*t_star/dt_zu
+      Ce   = ztmp0*q_star/dq_zu
+
+      ztmp1 = zu + z0
+      Cdn = vkarmn*vkarmn / (log(ztmp1/z0 )*log(ztmp1/z0 ))
+      Chn = vkarmn*vkarmn / (log(ztmp1/z0t)*log(ztmp1/z0t))
+      Cen = Chn
+
+      IF( .NOT. l_zt_equal_zu ) DEALLOCATE( zeta_t )
+
+      IF( l_use_cs .AND. PRESENT(pdT_cs) ) pdT_cs = dT_cs
+      IF( l_use_wl .AND. PRESENT(pdT_wl) ) pdT_wl = dT_wl
+      IF( l_use_wl .AND. PRESENT(pHz_wl) ) pHz_wl = Hz_wl
+
+      IF( l_use_cs .OR. l_use_wl ) DEALLOCATE ( zsst )
+
+   END SUBROUTINE turb_coare3p6
+
+
+   FUNCTION alfa_charn_3p6( pwnd )
+      !!-------------------------------------------------------------------
+      !! Computes the Charnock parameter as a function of the Neutral wind speed at 10m
+      !!  "wind speed dependent formulation"
+      !!  (Eq. 13 in Edson et al., 2013)
+      !!
+      !! Author: L. Brodeau, July 2019 / AeroBulk  (https://github.com/brodeau/aerobulk/)
+      !!-------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj) :: alfa_charn_3p6
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pwnd   ! neutral wind speed at 10m
+      !
+      REAL(wp), PARAMETER :: charn0_max = 0.028  !: value above which the Charnock parameter levels off for winds > 18 m/s
+      !!-------------------------------------------------------------------
+      alfa_charn_3p6 = MAX( MIN( 0.0017_wp*pwnd - 0.005_wp , charn0_max) , 0._wp )
+      !!
+   END FUNCTION alfa_charn_3p6
+
+   FUNCTION alfa_charn_3p6_wave( pus, pwsh, pwps )
+      !!-------------------------------------------------------------------
+      !! Computes the Charnock parameter as a function of wave information and u*
+      !!
+      !!  (COARE 3.6, Fairall et al., 2018)
+      !!
+      !! Author: L. Brodeau, October 2019 / AeroBulk  (https://github.com/brodeau/aerobulk/)
+      !!-------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj) :: alfa_charn_3p6_wave
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pus   ! friction velocity             [m/s]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pwsh  ! significant wave height       [m]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pwps  ! phase speed of dominant waves [m/s]
+      !!-------------------------------------------------------------------
+      alfa_charn_3p6_wave = ( pwsh*0.2_wp*(pus/pwps)**2.2_wp ) * grav/(pus*pus)
+      !!
+   END FUNCTION alfa_charn_3p6_wave
+
+
+   FUNCTION psi_m_coare( pzeta )
+      !!----------------------------------------------------------------------------------
+      !! ** Purpose: compute the universal profile stability function for momentum
+      !!             COARE 3.0, Fairall et al. 2003
+      !!             pzeta : stability paramenter, z/L where z is altitude
+      !!                     measurement and L is M-O length
+      !!       Stability function for wind speed and scalars matching Kansas and free
+      !!       convection forms with weighting f convective form, follows Fairall et
+      !!       al (1996) with profile constants from Grachev et al (2000) BLM stable
+      !!       form from Beljaars and Holtslag (1991)
+      !!
+      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
+      !!----------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj) :: psi_m_coare
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
+      !
+      INTEGER  ::   ji, jj    ! dummy loop indices
+      REAL(wp) :: zta, zphi_m, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab
+      !!----------------------------------------------------------------------------------
+      !
+      DO_2D_11_11
+      !
+      zta = pzeta(ji,jj)
+      !
+      zphi_m = ABS(1. - 15.*zta)**.25    !!Kansas unstable
+      !
+      zpsi_k = 2.*LOG((1. + zphi_m)/2.) + LOG((1. + zphi_m*zphi_m)/2.)   &
+         & - 2.*ATAN(zphi_m) + 0.5*rpi
+      !
+      zphi_c = ABS(1. - 10.15*zta)**.3333                   !!Convective
+      !
+      zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) &
+         &     - 1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447
+      !
+      zf = zta*zta
+      zf = zf/(1. + zf)
+      zc = MIN(50._wp, 0.35_wp*zta)
+      zstab = 0.5 + SIGN(0.5_wp, zta)
+      !
+      psi_m_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & ! (zta < 0)
+         &                -   zstab     * ( 1. + 1.*zta     &                ! (zta > 0)
+         &                         + 0.6667*(zta - 14.28)/EXP(zc) + 8.525 )   !     "
+      !
+      END_2D
+      !
+   END FUNCTION psi_m_coare
+
+
+   FUNCTION psi_h_coare( pzeta )
+      !!---------------------------------------------------------------------
+      !! Universal profile stability function for temperature and humidity
+      !! COARE 3.0, Fairall et al. 2003
+      !!
+      !! pzeta : stability paramenter, z/L where z is altitude measurement
+      !!         and L is M-O length
+      !!
+      !! Stability function for wind speed and scalars matching Kansas and free
+      !! convection forms with weighting f convective form, follows Fairall et
+      !! al (1996) with profile constants from Grachev et al (2000) BLM stable
+      !! form from Beljaars and Holtslag (1991)
+      !!
+      !! Author: L. Brodeau, June 2016 / AeroBulk
+      !!         (https://github.com/brodeau/aerobulk/)
+      !!----------------------------------------------------------------
+      !!
+      REAL(wp), DIMENSION(jpi,jpj) :: psi_h_coare
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
+      !
+      INTEGER  ::   ji, jj     ! dummy loop indices
+      REAL(wp) :: zta, zphi_h, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab
+      !
+      DO_2D_11_11
+      !
+      zta = pzeta(ji,jj)
+      !
+      zphi_h = (ABS(1. - 15.*zta))**.5  !! Kansas unstable   (zphi_h = zphi_m**2 when unstable, zphi_m when stable)
+      !
+      zpsi_k = 2.*LOG((1. + zphi_h)/2.)
+      !
+      zphi_c = (ABS(1. - 34.15*zta))**.3333   !! Convective
+      !
+      zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) &
+         &    -1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447
+      !
+      zf = zta*zta
+      zf = zf/(1. + zf)
+      zc = MIN(50._wp,0.35_wp*zta)
+      zstab = 0.5 + SIGN(0.5_wp, zta)
+      !
+      psi_h_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) &
+         &                -   zstab     * ( (ABS(1. + 2.*zta/3.))**1.5     &
+         &                           + .6667*(zta - 14.28)/EXP(zc) + 8.525 )
+      !
+      END_2D
+      !
+   END FUNCTION psi_h_coare
+
+   !!======================================================================
+END MODULE sbcblk_algo_coare3p6
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcblk_algo_ecmwf.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcblk_algo_ecmwf.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcblk_algo_ecmwf.F90	(revision 12928)
@@ -1,8 +1,6 @@
 MODULE sbcblk_algo_ecmwf
    !!======================================================================
-   !!                       ***  MODULE  sbcblk_algo_ecmwf  ***
-   !! Computes turbulent components of surface fluxes
-   !!         according to the method in IFS of the ECMWF model
-   !!
+   !!                   ***  MODULE  sbcblk_algo_ecmwf  ***
+   !! Computes:
    !!   * bulk transfer coefficients C_D, C_E and C_H
    !!   * air temp. and spec. hum. adjusted from zt (2m) to zu (10m) if needed
@@ -10,12 +8,11 @@
    !!   => all these are used in bulk formulas in sbcblk.F90
    !!
-   !!    Using the bulk formulation/param. of IFS of ECMWF (cycle 31r2)
+   !!    Using the bulk formulation/param. of IFS of ECMWF (cycle 40r1)
    !!         based on IFS doc (avaible online on the ECMWF's website)
    !!
+   !!       Routine turb_ecmwf maintained and developed in AeroBulk
+   !!                     (https://github.com/brodeau/aerobulk)
    !!
-   !!       Routine turb_ecmwf maintained and developed in AeroBulk
-   !!                     (http://aerobulk.sourceforge.net/)
-   !!
-   !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
+   !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk)
    !!----------------------------------------------------------------------
    !! History :  4.0  !  2016-02  (L.Brodeau)   Original code
@@ -41,48 +38,109 @@
 
    USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE sbcblk_phy      ! all thermodynamics functions, rho_air, q_sat, etc... !LB
+   USE sbcblk_skin_ecmwf ! cool-skin/warm layer scheme !LB
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC ::   TURB_ECMWF   ! called by sbcblk.F90
-
-   !                   !! ECMWF own values for given constants, taken form IFS documentation...
+   PUBLIC :: SBCBLK_ALGO_ECMWF_INIT, TURB_ECMWF
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+
+   !! ECMWF own values for given constants, taken form IFS documentation...
    REAL(wp), PARAMETER ::   charn0 = 0.018    ! Charnock constant (pretty high value here !!!
    !                                          !    =>  Usually 0.011 for moderate winds)
    REAL(wp), PARAMETER ::   zi0     = 1000.   ! scale height of the atmospheric boundary layer...1
    REAL(wp), PARAMETER ::   Beta0    = 1.     ! gustiness parameter ( = 1.25 in COAREv3)
-   REAL(wp), PARAMETER ::   rctv0    = 0.608  ! constant to obtain virtual temperature...
-   REAL(wp), PARAMETER ::   Cp_dry = 1005.0   ! Specic heat of dry air, constant pressure      [J/K/kg]
-   REAL(wp), PARAMETER ::   Cp_vap = 1860.0   ! Specic heat of water vapor, constant pressure  [J/K/kg]
    REAL(wp), PARAMETER ::   alpha_M = 0.11    ! For roughness length (smooth surface term)
    REAL(wp), PARAMETER ::   alpha_H = 0.40    ! (Chapter 3, p.34, IFS doc Cy31r1)
    REAL(wp), PARAMETER ::   alpha_Q = 0.62    !
+
+   INTEGER , PARAMETER ::   nb_itt = 10             ! number of itterations
+
    !!----------------------------------------------------------------------
 CONTAINS
 
-   SUBROUTINE TURB_ECMWF( zt, zu, sst, t_zt, ssq , q_zt , U_zu,   &
-      &                   Cd, Ch, Ce , t_zu, q_zu, U_blk,         &
-      &                   Cdn, Chn, Cen                           )
-      !!----------------------------------------------------------------------------------
-      !!                      ***  ROUTINE  turb_ecmwf  ***
-      !!
-      !!            2015: L. Brodeau (brodeau@gmail.com)
-      !!
-      !! ** Purpose :   Computes turbulent transfert coefficients of surface
-      !!                fluxes according to IFS doc. (cycle 31)
-      !!                If relevant (zt /= zu), adjust temperature and humidity from height zt to zu
-      !!
-      !! ** Method : Monin Obukhov Similarity Theory
+
+   SUBROUTINE sbcblk_algo_ecmwf_init(l_use_cs, l_use_wl)
+      !!---------------------------------------------------------------------
+      !!                  ***  FUNCTION sbcblk_algo_ecmwf_init  ***
       !!
       !! INPUT :
       !! -------
+      !!    * l_use_cs : use the cool-skin parameterization
+      !!    * l_use_wl : use the warm-layer parameterization
+      !!---------------------------------------------------------------------
+      LOGICAL , INTENT(in) ::   l_use_cs ! use the cool-skin parameterization
+      LOGICAL , INTENT(in) ::   l_use_wl ! use the warm-layer parameterization
+      INTEGER :: ierr
+      !!---------------------------------------------------------------------
+      IF( l_use_wl ) THEN
+         ierr = 0
+         ALLOCATE ( dT_wl(jpi,jpj), Hz_wl(jpi,jpj), STAT=ierr )
+         IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_ECMWF_INIT => allocation of dT_wl & Hz_wl failed!' )
+         dT_wl(:,:)  = 0._wp
+         Hz_wl(:,:)  = rd0 ! (rd0, constant, = 3m is default for Zeng & Beljaars)
+      ENDIF
+      IF( l_use_cs ) THEN
+         ierr = 0
+         ALLOCATE ( dT_cs(jpi,jpj), STAT=ierr )
+         IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_ECMWF_INIT => allocation of dT_cs failed!' )
+         dT_cs(:,:) = -0.25_wp  ! First guess of skin correction
+      ENDIF
+   END SUBROUTINE sbcblk_algo_ecmwf_init
+
+
+
+   SUBROUTINE turb_ecmwf( kt, zt, zu, T_s, t_zt, q_s, q_zt, U_zu, l_use_cs, l_use_wl, &
+      &                      Cd, Ch, Ce, t_zu, q_zu, U_blk,                           &
+      &                      Cdn, Chn, Cen,                                           &
+      &                      Qsw, rad_lw, slp, pdT_cs,                                & ! optionals for cool-skin (and warm-layer)
+      &                      pdT_wl, pHz_wl )                                           ! optionals for warm-layer only
+      !!----------------------------------------------------------------------------------
+      !!                      ***  ROUTINE  turb_ecmwf  ***
+      !!
+      !! ** Purpose :   Computes turbulent transfert coefficients of surface
+      !!                fluxes according to IFS doc. (cycle 45r1)
+      !!                If relevant (zt /= zu), adjust temperature and humidity from height zt to zu
+      !!                Returns the effective bulk wind speed at zu to be used in the bulk formulas
+      !!
+      !!                Applies the cool-skin warm-layer correction of the SST to T_s
+      !!                if the net shortwave flux at the surface (Qsw), the downwelling longwave
+      !!                radiative fluxes at the surface (rad_lw), and the sea-leve pressure (slp)
+      !!                are provided as (optional) arguments!
+      !!
+      !! INPUT :
+      !! -------
+      !!    *  kt   : current time step (starts at 1)
       !!    *  zt   : height for temperature and spec. hum. of air            [m]
-      !!    *  zu   : height for wind speed (generally 10m)                   [m]
-      !!    *  U_zu : scalar wind speed at 10m                                [m/s]
-      !!    *  sst  : SST                                                     [K]
+      !!    *  zu   : height for wind speed (usually 10m)                     [m]
       !!    *  t_zt : potential air temperature at zt                         [K]
-      !!    *  ssq  : specific humidity at saturation at SST                  [kg/kg]
       !!    *  q_zt : specific humidity of air at zt                          [kg/kg]
-      !!
+      !!    *  U_zu : scalar wind speed at zu                                 [m/s]
+      !!    * l_use_cs : use the cool-skin parameterization
+      !!    * l_use_wl : use the warm-layer parameterization
+      !!
+      !! INPUT/OUTPUT:
+      !! -------------
+      !!    *  T_s  : always "bulk SST" as input                              [K]
+      !!              -> unchanged "bulk SST" as output if CSWL not used      [K]
+      !!              -> skin temperature as output if CSWL used              [K]
+      !!
+      !!    *  q_s  : SSQ aka saturation specific humidity at temp. T_s       [kg/kg]
+      !!              -> doesn't need to be given a value if skin temp computed (in case l_use_cs=True or l_use_wl=True)
+      !!              -> MUST be given the correct value if not computing skint temp. (in case l_use_cs=False or l_use_wl=False)
+      !!
+      !! OPTIONAL INPUT:
+      !! ---------------
+      !!    *  Qsw    : net solar flux (after albedo) at the surface (>0)     [W/m^2]
+      !!    *  rad_lw : downwelling longwave radiation at the surface  (>0)   [W/m^2]
+      !!    *  slp    : sea-level pressure                                    [Pa]
+      !!
+      !! OPTIONAL OUTPUT:
+      !! ----------------
+      !!    * pdT_cs  : SST increment "dT" for cool-skin correction           [K]
+      !!    * pdT_wl  : SST increment "dT" for warm-layer correction          [K]
+      !!    * pHz_wl  : thickness of warm-layer                               [m]
       !!
       !! OUTPUT :
@@ -93,16 +151,19 @@
       !!    *  t_zu   : pot. air temperature adjusted at wind height zu       [K]
       !!    *  q_zu   : specific humidity of air        //                    [kg/kg]
-      !!    *  U_blk  : bulk wind at 10m                                      [m/s]
-      !!
-      !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
-      !!----------------------------------------------------------------------------------
+      !!    *  U_blk  : bulk wind speed at zu                                 [m/s]
+      !!
+      !!
+      !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/)
+      !!----------------------------------------------------------------------------------
+      INTEGER,  INTENT(in   )                     ::   kt       ! current time step
       REAL(wp), INTENT(in   )                     ::   zt       ! height for t_zt and q_zt                    [m]
       REAL(wp), INTENT(in   )                     ::   zu       ! height for U_zu                             [m]
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   sst      ! sea surface temperature                [Kelvin]
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) ::   T_s      ! sea surface temperature                [Kelvin]
       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   t_zt     ! potential air temperature              [Kelvin]
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   ssq      ! sea surface specific humidity           [kg/kg]
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity                   [kg/kg]
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) ::   q_s      ! sea surface specific humidity           [kg/kg]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity at zt             [kg/kg]
       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   U_zu     ! relative wind module at zu                [m/s]
+      LOGICAL , INTENT(in   )                     ::   l_use_cs ! use the cool-skin parameterization
+      LOGICAL , INTENT(in   )                     ::   l_use_wl ! use the warm-layer parameterization
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cd       ! transfer coefficient for momentum         (tau)
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ch       ! transfer coefficient for sensible heat (Q_sens)
@@ -110,81 +171,103 @@
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   t_zu     ! pot. air temp. adjusted at zu               [K]
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg]
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind at 10m                          [m/s]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind speed at zu                     [m/s]
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cdn, Chn, Cen ! neutral transfer coefficients
       !
+      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   Qsw      !             [W/m^2]
+      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   rad_lw   !             [W/m^2]
+      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   slp      !             [Pa]
+      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   pdT_cs
+      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   pdT_wl   !             [K]
+      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   pHz_wl   !             [m]
+      !
       INTEGER :: j_itt
-      LOGICAL ::   l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U
-      INTEGER , PARAMETER ::   nb_itt = 4       ! number of itterations
-      !
-      REAL(wp), DIMENSION(jpi,jpj) ::   u_star, t_star, q_star,   &
-         &  dt_zu, dq_zu,    &
-         &  znu_a,           & !: Nu_air, Viscosity of air
-         &  Linv,            & !: 1/L (inverse of Monin Obukhov length...
-         &  z0, z0t, z0q
-      REAL(wp), DIMENSION(jpi,jpj) ::   func_m, func_h
-      REAL(wp), DIMENSION(jpi,jpj) ::   ztmp0, ztmp1, ztmp2
-      !!----------------------------------------------------------------------------------
-      !
-      ! Identical first gess as in COARE, with IFS parameter values though
-      !
-      l_zt_equal_zu = .FALSE.
-      IF( ABS(zu - zt) < 0.01 )   l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision
-
-
+      LOGICAL :: l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U
+      !
+      REAL(wp), DIMENSION(jpi,jpj) :: u_star, t_star, q_star
+      REAL(wp), DIMENSION(jpi,jpj) :: dt_zu, dq_zu
+      REAL(wp), DIMENSION(jpi,jpj) :: znu_a         !: Nu_air, Viscosity of air
+      REAL(wp), DIMENSION(jpi,jpj) :: Linv  !: 1/L (inverse of Monin Obukhov length...
+      REAL(wp), DIMENSION(jpi,jpj) :: z0, z0t, z0q
+      !
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zsst  ! to back up the initial bulk SST
+      !
+      REAL(wp), DIMENSION(jpi,jpj) :: func_m, func_h
+      REAL(wp), DIMENSION(jpi,jpj) :: ztmp0, ztmp1, ztmp2
+      CHARACTER(len=40), PARAMETER :: crtnm = 'turb_ecmwf@sbcblk_algo_ecmwf.F90'
+      !!----------------------------------------------------------------------------------
+      IF( kt == nit000 ) CALL SBCBLK_ALGO_ECMWF_INIT(l_use_cs, l_use_wl)
+
+      l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision
+
+      !! Initializations for cool skin and warm layer:
+      IF( l_use_cs .AND. (.NOT.(PRESENT(Qsw) .AND. PRESENT(rad_lw) .AND. PRESENT(slp))) ) &
+         &   CALL ctl_stop( '['//TRIM(crtnm)//'] => ' , 'you need to provide Qsw, rad_lw & slp to use cool-skin param!' )
+
+      IF( l_use_wl .AND. (.NOT.(PRESENT(Qsw) .AND. PRESENT(rad_lw) .AND. PRESENT(slp))) ) &
+         &   CALL ctl_stop( '['//TRIM(crtnm)//'] => ' , 'you need to provide Qsw, rad_lw & slp to use warm-layer param!' )
+
+      IF( l_use_cs .OR. l_use_wl ) THEN
+         ALLOCATE ( zsst(jpi,jpj) )
+         zsst = T_s ! backing up the bulk SST
+         IF( l_use_cs ) T_s = T_s - 0.25_wp   ! First guess of correction
+         q_s    = rdct_qsat_salt*q_sat(MAX(T_s, 200._wp), slp) ! First guess of q_s
+      ENDIF
+
+
+      ! Identical first gess as in COARE, with IFS parameter values though...
+      !
       !! First guess of temperature and humidity at height zu:
-      t_zu = MAX( t_zt , 0.0  )   ! who knows what's given on masked-continental regions...
-      q_zu = MAX( q_zt , 1.e-6)   !               "
+      t_zu = MAX( t_zt ,  180._wp )   ! who knows what's given on masked-continental regions...
+      q_zu = MAX( q_zt , 1.e-6_wp )   !               "
 
       !! Pot. temp. difference (and we don't want it to be 0!)
-      dt_zu = t_zu - sst   ;   dt_zu = SIGN( MAX(ABS(dt_zu),1.e-6), dt_zu )
-      dq_zu = q_zu - ssq   ;   dq_zu = SIGN( MAX(ABS(dq_zu),1.e-9), dq_zu )
-
-      znu_a = visc_air(t_zt) ! Air viscosity (m^2/s) at zt given from temperature in (K)
-
-      ztmp2 = 0.5 * 0.5  ! initial guess for wind gustiness contribution
-      U_blk = SQRT(U_zu*U_zu + ztmp2)
-
-      ! z0     = 0.0001
-      ztmp2   = 10000.     ! optimization: ztmp2 == 1/z0
-      ztmp0   = LOG(zu*ztmp2)
-      ztmp1   = LOG(10.*ztmp2)
-      u_star = 0.035*U_blk*ztmp1/ztmp0       ! (u* = 0.035*Un10)
-
-      z0     = charn0*u_star*u_star/grav + 0.11*znu_a/u_star
-      z0t    = 0.1*EXP(vkarmn/(0.00115/(vkarmn/ztmp1)))   !  WARNING: 1/z0t !
+      dt_zu = t_zu - T_s ;   dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6_wp), dt_zu )
+      dq_zu = q_zu - q_s ;   dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9_wp), dq_zu )
+
+      znu_a = visc_air(t_zu) ! Air viscosity (m^2/s) at zt given from temperature in (K)
+
+      U_blk = SQRT(U_zu*U_zu + 0.5_wp*0.5_wp) ! initial guess for wind gustiness contribution
+
+      ztmp0   = LOG(    zu*10000._wp) ! optimization: 10000. == 1/z0 (with z0 first guess == 0.0001)
+      ztmp1   = LOG(10._wp*10000._wp) !       "                    "               "
+      u_star = 0.035_wp*U_blk*ztmp1/ztmp0       ! (u* = 0.035*Un10)
+
+      z0     = charn0*u_star*u_star/grav + 0.11_wp*znu_a/u_star
+      z0     = MIN( MAX(ABS(z0), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on)
+
+      z0t    = 1._wp / ( 0.1_wp*EXP(vkarmn/(0.00115/(vkarmn/ztmp1))) )
+      z0t    = MIN( MAX(ABS(z0t), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on)
 
       Cd     = (vkarmn/ztmp0)**2    ! first guess of Cd
 
-      ztmp0 = vkarmn*vkarmn/LOG(zt*z0t)/Cd
-
-      ztmp2 = Ri_bulk( zu, t_zu, dt_zu, q_zu, dq_zu, U_blk )   ! Ribu = Bulk Richardson number
-
-      !! First estimate of zeta_u, depending on the stability, ie sign of Ribu (ztmp2):
-      ztmp1 = 0.5 + SIGN( 0.5 , ztmp2 )
+      ztmp0 = vkarmn*vkarmn/LOG(zt/z0t)/Cd
+
+      ztmp2 = Ri_bulk( zu, T_s, t_zu, q_s, q_zu, U_blk ) ! Bulk Richardson Number (BRN)
+
+      !! First estimate of zeta_u, depending on the stability, ie sign of BRN (ztmp2):
+      ztmp1 = 0.5 + SIGN( 0.5_wp , ztmp2 )
       func_m = ztmp0*ztmp2 ! temporary array !!
-      !!             Ribu < 0                                 Ribu > 0   Beta = 1.25
-      func_h = (1.-ztmp1)*(func_m/(1.+ztmp2/(-zu/(zi0*0.004*Beta0**3)))) &  ! temporary array !!! func_h == zeta_u
-         &  +     ztmp1*(func_m*(1. + 27./9.*ztmp2/ztmp0))
+      func_h = (1._wp-ztmp1) * (func_m/(1._wp+ztmp2/(-zu/(zi0*0.004_wp*Beta0**3)))) & !  BRN < 0 ! temporary array !!! func_h == zeta_u
+         &  +     ztmp1   * (func_m*(1._wp + 27._wp/9._wp*ztmp2/func_m))              !  BRN > 0
+      !#LB: should make sure that the "func_m" of "27./9.*ztmp2/func_m" is "ztmp0*ztmp2" and not "ztmp0==vkarmn*vkarmn/LOG(zt/z0t)/Cd" !
 
       !! First guess M-O stability dependent scaling params.(u*,t*,q*) to estimate z0 and z/L
-      ztmp0   =        vkarmn/(LOG(zu*z0t) - psi_h_ecmwf(func_h))
-
-      u_star = U_blk*vkarmn/(LOG(zu) - LOG(z0)  - psi_m_ecmwf(func_h))
+      ztmp0  = vkarmn/(LOG(zu/z0t) - psi_h_ecmwf(func_h))
+
+      u_star = MAX ( U_blk*vkarmn/(LOG(zu) - LOG(z0)  - psi_m_ecmwf(func_h)) , 1.E-9 )  !  (MAX => prevents FPE from stupid values from masked region later on)
       t_star = dt_zu*ztmp0
       q_star = dq_zu*ztmp0
 
-      ! What's need to be done if zt /= zu:
+      ! What needs to be done if zt /= zu:
       IF( .NOT. l_zt_equal_zu ) THEN
-         !
          !! First update of values at zu (or zt for wind)
          ztmp0 = psi_h_ecmwf(func_h) - psi_h_ecmwf(zt*func_h/zu)    ! zt*func_h/zu == zeta_t
-         ztmp1 = log(zt/zu) + ztmp0
+         ztmp1 = LOG(zt/zu) + ztmp0
          t_zu = t_zt - t_star/vkarmn*ztmp1
          q_zu = q_zt - q_star/vkarmn*ztmp1
-         q_zu = (0.5 + sign(0.5,q_zu))*q_zu !Makes it impossible to have negative humidity :
-
-         dt_zu = t_zu - sst  ; dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6), dt_zu )
-         dq_zu = q_zu - ssq  ; dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9), dq_zu )
+         q_zu = (0.5_wp + SIGN(0.5_wp,q_zu))*q_zu !Makes it impossible to have negative humidity :
          !
+         dt_zu = t_zu - T_s  ; dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6_wp), dt_zu )
+         dq_zu = q_zu - q_s  ; dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9_wp), dq_zu )
       ENDIF
 
@@ -194,28 +277,24 @@
 
       !! First guess of inverse of Monin-Obukov length (1/L) :
-      ztmp0 = (1. + rctv0*q_zu)  ! the factor to apply to temp. to get virt. temp...
-      Linv  =  grav*vkarmn*(t_star*ztmp0 + rctv0*t_zu*q_star) / ( u_star*u_star * t_zu*ztmp0 )
+      Linv = One_on_L( t_zu, q_zu, u_star, t_star, q_star )
 
       !! Functions such as  u* = U_blk*vkarmn/func_m
-      ztmp1 = zu + z0
-      ztmp0 = ztmp1*Linv
-      func_m = LOG(ztmp1) -LOG(z0) - psi_m_ecmwf(ztmp0) + psi_m_ecmwf(z0*Linv)
-      func_h = LOG(ztmp1*z0t) - psi_h_ecmwf(ztmp0) + psi_h_ecmwf(1./z0t*Linv)
-
+      ztmp0 = zu*Linv
+      func_m = LOG(zu) - LOG(z0)  - psi_m_ecmwf(ztmp0) + psi_m_ecmwf( z0*Linv)
+      func_h = LOG(zu) - LOG(z0t) - psi_h_ecmwf(ztmp0) + psi_h_ecmwf(z0t*Linv)
 
       !! ITERATION BLOCK
-      !! ***************
-
       DO j_itt = 1, nb_itt
 
          !! Bulk Richardson Number at z=zu (Eq. 3.25)
-         ztmp0 = Ri_bulk(zu, t_zu, dt_zu, q_zu, dq_zu, U_blk)
+         ztmp0 = Ri_bulk( zu, T_s, t_zu, q_s, q_zu, U_blk ) ! Bulk Richardson Number (BRN)
 
          !! New estimate of the inverse of the Monin-Obukhon length (Linv == zeta/zu) :
-         Linv = ztmp0*func_m*func_m/func_h / zu     ! From Eq. 3.23, Chap.3, p.33, IFS doc - Cy31r1
+         Linv = ztmp0*func_m*func_m/func_h / zu     ! From Eq. 3.23, Chap.3.2.3, IFS doc - Cy40r1
+         !! Note: it is slightly different that the L we would get with the usual
+         Linv = SIGN( MIN(ABS(Linv),200._wp), Linv ) ! (prevent FPE from stupid values from masked region later on...)
 
          !! Update func_m with new Linv:
-         ztmp1 = zu + z0
-         func_m = LOG(ztmp1) -LOG(z0) - psi_m_ecmwf(ztmp1*Linv) + psi_m_ecmwf(z0*Linv)
+         func_m = LOG(zu) -LOG(z0) - psi_m_ecmwf(zu*Linv) + psi_m_ecmwf(z0*Linv) ! LB: should be "zu+z0" rather than "zu" alone, but z0 is tiny wrt zu!
 
          !! Need to update roughness lengthes:
@@ -223,13 +302,12 @@
          ztmp2  = u_star*u_star
          ztmp1  = znu_a/u_star
-         z0    = alpha_M*ztmp1 + charn0*ztmp2/grav
-         z0t    = alpha_H*ztmp1                              ! eq.3.26, Chap.3, p.34, IFS doc - Cy31r1
-         z0q    = alpha_Q*ztmp1
-
-         !! Update wind at 10m taking into acount convection-related wind gustiness:
-         ! Only true when unstable (L<0) => when ztmp0 < 0 => - !!!
-         ztmp2 = ztmp2 * (MAX(-zi0*Linv/vkarmn,0.))**(2./3.) ! => w*^2  (combining Eq. 3.8 and 3.18, hap.3, IFS doc - Cy31r1)
-         !! => equivalent using Beta=1 (gustiness parameter, 1.25 for COARE, also zi0=600 in COARE..)
-         U_blk = MAX(sqrt(U_zu*U_zu + ztmp2), 0.2)              ! eq.3.17, Chap.3, p.32, IFS doc - Cy31r1
+         z0     = MIN( ABS( alpha_M*ztmp1 + charn0*ztmp2/grav ) , 0.001_wp)
+         z0t    = MIN( ABS( alpha_H*ztmp1                     ) , 0.001_wp)   ! eq.3.26, Chap.3, p.34, IFS doc - Cy31r1
+         z0q    = MIN( ABS( alpha_Q*ztmp1                     ) , 0.001_wp)
+
+         !! Update wind at zu with convection-related wind gustiness in unstable conditions (Chap. 3.2, IFS doc - Cy40r1, Eq.3.17 and Eq.3.18 + Eq.3.8)
+         ztmp2 = Beta0*Beta0*ztmp2*(MAX(-zi0*Linv/vkarmn,0._wp))**(2._wp/3._wp) ! square of wind gustiness contribution  (combining Eq. 3.8 and 3.18, hap.3, IFS doc - Cy31r1)
+         !!   ! Only true when unstable (L<0) => when ztmp0 < 0 => explains "-" before zi0
+         U_blk = MAX(SQRT(U_zu*U_zu + ztmp2), 0.2_wp)        ! include gustiness in bulk wind speed
          ! => 0.2 prevents U_blk to be 0 in stable case when U_zu=0.
 
@@ -238,12 +316,11 @@
          !! as well the air-sea differences:
          IF( .NOT. l_zt_equal_zu ) THEN
-
             !! Arrays func_m and func_h are free for a while so using them as temporary arrays...
-            func_h = psi_h_ecmwf((zu+z0)*Linv) ! temporary array !!!
-            func_m = psi_h_ecmwf((zt+z0)*Linv) ! temporary array !!!
+            func_h = psi_h_ecmwf(zu*Linv) ! temporary array !!!
+            func_m = psi_h_ecmwf(zt*Linv) ! temporary array !!!
 
             ztmp2  = psi_h_ecmwf(z0t*Linv)
             ztmp0  = func_h - ztmp2
-            ztmp1  = vkarmn/(LOG(zu+z0) - LOG(z0t) - ztmp0)
+            ztmp1  = vkarmn/(LOG(zu) - LOG(z0t) - ztmp0)
             t_star = dt_zu*ztmp1
             ztmp2  = ztmp0 - func_m + ztmp2
@@ -253,34 +330,65 @@
             ztmp2  = psi_h_ecmwf(z0q*Linv)
             ztmp0  = func_h - ztmp2
-            ztmp1  = vkarmn/(LOG(zu+z0) - LOG(z0q) - ztmp0)
+            ztmp1  = vkarmn/(LOG(zu) - LOG(z0q) - ztmp0)
             q_star = dq_zu*ztmp1
             ztmp2  = ztmp0 - func_m + ztmp2
-            ztmp1  = log(zt/zu) + ztmp2
+            ztmp1  = LOG(zt/zu) + ztmp2
             q_zu   = q_zt - q_star/vkarmn*ztmp1
-
-            dt_zu = t_zu - sst ;  dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6), dt_zu )
-            dq_zu = q_zu - ssq ;  dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9), dq_zu )
-
-         END IF
+         ENDIF
 
          !! Updating because of updated z0 and z0t and new Linv...
-         ztmp1 = zu + z0
-         ztmp0 = ztmp1*Linv
-         func_m = log(ztmp1) - LOG(z0 ) - psi_m_ecmwf(ztmp0) + psi_m_ecmwf(z0 *Linv)
-         func_h = log(ztmp1) - LOG(z0t) - psi_h_ecmwf(ztmp0) + psi_h_ecmwf(z0t*Linv)
-
-      END DO
+         ztmp0 = zu*Linv
+         func_m = log(zu) - LOG(z0 ) - psi_m_ecmwf(ztmp0) + psi_m_ecmwf(z0 *Linv)
+         func_h = log(zu) - LOG(z0t) - psi_h_ecmwf(ztmp0) + psi_h_ecmwf(z0t*Linv)
+
+
+         IF( l_use_cs ) THEN
+            !! Cool-skin contribution
+
+            CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, U_blk, slp, rad_lw, &
+               &                   ztmp1, ztmp0,  Qlat=ztmp2)  ! Qnsol -> ztmp1 / Tau -> ztmp0
+
+            CALL CS_ECMWF( Qsw, ztmp1, u_star, zsst )  ! Qnsol -> ztmp1
+
+            T_s(:,:) = zsst(:,:) + dT_cs(:,:)*tmask(:,:,1)
+            IF( l_use_wl ) T_s(:,:) = T_s(:,:) + dT_wl(:,:)*tmask(:,:,1)
+            q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:))
+
+         ENDIF
+
+         IF( l_use_wl ) THEN
+            !! Warm-layer contribution
+            CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, U_blk, slp, rad_lw, &
+               &                   ztmp1, ztmp2)  ! Qnsol -> ztmp1 / Tau -> ztmp2
+            CALL WL_ECMWF( Qsw, ztmp1, u_star, zsst )
+            !! Updating T_s and q_s !!!
+            T_s(:,:) = zsst(:,:) + dT_wl(:,:)*tmask(:,:,1) !
+            IF( l_use_cs ) T_s(:,:) = T_s(:,:) + dT_cs(:,:)*tmask(:,:,1)
+            q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:))
+         ENDIF
+
+         IF( l_use_cs .OR. l_use_wl .OR. (.NOT. l_zt_equal_zu) ) THEN
+            dt_zu = t_zu - T_s ;  dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6_wp), dt_zu )
+            dq_zu = q_zu - q_s ;  dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9_wp), dq_zu )
+         ENDIF
+
+      END DO !DO j_itt = 1, nb_itt
 
       Cd = vkarmn*vkarmn/(func_m*func_m)
       Ch = vkarmn*vkarmn/(func_m*func_h)
-      ztmp1 = log((zu + z0)/z0q) - psi_h_ecmwf((zu + z0)*Linv) + psi_h_ecmwf(z0q*Linv)   ! func_q
-      Ce = vkarmn*vkarmn/(func_m*ztmp1)
-
-      ztmp1 = zu + z0
-      Cdn = vkarmn*vkarmn / (log(ztmp1/z0 )*log(ztmp1/z0 ))
-      Chn = vkarmn*vkarmn / (log(ztmp1/z0t)*log(ztmp1/z0t))
-      Cen = vkarmn*vkarmn / (log(ztmp1/z0q)*log(ztmp1/z0q))
-
-   END SUBROUTINE TURB_ECMWF
+      ztmp2 = log(zu/z0q) - psi_h_ecmwf(zu*Linv) + psi_h_ecmwf(z0q*Linv)   ! func_q
+      Ce = vkarmn*vkarmn/(func_m*ztmp2)
+
+      Cdn = vkarmn*vkarmn / (log(zu/z0 )*log(zu/z0 ))
+      Chn = vkarmn*vkarmn / (log(zu/z0t)*log(zu/z0t))
+      Cen = vkarmn*vkarmn / (log(zu/z0q)*log(zu/z0q))
+
+      IF( l_use_cs .AND. PRESENT(pdT_cs) ) pdT_cs = dT_cs
+      IF( l_use_wl .AND. PRESENT(pdT_wl) ) pdT_wl = dT_wl
+      IF( l_use_wl .AND. PRESENT(pHz_wl) ) pHz_wl = Hz_wl
+
+      IF( l_use_cs .OR. l_use_wl ) DEALLOCATE ( zsst )
+
+   END SUBROUTINE turb_ecmwf
 
 
@@ -294,5 +402,5 @@
       !!         and L is M-O length
       !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
+      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
       !!----------------------------------------------------------------------------------
       REAL(wp), DIMENSION(jpi,jpj) :: psi_m_ecmwf
@@ -302,35 +410,31 @@
       REAL(wp) :: zzeta, zx, ztmp, psi_unst, psi_stab, stab
       !!----------------------------------------------------------------------------------
-      !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            !
-            zzeta = MIN( pzeta(ji,jj) , 5. ) !! Very stable conditions (L positif and big!):
-            !
-            ! Unstable (Paulson 1970):
-            !   eq.3.20, Chap.3, p.33, IFS doc - Cy31r1
-            zx = SQRT(ABS(1. - 16.*zzeta))
-            ztmp = 1. + SQRT(zx)
-            ztmp = ztmp*ztmp
-            psi_unst = LOG( 0.125*ztmp*(1. + zx) )   &
-               &       -2.*ATAN( SQRT(zx) ) + 0.5*rpi
-            !
-            ! Unstable:
-            ! eq.3.22, Chap.3, p.33, IFS doc - Cy31r1
-            psi_stab = -2./3.*(zzeta - 5./0.35)*EXP(-0.35*zzeta) &
-               &       - zzeta - 2./3.*5./0.35
-            !
-            ! Combining:
-            stab = 0.5 + SIGN(0.5, zzeta) ! zzeta > 0 => stab = 1
-            !
-            psi_m_ecmwf(ji,jj) = (1. - stab) * psi_unst & ! (zzeta < 0) Unstable
-               &                +      stab  * psi_stab   ! (zzeta > 0) Stable
-            !
-         END DO
-      END DO
-      !
+      DO_2D_11_11
+      !
+      zzeta = MIN( pzeta(ji,jj) , 5._wp ) !! Very stable conditions (L positif and big!):
+      !
+      ! Unstable (Paulson 1970):
+      !   eq.3.20, Chap.3, p.33, IFS doc - Cy31r1
+      zx = SQRT(ABS(1._wp - 16._wp*zzeta))
+      ztmp = 1._wp + SQRT(zx)
+      ztmp = ztmp*ztmp
+      psi_unst = LOG( 0.125_wp*ztmp*(1._wp + zx) )   &
+         &       -2._wp*ATAN( SQRT(zx) ) + 0.5_wp*rpi
+      !
+      ! Unstable:
+      ! eq.3.22, Chap.3, p.33, IFS doc - Cy31r1
+      psi_stab = -2._wp/3._wp*(zzeta - 5._wp/0.35_wp)*EXP(-0.35_wp*zzeta) &
+         &       - zzeta - 2._wp/3._wp*5._wp/0.35_wp
+      !
+      ! Combining:
+      stab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => stab = 1
+      !
+      psi_m_ecmwf(ji,jj) = (1._wp - stab) * psi_unst & ! (zzeta < 0) Unstable
+         &                +      stab  * psi_stab      ! (zzeta > 0) Stable
+      !
+      END_2D
    END FUNCTION psi_m_ecmwf
 
-   
+
    FUNCTION psi_h_ecmwf( pzeta )
       !!----------------------------------------------------------------------------------
@@ -342,5 +446,5 @@
       !!         and L is M-O length
       !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
+      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
       !!----------------------------------------------------------------------------------
       REAL(wp), DIMENSION(jpi,jpj) :: psi_h_ecmwf
@@ -351,76 +455,27 @@
       !!----------------------------------------------------------------------------------
       !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            !
-            zzeta = MIN(pzeta(ji,jj) , 5.)   ! Very stable conditions (L positif and big!):
-            !
-            zx  = ABS(1. - 16.*zzeta)**.25        ! this is actually (1/phi_m)**2  !!!
-            !                                     ! eq.3.19, Chap.3, p.33, IFS doc - Cy31r1
-            ! Unstable (Paulson 1970) :
-            psi_unst = 2.*LOG(0.5*(1. + zx*zx))   ! eq.3.20, Chap.3, p.33, IFS doc - Cy31r1
-            !
-            ! Stable:
-            psi_stab = -2./3.*(zzeta - 5./0.35)*EXP(-0.35*zzeta) & ! eq.3.22, Chap.3, p.33, IFS doc - Cy31r1
-               &       - ABS(1. + 2./3.*zzeta)**1.5 - 2./3.*5./0.35 + 1. 
-            ! LB: added ABS() to avoid NaN values when unstable, which contaminates the unstable solution...
-            !
-            stab = 0.5 + SIGN(0.5, zzeta) ! zzeta > 0 => stab = 1
-            !
-            !
-            psi_h_ecmwf(ji,jj) = (1. - stab) * psi_unst &   ! (zzeta < 0) Unstable
-               &                +    stab    * psi_stab     ! (zzeta > 0) Stable
-            !
-         END DO
-      END DO
-      !
+      DO_2D_11_11
+      !
+      zzeta = MIN(pzeta(ji,jj) , 5._wp)   ! Very stable conditions (L positif and big!):
+      !
+      zx  = ABS(1._wp - 16._wp*zzeta)**.25        ! this is actually (1/phi_m)**2  !!!
+      !                                     ! eq.3.19, Chap.3, p.33, IFS doc - Cy31r1
+      ! Unstable (Paulson 1970) :
+      psi_unst = 2._wp*LOG(0.5_wp*(1._wp + zx*zx))   ! eq.3.20, Chap.3, p.33, IFS doc - Cy31r1
+      !
+      ! Stable:
+      psi_stab = -2._wp/3._wp*(zzeta - 5._wp/0.35_wp)*EXP(-0.35_wp*zzeta) & ! eq.3.22, Chap.3, p.33, IFS doc - Cy31r1
+         &       - ABS(1._wp + 2._wp/3._wp*zzeta)**1.5_wp - 2._wp/3._wp*5._wp/0.35_wp + 1._wp
+      ! LB: added ABS() to avoid NaN values when unstable, which contaminates the unstable solution...
+      !
+      stab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => stab = 1
+      !
+      !
+      psi_h_ecmwf(ji,jj) = (1._wp - stab) * psi_unst &   ! (zzeta < 0) Unstable
+         &                +    stab    * psi_stab        ! (zzeta > 0) Stable
+      !
+      END_2D
    END FUNCTION psi_h_ecmwf
 
-
-   FUNCTION Ri_bulk( pz, ptz, pdt, pqz, pdq, pub )
-      !!----------------------------------------------------------------------------------
-      !! Bulk Richardson number (Eq. 3.25 IFS doc)
-      !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
-      !!----------------------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj) ::   Ri_bulk   !
-      !
-      REAL(wp)                    , INTENT(in) ::   pz    ! height above the sea        [m]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptz   ! air temperature at pz m     [K]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pdt   ! ptz - sst                   [K]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqz   ! air temperature at pz m [kg/kg]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pdq   ! pqz - ssq               [kg/kg]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pub   ! bulk wind speed           [m/s]
-      !!----------------------------------------------------------------------------------
-      !
-      Ri_bulk =   grav*pz/(pub*pub)                                          &
-         &      * ( pdt/(ptz - 0.5_wp*(pdt + grav*pz/(Cp_dry+Cp_vap*pqz)))   &
-         &          + rctv0*pdq )
-      !
-   END FUNCTION Ri_bulk
-
-
-   FUNCTION visc_air(ptak)
-      !!----------------------------------------------------------------------------------
-      !! Air kinetic viscosity (m^2/s) given from temperature in degrees...
-      !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
-      !!----------------------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj)             ::   visc_air   !
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak       ! air temperature in (K)
-      !
-      INTEGER  ::   ji, jj      ! dummy loop indices
-      REAL(wp) ::   ztc, ztc2   ! local scalar
-      !!----------------------------------------------------------------------------------
-      !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            ztc  = ptak(ji,jj) - rt0   ! air temp, in deg. C
-            ztc2 = ztc*ztc
-            visc_air(ji,jj) = 1.326e-5*(1. + 6.542E-3*ztc + 8.301e-6*ztc2 - 4.84e-9*ztc2*ztc)
-         END DO
-      END DO
-      !
-   END FUNCTION visc_air
 
    !!======================================================================
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcblk_algo_ncar.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcblk_algo_ncar.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcblk_algo_ncar.F90	(revision 12928)
@@ -11,5 +11,5 @@
    !!
    !!       Routine turb_ncar maintained and developed in AeroBulk
-   !!                     (http://aerobulk.sourceforge.net/)
+   !!                     (https://github.com/brodeau/aerobulk/)
    !!
    !!                         L. Brodeau, 2015
@@ -38,13 +38,15 @@
    USE lib_fortran     ! to use key_nosignedzero
 
+   USE sbcblk_phy      ! all thermodynamics functions, rho_air, q_sat, etc... !LB
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC ::   TURB_NCAR   ! called by sbcblk.F90
-
-   !                              ! NCAR own values for given constants:
-   REAL(wp), PARAMETER ::   rctv0 = 0.608   ! constant to obtain virtual temperature...
-   
+   PUBLIC :: TURB_NCAR   ! called by sbcblk.F90
+
+   INTEGER , PARAMETER ::   nb_itt = 5        ! number of itterations
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+
    !!----------------------------------------------------------------------
 CONTAINS
@@ -61,30 +63,14 @@
       !!                Returns the effective bulk wind speed at 10m to be used in the bulk formulas
       !!
-      !! ** Method : Monin Obukhov Similarity Theory
-      !!             + Large & Yeager (2004,2008) closure: CD_n10 = f(U_n10)
-      !!
-      !! ** References :   Large & Yeager, 2004 / Large & Yeager, 2008
-      !!
-      !! ** Last update: Laurent Brodeau, June 2014:
-      !!    - handles both cases zt=zu and zt/=zu
-      !!    - optimized: less 2D arrays allocated and less operations
-      !!    - better first guess of stability by checking air-sea difference of virtual temperature
-      !!       rather than temperature difference only...
-      !!    - added function "cd_neutral_10m" that uses the improved parametrization of
-      !!      Large & Yeager 2008. Drag-coefficient reduction for Cyclone conditions!
-      !!    - using code-wide physical constants defined into "phycst.mod" rather than redifining them
-      !!      => 'vkarmn' and 'grav'
-      !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
       !!
       !! INPUT :
       !! -------
       !!    *  zt   : height for temperature and spec. hum. of air            [m]
-      !!    *  zu   : height for wind speed (generally 10m)                   [m]
-      !!    *  U_zu : scalar wind speed at 10m                                [m/s]
-      !!    *  sst  : SST                                                     [K]
+      !!    *  zu   : height for wind speed (usually 10m)                     [m]
+      !!    *  sst  : bulk SST                                                [K]
       !!    *  t_zt : potential air temperature at zt                         [K]
       !!    *  ssq  : specific humidity at saturation at SST                  [kg/kg]
       !!    *  q_zt : specific humidity of air at zt                          [kg/kg]
+      !!    *  U_zu : scalar wind speed at zu                                 [m/s]
       !!
       !!
@@ -96,5 +82,8 @@
       !!    *  t_zu   : pot. air temperature adjusted at wind height zu       [K]
       !!    *  q_zu   : specific humidity of air        //                    [kg/kg]
-      !!    *  U_blk  : bulk wind at 10m                                      [m/s]
+      !!    *  U_blk  : bulk wind speed at zu                                 [m/s]
+      !!
+      !!
+      !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/)
       !!----------------------------------------------------------------------------------
       REAL(wp), INTENT(in   )                     ::   zt       ! height for t_zt and q_zt                    [m]
@@ -103,5 +92,5 @@
       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   t_zt     ! potential air temperature              [Kelvin]
       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   ssq      ! sea surface specific humidity           [kg/kg]
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity                   [kg/kg]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity at zt             [kg/kg]
       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   U_zu     ! relative wind module at zu                [m/s]
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cd       ! transfer coefficient for momentum         (tau)
@@ -110,10 +99,9 @@
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   t_zu     ! pot. air temp. adjusted at zu               [K]
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg]
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind at 10m                          [m/s]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind speed at zu                     [m/s]
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cdn, Chn, Cen ! neutral transfer coefficients
       !
-      INTEGER ::   j_itt
-      LOGICAL ::   l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U
-      INTEGER , PARAMETER ::   nb_itt = 4       ! number of itterations
+      INTEGER :: j_itt
+      LOGICAL :: l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U
       !
       REAL(wp), DIMENSION(jpi,jpj) ::   Cx_n10        ! 10m neutral latent/sensible coefficient
@@ -124,13 +112,11 @@
       REAL(wp), DIMENSION(jpi,jpj) ::   stab          ! stability test integer
       !!----------------------------------------------------------------------------------
-      !
-      l_zt_equal_zu = .FALSE.
-      IF( ABS(zu - zt) < 0.01 ) l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision
-
-      U_blk = MAX( 0.5 , U_zu )   !  relative wind speed at zu (normally 10m), we don't want to fall under 0.5 m/s
+      l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision
+
+      U_blk = MAX( 0.5_wp , U_zu )   !  relative wind speed at zu (normally 10m), we don't want to fall under 0.5 m/s
 
       !! First guess of stability:
-      ztmp0 = t_zt*(1. + rctv0*q_zt) - sst*(1. + rctv0*ssq) ! air-sea difference of virtual pot. temp. at zt
-      stab  = 0.5 + sign(0.5,ztmp0)                           ! stab = 1 if dTv > 0  => STABLE, 0 if unstable
+      ztmp0 = virt_temp(t_zt, q_zt) - virt_temp(sst, ssq) ! air-sea difference of virtual pot. temp. at zt
+      stab  = 0.5_wp + sign(0.5_wp,ztmp0)                           ! stab = 1 if dTv > 0  => STABLE, 0 if unstable
 
       !! Neutral coefficients at 10m:
@@ -139,5 +125,5 @@
          ztmp0   (:,:) = cdn_wave(:,:)
       ELSE
-         ztmp0 = cd_neutral_10m( U_blk )
+      ztmp0 = cd_neutral_10m( U_blk )
       ENDIF
 
@@ -146,15 +132,19 @@
       !! Initializing transf. coeff. with their first guess neutral equivalents :
       Cd = ztmp0
-      Ce = 1.e-3*( 34.6 * sqrt_Cd_n10 )
-      Ch = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1. - stab))
+      Ce = 1.e-3_wp*( 34.6_wp * sqrt_Cd_n10 )
+      Ch = 1.e-3_wp*sqrt_Cd_n10*(18._wp*stab + 32.7_wp*(1._wp - stab))
       stab = sqrt_Cd_n10   ! Temporaty array !!! stab == SQRT(Cd)
  
-      IF( ln_cdgw )   Cen = Ce  ; Chn = Ch
-
-      !! Initializing values at z_u with z_t values:
-      t_zu = t_zt   ;   q_zu = q_zt
-
-      !!  * Now starting iteration loop
-      DO j_itt=1, nb_itt
+      IF( ln_cdgw ) THEN
+	Cen = Ce
+	Chn = Ch
+      ENDIF
+
+      !! First guess of temperature and humidity at height zu:
+      t_zu = MAX( t_zt ,  180._wp )   ! who knows what's given on masked-continental regions...
+      q_zu = MAX( q_zt , 1.e-6_wp )   !               "
+
+      !! ITERATION BLOCK
+      DO j_itt = 1, nb_itt
          !
          ztmp1 = t_zu - sst   ! Updating air/sea differences
@@ -162,15 +152,14 @@
 
          ! Updating turbulent scales :   (L&Y 2004 eq. (7))
-         ztmp1  = Ch/stab*ztmp1    ! theta*   (stab == SQRT(Cd))
-         ztmp2  = Ce/stab*ztmp2    ! q*       (stab == SQRT(Cd))
-
-         ztmp0 = 1. + rctv0*q_zu      ! multiply this with t and you have the virtual temperature
+         ztmp0 = stab*U_blk       ! u*       (stab == SQRT(Cd))
+         ztmp1 = Ch/stab*ztmp1    ! theta*   (stab == SQRT(Cd))
+         ztmp2 = Ce/stab*ztmp2    ! q*       (stab == SQRT(Cd))
 
          ! Estimate the inverse of Monin-Obukov length (1/L) at height zu:
-         ztmp0 =  (grav*vkarmn/(t_zu*ztmp0)*(ztmp1*ztmp0 + rctv0*t_zu*ztmp2)) / (Cd*U_blk*U_blk)
-         !                                                      ( Cd*U_blk*U_blk is U*^2 at zu )
-
+         ztmp0 = One_on_L( t_zu, q_zu, ztmp0, ztmp1, ztmp2 )
+         
          !! Stability parameters :
-         zeta_u   = zu*ztmp0   ;  zeta_u = sign( min(abs(zeta_u),10.0), zeta_u )
+         zeta_u   = zu*ztmp0
+         zeta_u = sign( min(abs(zeta_u),10._wp), zeta_u )
          zpsi_h_u = psi_h( zeta_u )
 
@@ -178,54 +167,59 @@
          IF( .NOT. l_zt_equal_zu ) THEN
             !! Array 'stab' is free for the moment so using it to store 'zeta_t'
-            stab = zt*ztmp0 ;  stab = SIGN( MIN(ABS(stab),10.0), stab )  ! Temporaty array stab == zeta_t !!!
+            stab = zt*ztmp0
+            stab = SIGN( MIN(ABS(stab),10._wp), stab )  ! Temporaty array stab == zeta_t !!!
             stab = LOG(zt/zu) + zpsi_h_u - psi_h(stab)                   ! stab just used as temp array again!
             t_zu = t_zt - ztmp1/vkarmn*stab    ! ztmp1 is still theta*  L&Y 2004 eq.(9b)
             q_zu = q_zt - ztmp2/vkarmn*stab    ! ztmp2 is still q*      L&Y 2004 eq.(9c)
-            q_zu = max(0., q_zu)
-         END IF
-
+            q_zu = max(0._wp, q_zu)
+         ENDIF
+
+         ! Update neutral wind speed at 10m and neutral Cd at 10m (L&Y 2004 eq. 9a)...
+         !   In very rare low-wind conditions, the old way of estimating the
+         !   neutral wind speed at 10m leads to a negative value that causes the code
+         !   to crash. To prevent this a threshold of 0.25m/s is imposed.
          ztmp2 = psi_m(zeta_u)
          IF( ln_cdgw ) THEN      ! surface wave case
             stab = vkarmn / ( vkarmn / sqrt_Cd_n10 - ztmp2 )  ! (stab == SQRT(Cd))
             Cd   = stab * stab
-            ztmp0 = (LOG(zu/10.) - zpsi_h_u) / vkarmn / sqrt_Cd_n10
+            ztmp0 = (LOG(zu/10._wp) - zpsi_h_u) / vkarmn / sqrt_Cd_n10
             ztmp2 = stab / sqrt_Cd_n10   ! (stab == SQRT(Cd))
-            ztmp1 = 1. + Chn * ztmp0     
+            ztmp1 = 1._wp + Chn * ztmp0     
             Ch    = Chn * ztmp2 / ztmp1  ! L&Y 2004 eq. (10b)
-            ztmp1 = 1. + Cen * ztmp0
+            ztmp1 = 1._wp + Cen * ztmp0
             Ce    = Cen * ztmp2 / ztmp1  ! L&Y 2004 eq. (10c)
 
          ELSE
-            ! Update neutral wind speed at 10m and neutral Cd at 10m (L&Y 2004 eq. 9a)...
-            !   In very rare low-wind conditions, the old way of estimating the
-            !   neutral wind speed at 10m leads to a negative value that causes the code
-            !   to crash. To prevent this a threshold of 0.25m/s is imposed.
-            ztmp0 = MAX( 0.25 , U_blk/(1. + sqrt_Cd_n10/vkarmn*(LOG(zu/10.) - ztmp2)) ) ! U_n10 (ztmp2 == psi_m(zeta_u))
-            ztmp0 = cd_neutral_10m(ztmp0)                                               ! Cd_n10
-            Cdn(:,:) = ztmp0
-            sqrt_Cd_n10 = sqrt(ztmp0)
-
-            stab    = 0.5 + sign(0.5,zeta_u)                           ! update stability
-            Cx_n10  = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1. - stab))  ! L&Y 2004 eq. (6c-6d)    (Cx_n10 == Ch_n10)
-            Chn(:,:) = Cx_n10
-
-            !! Update of transfer coefficients:
-            ztmp1 = 1. + sqrt_Cd_n10/vkarmn*(LOG(zu/10.) - ztmp2)   ! L&Y 2004 eq. (10a) (ztmp2 == psi_m(zeta_u))
-            Cd      = ztmp0 / ( ztmp1*ztmp1 )
-            stab = SQRT( Cd ) ! Temporary array !!! (stab == SQRT(Cd))
-
-            ztmp0 = (LOG(zu/10.) - zpsi_h_u) / vkarmn / sqrt_Cd_n10
-            ztmp2 = stab / sqrt_Cd_n10   ! (stab == SQRT(Cd))
-            ztmp1 = 1. + Cx_n10*ztmp0    ! (Cx_n10 == Ch_n10)
-            Ch  = Cx_n10*ztmp2 / ztmp1   ! L&Y 2004 eq. (10b)
-
-            Cx_n10  = 1.e-3 * (34.6 * sqrt_Cd_n10)  ! L&Y 2004 eq. (6b)    ! Cx_n10 == Ce_n10
-            Cen(:,:) = Cx_n10
-            ztmp1 = 1. + Cx_n10*ztmp0
-            Ce  = Cx_n10*ztmp2 / ztmp1  ! L&Y 2004 eq. (10c)
-            ENDIF
-         !
-      END DO
-      !
+         ! Update neutral wind speed at 10m and neutral Cd at 10m (L&Y 2004 eq. 9a)...
+         !   In very rare low-wind conditions, the old way of estimating the
+         !   neutral wind speed at 10m leads to a negative value that causes the code
+         !   to crash. To prevent this a threshold of 0.25m/s is imposed.
+         ztmp0 = MAX( 0.25_wp , U_blk/(1._wp + sqrt_Cd_n10/vkarmn*(LOG(zu/10._wp) - ztmp2)) ) ! U_n10 (ztmp2 == psi_m(zeta_u))
+         ztmp0 = cd_neutral_10m(ztmp0)                                               ! Cd_n10
+         Cdn(:,:) = ztmp0
+         sqrt_Cd_n10 = sqrt(ztmp0)
+
+         stab    = 0.5_wp + sign(0.5_wp,zeta_u)                        ! update stability
+         Cx_n10  = 1.e-3_wp*sqrt_Cd_n10*(18._wp*stab + 32.7_wp*(1._wp - stab))  ! L&Y 2004 eq. (6c-6d)    (Cx_n10 == Ch_n10)
+         Chn(:,:) = Cx_n10
+
+         !! Update of transfer coefficients:
+         ztmp1 = 1._wp + sqrt_Cd_n10/vkarmn*(LOG(zu/10._wp) - ztmp2)   ! L&Y 2004 eq. (10a) (ztmp2 == psi_m(zeta_u))
+         Cd      = ztmp0 / ( ztmp1*ztmp1 )
+         stab = SQRT( Cd ) ! Temporary array !!! (stab == SQRT(Cd))
+
+         ztmp0 = (LOG(zu/10._wp) - zpsi_h_u) / vkarmn / sqrt_Cd_n10
+         ztmp2 = stab / sqrt_Cd_n10   ! (stab == SQRT(Cd))
+         ztmp1 = 1._wp + Cx_n10*ztmp0    ! (Cx_n10 == Ch_n10)
+         Ch  = Cx_n10*ztmp2 / ztmp1   ! L&Y 2004 eq. (10b)
+
+         Cx_n10  = 1.e-3_wp * (34.6_wp * sqrt_Cd_n10)  ! L&Y 2004 eq. (6b)    ! Cx_n10 == Ce_n10
+         Cen(:,:) = Cx_n10
+         ztmp1 = 1._wp + Cx_n10*ztmp0
+         Ce  = Cx_n10*ztmp2 / ztmp1  ! L&Y 2004 eq. (10c)
+         ENDIF
+
+      END DO !DO j_itt = 1, nb_itt
+
    END SUBROUTINE turb_ncar
 
@@ -238,5 +232,5 @@
       !! Origin: Large & Yeager 2008 eq.(11a) and eq.(11b)
       !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
+      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
       !!----------------------------------------------------------------------------------
       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pw10           ! scalar wind speed at 10m (m/s)
@@ -247,22 +241,20 @@
       !!----------------------------------------------------------------------------------
       !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            !
-            zw  = pw10(ji,jj)
-            zw6 = zw*zw*zw
-            zw6 = zw6*zw6
-            !
-            ! When wind speed > 33 m/s => Cyclone conditions => special treatment
-            zgt33 = 0.5 + SIGN( 0.5, (zw - 33.) )   ! If pw10 < 33. => 0, else => 1
-            !
-            cd_neutral_10m(ji,jj) = 1.e-3 * ( &
-               &       (1. - zgt33)*( 2.7/zw + 0.142 + zw/13.09 - 3.14807E-10*zw6) & ! wind <  33 m/s
-               &      +    zgt33   *      2.34 )                                     ! wind >= 33 m/s
-            !
-            cd_neutral_10m(ji,jj) = MAX(cd_neutral_10m(ji,jj), 1.E-6)
-            !
-         END DO
-      END DO
+      DO_2D_11_11
+         !
+         zw  = pw10(ji,jj)
+         zw6 = zw*zw*zw
+         zw6 = zw6*zw6
+         !
+         ! When wind speed > 33 m/s => Cyclone conditions => special treatment
+         zgt33 = 0.5_wp + SIGN( 0.5_wp, (zw - 33._wp) )   ! If pw10 < 33. => 0, else => 1
+         !
+         cd_neutral_10m(ji,jj) = 1.e-3_wp * ( &
+            &       (1._wp - zgt33)*( 2.7_wp/zw + 0.142_wp + zw/13.09_wp - 3.14807E-10_wp*zw6) & ! wind <  33 m/s
+            &      +    zgt33   *      2.34_wp )                                                 ! wind >= 33 m/s
+         !
+         cd_neutral_10m(ji,jj) = MAX(cd_neutral_10m(ji,jj), 1.E-6_wp)
+         !
+      END_2D
       !
    END FUNCTION cd_neutral_10m
@@ -273,31 +265,27 @@
       !! Universal profile stability function for momentum
       !!    !! Psis, L&Y 2004 eq. (8c), (8d), (8e)
-      !!     
-      !! pzet0 : stability paramenter, z/L where z is altitude measurement                                          
+      !!
+      !! pzeta : stability paramenter, z/L where z is altitude measurement
       !!         and L is M-O length
       !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
-      !!----------------------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pzeta
-      REAL(wp), DIMENSION(jpi,jpj)             ::   psi_m
-      !
-      INTEGER  ::   ji, jj         ! dummy loop indices
+      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
+      !!----------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj) :: psi_m
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
+      !
+      INTEGER  ::   ji, jj    ! dummy loop indices
       REAL(wp) :: zx2, zx, zstab   ! local scalars
       !!----------------------------------------------------------------------------------
-      !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zx2 = SQRT( ABS( 1. - 16.*pzeta(ji,jj) ) )
-            zx2 = MAX ( zx2 , 1. )
-            zx  = SQRT( zx2 )
-            zstab = 0.5 + SIGN( 0.5 , pzeta(ji,jj) )
-            !
-            psi_m(ji,jj) =        zstab  * (-5.*pzeta(ji,jj))       &          ! Stable
-               &          + (1. - zstab) * (2.*LOG((1. + zx)*0.5)   &          ! Unstable
-               &               + LOG((1. + zx2)*0.5) - 2.*ATAN(zx) + rpi*0.5)  !    "
-            !
-         END DO
-      END DO
-      !
+      DO_2D_11_11
+         zx2 = SQRT( ABS( 1._wp - 16._wp*pzeta(ji,jj) ) )
+         zx2 = MAX( zx2 , 1._wp )
+         zx  = SQRT( zx2 )
+         zstab = 0.5_wp + SIGN( 0.5_wp , pzeta(ji,jj) )
+         !
+         psi_m(ji,jj) =        zstab  * (-5._wp*pzeta(ji,jj))       &          ! Stable
+            &          + (1._wp - zstab) * (2._wp*LOG((1._wp + zx)*0.5_wp)   &          ! Unstable
+            &               + LOG((1._wp + zx2)*0.5_wp) - 2._wp*ATAN(zx) + rpi*0.5_wp)  !    "
+         !
+      END_2D
    END FUNCTION psi_m
 
@@ -308,28 +296,25 @@
       !!    !! Psis, L&Y 2004 eq. (8c), (8d), (8e)
       !!
-      !! pzet0 : stability paramenter, z/L where z is altitude measurement                                          
+      !! pzeta : stability paramenter, z/L where z is altitude measurement
       !!         and L is M-O length
       !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
-      !!----------------------------------------------------------------------------------
+      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
+      !!----------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj) :: psi_h
       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
-      REAL(wp), DIMENSION(jpi,jpj)             :: psi_h
-      !
-      INTEGER  ::   ji, jj    ! dummy loop indices
+      !
+      INTEGER  ::   ji, jj     ! dummy loop indices
       REAL(wp) :: zx2, zstab  ! local scalars
       !!----------------------------------------------------------------------------------
       !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zx2 = SQRT( ABS( 1. - 16.*pzeta(ji,jj) ) )
-            zx2 = MAX ( zx2 , 1. )
-            zstab = 0.5 + SIGN( 0.5 , pzeta(ji,jj) )
-            !
-            psi_h(ji,jj) =         zstab  * (-5.*pzeta(ji,jj))        &  ! Stable
-               &           + (1. - zstab) * (2.*LOG( (1. + zx2)*0.5 ))   ! Unstable
-            !
-         END DO
-      END DO
-      !
+      DO_2D_11_11
+         zx2 = SQRT( ABS( 1._wp - 16._wp*pzeta(ji,jj) ) )
+         zx2 = MAX( zx2 , 1._wp )
+         zstab = 0.5_wp + SIGN( 0.5_wp , pzeta(ji,jj) )
+         !
+         psi_h(ji,jj) =         zstab  * (-5._wp*pzeta(ji,jj))        &  ! Stable
+            &           + (1._wp - zstab) * (2._wp*LOG( (1._wp + zx2)*0.5_wp ))   ! Unstable
+         !
+      END_2D
    END FUNCTION psi_h
 
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcblk_phy.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcblk_phy.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcblk_phy.F90	(revision 12928)
@@ -0,0 +1,669 @@
+MODULE sbcblk_phy
+   !!======================================================================
+   !!                       ***  MODULE  sbcblk_phy  ***
+   !! A set of functions to compute air themodynamics parameters
+   !!                     needed by Aerodynamic Bulk Formulas
+   !!=====================================================================
+   !!            4.0  !  2019 L. Brodeau from AeroBulk package (https://github.com/brodeau/aerobulk/)
+   !!----------------------------------------------------------------------
+
+   !!   virt_temp     : virtual (aka sensible) temperature (potential or absolute)
+   !!   rho_air       : density of (moist) air (depends on T_air, q_air and SLP
+   !!   visc_air      : kinematic viscosity (aka Nu_air) of air from temperature
+   !!   L_vap         : latent heat of vaporization of water as a function of temperature
+   !!   cp_air        : specific heat of (moist) air (depends spec. hum. q_air)
+   !!   gamma_moist   : adiabatic lapse-rate of moist air
+   !!   One_on_L      : 1. / ( Monin-Obukhov length )
+   !!   Ri_bulk       : bulk Richardson number aka BRN
+   !!   q_sat         : saturation humidity as a function of SLP and temperature
+   !!   q_air_rh      : specific humidity as a function of RH (fraction, not %), t_air and SLP
+
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !!  (mainly removed from sbcblk.F90)
+   REAL(wp), PARAMETER, PUBLIC :: rCp_dry = 1005.0_wp   !: Specic heat of dry air, constant pressure      [J/K/kg]
+   REAL(wp), PARAMETER, PUBLIC :: rCp_vap = 1860.0_wp   !: Specic heat of water vapor, constant pressure  [J/K/kg]
+   REAL(wp), PARAMETER, PUBLIC :: R_dry   = 287.05_wp   !: Specific gas constant for dry air              [J/K/kg]
+   REAL(wp), PARAMETER, PUBLIC :: R_vap   = 461.495_wp  !: Specific gas constant for water vapor          [J/K/kg]
+   REAL(wp), PARAMETER, PUBLIC :: reps0   = R_dry/R_vap !: ratio of gas constant for dry air and water vapor => ~ 0.622
+   REAL(wp), PARAMETER, PUBLIC :: rctv0   = R_vap/R_dry - 1._wp  !: for virtual temperature (== (1-eps)/eps) => ~ 0.608
+   REAL(wp), PARAMETER, PUBLIC :: rCp_air = 1000.5_wp   !: specific heat of air (only used for ice fluxes now...)
+   REAL(wp), PARAMETER, PUBLIC :: rCd_ice = 1.4e-3_wp   !: transfer coefficient over ice
+   REAL(wp), PARAMETER, PUBLIC :: albo    = 0.066_wp    !: ocean albedo assumed to be constant
+   !
+   REAL(wp), PARAMETER, PUBLIC :: rho0_a  = 1.2_wp      !: Approx. of density of air                       [kg/m^3]
+   REAL(wp), PARAMETER, PUBLIC :: rho0_w  = 1025._wp    !: Density of sea-water  (ECMWF->1025)             [kg/m^3]
+   REAL(wp), PARAMETER, PUBLIC :: radrw = rho0_a/rho0_w !: Density ratio
+   REAL(wp), PARAMETER, PUBLIC :: sq_radrw = SQRT(rho0_a/rho0_w)
+   REAL(wp), PARAMETER, PUBLIC :: rCp0_w  = 4190._wp    !: Specific heat capacity of seawater (ECMWF 4190) [J/K/kg]
+   REAL(wp), PARAMETER, PUBLIC :: rnu0_w  = 1.e-6_wp    !: kinetic viscosity of water                      [m^2/s]
+   REAL(wp), PARAMETER, PUBLIC :: rk0_w   = 0.6_wp      !: thermal conductivity of water (at 20C)          [W/m/K]
+   !
+   REAL(wp), PARAMETER, PUBLIC :: emiss_w = 1._wp       !: Surface emissivity (black-body long-wave radiation) of sea-water []
+   !                                                    !: Theoretically close to 0.97! Yet, taken equal as 1 to account for
+   !                                                    !: the small fraction of downwelling longwave reflected at the
+   !                                                    !: surface (Lind & Katsaros, 1986)
+   REAL(wp), PARAMETER, PUBLIC :: rdct_qsat_salt = 0.98_wp  !: reduction factor on specific humidity at saturation (q_sat(T_s)) due to salt
+   REAL(wp), PARAMETER, PUBLIC :: rtt0 = 273.16_wp        !: triple point of temperature    [K]
+   !
+   REAL(wp), PARAMETER, PUBLIC :: rcst_cs = -16._wp*9.80665_wp*rho0_w*rCp0_w*rnu0_w*rnu0_w*rnu0_w/(rk0_w*rk0_w) !: for cool-skin parameterizations... (grav = 9.80665_wp)
+   !                              => see eq.(14) in Fairall et al. 1996   (eq.(6) of Zeng aand Beljaars is WRONG! (typo?)
+
+
+   INTERFACE gamma_moist
+      MODULE PROCEDURE gamma_moist_vctr, gamma_moist_sclr
+   END INTERFACE gamma_moist
+
+   INTERFACE e_sat
+      MODULE PROCEDURE e_sat_vctr, e_sat_sclr
+   END INTERFACE e_sat
+
+   INTERFACE L_vap
+      MODULE PROCEDURE L_vap_vctr, L_vap_sclr
+   END INTERFACE L_vap
+
+   INTERFACE rho_air
+      MODULE PROCEDURE rho_air_vctr, rho_air_sclr
+   END INTERFACE rho_air
+
+   INTERFACE cp_air
+      MODULE PROCEDURE cp_air_vctr, cp_air_sclr
+   END INTERFACE cp_air
+
+   INTERFACE alpha_sw
+      MODULE PROCEDURE alpha_sw_vctr, alpha_sw_sclr
+   END INTERFACE alpha_sw
+
+   INTERFACE bulk_formula
+      MODULE PROCEDURE bulk_formula_vctr, bulk_formula_sclr
+   END INTERFACE bulk_formula
+
+
+
+   PUBLIC virt_temp
+   PUBLIC rho_air
+   PUBLIC visc_air
+   PUBLIC L_vap
+   PUBLIC cp_air
+   PUBLIC gamma_moist
+   PUBLIC One_on_L
+   PUBLIC Ri_bulk
+   PUBLIC q_sat
+   PUBLIC q_air_rh
+   !:
+   PUBLIC update_qnsol_tau
+   PUBLIC alpha_sw
+   PUBLIC bulk_formula
+
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: sbcblk.F90 10535 2019-01-16 17:36:47Z clem $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   FUNCTION virt_temp( pta, pqa )
+      !!------------------------------------------------------------------------
+      !!
+      !! Compute the (absolute/potential) virtual temperature, knowing the
+      !! (absolute/potential) temperature and specific humidity
+      !!
+      !! If input temperature is absolute then output vitual temperature is absolute
+      !! If input temperature is potential then output vitual temperature is potential
+      !!
+      !! Author: L. Brodeau, June 2019 / AeroBulk
+      !!         (https://github.com/brodeau/aerobulk/)
+      !!------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj)             :: virt_temp         !: 1./(Monin Obukhov length) [m^-1]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pta,  &  !: absolute or potetntial air temperature [K]
+         &                                        pqa      !: specific humidity of air   [kg/kg]
+      !!-------------------------------------------------------------------
+      !
+      virt_temp(:,:) = pta(:,:) * (1._wp + rctv0*pqa(:,:))
+      !!
+      !! This is exactly the same sing that:
+      !! virt_temp = pta * ( pwa + reps0) / (reps0*(1.+pwa))
+      !! with wpa (mixing ration) defined as : pwa = pqa/(1.-pqa)
+      !
+   END FUNCTION virt_temp
+
+   FUNCTION rho_air_vctr( ptak, pqa, pslp )
+      !!-------------------------------------------------------------------------------
+      !!                           ***  FUNCTION rho_air_vctr  ***
+      !!
+      !! ** Purpose : compute density of (moist) air using the eq. of state of the atmosphere
+      !!
+      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
+      !!-------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak      ! air temperature             [K]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqa       ! air specific humidity   [kg/kg]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pslp      ! pressure in                [Pa]
+      REAL(wp), DIMENSION(jpi,jpj)             ::   rho_air_vctr   ! density of moist air   [kg/m^3]
+      !!-------------------------------------------------------------------------------
+      rho_air_vctr = MAX( pslp / (R_dry*ptak * ( 1._wp + rctv0*pqa )) , 0.8_wp )
+   END FUNCTION rho_air_vctr
+
+   FUNCTION rho_air_sclr( ptak, pqa, pslp )
+      !!-------------------------------------------------------------------------------
+      !!                           ***  FUNCTION rho_air_sclr  ***
+      !!
+      !! ** Purpose : compute density of (moist) air using the eq. of state of the atmosphere
+      !!
+      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
+      !!-------------------------------------------------------------------------------
+      REAL(wp), INTENT(in) :: ptak           ! air temperature             [K]
+      REAL(wp), INTENT(in) :: pqa            ! air specific humidity   [kg/kg]
+      REAL(wp), INTENT(in) :: pslp           ! pressure in                [Pa]
+      REAL(wp)             :: rho_air_sclr   ! density of moist air   [kg/m^3]
+      !!-------------------------------------------------------------------------------
+      rho_air_sclr = MAX( pslp / (R_dry*ptak * ( 1._wp + rctv0*pqa )) , 0.8_wp )
+   END FUNCTION rho_air_sclr
+
+
+
+   FUNCTION visc_air(ptak)
+      !!----------------------------------------------------------------------------------
+      !! Air kinetic viscosity (m^2/s) given from temperature in degrees...
+      !!
+      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
+      !!----------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj)             ::   visc_air   !
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak       ! air temperature in (K)
+      !
+      INTEGER  ::   ji, jj      ! dummy loop indices
+      REAL(wp) ::   ztc, ztc2   ! local scalar
+      !!----------------------------------------------------------------------------------
+      !
+      DO_2D_11_11
+         ztc  = ptak(ji,jj) - rt0   ! air temp, in deg. C
+         ztc2 = ztc*ztc
+         visc_air(ji,jj) = 1.326e-5*(1. + 6.542E-3*ztc + 8.301e-6*ztc2 - 4.84e-9*ztc2*ztc)
+      END_2D
+      !
+   END FUNCTION visc_air
+
+   FUNCTION L_vap_vctr( psst )
+      !!---------------------------------------------------------------------------------
+      !!                           ***  FUNCTION L_vap_vctr  ***
+      !!
+      !! ** Purpose : Compute the latent heat of vaporization of water from temperature
+      !!
+      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
+      !!----------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj)             ::   L_vap_vctr   ! latent heat of vaporization   [J/kg]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   psst   ! water temperature                [K]
+      !!----------------------------------------------------------------------------------
+      !
+      L_vap_vctr = (  2.501_wp - 0.00237_wp * ( psst(:,:) - rt0)  ) * 1.e6_wp
+      !
+   END FUNCTION L_vap_vctr
+
+   FUNCTION L_vap_sclr( psst )
+      !!---------------------------------------------------------------------------------
+      !!                           ***  FUNCTION L_vap_sclr  ***
+      !!
+      !! ** Purpose : Compute the latent heat of vaporization of water from temperature
+      !!
+      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
+      !!----------------------------------------------------------------------------------
+      REAL(wp)             ::   L_vap_sclr   ! latent heat of vaporization   [J/kg]
+      REAL(wp), INTENT(in) ::   psst         ! water temperature                [K]
+      !!----------------------------------------------------------------------------------
+      !
+      L_vap_sclr = (  2.501_wp - 0.00237_wp * ( psst - rt0)  ) * 1.e6_wp
+      !
+   END FUNCTION L_vap_sclr
+
+
+   FUNCTION cp_air_vctr( pqa )
+      !!-------------------------------------------------------------------------------
+      !!                           ***  FUNCTION cp_air_vctr  ***
+      !!
+      !! ** Purpose : Compute specific heat (Cp) of moist air
+      !!
+      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
+      !!-------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqa      ! air specific humidity         [kg/kg]
+      REAL(wp), DIMENSION(jpi,jpj)             ::   cp_air_vctr   ! specific heat of moist air   [J/K/kg]
+      !!-------------------------------------------------------------------------------
+      cp_air_vctr = rCp_dry + rCp_vap * pqa
+   END FUNCTION cp_air_vctr
+
+   FUNCTION cp_air_sclr( pqa )
+      !!-------------------------------------------------------------------------------
+      !!                           ***  FUNCTION cp_air_sclr  ***
+      !!
+      !! ** Purpose : Compute specific heat (Cp) of moist air
+      !!
+      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
+      !!-------------------------------------------------------------------------------
+      REAL(wp), INTENT(in) :: pqa           ! air specific humidity         [kg/kg]
+      REAL(wp)             :: cp_air_sclr   ! specific heat of moist air   [J/K/kg]
+      !!-------------------------------------------------------------------------------
+      cp_air_sclr = rCp_dry + rCp_vap * pqa
+   END FUNCTION cp_air_sclr
+
+
+
+
+
+   FUNCTION gamma_moist_vctr( ptak, pqa )
+      !!----------------------------------------------------------------------------------
+      !!                           ***  FUNCTION gamma_moist_vctr  ***
+      !!
+      !! ** Purpose : Compute the moist adiabatic lapse-rate.
+      !!     => http://glossary.ametsoc.org/wiki/Moist-adiabatic_lapse_rate
+      !!     => http://www.geog.ucsb.edu/~joel/g266_s10/lecture_notes/chapt03/oh10_3_01/oh10_3_01.html
+      !!
+      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
+      !!----------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak          ! air temperature       [K]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqa           ! specific humidity [kg/kg]
+      REAL(wp), DIMENSION(jpi,jpj)             ::   gamma_moist_vctr   ! moist adiabatic lapse-rate
+      !
+      INTEGER  ::   ji, jj         ! dummy loop indices
+      !!----------------------------------------------------------------------------------
+      DO_2D_11_11
+         gamma_moist_vctr(ji,jj) = gamma_moist_sclr( ptak(ji,jj), pqa(ji,jj) )
+      END_2D
+   END FUNCTION gamma_moist_vctr
+
+   FUNCTION gamma_moist_sclr( ptak, pqa )
+      !!----------------------------------------------------------------------------------
+      !! ** Purpose : Compute the moist adiabatic lapse-rate.
+      !!     => http://glossary.ametsoc.org/wiki/Moist-adiabatic_lapse_rate
+      !!     => http://www.geog.ucsb.edu/~joel/g266_s10/lecture_notes/chapt03/oh10_3_01/oh10_3_01.html
+      !!
+      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
+      !!----------------------------------------------------------------------------------
+      REAL(wp)             :: gamma_moist_sclr
+      REAL(wp), INTENT(in) :: ptak, pqa ! air temperature (K) and specific humidity (kg/kg)
+      !
+      REAL(wp) :: zta, zqa, zwa, ziRT        ! local scalar
+      !!----------------------------------------------------------------------------------
+      zta = MAX( ptak,  180._wp) ! prevents screw-up over masked regions where field == 0.
+      zqa = MAX( pqa,  1.E-6_wp) !    "                   "                     "
+      !!
+      zwa = zqa / (1._wp - zqa)   ! w is mixing ratio w = q/(1-q) | q = w/(1+w)
+      ziRT = 1._wp / (R_dry*zta)    ! 1/RT
+      gamma_moist_sclr = grav * ( 1._wp + rLevap*zwa*ziRT ) / ( rCp_dry + rLevap*rLevap*zwa*reps0*ziRT/zta )
+      !!
+   END FUNCTION gamma_moist_sclr
+
+   FUNCTION One_on_L( ptha, pqa, pus, pts, pqs )
+      !!------------------------------------------------------------------------
+      !!
+      !! Evaluates the 1./(Monin Obukhov length) from air temperature and
+      !!  specific humidity, and frictional scales u*, t* and q*
+      !!
+      !! Author: L. Brodeau, June 2016 / AeroBulk
+      !!         (https://github.com/brodeau/aerobulk/)
+      !!------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj)             :: One_on_L         !: 1./(Monin Obukhov length) [m^-1]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptha,  &  !: average potetntial air temperature [K]
+         &                                        pqa,   &  !: average specific humidity of air   [kg/kg]
+         &                                      pus, pts, pqs   !: frictional velocity, temperature and humidity
+      !
+      INTEGER  ::   ji, jj         ! dummy loop indices
+      REAL(wp) ::     zqa          ! local scalar
+      !!-------------------------------------------------------------------
+      !
+      DO_2D_11_11
+         !
+         zqa = (1._wp + rctv0*pqa(ji,jj))
+         !
+         ! The main concern is to know whether, the vertical turbulent flux of virtual temperature, < u' theta_v' > is estimated with:
+         !  a/  -u* [ theta* (1 + 0.61 q) + 0.61 theta q* ] => this is the one that seems correct! chose this one!
+         !                      or
+         !  b/  -u* [ theta*              + 0.61 theta q* ]
+         !
+         One_on_L(ji,jj) = grav*vkarmn*( pts(ji,jj)*zqa + rctv0*ptha(ji,jj)*pqs(ji,jj) ) &
+            &               / MAX( pus(ji,jj)*pus(ji,jj)*ptha(ji,jj)*zqa , 1.E-9_wp )
+         !
+      END_2D
+      !
+      One_on_L = SIGN( MIN(ABS(One_on_L),200._wp), One_on_L ) ! (prevent FPE from stupid values over masked regions...)
+      !
+   END FUNCTION One_on_L
+
+   FUNCTION Ri_bulk( pz, psst, ptha, pssq, pqa, pub )
+      !!----------------------------------------------------------------------------------
+      !! Bulk Richardson number according to "wide-spread equation"...
+      !!
+      !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/)
+      !!----------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj)             :: Ri_bulk
+      REAL(wp)                    , INTENT(in) :: pz    ! height above the sea (aka "delta z")  [m]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: psst  ! SST                                   [K]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptha  ! pot. air temp. at height "pz"         [K]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pssq  ! 0.98*q_sat(SST)                   [kg/kg]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqa   ! air spec. hum. at height "pz"     [kg/kg]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pub   ! bulk wind speed                     [m/s]
+      !
+      INTEGER  ::   ji, jj                                ! dummy loop indices
+      REAL(wp) ::   zqa, zta, zgamma, zdth_v, ztv, zsstv  ! local scalars
+      !!-------------------------------------------------------------------
+      !
+      DO_2D_11_11
+         !
+         zqa = 0.5_wp*(pqa(ji,jj)+pssq(ji,jj))                                        ! ~ mean q within the layer...
+         zta = 0.5_wp*( psst(ji,jj) + ptha(ji,jj) - gamma_moist(ptha(ji,jj),zqa)*pz ) ! ~ mean absolute temperature of air within the layer
+         zta = 0.5_wp*( psst(ji,jj) + ptha(ji,jj) - gamma_moist(zta,        zqa)*pz ) ! ~ mean absolute temperature of air within the layer
+         zgamma =  gamma_moist(zta, zqa)                                              ! Adiabatic lapse-rate for moist air within the layer
+         !
+         zsstv = psst(ji,jj)*(1._wp + rctv0*pssq(ji,jj)) ! absolute==potential virtual SST (absolute==potential because z=0!)
+         !
+         zdth_v = ptha(ji,jj)*(1._wp + rctv0*pqa(ji,jj)) - zsstv ! air-sea delta of "virtual potential temperature"
+         !
+         ztv = 0.5_wp*( zsstv + (ptha(ji,jj) - zgamma*pz)*(1._wp + rctv0*pqa(ji,jj)) )  ! ~ mean absolute virtual temp. within the layer
+         !
+         Ri_bulk(ji,jj) = grav*zdth_v*pz / ( ztv*pub(ji,jj)*pub(ji,jj) )                            ! the usual definition of Ri_bulk
+         !
+      END_2D
+   END FUNCTION Ri_bulk
+
+
+   FUNCTION e_sat_vctr(ptak)
+      !!**************************************************
+      !! ptak:     air temperature [K]
+      !! e_sat:  water vapor at saturation [Pa]
+      !!
+      !! Recommended by WMO
+      !!
+      !! Goff, J. A., 1957: Saturation pressure of water on the new kelvin
+      !! temperature scale. Transactions of the American society of heating
+      !! and ventilating engineers, 347–354.
+      !!
+      !! rt0 should be 273.16 (triple point of water) and not 273.15 like here
+      !!**************************************************
+
+      REAL(wp), DIMENSION(jpi,jpj)             :: e_sat_vctr !: vapour pressure at saturation  [Pa]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptak    !: temperature (K)
+
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ztmp
+
+      ALLOCATE ( ztmp(jpi,jpj) )
+
+      ztmp(:,:) = rtt0/ptak(:,:)
+
+      e_sat_vctr = 100.*( 10.**(10.79574*(1. - ztmp) - 5.028*LOG10(ptak/rtt0)         &
+         &       + 1.50475*10.**(-4)*(1. - 10.**(-8.2969*(ptak/rtt0 - 1.)) )   &
+         &       + 0.42873*10.**(-3)*(10.**(4.76955*(1. - ztmp)) - 1.) + 0.78614) )
+
+      DEALLOCATE ( ztmp )
+
+   END FUNCTION e_sat_vctr
+
+
+   FUNCTION e_sat_sclr( ptak )
+      !!----------------------------------------------------------------------------------
+      !!                   ***  FUNCTION e_sat_sclr  ***
+      !!                  < SCALAR argument version >
+      !! ** Purpose : water vapor at saturation in [Pa]
+      !!              Based on accurate estimate by Goff, 1957
+      !!
+      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
+      !!
+      !!    Note: what rt0 should be here, is 273.16 (triple point of water) and not 273.15 like here
+      !!----------------------------------------------------------------------------------
+      REAL(wp), INTENT(in) ::   ptak    ! air temperature                  [K]
+      REAL(wp)             ::   e_sat_sclr   ! water vapor at saturation   [kg/kg]
+      !
+      REAL(wp) ::   zta, ztmp   ! local scalar
+      !!----------------------------------------------------------------------------------
+      !
+      zta = MAX( ptak , 180._wp )   ! air temp., prevents fpe0 errors dute to unrealistically low values over masked regions...
+      ztmp = rt0 / zta
+      !
+      ! Vapour pressure at saturation [Pa] : WMO, (Goff, 1957)
+      e_sat_sclr = 100.*( 10.**( 10.79574*(1. - ztmp) - 5.028*LOG10(zta/rt0)        &
+         &    + 1.50475*10.**(-4)*(1. - 10.**(-8.2969*(zta/rt0 - 1.)) )  &
+         &    + 0.42873*10.**(-3)*(10.**(4.76955*(1. - ztmp)) - 1.) + 0.78614) )
+      !
+   END FUNCTION e_sat_sclr
+
+
+   FUNCTION q_sat( ptak, pslp )
+      !!----------------------------------------------------------------------------------
+      !!                           ***  FUNCTION q_sat  ***
+      !!
+      !! ** Purpose : Specific humidity at saturation in [kg/kg]
+      !!              Based on accurate estimate of "e_sat"
+      !!              aka saturation water vapor (Goff, 1957)
+      !!
+      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
+      !!----------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak    ! air temperature                       [K]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pslp    ! sea level atmospheric pressure       [Pa]
+      REAL(wp), DIMENSION(jpi,jpj)             ::   q_sat   ! Specific humidity at saturation   [kg/kg]
+      !
+      INTEGER  ::   ji, jj         ! dummy loop indices
+      REAL(wp) ::   ze_sat   ! local scalar
+      !!----------------------------------------------------------------------------------
+      !
+      DO_2D_11_11
+         !
+         ze_sat =  e_sat_sclr( ptak(ji,jj) )
+         !
+         q_sat(ji,jj) = reps0 * ze_sat/( pslp(ji,jj) - (1._wp - reps0)*ze_sat )
+         !
+      END_2D
+      !
+   END FUNCTION q_sat
+
+   FUNCTION q_air_rh(prha, ptak, pslp)
+      !!----------------------------------------------------------------------------------
+      !! Specific humidity of air out of Relative Humidity
+      !!
+      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
+      !!----------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj)             :: q_air_rh
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: prha        !: relative humidity      [fraction, not %!!!]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptak        !: air temperature        [K]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pslp        !: atmospheric pressure   [Pa]
+      !
+      INTEGER  ::   ji, jj      ! dummy loop indices
+      REAL(wp) ::   ze      ! local scalar
+      !!----------------------------------------------------------------------------------
+      !
+      DO_2D_11_11
+         ze = prha(ji,jj)*e_sat_sclr(ptak(ji,jj))
+         q_air_rh(ji,jj) = ze*reps0/(pslp(ji,jj) - (1. - reps0)*ze)
+      END_2D
+      !
+   END FUNCTION q_air_rh
+
+
+   SUBROUTINE UPDATE_QNSOL_TAU( pzu, pTs, pqs, pTa, pqa, pust, ptst, pqst, pwnd, pUb, pslp, prlw, &
+      &                         pQns, pTau,  &
+      &                         Qlat)
+      !!----------------------------------------------------------------------------------
+      !! Purpose: returns the non-solar heat flux to the ocean aka "Qlat + Qsen + Qlw"
+      !!          and the module of the wind stress => pTau = Tau
+      !! ** Author: L. Brodeau, Sept. 2019 / AeroBulk (https://github.com/brodeau/aerobulk/)
+      !!----------------------------------------------------------------------------------
+      REAL(wp),                     INTENT(in)  :: pzu  ! height above the sea-level where all this takes place (normally 10m)
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pTs  ! water temperature at the air-sea interface [K]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pqs  ! satur. spec. hum. at T=pTs   [kg/kg]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pTa  ! potential air temperature at z=pzu [K]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pqa  ! specific humidity at z=pzu [kg/kg]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pust ! u*
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: ptst ! t*
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pqst ! q*
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pwnd ! wind speed module at z=pzu [m/s]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pUb  ! bulk wind speed at z=pzu (inc. pot. effect of gustiness etc) [m/s]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pslp ! sea-level atmospheric pressure [Pa]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: prlw ! downwelling longwave radiative flux [W/m^2]
+      !
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(out) :: pQns ! non-solar heat flux to the ocean aka "Qlat + Qsen + Qlw" [W/m^2]]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(out) :: pTau ! module of the wind stress [N/m^2]
+      !
+      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(out) :: Qlat
+      !
+      REAL(wp) :: zdt, zdq, zCd, zCh, zCe, zTs2, zz0, &
+         &        zQlat, zQsen, zQlw
+      INTEGER  ::   ji, jj     ! dummy loop indices
+      !!----------------------------------------------------------------------------------
+      DO_2D_11_11
+
+         zdt = pTa(ji,jj) - pTs(ji,jj) ;  zdt = SIGN( MAX(ABS(zdt),1.E-6_wp), zdt )
+         zdq = pqa(ji,jj) - pqs(ji,jj) ;  zdq = SIGN( MAX(ABS(zdq),1.E-9_wp), zdq )
+         zz0 = pust(ji,jj)/pUb(ji,jj)
+         zCd = zz0*zz0
+         zCh = zz0*ptst(ji,jj)/zdt
+         zCe = zz0*pqst(ji,jj)/zdq
+
+         CALL BULK_FORMULA_SCLR( pzu, pTs(ji,jj), pqs(ji,jj), pTa(ji,jj), pqa(ji,jj), &
+            &                    zCd, zCh, zCe,                                       &
+            &                    pwnd(ji,jj), pUb(ji,jj), pslp(ji,jj),                &
+            &                    pTau(ji,jj), zQsen, zQlat )
+         
+         zTs2  = pTs(ji,jj)*pTs(ji,jj)
+         zQlw  = emiss_w*(prlw(ji,jj) - stefan*zTs2*zTs2) ! Net longwave flux
+
+         pQns(ji,jj) = zQlat + zQsen + zQlw
+
+         IF( PRESENT(Qlat) ) Qlat(ji,jj) = zQlat
+      END_2D
+   END SUBROUTINE UPDATE_QNSOL_TAU
+
+
+   SUBROUTINE BULK_FORMULA_SCLR( pzu, pTs, pqs, pTa, pqa, &
+      &                          pCd, pCh, pCe,           &
+      &                          pwnd, pUb, pslp,         &
+      &                          pTau, pQsen, pQlat,      &
+      &                          pEvap, prhoa, pfact_evap )
+      !!----------------------------------------------------------------------------------
+      REAL(wp),                     INTENT(in)  :: pzu  ! height above the sea-level where all this takes place (normally 10m)
+      REAL(wp), INTENT(in)  :: pTs  ! water temperature at the air-sea interface [K]
+      REAL(wp), INTENT(in)  :: pqs  ! satur. spec. hum. at T=pTs   [kg/kg]
+      REAL(wp), INTENT(in)  :: pTa  ! potential air temperature at z=pzu [K]
+      REAL(wp), INTENT(in)  :: pqa  ! specific humidity at z=pzu [kg/kg]
+      REAL(wp), INTENT(in)  :: pCd
+      REAL(wp), INTENT(in)  :: pCh
+      REAL(wp), INTENT(in)  :: pCe
+      REAL(wp), INTENT(in)  :: pwnd ! wind speed module at z=pzu [m/s]
+      REAL(wp), INTENT(in)  :: pUb  ! bulk wind speed at z=pzu (inc. pot. effect of gustiness etc) [m/s]
+      REAL(wp), INTENT(in)  :: pslp ! sea-level atmospheric pressure [Pa]
+      !!
+      REAL(wp), INTENT(out) :: pTau  ! module of the wind stress [N/m^2]
+      REAL(wp), INTENT(out) :: pQsen !  [W/m^2]
+      REAL(wp), INTENT(out) :: pQlat !  [W/m^2]
+      !!
+      REAL(wp), INTENT(out), OPTIONAL :: pEvap ! Evaporation [kg/m^2/s]
+      REAL(wp), INTENT(out), OPTIONAL :: prhoa ! Air density at z=pzu [kg/m^3]
+      REAL(wp), INTENT(in) , OPTIONAL :: pfact_evap  ! ABOMINATION: corrective factor for evaporation (doing this against my will! /laurent)
+      !!
+      REAL(wp) :: ztaa, zgamma, zrho, zUrho, zevap, zfact_evap
+      INTEGER  :: jq
+      !!----------------------------------------------------------------------------------
+      zfact_evap = 1._wp
+      IF( PRESENT(pfact_evap) ) zfact_evap = pfact_evap
+      
+      !! Need ztaa, absolute temperature at pzu (formula to estimate rho_air needs absolute temperature, not the potential temperature "pTa")
+      ztaa = pTa ! first guess...
+      DO jq = 1, 4
+         zgamma = gamma_moist( 0.5*(ztaa+pTs) , pqa )  !LOLO: why not "0.5*(pqs+pqa)" rather then "pqa" ???
+         ztaa = pTa - zgamma*pzu   ! Absolute temp. is slightly colder...
+      END DO
+      zrho = rho_air(ztaa, pqa, pslp)
+      zrho = rho_air(ztaa, pqa, pslp-zrho*grav*pzu) ! taking into account that we are pzu m above the sea level where SLP is given!
+
+      zUrho = pUb*MAX(zrho, 1._wp)     ! rho*U10
+
+      pTau = zUrho * pCd * pwnd ! Wind stress module
+
+      zevap = zUrho * pCe * (pqa - pqs)
+      pQsen = zUrho * pCh * (pTa - pTs) * cp_air(pqa)
+      pQlat = L_vap(pTs) * zevap
+
+      IF( PRESENT(pEvap) ) pEvap = - zfact_evap * zevap
+      IF( PRESENT(prhoa) ) prhoa = zrho
+
+   END SUBROUTINE BULK_FORMULA_SCLR
+
+   SUBROUTINE BULK_FORMULA_VCTR( pzu, pTs, pqs, pTa, pqa, &
+      &                          pCd, pCh, pCe,           &
+      &                          pwnd, pUb, pslp,         &
+      &                          pTau, pQsen, pQlat,      & 
+      &                          pEvap, prhoa, pfact_evap )      
+      !!----------------------------------------------------------------------------------
+      REAL(wp),                     INTENT(in)  :: pzu  ! height above the sea-level where all this takes place (normally 10m)
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pTs  ! water temperature at the air-sea interface [K]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pqs  ! satur. spec. hum. at T=pTs   [kg/kg]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pTa  ! potential air temperature at z=pzu [K]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pqa  ! specific humidity at z=pzu [kg/kg]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pCd
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pCh
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pCe
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pwnd ! wind speed module at z=pzu [m/s]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pUb  ! bulk wind speed at z=pzu (inc. pot. effect of gustiness etc) [m/s]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pslp ! sea-level atmospheric pressure [Pa]
+      !!
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(out) :: pTau  ! module of the wind stress [N/m^2]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(out) :: pQsen !  [W/m^2]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(out) :: pQlat !  [W/m^2]
+      !!
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(out), OPTIONAL :: pEvap ! Evaporation [kg/m^2/s]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(out), OPTIONAL :: prhoa ! Air density at z=pzu [kg/m^3]
+      REAL(wp),                     INTENT(in) , OPTIONAL :: pfact_evap  ! ABOMINATION: corrective factor for evaporation (doing this against my will! /laurent)
+      !!
+      REAL(wp) :: ztaa, zgamma, zrho, zUrho, zevap, zfact_evap
+      INTEGER  :: ji, jj
+      !!----------------------------------------------------------------------------------
+      zfact_evap = 1._wp
+      IF( PRESENT(pfact_evap) ) zfact_evap = pfact_evap
+
+      DO_2D_11_11
+
+         CALL BULK_FORMULA_SCLR( pzu, pTs(ji,jj), pqs(ji,jj), pTa(ji,jj), pqa(ji,jj), &
+            &                    pCd(ji,jj), pCh(ji,jj), pCe(ji,jj),                  &
+            &                    pwnd(ji,jj), pUb(ji,jj), pslp(ji,jj),                &
+            &                    pTau(ji,jj), pQsen(ji,jj), pQlat(ji,jj),             &
+            &                    pEvap=zevap, prhoa=zrho, pfact_evap=zfact_evap       )
+
+         IF( PRESENT(pEvap) ) pEvap(ji,jj) = zevap
+         IF( PRESENT(prhoa) ) prhoa(ji,jj) = zrho
+   
+      END_2D
+   END SUBROUTINE BULK_FORMULA_VCTR
+
+
+   FUNCTION alpha_sw_vctr( psst )
+      !!---------------------------------------------------------------------------------
+      !!                           ***  FUNCTION alpha_sw_vctr  ***
+      !!
+      !! ** Purpose : ROUGH estimate of the thermal expansion coefficient of sea-water at the surface (P =~ 1010 hpa)
+      !!
+      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
+      !!----------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj)             ::   alpha_sw_vctr   ! thermal expansion coefficient of sea-water [1/K]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   psst   ! water temperature                [K]
+      !!----------------------------------------------------------------------------------
+      alpha_sw_vctr = 2.1e-5_wp * MAX(psst(:,:)-rt0 + 3.2_wp, 0._wp)**0.79
+   END FUNCTION alpha_sw_vctr
+
+   FUNCTION alpha_sw_sclr( psst )
+      !!---------------------------------------------------------------------------------
+      !!                           ***  FUNCTION alpha_sw_sclr  ***
+      !!
+      !! ** Purpose : ROUGH estimate of the thermal expansion coefficient of sea-water at the surface (P =~ 1010 hpa)
+      !!
+      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
+      !!----------------------------------------------------------------------------------
+      REAL(wp)             ::   alpha_sw_sclr   ! thermal expansion coefficient of sea-water [1/K]
+      REAL(wp), INTENT(in) ::   psst   ! sea-water temperature                   [K]
+      !!----------------------------------------------------------------------------------
+      alpha_sw_sclr = 2.1e-5_wp * MAX(psst-rt0 + 3.2_wp, 0._wp)**0.79
+   END FUNCTION alpha_sw_sclr
+
+
+
+   !!======================================================================
+END MODULE sbcblk_phy
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcblk_skin_coare.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcblk_skin_coare.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcblk_skin_coare.F90	(revision 12928)
@@ -0,0 +1,313 @@
+MODULE sbcblk_skin_coare
+   !!======================================================================
+   !!                   ***  MODULE  sbcblk_skin_coare  ***
+   !!
+   !!   Module that gathers the cool-skin and warm-layer parameterization used
+   !!   in the COARE family of bulk parameterizations.
+   !!
+   !!   Based on the last update for version COARE 3.6 (Fairall et al., 2019)
+   !!
+   !!   Module 'sbcblk_skin_coare' also maintained and developed in AeroBulk (as
+   !!            'mod_skin_coare')
+   !!    (https://github.com/brodeau/aerobulk)   !!
+   !! ** Author: L. Brodeau, November 2019 / AeroBulk (https://github.com/brodeau/aerobulk)
+   !!----------------------------------------------------------------------
+   !! History :  4.x  !  2019-11  (L.Brodeau)   Original code
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE sbc_oce         ! Surface boundary condition: ocean fields
+
+   USE sbcblk_phy      ! misc. functions for marine ABL physics (rho_air, q_sat, bulk_formula, etc)
+
+   USE sbcdcy          !#LB: to know hour of dawn and dusk: rdawn_dcy and rdusk_dcy (needed in WL_COARE)
+
+   USE lib_mpp         ! distribued memory computing library
+   USE in_out_manager  ! I/O manager
+   USE lib_fortran     ! to use key_nosignedzero
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC :: CS_COARE, WL_COARE
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+
+   !! Cool-skin related parameters:
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: dT_cs !: dT due to cool-skin effect
+   !                                                      ! => temperature difference between air-sea interface (z=0)
+   !                                                      !    and right below viscous layer (z=delta)
+
+   !! Warm-layer related parameters:
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: dT_wl !: dT due to warm-layer effect
+   !                                                      ! => difference between "almost surface (right below
+   !                                                      !    viscous layer, z=delta) and depth of bulk SST (z=gdept_1d(1))
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: Hz_wl !: depth (aka thickness) of warm-layer [m]
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: Qnt_ac !: time integral / accumulated heat stored by the warm layer
+   !                                                      !         Qxdt => [J/m^2] (reset to zero every midnight)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: Tau_ac !: time integral / accumulated momentum
+   !                                                      !         Tauxdt => [N.s/m^2] (reset to zero every midnight)
+
+   REAL(wp), PARAMETER, PUBLIC :: Hwl_max = 20._wp    !: maximum depth of warm layer (adjustable)
+   !
+   REAL(wp), PARAMETER :: rich   = 0.65_wp   !: critical Richardson number
+   !
+   REAL(wp), PARAMETER :: zfr0   = 0.5_wp    !: initial value of solar flux absorption
+   !
+   !!----------------------------------------------------------------------
+CONTAINS
+
+
+   SUBROUTINE CS_COARE( pQsw, pQnsol, pustar, pSST, pQlat )
+      !!---------------------------------------------------------------------
+      !!
+      !! Cool-skin parameterization, based on Fairall et al., 1996,
+      !! revisited for COARE 3.6 (Fairall et al., 2019)
+      !!
+      !! Fairall, C. W., Bradley, E. F., Godfrey, J. S., Wick, G. A.,
+      !! Edson, J. B., and Young, G. S. ( 1996), Cool‐skin and warm‐layer
+      !! effects on sea surface temperature, J. Geophys. Res., 101( C1), 1295-1308,
+      !! doi:10.1029/95JC03190.
+      !!
+      !!------------------------------------------------------------------
+      !!
+      !!  **   INPUT:
+      !!     *pQsw*       surface net solar radiation into the ocean     [W/m^2] => >= 0 !
+      !!     *pQnsol*     surface net non-solar heat flux into the ocean [W/m^2] => normally < 0 !
+      !!     *pustar*     friction velocity u*                           [m/s]
+      !!     *pSST*       bulk SST (taken at depth gdept_1d(1))          [K]
+      !!     *pQlat*      surface latent heat flux                       [K]
+      !!------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pQsw   ! net solar a.k.a shortwave radiation into the ocean (after albedo) [W/m^2]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pQnsol ! non-solar heat flux to the ocean [W/m^2]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pustar  ! friction velocity, temperature and humidity (u*,t*,q*)
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pSST ! bulk SST [K]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pQlat  ! latent heat flux [W/m^2]
+      !!---------------------------------------------------------------------
+      INTEGER  :: ji, jj, jc
+      REAL(wp) :: zQabs, zdlt, zfr, zalfa, zqlat, zus
+      !!---------------------------------------------------------------------
+      DO_2D_11_11
+
+         zQabs = pQnsol(ji,jj) ! first guess of heat flux absorbed within the viscous sublayer of thicknes delta,
+         !                     !   => we DO not miss a lot assuming 0 solar flux absorbed in the tiny layer of thicknes zdlt...
+
+         zalfa = alpha_sw(pSST(ji,jj)) ! (crude) thermal expansion coefficient of sea-water [1/K]
+         zqlat = pQlat(ji,jj)
+         zus   = pustar(ji,jj)
+
+
+         zdlt = delta_skin_layer( zalfa, zQabs, zqlat, zus )
+
+         DO jc = 1, 4 ! because implicit in terms of zdlt...
+            zfr = MAX( 0.137_wp + 11._wp*zdlt &
+               &       - 6.6E-5_wp/zdlt*(1._wp - EXP(-zdlt/8.E-4_wp)) &
+               &      , 0.01_wp ) ! Solar absorption, Eq.16 (Fairall al. 1996b)
+            !                  !LB: why 0.065 and not 0.137 like in the paper??? Beljaars & Zeng use 0.065, not 0.137 !
+            zQabs = pQnsol(ji,jj) + zfr*pQsw(ji,jj)
+            zdlt = delta_skin_layer( zalfa, zQabs, zqlat, zus )
+         END DO
+
+         dT_cs(ji,jj) = zQabs*zdlt/rk0_w   ! temperature increment, yes dT_cs can actually > 0, if Qabs > 0 (rare but possible!)
+
+      END_2D
+
+   END SUBROUTINE CS_COARE
+
+
+   SUBROUTINE WL_COARE( pQsw, pQnsol, pTau, pSST, iwait )
+      !!---------------------------------------------------------------------
+      !!
+      !!  Warm-Layer scheme according to COARE 3.6 (Fairall et al, 2019)
+      !!     ------------------------------------------------------------------
+      !!
+      !!  **   INPUT:
+      !!     *pQsw*       surface net solar radiation into the ocean     [W/m^2] => >= 0 !
+      !!     *pQnsol*     surface net non-solar heat flux into the ocean [W/m^2] => normally < 0 !
+      !!     *pTau*       surface wind stress                            [N/m^2]
+      !!     *pSST*       bulk SST  (taken at depth gdept_1d(1))         [K]
+      !!     *iwait*      if /= 0 then wait before updating accumulated fluxes, we are within a converging itteration loop...
+      !!---------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pQsw     ! surface net solar radiation into the ocean [W/m^2]     => >= 0 !
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pQnsol   ! surface net non-solar heat flux into the ocean [W/m^2] => normally < 0 !
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pTau     ! wind stress [N/m^2]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pSST     ! bulk SST at depth gdept_1d(1) [K]
+      INTEGER ,                     INTENT(in)  :: iwait    ! if /= 0 then wait before updating accumulated fluxes
+      !!
+      INTEGER :: ji,jj
+      !
+      REAL(wp) :: zdTwl, zHwl, zQabs, zfr
+      REAL(wp) :: zqac, ztac
+      REAL(wp) :: zalfa, zcd1, zcd2, flg
+      !!---------------------------------------------------------------------
+
+      REAL(wp) :: ztime, znoon, zmidn
+      INTEGER  :: jl
+
+      LOGICAL :: l_exit, l_destroy_wl
+
+      !! INITIALIZATION:
+      zQabs  = 0._wp       ! total heat flux absorped in warm layer
+      zfr    = zfr0        ! initial value of solar flux absorption !#LB: save it and use previous value !!!
+
+      IF( .NOT. ln_dm2dc ) CALL sbc_dcy_param() ! we need to call sbc_dcy_param (sbcdcy.F90) because rdawn_dcy and rdusk_dcy are unkonwn otherwize!
+
+      ztime = REAL(nsec_day,wp)/(24._wp*3600._wp) ! time of current time step since 00:00 for current day (UTC) -> ztime = 0 -> 00:00 / ztime = 0.5 -> 12:00 ...
+
+      DO_2D_11_11
+
+         l_exit       = .FALSE.
+         l_destroy_wl = .FALSE.
+
+         zdTwl =  dT_wl(ji,jj)                          ! value of previous time step as first guess
+         zHwl  = MAX( MIN(Hz_wl(ji,jj),Hwl_max),0.1_wp) !   "                  "           "
+
+         zqac = Qnt_ac(ji,jj) ! previous time step Qnt_ac
+         ztac = Tau_ac(ji,jj)
+
+         !*****  variables for warm layer  ***
+         zalfa = alpha_sw( pSST(ji,jj) ) ! (crude) thermal expansion coefficient of sea-water [1/K] (SST accurate enough!)
+
+         zcd1 = SQRT(2._wp*rich*rCp0_w/(zalfa*grav*rho0_w))        !mess-o-constants 1
+         zcd2 = SQRT(2._wp*zalfa*grav/(rich*rho0_w))/(rCp0_w**1.5) !mess-o-constants 2
+
+
+         znoon = MOD( 0.5_wp*(rdawn_dcy(ji,jj)+rdusk_dcy(ji,jj)), 1._wp )   ! 0<rnoon<1. => rnoon*24 = UTC time of local noon
+         zmidn = MOD(              znoon-0.5_wp                 , 1._wp )
+         zmidn = MOD( zmidn + 0.125_wp , 1._wp ) ! 3 hours past the local midnight
+
+         IF( (ztime >= zmidn) .AND. (ztime < rdawn_dcy(ji,jj)) ) THEN
+            ! Dawn reset to 0!
+            l_exit       = .TRUE.
+            l_destroy_wl = .TRUE.
+         ENDIF
+
+         IF( .NOT. l_exit ) THEN
+            !! Initial test on initial guess of absorbed heat flux in warm-layer:
+            zQabs = frac_solar_abs(zHwl)*pQsw(ji,jj) + pQnsol(ji,jj) ! first guess of tot. heat flux absorbed in warm layer
+            !                                                        ! => #LB: depends of zfr, which is wild guess... Wrong!!!
+            IF( (ABS(zdTwl) < 1.E-6_wp) .AND. (zQabs <= 0._wp) ) THEN
+               ! We have not started to build a WL yet (dT==0) and there's no way it can occur now
+               ! since zQabs <= 0._wp
+               ! => no need to go further
+               l_exit = .TRUE.
+            ENDIF
+
+         ENDIF
+
+         ! Okay test on updated absorbed flux:
+         !#LB: remove??? has a strong influence !!!
+         IF( (.NOT. l_exit).AND.(Qnt_ac(ji,jj) + zQabs*rn_Dt <= 0._wp) ) THEN
+            l_exit       = .TRUE.
+            l_destroy_wl = .TRUE.
+         ENDIF
+
+
+         IF( .NOT. l_exit) THEN
+
+            ! Two possibilities at this point:
+            ! 1/ A warm layer already exists (dT>0) but it is cooling down because Qabs<0
+            ! 2/ Regardless of WL formed (dT==0 or dT>0), we are in the process to initiate one or warm further it !
+
+            ztac = Tau_ac(ji,jj) + MAX(.002_wp , pTau(ji,jj))*rn_Dt      ! updated momentum integral
+            !PRINT *, '#LBD: updated value for Tac=',  REAL(ztac,4)
+
+            !! We update the value of absorbtion and zQabs:
+            !! some part is useless if Qsw=0 !!!
+            DO jl = 1, 5
+               zQabs = frac_solar_abs(zHwl)*pQsw(ji,jj) + pQnsol(ji,jj)
+               zqac  = Qnt_ac(ji,jj) + zQabs*rn_Dt ! updated heat absorbed
+               IF( zqac <= 0._wp ) EXIT
+               zHwl = MAX( MIN( Hwl_max , zcd1*ztac/SQRT(zqac)) , 0.1_wp ) ! Warm-layer depth
+            END DO
+
+            IF( zqac <= 0._wp ) THEN
+               l_destroy_wl = .TRUE.
+               l_exit       = .TRUE.
+            ELSE
+               zdTwl = zcd2*zqac**1.5/ztac * MAX(zqac/ABS(zqac),0._wp)  !! => IF(zqac>0._wp): zdTwl=zcd2*zqac**1.5/ztac ; ELSE: zdTwl=0. / ! normally: zqac > 0 !
+               !PRINT *, '#LBD: updated preliminary value for dT_wl=',  REAL(zdTwl,4)
+               ! Warm layer correction
+               flg = 0.5_wp + SIGN( 0.5_wp , gdept_1d(1)-zHwl )               ! => 1 when gdept_1d(1)>zHwl (zdTwl = zdTwl) | 0 when gdept_1d(1)<zHwl (zdTwl = zdTwl*gdept_1d(1)/zHwl)
+               zdTwl = zdTwl * ( flg + (1._wp-flg)*gdept_1d(1)/zHwl )
+            ENDIF
+
+         ENDIF !IF( .NOT. l_exit)
+
+         IF( l_destroy_wl ) THEN
+            zdTwl = 0._wp
+            zfr   = 0.75_wp
+            zHwl  = Hwl_max
+            zqac  = 0._wp
+            ztac  = 0._wp
+         ENDIF
+
+         IF( iwait == 0 ) THEN
+            !! Iteration loop within bulk algo is over, time to update what needs to be updated:
+            dT_wl(ji,jj)  = zdTwl
+            Hz_wl(ji,jj)  = zHwl
+            Qnt_ac(ji,jj) = zqac ! Updating Qnt_ac, heat integral
+            Tau_ac(ji,jj) = ztac
+         ENDIF
+
+      END_2D
+
+   END SUBROUTINE WL_COARE
+
+
+
+
+   FUNCTION delta_skin_layer( palpha, pQd, pQlat, pustar_a )
+      !!---------------------------------------------------------------------
+      !! Computes the thickness (m) of the viscous skin layer.
+      !! Based on Fairall et al., 1996
+      !!
+      !! Fairall, C. W., Bradley, E. F., Godfrey, J. S., Wick, G. A.,
+      !! Edson, J. B., and Young, G. S. ( 1996), Cool‐skin and warm‐layer
+      !! effects on sea surface temperature, J. Geophys. Res., 101( C1), 1295-1308,
+      !! doi:10.1029/95JC03190.
+      !!
+      !! L. Brodeau, october 2019
+      !!---------------------------------------------------------------------
+      REAL(wp)                :: delta_skin_layer
+      REAL(wp), INTENT(in)    :: palpha   ! thermal expansion coefficient of sea-water (SST accurate enough!)
+      REAL(wp), INTENT(in)    :: pQd ! < 0 !!! part of the net heat flux actually absorbed in the WL [W/m^2]
+      !                              !  => term "Q + Rs*fs" in eq.6 of Fairall et al. 1996
+      REAL(wp), INTENT(in)    :: pQlat    ! latent heat flux [W/m^2]
+      REAL(wp), INTENT(in)    :: pustar_a ! friction velocity in the air (u*) [m/s]
+      !!---------------------------------------------------------------------
+      REAL(wp) :: zusw, zusw2, zlamb, zQd, ztf, ztmp
+      !!---------------------------------------------------------------------
+
+      zQd = pQd + 0.026*MIN(pQlat,0._wp)*rCp0_w/rLevap/palpha   ! #LB: Double check sign + division by palpha !!! units are okay!
+
+      ztf = 0.5_wp + SIGN(0.5_wp, zQd)  ! Qabs < 0 => cooling of the viscous layer => ztf = 0 (regular case)
+      !                                 ! Qabs > 0 => warming of the viscous layer => ztf = 1 (ex: weak evaporation and strong positive sensible heat flux)
+      !
+      zusw  = MAX(pustar_a, 1.E-4_wp) * sq_radrw    ! u* in the water
+      zusw2 = zusw*zusw
+      !
+      zlamb = 6._wp*( 1._wp + MAX(palpha*rcst_cs/(zusw2*zusw2)*zQd, 0._wp)**0.75 )**(-1./3.) ! see Eq.(14) in Fairall et al., 1996
+      !  => zlamb is not used when Qd > 0, and since rcst_cs < 0, we just use this "MAX" to prevent FPE errors (something_negative)**0.75
+      !
+      ztmp = rnu0_w/zusw
+      delta_skin_layer = (1._wp-ztf) *     zlamb*ztmp           &  ! regular case, Qd < 0, see Eq.(12) in Fairall et al., 1996
+         &               +   ztf     * MIN(6._wp*ztmp , 0.007_wp)  ! when Qd > 0
+   END FUNCTION delta_skin_layer
+
+
+   FUNCTION frac_solar_abs( pHwl )
+      !!---------------------------------------------------------------------
+      !! Fraction of solar heat flux absorbed inside warm layer
+      !!---------------------------------------------------------------------
+      REAL(wp)             :: frac_solar_abs
+      REAL(wp), INTENT(in) :: pHwl   ! thickness of warm-layer [m]
+      !!---------------------------------------------------------------------
+      frac_solar_abs = 1._wp - ( 0.28*0.014  *(1._wp - EXP(-pHwl/0.014)) &
+         &                       + 0.27*0.357*(1._wp - EXP(-pHwl/0.357)) &
+         &                       + 0.45*12.82*(1-EXP(-pHwl/12.82)) ) / pHwl
+   END FUNCTION frac_solar_abs
+
+   !!======================================================================
+END MODULE sbcblk_skin_coare
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcblk_skin_ecmwf.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcblk_skin_ecmwf.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcblk_skin_ecmwf.F90	(revision 12928)
@@ -0,0 +1,309 @@
+MODULE sbcblk_skin_ecmwf
+   !!======================================================================
+   !!                   ***  MODULE  sbcblk_skin_ecmwf  ***
+   !!
+   !!   Module that gathers the cool-skin and warm-layer parameterization used
+   !!   by the IFS at ECMWF (recoded from scratch =>
+   !!   https://github.com/brodeau/aerobulk)
+   !!
+   !!  Mainly based on Zeng & Beljaars, 2005 with the more recent add-up from
+   !!  Takaya et al., 2010 when it comes to the warm-layer parameterization
+   !!  (contribution of extra mixing due to Langmuir circulation)
+   !!
+   !!  - Zeng X., and A. Beljaars, 2005: A prognostic scheme of sea surface skin
+   !!    temperature for modeling and data assimilation. Geophysical Research
+   !!    Letters, 32 (14) , pp. 1-4.
+   !!
+   !!  - Takaya, Y., J.-R. Bildot, A. C. M. Beljaars, and P. A. E. M. Janssen,
+   !!    2010: Refinements to a prognostic scheme of skin sea surface
+   !!    temperature. J. Geophys. Res., 115, C06009, doi:10.1029/2009JC005985
+   !!
+   !!   Most of the formula are taken from the documentation of IFS of ECMWF
+   !!            (cycle 40r1) (avaible online on the ECMWF's website)
+   !!
+   !!   Routine 'sbcblk_skin_ecmwf' also maintained and developed in AeroBulk (as
+   !!            'mod_skin_ecmwf')
+   !!    (https://github.com/brodeau/aerobulk)
+   !!
+   !! ** Author: L. Brodeau, November 2019 / AeroBulk (https://github.com/brodeau/aerobulk)
+   !!----------------------------------------------------------------------
+   !! History :  4.x  !  2019-11  (L.Brodeau)   Original code
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE sbc_oce         ! Surface boundary condition: ocean fields
+
+   USE sbcblk_phy      ! misc. functions for marine ABL physics (rho_air, q_sat, bulk_formula, etc)
+
+   USE lib_mpp         ! distribued memory computing library
+   USE in_out_manager  ! I/O manager
+   USE lib_fortran     ! to use key_nosignedzero
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC :: CS_ECMWF, WL_ECMWF
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+
+   !! Cool-skin related parameters:
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: dT_cs !: dT due to cool-skin effect
+   !                                                      ! => temperature difference between air-sea interface (z=0)
+   !                                                      !    and right below viscous layer (z=delta)
+
+   !! Warm-layer related parameters:
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: dT_wl !: dT due to warm-layer effect
+   !                                                      ! => difference between "almost surface (right below
+   !                                                      !    viscous layer, z=delta) and depth of bulk SST (z=gdept_1d(1))
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: Hz_wl !: depth (aka thickness) of warm-layer [m]
+   !
+   REAL(wp), PARAMETER, PUBLIC :: rd0  = 3.    !: Depth scale [m] of warm layer, "d" in Eq.11 (Zeng & Beljaars 2005)
+   REAL(wp), PARAMETER         :: zRhoCp_w = rho0_w*rCp0_w
+   !
+   REAL(wp), PARAMETER         :: rNuwl0 = 0.5  !: Nu (exponent of temperature profile) Eq.11
+   !                                            !: (Zeng & Beljaars 2005) !: set to 0.5 instead of
+   !                                            !: 0.3 to respect a warming of +3 K in calm
+   !                                            !: condition for the insolation peak of +1000W/m^2
+   !!----------------------------------------------------------------------
+CONTAINS
+
+
+   SUBROUTINE CS_ECMWF( pQsw, pQnsol, pustar, pSST )
+      !!---------------------------------------------------------------------
+      !!
+      !! Cool-skin parameterization, based on Fairall et al., 1996:
+      !!
+      !!  - Zeng X., and A. Beljaars, 2005: A prognostic scheme of sea surface
+      !!    skin temperature for modeling and data assimilation. Geophysical
+      !!    Research Letters, 32 (14) , pp. 1-4.
+      !!
+      !!------------------------------------------------------------------
+      !!
+      !!  **   INPUT:
+      !!     *pQsw*       surface net solar radiation into the ocean     [W/m^2] => >= 0 !
+      !!     *pQnsol*     surface net non-solar heat flux into the ocean [W/m^2] => normally < 0 !
+      !!     *pustar*     friction velocity u*                           [m/s]
+      !!     *pSST*       bulk SST (taken at depth gdept_1d(1))          [K]
+      !!------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pQsw   ! net solar a.k.a shortwave radiation into the ocean (after albedo) [W/m^2]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pQnsol ! non-solar heat flux to the ocean [W/m^2]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pustar  ! friction velocity, temperature and humidity (u*,t*,q*)
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pSST ! bulk SST [K]
+      !!---------------------------------------------------------------------
+      INTEGER  :: ji, jj, jc
+      REAL(wp) :: zQabs, zdlt, zfr, zalfa, zus
+      !!---------------------------------------------------------------------
+      DO_2D_11_11
+
+         zQabs = pQnsol(ji,jj) ! first guess of heat flux absorbed within the viscous sublayer of thicknes delta,
+         !                     !   => we DO not miss a lot assuming 0 solar flux absorbed in the tiny layer of thicknes zdlt...
+
+         zalfa = alpha_sw(pSST(ji,jj)) ! (crude) thermal expansion coefficient of sea-water [1/K]
+         zus   = pustar(ji,jj)
+
+         zdlt = delta_skin_layer( zalfa, zQabs, zus )
+
+         DO jc = 1, 4 ! because implicit in terms of zdlt...
+            zfr = MAX( 0.065_wp + 11._wp*zdlt  &
+               &       - 6.6E-5_wp/zdlt*(1._wp - EXP(-zdlt/8.E-4_wp)) &
+               &      , 0.01_wp ) ! Solar absorption, Eq.(5) Zeng & Beljaars, 2005
+            !                     !  =>  (WARNING: 0.065 rather than 0.137 in Fairal et al. 1996)
+            zQabs = pQnsol(ji,jj) + zfr*pQsw(ji,jj)
+            zdlt = delta_skin_layer( zalfa, zQabs, zus )
+         END DO
+
+         dT_cs(ji,jj) = zQabs*zdlt/rk0_w   ! temperature increment, yes dT_cs can actually > 0, if Qabs > 0 (rare but possible!)
+
+      END_2D
+
+   END SUBROUTINE CS_ECMWF
+
+
+   SUBROUTINE WL_ECMWF( pQsw, pQnsol, pustar, pSST,  pustk )
+      !!---------------------------------------------------------------------
+      !!
+      !!  Warm-Layer scheme according to Zeng & Beljaars, 2005 (GRL) with the
+      !!  more recent add-up from Takaya et al., 2010 when it comes to the
+      !!  warm-layer parameterization (contribution of extra mixing due to
+      !!  Langmuir circulation)
+      !!
+      !!  - Zeng X., and A. Beljaars, 2005: A prognostic scheme of sea surface skin
+      !!    temperature for modeling and data assimilation. Geophysical Research
+      !!    Letters, 32 (14) , pp. 1-4.
+      !!
+      !!  - Takaya, Y., J.-R. Bildot, A. C. M. Beljaars, and P. A. E. M. Janssen,
+      !!    2010: Refinements to a prognostic scheme of skin sea surface
+      !!    temperature. J. Geophys. Res., 115, C06009, doi:10.1029/2009JC005985
+      !!
+      !!  STIL NO PROGNOSTIC EQUATION FOR THE DEPTH OF THE WARM-LAYER!
+      !!
+      !!     ------------------------------------------------------------------
+      !!
+      !!  **   INPUT:
+      !!     *pQsw*       surface net solar radiation into the ocean     [W/m^2] => >= 0 !
+      !!     *pQnsol*     surface net non-solar heat flux into the ocean [W/m^2] => normally < 0 !
+      !!     *pustar*     friction velocity u*                           [m/s]
+      !!     *pSST*       bulk SST  (taken at depth gdept_1d(1))         [K]
+      !!------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pQsw     ! surface net solar radiation into the ocean [W/m^2]     => >= 0 !
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pQnsol   ! surface net non-solar heat flux into the ocean [W/m^2] => normally < 0 !
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pustar   ! friction velocity [m/s]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pSST     ! bulk SST at depth gdept_1d(1) [K]
+      !!
+      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: pustk ! surface Stokes velocity [m/s]
+      !
+      INTEGER :: ji, jj, jc
+      !
+      REAL(wp) :: zHwl      !: thickness of the warm-layer [m]
+      REAL(wp) :: ztcorr    !: correction of dT w.r.t measurement depth of bulk SST (first T-point)
+      REAL(wp) :: zalfa     !: thermal expansion coefficient of sea-water [1/K]
+      REAL(wp) :: zdTwl_b, zdTwl_n  !: temp. diff. between "almost surface (right below viscous layer) and bottom of WL
+      REAL(wp) :: zfr, zeta 
+      REAL(wp) :: zusw, zusw2 
+      REAL(wp) :: zLa, zfLa 
+      REAL(wp) :: flg, zwf, zQabs 
+      REAL(wp) :: ZA, ZB, zL1, zL2
+      REAL(wp) :: zcst0, zcst1, zcst2, zcst3
+      !
+      LOGICAL :: l_pustk_known
+      !!---------------------------------------------------------------------
+
+      l_pustk_known = .FALSE.
+      IF( PRESENT(pustk) ) l_pustk_known = .TRUE.
+
+      DO_2D_11_11
+
+         zHwl = Hz_wl(ji,jj) ! first guess for warm-layer depth (and unique..., less advanced than COARE3p6 !)
+         ! it is = rd0 (3m) in default Zeng & Beljaars case...
+
+         !! Previous value of dT / warm-layer, adapted to depth:
+         flg = 0.5_wp + SIGN( 0.5_wp , gdept_1d(1)-zHwl ) ! => 1 when gdept_1d(1)>zHwl (dT_wl(ji,jj) = zdTwl) | 0 when z_s$
+         ztcorr = flg + (1._wp - flg)*gdept_1d(1)/zHwl
+         zdTwl_b = MAX ( dT_wl(ji,jj) / ztcorr , 0._wp )
+         ! zdTwl is the difference between "almost surface (right below viscous layer) and bottom of WL (here zHwl)
+         ! pdT         "                          "                                    and depth of bulk SST (here gdept_1d(1))!
+         !! => but of course in general the bulk SST is taken shallower than zHwl !!! So correction less pronounced!
+         !! => so here since pdT is difference between surface and gdept_1d(1), need to increase fof zdTwl !
+
+         zalfa = alpha_sw( pSST(ji,jj) ) ! (crude) thermal expansion coefficient of sea-water [1/K] (SST accurate enough!)
+
+         ! *** zfr = Fraction of solar radiation absorbed in warm layer (-)
+         zfr = 1._wp - 0.28_wp*EXP(-71.5_wp*zHwl) - 0.27_wp*EXP(-2.8_wp*zHwl) - 0.45_wp*EXP(-0.07_wp*zHwl)  !: Eq. 8.157
+
+         zQabs = zfr*pQsw(ji,jj) + pQnsol(ji,jj)       ! tot heat absorbed in warm layer
+
+         zusw  = MAX( pustar(ji,jj), 1.E-4_wp ) * sq_radrw    ! u* in the water
+         zusw2 = zusw*zusw
+
+         ! Langmuir:
+         IF( l_pustk_known ) THEN
+            zLa = SQRT(zusw/MAX(pustk(ji,jj),1.E-6))
+         ELSE
+            zla = 0.3_wp
+         ENDIF
+         zfLa = MAX( zla**(-2._wp/3._wp) , 1._wp )   ! Eq.(6)
+
+         zwf = 0.5_wp + SIGN(0.5_wp, zQabs)  ! zQabs > 0. => 1.  / zQabs < 0. => 0.
+
+         zcst1 = vkarmn*grav*zalfa
+
+         ! 1/L when zQabs > 0 :
+         zL2 = zcst1*zQabs / (zRhoCp_w*zusw2*zusw)
+
+         zcst2 = zcst1 / ( 5._wp*zHwl*zusw2 )  !OR: zcst2 = zcst1*rNuwl0 / ( 5._wp*zHwl*zusw2 ) ???
+
+         zcst0 = rn_Dt * (rNuwl0 + 1._wp) / zHwl
+
+         ZA = zcst0 * zQabs / ( rNuwl0 * zRhoCp_w )
+
+         zcst3 = -zcst0 * vkarmn * zusw * zfLa
+
+         !! Sorry about all these constants ( constant w.r.t zdTwl), it's for
+         !! the sake of optimizations... So all these operations are not done
+         !! over and over within the iteration loop...
+
+         !! T R U L L Y   I M P L I C I T => needs itteration
+         !! => have to itterate just because the 1/(Monin-Obukhov length), zL1, uses zdTwl when zQabs < 0..
+         !!    (without this term otherwize the implicit analytical solution is straightforward...)
+         zdTwl_n = zdTwl_b
+         DO jc = 1, 10
+
+            zdTwl_n = 0.5_wp * ( zdTwl_n + zdTwl_b ) ! semi implicit, for faster convergence
+
+            ! 1/L when zdTwl > 0 .AND. zQabs < 0 :
+            zL1 =         SQRT( zdTwl_n * zcst2 ) ! / zusw !!! Or??? => vkarmn * SQRT( zdTwl_n*grav*zalfa/( 5._wp*zHwl ) ) / zusw
+
+            ! Stability parameter (z/L):
+            zeta =  (1._wp - zwf) * zHwl*zL1   +   zwf * zHwl*zL2
+
+            ZB = zcst3 / PHI(zeta)
+
+            zdTwl_n = MAX ( zdTwl_b + ZA + ZB*zdTwl_n , 0._wp )  ! Eq.(6)
+
+         END DO
+
+         !! Update:
+         dT_wl(ji,jj) = zdTwl_n * ztcorr
+
+      END_2D
+
+   END SUBROUTINE WL_ECMWF
+
+
+   FUNCTION delta_skin_layer( palpha, pQd, pustar_a )
+      !!---------------------------------------------------------------------
+      !! Computes the thickness (m) of the viscous skin layer.
+      !! Based on Fairall et al., 1996
+      !!
+      !! Fairall, C. W., Bradley, E. F., Godfrey, J. S., Wick, G. A.,
+      !! Edson, J. B., and Young, G. S. ( 1996), Cool‐skin and warm‐layer
+      !! effects on sea surface temperature, J. Geophys. Res., 101( C1), 1295-1308,
+      !! doi:10.1029/95JC03190.
+      !!
+      !! L. Brodeau, october 2019
+      !!---------------------------------------------------------------------
+      REAL(wp)                :: delta_skin_layer
+      REAL(wp), INTENT(in)    :: palpha   ! thermal expansion coefficient of sea-water (SST accurate enough!)
+      REAL(wp), INTENT(in)    :: pQd ! < 0 !!! part of the net heat flux actually absorbed in the WL [W/m^2]
+      !                              !  => term "Q + Rs*fs" in eq.6 of Fairall et al. 1996
+      REAL(wp), INTENT(in)    :: pustar_a ! friction velocity in the air (u*) [m/s]
+      !!---------------------------------------------------------------------
+      REAL(wp) :: zusw, zusw2, zlamb, ztf, ztmp
+      !!---------------------------------------------------------------------
+      ztf = 0.5_wp + SIGN(0.5_wp, pQd)  ! Qabs < 0 => cooling of the viscous layer => ztf = 0 (regular case)
+      !                                 ! Qabs > 0 => warming of the viscous layer => ztf = 1
+      !                                 !    (ex: weak evaporation and strong positive sensible heat flux)
+      zusw  = MAX(pustar_a, 1.E-4_wp) * sq_radrw    ! u* in the water
+      zusw2 = zusw*zusw
+      !
+      zlamb = 6._wp*( 1._wp + MAX(palpha*rcst_cs/(zusw2*zusw2)*pQd, 0._wp)**0.75 )**(-1./3.) ! see Eq.(14) in Fairall et al., 1996
+      !  => zlamb is not used when Qd > 0, and since rcst_cs < 0, we just use this "MAX" to prevent FPE errors (something_negative)**0.75
+      !
+      ztmp = rnu0_w/zusw
+      delta_skin_layer = (1._wp-ztf) *     zlamb*ztmp           &  ! regular case, Qd < 0, see Eq.(12) in Fairall et al., 1996
+         &               +   ztf     * MIN(6._wp*ztmp , 0.007_wp)  ! when Qd > 0
+   END FUNCTION delta_skin_layer
+
+
+   FUNCTION PHI( pzeta)
+      !!---------------------------------------------------------------------
+      !!
+      !! Takaya et al., 2010
+      !!  Eq.(5)
+      !! L. Brodeau, october 2019
+      !!---------------------------------------------------------------------
+      REAL(wp)                :: PHI
+      REAL(wp), INTENT(in)    :: pzeta    ! stability parameter
+      !!---------------------------------------------------------------------
+      REAL(wp) :: ztf, zzt2
+      !!---------------------------------------------------------------------
+      zzt2 = pzeta*pzeta
+      ztf = 0.5_wp + SIGN(0.5_wp, pzeta)  ! zeta > 0 => ztf = 1
+      !                                   ! zeta < 0 => ztf = 0
+      PHI =      ztf     * ( 1. + (5.*pzeta + 4.*zzt2)/(1. + 3.*pzeta + 0.25*zzt2) ) &   ! zeta > 0
+         &  + (1. - ztf) * 1./SQRT( 1. - 16.*(-ABS(pzeta)) )                             ! zeta < 0
+   END FUNCTION PHI
+
+   !!======================================================================
+END MODULE sbcblk_skin_ecmwf
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcclo.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcclo.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcclo.F90	(revision 12928)
@@ -0,0 +1,350 @@
+MODULE sbcclo
+   !!======================================================================
+   !!                       ***  MODULE  sbcclo  ***
+   !! Ocean forcing: redistribution of emp unbalance over closed sea into river mouth or open ocean
+   !!=====================================================================
+   !! History :  4.0 and earlier ! see closea.F90 history   
+   !!   NEMO     4.1  ! 2019-09  (P. Mathiot) rewrite sbc_clo module to match new closed sea mask definition (original sbcclo.F90)
+   !! 
+   !!----------------------------------------------------------------------
+   !
+   !!----------------------------------------------------------------------
+   !!   Public subroutines:
+   !!   sbc_clo       : update emp and qns over target area and source area
+   !!   sbc_clo_init  : initialise all variable needed for closed sea correction
+   !!
+   !!   Private subroutines:
+   !!   alloc_csarr   : allocate closed sea array
+   !!   get_cssrcsurf : compute source surface area
+   !!   get_cstrgsurf : compute target surface area
+   !!   prt_csctl     : closed sea control print
+   !!   sbc_csupdate  : compute net fw from closed sea
+   !!----------------------------------------------------------------------
+   !
+   USE closea                                  ! closed sea 
+   USE in_out_manager                          ! I/O manager
+   !
+   USE dom_oce,     ONLY: e1e2t                ! ocean space and time domain
+   USE phycst ,     ONLY: rcp                  ! physical constants
+   USE sbc_oce,     ONLY: emp, qns, rnf, sst_m ! ocean surface boundary conditions
+   USE iom    ,     ONLY: iom_put              ! I/O routines
+   USE lib_fortran, ONLY: glob_sum             ! fortran library
+   USE lib_mpp    , ONLY: mpp_min, ctl_stop    ! MPP library
+   !
+   IMPLICIT NONE
+   !
+   PRIVATE
+   !
+   PUBLIC sbc_clo
+   PUBLIC sbc_clo_init
+   !
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: rsurfsrcg, rsurftrgg      !: closed sea source/target glo surface areas 
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: rsurfsrcr, rsurftrgr      !: closed sea source/target rnf surface areas 
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: rsurfsrce, rsurftrge      !: closed sea source/target emp surface areas 
+   !
+   INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:)  :: mcsgrpg, mcsgrpr, mcsgrpe !: closed sea group for glo, rnf and emp
+   !
+   CONTAINS
+   !
+   !!----------------------------------------------------------------------
+   !!  Public subroutines
+   !!----------------------------------------------------------------------
+   !
+   SUBROUTINE sbc_clo_init
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_clo_init  ***
+      !!                    
+      !! ** Purpose :  Initialisation of the variable needed for the net fw closed sea correction
+      !!
+      !! ** Method  :  - compute source surface area for each closed sea
+      !!               - defined the group of each closed sea 
+      !!                 (needed to manage multiple closed sea and one target area like great lakes / St Laurent outlet)
+      !!               - compute target surface area
+      !!----------------------------------------------------------------------
+      !
+      ! 0. Allocate cs variables (surf)
+      CALL alloc_csarr( ncsg, rsurfsrcg, rsurftrgg, mcsgrpg ) 
+      CALL alloc_csarr( ncsr, rsurfsrcr, rsurftrgr, mcsgrpr )
+      CALL alloc_csarr( ncse, rsurfsrce, rsurftrge, mcsgrpe )
+      !
+      ! 1. compute source surface area
+      CALL get_cssrcsurf( ncsg, mask_csglo, rsurfsrcg )
+      CALL get_cssrcsurf( ncsr, mask_csrnf, rsurfsrcr )
+      CALL get_cssrcsurf( ncse, mask_csemp, rsurfsrce )
+      !
+      ! 2. compute target surface area and group number (mcsgrp) for all cs and cases 
+      ! glo could be simpler but for lisibility, all treated the same way
+      ! It is only done once, so not a big deal
+      CALL get_cstrgsurf( ncsg, mask_csglo, mask_csgrpglo, rsurftrgg, mcsgrpg )
+      CALL get_cstrgsurf( ncsr, mask_csrnf, mask_csgrprnf, rsurftrgr, mcsgrpr )
+      CALL get_cstrgsurf( ncse, mask_csemp, mask_csgrpemp, rsurftrge, mcsgrpe )
+      ! 
+      ! 3. print out in ocean.ouput
+      IF ( lwp ) WRITE(numout,*) 'sbc_clo_init : compute surface area for source (closed sea) and target (river mouth)'
+      IF ( lwp ) WRITE(numout,*) '~~~~~~~~~~~~~~'
+      CALL prt_csctl( ncsg, rsurfsrcg, rsurftrgg, mcsgrpg, 'glo' )
+      CALL prt_csctl( ncsr, rsurfsrcr, rsurftrgr, mcsgrpr, 'rnf' )
+      CALL prt_csctl( ncse, rsurfsrce, rsurftrge, mcsgrpe, 'emp' )
+
+   END SUBROUTINE sbc_clo_init
+
+   SUBROUTINE sbc_clo( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_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  : - compute surface freshwater fluxes and associated heat content flux at kt
+      !!              - output closed sea contribution to fw and heat budget
+      !!              - update emp and qns
+      !!----------------------------------------------------------------------
+      INTEGER         , INTENT(in   ) ::   kt       ! ocean model time step
+      !
+      REAL(wp), DIMENSION(jpi,jpj) :: zwcs, zqcs    ! water flux and heat flux correction due to closed seas
+      !!----------------------------------------------------------------------
+      !
+      ! 0. initialisation
+      zwcs(:,:) = 0._wp ; zqcs(:,:) = 0._wp
+      !
+      ! 1. update emp and qns
+      CALL sbc_csupdate( ncsg, mcsgrpg, mask_csglo, mask_csgrpglo, rsurfsrcg, rsurftrgg, 'glo', mask_opnsea, rsurftrgg, zwcs, zqcs )
+      CALL sbc_csupdate( ncsr, mcsgrpr, mask_csrnf, mask_csgrprnf, rsurfsrcr, rsurftrgr, 'rnf', mask_opnsea, rsurftrgg, zwcs, zqcs )
+      CALL sbc_csupdate( ncse, mcsgrpe, mask_csemp, mask_csgrpemp, rsurfsrce, rsurftrge, 'emp', mask_opnsea, rsurftrgg, zwcs, zqcs )
+      !
+      ! 2. ouput closed sea contributions
+      CALL iom_put('wclosea',zwcs)
+      CALL iom_put('qclosea',zqcs)
+      !
+      ! 3. update emp and qns
+      emp(:,:) = emp(:,:) + zwcs(:,:)
+      qns(:,:) = qns(:,:) + zqcs(:,:)
+      !
+   END SUBROUTINE sbc_clo
+   !
+   !!----------------------------------------------------------------------
+   !!  Private subroutines
+   !!----------------------------------------------------------------------
+   !
+   SUBROUTINE get_cssrcsurf(kncs, kmaskcs, psurfsrc)
+      !!-----------------------------------------------------------------------
+      !!                  ***  routine get_cssrcsurf  ***
+      !!
+      !! ** Purpose : compute closed sea (source) surface area
+      !!----------------------------------------------------------------------
+      ! subroutine parameters
+      INTEGER ,                 INTENT(in   ) :: kncs          ! closed sea number
+      INTEGER , DIMENSION(:,:), INTENT(in   ) :: kmaskcs       ! closed sea mask
+      REAL(wp), DIMENSION(:)  , INTENT(  out) :: psurfsrc      ! source surface area
+
+      ! local variables
+      INTEGER :: jcs                                           ! loop index
+      INTEGER, DIMENSION(jpi,jpj) :: imsksrc                   ! source mask
+      !!----------------------------------------------------------------------
+      !
+      DO jcs = 1,kncs  ! loop over closed seas
+         !
+         ! 0. build river mouth mask for this lake
+         WHERE ( kmaskcs == jcs )
+            imsksrc = 1
+         ELSE WHERE
+            imsksrc = 0
+         END WHERE
+         !
+         ! 1. compute target area
+         psurfsrc(jcs) = glob_sum('closea', e1e2t(:,:) * imsksrc(:,:) )
+         !
+      END DO  ! jcs
+
+   END SUBROUTINE
+
+   SUBROUTINE get_cstrgsurf(kncs, kmaskcs, kmaskcsgrp, psurftrg, kcsgrp )
+      !!-----------------------------------------------------------------------
+      !!                  ***  routine get_cstrgsurf  ***
+      !!
+      !! ** Purpose : compute closed sea (target) surface area
+      !!----------------------------------------------------------------------
+      ! subroutine parameters
+      ! input
+      INTEGER,                 INTENT(in   ) :: kncs                 ! closed sea number
+      INTEGER, DIMENSION(:,:), INTENT(in   ) :: kmaskcs, kmaskcsgrp  ! closed sea and group mask
+
+      ! output
+      INTEGER , DIMENSION(:)  , INTENT(  out) :: kcsgrp              ! closed sea group number
+      REAL(wp), DIMENSION(:)  , INTENT(  out) :: psurftrg            ! target surface area
+
+      ! local variables
+      INTEGER :: jcs, jtmp                                           ! tmp
+      INTEGER, DIMENSION(jpi,jpj) :: imskgrp, imsksrc, imsktrg, imsk ! tmp group, source, target and tmp mask
+      !!----------------------------------------------------------------------
+      !
+      DO jcs = 1,kncs  ! loop over closed seas
+         !
+         !! 0. find group number for cs number jcs
+         imskgrp(:,:) = kmaskcsgrp(:,:)
+         imsksrc(:,:) = kmaskcs(:,:)
+         !
+         ! set cs value where cs is defined
+         ! imsk = HUGE outside the cs id jcs
+         imsk(:,:) = HUGE(1)
+         WHERE ( imsksrc(:,:) == jcs ) imsk(:,:) = jcs
+         !
+         ! jtmp = jcs - group id for this lake
+         imsk(:,:) = imsk(:,:) - imskgrp(:,:)
+         jtmp = MINVAL(imsk(:,:)) ; CALL mpp_min('closea',jtmp)
+         ! kcsgrp = group id corresponding to the cs id jcs
+         ! kcsgrp(jcs)=(jcs - (jcs - group id))=group id
+         kcsgrp(jcs) = jcs - jtmp
+         !
+         !! 1. build the target river mouth mask for this lake
+         WHERE ( imskgrp(:,:) * mask_opnsea(:,:) == kcsgrp(jcs) )
+            imsktrg(:,:) = 1
+         ELSE WHERE
+            imsktrg(:,:) = 0
+         END WHERE
+         !
+         !! 2. compute target area
+         psurftrg(jcs) = glob_sum('closea', e1e2t(:,:) * imsktrg(:,:) )
+         !
+      END DO ! jcs
+
+   END SUBROUTINE
+
+   SUBROUTINE prt_csctl(kncs, psurfsrc, psurftrg, kcsgrp, cdcstype)
+      !!-----------------------------------------------------------------------
+      !!                  ***  routine prt_csctl  ***
+      !!
+      !! ** Purpose : output information about each closed sea (src id, trg id, src area and trg area)
+      !!----------------------------------------------------------------------
+      ! subroutine parameters
+      INTEGER,                INTENT(in   ) :: kncs                ! closed sea number                
+      INTEGER, DIMENSION(:) , INTENT(in   ) :: kcsgrp              ! closed sea group number
+      !
+      REAL(wp), DIMENSION(:), INTENT(in   ) :: psurfsrc, psurftrg  ! source and target surface area
+      !
+      CHARACTER(LEN=3)      , INTENT(in   ) :: cdcstype            ! closed sea scheme used for redistribution
+      !!----------------------------------------------------------------------
+      ! local variable
+      INTEGER :: jcs
+      !!----------------------------------------------------------------------
+      !
+      IF ( lwp .AND. kncs > 0 ) THEN
+         WRITE(numout,*)''
+         !
+         WRITE(numout,*)'Closed sea target ',TRIM(cdcstype),' : '
+         !
+         DO jcs = 1,kncs
+            WRITE(numout,FMT='(3a,i3,a,i3)') ' ',TRIM(cdcstype),' closed sea id is ',jcs,' and trg group id is : ', kcsgrp(jcs)
+            WRITE(numout,FMT='(a,f12.2)'   ) ' src surface areas (km2) : ', psurfsrc(jcs) * 1.0e-6
+            WRITE(numout,FMT='(a,f12.2)'   ) ' trg surface areas (km2) : ', psurftrg(jcs) * 1.0e-6
+         END DO
+         !
+         WRITE(numout,*)''
+      END IF
+
+   END SUBROUTINE
+
+   SUBROUTINE sbc_csupdate(kncs, kcsgrp, kmsk_src, kmsk_grp, psurfsrc, psurftrg, cdcstype, kmsk_opnsea, psurf_opnsea, pwcs, pqcs)
+      !!-----------------------------------------------------------------------
+      !!                  ***  routine sbc_csupdate  ***
+      !!
+      !! ** Purpose : - compute the net freshwater fluxes over each closed seas
+      !!              - apply correction to closed sea source/target net fwf accordingly
+      !!----------------------------------------------------------------------
+      ! subroutine parameters
+      CHARACTER(LEN=3)        , INTENT(in   ) :: cdcstype  ! closed sea scheme used for redistribution
+      !
+      INTEGER,                 INTENT(in)     :: kncs                                 ! closed sea id
+      INTEGER, DIMENSION(:  ), INTENT(in)     :: kcsgrp                               ! closed sea group id
+      INTEGER, DIMENSION(:,:), INTENT(in)     :: kmsk_src, kmsk_grp, kmsk_opnsea      ! source, target, open ocean mask
+      
+      REAL(wp), DIMENSION(:)  , INTENT(in   ) :: psurfsrc, psurftrg, psurf_opnsea ! source, target and open ocean surface area
+      REAL(wp), DIMENSION(:,:), INTENT(inout) :: pwcs, pqcs                       ! water and heat flux correction due to closed seas
+
+
+      ! local variables
+      INTEGER :: jcs                                     ! loop index over closed sea 
+      INTEGER, DIMENSION(jpi,jpj) :: imsk_src, imsk_trg  ! tmp array source and target closed sea masks
+      
+      REAL(wp) :: zcsfw, zcsh        ! total fresh water and associated heat over one closed sea
+      REAL(wp) :: zcsfwf             ! mean fresh water flux over one closed sea
+      REAL(wp) :: zsurftrg, zsurfsrc ! total target surface area
+      !!----------------------------------------------------------------------
+      !
+      DO jcs = 1, kncs  ! loop over closed seas
+         !
+         !! 0. get mask and surface of the closed sea
+         ! mask src
+         WHERE ( kmsk_src(:,:) == jcs ) 
+            imsk_src(:,:) = 1
+         ELSEWHERE
+            imsk_src(:,:) = 0
+         END WHERE
+         ! area src
+         zsurfsrc = psurfsrc(jcs)
+         !
+         !! 1. Work out net freshwater over the closed sea from EMP - RNF.
+         !!    Work out net heat associated with the correction (needed for conservation)
+         !!    (PM: should we consider used delayed glob sum ?)
+         zcsfw  = glob_sum( 'closea', e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * imsk_src(:,:) )
+         !
+         !! 2. Deal with runoff special case (net evaporation spread globally)
+         !!    and compute trg mask
+         IF (cdcstype == 'rnf' .AND. zcsfw  > 0._wp) THEN
+            zsurftrg = psurf_opnsea(1)           ! change the target area surface
+            imsk_trg = kcsgrp(jcs) * kmsk_opnsea ! trg mask is now the open sea mask
+         ELSE
+            zsurftrg = psurftrg(jcs)
+            imsk_trg = kmsk_grp * kmsk_opnsea
+         END IF
+         !
+         !! 3. Subtract residuals from source points
+         zcsfwf = zcsfw / zsurfsrc
+         pwcs(:,:) = pwcs(:,:) -       zcsfwf              * imsk_src(:,:)
+         pqcs(:,:) = pqcs(:,:) + rcp * zcsfwf * sst_m(:,:) * imsk_src(:,:)
+         !
+         !! 4. Add residuals to target points 
+         !!    Do not use pqcs(:,:) = pqcs(:,:) - rcp * zcsfw  * sst_m(:,:) / zsurftrg 
+         !!    as there is no reason heat will be conserved with this formulation
+         zcsh   = glob_sum( 'closea', e1e2t(:,:) * rcp * zcsfwf * sst_m(:,:) * imsk_src(:,:) )
+         WHERE( imsk_trg(:,:) == kcsgrp(jcs) )
+            pwcs(:,:) = pwcs(:,:) + zcsfw / zsurftrg
+            pqcs(:,:) = pqcs(:,:) - zcsh  / zsurftrg
+         ENDWHERE
+         !
+      END DO ! jcs
+
+   END SUBROUTINE
+
+   SUBROUTINE alloc_csarr( klen, pvarsrc, pvartrg, kvargrp )
+      !!-----------------------------------------------------------------------
+      !!                  ***  routine alloc_cssurf  ***
+      !!
+      !! ** Purpose : allocate closed sea surface array
+      !!----------------------------------------------------------------------
+      ! subroutine parameters
+      INTEGER,  INTENT(in) :: klen
+      INTEGER,  ALLOCATABLE, DIMENSION(:), INTENT(  out) :: kvargrp
+      REAL(wp), ALLOCATABLE, DIMENSION(:), INTENT(  out) :: pvarsrc, pvartrg 
+      !
+      ! local variables
+      INTEGER :: ierr
+      !!----------------------------------------------------------------------
+      !
+      ! klen (number of lake) can be zero so use MAX(klen,1) to avoid 0 length array
+      ALLOCATE( pvarsrc(MAX(klen,1)) , pvartrg(MAX(klen,1)) , STAT=ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'sbc_clo: failed to allocate surf array')
+      !
+      ALLOCATE( kvargrp(MAX(klen,1)) , STAT=ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'sbc_clo: failed to allocate group array')
+      !
+      ! initialise to 0
+      pvarsrc(:) = 0.e0_wp
+      pvartrg(:) = 0.e0_wp
+      kvargrp(:) = 0
+   END SUBROUTINE
+
+END MODULE
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbccpl.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbccpl.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbccpl.F90	(revision 12928)
@@ -27,4 +27,5 @@
    USE sbcwave         ! surface boundary condition: waves
    USE phycst          ! physical constants
+   USE isf_oce , ONLY : l_isfoasis, fwfisf_oasis ! ice shelf boundary condition
 #if defined key_si3
    USE ice            ! ice variables
@@ -32,9 +33,8 @@
    USE cpl_oasis3     ! OASIS3 coupling
    USE geo2ocean      ! 
-   USE oce     , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev
+   USE oce     , ONLY : ts, uu, vv, ssh, fraqsr_1lev
    USE ocealb         ! 
    USE eosbn2         ! 
    USE sbcrnf  , ONLY : l_rnfcpl
-   USE sbcisf  , ONLY : l_isfcpl
 #if defined key_cice
    USE ice_domain_size, only: ncat
@@ -193,10 +193,10 @@
 
    REAL(wp) ::   rpref = 101000._wp   ! reference atmospheric pressure[N/m2] 
-   REAL(wp) ::   r1_grau              ! = 1.e0 / (grav * rau0) 
+   REAL(wp) ::   r1_grau              ! = 1.e0 / (grav * rho0) 
 
    INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) ::   nrcvinfo           ! OASIS info argument
 
    !! Substitution
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -264,9 +264,7 @@
       ! ================================ !
       !
-      REWIND( numnam_ref )              ! Namelist namsbc_cpl in reference namelist : Variables for OASIS coupling
       READ  ( numnam_ref, namsbc_cpl, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_cpl in reference namelist' )
       !
-      REWIND( numnam_cfg )              ! Namelist namsbc_cpl in configuration namelist : Variables for OASIS coupling
       READ  ( numnam_cfg, namsbc_cpl, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_cpl in configuration namelist' )
@@ -453,5 +451,5 @@
       CASE( 'conservative'  )
          srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE.
-         IF ( k_ice <= 1 )  srcv(jpr_ievp)%laction = .FALSE.
+         IF( k_ice <= 1 )  srcv(jpr_ievp)%laction = .FALSE.
       CASE( 'oce and ice'   )   ;   srcv( (/jpr_ievp, jpr_sbpr, jpr_semp, jpr_oemp/) )%laction = .TRUE.
       CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' )
@@ -474,8 +472,9 @@
       srcv(jpr_icb)%clname = 'OIceberg'   ;  IF( TRIM( sn_rcv_icb%cldes) == 'coupled' )   srcv(jpr_icb)%laction = .TRUE.
 
-      IF( srcv(jpr_isf)%laction .AND. ln_isf ) THEN
-         l_isfcpl             = .TRUE.                      ! -> no need to read isf in sbcisf
+      IF( srcv(jpr_isf)%laction ) THEN
+         l_isfoasis = .TRUE.  ! -> isf fwf comes from oasis
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) '   iceshelf received from oasis '
+         CALL ctl_stop('STOP','not coded')
       ENDIF
       !
@@ -533,5 +532,4 @@
       !                                                      ! ------------------------- !
       srcv(jpr_taum)%clname = 'O_TauMod'   ;   IF( TRIM(sn_rcv_taumod%cldes) == 'coupled' )   srcv(jpr_taum)%laction = .TRUE.
-      lhftau = srcv(jpr_taum)%laction
       !
       !                                                      ! ------------------------- !
@@ -558,5 +556,5 @@
       srcv(jpr_botm )%clname = 'OBotMlt'
       IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN
-         IF ( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN
+         IF( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN
             srcv(jpr_topm:jpr_botm)%nct = nn_cats_cpl
          ELSE
@@ -569,8 +567,14 @@
       !                                                      ! ------------------------- !
       srcv(jpr_ts_ice)%clname = 'OTsfIce'    ! needed by Met Office
-      IF ( TRIM( sn_rcv_ts_ice%cldes ) == 'ice' )   srcv(jpr_ts_ice)%laction = .TRUE.
-      IF ( TRIM( sn_rcv_ts_ice%clcat ) == 'yes' )   srcv(jpr_ts_ice)%nct     = nn_cats_cpl
-      IF ( TRIM( sn_rcv_emp%clcat    ) == 'yes' )   srcv(jpr_ievp)%nct       = nn_cats_cpl
-
+      IF( TRIM( sn_rcv_ts_ice%cldes ) == 'ice' )   srcv(jpr_ts_ice)%laction = .TRUE.
+      IF( TRIM( sn_rcv_ts_ice%clcat ) == 'yes' )   srcv(jpr_ts_ice)%nct     = nn_cats_cpl
+      IF( TRIM( sn_rcv_emp%clcat    ) == 'yes' )   srcv(jpr_ievp)%nct       = nn_cats_cpl
+
+#if defined key_si3
+      IF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN 
+         IF( .NOT.srcv(jpr_ts_ice)%laction )  &
+            &   CALL ctl_stop( 'sbc_cpl_init: srcv(jpr_ts_ice)%laction should be set to true when ln_cndflx=T' )     
+      ENDIF
+#endif
       !                                                      ! ------------------------- !
       !                                                      !      Wave breaking        !    
@@ -693,5 +697,5 @@
          ! for example O_Runoff received by OPA from SAS and therefore O_Runoff received by SAS from the Atmosphere
          DO jn = 1, jprcv
-            IF ( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname))
+            IF( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname))
          END DO
          !
@@ -720,18 +724,18 @@
       ! =================================================== !
       DO jn = 1, jprcv
-         IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) )
+         IF( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) )
       END DO
       ! Allocate taum part of frcv which is used even when not received as coupling field
-      IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) )
+      IF( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) )
       ! Allocate w10m part of frcv which is used even when not received as coupling field
-      IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) )
+      IF( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) )
       ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field
-      IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) )
-      IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) )
+      IF( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) )
+      IF( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) )
       ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE.
       IF( k_ice /= 0 ) THEN
-         IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) )
-         IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) )
-      END IF
+         IF( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) )
+         IF( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) )
+      ENDIF
 
       ! ================================ !
@@ -757,5 +761,5 @@
       CASE( 'oce and ice' , 'weighted oce and ice' , 'oce and weighted ice' )
          ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE.
-         IF ( TRIM( sn_snd_temp%clcat ) == 'yes' )  ssnd(jps_tice)%nct = nn_cats_cpl
+         IF( TRIM( sn_snd_temp%clcat ) == 'yes' )  ssnd(jps_tice)%nct = nn_cats_cpl
       CASE( 'mixed oce-ice'                        )   ;   ssnd( jps_tmix )%laction = .TRUE.
       CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' )
@@ -777,5 +781,5 @@
       !     1. sending mixed oce-ice albedo or
       !     2. receiving mixed oce-ice solar radiation 
-      IF ( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN
+      IF( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN
          CALL oce_alb( zaos, zacs )
          ! Due to lack of information on nebulosity : mean clear/overcast sky
@@ -796,9 +800,9 @@
          ssnd(jps_fice1)%laction = .TRUE.                 ! First-order regridded ice concentration, to be used producing atmos-to-ice fluxes (Met Office requirement)
 ! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now
-         IF ( TRIM( sn_snd_thick%clcat  ) == 'yes' ) ssnd(jps_fice)%nct  = nn_cats_cpl
-         IF ( TRIM( sn_snd_thick1%clcat ) == 'yes' ) ssnd(jps_fice1)%nct = nn_cats_cpl
+         IF( TRIM( sn_snd_thick%clcat  ) == 'yes' ) ssnd(jps_fice)%nct  = nn_cats_cpl
+         IF( TRIM( sn_snd_thick1%clcat ) == 'yes' ) ssnd(jps_fice1)%nct = nn_cats_cpl
       ENDIF
       
-      IF (TRIM( sn_snd_ifrac%cldes )  == 'coupled') ssnd(jps_ficet)%laction = .TRUE. 
+      IF(TRIM( sn_snd_ifrac%cldes )  == 'coupled') ssnd(jps_ficet)%laction = .TRUE. 
 
       SELECT CASE ( TRIM( sn_snd_thick%cldes ) )
@@ -806,10 +810,10 @@
       CASE( 'ice and snow' ) 
          ssnd(jps_hice:jps_hsnw)%laction = .TRUE.
-         IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN
+         IF( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN
             ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl
          ENDIF
       CASE ( 'weighted ice and snow' ) 
          ssnd(jps_hice:jps_hsnw)%laction = .TRUE.
-         IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl
+         IF( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl
       CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_thick%cldes' )
       END SELECT
@@ -828,9 +832,9 @@
          ssnd(jps_a_p)%laction  = .TRUE. 
          ssnd(jps_ht_p)%laction = .TRUE. 
-         IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 
+         IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 
             ssnd(jps_a_p)%nct  = nn_cats_cpl 
             ssnd(jps_ht_p)%nct = nn_cats_cpl 
          ELSE 
-            IF ( nn_cats_cpl > 1 ) THEN 
+            IF( nn_cats_cpl > 1 ) THEN 
                CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_mpnd%cldes if not exchanging category fields' ) 
             ENDIF 
@@ -839,5 +843,5 @@
          ssnd(jps_a_p)%laction  = .TRUE. 
          ssnd(jps_ht_p)%laction = .TRUE. 
-         IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 
+         IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 
             ssnd(jps_a_p)%nct  = nn_cats_cpl  
             ssnd(jps_ht_p)%nct = nn_cats_cpl  
@@ -862,5 +866,4 @@
       ELSE IF( sn_snd_crt%clvgrd /= 'T' ) THEN  
          CALL ctl_stop( 'sn_snd_crt%clvgrd must be equal to T' )
-         ssnd(jps_ocx1:jps_ivz1)%clgrid  = 'T'      ! all oce and ice components on the same unique grid
       ENDIF
       ssnd(jps_ocx1:jps_ivz1)%laction = .TRUE.   ! default: all are send
@@ -914,8 +917,8 @@
       CASE ( 'ice only' ) 
          ssnd(jps_ttilyr)%laction = .TRUE. 
-         IF ( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) THEN 
+         IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) THEN 
             ssnd(jps_ttilyr)%nct = nn_cats_cpl 
          ELSE 
-            IF ( nn_cats_cpl > 1 ) THEN 
+            IF( nn_cats_cpl > 1 ) THEN 
                CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_ttilyr%cldes if not exchanging category fields' ) 
             ENDIF 
@@ -923,5 +926,5 @@
       CASE ( 'weighted ice' ) 
          ssnd(jps_ttilyr)%laction = .TRUE. 
-         IF ( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) ssnd(jps_ttilyr)%nct = nn_cats_cpl 
+         IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) ssnd(jps_ttilyr)%nct = nn_cats_cpl 
       CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_ttilyr%cldes;'//sn_snd_ttilyr%cldes ) 
       END SELECT 
@@ -933,8 +936,8 @@
       CASE ( 'ice only' ) 
          ssnd(jps_kice)%laction = .TRUE. 
-         IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN 
+         IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN 
             ssnd(jps_kice)%nct = nn_cats_cpl 
          ELSE 
-            IF ( nn_cats_cpl > 1 ) THEN 
+            IF( nn_cats_cpl > 1 ) THEN 
                CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_cond%cldes if not exchanging category fields' ) 
             ENDIF 
@@ -942,5 +945,5 @@
       CASE ( 'weighted ice' ) 
          ssnd(jps_kice)%laction = .TRUE. 
-         IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = nn_cats_cpl 
+         IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = nn_cats_cpl 
       CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_cond%cldes;'//sn_snd_cond%cldes ) 
       END SELECT 
@@ -1003,5 +1006,5 @@
          ! for example O_SSTSST sent by OPA to SAS and therefore S_SSTSST sent by SAS to the Atmosphere
          DO jn = 1, jpsnd
-            IF ( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname))
+            IF( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname))
          END DO
          !
@@ -1030,5 +1033,5 @@
       CALL cpl_define(jprcv, jpsnd, nn_cplmodel)
       
-      IF (ln_usecplmask) THEN 
+      IF(ln_usecplmask) THEN 
          xcplmask(:,:,:) = 0.
          CALL iom_open( 'cplmask', inum )
@@ -1041,13 +1044,8 @@
       xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 )
       !
-      ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'I_QsrOce' ) + cpl_freq( 'I_QsrMix' )
-      IF( ln_dm2dc .AND. ln_cpl .AND. ncpl_qsr_freq /= 86400 )   &
-         &   CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' )
-      IF( ln_dm2dc .AND. ln_cpl ) ncpl_qsr_freq = 86400 / ncpl_qsr_freq
-      !
    END SUBROUTINE sbc_cpl_init
 
 
-   SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice )     
+   SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice, Kbb, Kmm )     
       !!----------------------------------------------------------------------
       !!             ***  ROUTINE sbc_cpl_rcv  ***
@@ -1099,4 +1097,5 @@
       INTEGER, INTENT(in) ::   k_fsbc      ! frequency of sbc (-> ice model) computation 
       INTEGER, INTENT(in) ::   k_ice       ! ice management in the sbc (=0/1/2/3)
+      INTEGER, INTENT(in) ::   Kbb, Kmm    ! ocean model time level indices
       !!
       LOGICAL  ::   llnewtx, llnewtau      ! update wind stress components and module??
@@ -1111,4 +1110,14 @@
       !!----------------------------------------------------------------------
       !
+      IF( kt == nit000 ) THEN
+      !   cannot be done in the init phase when we use agrif as cpl_freq requires that oasis_enddef is done
+         ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'I_QsrOce' ) + cpl_freq( 'I_QsrMix' )
+         IF( ln_dm2dc .AND. ncpl_qsr_freq /= 86400 )   &
+            &   CALL ctl_stop( 'sbc_cpl_rcv: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' )
+
+         IF( ncpl_qsr_freq /= 0) ncpl_qsr_freq = 86400 / ncpl_qsr_freq ! used by top
+         
+      ENDIF
+      !
       IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0)
       !
@@ -1116,5 +1125,5 @@
       !                                                      ! Receive all the atmos. fields (including ice information)
       !                                                      ! ======================================================= !
-      isec = ( kt - nit000 ) * NINT( rdt )                      ! date of exchanges
+      isec = ( kt - nit000 ) * NINT( rn_Dt )                      ! date of exchanges
       DO jn = 1, jprcv                                          ! received fields sent by the atmosphere
          IF( srcv(jn)%laction )   CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) )
@@ -1158,10 +1167,8 @@
             !                              
             IF( srcv(jpr_otx1)%clgrid == 'T' ) THEN
-               DO jj = 2, jpjm1                                          ! T ==> (U,V)
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1) )
-                     frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji  ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) )
-                  END DO
-               END DO
+               DO_2D_00_00
+                  frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1) )
+                  frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji  ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) )
+               END_2D
                CALL lbc_lnk_multi( 'sbccpl', frcv(jpr_otx1)%z3(:,:,1), 'U',  -1., frcv(jpr_oty1)%z3(:,:,1), 'V',  -1. )
             ENDIF
@@ -1184,11 +1191,9 @@
          ! => need to be done only when otx1 was changed
          IF( llnewtx ) THEN
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vect. opt.
-                  zzx = frcv(jpr_otx1)%z3(ji-1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1)
-                  zzy = frcv(jpr_oty1)%z3(ji  ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1)
-                  frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy )
-               END DO
-            END DO
+            DO_2D_00_00
+               zzx = frcv(jpr_otx1)%z3(ji-1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1)
+               zzy = frcv(jpr_oty1)%z3(ji  ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1)
+               frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy )
+            END_2D
             CALL lbc_lnk( 'sbccpl', frcv(jpr_taum)%z3(:,:,1), 'T', 1. )
             llnewtau = .TRUE.
@@ -1211,9 +1216,7 @@
          IF( llnewtau ) THEN 
             zcoef = 1. / ( zrhoa * zcdrag ) 
-            DO jj = 1, jpj
-               DO ji = 1, jpi 
-                  frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )
-               END DO
-            END DO
+            DO_2D_11_11
+               frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )
+            END_2D
          ENDIF
       ENDIF
@@ -1243,16 +1246,4 @@
       IF( srcv(jpr_co2)%laction )   atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1)
       !
-      !                                                      ! ================== !
-      !                                                      !   ice skin temp.   !
-      !                                                      ! ================== !
-#if defined key_si3
-      ! needed by Met Office
-      IF( srcv(jpr_ts_ice)%laction ) THEN 
-         WHERE    ( frcv(jpr_ts_ice)%z3(:,:,:) > 0.0  )   ;   tsfc_ice(:,:,:) = 0.0 
-         ELSEWHERE( frcv(jpr_ts_ice)%z3(:,:,:) < -60. )   ;   tsfc_ice(:,:,:) = -60.
-         ELSEWHERE                                        ;   tsfc_ice(:,:,:) = frcv(jpr_ts_ice)%z3(:,:,:)
-         END WHERE
-      ENDIF 
-#endif
       !                                                      ! ========================= ! 
       !                                                      ! Mean Sea Level Pressure   !   (taum) 
@@ -1261,10 +1252,10 @@
           IF( kt /= nit000 )   ssh_ibb(:,:) = ssh_ib(:,:)    !* Swap of ssh_ib fields 
 
-          r1_grau = 1.e0 / (grav * rau0)               !* constant for optimization 
+          r1_grau = 1.e0 / (grav * rho0)               !* constant for optimization 
           ssh_ib(:,:) = - ( frcv(jpr_mslp)%z3(:,:,1) - rpref ) * r1_grau    ! equivalent ssh (inverse barometer) 
           apr   (:,:) =     frcv(jpr_mslp)%z3(:,:,1)                         !atmospheric pressure 
     
           IF( kt == nit000 ) ssh_ibb(:,:) = ssh_ib(:,:)  ! correct this later (read from restart if possible) 
-      END IF 
+      ENDIF 
       !
       IF( ln_sdw ) THEN  ! Stokes Drift correction activated
@@ -1302,5 +1293,5 @@
          IF( srcv(jpr_sdrftx)%laction .OR. srcv(jpr_sdrfty)%laction .OR. srcv(jpr_wper)%laction &
                                       .OR. srcv(jpr_hsig)%laction   .OR. srcv(jpr_wfreq)%laction) THEN
-            CALL sbc_stokes()
+            CALL sbc_stokes( Kmm )
          ENDIF
       ENDIF
@@ -1354,12 +1345,12 @@
       IF( srcv(jpr_ocx1)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling
          ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1)
-         ub (:,:,1) = ssu_m(:,:)                             ! will be used in icestp in the call of ice_forcing_tau
-         un (:,:,1) = ssu_m(:,:)                             ! will be used in sbc_cpl_snd if atmosphere coupling
+         uu(:,:,1,Kbb) = ssu_m(:,:)                          ! will be used in icestp in the call of ice_forcing_tau
+         uu(:,:,1,Kmm) = ssu_m(:,:)                          ! will be used in sbc_cpl_snd if atmosphere coupling
          CALL iom_put( 'ssu_m', ssu_m )
       ENDIF
       IF( srcv(jpr_ocy1)%laction ) THEN
          ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1)
-         vb (:,:,1) = ssv_m(:,:)                             ! will be used in icestp in the call of ice_forcing_tau
-         vn (:,:,1) = ssv_m(:,:)                             ! will be used in sbc_cpl_snd if atmosphere coupling
+         vv(:,:,1,Kbb) = ssv_m(:,:)                          ! will be used in icestp in the call of ice_forcing_tau
+         vv(:,:,1,Kmm) = ssv_m(:,:)                          ! will be used in sbc_cpl_snd if atmosphere coupling
          CALL iom_put( 'ssv_m', ssv_m )
       ENDIF
@@ -1405,5 +1396,9 @@
              rnf(:,:)    = rnf(:,:) + fwficb(:,:)   ! iceberg added to runfofs
          ENDIF
-         IF( srcv(jpr_isf)%laction )  fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1)  ! fresh water flux from the isf (fwfisf <0 mean melting)  
+         !
+         ! ice shelf fwf
+         IF( srcv(jpr_isf)%laction )  THEN
+            fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1)  ! fresh water flux from the isf (fwfisf <0 mean melting)  
+         END IF
         
          IF( ln_mixcpl ) THEN   ;   emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:)
@@ -1415,5 +1410,5 @@
          ELSE IF( srcv(jpr_qnsmix)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
          ELSE                                       ;   zqns(:,:) = 0._wp
-         END IF
+         ENDIF
          ! update qns over the free ocean with:
          IF( nn_components /= jp_iam_opa ) THEN
@@ -1486,4 +1481,5 @@
       INTEGER ::   ji, jj   ! dummy loop indices
       INTEGER ::   itx      ! index of taux over ice
+      REAL(wp)                     ::   zztmp1, zztmp2
       REAL(wp), DIMENSION(jpi,jpj) ::   ztx, zty 
       !!----------------------------------------------------------------------
@@ -1549,29 +1545,14 @@
             p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1)                   ! (U,V) ==> (U,V)
             p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)
-         CASE( 'F' )
-            DO jj = 2, jpjm1                                   ! F ==> (U,V)
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji  ,jj-1,1) )
-                  p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji,jj,1) + frcv(jpr_ity1)%z3(ji-1,jj  ,1) )
-               END DO
-            END DO
          CASE( 'T' )
-            DO jj = 2, jpjm1                                   ! T ==> (U,V)
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj  ,1) + frcv(jpr_itx1)%z3(ji,jj,1) )
-                  p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji  ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) )
-               END DO
-            END DO
-         CASE( 'I' )
-            DO jj = 2, jpjm1                                   ! I ==> (U,V)
-               DO ji = 2, jpim1   ! NO vector opt.
-                  p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj  ,1) )
-                  p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji+1,jj+1,1) + frcv(jpr_ity1)%z3(ji  ,jj+1,1) )
-               END DO
-            END DO
+            DO_2D_00_00
+               ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and  rheology 
+               zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj  ,1) )
+               zztmp2 = 0.5_wp * ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji  ,jj+1,1) )
+               p_taui(ji,jj) = zztmp1 * ( frcv(jpr_itx1)%z3(ji+1,jj  ,1) + frcv(jpr_itx1)%z3(ji,jj,1) )
+               p_tauj(ji,jj) = zztmp2 * ( frcv(jpr_ity1)%z3(ji  ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) )
+            END_2D
+            CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U',  -1., p_tauj, 'V',  -1. )
          END SELECT
-         IF( srcv(jpr_itx1)%clgrid /= 'U' ) THEN 
-            CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U',  -1., p_tauj, 'V',  -1. )
-         ENDIF
          
       ENDIF
@@ -1630,11 +1611,11 @@
       !!                   sprecip           solid precipitation over the ocean  
       !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in), DIMENSION(:,:)             ::   picefr     ! ice fraction                [0 to 1]
-      !                                                !!           ! optional arguments, used only in 'mixed oce-ice' case
-      REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL ::   palbi      ! all skies ice albedo 
-      REAL(wp), INTENT(in), DIMENSION(:,:  ), OPTIONAL ::   psst       ! sea surface temperature     [Celsius]
-      REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL ::   pist       ! ice surface temperature     [Kelvin]
-      REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL ::   phs        ! snow depth                  [m]
-      REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL ::   phi        ! ice thickness               [m]
+      REAL(wp), INTENT(in)   , DIMENSION(:,:)             ::   picefr     ! ice fraction                [0 to 1]
+      !                                                   !!           ! optional arguments, used only in 'mixed oce-ice' case or for Met-Office coupling
+      REAL(wp), INTENT(in)   , DIMENSION(:,:,:), OPTIONAL ::   palbi      ! all skies ice albedo 
+      REAL(wp), INTENT(in)   , DIMENSION(:,:  ), OPTIONAL ::   psst       ! sea surface temperature     [Celsius]
+      REAL(wp), INTENT(inout), DIMENSION(:,:,:), OPTIONAL ::   pist       ! ice surface temperature     [Kelvin] => inout for Met-Office
+      REAL(wp), INTENT(in)   , DIMENSION(:,:,:), OPTIONAL ::   phs        ! snow depth                  [m]
+      REAL(wp), INTENT(in)   , DIMENSION(:,:,:), OPTIONAL ::   phi        ! ice thickness               [m]
       !
       INTEGER  ::   ji, jj, jl   ! dummy loop index
@@ -1643,5 +1624,5 @@
       REAL(wp), DIMENSION(jpi,jpj)     ::   zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip  , zevap_oce, zdevap_ice
       REAL(wp), DIMENSION(jpi,jpj)     ::   zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice
-      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice    !!gm , zfrqsr_tr_i
+      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice, zqtr_ice_top, ztsu
       !!----------------------------------------------------------------------
       !
@@ -1687,5 +1668,5 @@
       ! --- evaporation over ice (kg/m2/s) --- !
       DO jl=1,jpl
-         IF (sn_rcv_emp%clcat == 'yes') THEN   ;   zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl)
+         IF(sn_rcv_emp%clcat == 'yes') THEN   ;   zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl)
          ELSE                                  ;   zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,1 )   ;   ENDIF
       ENDDO
@@ -1708,5 +1689,5 @@
       ENDIF
       IF( srcv(jpr_isf)%laction ) THEN   ! iceshelf (fwfisf <0 mean melting)
-        fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1)  
+        fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1)  
       ENDIF
 
@@ -1747,5 +1728,5 @@
       ENDIF
       IF( srcv(jpr_isf)%laction ) THEN   ! iceshelf (fwfisf <0 mean melting)
-        fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1)
+        fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1)
       ENDIF
       !
@@ -1774,4 +1755,5 @@
       IF( iom_use('snow_ao_cea') )  CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) )                  )  ! Snow over ice-free ocean  (cell average)
       IF( iom_use('snow_ai_cea') )  CALL iom_put( 'snow_ai_cea' , sprecip(:,:) *           zsnw(:,:)                    )  ! Snow over sea-ice         (cell average)
+      IF( iom_use('rain_ao_cea') )  CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * picefr(:,:)         )  ! liquid precipitation over ocean (cell average)
       IF( iom_use('subl_ai_cea') )  CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * tmask(:,:,1) )  ! Sublimation over sea-ice (cell average)
       IF( iom_use('evap_ao_cea') )  CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1)  &
@@ -1786,5 +1768,5 @@
       CASE( 'conservative' )     ! the required fields are directly provided
          zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
-         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
+         IF( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
             zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl)
          ELSE
@@ -1795,5 +1777,5 @@
       CASE( 'oce and ice' )      ! the total flux is computed from ocean and ice fluxes
          zqns_tot(:,:) =  ziceld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)
-         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
+         IF( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
             DO jl=1,jpl
                zqns_tot(:,:   ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)   
@@ -1810,7 +1792,17 @@
 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED **
          zqns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1)
-         zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1)    &
-            &            + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,:  ) ) * ziceld(:,:)   &
-            &                                           + pist(:,:,1) * picefr(:,:) ) )
+         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
+            DO jl = 1, jpl
+               zqns_ice(:,:,jl) = frcv(jpr_qnsmix)%z3(:,:,jl)    &
+                  &             + frcv(jpr_dqnsdt)%z3(:,:,jl) * ( pist(:,:,jl) - ( ( rt0 + psst(:,:) ) * ziceld(:,:)   &
+                  &                                                                + pist(:,:,jl) * picefr(:,:) ) )
+            END DO
+         ELSE
+            DO jl = 1, jpl
+               zqns_ice(:,:,jl) = frcv(jpr_qnsmix)%z3(:,:, 1)    &
+                  &             + frcv(jpr_dqnsdt)%z3(:,:, 1) * ( pist(:,:,jl) - ( ( rt0 + psst(:,:) ) * ziceld(:,:)   &
+                  &                                                                + pist(:,:,jl) * picefr(:,:) ) )
+            END DO
+         ENDIF
       END SELECT
       !                                     
@@ -1897,13 +1889,15 @@
 #endif
       ! outputs
-      IF ( srcv(jpr_cal)%laction       ) CALL iom_put('hflx_cal_cea'    , - frcv(jpr_cal)%z3(:,:,1) * rLfus )                      ! latent heat from calving
-      IF ( srcv(jpr_icb)%laction       ) CALL iom_put('hflx_icb_cea'    , - frcv(jpr_icb)%z3(:,:,1) * rLfus )                      ! latent heat from icebergs melting
-      IF ( iom_use('hflx_rain_cea')    ) CALL iom_put('hflx_rain_cea'   , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )        ! heat flux from rain (cell average)
-      IF ( iom_use('hflx_evap_cea')    ) CALL iom_put('hflx_evap_cea'   , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) &
+      IF( srcv(jpr_cal)%laction       ) CALL iom_put('hflx_cal_cea'    , - frcv(jpr_cal)%z3(:,:,1) * rLfus )                      ! latent heat from calving
+      IF( srcv(jpr_icb)%laction       ) CALL iom_put('hflx_icb_cea'    , - frcv(jpr_icb)%z3(:,:,1) * rLfus )                      ! latent heat from icebergs melting
+      IF( iom_use('hflx_rain_cea')    ) CALL iom_put('hflx_rain_cea'   , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )        ! heat flux from rain (cell average)
+      IF( iom_use('hflx_evap_cea')    ) CALL iom_put('hflx_evap_cea'   , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) &
            &                                                              * picefr(:,:) ) * zcptn(:,:) * tmask(:,:,1) )            ! heat flux from evap (cell average)
-      IF ( iom_use('hflx_snow_cea')    ) CALL iom_put('hflx_snow_cea'   , sprecip(:,:) * ( zcptsnw(:,:) - rLfus )  )               ! heat flux from snow (cell average)
-      IF ( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) &
+      IF( iom_use('hflx_prec_cea')    ) CALL iom_put('hflx_prec_cea'   ,  sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) +  &                    ! heat flux from all precip (cell avg)
+         &                                                               ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )
+      IF( iom_use('hflx_snow_cea')    ) CALL iom_put('hflx_snow_cea'   , sprecip(:,:) * ( zcptsnw(:,:) - rLfus )  )               ! heat flux from snow (cell average)
+      IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) &
            &                                                              * ( 1._wp - zsnw(:,:) )                  )               ! heat flux from snow (over ocean)
-      IF ( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 
+      IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 
            &                                                              *           zsnw(:,:)                    )               ! heat flux from snow (over ice)
       ! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp.
@@ -1916,5 +1910,5 @@
       CASE( 'conservative' )
          zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
-         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
+         IF( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
             zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl)
          ELSE
@@ -1924,9 +1918,7 @@
             END DO
          ENDIF
-         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
-         zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1)
       CASE( 'oce and ice' )
          zqsr_tot(:,:  ) =  ziceld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)
-         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
+         IF( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
             DO jl = 1, jpl
                zqsr_tot(:,:   ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)   
@@ -1945,7 +1937,17 @@
 !       Create solar heat flux over ice using incoming solar heat flux and albedos
 !       ( see OASIS3 user guide, 5th edition, p39 )
-         zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) )   &
-            &            / (  1.- ( alb_oce_mix(:,:  ) * ziceld(:,:)       &
-            &                     + palbi      (:,:,1) * picefr(:,:) ) )
+         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
+            DO jl = 1, jpl
+               zqsr_ice(:,:,jl) = frcv(jpr_qsrmix)%z3(:,:,jl) * ( 1.- palbi(:,:,jl) )   &
+                  &            / (  1.- ( alb_oce_mix(:,:   ) * ziceld(:,:)       &
+                  &                     + palbi      (:,:,jl) * picefr(:,:) ) )
+            END DO
+         ELSE
+            DO jl = 1, jpl
+               zqsr_ice(:,:,jl) = frcv(jpr_qsrmix)%z3(:,:, 1) * ( 1.- palbi(:,:,jl) )   &
+                  &            / (  1.- ( alb_oce_mix(:,:   ) * ziceld(:,:)       &
+                  &                     + palbi      (:,:,jl) * picefr(:,:) ) )
+            END DO
+         ENDIF
       CASE( 'none'      )       ! Not available as for now: needs additional coding  
       !                         ! since fields received, here zqsr_tot,  are not defined with none option
@@ -1984,5 +1986,5 @@
       !                                                      ! ========================= !
       CASE ('coupled')
-         IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN
+         IF( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN
             zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)
          ELSE
@@ -2007,8 +2009,14 @@
       !                                                      ! ========================= !
       CASE ('coupled')
-         qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:)
-         qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:)
+         IF( ln_mixcpl ) THEN
+            DO jl=1,jpl
+               qml_ice(:,:,jl) = qml_ice(:,:,jl) * xcplmask(:,:,0) + frcv(jpr_topm)%z3(:,:,jl) * zmsk(:,:)
+               qcn_ice(:,:,jl) = qcn_ice(:,:,jl) * xcplmask(:,:,0) + frcv(jpr_botm)%z3(:,:,jl) * zmsk(:,:)
+            ENDDO
+         ELSE
+            qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:)
+            qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:)
+         ENDIF
       END SELECT
-      !
       !                                                      ! ========================= !
       !                                                      !      Transmitted Qsr      !   [W/m2]
@@ -2017,9 +2025,13 @@
          !
          !                    ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81)
-         ztri = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice    ! surface transmission parameter (Grenfell Maykut 77)
+         ztri = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice    ! surface transmission when hi>10cm (Grenfell Maykut 77)
          !
-         qtr_ice_top(:,:,:) = ztri * qsr_ice(:,:,:)
-         WHERE( phs(:,:,:) >= 0.0_wp )   qtr_ice_top(:,:,:) = 0._wp            ! snow fully opaque
-         WHERE( phi(:,:,:) <= 0.1_wp )   qtr_ice_top(:,:,:) = qsr_ice(:,:,:)   ! thin ice transmits all solar radiation
+         WHERE    ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) <  0.1_wp )       ! linear decrease from hi=0 to 10cm  
+            zqtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( ztri + ( 1._wp - ztri ) * ( 1._wp - phi(:,:,:) * 10._wp ) )
+         ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp )       ! constant (ztri) when hi>10cm
+            zqtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ztri
+         ELSEWHERE                                                         ! zero when hs>0
+            zqtr_ice_top(:,:,:) = 0._wp
+         END WHERE
          !     
       ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN      !==  conduction flux as surface forcing  ==!
@@ -2027,5 +2039,32 @@
          !                    ! ===> here we must receive the qtr_ice_top array from the coupler
          !                           for now just assume zero (fully opaque ice)
-         qtr_ice_top(:,:,:) = 0._wp
+         zqtr_ice_top(:,:,:) = 0._wp
+         !
+      ENDIF
+      !
+      IF( ln_mixcpl ) THEN
+         DO jl=1,jpl
+            qtr_ice_top(:,:,jl) = qtr_ice_top(:,:,jl) * xcplmask(:,:,0) + zqtr_ice_top(:,:,jl) * zmsk(:,:)
+         ENDDO
+      ELSE
+         qtr_ice_top(:,:,:) = zqtr_ice_top(:,:,:)
+      ENDIF
+      !                                                      ! ================== !
+      !                                                      !   ice skin temp.   !
+      !                                                      ! ================== !
+      ! needed by Met Office
+      IF( srcv(jpr_ts_ice)%laction ) THEN 
+         WHERE    ( frcv(jpr_ts_ice)%z3(:,:,:) > 0.0  )   ;   ztsu(:,:,:) =   0. + rt0 
+         ELSEWHERE( frcv(jpr_ts_ice)%z3(:,:,:) < -60. )   ;   ztsu(:,:,:) = -60. + rt0
+         ELSEWHERE                                        ;   ztsu(:,:,:) = frcv(jpr_ts_ice)%z3(:,:,:) + rt0
+         END WHERE
+         !
+         IF( ln_mixcpl ) THEN
+            DO jl=1,jpl
+               pist(:,:,jl) = pist(:,:,jl) * xcplmask(:,:,0) + ztsu(:,:,jl) * zmsk(:,:)
+            ENDDO
+         ELSE
+            pist(:,:,:) = ztsu(:,:,:)
+         ENDIF
          !
       ENDIF
@@ -2036,5 +2075,5 @@
    
    
-   SUBROUTINE sbc_cpl_snd( kt )
+   SUBROUTINE sbc_cpl_snd( kt, Kbb, Kmm )
       !!----------------------------------------------------------------------
       !!             ***  ROUTINE sbc_cpl_snd  ***
@@ -2046,4 +2085,5 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt
+      INTEGER, INTENT(in) ::   Kbb, Kmm    ! ocean model time level index
       !
       INTEGER ::   ji, jj, jl   ! dummy loop indices
@@ -2054,5 +2094,5 @@
       !!----------------------------------------------------------------------
       !
-      isec = ( kt - nit000 ) * NINT( rdt )        ! date of exchanges
+      isec = ( kt - nit000 ) * NINT( rn_Dt )        ! date of exchanges
 
       zfr_l(:,:) = 1.- fr_i(:,:)
@@ -2062,10 +2102,10 @@
       IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN
          
-         IF ( nn_components == jp_iam_opa ) THEN
-            ztmp1(:,:) = tsn(:,:,1,jp_tem)   ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part
+         IF( nn_components == jp_iam_opa ) THEN
+            ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm)   ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part
          ELSE
             ! we must send the surface potential temperature 
-            IF( l_useCT )  THEN    ;   ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) )
-            ELSE                   ;   ztmp1(:,:) = tsn(:,:,1,jp_tem)
+            IF( l_useCT )  THEN    ;   ztmp1(:,:) = eos_pt_from_ct( ts(:,:,1,jp_tem,Kmm), ts(:,:,1,jp_sal,Kmm) )
+            ELSE                   ;   ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm)
             ENDIF
             !
@@ -2095,5 +2135,5 @@
                CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
                END SELECT
-            CASE( 'oce and weighted ice')    ;   ztmp1(:,:) =   tsn(:,:,1,jp_tem) + rt0  
+            CASE( 'oce and weighted ice')    ;   ztmp1(:,:) =   ts(:,:,1,jp_tem,Kmm) + rt0  
                SELECT CASE( sn_snd_temp%clcat ) 
                CASE( 'yes' )    
@@ -2190,5 +2230,5 @@
          CASE default    ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
          END SELECT
-         IF( ssnd(jps_fice)%laction )   CALL cpl_snd( jps_fice, isec, ztmp3, info )
+         CALL cpl_snd( jps_fice, isec, ztmp3, info )
       ENDIF
 
@@ -2250,5 +2290,5 @@
       !                                                      !      Ice melt ponds       ! 
       !                                                      ! ------------------------- !
-      ! needed by Met Office
+      ! needed by Met Office: 1) fraction of ponded ice 2) local/actual pond depth 
       IF( ssnd(jps_a_p)%laction .OR. ssnd(jps_ht_p)%laction ) THEN 
          SELECT CASE( sn_snd_mpnd%cldes)  
@@ -2256,12 +2296,12 @@
             SELECT CASE( sn_snd_mpnd%clcat )  
             CASE( 'yes' )  
-               ztmp3(:,:,1:jpl) =  a_ip(:,:,1:jpl)
-               ztmp4(:,:,1:jpl) =  v_ip(:,:,1:jpl)  
+               ztmp3(:,:,1:jpl) =  a_ip_frac(:,:,1:jpl)
+               ztmp4(:,:,1:jpl) =  h_ip(:,:,1:jpl)  
             CASE( 'no' )  
                ztmp3(:,:,:) = 0.0  
                ztmp4(:,:,:) = 0.0  
                DO jl=1,jpl  
-                 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip(:,:,jpl)  
-                 ztmp4(:,:,1) = ztmp4(:,:,1) + v_ip(:,:,jpl) 
+                 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip_frac(:,:,jpl)  
+                 ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(:,:,jpl) 
                ENDDO  
             CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%clcat' )  
@@ -2301,5 +2341,8 @@
       !                                                      !  CO2 flux from PISCES     ! 
       !                                                      ! ------------------------- !
-      IF( ssnd(jps_co2)%laction .AND. l_co2cpl )   CALL cpl_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info )
+      IF( ssnd(jps_co2)%laction .AND. l_co2cpl )   THEN 
+         ztmp1(:,:) = oce_co2(:,:) * 1000.  ! conversion in molC/m2/s
+         CALL cpl_snd( jps_co2, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ) , info )
+      ENDIF
       !
       !                                                      ! ------------------------- !
@@ -2316,34 +2359,28 @@
          !                                                               i      i+1 (for I)
          IF( nn_components == jp_iam_opa ) THEN
-            zotx1(:,:) = un(:,:,1)  
-            zoty1(:,:) = vn(:,:,1)  
+            zotx1(:,:) = uu(:,:,1,Kmm)  
+            zoty1(:,:) = vv(:,:,1,Kmm)  
          ELSE        
             SELECT CASE( TRIM( sn_snd_crt%cldes ) )
             CASE( 'oce only'             )      ! C-grid ==> T
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) )
-                     zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) ) 
-                  END DO
-               END DO
+               DO_2D_00_00
+                  zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj  ,1,Kmm) )
+                  zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji  ,jj-1,1,Kmm) ) 
+               END_2D
             CASE( 'weighted oce and ice' )      ! Ocean and Ice on C-grid ==> T  
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)  
-                     zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)
-                     zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)
-                     zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)
-                  END DO
-               END DO
+               DO_2D_00_00
+                  zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj)  
+                  zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Kmm) + vv   (ji  ,jj-1,1,Kmm) ) * zfr_l(ji,jj)
+                  zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  )     + u_ice(ji-1,jj    )     ) *  fr_i(ji,jj)
+                  zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  )     + v_ice(ji  ,jj-1  )     ) *  fr_i(ji,jj)
+               END_2D
                CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1., zity1, 'T', -1. )
             CASE( 'mixed oce-ice'        )      ! Ocean and Ice on C-grid ==> T
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   &
-                        &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)
-                     zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)   &
-                        &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)
-                  END DO
-               END DO
+               DO_2D_00_00
+                  zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj)   &
+                     &         + 0.5 * ( u_ice(ji,jj  )     + u_ice(ji-1,jj    )     ) *  fr_i(ji,jj)
+                  zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Kmm) + vv   (ji  ,jj-1,1,Kmm) ) * zfr_l(ji,jj)   &
+                     &         + 0.5 * ( v_ice(ji,jj  )     + v_ice(ji  ,jj-1  )     ) *  fr_i(ji,jj)
+               END_2D
             END SELECT
             CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1.,  zoty1, ssnd(jps_ocy1)%clgrid, -1. )
@@ -2404,29 +2441,23 @@
           SELECT CASE( TRIM( sn_snd_crtw%cldes ) ) 
           CASE( 'oce only'             )      ! C-grid ==> T 
-             DO jj = 2, jpjm1 
-                DO ji = fs_2, fs_jpim1   ! vector opt. 
-                   zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) ) 
-                   zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji , jj-1,1) )  
-                END DO 
-             END DO 
+             DO_2D_00_00
+                zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj  ,1,Kmm) ) 
+                zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji , jj-1,1,Kmm) )  
+             END_2D
           CASE( 'weighted oce and ice' )      ! Ocean and Ice on C-grid ==> T   
-             DO jj = 2, jpjm1 
-                DO ji = fs_2, fs_jpim1   ! vector opt. 
-                   zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   
-                   zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj) 
-                   zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
-                   zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
-                END DO
-             END DO
+             DO_2D_00_00
+                zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj)   
+                zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Kmm) + vv   (ji  ,jj-1,1,Kmm) ) * zfr_l(ji,jj) 
+                zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
+                zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
+             END_2D
              CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.,  zity1, 'T', -1. ) 
           CASE( 'mixed oce-ice'        )      ! Ocean and Ice on C-grid ==> T  
-             DO jj = 2, jpjm1 
-                DO ji = fs_2, fs_jpim1   ! vector opt. 
-                   zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   & 
-                      &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
-                   zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)   & 
-                      &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
-                END DO
-             END DO
+             DO_2D_00_00
+                zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj)   & 
+                   &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
+                zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Kmm) + vv   (ji  ,jj-1,1,Kmm) ) * zfr_l(ji,jj)   & 
+                   &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
+             END_2D
           END SELECT
          CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1., zoty1, ssnd(jps_ocyw)%clgrid, -1. ) 
@@ -2467,5 +2498,5 @@
       IF( ssnd(jps_ficet)%laction ) THEN 
          CALL cpl_snd( jps_ficet, isec, RESHAPE ( fr_i, (/jpi,jpj,1/) ), info ) 
-      END IF 
+      ENDIF 
       !                                                      ! ------------------------- ! 
       !                                                      !   Water levels to waves   ! 
@@ -2474,13 +2505,13 @@
          IF( ln_apr_dyn ) THEN  
             IF( kt /= nit000 ) THEN  
-               ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )  
+               ztmp1(:,:) = ssh(:,:,Kbb) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )  
             ELSE  
-               ztmp1(:,:) = sshb(:,:)  
+               ztmp1(:,:) = ssh(:,:,Kbb)  
             ENDIF  
          ELSE  
-            ztmp1(:,:) = sshn(:,:)  
+            ztmp1(:,:) = ssh(:,:,Kmm)  
          ENDIF  
          CALL cpl_snd( jps_wlev  , isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
-      END IF 
+      ENDIF 
       !
       !  Fields sent by OPA to SAS when doing OPA<->SAS coupling
@@ -2489,6 +2520,6 @@
          !                          ! removed inverse barometer ssh when Patm
          !                          forcing is used (for sea-ice dynamics)
-         IF( ln_apr_dyn ) THEN   ;   ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
-         ELSE                    ;   ztmp1(:,:) = sshn(:,:)
+         IF( ln_apr_dyn ) THEN   ;   ztmp1(:,:) = ssh(:,:,Kbb) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
+         ELSE                    ;   ztmp1(:,:) = ssh(:,:,Kmm)
          ENDIF
          CALL cpl_snd( jps_ssh   , isec, RESHAPE ( ztmp1            , (/jpi,jpj,1/) ), info )
@@ -2497,9 +2528,9 @@
       !                                                        ! SSS
       IF( ssnd(jps_soce  )%laction )  THEN
-         CALL cpl_snd( jps_soce  , isec, RESHAPE ( tsn(:,:,1,jp_sal), (/jpi,jpj,1/) ), info )
+         CALL cpl_snd( jps_soce  , isec, RESHAPE ( ts(:,:,1,jp_sal,Kmm), (/jpi,jpj,1/) ), info )
       ENDIF
       !                                                        ! first T level thickness 
       IF( ssnd(jps_e3t1st )%laction )  THEN
-         CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t_n(:,:,1)   , (/jpi,jpj,1/) ), info )
+         CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t(:,:,1,Kmm)   , (/jpi,jpj,1/) ), info )
       ENDIF
       !                                                        ! Qsr fraction
@@ -2524,5 +2555,5 @@
       !                                                      ! ------------------------- !
       ! needed by Met Office
-      CALL eos_fzp(tsn(:,:,1,jp_sal), sstfrz)
+      CALL eos_fzp(ts(:,:,1,jp_sal,Kmm), sstfrz)
       ztmp1(:,:) = sstfrz(:,:) + rt0
       IF( ssnd(jps_sstfrz)%laction )  CALL cpl_snd( jps_sstfrz, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info)
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcdcy.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcdcy.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcdcy.F90	(revision 12928)
@@ -7,4 +7,9 @@
    !!   NEMO    2.0  !  2006-02  (S. Masson, G. Madec)  adaptation to NEMO
    !!           3.1  !  2009-07  (J.M. Molines)  adaptation to v3.1
+   !!           4.*  !  2019-10  (L. Brodeau)  nothing really new, but the routine
+   !!                ! "sbc_dcy_param" has been extracted from old function "sbc_dcy"
+   !!                ! => this allows the warm-layer param of COARE3* to know the time
+   !!                ! of dawn and dusk even if "ln_dm2dc=.false." (rdawn_dcy & rdusk_dcy
+   !!                ! are now public)
    !!----------------------------------------------------------------------
 
@@ -22,29 +27,33 @@
    IMPLICIT NONE
    PRIVATE
-   
+
    INTEGER, PUBLIC ::   nday_qsr   !: day when parameters were computed
-   
+
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   raa , rbb  , rcc  , rab     ! diurnal cycle parameters
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rtmd, rdawn, rdusk, rscal   !    -      -       -
-  
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rtmd, rscal   !    -      -       -
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: rdawn_dcy, rdusk_dcy   !    -      -       -
+
    PUBLIC   sbc_dcy        ! routine called by sbc
-
+   PUBLIC   sbc_dcy_param  ! routine used here and called by warm-layer parameterization (sbcblk_skin_coare*)
+
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id$ 
+   !! $Id$
    !! Software governed by the CeCILL license (see ./LICENSE)
    !!----------------------------------------------------------------------
 CONTAINS
 
-      INTEGER FUNCTION sbc_dcy_alloc()
-         !!----------------------------------------------------------------------
-         !!                ***  FUNCTION sbc_dcy_alloc  ***
-         !!----------------------------------------------------------------------
-         ALLOCATE( raa (jpi,jpj) , rbb  (jpi,jpj) , rcc  (jpi,jpj) , rab  (jpi,jpj) ,     &
-            &      rtmd(jpi,jpj) , rdawn(jpi,jpj) , rdusk(jpi,jpj) , rscal(jpi,jpj) , STAT=sbc_dcy_alloc )
-            !
-         CALL mpp_sum ( 'sbcdcy', sbc_dcy_alloc )
-         IF( sbc_dcy_alloc /= 0 )   CALL ctl_stop( 'STOP', 'sbc_dcy_alloc: failed to allocate arrays' )
-      END FUNCTION sbc_dcy_alloc
+   INTEGER FUNCTION sbc_dcy_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  FUNCTION sbc_dcy_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( raa (jpi,jpj) , rbb  (jpi,jpj) , rcc  (jpi,jpj) , rab  (jpi,jpj) ,     &
+         &      rtmd(jpi,jpj) , rdawn_dcy(jpi,jpj) , rdusk_dcy(jpi,jpj) , rscal(jpi,jpj) , STAT=sbc_dcy_alloc )
+      !
+      CALL mpp_sum ( 'sbcdcy', sbc_dcy_alloc )
+      IF( sbc_dcy_alloc /= 0 )   CALL ctl_stop( 'STOP', 'sbc_dcy_alloc: failed to allocate arrays' )
+   END FUNCTION sbc_dcy_alloc
 
 
@@ -60,36 +69,25 @@
       !!
       !! reference  : Bernie, DJ, E Guilyardi, G Madec, JM Slingo, and SJ Woolnough, 2007
-      !!              Impact of resolving the diurnal cycle in an ocean--atmosphere GCM. 
+      !!              Impact of resolving the diurnal cycle in an ocean--atmosphere GCM.
       !!              Part 1: a diurnally forced OGCM. Climate Dynamics 29:6, 575-590.
       !!----------------------------------------------------------------------
       LOGICAL , OPTIONAL          , INTENT(in) ::   l_mask    ! use the routine for night mask computation
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqsrin    ! input daily QSR flux 
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqsrin    ! input daily QSR flux
       REAL(wp), DIMENSION(jpi,jpj)             ::   zqsrout   ! output QSR flux with diurnal cycle
       !!
       INTEGER  ::   ji, jj                                       ! dummy loop indices
       INTEGER, DIMENSION(jpi,jpj) :: imask_night ! night mask
-      REAL(wp) ::   ztwopi, zinvtwopi, zconvrad 
       REAL(wp) ::   zlo, zup, zlousd, zupusd
-      REAL(wp) ::   zdsws, zdecrad, ztx, zsin, zcos
-      REAL(wp) ::   ztmp, ztmp1, ztmp2, ztest
+      REAL(wp) ::   ztmp, ztmp1, ztmp2
       REAL(wp) ::   ztmpm, ztmpm1, ztmpm2
-      !---------------------------statement functions------------------------
-      REAL(wp) ::   fintegral, pt1, pt2, paaa, pbbb, pccc        ! dummy statement function arguments
-      fintegral( pt1, pt2, paaa, pbbb, pccc ) =                         &
-         &   paaa * pt2 + zinvtwopi * pbbb * SIN(pccc + ztwopi * pt2)   &
-         & - paaa * pt1 - zinvtwopi * pbbb * SIN(pccc + ztwopi * pt1)
       !!---------------------------------------------------------------------
       !
       ! Initialization
       ! --------------
-      ztwopi    = 2._wp * rpi
-      zinvtwopi = 1._wp / ztwopi
-      zconvrad  = ztwopi / 360._wp
-
       ! When are we during the day (from 0 to 1)
-      zlo = ( REAL(nsec_day, wp) - 0.5_wp * rdt ) / rday
-      zup = zlo + ( REAL(nn_fsbc, wp)     * rdt ) / rday
-      !                                          
-      IF( nday_qsr == -1 ) THEN       ! first time step only  
+      zlo = ( REAL(nsec_day, wp) - 0.5_wp * rn_Dt ) / rday
+      zup = zlo + ( REAL(nn_fsbc, wp)     * rn_Dt ) / rday
+      !
+      IF( nday_qsr == -1 ) THEN       ! first time step only
          IF(lwp) THEN
             WRITE(numout,*)
@@ -98,8 +96,80 @@
             WRITE(numout,*)
          ENDIF
+      ENDIF
+
+      ! Setting parameters for each new day:
+      CALL sbc_dcy_param()
+
+      !CALL iom_put( "rdusk_dcy", rdusk_dcy(:,:)*tmask(:,:,1) ) !LB
+      !CALL iom_put( "rdawn_dcy", rdawn_dcy(:,:)*tmask(:,:,1) ) !LB
+      !CALL iom_put( "rscal_dcy", rscal(:,:)*tmask(:,:,1) ) !LB
+
+
+      !     3. update qsr with the diurnal cycle
+      !     ------------------------------------
+
+      imask_night(:,:) = 0
+      DO_2D_11_11
+         ztmpm = 0._wp
+         IF( ABS(rab(ji,jj)) < 1. ) THEN         ! day duration is less than 24h
+            !
+            IF( rdawn_dcy(ji,jj) < rdusk_dcy(ji,jj) ) THEN       ! day time in one part
+               zlousd = MAX(zlo, rdawn_dcy(ji,jj))
+               zlousd = MIN(zlousd, zup)
+               zupusd = MIN(zup, rdusk_dcy(ji,jj))
+               zupusd = MAX(zupusd, zlo)
+               ztmp = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))
+               zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj)
+               ztmpm = zupusd - zlousd
+               IF( ztmpm .EQ. 0 ) imask_night(ji,jj) = 1
+               !
+            ELSE                                         ! day time in two parts
+               zlousd = MIN(zlo, rdusk_dcy(ji,jj))
+               zupusd = MIN(zup, rdusk_dcy(ji,jj))
+               ztmp1 = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))
+               ztmpm1=zupusd-zlousd
+               zlousd = MAX(zlo, rdawn_dcy(ji,jj))
+               zupusd = MAX(zup, rdawn_dcy(ji,jj))
+               ztmp2 = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))
+               ztmpm2 =zupusd-zlousd
+               ztmp = ztmp1 + ztmp2
+               ztmpm = ztmpm1 + ztmpm2
+               zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj)
+               IF(ztmpm .EQ. 0.) imask_night(ji,jj) = 1
+            ENDIF
+         ELSE                                   ! 24h light or 24h night
+            !
+            IF( raa(ji,jj) > rbb(ji,jj) ) THEN           ! 24h day
+               ztmp = fintegral(zlo, zup, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))
+               zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj)
+               imask_night(ji,jj) = 0
+               !
+            ELSE                                         ! No day
+               zqsrout(ji,jj) = 0.0_wp
+               imask_night(ji,jj) = 1
+            ENDIF
+         ENDIF
+      END_2D
+      !
+      IF( PRESENT(l_mask) .AND. l_mask ) THEN
+         zqsrout(:,:) = float(imask_night(:,:))
+      ENDIF
+      !
+   END FUNCTION sbc_dcy
+
+
+   SUBROUTINE sbc_dcy_param( )
+      !!
+      INTEGER  ::   ji, jj                                       ! dummy loop indices
+      !INTEGER, DIMENSION(jpi,jpj) :: imask_night ! night mask
+      REAL(wp) ::   zdsws, zdecrad, ztx, zsin, zcos
+      REAL(wp) ::   ztmp, ztest
+      !---------------------------statement functions------------------------
+      !
+      IF( nday_qsr == -1 ) THEN       ! first time step only
          ! allocate sbcdcy arrays
          IF( sbc_dcy_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_dcy_alloc : unable to allocate arrays' )
          ! Compute rcc needed to compute the time integral of the diurnal cycle
-         rcc(:,:) = zconvrad * glamt(:,:) - rpi
+         rcc(:,:) = rad * glamt(:,:) - rpi
          ! time of midday
          rtmd(:,:) = 0.5_wp - glamt(:,:) / 360._wp
@@ -107,141 +177,92 @@
       ENDIF
 
-      ! If this is a new day, we have to update the dawn, dusk and scaling function  
+      ! If this is a new day, we have to update the dawn, dusk and scaling function
       !----------------------
-    
-      !     2.1 dawn and dusk  
-
-      ! nday is the number of days since the beginning of the current month 
-      IF( nday_qsr /= nday ) THEN 
+
+      !     2.1 dawn and dusk
+
+      ! nday is the number of days since the beginning of the current month
+      IF( nday_qsr /= nday ) THEN
          ! save the day of the year and the daily mean of qsr
-         nday_qsr = nday 
-         ! number of days since the previous winter solstice (supposed to be always 21 December)         
+         nday_qsr = nday
+         ! number of days since the previous winter solstice (supposed to be always 21 December)
          zdsws = REAL(11 + nday_year, wp)
          ! declination of the earths orbit
-         zdecrad = (-23.5_wp * zconvrad) * COS( zdsws * ztwopi / REAL(nyear_len(1),wp) )
+         zdecrad = (-23.5_wp * rad) * COS( zdsws * 2._wp*rpi / REAL(nyear_len(1),wp) )
          ! Compute A and B needed to compute the time integral of the diurnal cycle
 
          zsin = SIN( zdecrad )   ;   zcos = COS( zdecrad )
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ztmp = zconvrad * gphit(ji,jj)
-               raa(ji,jj) = SIN( ztmp ) * zsin
-               rbb(ji,jj) = COS( ztmp ) * zcos
-            END DO  
-         END DO  
+         DO_2D_11_11
+            ztmp = rad * gphit(ji,jj)
+            raa(ji,jj) = SIN( ztmp ) * zsin
+            rbb(ji,jj) = COS( ztmp ) * zcos
+         END_2D
          ! Compute the time of dawn and dusk
 
-         ! rab to test if the day time is equal to 0, less than 24h of full day        
+         ! rab to test if the day time is equal to 0, less than 24h of full day
          rab(:,:) = -raa(:,:) / rbb(:,:)
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF ( ABS(rab(ji,jj)) < 1._wp ) THEN         ! day duration is less than 24h
-         ! When is it night?
-                  ztx = zinvtwopi * (ACOS(rab(ji,jj)) - rcc(ji,jj))
-                  ztest = -rbb(ji,jj) * SIN( rcc(ji,jj) + ztwopi * ztx )
-         ! is it dawn or dusk?
-                  IF ( ztest > 0._wp ) THEN
-                     rdawn(ji,jj) = ztx
-                     rdusk(ji,jj) = rtmd(ji,jj) + ( rtmd(ji,jj) - rdawn(ji,jj) )
-                  ELSE
-                     rdusk(ji,jj) = ztx
-                     rdawn(ji,jj) = rtmd(ji,jj) - ( rdusk(ji,jj) - rtmd(ji,jj) )
-                  ENDIF
+         DO_2D_11_11
+            IF( ABS(rab(ji,jj)) < 1._wp ) THEN         ! day duration is less than 24h
+               ! When is it night?
+               ztx = 1._wp/(2._wp*rpi) * (ACOS(rab(ji,jj)) - rcc(ji,jj))
+               ztest = -rbb(ji,jj) * SIN( rcc(ji,jj) + 2._wp*rpi * ztx )
+               ! is it dawn or dusk?
+               IF( ztest > 0._wp ) THEN
+                  rdawn_dcy(ji,jj) = ztx
+                  rdusk_dcy(ji,jj) = rtmd(ji,jj) + ( rtmd(ji,jj) - rdawn_dcy(ji,jj) )
                ELSE
-                  rdawn(ji,jj) = rtmd(ji,jj) + 0.5_wp
-                  rdusk(ji,jj) = rdawn(ji,jj)
+                  rdusk_dcy(ji,jj) = ztx
+                  rdawn_dcy(ji,jj) = rtmd(ji,jj) - ( rdusk_dcy(ji,jj) - rtmd(ji,jj) )
                ENDIF
-             END DO  
-         END DO  
-         rdawn(:,:) = MOD( (rdawn(:,:) + 1._wp), 1._wp )
-         rdusk(:,:) = MOD( (rdusk(:,:) + 1._wp), 1._wp )
+            ELSE
+               rdawn_dcy(ji,jj) = rtmd(ji,jj) + 0.5_wp
+               rdusk_dcy(ji,jj) = rdawn_dcy(ji,jj)
+            ENDIF
+         END_2D
+         rdawn_dcy(:,:) = MOD( (rdawn_dcy(:,:) + 1._wp), 1._wp )
+         rdusk_dcy(:,:) = MOD( (rdusk_dcy(:,:) + 1._wp), 1._wp )
          !     2.2 Compute the scaling function:
          !         S* = the inverse of the time integral of the diurnal cycle from dawn to dusk
          !         Avoid possible infinite scaling factor, associated with very short daylight
          !         periods, by ignoring periods less than 1/1000th of a day (ticket #1040)
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF ( ABS(rab(ji,jj)) < 1._wp ) THEN         ! day duration is less than 24h
-                  rscal(ji,jj) = 0.0_wp
-                  IF ( rdawn(ji,jj) < rdusk(ji,jj) ) THEN      ! day time in one part
-                     IF( (rdusk(ji,jj) - rdawn(ji,jj) ) .ge. 0.001_wp ) THEN
-                       rscal(ji,jj) = fintegral(rdawn(ji,jj), rdusk(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
-                       rscal(ji,jj) = 1._wp / rscal(ji,jj)
-                     ENDIF
-                  ELSE                                         ! day time in two parts
-                     IF( (rdusk(ji,jj) + (1._wp - rdawn(ji,jj)) ) .ge. 0.001_wp ) THEN
-                       rscal(ji,jj) = fintegral(0._wp, rdusk(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj))   &
-                          &         + fintegral(rdawn(ji,jj), 1._wp, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
-                       rscal(ji,jj) = 1. / rscal(ji,jj)
-                     ENDIF
+         DO_2D_11_11
+            IF( ABS(rab(ji,jj)) < 1._wp ) THEN         ! day duration is less than 24h
+               rscal(ji,jj) = 0.0_wp
+               IF( rdawn_dcy(ji,jj) < rdusk_dcy(ji,jj) ) THEN      ! day time in one part
+                  IF( (rdusk_dcy(ji,jj) - rdawn_dcy(ji,jj) ) .ge. 0.001_wp ) THEN
+                     rscal(ji,jj) = fintegral(rdawn_dcy(ji,jj), rdusk_dcy(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj))
+                     rscal(ji,jj) = 1._wp / rscal(ji,jj)
                   ENDIF
-               ELSE
-                  IF ( raa(ji,jj) > rbb(ji,jj) ) THEN         ! 24h day
-                     rscal(ji,jj) = fintegral(0._wp, 1._wp, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
-                     rscal(ji,jj) = 1._wp / rscal(ji,jj)
-                  ELSE                                          ! No day
-                     rscal(ji,jj) = 0.0_wp
+               ELSE                                         ! day time in two parts
+                  IF( (rdusk_dcy(ji,jj) + (1._wp - rdawn_dcy(ji,jj)) ) .ge. 0.001_wp ) THEN
+                     rscal(ji,jj) = fintegral(0._wp, rdusk_dcy(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj))   &
+                        &         + fintegral(rdawn_dcy(ji,jj), 1._wp, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))
+                     rscal(ji,jj) = 1. / rscal(ji,jj)
                   ENDIF
                ENDIF
-            END DO  
-         END DO  
+            ELSE
+               IF( raa(ji,jj) > rbb(ji,jj) ) THEN         ! 24h day
+                  rscal(ji,jj) = fintegral(0._wp, 1._wp, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))
+                  rscal(ji,jj) = 1._wp / rscal(ji,jj)
+               ELSE                                          ! No day
+                  rscal(ji,jj) = 0.0_wp
+               ENDIF
+            ENDIF
+         END_2D
          !
-         ztmp = rday / ( rdt * REAL(nn_fsbc, wp) )
+         ztmp = rday / ( rn_Dt * REAL(nn_fsbc, wp) )
          rscal(:,:) = rscal(:,:) * ztmp
          !
-      ENDIF 
-         !     3. update qsr with the diurnal cycle
-         !     ------------------------------------
-
-      imask_night(:,:) = 0
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            ztmpm = 0._wp
-            IF( ABS(rab(ji,jj)) < 1. ) THEN         ! day duration is less than 24h
-               !
-               IF( rdawn(ji,jj) < rdusk(ji,jj) ) THEN       ! day time in one part
-                  zlousd = MAX(zlo, rdawn(ji,jj))
-                  zlousd = MIN(zlousd, zup)
-                  zupusd = MIN(zup, rdusk(ji,jj))
-                  zupusd = MAX(zupusd, zlo)
-                  ztmp = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
-                  zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj)
-                  ztmpm = zupusd - zlousd
-                  IF ( ztmpm .EQ. 0 ) imask_night(ji,jj) = 1
-                  !
-               ELSE                                         ! day time in two parts
-                  zlousd = MIN(zlo, rdusk(ji,jj))
-                  zupusd = MIN(zup, rdusk(ji,jj))
-                  ztmp1 = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
-                  ztmpm1=zupusd-zlousd
-                  zlousd = MAX(zlo, rdawn(ji,jj))
-                  zupusd = MAX(zup, rdawn(ji,jj))
-                  ztmp2 = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
-                  ztmpm2 =zupusd-zlousd
-                  ztmp = ztmp1 + ztmp2
-                  ztmpm = ztmpm1 + ztmpm2
-                  zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj)
-                  IF (ztmpm .EQ. 0.) imask_night(ji,jj) = 1
-               ENDIF
-            ELSE                                   ! 24h light or 24h night
-               !
-               IF( raa(ji,jj) > rbb(ji,jj) ) THEN           ! 24h day
-                  ztmp = fintegral(zlo, zup, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
-                  zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj)
-                  imask_night(ji,jj) = 0
-                  !
-               ELSE                                         ! No day
-                  zqsrout(ji,jj) = 0.0_wp
-                  imask_night(ji,jj) = 1
-               ENDIF
-            ENDIF
-         END DO  
-      END DO  
-      !
-      IF( PRESENT(l_mask) .AND. l_mask ) THEN
-         zqsrout(:,:) = float(imask_night(:,:))
-      ENDIF
-      !
-   END FUNCTION sbc_dcy
+      ENDIF !IF( nday_qsr /= nday )
+      !
+   END SUBROUTINE sbc_dcy_param
+
+
+   FUNCTION fintegral( pt1, pt2, paaa, pbbb, pccc )
+      REAL(wp), INTENT(in) :: pt1, pt2, paaa, pbbb, pccc
+      REAL(wp) :: fintegral
+      fintegral =   paaa * pt2 + 1._wp/(2._wp*rpi) * pbbb * SIN(pccc + 2._wp*rpi*pt2)   &
+         &        - paaa * pt1 - 1._wp/(2._wp*rpi) * pbbb * SIN(pccc + 2._wp*rpi*pt1)
+   END FUNCTION fintegral
 
    !!======================================================================
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcflx.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcflx.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcflx.F90	(revision 12928)
@@ -38,5 +38,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -91,9 +91,7 @@
       IF( kt == nit000 ) THEN                ! First call kt=nit000  
          ! set file information
-         REWIND( numnam_ref )              ! Namelist namsbc_flx in reference namelist : Files for fluxes
          READ  ( numnam_ref, namsbc_flx, IOSTAT = ios, ERR = 901)
 901      IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_flx in reference namelist' )
 
-         REWIND( numnam_cfg )              ! Namelist namsbc_flx in configuration namelist : Files for fluxes
          READ  ( numnam_cfg, namsbc_flx, IOSTAT = ios, ERR = 902 )
 902      IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_flx in configuration namelist' )
@@ -131,12 +129,10 @@
          ELSE                  ;   qsr(:,:) =          sf(jp_qsr)%fnow(:,:,1)
          ENDIF
-         DO jj = 1, jpj                                           ! set the ocean fluxes from read fields
-            DO ji = 1, jpi
-               utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1)
-               vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1)
-               qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1)
-               emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1)
-            END DO
-         END DO
+         DO_2D_11_11
+            utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1)
+            vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1)
+            qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1)
+            emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1)
+         END_2D
          !                                                        ! add to qns the heat due to e-p
          qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp        ! mass flux is at SST
@@ -147,13 +143,11 @@
          !                                                        ! module of wind stress and wind speed at T-point
          zcoef = 1. / ( zrhoa * zcdrag )
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vect. opt.
-               ztx = utau(ji-1,jj  ) + utau(ji,jj) 
-               zty = vtau(ji  ,jj-1) + vtau(ji,jj) 
-               zmod = 0.5 * SQRT( ztx * ztx + zty * zty )
-               taum(ji,jj) = zmod
-               wndm(ji,jj) = SQRT( zmod * zcoef )
-            END DO
-         END DO
+         DO_2D_00_00
+            ztx = utau(ji-1,jj  ) + utau(ji,jj) 
+            zty = vtau(ji  ,jj-1) + vtau(ji,jj) 
+            zmod = 0.5 * SQRT( ztx * ztx + zty * zty )
+            taum(ji,jj) = zmod
+            wndm(ji,jj) = SQRT( zmod * zcoef )
+         END_2D
          taum(:,:) = taum(:,:) * tmask(:,:,1) ; wndm(:,:) = wndm(:,:) * tmask(:,:,1)
          CALL lbc_lnk( 'sbcflx', taum(:,:), 'T', 1. )   ;   CALL lbc_lnk( 'sbcflx', wndm(:,:), 'T', 1. )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcfwb.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcfwb.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcfwb.F90	(revision 12928)
@@ -17,8 +17,8 @@
    USE dom_oce        ! ocean space and time domain
    USE sbc_oce        ! surface ocean boundary condition
+   USE isf_oce , ONLY : fwfisf_cav, fwfisf_par                    ! ice shelf melting contribution
    USE sbc_ice , ONLY : snwice_mass, snwice_mass_b, snwice_fmass
    USE phycst         ! physical constants
    USE sbcrnf         ! ocean runoffs
-   USE sbcisf         ! ice shelf melting contribution
    USE sbcssr         ! Sea-Surface damping terms
    !
@@ -39,6 +39,4 @@
    REAL(wp) ::   area      ! global mean ocean surface (interior domain)
 
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -48,5 +46,5 @@
 CONTAINS
 
-   SUBROUTINE sbc_fwb( kt, kn_fwb, kn_fsbc )
+   SUBROUTINE sbc_fwb( kt, kn_fwb, kn_fsbc, Kmm )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE sbc_fwb  ***
@@ -65,4 +63,5 @@
       INTEGER, INTENT( in ) ::   kn_fsbc  ! 
       INTEGER, INTENT( in ) ::   kn_fwb   ! ocean time-step index
+      INTEGER, INTENT( in ) ::   Kmm      ! ocean time level index
       !
       INTEGER  ::   inum, ikty, iyear     ! local integers
@@ -104,5 +103,5 @@
          !
          IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
-            y_fwfnow(1) = local_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) - snwice_fmass(:,:) ) )
+            y_fwfnow(1) = local_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf_cav(:,:) + fwfisf_par(:,:) - snwice_fmass(:,:) ) )
             CALL mpp_delay_sum( 'sbcfwb', 'fwb', y_fwfnow(:), z_fwfprv(:), kt == nitend - nn_fsbc + 1 )
             z_fwfprv(1) = z_fwfprv(1) / area
@@ -127,9 +126,9 @@
          ENDIF   
          !                                         ! Update fwfold if new year start
-         ikty = 365 * 86400 / rdt                  !!bug  use of 365 days leap year or 360d year !!!!!!!
+         ikty = 365 * 86400 / rn_Dt                  !!bug  use of 365 days leap year or 360d year !!!!!!!
          IF( MOD( kt, ikty ) == 0 ) THEN
             a_fwb_b = a_fwb                           ! mean sea level taking into account the ice+snow
                                                       ! sum over the global domain
-            a_fwb   = glob_sum( 'sbcfwb', e1e2t(:,:) * ( sshn(:,:) + snwice_mass(:,:) * r1_rau0 ) )
+            a_fwb   = glob_sum( 'sbcfwb', e1e2t(:,:) * ( ssh(:,:,Kmm) + snwice_mass(:,:) * r1_rho0 ) )
             a_fwb   = a_fwb * 1.e+3 / ( area * rday * 365. )     ! convert in Kg/m3/s = mm/s
 !!gm        !                                                      !!bug 365d year 
@@ -159,5 +158,5 @@
             ztmsk_neg(:,:) = tmask_i(:,:) - ztmsk_pos(:,:)
             !                                                  ! fwf global mean (excluding ocean to ice/snow exchanges) 
-            z_fwf     = glob_sum( 'sbcfwb', e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) - snwice_fmass(:,:) ) ) / area
+            z_fwf     = glob_sum( 'sbcfwb', e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf_cav(:,:) + fwfisf_par(:,:) - snwice_fmass(:,:) ) ) / area
             !            
             IF( z_fwf < 0._wp ) THEN         ! spread out over >0 erp area to increase evaporation
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcice_cice.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcice_cice.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcice_cice.F90	(revision 12928)
@@ -13,5 +13,5 @@
    USE dom_oce         ! ocean space and time domain
    USE domvvl
-   USE phycst, only : rcp, rau0, r1_rau0, rhos, rhoi
+   USE phycst, only : rcp, rho0, r1_rho0, rhos, rhoi
    USE in_out_manager  ! I/O manager
    USE iom, ONLY : iom_put,iom_use              ! I/O manager library !!Joakim edit
@@ -88,4 +88,6 @@
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), PRIVATE ::   png     ! local array used in sbc_cice_ice
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -132,5 +134,5 @@
          IF      ( ksbc == jp_flx ) THEN
             CALL cice_sbc_force(kt)
-         ELSE IF ( ksbc == jp_purecpl ) THEN
+         ELSE IF( ksbc == jp_purecpl ) THEN
             CALL sbc_cpl_ice_flx( fr_i )
          ENDIF
@@ -140,5 +142,5 @@
          CALL cice_sbc_out ( kt, ksbc )
 
-         IF ( ksbc == jp_purecpl )  CALL cice_sbc_hadgam(kt+1)
+         IF( ksbc == jp_purecpl )  CALL cice_sbc_hadgam(kt+1)
 
       ENDIF                                          ! End sea-ice time step only
@@ -147,5 +149,5 @@
 
 
-   SUBROUTINE cice_sbc_init( ksbc )
+   SUBROUTINE cice_sbc_init( ksbc, Kbb, Kmm )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE cice_sbc_init  ***
@@ -154,4 +156,5 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT( in  ) ::   ksbc                ! surface forcing type
+      INTEGER, INTENT( in  ) ::   Kbb, Kmm            ! time level indices
       REAL(wp), DIMENSION(jpi,jpj) :: ztmp1, ztmp2
       REAL(wp) ::   zcoefu, zcoefv, zcoeff            ! local scalar
@@ -168,6 +171,6 @@
       ! there is no restart file.
       ! Values from a CICE restart file would overwrite this
-      IF ( .NOT. ln_rstart ) THEN    
-         CALL nemo2cice( tsn(:,:,1,jp_tem) , sst , 'T' , 1.) 
+      IF( .NOT. ln_rstart ) THEN    
+         CALL nemo2cice( ts(:,:,1,jp_tem,Kmm) , sst , 'T' , 1.) 
       ENDIF  
 #endif
@@ -177,10 +180,10 @@
 
 ! Do some CICE consistency checks
-      IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN
-         IF ( calc_strair .OR. calc_Tsfc ) THEN
+      IF( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN
+         IF( calc_strair .OR. calc_Tsfc ) THEN
             CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=F and calc_Tsfc=F in ice_in' )
          ENDIF
-      ELSEIF (ksbc == jp_blk) THEN
-         IF ( .NOT. (calc_strair .AND. calc_Tsfc) ) THEN
+      ELSEIF(ksbc == jp_blk) THEN
+         IF( .NOT. (calc_strair .AND. calc_Tsfc) ) THEN
             CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=T and calc_Tsfc=T in ice_in' )
          ENDIF
@@ -194,6 +197,6 @@
 ! Ensure ocean temperatures are nowhere below freezing if not a NEMO restart
       IF( .NOT. ln_rstart ) THEN
-         tsn(:,:,:,jp_tem) = MAX (tsn(:,:,:,jp_tem),Tocnfrz)
-         tsb(:,:,:,jp_tem) = tsn(:,:,:,jp_tem)
+         ts(:,:,:,jp_tem,Kmm) = MAX (ts(:,:,:,jp_tem,Kmm),Tocnfrz)
+         ts(:,:,:,jp_tem,Kbb) = ts(:,:,:,jp_tem,Kmm)
       ENDIF
 
@@ -202,5 +205,5 @@
 
       CALL cice2nemo(aice,fr_i, 'T', 1. )
-      IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN
+      IF( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN
          DO jl=1,ncat
             CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. )
@@ -210,10 +213,8 @@
 ! T point to U point
 ! T point to V point
-      DO jj=1,jpjm1
-         DO ji=1,jpim1
-            fr_iu(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji+1,jj))*umask(ji,jj,1)
-            fr_iv(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji,jj+1))*vmask(ji,jj,1)
-         ENDDO
-      ENDDO
+      DO_2D_10_10
+         fr_iu(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji+1,jj))*umask(ji,jj,1)
+         fr_iv(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji,jj+1))*vmask(ji,jj,1)
+      END_2D
 
       CALL lbc_lnk_multi( 'sbcice_cice', fr_iu , 'U', 1.,  fr_iv , 'V', 1. )
@@ -227,6 +228,6 @@
       IF( .NOT.ln_rstart ) THEN
          IF( ln_ice_embd ) THEN            ! embedded sea-ice: deplete the initial ssh below sea-ice area
-            sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0
-            sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0
+            ssh(:,:,Kmm) = ssh(:,:,Kmm) - snwice_mass(:,:) * r1_rho0
+            ssh(:,:,Kbb) = ssh(:,:,Kbb) - snwice_mass(:,:) * r1_rho0
 
 !!gm This should be put elsewhere....   (same remark for limsbc)
@@ -235,33 +236,33 @@
                !
                DO jk = 1,jpkm1                     ! adjust initial vertical scale factors
-                  e3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
-                  e3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
+                  e3t(:,:,jk,Kmm) = e3t_0(:,:,jk)*( 1._wp + ssh(:,:,Kmm)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
+                  e3t(:,:,jk,Kbb) = e3t_0(:,:,jk)*( 1._wp + ssh(:,:,Kbb)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
                ENDDO
-               e3t_a(:,:,:) = e3t_b(:,:,:)
+               e3t(:,:,:,Krhs) = e3t(:,:,:,Kbb)
                ! Reconstruction of all vertical scale factors at now and before time-steps
                ! =============================================================================
                ! Horizontal scale factor interpolations
                ! --------------------------------------
-               CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' )
-               CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' )
-               CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' )
-               CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' )
-               CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' )
+               CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb), 'U' )
+               CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' )
+               CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' )
+               CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' )
+               CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' )
                ! Vertical scale factor interpolations
                ! ------------------------------------
-               CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  )
-               CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' )
-               CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' )
-               CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' )
-               CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' )
+               CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W'  )
+               CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3uw(:,:,:,Kmm), 'UW' )
+               CALL dom_vvl_interpol( e3v(:,:,:,Kmm), e3vw(:,:,:,Kmm), 'VW' )
+               CALL dom_vvl_interpol( e3u(:,:,:,Kbb), e3uw(:,:,:,Kbb), 'UW' )
+               CALL dom_vvl_interpol( e3v(:,:,:,Kbb), e3vw(:,:,:,Kbb), 'VW' )
                ! t- and w- points depth
                ! ----------------------
-               gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)
-               gdepw_n(:,:,1) = 0.0_wp
-               gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)
+               gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm)
+               gdepw(:,:,1,Kmm) = 0.0_wp
+               gde3w(:,:,1)     = gdept(:,:,1,Kmm) - ssh(:,:,Kmm)
                DO jk = 2, jpk
-                  gdept_n(:,:,jk) = gdept_n(:,:,jk-1) + e3w_n(:,:,jk)
-                  gdepw_n(:,:,jk) = gdepw_n(:,:,jk-1) + e3t_n(:,:,jk-1)
-                  gde3w_n(:,:,jk) = gdept_n(:,:,jk  ) - sshn   (:,:)
+                  gdept(:,:,jk,Kmm) = gdept(:,:,jk-1,Kmm) + e3w(:,:,jk,Kmm)
+                  gdepw(:,:,jk,Kmm) = gdepw(:,:,jk-1,Kmm) + e3t(:,:,jk-1,Kmm)
+                  gde3w(:,:,jk)     = gdept(:,:,jk  ,Kmm) - sshn   (:,:)
                END DO
             ENDIF
@@ -297,5 +298,5 @@
 ! forced and coupled case 
 
-      IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN
+      IF( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN
 
          ztmpn(:,:,:)=0.0
@@ -303,24 +304,20 @@
 ! x comp of wind stress (CI_1)
 ! U point to F point
-         DO jj=1,jpjm1
-            DO ji=1,jpi
-               ztmp(ji,jj) = 0.5 * (  fr_iu(ji,jj) * utau(ji,jj)      &
-                                    + fr_iu(ji,jj+1) * utau(ji,jj+1) ) * fmask(ji,jj,1)
-            ENDDO
-         ENDDO
+         DO_2D_10_11
+            ztmp(ji,jj) = 0.5 * (  fr_iu(ji,jj) * utau(ji,jj)      &
+                                 + fr_iu(ji,jj+1) * utau(ji,jj+1) ) * fmask(ji,jj,1)
+         END_2D
          CALL nemo2cice(ztmp,strax,'F', -1. )
 
 ! y comp of wind stress (CI_2)
 ! V point to F point
-         DO jj=1,jpj
-            DO ji=1,jpim1
-               ztmp(ji,jj) = 0.5 * (  fr_iv(ji,jj) * vtau(ji,jj)      &
-                                    + fr_iv(ji+1,jj) * vtau(ji+1,jj) ) * fmask(ji,jj,1)
-            ENDDO
-         ENDDO
+         DO_2D_11_10
+            ztmp(ji,jj) = 0.5 * (  fr_iv(ji,jj) * vtau(ji,jj)      &
+                                 + fr_iv(ji+1,jj) * vtau(ji+1,jj) ) * fmask(ji,jj,1)
+         END_2D
          CALL nemo2cice(ztmp,stray,'F', -1. )
 
 ! Surface downward latent heat flux (CI_5)
-         IF (ksbc == jp_flx) THEN
+         IF(ksbc == jp_flx) THEN
             DO jl=1,ncat
                ztmpn(:,:,jl)=qla_ice(:,:,1)*a_i(:,:,jl)
@@ -330,19 +327,17 @@
             qla_ice(:,:,1)= - ( emp_ice(:,:)+sprecip(:,:) ) * rLsub
 ! End of temporary code
-            DO jj=1,jpj
-               DO ji=1,jpi
-                  IF (fr_i(ji,jj).eq.0.0) THEN
-                     DO jl=1,ncat
-                        ztmpn(ji,jj,jl)=0.0
-                     ENDDO
-                     ! This will then be conserved in CICE
-                     ztmpn(ji,jj,1)=qla_ice(ji,jj,1)
-                  ELSE
-                     DO jl=1,ncat
-                        ztmpn(ji,jj,jl)=qla_ice(ji,jj,1)*a_i(ji,jj,jl)/fr_i(ji,jj)
-                     ENDDO
-                  ENDIF
-               ENDDO
-            ENDDO
+            DO_2D_11_11
+               IF(fr_i(ji,jj).eq.0.0) THEN
+                  DO jl=1,ncat
+                     ztmpn(ji,jj,jl)=0.0
+                  ENDDO
+                  ! This will then be conserved in CICE
+                  ztmpn(ji,jj,1)=qla_ice(ji,jj,1)
+               ELSE
+                  DO jl=1,ncat
+                     ztmpn(ji,jj,jl)=qla_ice(ji,jj,1)*a_i(ji,jj,jl)/fr_i(ji,jj)
+                  ENDDO
+               ENDIF
+            END_2D
          ENDIF
          DO jl=1,ncat
@@ -351,5 +346,5 @@
 ! GBM conductive flux through ice (CI_6)
 !  Convert to GBM
-            IF (ksbc == jp_flx) THEN
+            IF(ksbc == jp_flx) THEN
                ztmp(:,:) = botmelt(:,:,jl)*a_i(:,:,jl)
             ELSE
@@ -360,5 +355,5 @@
 ! GBM surface heat flux (CI_7)
 !  Convert to GBM
-            IF (ksbc == jp_flx) THEN
+            IF(ksbc == jp_flx) THEN
                ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i(:,:,jl) 
             ELSE
@@ -368,5 +363,5 @@
          ENDDO
 
-      ELSE IF (ksbc == jp_blk) THEN
+      ELSE IF(ksbc == jp_blk) THEN
 
 ! Pass bulk forcing fields to CICE (which will calculate heat fluxes etc itself)
@@ -422,5 +417,5 @@
 ! Freezing/melting potential
 ! Calculated over NEMO leapfrog timestep (hence 2*dt)
-      nfrzmlt(:,:) = rau0 * rcp * e3t_m(:,:) * ( Tocnfrz-sst_m(:,:) ) / ( 2.0*dt )
+      nfrzmlt(:,:) = rho0 * rcp * e3t_m(:,:) * ( Tocnfrz-sst_m(:,:) ) / ( 2.0*dt )
 
       ztmp(:,:) = nfrzmlt(:,:)
@@ -434,17 +429,13 @@
 ! x comp and y comp of surface ocean current
 ! U point to F point
-      DO jj=1,jpjm1
-         DO ji=1,jpi
-            ztmp(ji,jj)=0.5*(ssu_m(ji,jj)+ssu_m(ji,jj+1))*fmask(ji,jj,1)
-         ENDDO
-      ENDDO
+      DO_2D_10_11
+         ztmp(ji,jj)=0.5*(ssu_m(ji,jj)+ssu_m(ji,jj+1))*fmask(ji,jj,1)
+      END_2D
       CALL nemo2cice(ztmp,uocn,'F', -1. )
 
 ! V point to F point
-      DO jj=1,jpj
-         DO ji=1,jpim1
-            ztmp(ji,jj)=0.5*(ssv_m(ji,jj)+ssv_m(ji+1,jj))*fmask(ji,jj,1)
-         ENDDO
-      ENDDO
+      DO_2D_11_10
+         ztmp(ji,jj)=0.5*(ssv_m(ji,jj)+ssv_m(ji+1,jj))*fmask(ji,jj,1)
+      END_2D
       CALL nemo2cice(ztmp,vocn,'F', -1. )
 
@@ -459,5 +450,5 @@
          zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp
           !
-         zpice(:,:) = ssh_m(:,:) + (  zintn * snwice_mass(:,:) +  zintb * snwice_mass_b(:,:)  ) * r1_rau0
+         zpice(:,:) = ssh_m(:,:) + (  zintn * snwice_mass(:,:) +  zintb * snwice_mass_b(:,:)  ) * r1_rho0
           !
          !
@@ -468,19 +459,15 @@
 ! x comp and y comp of sea surface slope (on F points)
 ! T point to F point
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-            ztmp(ji,jj)=0.5 * (  (zpice(ji+1,jj  )-zpice(ji,jj  )) * r1_e1u(ji,jj  )    &
-               &               + (zpice(ji+1,jj+1)-zpice(ji,jj+1)) * r1_e1u(ji,jj+1)  ) * fmask(ji,jj,1)
-         END DO
-      END DO
+      DO_2D_10_10
+         ztmp(ji,jj)=0.5 * (  (zpice(ji+1,jj  )-zpice(ji,jj  )) * r1_e1u(ji,jj  )    &
+            &               + (zpice(ji+1,jj+1)-zpice(ji,jj+1)) * r1_e1u(ji,jj+1)  ) * fmask(ji,jj,1)
+      END_2D
       CALL nemo2cice( ztmp,ss_tltx,'F', -1. )
 
 ! T point to F point
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-            ztmp(ji,jj)=0.5 * (  (zpice(ji  ,jj+1)-zpice(ji  ,jj)) * r1_e2v(ji  ,jj)    &
-               &               + (zpice(ji+1,jj+1)-zpice(ji+1,jj)) * r1_e2v(ji+1,jj)  ) *  fmask(ji,jj,1)
-         END DO
-      END DO
+      DO_2D_10_10
+         ztmp(ji,jj)=0.5 * (  (zpice(ji  ,jj+1)-zpice(ji  ,jj)) * r1_e2v(ji  ,jj)    &
+            &               + (zpice(ji+1,jj+1)-zpice(ji+1,jj)) * r1_e2v(ji+1,jj)  ) *  fmask(ji,jj,1)
+      END_2D
       CALL nemo2cice(ztmp,ss_tlty,'F', -1. )
       !
@@ -508,9 +495,7 @@
       ss_iou(:,:)=0.0
 ! F point to U point
-      DO jj=2,jpjm1
-         DO ji=2,jpim1
-            ss_iou(ji,jj) = 0.5 * ( ztmp1(ji,jj-1) + ztmp1(ji,jj) ) * umask(ji,jj,1)
-         ENDDO
-      ENDDO
+      DO_2D_00_00
+         ss_iou(ji,jj) = 0.5 * ( ztmp1(ji,jj-1) + ztmp1(ji,jj) ) * umask(ji,jj,1)
+      END_2D
       CALL lbc_lnk( 'sbcice_cice', ss_iou , 'U', -1. )
 
@@ -520,9 +505,7 @@
 ! F point to V point
 
-      DO jj=1,jpjm1
-         DO ji=2,jpim1
-            ss_iov(ji,jj) = 0.5 * ( ztmp1(ji-1,jj) + ztmp1(ji,jj) ) * vmask(ji,jj,1)
-         ENDDO
-      ENDDO
+      DO_2D_10_00
+         ss_iov(ji,jj) = 0.5 * ( ztmp1(ji-1,jj) + ztmp1(ji,jj) ) * vmask(ji,jj,1)
+      END_2D
       CALL lbc_lnk( 'sbcice_cice', ss_iov , 'V', -1. )
 
@@ -546,5 +529,5 @@
 ! Freshwater fluxes 
 
-      IF (ksbc == jp_flx) THEN
+      IF(ksbc == jp_flx) THEN
 ! Note that emp from the forcing files is evap*(1-aice)-(tprecip-aice*sprecip)
 ! What we want here is evap*(1-aice)-tprecip*(1-aice) hence manipulation below
@@ -552,7 +535,7 @@
 ! Better to use evap and tprecip? (but for now don't read in evap in this case)
          emp(:,:)  = emp(:,:)+fr_i(:,:)*(tprecip(:,:)-sprecip(:,:))
-      ELSE IF (ksbc == jp_blk) THEN
+      ELSE IF(ksbc == jp_blk) THEN
          emp(:,:)  = (1.0-fr_i(:,:))*emp(:,:)        
-      ELSE IF (ksbc == jp_purecpl) THEN
+      ELSE IF(ksbc == jp_purecpl) THEN
 ! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above) 
 ! This is currently as required with the coupling fields from the UM atmosphere
@@ -584,10 +567,10 @@
 ! Scale qsr and qns according to ice fraction (bulk formulae only)
 
-      IF (ksbc == jp_blk) THEN
+      IF(ksbc == jp_blk) THEN
          qsr(:,:)=qsr(:,:)*(1.0-fr_i(:,:))
          qns(:,:)=qns(:,:)*(1.0-fr_i(:,:))
       ENDIF
 ! Take into account snow melting except for fully coupled when already in qns_tot
-      IF (ksbc == jp_purecpl) THEN
+      IF(ksbc == jp_purecpl) THEN
          qsr(:,:)= qsr_tot(:,:)
          qns(:,:)= qns_tot(:,:)
@@ -606,9 +589,7 @@
       CALL lbc_lnk( 'sbcice_cice', qsr , 'T', 1. )
 
-      DO jj=1,jpj
-         DO ji=1,jpi
-            nfrzmlt(ji,jj)=MAX(nfrzmlt(ji,jj),0.0)
-         ENDDO
-      ENDDO
+      DO_2D_11_11
+         nfrzmlt(ji,jj)=MAX(nfrzmlt(ji,jj),0.0)
+      END_2D
 
 #if defined key_cice4
@@ -624,5 +605,5 @@
 
       CALL cice2nemo(aice,fr_i,'T', 1. )
-      IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN
+      IF( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN
          DO jl=1,ncat
             CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. )
@@ -632,10 +613,8 @@
 ! T point to U point
 ! T point to V point
-      DO jj=1,jpjm1
-         DO ji=1,jpim1
-            fr_iu(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji+1,jj))*umask(ji,jj,1)
-            fr_iv(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji,jj+1))*vmask(ji,jj,1)
-         ENDDO
-      ENDDO
+      DO_2D_10_10
+         fr_iu(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji+1,jj))*umask(ji,jj,1)
+         fr_iv(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji,jj+1))*vmask(ji,jj,1)
+      END_2D
 
       CALL lbc_lnk_multi( 'sbcice_cice', fr_iu , 'U', 1., fr_iv , 'V', 1. )
@@ -762,9 +741,7 @@
          sn_bot5 = FLD_N( 'botmeltn5_1m' ,    -1.    ,  'botmeltn5' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    )
 
-         REWIND( numnam_ref )              ! Namelist namsbc_cice in reference namelist : 
          READ  ( numnam_ref, namsbc_cice, IOSTAT = ios, ERR = 901)
 901      IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_cice in reference namelist' )
 
-         REWIND( numnam_cfg )              ! Namelist namsbc_cice in configuration namelist : Parameters of the run
          READ  ( numnam_cfg, namsbc_cice, IOSTAT = ios, ERR = 902 )
 902      IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_cice in configuration namelist' )
@@ -879,5 +856,5 @@
 !     B. Gather pn into global array (png)
 
-      IF ( jpnij > 1) THEN
+      IF( jpnij > 1) THEN
          CALL mppsync
          CALL mppgather (pn,0,png) 
@@ -892,5 +869,5 @@
 ! (may be OK but not 100% sure)
 
-      IF (nproc==0) THEN     
+      IF(nproc==0) THEN     
 !        pcg(:,:)=0.0
          DO jn=1,jpnij
@@ -996,9 +973,7 @@
 
       pn(:,:)=0.0
-      DO jj=1,jpjm1
-         DO ji=1,jpim1
-            pn(ji,jj)=pc(ji+1-ji_off,jj+1-jj_off,1)
-         ENDDO
-      ENDDO
+      DO_2D_10_10
+         pn(ji,jj)=pc(ji+1-ji_off,jj+1-jj_off,1)
+      END_2D
 
 #else
@@ -1015,5 +990,5 @@
 ! the lbclnk call on pn will replace these with sensible values
 
-      IF (nproc==0) THEN
+      IF(nproc==0) THEN
          png(:,:,:)=0.0
          DO jn=1,jpnij
@@ -1028,5 +1003,5 @@
 !     C. Scatter png into NEMO field (pn) for each processor
 
-      IF ( jpnij > 1) THEN
+      IF( jpnij > 1) THEN
          CALL mppsync
          CALL mppscatter (png,0,pn) 
@@ -1056,7 +1031,8 @@
    END SUBROUTINE sbc_ice_cice
 
-   SUBROUTINE cice_sbc_init (ksbc)    ! Dummy routine
+   SUBROUTINE cice_sbc_init (ksbc, Kbb, Kmm)    ! Dummy routine
       IMPLICIT NONE
       INTEGER, INTENT( in ) :: ksbc
+      INTEGER, INTENT( in ) :: Kbb, Kmm
       WRITE(*,*) 'cice_sbc_init: You should not have seen this print! error?', ksbc
    END SUBROUTINE cice_sbc_init
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcice_if.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcice_if.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcice_if.F90	(revision 12928)
@@ -35,4 +35,6 @@
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_ice   ! structure of input ice-cover (file informations, fields read)
    
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -42,5 +44,5 @@
 CONTAINS
 
-   SUBROUTINE sbc_ice_if( kt )
+   SUBROUTINE sbc_ice_if( kt, Kbb, Kmm )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE sbc_ice_if  ***
@@ -59,4 +61,5 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! ocean time step
+      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices
       !
       INTEGER  ::   ji, jj     ! dummy loop indices
@@ -74,9 +77,7 @@
          !                                      ! ====================== !
          ! set file information
-         REWIND( numnam_ref )              ! Namelist namsbc_iif in reference namelist : Ice if file
          READ  ( numnam_ref, namsbc_iif, IOSTAT = ios, ERR = 901)
 901      IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_iif in reference namelist' )
 
-         REWIND( numnam_cfg )              ! Namelist Namelist namsbc_iif in configuration namelist : Ice if file
          READ  ( numnam_cfg, namsbc_iif, IOSTAT = ios, ERR = 902 )
 902      IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_iif in configuration namelist' )
@@ -108,37 +109,35 @@
 
          ! Flux and ice fraction computation
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               !
-               zt_fzp  = fr_i(ji,jj)                        ! freezing point temperature
-               zfr_obs = sf_ice(1)%fnow(ji,jj,1)            ! observed ice cover
-               !                                            ! ocean ice fraction (0/1) from the freezing point temperature
-               IF( sst_m(ji,jj) <= zt_fzp ) THEN   ;   fr_i(ji,jj) = 1.e0
-               ELSE                                ;   fr_i(ji,jj) = 0.e0
-               ENDIF
+         DO_2D_11_11
+            !
+            zt_fzp  = fr_i(ji,jj)                        ! freezing point temperature
+            zfr_obs = sf_ice(1)%fnow(ji,jj,1)            ! observed ice cover
+            !                                            ! ocean ice fraction (0/1) from the freezing point temperature
+            IF( sst_m(ji,jj) <= zt_fzp ) THEN   ;   fr_i(ji,jj) = 1.e0
+            ELSE                                ;   fr_i(ji,jj) = 0.e0
+            ENDIF
 
-               tsn(ji,jj,1,jp_tem) = MAX( tsn(ji,jj,1,jp_tem), zt_fzp )     ! avoid over-freezing point temperature
+            ts(ji,jj,1,jp_tem,Kmm) = MAX( ts(ji,jj,1,jp_tem,Kmm), zt_fzp )     ! avoid over-freezing point temperature
 
-               qsr(ji,jj) = ( 1. - zfr_obs ) * qsr(ji,jj)   ! solar heat flux : zero below observed ice cover
+            qsr(ji,jj) = ( 1. - zfr_obs ) * qsr(ji,jj)   ! solar heat flux : zero below observed ice cover
 
-               !                                            ! non solar heat flux : add a damping term 
-               !      # ztrp*(t-(tgel-1.))  if observed ice and no opa ice   (zfr_obs=1 fr_i=0)
-               !      # ztrp*min(0,t-tgel)  if observed ice and opa ice      (zfr_obs=1 fr_i=1)
-               zqri = ztrp * ( tsb(ji,jj,1,jp_tem) - ( zt_fzp - 1.) )
-               zqrj = ztrp * MIN( 0., tsb(ji,jj,1,jp_tem) - zt_fzp )
-               zqrp = ( zfr_obs * ( (1. - fr_i(ji,jj) ) * zqri    &
-                 &                 +      fr_i(ji,jj)   * zqrj ) ) * tmask(ji,jj,1)
+            !                                            ! non solar heat flux : add a damping term 
+            !      # ztrp*(t-(tgel-1.))  if observed ice and no opa ice   (zfr_obs=1 fr_i=0)
+            !      # ztrp*min(0,t-tgel)  if observed ice and opa ice      (zfr_obs=1 fr_i=1)
+            zqri = ztrp * ( ts(ji,jj,1,jp_tem,Kbb) - ( zt_fzp - 1.) )
+            zqrj = ztrp * MIN( 0., ts(ji,jj,1,jp_tem,Kbb) - zt_fzp )
+            zqrp = ( zfr_obs * ( (1. - fr_i(ji,jj) ) * zqri    &
+              &                 +      fr_i(ji,jj)   * zqrj ) ) * tmask(ji,jj,1)
 
-               !                                            ! non-solar heat flux 
-               !      # qns unchanged              if no climatological ice              (zfr_obs=0)
-               !      # qns = zqrp                 if climatological ice and no opa ice  (zfr_obs=1, fr_i=0)
-               !      # qns = zqrp -2(-4) watt/m2  if climatological ice and opa ice     (zfr_obs=1, fr_i=1)
-               !                                   (-2=arctic, -4=antarctic)   
-               zqi = -3. + SIGN( 1._wp, ff_f(ji,jj) )
-               qns(ji,jj) = ( ( 1.- zfr_obs ) * qns(ji,jj)                             &
-                  &          +      zfr_obs   * fr_i(ji,jj) * zqi ) * tmask(ji,jj,1)   &
-                  &       + zqrp
-            END DO
-         END DO
+            !                                            ! non-solar heat flux 
+            !      # qns unchanged              if no climatological ice              (zfr_obs=0)
+            !      # qns = zqrp                 if climatological ice and no opa ice  (zfr_obs=1, fr_i=0)
+            !      # qns = zqrp -2(-4) watt/m2  if climatological ice and opa ice     (zfr_obs=1, fr_i=1)
+            !                                   (-2=arctic, -4=antarctic)   
+            zqi = -3. + SIGN( 1._wp, ff_f(ji,jj) )
+            qns(ji,jj) = ( ( 1.- zfr_obs ) * qns(ji,jj)                             &
+               &          +      zfr_obs   * fr_i(ji,jj) * zqi ) * tmask(ji,jj,1)   &
+               &       + zqrp
+         END_2D
          !
       ENDIF
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcisf.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcisf.F90	(revision 12384)
+++ 	(revision )
@@ -1,902 +1,0 @@
-MODULE sbcisf
-   !!======================================================================
-   !!                       ***  MODULE  sbcisf  ***
-   !! Surface module :  update surface ocean boundary condition under ice
-   !!                   shelf
-   !!======================================================================
-   !! History :  3.2  !  2011-02  (C.Harris  ) Original code isf cav
-   !!            X.X  !  2006-02  (C. Wang   ) Original code bg03
-   !!            3.4  !  2013-03  (P. Mathiot) Merging + parametrization
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   sbc_isf       : update sbc under ice shelf
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and tracers
-   USE dom_oce        ! ocean space and time domain
-   USE phycst         ! physical constants
-   USE eosbn2         ! equation of state
-   USE sbc_oce        ! surface boundary condition: ocean fields
-   USE zdfdrg         ! vertical physics: top/bottom drag coef.
-   !
-   USE in_out_manager ! I/O manager
-   USE iom            ! I/O library
-   USE fldread        ! read input field at current time step
-   USE lbclnk         !
-   USE lib_fortran    ! glob_sum
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   sbc_isf, sbc_isf_init, sbc_isf_div, sbc_isf_alloc  ! routine called in sbcmod and divhor
-
-   ! public in order to be able to output then 
-
-   REAL(wp), PUBLIC ::   rn_hisf_tbl                 !: thickness of top boundary layer [m]
-   INTEGER , PUBLIC ::   nn_isf                      !: flag to choose between explicit/param/specified  
-   INTEGER , PUBLIC ::   nn_isfblk                   !: flag to choose the bulk formulation to compute the ice shelf melting
-   INTEGER , PUBLIC ::   nn_gammablk                 !: flag to choose how the exchange coefficient is computed
-   REAL(wp), PUBLIC ::   rn_gammat0                  !: temperature exchange coeficient []
-   REAL(wp), PUBLIC ::   rn_gammas0                  !: salinity    exchange coeficient []
-
-   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   misfkt   , misfkb        !: Level of ice shelf base
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rzisf_tbl                !: depth of calving front (shallowest point) nn_isf ==2/3
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rhisf_tbl, rhisf_tbl_0   !: thickness of tbl  [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   r1_hisf_tbl              !: 1/thickness of tbl
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ralpha                   !: proportion of bottom cell influenced by tbl 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   risfLeff                 !: effective length (Leff) BG03 nn_isf==2
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ttbl, stbl, utbl, vtbl   !: top boundary layer variable at T point
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qisf                     !: net heat flux from ice shelf      [W/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   risf_tsc_b, risf_tsc     !: before and now T & S isf contents [K.m/s & PSU.m/s]  
-
-   LOGICAL, PUBLIC ::   l_isfcpl = .false.       !: isf recieved from oasis
-
-   REAL(wp), PUBLIC, SAVE ::   rcpisf   = 2000.0_wp     !: specific heat of ice shelf             [J/kg/K]
-   REAL(wp), PUBLIC, SAVE ::   rkappa   = 1.54e-6_wp    !: heat diffusivity through the ice-shelf [m2/s]
-   REAL(wp), PUBLIC, SAVE ::   rhoisf   = 920.0_wp      !: volumic mass of ice shelf              [kg/m3]
-   REAL(wp), PUBLIC, SAVE ::   tsurf    = -20.0_wp      !: air temperature on top of ice shelf    [C]
-   REAL(wp), PUBLIC, SAVE ::   rLfusisf = 0.334e6_wp    !: latent heat of fusion of ice shelf     [J/kg]
-
-!: Variable used in fldread to read the forcing file (nn_isf == 4 .OR. nn_isf == 3)
-   CHARACTER(len=100), PUBLIC           :: cn_dirisf  = './' !: Root directory for location of ssr files
-   TYPE(FLD_N)       , PUBLIC           :: sn_fwfisf         !: information about the isf melting file to be read
-   TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_fwfisf
-   TYPE(FLD_N)       , PUBLIC           :: sn_rnfisf         !: information about the isf melting param.   file to be read
-   TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_rnfisf           
-   TYPE(FLD_N)       , PUBLIC           :: sn_depmax_isf     !: information about the grounding line depth file to be read
-   TYPE(FLD_N)       , PUBLIC           :: sn_depmin_isf     !: information about the calving   line depth file to be read
-   TYPE(FLD_N)       , PUBLIC           :: sn_Leff_isf       !: information about the effective length     file to be read
-   
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id$
-   !! Software governed by the CeCILL license (see ./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
- 
-  SUBROUTINE sbc_isf( kt )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE sbc_isf  ***
-      !!
-      !! ** Purpose : Compute Salt and Heat fluxes related to ice_shelf 
-      !!              melting and freezing 
-      !!
-      !! ** Method  :  4 parameterizations are available according to nn_isf 
-      !!               nn_isf = 1 : Realistic ice_shelf formulation
-      !!                        2 : Beckmann & Goose parameterization
-      !!                        3 : Specified runoff in deptht (Mathiot & al. )
-      !!                        4 : specified fwf and heat flux forcing beneath the ice shelf
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time step
-      !
-      INTEGER ::   ji, jj, jk   ! loop index
-      INTEGER ::   ikt, ikb     ! local integers
-      REAL(wp), DIMENSION(jpi,jpj) ::   zt_frz, zdep   ! freezing temperature (zt_frz) at depth (zdep) 
-      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   zqhcisf2d
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   zfwfisf3d, zqhcisf3d, zqlatisf3d
-      !!---------------------------------------------------------------------
-      !
-      IF( MOD( kt-1, nn_fsbc) == 0 ) THEN    ! compute salt and heat flux
-         !
-         SELECT CASE ( nn_isf )
-         CASE ( 1 )    ! realistic ice shelf formulation
-            ! compute T/S/U/V for the top boundary layer
-            CALL sbc_isf_tbl(tsn(:,:,:,jp_tem),ttbl(:,:),'T')
-            CALL sbc_isf_tbl(tsn(:,:,:,jp_sal),stbl(:,:),'T')
-            CALL sbc_isf_tbl(un(:,:,:)        ,utbl(:,:),'U')
-            CALL sbc_isf_tbl(vn(:,:,:)        ,vtbl(:,:),'V')
-            ! iom print
-            CALL iom_put('ttbl',ttbl(:,:))
-            CALL iom_put('stbl',stbl(:,:))
-            CALL iom_put('utbl',utbl(:,:) * (1._wp - tmask(:,:,1)) * ssmask(:,:))
-            CALL iom_put('vtbl',vtbl(:,:) * (1._wp - tmask(:,:,1)) * ssmask(:,:))
-            ! compute fwf and heat flux
-            ! compute fwf and heat flux
-            IF( .NOT.l_isfcpl ) THEN    ;   CALL sbc_isf_cav (kt)
-            ELSE                        ;   qisf(:,:)  = fwfisf(:,:) * rLfusisf  ! heat        flux
-            ENDIF
-            !
-         CASE ( 2 )    ! Beckmann and Goosse parametrisation 
-            stbl(:,:)   = soce
-            CALL sbc_isf_bg03(kt)
-            !
-         CASE ( 3 )    ! specified runoff in depth (Mathiot et al., XXXX in preparation)
-            ! specified runoff in depth (Mathiot et al., XXXX in preparation)
-            IF( .NOT.l_isfcpl ) THEN
-               CALL fld_read ( kt, nn_fsbc, sf_rnfisf   )
-               fwfisf(:,:) = - sf_rnfisf(1)%fnow(:,:,1)         ! fresh water flux from the isf (fwfisf <0 mean melting) 
-            ENDIF
-            qisf(:,:)   = fwfisf(:,:) * rLfusisf             ! heat flux
-            stbl(:,:)   = soce
-            !
-         CASE ( 4 )    ! specified fwf and heat flux forcing beneath the ice shelf
-            !          ! specified fwf and heat flux forcing beneath the ice shelf
-            IF( .NOT.l_isfcpl ) THEN
-               CALL fld_read ( kt, nn_fsbc, sf_fwfisf   )
-               !CALL fld_read ( kt, nn_fsbc, sf_qisf   )
-               fwfisf(:,:) = -sf_fwfisf(1)%fnow(:,:,1)            ! fwf
-            ENDIF
-            qisf(:,:)   = fwfisf(:,:) * rLfusisf               ! heat flux
-            stbl(:,:)   = soce
-            !
-         END SELECT
-
-         ! compute tsc due to isf
-         ! isf melting implemented as a volume flux and we assume that melt water is at 0 PSU.
-         ! WARNING water add at temp = 0C, need to add a correction term (fwfisf * tfreez / rau0).
-         ! compute freezing point beneath ice shelf (or top cell if nn_isf = 3)
-         DO jj = 1,jpj
-            DO ji = 1,jpi
-               zdep(ji,jj)=gdepw_n(ji,jj,misfkt(ji,jj))
-            END DO
-         END DO
-         CALL eos_fzp( stbl(:,:), zt_frz(:,:), zdep(:,:) )
-         
-         risf_tsc(:,:,jp_tem) = qisf(:,:) * r1_rau0_rcp - fwfisf(:,:) * zt_frz(:,:) * r1_rau0 !
-         risf_tsc(:,:,jp_sal) = 0.0_wp
-
-         ! lbclnk
-         CALL lbc_lnk_multi( 'sbcisf', risf_tsc(:,:,jp_tem), 'T', 1., risf_tsc(:,:,jp_sal), 'T', 1., fwfisf,'T', 1., qisf, 'T', 1.)
-         ! output
-         IF( iom_use('iceshelf_cea') )   CALL iom_put( 'iceshelf_cea', -fwfisf(:,:)                      )   ! isf mass flux
-         IF( iom_use('hflx_isf_cea') )   CALL iom_put( 'hflx_isf_cea', risf_tsc(:,:,jp_tem) * rau0 * rcp )   ! isf sensible+latent heat (W/m2)
-         IF( iom_use('qlatisf' ) )       CALL iom_put( 'qlatisf'     , qisf(:,:)                         )   ! isf latent heat
-         IF( iom_use('fwfisf'  ) )       CALL iom_put( 'fwfisf'      , fwfisf(:,:)                       )   ! isf mass flux (opposite sign)
-
-         ! Diagnostics
-         IF( iom_use('fwfisf3d') .OR. iom_use('qlatisf3d') .OR. iom_use('qhcisf3d') .OR. iom_use('qhcisf')) THEN
-            ALLOCATE( zfwfisf3d(jpi,jpj,jpk) , zqhcisf3d(jpi,jpj,jpk) , zqlatisf3d(jpi,jpj,jpk) )
-            ALLOCATE( zqhcisf2d(jpi,jpj) )
-            !
-            zfwfisf3d (:,:,:) = 0._wp                         ! 3d ice shelf melting (kg/m2/s)
-            zqhcisf3d (:,:,:) = 0._wp                         ! 3d heat content flux (W/m2)
-            zqlatisf3d(:,:,:) = 0._wp                         ! 3d ice shelf melting latent heat flux (W/m2)
-            zqhcisf2d (:,:)   = fwfisf(:,:) * zt_frz * rcp    ! 2d heat content flux (W/m2)
-            !
-            DO jj = 1,jpj
-               DO ji = 1,jpi
-                  ikt = misfkt(ji,jj)
-                  ikb = misfkb(ji,jj)
-                  DO jk = ikt, ikb - 1
-                     zfwfisf3d (ji,jj,jk) = zfwfisf3d (ji,jj,jk) + fwfisf   (ji,jj) * r1_hisf_tbl(ji,jj) * e3t_n(ji,jj,jk)
-                     zqhcisf3d (ji,jj,jk) = zqhcisf3d (ji,jj,jk) + zqhcisf2d(ji,jj) * r1_hisf_tbl(ji,jj) * e3t_n(ji,jj,jk)
-                     zqlatisf3d(ji,jj,jk) = zqlatisf3d(ji,jj,jk) + qisf     (ji,jj) * r1_hisf_tbl(ji,jj) * e3t_n(ji,jj,jk)
-                  END DO
-                  zfwfisf3d (ji,jj,jk) = zfwfisf3d (ji,jj,jk) + fwfisf   (ji,jj) * r1_hisf_tbl(ji,jj)   & 
-                     &                                                                   * ralpha(ji,jj) * e3t_n(ji,jj,jk)
-                  zqhcisf3d (ji,jj,jk) = zqhcisf3d (ji,jj,jk) + zqhcisf2d(ji,jj) * r1_hisf_tbl(ji,jj)   & 
-                     &                                                                   * ralpha(ji,jj) * e3t_n(ji,jj,jk)
-                  zqlatisf3d(ji,jj,jk) = zqlatisf3d(ji,jj,jk) + qisf     (ji,jj) * r1_hisf_tbl(ji,jj)   &  
-                     &                                                                   * ralpha(ji,jj) * e3t_n(ji,jj,jk)
-               END DO
-            END DO
-            !
-            CALL iom_put('fwfisf3d' , zfwfisf3d (:,:,:))
-            CALL iom_put('qlatisf3d', zqlatisf3d(:,:,:))
-            CALL iom_put('qhcisf3d' , zqhcisf3d (:,:,:))
-            CALL iom_put('qhcisf'   , zqhcisf2d (:,:  ))
-            !
-            DEALLOCATE( zfwfisf3d, zqhcisf3d, zqlatisf3d )
-            DEALLOCATE( zqhcisf2d )
-         ENDIF
-         !
-      ENDIF
-
-      IF( kt == nit000 ) THEN                         !   set the forcing field at nit000 - 1    !
-         IF( ln_rstart .AND.    &                     ! Restart: read in restart file
-            &   iom_varid( numror, 'fwf_isf_b', ldstop = .FALSE. ) > 0 ) THEN
-            IF(lwp) WRITE(numout,*) '          nit000-1 isf tracer content forcing fields read in the restart file'
-            CALL iom_get( numror, jpdom_autoglo, 'fwf_isf_b', fwfisf_b(:,:)         , ldxios = lrxios )   ! before salt content isf_tsc trend
-            CALL iom_get( numror, jpdom_autoglo, 'isf_sc_b' , risf_tsc_b(:,:,jp_sal), ldxios = lrxios )   ! before salt content isf_tsc trend
-            CALL iom_get( numror, jpdom_autoglo, 'isf_hc_b' , risf_tsc_b(:,:,jp_tem), ldxios = lrxios )   ! before salt content isf_tsc trend
-         ELSE
-            fwfisf_b(:,:)    = fwfisf(:,:)
-            risf_tsc_b(:,:,:)= risf_tsc(:,:,:)
-         ENDIF
-      ENDIF
-      ! 
-      IF( lrst_oce ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'sbc : isf surface tracer content forcing fields written in ocean restart file ',   &
-            &                    'at it= ', kt,' date= ', ndastp
-         IF(lwp) WRITE(numout,*) '~~~~'
-         IF( lwxios ) CALL iom_swap(      cwxios_context          )
-         CALL iom_rstput( kt, nitrst, numrow, 'fwf_isf_b', fwfisf(:,:)         , ldxios = lwxios )
-         CALL iom_rstput( kt, nitrst, numrow, 'isf_hc_b' , risf_tsc(:,:,jp_tem), ldxios = lwxios )
-         CALL iom_rstput( kt, nitrst, numrow, 'isf_sc_b' , risf_tsc(:,:,jp_sal), ldxios = lwxios )
-         IF( lwxios ) CALL iom_swap(      cxios_context          )
-      ENDIF
-      !
-   END SUBROUTINE sbc_isf
-
-
-   INTEGER FUNCTION sbc_isf_alloc()
-      !!----------------------------------------------------------------------
-      !!               ***  FUNCTION sbc_isf_rnf_alloc  ***
-      !!----------------------------------------------------------------------
-      sbc_isf_alloc = 0       ! set to zero if no array to be allocated
-      IF( .NOT. ALLOCATED( qisf ) ) THEN
-         ALLOCATE(  risf_tsc(jpi,jpj,jpts), risf_tsc_b(jpi,jpj,jpts), qisf(jpi,jpj)   , &
-               &    rhisf_tbl(jpi,jpj)    , r1_hisf_tbl(jpi,jpj), rzisf_tbl(jpi,jpj)  , &
-               &    ttbl(jpi,jpj)         , stbl(jpi,jpj)       , utbl(jpi,jpj)       , &
-               &    vtbl(jpi, jpj)        , risfLeff(jpi,jpj)   , rhisf_tbl_0(jpi,jpj), &
-               &    ralpha(jpi,jpj)       , misfkt(jpi,jpj)     , misfkb(jpi,jpj)     , &
-               &    STAT= sbc_isf_alloc )
-         !
-         CALL mpp_sum ( 'sbcisf', sbc_isf_alloc )
-         IF( sbc_isf_alloc /= 0 )   CALL ctl_stop( 'STOP', 'sbc_isf_alloc: failed to allocate arrays.' )
-         !
-      ENDIF
-   END FUNCTION
-
-
-  SUBROUTINE sbc_isf_init
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE sbc_isf_init  ***
-      !!
-      !! ** Purpose : Initialisation of variables for iceshelf fluxes formulation
-      !!
-      !! ** Method  :  4 parameterizations are available according to nn_isf 
-      !!               nn_isf = 1 : Realistic ice_shelf formulation
-      !!                        2 : Beckmann & Goose parameterization
-      !!                        3 : Specified runoff in deptht (Mathiot & al. )
-      !!                        4 : specified fwf and heat flux forcing beneath the ice shelf
-      !!----------------------------------------------------------------------
-      INTEGER               :: ji, jj, jk           ! loop index
-      INTEGER               :: ik                   ! current level index
-      INTEGER               :: ikt, ikb             ! top and bottom level of the isf boundary layer
-      INTEGER               :: inum, ierror
-      INTEGER               :: ios                  ! Local integer output status for namelist read
-      REAL(wp)              :: zhk
-      CHARACTER(len=256)    :: cvarzisf, cvarhisf   ! name for isf file
-      CHARACTER(LEN=32 )    :: cvarLeff             ! variable name for efficient Length scale
-      !!----------------------------------------------------------------------
-      NAMELIST/namsbc_isf/ nn_isfblk, rn_hisf_tbl, rn_gammat0, rn_gammas0, nn_gammablk, nn_isf, &
-                         & sn_fwfisf, sn_rnfisf, sn_depmax_isf, sn_depmin_isf, sn_Leff_isf
-      !!----------------------------------------------------------------------
-
-      REWIND( numnam_ref )              ! Namelist namsbc_rnf in reference namelist : Runoffs 
-      READ  ( numnam_ref, namsbc_isf, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_isf in reference namelist' )
-
-      REWIND( numnam_cfg )              ! Namelist namsbc_rnf in configuration namelist : Runoffs
-      READ  ( numnam_cfg, namsbc_isf, IOSTAT = ios, ERR = 902 )
-902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_isf in configuration namelist' )
-      IF(lwm) WRITE ( numond, namsbc_isf )
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'sbc_isf_init : heat flux of the ice shelf'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
-      IF(lwp) WRITE(numout,*) '   Namelist namsbc_isf :'
-      IF(lwp) WRITE(numout,*) '      type ice shelf melting/freezing         nn_isf      = ', nn_isf
-      IF(lwp) WRITE(numout,*) '      bulk formulation (nn_isf=1 only)        nn_isfblk   = ', nn_isfblk
-      IF(lwp) WRITE(numout,*) '      thickness of the top boundary layer     rn_hisf_tbl = ', rn_hisf_tbl
-      IF(lwp) WRITE(numout,*) '      gamma formulation                       nn_gammablk = ', nn_gammablk 
-      IF(lwp) WRITE(numout,*) '      gammat coefficient                      rn_gammat0  = ', rn_gammat0  
-      IF(lwp) WRITE(numout,*) '      gammas coefficient                      rn_gammas0  = ', rn_gammas0  
-      IF(lwp) WRITE(numout,*) '      top drag coef. used (from namdrg_top)   rn_Cd0      = ', r_Cdmin_top 
-
-
-                           !  1 = presence of ISF    2 = bg03 parametrisation 
-                           !  3 = rnf file for isf   4 = ISF fwf specified
-                           !  option 1 and 4 need ln_isfcav = .true. (domzgr)
-      !
-      ! Allocate public variable
-      IF ( sbc_isf_alloc()  /= 0 )         CALL ctl_stop( 'STOP', 'sbc_isf : unable to allocate arrays' )
-      !
-      ! initialisation
-      qisf    (:,:)    = 0._wp   ;   fwfisf  (:,:) = 0._wp
-      risf_tsc(:,:,:)  = 0._wp   ;   fwfisf_b(:,:) = 0._wp
-      !
-      ! define isf tbl tickness, top and bottom indice
-      SELECT CASE ( nn_isf )
-      CASE ( 1 ) 
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '      ==>>>   presence of under iceshelf seas (nn_isf = 1)'
-         rhisf_tbl(:,:) = rn_hisf_tbl
-         misfkt   (:,:) = mikt(:,:)         ! same indice for bg03 et cav => used in isfdiv
-         !
-      CASE ( 2 , 3 )
-         IF( .NOT.l_isfcpl ) THEN
-             ALLOCATE( sf_rnfisf(1), STAT=ierror )
-             ALLOCATE( sf_rnfisf(1)%fnow(jpi,jpj,1), sf_rnfisf(1)%fdta(jpi,jpj,1,2) )
-             CALL fld_fill( sf_rnfisf, (/ sn_rnfisf /), cn_dirisf, 'sbc_isf_init', 'read fresh water flux isf data', 'namsbc_isf' )
-          ENDIF
-          !  read effective lenght (BG03)
-          IF( nn_isf == 2 ) THEN
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '      ==>>>   bg03 parametrisation (nn_isf = 2)'
-            CALL iom_open( sn_Leff_isf%clname, inum )
-            cvarLeff = TRIM(sn_Leff_isf%clvar)
-            CALL iom_get( inum, jpdom_data, cvarLeff, risfLeff , 1)
-            CALL iom_close(inum)
-            !
-            risfLeff = risfLeff*1000.0_wp           !: convertion in m
-         ELSE
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '      ==>>>   rnf file for isf (nn_isf = 3)'
-         ENDIF
-         ! read depth of the top and bottom of the isf top boundary layer (in this case, isf front depth and grounding line depth)
-         CALL iom_open( sn_depmax_isf%clname, inum )
-         cvarhisf = TRIM(sn_depmax_isf%clvar)
-         CALL iom_get( inum, jpdom_data, cvarhisf, rhisf_tbl, 1) !: depth of deepest point of the ice shelf base
-         CALL iom_close(inum)
-         !
-         CALL iom_open( sn_depmin_isf%clname, inum )
-         cvarzisf = TRIM(sn_depmin_isf%clvar)
-         CALL iom_get( inum, jpdom_data, cvarzisf, rzisf_tbl, 1) !: depth of shallowest point of the ice shelves base
-         CALL iom_close(inum)
-         !
-         rhisf_tbl(:,:) = rhisf_tbl(:,:) - rzisf_tbl(:,:)        !: tickness isf boundary layer
-
-         !! compute first level of the top boundary layer
-         DO ji = 1, jpi
-            DO jj = 1, jpj
-                ik = 2
-!!gm potential bug: use gdepw_0 not _n
-                DO WHILE ( ik <= mbkt(ji,jj) .AND. gdepw_n(ji,jj,ik) < rzisf_tbl(ji,jj) ) ;  ik = ik + 1 ;  END DO
-                misfkt(ji,jj) = ik-1
-            END DO
-         END DO
-         !
-      CASE ( 4 ) 
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '      ==>>>   specified fresh water flux in ISF (nn_isf = 4)'
-         ! as in nn_isf == 1
-         rhisf_tbl(:,:) = rn_hisf_tbl
-         misfkt   (:,:) = mikt(:,:)         ! same indice for bg03 et cav => used in isfdiv
-         !
-         ! load variable used in fldread (use for temporal interpolation of isf fwf forcing)
-         IF( .NOT.l_isfcpl ) THEN
-           ALLOCATE( sf_fwfisf(1), STAT=ierror )
-           ALLOCATE( sf_fwfisf(1)%fnow(jpi,jpj,1), sf_fwfisf(1)%fdta(jpi,jpj,1,2) )
-           CALL fld_fill( sf_fwfisf, (/ sn_fwfisf /), cn_dirisf, 'sbc_isf_init', 'read fresh water flux isf data', 'namsbc_isf' )
-         ENDIF
-         !
-      CASE DEFAULT
-         CALL ctl_stop( 'sbc_isf_init: wrong value of nn_isf' )
-      END SELECT
-         
-      rhisf_tbl_0(:,:) = rhisf_tbl(:,:)
-
-      ! compute bottom level of isf tbl and thickness of tbl below the ice shelf
-      DO jj = 1,jpj
-         DO ji = 1,jpi
-            ikt = misfkt(ji,jj)
-            ikb = misfkt(ji,jj)
-            ! thickness of boundary layer at least the top level thickness
-            rhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), e3t_n(ji,jj,ikt))
-
-            ! determine the deepest level influenced by the boundary layer
-            DO jk = ikt+1, mbkt(ji,jj)
-               IF( (SUM(e3t_n(ji,jj,ikt:jk-1)) < rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) )   ikb = jk
-            END DO
-            rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(e3t_n(ji,jj,ikt:ikb))) ! limit the tbl to water thickness.
-            misfkb(ji,jj) = ikb                                                   ! last wet level of the tbl
-            r1_hisf_tbl(ji,jj) = 1._wp / rhisf_tbl(ji,jj)
-
-            zhk           = SUM( e3t_n(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj) ! proportion of tbl cover by cell from ikt to ikb - 1
-            ralpha(ji,jj) = rhisf_tbl(ji,jj) * (1._wp - zhk ) / e3t_n(ji,jj,ikb)  ! proportion of bottom cell influenced by boundary layer
-         END DO
-      END DO
-
-      IF( lwxios ) THEN
-          CALL iom_set_rstw_var_active('fwf_isf_b')
-          CALL iom_set_rstw_var_active('isf_hc_b')
-          CALL iom_set_rstw_var_active('isf_sc_b')
-      ENDIF
-
-
-  END SUBROUTINE sbc_isf_init
-
-
-  SUBROUTINE sbc_isf_bg03(kt)
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE sbc_isf_bg03  ***
-      !!
-      !! ** Purpose : add net heat and fresh water flux from ice shelf melting
-      !!          into the adjacent ocean
-      !!
-      !! ** Method  :   See reference
-      !!
-      !! ** Reference : Beckmann and Goosse (2003), "A parameterization of ice shelf-ocean
-      !!         interaction for climate models", Ocean Modelling 5(2003) 157-170.
-      !!         (hereafter BG)
-      !! History :  06-02  (C. Wang) Original code
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT ( in ) :: kt
-      !
-      INTEGER  :: ji, jj, jk ! dummy loop index
-      INTEGER  :: ik         ! current level
-      REAL(wp) :: zt_sum     ! sum of the temperature between 200m and 600m
-      REAL(wp) :: zt_ave     ! averaged temperature between 200m and 600m
-      REAL(wp) :: zt_frz     ! freezing point temperature at depth z
-      REAL(wp) :: zpress     ! pressure to compute the freezing point in depth
-      !!----------------------------------------------------------------------
-      !
-      DO ji = 1, jpi
-         DO jj = 1, jpj
-            ik = misfkt(ji,jj)
-            !! Initialize arrays to 0 (each step)
-            zt_sum = 0.e0_wp
-            IF ( ik > 1 ) THEN
-               ! 1. -----------the average temperature between 200m and 600m ---------------------
-               DO jk = misfkt(ji,jj),misfkb(ji,jj)
-                  ! Calculate freezing temperature
-                  zpress = grav*rau0*gdept_n(ji,jj,ik)*1.e-04
-                  CALL eos_fzp(stbl(ji,jj), zt_frz, zpress) 
-                  zt_sum = zt_sum + (tsn(ji,jj,jk,jp_tem)-zt_frz) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk)  ! sum temp
-               END DO
-               zt_ave = zt_sum/rhisf_tbl(ji,jj) ! calcul mean value
-               ! 2. ------------Net heat flux and fresh water flux due to the ice shelf
-               ! For those corresponding to zonal boundary    
-               qisf(ji,jj) = - rau0 * rcp * rn_gammat0 * risfLeff(ji,jj) * e1t(ji,jj) * zt_ave  &
-                           & * r1_e1e2t(ji,jj) * tmask(ji,jj,jk)
-             
-               fwfisf(ji,jj) = qisf(ji,jj) / rLfusisf          !fresh water flux kg/(m2s)                  
-               fwfisf(ji,jj) = fwfisf(ji,jj) * ( soce / stbl(ji,jj) )
-               !add to salinity trend
-            ELSE
-               qisf(ji,jj) = 0._wp   ;   fwfisf(ji,jj) = 0._wp
-            END IF
-         END DO
-      END DO
-      !
-  END SUBROUTINE sbc_isf_bg03
-
-
-  SUBROUTINE sbc_isf_cav( kt )
-      !!---------------------------------------------------------------------
-      !!                     ***  ROUTINE sbc_isf_cav  ***
-      !!
-      !! ** Purpose :   handle surface boundary condition under ice shelf
-      !!
-      !! ** Method  : -
-      !!
-      !! ** Action  :   utau, vtau : remain unchanged
-      !!                taum, wndm : remain unchanged
-      !!                qns        : update heat flux below ice shelf
-      !!                emp, emps  : update freshwater flux below ice shelf
-      !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time step
-      !
-      INTEGER  ::   ji, jj     ! dummy loop indices
-      INTEGER  ::   nit
-      LOGICAL  ::   lit
-      REAL(wp) ::   zlamb1, zlamb2, zlamb3
-      REAL(wp) ::   zeps1,zeps2,zeps3,zeps4,zeps6,zeps7
-      REAL(wp) ::   zaqe,zbqe,zcqe,zaqer,zdis,zsfrz,zcfac
-      REAL(wp) ::   zeps = 1.e-20_wp        
-      REAL(wp) ::   zerr
-      REAL(wp), DIMENSION(jpi,jpj) ::   zfrz
-      REAL(wp), DIMENSION(jpi,jpj) ::   zgammat, zgammas 
-      REAL(wp), DIMENSION(jpi,jpj) ::   zfwflx, zhtflx, zhtflx_b
-      !!---------------------------------------------------------------------
-      !
-      ! coeficient for linearisation of potential tfreez
-      ! Crude approximation for pressure (but commonly used)
-      IF ( l_useCT ) THEN   ! linearisation from Jourdain et al. (2017)
-         zlamb1 =-0.0564_wp
-         zlamb2 = 0.0773_wp
-         zlamb3 =-7.8633e-8 * grav * rau0
-      ELSE                  ! linearisation from table 4 (Asay-Davis et al., 2015)
-         zlamb1 =-0.0573_wp
-         zlamb2 = 0.0832_wp
-         zlamb3 =-7.53e-8 * grav * rau0
-      ENDIF
-      !
-      ! initialisation
-      zgammat(:,:) = rn_gammat0 ; zgammas (:,:) = rn_gammas0
-      zhtflx (:,:) = 0.0_wp     ; zhtflx_b(:,:) = 0.0_wp    
-      zfwflx (:,:) = 0.0_wp
-
-      ! compute ice shelf melting
-      nit = 1 ; lit = .TRUE.
-      DO WHILE ( lit )    ! maybe just a constant number of iteration as in blk_core is fine
-         SELECT CASE ( nn_isfblk )
-         CASE ( 1 )   !  ISOMIP formulation (2 equations) for volume flux (Hunter et al., 2006)
-            ! Calculate freezing temperature
-            CALL eos_fzp( stbl(:,:), zfrz(:,:), risfdep(:,:) )
-
-            ! compute gammat every where (2d)
-            CALL sbc_isf_gammats(zgammat, zgammas, zhtflx, zfwflx)
-            
-            ! compute upward heat flux zhtflx and upward water flux zwflx
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zhtflx(ji,jj) =   zgammat(ji,jj)*rcp*rau0*(ttbl(ji,jj)-zfrz(ji,jj))
-                  zfwflx(ji,jj) = - zhtflx(ji,jj)/rLfusisf
-               END DO
-            END DO
-
-            ! Compute heat flux and upward fresh water flux
-            qisf  (:,:) = - zhtflx(:,:) * (1._wp - tmask(:,:,1)) * ssmask(:,:)
-            fwfisf(:,:) =   zfwflx(:,:) * (1._wp - tmask(:,:,1)) * ssmask(:,:)
-
-         CASE ( 2 )  ! ISOMIP+ formulation (3 equations) for volume flux (Asay-Davis et al., 2015)
-            ! compute gammat every where (2d)
-            CALL sbc_isf_gammats(zgammat, zgammas, zhtflx, zfwflx)
-
-            ! compute upward heat flux zhtflx and upward water flux zwflx
-            ! Resolution of a 2d equation from equation 21, 22 and 23 to find Sb (Asay-Davis et al., 2015)
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  ! compute coeficient to solve the 2nd order equation
-                  zeps1 = rcp*rau0*zgammat(ji,jj)
-                  zeps2 = rLfusisf*rau0*zgammas(ji,jj)
-                  zeps3 = rhoisf*rcpisf*rkappa/MAX(risfdep(ji,jj),zeps)
-                  zeps4 = zlamb2+zlamb3*risfdep(ji,jj)
-                  zeps6 = zeps4-ttbl(ji,jj)
-                  zeps7 = zeps4-tsurf
-                  zaqe  = zlamb1 * (zeps1 + zeps3)
-                  zaqer = 0.5_wp/MIN(zaqe,-zeps)
-                  zbqe  = zeps1*zeps6+zeps3*zeps7-zeps2
-                  zcqe  = zeps2*stbl(ji,jj)
-                  zdis  = zbqe*zbqe-4.0_wp*zaqe*zcqe               
-
-                  ! Presumably zdis can never be negative because gammas is very small compared to gammat
-                  ! compute s freeze
-                  zsfrz=(-zbqe-SQRT(zdis))*zaqer
-                  IF ( zsfrz < 0.0_wp ) zsfrz=(-zbqe+SQRT(zdis))*zaqer
-
-                  ! compute t freeze (eq. 22)
-                  zfrz(ji,jj)=zeps4+zlamb1*zsfrz
-  
-                  ! zfwflx is upward water flux
-                  ! zhtflx is upward heat flux (out of ocean)
-                  ! compute the upward water and heat flux (eq. 28 and eq. 29)
-                  zfwflx(ji,jj) = rau0 * zgammas(ji,jj) * (zsfrz-stbl(ji,jj)) / MAX(zsfrz,zeps)
-                  zhtflx(ji,jj) = zgammat(ji,jj) * rau0 * rcp * (ttbl(ji,jj) - zfrz(ji,jj) ) 
-               END DO
-            END DO
-
-            ! compute heat and water flux
-            qisf  (:,:) = - zhtflx(:,:) * (1._wp - tmask(:,:,1)) * ssmask(:,:)
-            fwfisf(:,:) =   zfwflx(:,:) * (1._wp - tmask(:,:,1)) * ssmask(:,:)
-
-         END SELECT
-
-         ! define if we need to iterate (nn_gammablk 0/1 do not need iteration)
-         IF ( nn_gammablk <  2 ) THEN ; lit = .FALSE.
-         ELSE                           
-            ! check total number of iteration
-            IF (nit >= 100) THEN ; CALL ctl_stop( 'STOP', 'sbc_isf_hol99 : too many iteration ...' )
-            ELSE                 ; nit = nit + 1
-            END IF
-
-            ! compute error between 2 iterations
-            ! if needed save gammat and compute zhtflx_b for next iteration
-            zerr = MAXVAL(ABS(zhtflx-zhtflx_b))
-            IF ( zerr <= 0.01_wp ) THEN ; lit = .FALSE.
-            ELSE                        ; zhtflx_b(:,:) = zhtflx(:,:)
-            END IF
-         END IF
-      END DO
-      !
-      CALL iom_put('isfgammat', zgammat)
-      CALL iom_put('isfgammas', zgammas)
-      ! 
-   END SUBROUTINE sbc_isf_cav
-
-
-   SUBROUTINE sbc_isf_gammats(pgt, pgs, pqhisf, pqwisf )
-      !!----------------------------------------------------------------------
-      !! ** Purpose    : compute the coefficient echange for heat flux
-      !!
-      !! ** Method     : gamma assume constant or depends of u* and stability
-      !!
-      !! ** References : Holland and Jenkins, 1999, JPO, p1787-1800, eq 14
-      !!                Jenkins et al., 2010, JPO, p2298-2312
-      !!---------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:), INTENT(  out) ::   pgt   , pgs      ! 
-      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   pqhisf, pqwisf   ! 
-      !
-      INTEGER  :: ji, jj                     ! loop index
-      INTEGER  :: ikt                        ! local integer
-      REAL(wp) :: zdku, zdkv                 ! U, V shear 
-      REAL(wp) :: zPr, zSc, zRc              ! Prandtl, Scmidth and Richardson number 
-      REAL(wp) :: zmob, zmols                ! Monin Obukov length, coriolis factor at T point
-      REAL(wp) :: zbuofdep, zhnu             ! Bouyancy length scale, sublayer tickness
-      REAL(wp) :: zhmax                      ! limitation of mol
-      REAL(wp) :: zetastar                   ! stability parameter
-      REAL(wp) :: zgmolet, zgmoles, zgturb   ! contribution of modelecular sublayer and turbulence 
-      REAL(wp) :: zcoef                      ! temporary coef
-      REAL(wp) :: zdep
-      REAL(wp) :: zeps = 1.0e-20_wp    
-      REAL(wp), PARAMETER :: zxsiN = 0.052_wp   ! dimensionless constant
-      REAL(wp), PARAMETER :: znu   = 1.95e-6_wp ! kinamatic viscosity of sea water (m2.s-1)
-      REAL(wp), DIMENSION(2) :: zts, zab
-      REAL(wp), DIMENSION(jpi,jpj) :: zustar   ! U, V at T point and friction velocity
-      !!---------------------------------------------------------------------
-      !
-      SELECT CASE ( nn_gammablk )
-      CASE ( 0 ) ! gamma is constant (specified in namelist)
-         !! ISOMIP formulation (Hunter et al, 2006)
-         pgt(:,:) = rn_gammat0
-         pgs(:,:) = rn_gammas0
-
-      CASE ( 1 ) ! gamma is assume to be proportional to u*
-         !! Jenkins et al., 2010, JPO, p2298-2312
-         !! Adopted by Asay-Davis et al. (2015)
-         !! compute ustar (eq. 24)
-!!gm  NB  use pCdU here so that it will incorporate local boost of Cd0 and log layer case :
-!!         zustar(:,:) = SQRT( rCdU_top(:,:) * SQRT(utbl(:,:) * utbl(:,:) + vtbl(:,:) * vtbl(:,:) + r_ke0_top) )
-!! or better :  compute ustar in zdfdrg  and use it here as well as in TKE, GLS and Co
-!!
-!!     ===>>>>    GM  to be done this chrismas
-!!         
-!!gm end
-         zustar(:,:) = SQRT( r_Cdmin_top * (utbl(:,:) * utbl(:,:) + vtbl(:,:) * vtbl(:,:) + r_ke0_top) )
-
-         !! Compute gammats
-         pgt(:,:) = zustar(:,:) * rn_gammat0
-         pgs(:,:) = zustar(:,:) * rn_gammas0
-      
-      CASE ( 2 ) ! gamma depends of stability of boundary layer
-         !! Holland and Jenkins, 1999, JPO, p1787-1800, eq 14
-         !! as MOL depends of flux and flux depends of MOL, best will be iteration (TO DO)
-         !! compute ustar
-         zustar(:,:) = SQRT( r_Cdmin_top * (utbl(:,:) * utbl(:,:) + vtbl(:,:) * vtbl(:,:) + r_ke0_top) )
-
-         !! compute Pr and Sc number (can be improved)
-         zPr =   13.8_wp
-         zSc = 2432.0_wp
-
-         !! compute gamma mole
-         zgmolet = 12.5_wp * zPr ** (2.0/3.0) - 6.0_wp
-         zgmoles = 12.5_wp * zSc ** (2.0/3.0) - 6.0_wp
-
-         !! compute gamma
-         DO ji = 2, jpi
-            DO jj = 2, jpj
-               ikt = mikt(ji,jj)
-
-               IF( zustar(ji,jj) == 0._wp ) THEN           ! only for kt = 1 I think
-                  pgt = rn_gammat0
-                  pgs = rn_gammas0
-               ELSE
-                  !! compute Rc number (as done in zdfric.F90)
-!!gm better to do it like in the new zdfric.F90   i.e. avm weighted Ri computation
-!!gm moreover, use Max(rn2,0) to take care of static instabilities....
-                  zcoef = 0.5_wp / e3w_n(ji,jj,ikt+1)
-                  !                                            ! shear of horizontal velocity
-                  zdku = zcoef * (  un(ji-1,jj  ,ikt  ) + un(ji,jj,ikt  )  &
-                     &             -un(ji-1,jj  ,ikt+1) - un(ji,jj,ikt+1)  )
-                  zdkv = zcoef * (  vn(ji  ,jj-1,ikt  ) + vn(ji,jj,ikt  )  &
-                     &             -vn(ji  ,jj-1,ikt+1) - vn(ji,jj,ikt+1)  )
-                  !                                            ! richardson number (minimum value set to zero)
-                  zRc = rn2(ji,jj,ikt+1) / MAX( zdku*zdku + zdkv*zdkv, zeps )
-
-                  !! compute bouyancy 
-                  zts(jp_tem) = ttbl(ji,jj)
-                  zts(jp_sal) = stbl(ji,jj)
-                  zdep        = gdepw_n(ji,jj,ikt)
-                  !
-                  CALL eos_rab( zts, zdep, zab )
-                  !
-                  !! compute length scale 
-                  zbuofdep = grav * ( zab(jp_tem) * pqhisf(ji,jj) - zab(jp_sal) * pqwisf(ji,jj) )  !!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-                  !! compute Monin Obukov Length
-                  ! Maximum boundary layer depth
-                  zhmax = gdept_n(ji,jj,mbkt(ji,jj)) - gdepw_n(ji,jj,mikt(ji,jj)) -0.001_wp
-                  ! Compute Monin obukhov length scale at the surface and Ekman depth:
-                  zmob   = zustar(ji,jj) ** 3 / (vkarmn * (zbuofdep + zeps))
-                  zmols  = SIGN(1._wp, zmob) * MIN(ABS(zmob), zhmax) * tmask(ji,jj,ikt)
-
-                  !! compute eta* (stability parameter)
-                  zetastar = 1._wp / ( SQRT(1._wp + MAX(zxsiN * zustar(ji,jj) / ( ABS(ff_f(ji,jj)) * zmols * zRc ), 0._wp)))
-
-                  !! compute the sublayer thickness
-                  zhnu = 5 * znu / zustar(ji,jj)
-
-                  !! compute gamma turb
-                  zgturb = 1._wp / vkarmn * LOG(zustar(ji,jj) * zxsiN * zetastar * zetastar / ( ABS(ff_f(ji,jj)) * zhnu )) &
-                  &      + 1._wp / ( 2 * zxsiN * zetastar ) - 1._wp / vkarmn
-
-                  !! compute gammats
-                  pgt(ji,jj) = zustar(ji,jj) / (zgturb + zgmolet)
-                  pgs(ji,jj) = zustar(ji,jj) / (zgturb + zgmoles)
-               END IF
-            END DO
-         END DO
-         CALL lbc_lnk_multi( 'sbcisf', pgt, 'T', 1., pgs, 'T', 1.)
-      END SELECT
-      !
-   END SUBROUTINE sbc_isf_gammats
-
-
-   SUBROUTINE sbc_isf_tbl( pvarin, pvarout, cd_ptin )
-      !!----------------------------------------------------------------------
-      !!                  ***  SUBROUTINE sbc_isf_tbl  ***
-      !!
-      !! ** Purpose : compute mean T/S/U/V in the boundary layer at T- point
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) :: pvarin
-      REAL(wp), DIMENSION(:,:)  , INTENT(  out) :: pvarout
-      CHARACTER(len=1),           INTENT(in   ) :: cd_ptin ! point of variable in/out
-      !
-      INTEGER ::   ji, jj, jk                ! loop index
-      INTEGER ::   ikt, ikb                    ! top and bottom index of the tbl
-      REAL(wp) ::   ze3, zhk
-      REAL(wp), DIMENSION(jpi,jpj) :: zhisf_tbl ! thickness of the tbl
-      !!----------------------------------------------------------------------
-      
-      ! initialisation
-      pvarout(:,:)=0._wp
-   
-      SELECT CASE ( cd_ptin )
-      CASE ( 'U' ) ! compute U in the top boundary layer at T- point 
-         DO jj = 1,jpj
-            DO ji = 1,jpi
-               ikt = miku(ji,jj) ; ikb = miku(ji,jj)
-               ! thickness of boundary layer at least the top level thickness
-               zhisf_tbl(ji,jj) = MAX( rhisf_tbl_0(ji,jj) , e3u_n(ji,jj,ikt) )
-
-               ! determine the deepest level influenced by the boundary layer
-               DO jk = ikt+1, mbku(ji,jj)
-                  IF ( (SUM(e3u_n(ji,jj,ikt:jk-1)) < zhisf_tbl(ji,jj)) .AND. (umask(ji,jj,jk) == 1) ) ikb = jk
-               END DO
-               zhisf_tbl(ji,jj) = MIN(zhisf_tbl(ji,jj), SUM(e3u_n(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness.
-
-               ! level fully include in the ice shelf boundary layer
-               DO jk = ikt, ikb - 1
-                  ze3 = e3u_n(ji,jj,jk)
-                  pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,jk) / zhisf_tbl(ji,jj) * ze3
-               END DO
-
-               ! level partially include in ice shelf boundary layer 
-               zhk = SUM( e3u_n(ji, jj, ikt:ikb - 1)) / zhisf_tbl(ji,jj)
-               pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,ikb) * (1._wp - zhk)
-            END DO
-         END DO
-         DO jj = 2, jpj
-            DO ji = 2, jpi
-!!gm a wet-point only average should be used here !!!
-               pvarout(ji,jj) = 0.5_wp * (pvarout(ji,jj) + pvarout(ji-1,jj))
-            END DO
-         END DO
-         CALL lbc_lnk('sbcisf', pvarout,'T',-1.)
-      
-      CASE ( 'V' ) ! compute V in the top boundary layer at T- point 
-         DO jj = 1,jpj
-            DO ji = 1,jpi
-               ikt = mikv(ji,jj) ; ikb = mikv(ji,jj)
-               ! thickness of boundary layer at least the top level thickness
-               zhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), e3v_n(ji,jj,ikt))
-
-               ! determine the deepest level influenced by the boundary layer
-               DO jk = ikt+1, mbkv(ji,jj)
-                  IF ( (SUM(e3v_n(ji,jj,ikt:jk-1)) < zhisf_tbl(ji,jj)) .AND. (vmask(ji,jj,jk) == 1) ) ikb = jk
-               END DO
-               zhisf_tbl(ji,jj) = MIN(zhisf_tbl(ji,jj), SUM(e3v_n(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness.
-
-               ! level fully include in the ice shelf boundary layer
-               DO jk = ikt, ikb - 1
-                  ze3 = e3v_n(ji,jj,jk)
-                  pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,jk) / zhisf_tbl(ji,jj) * ze3
-               END DO
-
-               ! level partially include in ice shelf boundary layer 
-               zhk = SUM( e3v_n(ji, jj, ikt:ikb - 1)) / zhisf_tbl(ji,jj)
-               pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,ikb) * (1._wp - zhk)
-            END DO
-         END DO
-         DO jj = 2, jpj
-            DO ji = 2, jpi
-!!gm a wet-point only average should be used here !!!
-               pvarout(ji,jj) = 0.5_wp * (pvarout(ji,jj) + pvarout(ji,jj-1))
-            END DO
-         END DO
-         CALL lbc_lnk('sbcisf', pvarout,'T',-1.)
-
-      CASE ( 'T' ) ! compute T in the top boundary layer at T- point 
-         DO jj = 1,jpj
-            DO ji = 1,jpi
-               ikt = misfkt(ji,jj)
-               ikb = misfkb(ji,jj)
-
-               ! level fully include in the ice shelf boundary layer
-               DO jk = ikt, ikb - 1
-                  ze3 = e3t_n(ji,jj,jk)
-                  pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,jk) * r1_hisf_tbl(ji,jj) * ze3
-               END DO
-
-               ! level partially include in ice shelf boundary layer 
-               zhk = SUM( e3t_n(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj)
-               pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,ikb) * (1._wp - zhk)
-            END DO
-         END DO
-      END SELECT
-      !
-      ! mask mean tbl value
-      pvarout(:,:) = pvarout(:,:) * ssmask(:,:)
-      !
-   END SUBROUTINE sbc_isf_tbl
-      
-
-   SUBROUTINE sbc_isf_div( phdivn )
-      !!----------------------------------------------------------------------
-      !!                  ***  SUBROUTINE sbc_isf_div  ***
-      !!       
-      !! ** Purpose :   update the horizontal divergence with the runoff inflow
-      !!
-      !! ** Method  :   
-      !!                CAUTION : risf_tsc(:,:,jp_sal) is negative (outflow) increase the 
-      !!                          divergence and expressed in m/s
-      !!
-      !! ** Action  :   phdivn   decreased by the runoff inflow
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:,:), INTENT( inout ) ::   phdivn   ! horizontal divergence
-      ! 
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      INTEGER  ::   ikt, ikb 
-      REAL(wp) ::   zhk
-      REAL(wp) ::   zfact     ! local scalar
-      !!----------------------------------------------------------------------
-      !
-      zfact   = 0.5_wp
-      !
-      IF(.NOT.ln_linssh ) THEN     ! need to re compute level distribution of isf fresh water
-         DO jj = 1,jpj
-            DO ji = 1,jpi
-               ikt = misfkt(ji,jj)
-               ikb = misfkt(ji,jj)
-               ! thickness of boundary layer at least the top level thickness
-               rhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), e3t_n(ji,jj,ikt))
-
-               ! determine the deepest level influenced by the boundary layer
-               DO jk = ikt, mbkt(ji,jj)
-                  IF ( (SUM(e3t_n(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk
-               END DO
-               rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(e3t_n(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness.
-               misfkb(ji,jj) = ikb                                                  ! last wet level of the tbl
-               r1_hisf_tbl(ji,jj) = 1._wp / rhisf_tbl(ji,jj)
-
-               zhk           = SUM( e3t_n(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj)  ! proportion of tbl cover by cell from ikt to ikb - 1
-               ralpha(ji,jj) = rhisf_tbl(ji,jj) * (1._wp - zhk ) / e3t_n(ji,jj,ikb)  ! proportion of bottom cell influenced by boundary layer
-            END DO
-         END DO
-      END IF 
-      !
-      !==   ice shelf melting distributed over several levels   ==!
-      DO jj = 1,jpj
-         DO ji = 1,jpi
-               ikt = misfkt(ji,jj)
-               ikb = misfkb(ji,jj)
-               ! level fully include in the ice shelf boundary layer
-               DO jk = ikt, ikb - 1
-                  phdivn(ji,jj,jk) = phdivn(ji,jj,jk) + ( fwfisf(ji,jj) + fwfisf_b(ji,jj) ) &
-                    &              * r1_hisf_tbl(ji,jj) * r1_rau0 * zfact
-               END DO
-               ! level partially include in ice shelf boundary layer 
-               phdivn(ji,jj,ikb) = phdivn(ji,jj,ikb) + ( fwfisf(ji,jj) &
-                    &            + fwfisf_b(ji,jj) ) * r1_hisf_tbl(ji,jj) * r1_rau0 * zfact * ralpha(ji,jj) 
-         END DO
-      END DO
-      !
-   END SUBROUTINE sbc_isf_div
-
-   !!======================================================================
-END MODULE sbcisf
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcmod.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcmod.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcmod.F90	(revision 12928)
@@ -15,4 +15,5 @@
    !!            3.6  ! 2014-11  (P. Mathiot, C. Harris) add ice shelves melting
    !!            4.0  ! 2016-06  (L. Brodeau) new general bulk formulation
+   !!            4.0  ! 2019-03  (F. Lemarié & G. Samson)  add ABL compatibility (ln_abl=TRUE)
    !!----------------------------------------------------------------------
 
@@ -24,4 +25,5 @@
    USE oce            ! ocean dynamics and tracers
    USE dom_oce        ! ocean space and time domain
+   USE closea         ! closed seas
    USE phycst         ! physical constants
    USE sbc_oce        ! Surface boundary condition: ocean fields
@@ -32,4 +34,5 @@
    USE sbcflx         ! surface boundary condition: flux formulation
    USE sbcblk         ! surface boundary condition: bulk formulation
+   USE sbcabl         ! atmospheric boundary layer
    USE sbcice_if      ! surface boundary condition: ice-if sea-ice model
 #if defined key_si3
@@ -37,11 +40,10 @@
 #endif
    USE sbcice_cice    ! surface boundary condition: CICE sea-ice model
-   USE sbcisf         ! surface boundary condition: ice-shelf
    USE sbccpl         ! surface boundary condition: coupled formulation
    USE cpl_oasis3     ! OASIS routines for coupling
+   USE sbcclo         ! surface boundary condition: closed sea correction
    USE sbcssr         ! surface boundary condition: sea surface restoring
    USE sbcrnf         ! surface boundary condition: runoffs
    USE sbcapr         ! surface boundary condition: atmo pressure 
-   USE sbcisf         ! surface boundary condition: ice shelf
    USE sbcfwb         ! surface boundary condition: freshwater budget
    USE icbstp         ! Icebergs
@@ -59,5 +61,5 @@
    USE timing         ! Timing
    USE wet_dry
-   USE diurnal_bulk, ONLY:   ln_diurnal_only   ! diurnal SST diagnostic
+   USE diu_bulk, ONLY:   ln_diurnal_only   ! diurnal SST diagnostic
 
    IMPLICIT NONE
@@ -76,5 +78,5 @@
 CONTAINS
 
-   SUBROUTINE sbc_init
+   SUBROUTINE sbc_init( Kbb, Kmm, Kaa )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE sbc_init ***
@@ -88,14 +90,15 @@
       !!              - nsbc: type of sbc
       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   Kbb, Kmm, Kaa         ! ocean time level indices
       INTEGER ::   ios, icpt                         ! local integer
       LOGICAL ::   ll_purecpl, ll_opa, ll_not_nemo   ! local logical
       !!
       NAMELIST/namsbc/ nn_fsbc  ,                                                    &
-         &             ln_usr   , ln_flx   , ln_blk       ,                          &
+         &             ln_usr   , ln_flx   , ln_blk   , ln_abl,                      &
          &             ln_cpl   , ln_mixcpl, nn_components,                          &
          &             nn_ice   , ln_ice_embd,                                       &
          &             ln_traqsr, ln_dm2dc ,                                         &
-         &             ln_rnf   , nn_fwb   , ln_ssr   , ln_isf    , ln_apr_dyn ,     &
-         &             ln_wave  , ln_cdgw  , ln_sdw   , ln_tauwoc  , ln_stcor   ,     &
+         &             ln_rnf   , nn_fwb     , ln_ssr   , ln_apr_dyn,              &
+         &             ln_wave  , ln_cdgw  , ln_sdw   , ln_tauwoc  , ln_stcor  ,     &
          &             ln_tauw  , nn_lsm, nn_sdrift
       !!----------------------------------------------------------------------
@@ -108,8 +111,6 @@
       !
       !                       !**  read Surface Module namelist
-      REWIND( numnam_ref )          !* Namelist namsbc in reference namelist : Surface boundary
       READ  ( numnam_ref, namsbc, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc in reference namelist' )
-      REWIND( numnam_cfg )          !* Namelist namsbc in configuration namelist : Parameters of the run
       READ  ( numnam_cfg, namsbc, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc in configuration namelist' )
@@ -125,7 +126,8 @@
          IF( lk_cice )   nn_ice      = 3
       ENDIF
-#else
-      IF( lk_si3  )   nn_ice      = 2
-      IF( lk_cice )   nn_ice      = 3
+!!GS: TBD
+!#else
+!      IF( lk_si3  )   nn_ice      = 2
+!      IF( lk_cice )   nn_ice      = 3
 #endif
       !
@@ -137,4 +139,5 @@
          WRITE(numout,*) '         flux         formulation                   ln_flx        = ', ln_flx
          WRITE(numout,*) '         bulk         formulation                   ln_blk        = ', ln_blk
+         WRITE(numout,*) '         ABL          formulation                   ln_abl        = ', ln_abl
          WRITE(numout,*) '      Type of coupling (Ocean/Ice/Atmosphere) : '
          WRITE(numout,*) '         ocean-atmosphere coupled formulation       ln_cpl        = ', ln_cpl
@@ -153,5 +156,4 @@
          WRITE(numout,*) '         Patm gradient added in ocean & ice Eqs.    ln_apr_dyn    = ', ln_apr_dyn
          WRITE(numout,*) '         runoff / runoff mouths                     ln_rnf        = ', ln_rnf
-         WRITE(numout,*) '         iceshelf formulation                       ln_isf        = ', ln_isf
          WRITE(numout,*) '         nb of iterations if land-sea-mask applied  nn_lsm        = ', nn_lsm
          WRITE(numout,*) '         surface wave                               ln_wave       = ', ln_wave
@@ -185,7 +187,7 @@
       !
       IF( .NOT.ln_usr ) THEN     ! the model calendar needs some specificities (except in user defined case)
-         IF( MOD( rday , rdt ) /= 0. )   CALL ctl_stop( 'the time step must devide the number of second of in a day' )
+         IF( MOD( rday , rn_Dt ) /= 0. )   CALL ctl_stop( 'the time step must devide the number of second of in a day' )
          IF( MOD( rday , 2.  ) /= 0. )   CALL ctl_stop( 'the number of second of in a day must be an even number'    )
-         IF( MOD( rdt  , 2.  ) /= 0. )   CALL ctl_stop( 'the time step (in second) must be an even number'           )
+         IF( MOD( rn_Dt  , 2.  ) /= 0. )   CALL ctl_stop( 'the time step (in second) must be an even number'           )
       ENDIF
       !                       !**  check option consistency
@@ -225,9 +227,14 @@
       CASE( 1 )                        !- Ice-cover climatology ("Ice-if" model)  
       CASE( 2 )                        !- SI3  ice model
+         IF( .NOT.( ln_blk .OR. ln_cpl .OR. ln_abl .OR. ln_usr ) )   &
+            &                   CALL ctl_stop( 'sbc_init : SI3 sea-ice model requires ln_blk or ln_cpl or ln_abl or ln_usr = T' )
       CASE( 3 )                        !- CICE ice model
-         IF( .NOT.( ln_blk .OR. ln_cpl ) )   CALL ctl_stop( 'sbc_init : CICE sea-ice model requires ln_blk or ln_cpl = T' )
-         IF( lk_agrif                    )   CALL ctl_stop( 'sbc_init : CICE sea-ice model not currently available with AGRIF' ) 
+         IF( .NOT.( ln_blk .OR. ln_cpl .OR. ln_abl .OR. ln_usr ) )   &
+            &                   CALL ctl_stop( 'sbc_init : CICE sea-ice model requires ln_blk or ln_cpl or ln_abl or ln_usr = T' )
+         IF( lk_agrif                                )   &
+            &                   CALL ctl_stop( 'sbc_init : CICE sea-ice model not currently available with AGRIF' ) 
       CASE DEFAULT                     !- not supported
       END SELECT
+      IF( ln_diurnal .AND. .NOT. ln_blk  )   CALL ctl_stop( "sbc_init: diurnal flux processing only implemented for bulk forcing" )
       !
       !                       !**  allocate and set required variables
@@ -239,9 +246,12 @@
 #endif
       !
-      IF( .NOT.ln_isf ) THEN        !* No ice-shelf in the domain : allocate and set to zero
-         IF( sbc_isf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_isf arrays' )
-         fwfisf  (:,:)   = 0._wp   ;   risf_tsc  (:,:,:) = 0._wp
-         fwfisf_b(:,:)   = 0._wp   ;   risf_tsc_b(:,:,:) = 0._wp
-      END IF
+      !
+      IF( sbc_ssr_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_ssr arrays' )
+      IF( .NOT.ln_ssr ) THEN               !* Initialize qrp and erp if no restoring 
+         qrp(:,:) = 0._wp
+         erp(:,:) = 0._wp
+      ENDIF
+      !
+
       IF( nn_ice == 0 ) THEN        !* No sea-ice in the domain : ice fraction is always zero
          IF( nn_components /= jp_iam_opa )   fr_i(:,:) = 0._wp    ! except for OPA in SAS-OPA coupled case
@@ -254,8 +264,9 @@
 
       !                          ! Choice of the Surface Boudary Condition (set nsbc)
+      nday_qsr = -1   ! allow initialization at the 1st call !LB: now warm-layer of COARE* calls "sbc_dcy_param" of sbcdcy.F90!
       IF( ln_dm2dc ) THEN           !* daily mean to diurnal cycle
-         nday_qsr = -1   ! allow initialization at the 1st call
-         IF( .NOT.( ln_flx .OR. ln_blk ) .AND. nn_components /= jp_iam_opa )   &
-            &   CALL ctl_stop( 'qsr diurnal cycle from daily values requires a flux or bulk formulation' )
+         !LB:nday_qsr = -1   ! allow initialization at the 1st call
+         IF( .NOT.( ln_flx .OR. ln_blk .OR. ln_abl ) .AND. nn_components /= jp_iam_opa )   &
+            &   CALL ctl_stop( 'qsr diurnal cycle from daily values requires flux, bulk or abl formulation' )
       ENDIF
       !                             !* Choice of the Surface Boudary Condition
@@ -270,4 +281,5 @@
       IF( ln_flx          ) THEN   ;   nsbc = jp_flx     ; icpt = icpt + 1   ;   ENDIF       ! flux                 formulation
       IF( ln_blk          ) THEN   ;   nsbc = jp_blk     ; icpt = icpt + 1   ;   ENDIF       ! bulk                 formulation
+      IF( ln_abl          ) THEN   ;   nsbc = jp_abl     ; icpt = icpt + 1   ;   ENDIF       ! ABL                  formulation
       IF( ll_purecpl      ) THEN   ;   nsbc = jp_purecpl ; icpt = icpt + 1   ;   ENDIF       ! Pure Coupled         formulation
       IF( ll_opa          ) THEN   ;   nsbc = jp_none    ; icpt = icpt + 1   ;   ENDIF       ! opa coupling via SAS module
@@ -281,4 +293,5 @@
          CASE( jp_flx     )   ;   WRITE(numout,*) '   ==>>>   flux formulation'
          CASE( jp_blk     )   ;   WRITE(numout,*) '   ==>>>   bulk formulation'
+         CASE( jp_abl     )   ;   WRITE(numout,*) '   ==>>>   ABL  formulation'
          CASE( jp_purecpl )   ;   WRITE(numout,*) '   ==>>>   pure coupled formulation'
 !!gm abusive use of jp_none ??   ===>>> need to be check and changed by adding a jp_sas parameter
@@ -296,6 +309,6 @@
       !     SAS time-step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly
       IF( nn_components /= jp_iam_nemo ) THEN
-         IF( nn_components == jp_iam_opa )   nn_fsbc = cpl_freq('O_SFLX') / NINT(rdt)
-         IF( nn_components == jp_iam_sas )   nn_fsbc = cpl_freq('I_SFLX') / NINT(rdt)
+         IF( nn_components == jp_iam_opa )   nn_fsbc = cpl_freq('O_SFLX') / NINT(rn_Dt)
+         IF( nn_components == jp_iam_sas )   nn_fsbc = cpl_freq('I_SFLX') / NINT(rn_Dt)
          !
          IF(lwp)THEN
@@ -318,8 +331,8 @@
       ENDIF
       !
-      IF( MOD( rday, REAL(nn_fsbc, wp) * rdt ) /= 0 )   &
+      IF( MOD( rday, REAL(nn_fsbc, wp) * rn_Dt ) /= 0 )   &
          &  CALL ctl_warn( 'sbc_init : nn_fsbc is NOT a multiple of the number of time steps in a day' )
       !
-      IF( ln_dm2dc .AND. NINT(rday) / ( nn_fsbc * NINT(rdt) ) < 8  )   &
+      IF( ln_dm2dc .AND. NINT(rday) / ( nn_fsbc * NINT(rn_Dt) ) < 8  )   &
          &   CALL ctl_warn( 'sbc_init : diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' )
       !
@@ -327,15 +340,18 @@
       !                       !**  associated modules : initialization
       !
-                          CALL sbc_ssm_init            ! Sea-surface mean fields initialization
+                          CALL sbc_ssm_init ( Kbb, Kmm ) ! Sea-surface mean fields initialization
+      !
+      IF( l_sbc_clo   )   CALL sbc_clo_init              ! closed sea surface initialisation
       !
       IF( ln_blk      )   CALL sbc_blk_init            ! bulk formulae initialization
 
+      IF( ln_abl      )   CALL sbc_abl_init            ! Atmospheric Boundary Layer (ABL)
+
       IF( ln_ssr      )   CALL sbc_ssr_init            ! Sea-Surface Restoring initialization
       !
-      IF( ln_isf      )   CALL sbc_isf_init            ! Compute iceshelves
-      !
-                          CALL sbc_rnf_init            ! Runof initialization
-      !
-      IF( ln_apr_dyn )    CALL sbc_apr_init            ! Atmo Pressure Forcing initialization
+      !
+                          CALL sbc_rnf_init( Kmm )       ! Runof initialization
+      !
+      IF( ln_apr_dyn )    CALL sbc_apr_init              ! Atmo Pressure Forcing initialization
       !
 #if defined key_si3
@@ -343,10 +359,10 @@
                           IF( sbc_ice_alloc() /= 0 )   CALL ctl_stop('STOP', 'sbc_ice_alloc : unable to allocate arrays' )
       ELSEIF( nn_ice == 2 ) THEN
-                          CALL ice_init                ! ICE initialization
+                          CALL ice_init( Kbb, Kmm, Kaa )         ! ICE initialization
       ENDIF
 #endif
-      IF( nn_ice == 3 )   CALL cice_sbc_init( nsbc )   ! CICE initialization
-      !
-      IF( ln_wave     )   CALL sbc_wave_init           ! surface wave initialisation
+      IF( nn_ice == 3 )   CALL cice_sbc_init( nsbc, Kbb, Kmm )   ! CICE initialization
+      !
+      IF( ln_wave     )   CALL sbc_wave_init                     ! surface wave initialisation
       !
       IF( lwxios ) THEN
@@ -363,5 +379,5 @@
 
 
-   SUBROUTINE sbc( kt )
+   SUBROUTINE sbc( kt, Kbb, Kmm )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE sbc  ***
@@ -380,4 +396,5 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! ocean time step
+      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices
       !
       LOGICAL ::   ll_sas, ll_opa   ! local logical
@@ -398,12 +415,8 @@
          emp_b (:,:) = emp (:,:)
          sfx_b (:,:) = sfx (:,:)
-         IF ( ln_rnf ) THEN
+         IF( ln_rnf ) THEN
             rnf_b    (:,:  ) = rnf    (:,:  )
             rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)
          ENDIF
-         IF( ln_isf )  THEN
-            fwfisf_b  (:,:  ) = fwfisf  (:,:  )               
-            risf_tsc_b(:,:,:) = risf_tsc(:,:,:)              
-         ENDIF
         !
       ENDIF
@@ -415,6 +428,6 @@
       ll_opa = nn_components == jp_iam_opa
       !
-      IF( .NOT.ll_sas )   CALL sbc_ssm ( kt )            ! mean ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m)
-      IF( ln_wave     )   CALL sbc_wave( kt )            ! surface waves
+      IF( .NOT.ll_sas )   CALL sbc_ssm ( kt, Kbb, Kmm )  ! mean ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m)
+      IF( ln_wave     )   CALL sbc_wave( kt, Kmm )       ! surface waves
 
       !
@@ -423,25 +436,29 @@
       SELECT CASE( nsbc )                                ! Compute ocean surface boundary condition
       !                                                  ! (i.e. utau,vtau, qns, qsr, emp, sfx)
-      CASE( jp_usr   )     ;   CALL usrdef_sbc_oce( kt )                    ! user defined formulation 
-      CASE( jp_flx     )   ;   CALL sbc_flx       ( kt )                    ! flux formulation
+      CASE( jp_usr   )     ;   CALL usrdef_sbc_oce( kt, Kbb )                        ! user defined formulation 
+      CASE( jp_flx     )   ;   CALL sbc_flx       ( kt )                             ! flux formulation
       CASE( jp_blk     )
-         IF( ll_sas    )       CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: SAS receiving fields from OPA
+         IF( ll_sas    )       CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )   ! OPA-SAS coupling: SAS receiving fields from OPA
                                CALL sbc_blk       ( kt )                    ! bulk formulation for the ocean
                                !
-      CASE( jp_purecpl )   ;   CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice )   ! pure coupled formulation
+      CASE( jp_abl     )
+         IF( ll_sas    )       CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )   ! OPA-SAS coupling: SAS receiving fields from OPA
+                               CALL sbc_abl       ( kt )                    ! ABL  formulation for the ocean
+                               !
+      CASE( jp_purecpl )   ;   CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )   ! pure coupled formulation
       CASE( jp_none    )
-         IF( ll_opa    )       CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: OPA receiving fields from SAS
+         IF( ll_opa    )       CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )  ! OPA-SAS coupling: OPA receiving fields from SAS
       END SELECT
       !
-      IF( ln_mixcpl )          CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice )   ! forced-coupled mixed formulation after forcing
-      !
-      IF ( ln_wave .AND. (ln_tauwoc .OR. ln_tauw) ) CALL sbc_wstress( )      ! Wind stress provided by waves 
+      IF( ln_mixcpl )          CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )  ! forced-coupled mixed formulation after forcing
+      !
+      IF ( ln_wave .AND. (ln_tauwoc .OR. ln_tauw) ) CALL sbc_wstress( )              ! Wind stress provided by waves 
       !
       !                                            !==  Misc. Options  ==!
       !
       SELECT CASE( nn_ice )                                       ! Update heat and freshwater fluxes over sea-ice areas
-      CASE(  1 )   ;         CALL sbc_ice_if   ( kt )             ! Ice-cover climatology ("Ice-if" model)
+      CASE(  1 )   ;         CALL sbc_ice_if   ( kt, Kbb, Kmm )   ! Ice-cover climatology ("Ice-if" model)
 #if defined key_si3
-      CASE(  2 )   ;         CALL ice_stp  ( kt, nsbc )           ! SI3 ice model
+      CASE(  2 )   ;         CALL ice_stp  ( kt, Kbb, Kmm, nsbc ) ! SI3 ice model
 #endif
       CASE(  3 )   ;         CALL sbc_ice_cice ( kt, nsbc )       ! CICE ice model
@@ -450,27 +467,27 @@
       IF( ln_icebergs    )   THEN
                                      CALL icb_stp( kt )           ! compute icebergs
-         ! icebergs may advect into haloes during the icb step and alter emp.
-         ! A lbc_lnk is necessary here to ensure restartability (#2113)
+         ! Icebergs do not melt over the haloes. 
+         ! So emp values over the haloes are no more consistent with the inner domain values. 
+         ! A lbc_lnk is therefore needed to ensure reproducibility and restartability.
+         ! see ticket #2113 for discussion about this lbc_lnk.
          IF( .NOT. ln_passive_mode ) CALL lbc_lnk( 'sbcmod', emp, 'T', 1. ) ! ensure restartability with icebergs
       ENDIF
 
-      IF( ln_isf         )   CALL sbc_isf( kt )                   ! compute iceshelves
-
       IF( ln_rnf         )   CALL sbc_rnf( kt )                   ! add runoffs to fresh water fluxes
 
-      IF( ln_ssr         )   CALL sbc_ssr( kt )                   ! add SST/SSS damping term
-
-      IF( nn_fwb    /= 0 )   CALL sbc_fwb( kt, nn_fwb, nn_fsbc )  ! control the freshwater budget
+      IF( ln_ssr         )   CALL sbc_ssr( kt )                        ! add SST/SSS damping term
+
+      IF( nn_fwb    /= 0 )   CALL sbc_fwb( kt, nn_fwb, nn_fsbc, Kmm )  ! control the freshwater budget
 
       ! Special treatment of freshwater fluxes over closed seas in the model domain
       ! Should not be run if ln_diurnal_only
-      IF( l_sbc_clo .AND. (.NOT. ln_diurnal_only) )   CALL sbc_clo( kt )   
+      IF( l_sbc_clo      )   CALL sbc_clo( kt )   
 
 !!$!RBbug do not understand why see ticket 667
 !!$!clem: it looks like it is necessary for the north fold (in certain circumstances). Don't know why.
 !!$      CALL lbc_lnk( 'sbcmod', emp, 'T', 1. )
-      IF ( ll_wd ) THEN     ! If near WAD point limit the flux for now
+      IF( ll_wd ) THEN     ! If near WAD point limit the flux for now
          zthscl = atanh(rn_wd_sbcfra)                     ! taper frac default is .999 
-         zwdht(:,:) = sshn(:,:) + ht_0(:,:) - rn_wdmin1   ! do this calc of water
+         zwdht(:,:) = ssh(:,:,Kmm) + ht_0(:,:) - rn_wdmin1   ! do this calc of water
                                                      ! depth above wd limit once
          WHERE( zwdht(:,:) <= 0.0 )
@@ -502,5 +519,5 @@
             CALL iom_get( numror, jpdom_autoglo, 'utau_b', utau_b, ldxios = lrxios )   ! before i-stress  (U-point)
             CALL iom_get( numror, jpdom_autoglo, 'vtau_b', vtau_b, ldxios = lrxios )   ! before j-stress  (V-point)
-            CALL iom_get( numror, jpdom_autoglo, 'qns_b' , qns_b, ldxios = lrxios  )   ! before non solar heat flux (T-point)
+            CALL iom_get( numror, jpdom_autoglo,  'qns_b',  qns_b, ldxios = lrxios )   ! before non solar heat flux (T-point)
             ! The 3D heat content due to qsr forcing is treated in traqsr
             ! CALL iom_get( numror, jpdom_autoglo, 'qsr_b' , qsr_b, ldxios = lrxios  ) ! before     solar heat flux (T-point)
@@ -552,4 +569,6 @@
          CALL iom_put( "taum"  , taum       )                   ! wind stress module
          CALL iom_put( "wspd"  , wndm       )                   ! wind speed  module over free ocean or leads in presence of sea-ice
+         CALL iom_put( "qrp", qrp )                             ! heat flux damping
+         CALL iom_put( "erp", erp )                             ! freshwater flux damping
       ENDIF
       !
@@ -557,15 +576,15 @@
       CALL iom_put( "vtau", vtau )   ! j-wind stress
       !
-      IF(ln_ctl) THEN         ! print mean trends (used for debugging)
-         CALL prt_ctl(tab2d_1=fr_i              , clinfo1=' fr_i    - : ', mask1=tmask )
-         CALL prt_ctl(tab2d_1=(emp-rnf + fwfisf), clinfo1=' emp-rnf - : ', mask1=tmask )
-         CALL prt_ctl(tab2d_1=(sfx-rnf + fwfisf), clinfo1=' sfx-rnf - : ', mask1=tmask )
+      IF(sn_cfctl%l_prtctl) THEN     ! print mean trends (used for debugging)
+         CALL prt_ctl(tab2d_1=fr_i             , clinfo1=' fr_i     - : ', mask1=tmask )
+         CALL prt_ctl(tab2d_1=(emp-rnf)        , clinfo1=' emp-rnf  - : ', mask1=tmask )
+         CALL prt_ctl(tab2d_1=(sfx-rnf)        , clinfo1=' sfx-rnf  - : ', mask1=tmask )
          CALL prt_ctl(tab2d_1=qns              , clinfo1=' qns      - : ', mask1=tmask )
          CALL prt_ctl(tab2d_1=qsr              , clinfo1=' qsr      - : ', mask1=tmask )
          CALL prt_ctl(tab3d_1=tmask            , clinfo1=' tmask    - : ', mask1=tmask, kdim=jpk )
-         CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' sst      - : ', mask1=tmask, kdim=1   )
-         CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_sal), clinfo1=' sss      - : ', mask1=tmask, kdim=1   )
-         CALL prt_ctl(tab2d_1=utau             , clinfo1=' utau     - : ', mask1=umask,                      &
-            &         tab2d_2=vtau             , clinfo2=' vtau     - : ', mask2=vmask )
+         CALL prt_ctl(tab3d_1=ts(:,:,:,jp_tem,Kmm), clinfo1=' sst      - : ', mask1=tmask, kdim=1   )
+         CALL prt_ctl(tab3d_1=ts(:,:,:,jp_sal,Kmm), clinfo1=' sss      - : ', mask1=tmask, kdim=1   )
+         CALL prt_ctl(tab2d_1=utau                , clinfo1=' utau     - : ', mask1=umask,                      &
+            &         tab2d_2=vtau                , clinfo2=' vtau     - : ', mask2=vmask )
       ENDIF
 
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcrnf.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcrnf.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcrnf.F90	(revision 12928)
@@ -19,7 +19,6 @@
    USE phycst         ! physical constants
    USE sbc_oce        ! surface boundary condition variables
-   USE sbcisf         ! PM we could remove it I think
    USE eosbn2         ! Equation Of State
-   USE closea         ! closed seas
+   USE closea, ONLY: l_clo_rnf, clo_rnf ! closed seas
    !
    USE in_out_manager ! I/O manager
@@ -43,8 +42,10 @@
    REAL(wp)                   ::      rn_dep_max        !: depth over which runoffs is spread       (ln_rnf_depth_ini =T)
    INTEGER                    ::      nn_rnf_depth_file !: create (=1) a runoff depth file or not (=0)
+   LOGICAL                    ::   ln_rnf_icb        !: iceberg flux is specified in a file
    LOGICAL                    ::   ln_rnf_tem        !: temperature river runoffs attribute specified in a file
    LOGICAL           , PUBLIC ::   ln_rnf_sal        !: salinity    river runoffs attribute specified in a file
    TYPE(FLD_N)       , PUBLIC ::   sn_rnf            !: information about the runoff file to be read
    TYPE(FLD_N)                ::   sn_cnf            !: information about the runoff mouth file to be read
+   TYPE(FLD_N)                ::   sn_i_rnf        !: information about the iceberg flux file to be read
    TYPE(FLD_N)                ::   sn_s_rnf          !: information about the salinities of runoff file to be read
    TYPE(FLD_N)                ::   sn_t_rnf          !: information about the temperatures of runoff file to be read
@@ -65,7 +66,10 @@
 
    TYPE(FLD),        ALLOCATABLE, DIMENSION(:) ::   sf_rnf       ! structure: river runoff (file information, fields read)
+   TYPE(FLD),        ALLOCATABLE, DIMENSION(:) ::   sf_i_rnf     ! structure: iceberg flux (file information, fields read)
    TYPE(FLD),        ALLOCATABLE, DIMENSION(:) ::   sf_s_rnf     ! structure: river runoff salinity (file information, fields read)  
    TYPE(FLD),        ALLOCATABLE, DIMENSION(:) ::   sf_t_rnf     ! structure: river runoff temperature (file information, fields read)  
  
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -112,5 +116,9 @@
       !                                            !-------------------!
       !
-      IF( .NOT. l_rnfcpl )   CALL fld_read ( kt, nn_fsbc, sf_rnf   )    ! Read Runoffs data and provide it at kt
+      !
+      IF( .NOT. l_rnfcpl )  THEN
+                            CALL fld_read ( kt, nn_fsbc, sf_rnf   )    ! Read Runoffs data and provide it at kt ( runoffs + iceberg )
+         IF( ln_rnf_icb )   CALL fld_read ( kt, nn_fsbc, sf_i_rnf )    ! idem for iceberg flux if required
+      ENDIF
       IF(   ln_rnf_tem   )   CALL fld_read ( kt, nn_fsbc, sf_t_rnf )    ! idem for runoffs temperature if required
       IF(   ln_rnf_sal   )   CALL fld_read ( kt, nn_fsbc, sf_s_rnf )    ! idem for runoffs salinity    if required
@@ -118,25 +126,29 @@
       IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN
          !
-         IF( .NOT. l_rnfcpl )   rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) ) * tmask(:,:,1)       ! updated runoff value at time step kt
+         IF( .NOT. l_rnfcpl ) THEN
+             rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) ) * tmask(:,:,1)  ! updated runoff value at time step kt
+             IF( ln_rnf_icb ) THEN
+                fwficb(:,:) = rn_rfact * ( sf_i_rnf(1)%fnow(:,:,1) ) * tmask(:,:,1)  ! updated runoff value at time step kt
+                CALL iom_put( 'iceberg_cea'  , fwficb(:,:)  )         ! output iceberg flux
+                CALL iom_put( 'hflx_icb_cea' , fwficb(:,:) * rLfus )   ! output Heat Flux into Sea Water due to Iceberg Thermodynamics -->
+             ENDIF
+         ENDIF
          !
          !                                                           ! set temperature & salinity content of runoffs
          IF( ln_rnf_tem ) THEN                                       ! use runoffs temperature data
-            rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0
+            rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rho0
             CALL eos_fzp( sss_m(:,:), ztfrz(:,:) )
             WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999._wp )             ! if missing data value use SST as runoffs temperature
-               rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0
-            END WHERE
-            WHERE( sf_t_rnf(1)%fnow(:,:,1) == -222._wp )             ! where fwf comes from melting of ice shelves or iceberg
-               rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rau0 - rnf(:,:) * rLfusisf * r1_rau0_rcp
+               rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rho0
             END WHERE
          ELSE                                                        ! use SST as runoffs temperature
             !CEOD River is fresh water so must at least be 0 unless we consider ice
-            rnf_tsc(:,:,jp_tem) = MAX(sst_m(:,:),0.0_wp) * rnf(:,:) * r1_rau0
+            rnf_tsc(:,:,jp_tem) = MAX( sst_m(:,:), 0.0_wp ) * rnf(:,:) * r1_rho0
          ENDIF
          !                                                           ! use runoffs salinity data
-         IF( ln_rnf_sal )   rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0
+         IF( ln_rnf_sal )   rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rho0
          !                                                           ! else use S=0 for runoffs (done one for all in the init)
-         IF( iom_use('runoffs') )        CALL iom_put( 'runoffs'     , rnf(:,:)                         )   ! output runoff mass flux
-         IF( iom_use('hflx_rnf_cea') )   CALL iom_put( 'hflx_rnf_cea', rnf_tsc(:,:,jp_tem) * rau0 * rcp )   ! output runoff sensible heat (W/m2)
+                                         CALL iom_put( 'runoffs'     , rnf(:,:)                         )   ! output runoff mass flux
+         IF( iom_use('hflx_rnf_cea') )   CALL iom_put( 'hflx_rnf_cea', rnf_tsc(:,:,jp_tem) * rho0 * rcp )   ! output runoff sensible heat (W/m2)
       ENDIF
       !
@@ -173,5 +185,5 @@
 
 
-   SUBROUTINE sbc_rnf_div( phdivn )
+   SUBROUTINE sbc_rnf_div( phdivn, Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE sbc_rnf  ***
@@ -185,4 +197,5 @@
       !! ** Action  :   phdivn   decreased by the runoff inflow
       !!----------------------------------------------------------------------
+      INTEGER                   , INTENT(in   ) ::   Kmm      ! ocean time level index
       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   phdivn   ! horizontal divergence
       !!
@@ -195,28 +208,24 @@
       IF( ln_rnf_depth .OR. ln_rnf_depth_ini ) THEN      !==   runoff distributed over several levels   ==!
          IF( ln_linssh ) THEN    !* constant volume case : just apply the runoff input flow
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  DO jk = 1, nk_rnf(ji,jj)
-                     phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / h_rnf(ji,jj)
-                  END DO
+            DO_2D_11_11
+               DO jk = 1, nk_rnf(ji,jj)
+                  phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rho0 / h_rnf(ji,jj)
                END DO
-            END DO
+            END_2D
          ELSE                    !* variable volume case
-            DO jj = 1, jpj                   ! update the depth over which runoffs are distributed
-               DO ji = 1, jpi
-                  h_rnf(ji,jj) = 0._wp
-                  DO jk = 1, nk_rnf(ji,jj)                           ! recalculates h_rnf to be the depth in metres
-                     h_rnf(ji,jj) = h_rnf(ji,jj) + e3t_n(ji,jj,jk)   ! to the bottom of the relevant grid box
-                  END DO
-                  !                          ! apply the runoff input flow
-                  DO jk = 1, nk_rnf(ji,jj)
-                     phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / h_rnf(ji,jj)
-                  END DO
+            DO_2D_11_11
+               h_rnf(ji,jj) = 0._wp
+               DO jk = 1, nk_rnf(ji,jj)                           ! recalculates h_rnf to be the depth in metres
+                  h_rnf(ji,jj) = h_rnf(ji,jj) + e3t(ji,jj,jk,Kmm)   ! to the bottom of the relevant grid box
                END DO
-            END DO
+               !                          ! apply the runoff input flow
+               DO jk = 1, nk_rnf(ji,jj)
+                  phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rho0 / h_rnf(ji,jj)
+               END DO
+            END_2D
          ENDIF
       ELSE                       !==   runoff put only at the surface   ==!
-         h_rnf (:,:)   = e3t_n (:,:,1)        ! update h_rnf to be depth of top box
-         phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rau0 / e3t_n(:,:,1)
+         h_rnf (:,:)   = e3t (:,:,1,Kmm)        ! update h_rnf to be depth of top box
+         phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rho0 / e3t(:,:,1,Kmm)
       ENDIF
       !
@@ -224,5 +233,5 @@
 
 
-   SUBROUTINE sbc_rnf_init
+   SUBROUTINE sbc_rnf_init( Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE sbc_rnf_init  ***
@@ -234,4 +243,5 @@
       !! ** Action  : - read parameters
       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: Kmm           ! ocean time level index
       CHARACTER(len=32) ::   rn_dep_file   ! runoff file name
       INTEGER           ::   ji, jj, jk, jm    ! dummy loop indices
@@ -242,6 +252,6 @@
       REAL(wp), DIMENSION(jpi,jpj,2) :: zrnfcl    
       !!
-      NAMELIST/namsbc_rnf/ cn_dir            , ln_rnf_depth, ln_rnf_tem, ln_rnf_sal,   &
-         &                 sn_rnf, sn_cnf    , sn_s_rnf    , sn_t_rnf  , sn_dep_rnf,   &
+      NAMELIST/namsbc_rnf/ cn_dir            , ln_rnf_depth, ln_rnf_tem, ln_rnf_sal, ln_rnf_icb,   &
+         &                 sn_rnf, sn_cnf    , sn_i_rnf, sn_s_rnf    , sn_t_rnf  , sn_dep_rnf,   &
          &                 ln_rnf_mouth      , rn_hrnf     , rn_avt_rnf, rn_rfact,     &
          &                 ln_rnf_depth_ini  , rn_dep_max  , rn_rnf_max, nn_rnf_depth_file
@@ -265,9 +275,7 @@
       !                                   ! ============
       !
-      REWIND( numnam_ref )              ! Namelist namsbc_rnf in reference namelist : Runoffs 
       READ  ( numnam_ref, namsbc_rnf, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_rnf in reference namelist' )
 
-      REWIND( numnam_cfg )              ! Namelist namsbc_rnf in configuration namelist : Runoffs
       READ  ( numnam_cfg, namsbc_rnf, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_rnf in configuration namelist' )
@@ -299,4 +307,19 @@
          IF( sn_rnf%ln_tint ) ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) )
          CALL fld_fill( sf_rnf, (/ sn_rnf /), cn_dir, 'sbc_rnf_init', 'read runoffs data', 'namsbc_rnf', no_print )
+         !
+         IF( ln_rnf_icb ) THEN                      ! Create (if required) sf_i_rnf structure
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '          iceberg flux read in a file'
+            ALLOCATE( sf_i_rnf(1), STAT=ierror  )
+            IF( ierror > 0 ) THEN
+               CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_i_rnf structure' )   ;   RETURN
+            ENDIF
+            ALLOCATE( sf_i_rnf(1)%fnow(jpi,jpj,1)   )
+            IF( sn_i_rnf%ln_tint ) ALLOCATE( sf_i_rnf(1)%fdta(jpi,jpj,1,2) )
+            CALL fld_fill (sf_i_rnf, (/ sn_i_rnf /), cn_dir, 'sbc_rnf_init', 'read iceberg flux data', 'namsbc_rnf' )
+         ELSE
+            fwficb(:,:) = 0._wp
+         ENDIF
+
       ENDIF
       !
@@ -337,27 +360,23 @@
          !
          nk_rnf(:,:) = 0                               ! set the number of level over which river runoffs are applied
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( h_rnf(ji,jj) > 0._wp ) THEN
-                  jk = 2
-                  DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1
-                  END DO
-                  nk_rnf(ji,jj) = jk
-               ELSEIF( h_rnf(ji,jj) == -1._wp   ) THEN   ;  nk_rnf(ji,jj) = 1
-               ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN   ;  nk_rnf(ji,jj) = mbkt(ji,jj)
-               ELSE
-                  CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999'  )
-                  WRITE(999,*) 'ji, jj, h_rnf(ji,jj) :', ji, jj, h_rnf(ji,jj)
-               ENDIF
+         DO_2D_11_11
+            IF( h_rnf(ji,jj) > 0._wp ) THEN
+               jk = 2
+               DO WHILE ( jk < mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1
+               END DO
+               nk_rnf(ji,jj) = jk
+            ELSEIF( h_rnf(ji,jj) == -1._wp   ) THEN   ;  nk_rnf(ji,jj) = 1
+            ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN   ;  nk_rnf(ji,jj) = mbkt(ji,jj)
+            ELSE
+               CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999'  )
+               WRITE(999,*) 'ji, jj, h_rnf(ji,jj) :', ji, jj, h_rnf(ji,jj)
+            ENDIF
+         END_2D
+         DO_2D_11_11
+            h_rnf(ji,jj) = 0._wp
+            DO jk = 1, nk_rnf(ji,jj)
+               h_rnf(ji,jj) = h_rnf(ji,jj) + e3t(ji,jj,jk,Kmm)
             END DO
-         END DO
-         DO jj = 1, jpj                                ! set the associated depth
-            DO ji = 1, jpi
-               h_rnf(ji,jj) = 0._wp
-               DO jk = 1, nk_rnf(ji,jj)
-                  h_rnf(ji,jj) = h_rnf(ji,jj) + e3t_n(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         END_2D
          !
       ELSE IF( ln_rnf_depth_ini ) THEN           ! runoffs applied at the surface
@@ -384,35 +403,29 @@
          WHERE( zrnfcl(:,:,1) > 0._wp )  h_rnf(:,:) = zacoef * zrnfcl(:,:,1)   ! compute depth for all runoffs
          !
-         DO jj = 1, jpj                     ! take in account min depth of ocean rn_hmin
-            DO ji = 1, jpi
-               IF( zrnfcl(ji,jj,1) > 0._wp ) THEN
-                  jk = mbkt(ji,jj)
-                  h_rnf(ji,jj) = MIN( h_rnf(ji,jj), gdept_0(ji,jj,jk ) )
-               ENDIF
+         DO_2D_11_11
+            IF( zrnfcl(ji,jj,1) > 0._wp ) THEN
+               jk = mbkt(ji,jj)
+               h_rnf(ji,jj) = MIN( h_rnf(ji,jj), gdept_0(ji,jj,jk ) )
+            ENDIF
+         END_2D
+         !
+         nk_rnf(:,:) = 0                       ! number of levels on which runoffs are distributed
+         DO_2D_11_11
+            IF( zrnfcl(ji,jj,1) > 0._wp ) THEN
+               jk = 2
+               DO WHILE ( jk < mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1
+               END DO
+               nk_rnf(ji,jj) = jk
+            ELSE
+               nk_rnf(ji,jj) = 1
+            ENDIF
+         END_2D
+         !
+         DO_2D_11_11
+            h_rnf(ji,jj) = 0._wp
+            DO jk = 1, nk_rnf(ji,jj)
+               h_rnf(ji,jj) = h_rnf(ji,jj) + e3t(ji,jj,jk,Kmm)
             END DO
-         END DO
-         !
-         nk_rnf(:,:) = 0                       ! number of levels on which runoffs are distributed
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( zrnfcl(ji,jj,1) > 0._wp ) THEN
-                  jk = 2
-                  DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1
-                  END DO
-                  nk_rnf(ji,jj) = jk
-               ELSE
-                  nk_rnf(ji,jj) = 1
-               ENDIF
-            END DO
-         END DO
-         !
-         DO jj = 1, jpj                                ! set the associated depth
-            DO ji = 1, jpi
-               h_rnf(ji,jj) = 0._wp
-               DO jk = 1, nk_rnf(ji,jj)
-                  h_rnf(ji,jj) = h_rnf(ji,jj) + e3t_n(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         END_2D
          !
          IF( nn_rnf_depth_file == 1 ) THEN      !  save  output nb levels for runoff
@@ -424,5 +437,5 @@
       ELSE                                       ! runoffs applied at the surface
          nk_rnf(:,:) = 1
-         h_rnf (:,:) = e3t_n(:,:,1)
+         h_rnf (:,:) = e3t(:,:,1,Kmm)
       ENDIF
       !
@@ -439,5 +452,5 @@
          !                                      !    - mixed upstream-centered (ln_traadv_cen2=T)
          !
-         IF ( ln_rnf_depth )   CALL ctl_warn( 'sbc_rnf_init: increased mixing turned on but effects may already',   &
+         IF( ln_rnf_depth )   CALL ctl_warn( 'sbc_rnf_init: increased mixing turned on but effects may already',   &
             &                                              'be spread through depth by ln_rnf_depth'               )
          !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcssm.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcssm.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcssm.F90	(revision 12928)
@@ -39,5 +39,5 @@
 CONTAINS
 
-   SUBROUTINE sbc_ssm( kt )
+   SUBROUTINE sbc_ssm( kt, Kbb, Kmm )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE sbc_oce  ***
@@ -53,4 +53,5 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! ocean time step
+      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices
       !
       INTEGER  ::   ji, jj               ! loop index
@@ -60,25 +61,21 @@
       !
       !                                        !* surface T-, U-, V- ocean level variables (T, S, depth, velocity)
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zts(ji,jj,jp_tem) = tsn(ji,jj,mikt(ji,jj),jp_tem)
-            zts(ji,jj,jp_sal) = tsn(ji,jj,mikt(ji,jj),jp_sal)
-         END DO
-      END DO
+      zts(:,:,jp_tem) = ts(:,:,1,jp_tem,Kmm)
+      zts(:,:,jp_sal) = ts(:,:,1,jp_sal,Kmm)
       !
       IF( nn_fsbc == 1 ) THEN                             !   Instantaneous surface fields        !
          !                                                ! ---------------------------------------- !
-         ssu_m(:,:) = ub(:,:,1)
-         ssv_m(:,:) = vb(:,:,1)
+         ssu_m(:,:) = uu(:,:,1,Kbb)
+         ssv_m(:,:) = vv(:,:,1,Kbb)
          IF( l_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) )
-         ELSE                    ;   sst_m(:,:) = zts(:,:,jp_tem)
+         ELSE                   ;   sst_m(:,:) = zts(:,:,jp_tem)
          ENDIF
          sss_m(:,:) = zts(:,:,jp_sal)
          !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics)
-         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
-         ELSE                    ;   ssh_m(:,:) = sshn(:,:)
-         ENDIF
-         !
-         e3t_m(:,:) = e3t_n(:,:,1)
+         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh(:,:,Kmm) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
+         ELSE                    ;   ssh_m(:,:) = ssh(:,:,Kmm)
+         ENDIF
+         !
+         e3t_m(:,:) = e3t(:,:,1,Kmm)
          !
          frq_m(:,:) = fraqsr_1lev(:,:)
@@ -92,6 +89,6 @@
             IF(lwp) WRITE(numout,*) '~~~~~~~   '
             zcoef = REAL( nn_fsbc - 1, wp )
-            ssu_m(:,:) = zcoef * ub(:,:,1)
-            ssv_m(:,:) = zcoef * vb(:,:,1)
+            ssu_m(:,:) = zcoef * uu(:,:,1,Kbb)
+            ssv_m(:,:) = zcoef * vv(:,:,1,Kbb)
             IF( l_useCT )  THEN    ;   sst_m(:,:) = zcoef * eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) )
             ELSE                    ;   sst_m(:,:) = zcoef * zts(:,:,jp_tem)
@@ -99,9 +96,9 @@
             sss_m(:,:) = zcoef * zts(:,:,jp_sal)
             !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics)
-            IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) )
-            ELSE                    ;   ssh_m(:,:) = zcoef * sshn(:,:)
-            ENDIF
-            !
-            e3t_m(:,:) = zcoef * e3t_n(:,:,1)
+            IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = zcoef * ( ssh(:,:,Kmm) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) )
+            ELSE                    ;   ssh_m(:,:) = zcoef *   ssh(:,:,Kmm)
+            ENDIF
+            !
+            e3t_m(:,:) = zcoef * e3t(:,:,1,Kmm)
             !
             frq_m(:,:) = zcoef * fraqsr_1lev(:,:)
@@ -120,6 +117,6 @@
          !                                                !        Cumulate at each time step        !
          !                                                ! ---------------------------------------- !
-         ssu_m(:,:) = ssu_m(:,:) + ub(:,:,1)
-         ssv_m(:,:) = ssv_m(:,:) + vb(:,:,1)
+         ssu_m(:,:) = ssu_m(:,:) + uu(:,:,1,Kbb)
+         ssv_m(:,:) = ssv_m(:,:) + vv(:,:,1,Kbb)
          IF( l_useCT )  THEN     ;   sst_m(:,:) = sst_m(:,:) + eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) )
          ELSE                    ;   sst_m(:,:) = sst_m(:,:) + zts(:,:,jp_tem)
@@ -127,9 +124,9 @@
          sss_m(:,:) = sss_m(:,:) + zts(:,:,jp_sal)
          !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics)
-         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
-         ELSE                    ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:)
-         ENDIF
-         !
-         e3t_m(:,:) = e3t_m(:,:) + e3t_n(:,:,1)
+         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh_m(:,:) + ssh(:,:,Kmm) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
+         ELSE                    ;   ssh_m(:,:) = ssh_m(:,:) + ssh(:,:,Kmm)
+         ENDIF
+         !
+         e3t_m(:,:) = e3t_m(:,:) + e3t(:,:,1,Kmm)
          !
          frq_m(:,:) = frq_m(:,:) + fraqsr_1lev(:,:)
@@ -184,5 +181,5 @@
 
 
-   SUBROUTINE sbc_ssm_init
+   SUBROUTINE sbc_ssm_init( Kbb, Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE sbc_ssm_init  ***
@@ -192,4 +189,5 @@
       !! ** Action  : - read parameters
       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices
       REAL(wp) ::   zcoef, zf_sbc   ! local scalar
       !!----------------------------------------------------------------------
@@ -242,12 +240,12 @@
          !
          IF(lwp) WRITE(numout,*) '   default initialisation of ss._m arrays'
-         ssu_m(:,:) = ub(:,:,1)
-         ssv_m(:,:) = vb(:,:,1)
-         IF( l_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) )
-         ELSE                   ;   sst_m(:,:) = tsn(:,:,1,jp_tem)
-         ENDIF
-         sss_m(:,:) = tsn  (:,:,1,jp_sal)
-         ssh_m(:,:) = sshn (:,:)
-         e3t_m(:,:) = e3t_n(:,:,1)
+         ssu_m(:,:) = uu(:,:,1,Kbb)
+         ssv_m(:,:) = vv(:,:,1,Kbb)
+         IF( l_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( ts(:,:,1,jp_tem,Kmm), ts(:,:,1,jp_sal,Kmm) )
+         ELSE                   ;   sst_m(:,:) = ts(:,:,1,jp_tem,Kmm)
+         ENDIF
+         sss_m(:,:) = ts  (:,:,1,jp_sal,Kmm)
+         ssh_m(:,:) = ssh(:,:,Kmm)
+         e3t_m(:,:) = e3t (:,:,1,Kmm)
          frq_m(:,:) = 1._wp
          !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcssr.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcssr.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcssr.F90	(revision 12928)
@@ -30,7 +30,9 @@
    PUBLIC   sbc_ssr        ! routine called in sbcmod
    PUBLIC   sbc_ssr_init   ! routine called in sbcmod
+   PUBLIC   sbc_ssr_alloc  ! routine called in sbcmod
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   erp   !: evaporation damping   [kg/m2/s]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qrp   !: heat flux damping        [w/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   coefice   !: under ice relaxation coefficient
 
    !                                   !!* Namelist namsbc_ssr *
@@ -41,4 +43,5 @@
    LOGICAL         ::   ln_sssr_bnd     ! flag to bound erp term 
    REAL(wp)        ::   rn_sssr_bnd     ! ABS(Max./Min.) value of erp term [mm/day]
+   INTEGER         ::   nn_sssr_ice     ! Control of restoring under ice
 
    REAL(wp) , ALLOCATABLE, DIMENSION(:) ::   buffer   ! Temporary buffer for exchange
@@ -46,4 +49,6 @@
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sss   ! structure of input SSS (file informations, fields read)
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -90,41 +95,45 @@
             !
             IF( nn_sstr == 1 ) THEN                                   !* Temperature restoring term
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) * tmask(ji,jj,1)
-                     qns(ji,jj) = qns(ji,jj) + zqrp
-                     qrp(ji,jj) = zqrp
-                  END DO
-               END DO
-               CALL iom_put( "qrp", qrp )                             ! heat flux damping
+               DO_2D_11_11
+                  zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) * tmask(ji,jj,1)
+                  qns(ji,jj) = qns(ji,jj) + zqrp
+                  qrp(ji,jj) = zqrp
+               END_2D
+            ENDIF
+            !
+            IF( nn_sssr /= 0 .AND. nn_sssr_ice /= 1 ) THEN
+              ! use fraction of ice ( fr_i ) to adjust relaxation under ice if nn_sssr_ice .ne. 1
+              ! n.b. coefice is initialised and fixed to 1._wp if nn_sssr_ice = 1
+               DO_2D_11_11
+                  SELECT CASE ( nn_sssr_ice )
+                    CASE ( 0 )    ;  coefice(ji,jj) = 1._wp - fr_i(ji,jj)              ! no/reduced damping under ice
+                    CASE  DEFAULT ;  coefice(ji,jj) = 1._wp + ( nn_sssr_ice - 1 ) * fr_i(ji,jj) ! reinforced damping (x nn_sssr_ice) under ice )
+                  END SELECT
+               END_2D
             ENDIF
             !
             IF( nn_sssr == 1 ) THEN                                   !* Salinity damping term (salt flux only (sfx))
                zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s]
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths
-                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) * tmask(ji,jj,1)
-                     sfx(ji,jj) = sfx(ji,jj) + zerp                 ! salt flux
-                     erp(ji,jj) = zerp / MAX( sss_m(ji,jj), 1.e-20 ) ! converted into an equivalent volume flux (diagnostic only)
-                  END DO
-               END DO
-               CALL iom_put( "erp", erp )                             ! freshwater flux damping
+               DO_2D_11_11
+                  zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths
+                     &        *   coefice(ji,jj)            &      ! Optional control of damping under sea-ice
+                     &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) * tmask(ji,jj,1)
+                  sfx(ji,jj) = sfx(ji,jj) + zerp                 ! salt flux
+                  erp(ji,jj) = zerp / MAX( sss_m(ji,jj), 1.e-20 ) ! converted into an equivalent volume flux (diagnostic only)
+               END_2D
                !
             ELSEIF( nn_sssr == 2 ) THEN                               !* Salinity damping term (volume flux (emp) and associated heat flux (qns)
                zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s]
                zerp_bnd = rn_sssr_bnd / rday                          !       -              -    
-               DO jj = 1, jpj
-                  DO ji = 1, jpi                            
-                     zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths
-                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )   &
-                        &        / MAX(  sss_m(ji,jj), 1.e-20   ) * tmask(ji,jj,1)
-                     IF( ln_sssr_bnd )   zerp = SIGN( 1., zerp ) * MIN( zerp_bnd, ABS(zerp) )
-                     emp(ji,jj) = emp (ji,jj) + zerp
-                     qns(ji,jj) = qns(ji,jj) - zerp * rcp * sst_m(ji,jj)
-                     erp(ji,jj) = zerp
-                  END DO
-               END DO
-               CALL iom_put( "erp", erp )                             ! freshwater flux damping
+               DO_2D_11_11
+                  zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths
+                     &        *   coefice(ji,jj)            &      ! Optional control of damping under sea-ice
+                     &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )   &
+                     &        / MAX(  sss_m(ji,jj), 1.e-20   ) * tmask(ji,jj,1)
+                  IF( ln_sssr_bnd )   zerp = SIGN( 1., zerp ) * MIN( zerp_bnd, ABS(zerp) )
+                  emp(ji,jj) = emp (ji,jj) + zerp
+                  qns(ji,jj) = qns(ji,jj) - zerp * rcp * sst_m(ji,jj)
+                  erp(ji,jj) = zerp
+               END_2D
             ENDIF
             !
@@ -154,5 +163,6 @@
       CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files
       TYPE(FLD_N) ::   sn_sst, sn_sss        ! informations about the fields to be read
-      NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd
+      NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, &
+              & sn_sss, ln_sssr_bnd, rn_sssr_bnd, nn_sssr_ice
       INTEGER     ::  ios
       !!----------------------------------------------------------------------
@@ -164,9 +174,7 @@
       ENDIF
       ! 
-      REWIND( numnam_ref )              ! Namelist namsbc_ssr in reference namelist : 
       READ  ( numnam_ref, namsbc_ssr, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_ssr in reference namelist' )
 
-      REWIND( numnam_cfg )              ! Namelist namsbc_ssr in configuration namelist :
       READ  ( numnam_cfg, namsbc_ssr, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_ssr in configuration namelist' )
@@ -182,9 +190,9 @@
          WRITE(numout,*) '         flag to bound erp term                 ln_sssr_bnd = ', ln_sssr_bnd
          WRITE(numout,*) '         ABS(Max./Min.) erp threshold           rn_sssr_bnd = ', rn_sssr_bnd, ' mm/day'
-      ENDIF
-      !
-      !                            !* Allocate erp and qrp array
-      ALLOCATE( qrp(jpi,jpj), erp(jpi,jpj), STAT=ierror )
-      IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate erp and qrp array' )
+         WRITE(numout,*) '      Cntrl of surface restoration under ice nn_sssr_ice    = ', nn_sssr_ice
+         WRITE(numout,*) '          ( 0 = no restoration under ice)'
+         WRITE(numout,*) '          ( 1 = restoration everywhere  )'
+         WRITE(numout,*) '          (>1 = enhanced restoration under ice  )'
+      ENDIF
       !
       IF( nn_sstr == 1 ) THEN      !* set sf_sst structure & allocate arrays
@@ -216,4 +224,5 @@
       ENDIF
       !
+      coefice(:,:) = 1._wp         !  Initialise coefice to 1._wp ; will not need to be changed if nn_sssr_ice=1
       !                            !* Initialize qrp and erp if no restoring 
       IF( nn_sstr /= 1                   )   qrp(:,:) = 0._wp
@@ -221,4 +230,18 @@
       !
    END SUBROUTINE sbc_ssr_init
+         
+   INTEGER FUNCTION sbc_ssr_alloc()
+      !!----------------------------------------------------------------------
+      !!               ***  FUNCTION sbc_ssr_alloc  ***
+      !!----------------------------------------------------------------------
+      sbc_ssr_alloc = 0       ! set to zero if no array to be allocated
+      IF( .NOT. ALLOCATED( erp ) ) THEN
+         ALLOCATE( qrp(jpi,jpj), erp(jpi,jpj), coefice(jpi,jpj), STAT= sbc_ssr_alloc )
+         !
+         IF( lk_mpp                  )   CALL mpp_sum ( 'sbcssr', sbc_ssr_alloc )
+         IF( sbc_ssr_alloc /= 0 )   CALL ctl_warn('sbc_ssr_alloc: failed to allocate arrays.')
+         !
+      ENDIF
+   END FUNCTION
       
    !!======================================================================
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbctide.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbctide.F90	(revision 12384)
+++ 	(revision )
@@ -1,168 +1,0 @@
-MODULE sbctide
-   !!======================================================================
-   !!                       ***  MODULE  sbctide  ***
-   !! Initialization of tidal forcing
-   !!======================================================================
-   !! History :  9.0  !  2007  (O. Le Galloudec)  Original code
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and tracers variables
-   USE dom_oce        ! ocean space and time domain
-   USE phycst         ! physical constant
-   USE daymod         ! calandar
-   USE tideini        ! 
-   !
-   USE in_out_manager ! I/O units
-   USE iom            ! xIOs server
-   USE ioipsl         ! NetCDF IPSL library
-   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
-
-   IMPLICIT NONE
-   PUBLIC
-
-   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::   pot_astro   !
-
-   !!----------------------------------------------------------------------
-   !!   tidal potential
-   !!----------------------------------------------------------------------
-   !!   sbc_tide            : 
-   !!   tide_init_potential :
-   !!----------------------------------------------------------------------
-
-   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   amp_pot, phi_pot
-   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   amp_load, phi_load
- 
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id$
-   !! Software governed by the CeCILL license (see ./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE sbc_tide( kt )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE sbc_tide  ***
-      !!----------------------------------------------------------------------      
-      INTEGER, INTENT( in ) ::   kt     ! ocean time-step
-      INTEGER               ::   jk     ! dummy loop index
-      INTEGER               ::   nsec_day_orig     ! Temporary variable
-      !!----------------------------------------------------------------------
-      
-      IF( nsec_day == NINT(0.5_wp * rdt) .OR. kt == nit000 ) THEN      ! start a new day
-         !
-         IF( kt == nit000 )THEN
-            ALLOCATE( amp_pot(jpi,jpj,nb_harmo),                      &
-               &      phi_pot(jpi,jpj,nb_harmo), pot_astro(jpi,jpj)   )
-            IF( ln_read_load )THEN
-               ALLOCATE( amp_load(jpi,jpj,nb_harmo), phi_load(jpi,jpj,nb_harmo) )
-               CALL tide_init_load
-            ENDIF
-         ENDIF
-         !
-         IF( ln_read_load )THEN
-            amp_pot(:,:,:) = amp_load(:,:,:)
-            phi_pot(:,:,:) = phi_load(:,:,:)
-         ELSE 
-            amp_pot(:,:,:) = 0._wp
-            phi_pot(:,:,:) = 0._wp
-         ENDIF
-         pot_astro(:,:) = 0._wp
-         !
-         ! If the run does not start from midnight then need to initialise tides
-         ! at the start of the current day (only occurs when kt==nit000)
-         ! Temporarily set nsec_day to beginning of day.
-         nsec_day_orig = nsec_day
-         IF ( nsec_day /= NINT(0.5_wp * rdt) ) THEN 
-            kt_tide = kt - (nsec_day - 0.5_wp * rdt)/rdt
-            nsec_day = NINT(0.5_wp * rdt)
-         ELSE
-            kt_tide = kt 
-         ENDIF
-         CALL tide_harmo( omega_tide, v0tide, utide, ftide, ntide, nb_harmo )
-         !
-         !
-         IF(lwp) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) 'sbc_tide : Update of the components and (re)Init. the potential at kt=', kt
-            WRITE(numout,*) '~~~~~~~~ '
-            DO jk = 1, nb_harmo
-               WRITE(numout,*) Wave(ntide(jk))%cname_tide, utide(jk), ftide(jk), v0tide(jk), omega_tide(jk)
-            END DO
-         ENDIF
-         !
-         IF( ln_tide_pot )   CALL tide_init_potential
-         !
-         ! Reset nsec_day
-         nsec_day = nsec_day_orig 
-      ENDIF
-      !
-   END SUBROUTINE sbc_tide
-
-
-   SUBROUTINE tide_init_potential
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE tide_init_potential  ***
-      !!----------------------------------------------------------------------
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   zcons, ztmp1, ztmp2, zlat, zlon, ztmp, zamp, zcs   ! local scalar
-      !!----------------------------------------------------------------------
-
-      DO jk = 1, nb_harmo
-         zcons = 0.7_wp * Wave(ntide(jk))%equitide * ftide(jk)
-         DO ji = 1, jpi
-            DO jj = 1, jpj
-               ztmp1 =  ftide(jk) * amp_pot(ji,jj,jk) * COS( phi_pot(ji,jj,jk) + v0tide(jk) + utide(jk) )
-               ztmp2 = -ftide(jk) * amp_pot(ji,jj,jk) * SIN( phi_pot(ji,jj,jk) + v0tide(jk) + utide(jk) )
-               zlat = gphit(ji,jj)*rad !! latitude en radian
-               zlon = glamt(ji,jj)*rad !! longitude en radian
-               ztmp = v0tide(jk) + utide(jk) + Wave(ntide(jk))%nutide * zlon
-               ! le potentiel est composé des effets des astres:
-               IF    ( Wave(ntide(jk))%nutide == 1 )  THEN  ;  zcs = zcons * SIN( 2._wp*zlat )
-               ELSEIF( Wave(ntide(jk))%nutide == 2 )  THEN  ;  zcs = zcons * COS( zlat )**2
-               ELSE                                         ;  zcs = 0._wp
-               ENDIF
-               ztmp1 = ztmp1 + zcs * COS( ztmp )
-               ztmp2 = ztmp2 - zcs * SIN( ztmp )
-               zamp = SQRT( ztmp1*ztmp1 + ztmp2*ztmp2 )
-               amp_pot(ji,jj,jk) = zamp
-               phi_pot(ji,jj,jk) = ATAN2( -ztmp2 / MAX( 1.e-10_wp , zamp ) ,   &
-                  &                        ztmp1 / MAX( 1.e-10_wp,  zamp )   )
-            END DO
-         END DO
-      END DO
-      !
-   END SUBROUTINE tide_init_potential
-
-   SUBROUTINE tide_init_load
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE tide_init_load  ***
-      !!----------------------------------------------------------------------
-      INTEGER :: inum                 ! Logical unit of input file
-      INTEGER :: ji, jj, itide        ! dummy loop indices
-      REAL(wp), DIMENSION(jpi,jpj) ::   ztr, zti   !: workspace to read in tidal harmonics data 
-      !!----------------------------------------------------------------------
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'tide_init_load : Initialization of load potential from file'
-         WRITE(numout,*) '~~~~~~~~~~~~~~ '
-      ENDIF
-      !
-      CALL iom_open ( cn_tide_load , inum )
-      !
-      DO itide = 1, nb_harmo
-         CALL iom_get  ( inum, jpdom_data,TRIM(Wave(ntide(itide))%cname_tide)//'_z1', ztr(:,:) )
-         CALL iom_get  ( inum, jpdom_data,TRIM(Wave(ntide(itide))%cname_tide)//'_z2', zti(:,:) )
-         !
-         DO ji=1,jpi
-            DO jj=1,jpj
-               amp_load(ji,jj,itide) =  SQRT( ztr(ji,jj)**2. + zti(ji,jj)**2. )
-               phi_load(ji,jj,itide) = ATAN2(-zti(ji,jj), ztr(ji,jj) )
-            END DO
-         END DO
-         !
-      END DO
-      CALL iom_close( inum )
-      !
-   END SUBROUTINE tide_init_load
-
-  !!======================================================================
-END MODULE sbctide
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcwave.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcwave.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcwave.F90	(revision 12928)
@@ -72,5 +72,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -80,5 +80,5 @@
 CONTAINS
 
-   SUBROUTINE sbc_stokes( )
+   SUBROUTINE sbc_stokes( Kmm )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE sbc_stokes  ***
@@ -92,4 +92,5 @@
       !! ** action  
       !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) :: Kmm ! ocean time level index
       INTEGER  ::   jj, ji, jk   ! dummy loop argument
       INTEGER  ::   ik           ! local integer 
@@ -111,105 +112,87 @@
       IF( ll_st_bv_li ) THEN   ! (Eq. (19) in Breivik et al. (2014) )
          zfac = 2.0_wp * rpi / 16.0_wp
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ! Stokes drift velocity estimated from Hs and Tmean
-               ztransp = zfac * hsw(ji,jj)*hsw(ji,jj) / MAX( wmp(ji,jj), 0.0000001_wp )
-               ! Stokes surface speed
-               tsd2d(ji,jj) = SQRT( ut0sd(ji,jj)*ut0sd(ji,jj) + vt0sd(ji,jj)*vt0sd(ji,jj))
-               ! Wavenumber scale
-               zk_t(ji,jj) = ABS( tsd2d(ji,jj) ) / MAX( ABS( 5.97_wp*ztransp ), 0.0000001_wp )
-            END DO
-         END DO
-         DO jj = 1, jpjm1              ! exp. wave number & Stokes drift velocity at u- & v-points
-            DO ji = 1, jpim1
-               zk_u(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji+1,jj) )
-               zk_v(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji,jj+1) )
-               !
-               zu0_sd(ji,jj) = 0.5_wp * ( ut0sd(ji,jj) + ut0sd(ji+1,jj) )
-               zv0_sd(ji,jj) = 0.5_wp * ( vt0sd(ji,jj) + vt0sd(ji,jj+1) )
-            END DO
-         END DO
+         DO_2D_11_11
+            ! Stokes drift velocity estimated from Hs and Tmean
+            ztransp = zfac * hsw(ji,jj)*hsw(ji,jj) / MAX( wmp(ji,jj), 0.0000001_wp )
+            ! Stokes surface speed
+            tsd2d(ji,jj) = SQRT( ut0sd(ji,jj)*ut0sd(ji,jj) + vt0sd(ji,jj)*vt0sd(ji,jj))
+            ! Wavenumber scale
+            zk_t(ji,jj) = ABS( tsd2d(ji,jj) ) / MAX( ABS( 5.97_wp*ztransp ), 0.0000001_wp )
+         END_2D
+         DO_2D_10_10
+            zk_u(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji+1,jj) )
+            zk_v(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji,jj+1) )
+            !
+            zu0_sd(ji,jj) = 0.5_wp * ( ut0sd(ji,jj) + ut0sd(ji+1,jj) )
+            zv0_sd(ji,jj) = 0.5_wp * ( vt0sd(ji,jj) + vt0sd(ji,jj+1) )
+         END_2D
       ELSE IF( ll_st_peakfr ) THEN    ! peak wave number calculated from the peak frequency received by the wave model
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zk_t(ji,jj) = ( 2.0_wp * rpi * wfreq(ji,jj) ) * ( 2.0_wp * rpi * wfreq(ji,jj) ) / grav
-            END DO
-         END DO
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               zk_u(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji+1,jj) )
-               zk_v(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji,jj+1) )
-               !
-               zu0_sd(ji,jj) = 0.5_wp * ( ut0sd(ji,jj) + ut0sd(ji+1,jj) )
-               zv0_sd(ji,jj) = 0.5_wp * ( vt0sd(ji,jj) + vt0sd(ji,jj+1) )
-            END DO
-         END DO
+         DO_2D_11_11
+            zk_t(ji,jj) = ( 2.0_wp * rpi * wfreq(ji,jj) ) * ( 2.0_wp * rpi * wfreq(ji,jj) ) / grav
+         END_2D
+         DO_2D_10_10
+            zk_u(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji+1,jj) )
+            zk_v(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji,jj+1) )
+            !
+            zu0_sd(ji,jj) = 0.5_wp * ( ut0sd(ji,jj) + ut0sd(ji+1,jj) )
+            zv0_sd(ji,jj) = 0.5_wp * ( vt0sd(ji,jj) + vt0sd(ji,jj+1) )
+         END_2D
       ENDIF
       !
       !                       !==  horizontal Stokes Drift 3D velocity  ==!
       IF( ll_st_bv2014 ) THEN
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  zdep_u = 0.5_wp * ( gdept_n(ji,jj,jk) + gdept_n(ji+1,jj,jk) )
-                  zdep_v = 0.5_wp * ( gdept_n(ji,jj,jk) + gdept_n(ji,jj+1,jk) )
-                  !                          
-                  zkh_u = zk_u(ji,jj) * zdep_u     ! k * depth
-                  zkh_v = zk_v(ji,jj) * zdep_v
-                  !                                ! Depth attenuation
-                  zda_u = EXP( -2.0_wp*zkh_u ) / ( 1.0_wp + 8.0_wp*zkh_u )
-                  zda_v = EXP( -2.0_wp*zkh_v ) / ( 1.0_wp + 8.0_wp*zkh_v )
-                  !
-                  usd(ji,jj,jk) = zda_u * zu0_sd(ji,jj) * umask(ji,jj,jk)
-                  vsd(ji,jj,jk) = zda_v * zv0_sd(ji,jj) * vmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            zdep_u = 0.5_wp * ( gdept(ji,jj,jk,Kmm) + gdept(ji+1,jj,jk,Kmm) )
+            zdep_v = 0.5_wp * ( gdept(ji,jj,jk,Kmm) + gdept(ji,jj+1,jk,Kmm) )
+            !                          
+            zkh_u = zk_u(ji,jj) * zdep_u     ! k * depth
+            zkh_v = zk_v(ji,jj) * zdep_v
+            !                                ! Depth attenuation
+            zda_u = EXP( -2.0_wp*zkh_u ) / ( 1.0_wp + 8.0_wp*zkh_u )
+            zda_v = EXP( -2.0_wp*zkh_v ) / ( 1.0_wp + 8.0_wp*zkh_v )
+            !
+            usd(ji,jj,jk) = zda_u * zu0_sd(ji,jj) * umask(ji,jj,jk)
+            vsd(ji,jj,jk) = zda_v * zv0_sd(ji,jj) * vmask(ji,jj,jk)
+         END_3D
       ELSE IF( ll_st_li2017 .OR. ll_st_peakfr ) THEN
          ALLOCATE( zstokes_psi_u_top(jpi,jpj), zstokes_psi_v_top(jpi,jpj) )
-         DO jj = 1, jpjm1              ! exp. wave number & Stokes drift velocity at u- & v-points
-            DO ji = 1, jpim1
-               zstokes_psi_u_top(ji,jj) = 0._wp
-               zstokes_psi_v_top(ji,jj) = 0._wp
-            END DO
-         END DO
+         DO_2D_10_10
+            zstokes_psi_u_top(ji,jj) = 0._wp
+            zstokes_psi_v_top(ji,jj) = 0._wp
+         END_2D
          zsqrtpi = SQRT(rpi)
          z_two_thirds = 2.0_wp / 3.0_wp
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  zbot_u = ( gdepw_n(ji,jj,jk+1) + gdepw_n(ji+1,jj,jk+1) )  ! 2 * bottom depth
-                  zbot_v = ( gdepw_n(ji,jj,jk+1) + gdepw_n(ji,jj+1,jk+1) )  ! 2 * bottom depth
-                  zkb_u  = zk_u(ji,jj) * zbot_u                             ! 2 * k * bottom depth
-                  zkb_v  = zk_v(ji,jj) * zbot_v                             ! 2 * k * bottom depth
-                  !
-                  zke3_u = MAX(1.e-8_wp, 2.0_wp * zk_u(ji,jj) * e3u_n(ji,jj,jk))     ! 2k * thickness
-                  zke3_v = MAX(1.e-8_wp, 2.0_wp * zk_v(ji,jj) * e3v_n(ji,jj,jk))     ! 2k * thickness
-
-                  ! Depth attenuation .... do u component first..
-                  zdepth      = zkb_u
-                  zsqrt_depth = SQRT(zdepth)
-                  zexp_depth  = EXP(-zdepth)
-                  zstokes_psi_u_bot = 1.0_wp - zexp_depth  &
-                       &              - z_two_thirds * ( zsqrtpi*zsqrt_depth*zdepth*ERFC(zsqrt_depth) &
-                       &              + 1.0_wp - (1.0_wp + zdepth)*zexp_depth )
-                  zda_u                    = ( zstokes_psi_u_bot - zstokes_psi_u_top(ji,jj) ) / zke3_u
-                  zstokes_psi_u_top(ji,jj) =   zstokes_psi_u_bot
-
-                  !         ... and then v component
-                  zdepth      =zkb_v
-                  zsqrt_depth = SQRT(zdepth)
-                  zexp_depth  = EXP(-zdepth)
-                  zstokes_psi_v_bot = 1.0_wp - zexp_depth  &
-                       &              - z_two_thirds * ( zsqrtpi*zsqrt_depth*zdepth*ERFC(zsqrt_depth) &
-                       &              + 1.0_wp - (1.0_wp + zdepth)*zexp_depth )
-                  zda_v                    = ( zstokes_psi_v_bot - zstokes_psi_v_top(ji,jj) ) / zke3_v
-                  zstokes_psi_v_top(ji,jj) =   zstokes_psi_v_bot
-                  !
-                  usd(ji,jj,jk) = zda_u * zu0_sd(ji,jj) * umask(ji,jj,jk)
-                  vsd(ji,jj,jk) = zda_v * zv0_sd(ji,jj) * vmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            zbot_u = ( gdepw(ji,jj,jk+1,Kmm) + gdepw(ji+1,jj,jk+1,Kmm) )  ! 2 * bottom depth
+            zbot_v = ( gdepw(ji,jj,jk+1,Kmm) + gdepw(ji,jj+1,jk+1,Kmm) )  ! 2 * bottom depth
+            zkb_u  = zk_u(ji,jj) * zbot_u                             ! 2 * k * bottom depth
+            zkb_v  = zk_v(ji,jj) * zbot_v                             ! 2 * k * bottom depth
+            !
+            zke3_u = MAX(1.e-8_wp, 2.0_wp * zk_u(ji,jj) * e3u(ji,jj,jk,Kmm))     ! 2k * thickness
+            zke3_v = MAX(1.e-8_wp, 2.0_wp * zk_v(ji,jj) * e3v(ji,jj,jk,Kmm))     ! 2k * thickness
+
+            ! Depth attenuation .... do u component first..
+            zdepth      = zkb_u
+            zsqrt_depth = SQRT(zdepth)
+            zexp_depth  = EXP(-zdepth)
+            zstokes_psi_u_bot = 1.0_wp - zexp_depth  &
+                 &              - z_two_thirds * ( zsqrtpi*zsqrt_depth*zdepth*ERFC(zsqrt_depth) &
+                 &              + 1.0_wp - (1.0_wp + zdepth)*zexp_depth )
+            zda_u                    = ( zstokes_psi_u_bot - zstokes_psi_u_top(ji,jj) ) / zke3_u
+            zstokes_psi_u_top(ji,jj) =   zstokes_psi_u_bot
+
+            !         ... and then v component
+            zdepth      =zkb_v
+            zsqrt_depth = SQRT(zdepth)
+            zexp_depth  = EXP(-zdepth)
+            zstokes_psi_v_bot = 1.0_wp - zexp_depth  &
+                 &              - z_two_thirds * ( zsqrtpi*zsqrt_depth*zdepth*ERFC(zsqrt_depth) &
+                 &              + 1.0_wp - (1.0_wp + zdepth)*zexp_depth )
+            zda_v                    = ( zstokes_psi_v_bot - zstokes_psi_v_top(ji,jj) ) / zke3_v
+            zstokes_psi_v_top(ji,jj) =   zstokes_psi_v_bot
+            !
+            usd(ji,jj,jk) = zda_u * zu0_sd(ji,jj) * umask(ji,jj,jk)
+            vsd(ji,jj,jk) = zda_v * zv0_sd(ji,jj) * vmask(ji,jj,jk)
+         END_3D
          DEALLOCATE( zstokes_psi_u_top, zstokes_psi_v_top )
       ENDIF
@@ -220,14 +203,10 @@
       !                       !==  vertical Stokes Drift 3D velocity  ==!
       !
-      DO jk = 1, jpkm1               ! Horizontal e3*divergence
-         DO jj = 2, jpj
-            DO ji = fs_2, jpi
-               ze3divh(ji,jj,jk) = (  e2u(ji  ,jj) * e3u_n(ji  ,jj,jk) * usd(ji  ,jj,jk)    &
-                  &                 - e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) * usd(ji-1,jj,jk)    &
-                  &                 + e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) * vsd(ji,jj  ,jk)    &
-                  &                 - e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * vsd(ji,jj-1,jk)  ) * r1_e1e2t(ji,jj)
-            END DO
-         END DO
-      END DO
+      DO_3D_01_01( 1, jpkm1 )
+         ze3divh(ji,jj,jk) = (  e2u(ji  ,jj) * e3u(ji  ,jj,jk,Kmm) * usd(ji  ,jj,jk)    &
+            &                 - e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * usd(ji-1,jj,jk)    &
+            &                 + e1v(ji,jj  ) * e3v(ji,jj  ,jk,Kmm) * vsd(ji,jj  ,jk)    &
+            &                 - e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) * vsd(ji,jj-1,jk)  ) * r1_e1e2t(ji,jj)
+      END_3D
       !
 #if defined key_agrif
@@ -291,14 +270,12 @@
       !
       IF( ln_tauw ) THEN
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               ! Stress components at u- & v-points
-               utau(ji,jj) = 0.5_wp * ( tauw_x(ji,jj) + tauw_x(ji+1,jj) )
-               vtau(ji,jj) = 0.5_wp * ( tauw_y(ji,jj) + tauw_y(ji,jj+1) )
-               !
-               ! Stress module at t points
-               taum(ji,jj) = SQRT( tauw_x(ji,jj)*tauw_x(ji,jj) + tauw_y(ji,jj)*tauw_y(ji,jj) )
-            END DO
-         END DO
+         DO_2D_10_10
+            ! Stress components at u- & v-points
+            utau(ji,jj) = 0.5_wp * ( tauw_x(ji,jj) + tauw_x(ji+1,jj) )
+            vtau(ji,jj) = 0.5_wp * ( tauw_y(ji,jj) + tauw_y(ji,jj+1) )
+            !
+            ! Stress module at t points
+            taum(ji,jj) = SQRT( tauw_x(ji,jj)*tauw_x(ji,jj) + tauw_y(ji,jj)*tauw_y(ji,jj) )
+         END_2D
          CALL lbc_lnk_multi( 'sbcwave', utau(:,:), 'U', -1. , vtau(:,:), 'V', -1. , taum(:,:) , 'T', -1. )
       ENDIF
@@ -307,5 +284,5 @@
 
 
-   SUBROUTINE sbc_wave( kt )
+   SUBROUTINE sbc_wave( kt, Kmm )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE sbc_wave  ***
@@ -322,4 +299,5 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in   ) ::   kt   ! ocean time step
+      INTEGER, INTENT(in   ) ::   Kmm  ! ocean time index
       !!---------------------------------------------------------------------
       !
@@ -361,5 +339,5 @@
          !
          IF( ( ll_st_bv_li   .AND. jp_hsw>0 .AND. jp_wmp>0 .AND. jp_usd>0 .AND. jp_vsd>0 ) .OR. &
-           & ( ll_st_peakfr  .AND. jp_wfr>0 .AND. jp_usd>0 .AND. jp_vsd>0                ) ) CALL sbc_stokes()
+           & ( ll_st_peakfr  .AND. jp_wfr>0 .AND. jp_usd>0 .AND. jp_vsd>0                ) ) CALL sbc_stokes( Kmm )
          !
       ENDIF
@@ -395,9 +373,7 @@
       !!---------------------------------------------------------------------
       !
-      REWIND( numnam_ref )              ! Namelist namsbc_wave in reference namelist : File for drag coeff. from wave model
       READ  ( numnam_ref, namsbc_wave, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_wave in reference namelist' )
          
-      REWIND( numnam_cfg )              ! Namelist namsbc_wave in configuration namelist : File for drag coeff. from wave model
       READ  ( numnam_cfg, namsbc_wave, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_wave in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/tide.h90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/tide.h90	(revision 12384)
+++ 	(revision )
@@ -1,29 +1,0 @@
-   !!----------------------------------------------------------------------
-   !! History :  3.2  !  2007  (O. Le Galloudec)  Original code
-   !!----------------------------------------------------------------------
-
-   !             !! name_tide , equitide , nutide , nt , ns , nh , np , np1 , shift , nksi , nnu0 , nnu1 , nnu2 , R , formula !!
-   !             !!           !          !        !    !    !    !    !     !       !      !      !      !      !   !         !!
-   Wave( 1) = tide(  'M2'     , 0.242297 ,    2   ,  2 , -2 ,  2 ,  0 ,  0  ,    0  ,  2   , -2   ,  0   ,  0   , 0 ,    78   )
-   Wave( 2) = tide(  'N2'     , 0.046313 ,    2   ,  2 , -3 ,  2 ,  1 ,  0  ,    0  ,  2   , -2   ,  0   ,  0   , 0 ,    78   )
-   Wave( 3) = tide( '2N2'     , 0.006184 ,    2   ,  2 , -4 ,  2 ,  2 ,  0  ,    0  ,  2   , -2   ,  0   ,  0   , 0 ,    78   )
-   Wave( 4) = tide(  'S2'     , 0.113572 ,    2   ,  2 ,  0 ,  0 ,  0 ,  0  ,    0  ,  0   ,  0   ,  0   ,  0   , 0 ,     0   )
-   Wave( 5) = tide(  'K2'     , 0.030875 ,    2   ,  2 ,  0 ,  2 ,  0 ,  0  ,    0  ,  0   ,  0   ,  0   , -2   , 0 ,   235   )
-   !              !           !          !        !    !    !    !    !     !       !      !      !      !      !   !         !
-   Wave( 6) = tide(  'K1'     , 0.142408 ,    1   ,  1 ,  0 ,  1 ,  0 ,  0  ,  -90  ,  0   ,  0   , -1   ,  0   , 0 ,   227   )
-   Wave( 7) = tide(  'O1'     , 0.101266 ,    1   ,  1 , -2 ,  1 ,  0 ,  0  ,  +90  ,  2   , -1   ,  0   ,  0   , 0 ,    75   )
-   Wave( 8) = tide(  'Q1'     , 0.019387 ,    1   ,  1 , -3 ,  1 ,  1 ,  0  ,  +90  ,  2   , -1   ,  0   ,  0   , 0 ,    75   )
-   Wave( 9) = tide(  'P1'     , 0.047129 ,    1   ,  1 ,  0 , -1 ,  0 ,  0  ,  +90  ,  0   ,  0   ,  0   ,  0   , 0 ,    0    )
-   !              !           !          !        !    !    !    !    !     !       !      !      !      !      !   !         !
-   Wave(10) = tide(  'M4'     , 0.000000 ,    4   ,  4 , -4 ,  4 ,  0 ,  0  ,    0  ,  4   , -4   ,  0   ,  0   , 0 ,    1    )
-   !              !           !          !        !    !    !    !    !     !       !      !      !      !      !   !         !
-   Wave(11) = tide(  'Mf'     , 0.042017 ,    0   ,  0 ,  2 ,  0 ,  0 ,  0  ,    0  , -2   ,  0   ,  0   ,  0   , 0 ,   74    )
-   Wave(12) = tide(  'Mm'     , 0.022191 ,    0   ,  0 ,  1 ,  0 , -1 ,  0  ,    0  ,  0   ,  0   ,  0   ,  0   , 0 ,   73    )
-   Wave(13) = tide(  'Msqm'   , 0.000667 ,    0   ,  0 ,  4 , -2 ,  0 ,  0  ,    0  , -2   ,  0   ,  0   ,  0   , 0 ,   74    )
-   Wave(14) = tide(  'Mtm'    , 0.008049 ,    0   ,  0 ,  3 ,  0 , -1 ,  0  ,    0  , -2   ,  0   ,  0   ,  0   , 0 ,   74    )
-   !              !           !          !        !    !    !    !    !     !       !      !      !      !      !   !         !
-   Wave(15) = tide(  'S1'     , 0.000000 ,    1   ,  1 ,  0 ,  0 ,  0 ,  0  ,    0  ,  0   ,  0   ,  0   ,  0   , 0 ,    0    )   
-   Wave(16) = tide(  'MU2'    , 0.005841 ,    2   ,  2 , -4 ,  4 ,  0 ,  0  ,    0  ,  2   , -2   ,  0   ,  0   , 0 ,   78    )
-   Wave(17) = tide(  'NU2'    , 0.009094 ,    2   ,  2 , -3 ,  4 , -1 ,  0  ,    0  ,  2   , -2   ,  0   ,  0   , 0 ,   78    ) 
-   Wave(18) = tide(  'L2'     , 0.006694 ,    2   ,  2 , -1 ,  2 , -1 ,  0  , +180  ,  2   , -2   ,  0   ,  0   , 0 ,  215    )
-   Wave(19) = tide(  'T2'     , 0.006614 ,    2   ,  2 ,  0 , -1 ,  0 ,  1  ,    0  ,  0   ,  0   ,  0   ,  0   , 0 ,    0    )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/tide_mod.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/tide_mod.F90	(revision 12384)
+++ 	(revision )
@@ -1,411 +1,0 @@
-MODULE tide_mod
-   !!======================================================================
-   !!                       ***  MODULE  tide_mod  ***
-   !! Compute nodal modulations corrections and pulsations
-   !!======================================================================
-   !! History :  1.0  !  2007  (O. Le Galloudec)  Original code
-   !!----------------------------------------------------------------------
-   USE dom_oce        ! ocean space and time domain
-   USE phycst         ! physical constant
-   USE daymod         ! calendar
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tide_harmo       ! called by tideini and diaharm modules
-   PUBLIC   tide_init_Wave   ! called by tideini and diaharm modules
-
-   INTEGER, PUBLIC, PARAMETER ::   jpmax_harmo = 19   !: maximum number of harmonic
-
-   TYPE, PUBLIC ::    tide
-      CHARACTER(LEN=4) ::   cname_tide
-      REAL(wp)         ::   equitide
-      INTEGER          ::   nutide
-      INTEGER          ::   nt, ns, nh, np, np1, shift
-      INTEGER          ::   nksi, nnu0, nnu1, nnu2, R
-      INTEGER          ::   nformula
-   END TYPE tide
-
-   TYPE(tide), PUBLIC, DIMENSION(jpmax_harmo) ::   Wave   !:
-
-   REAL(wp) ::   sh_T, sh_s, sh_h, sh_p, sh_p1             ! astronomic angles
-   REAL(wp) ::   sh_xi, sh_nu, sh_nuprim, sh_nusec, sh_R   !
-   REAL(wp) ::   sh_I, sh_x1ra, sh_N                       !
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id$ 
-   !! Software governed by the CeCILL license (see ./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tide_init_Wave
-#     include "tide.h90"
-   END SUBROUTINE tide_init_Wave
-
-
-   SUBROUTINE tide_harmo( pomega, pvt, put , pcor, ktide ,kc)
-      !!----------------------------------------------------------------------
-      !!----------------------------------------------------------------------
-      INTEGER , DIMENSION(kc), INTENT(in ) ::   ktide            ! Indice of tidal constituents
-      INTEGER                , INTENT(in ) ::   kc               ! Total number of tidal constituents
-      REAL(wp), DIMENSION(kc), INTENT(out) ::   pomega           ! pulsation in radians/s
-      REAL(wp), DIMENSION(kc), INTENT(out) ::   pvt, put, pcor   !
-      !!----------------------------------------------------------------------
-      !
-      CALL astronomic_angle
-      CALL tide_pulse( pomega, ktide ,kc )
-      CALL tide_vuf  ( pvt, put, pcor, ktide ,kc )
-      !
-   END SUBROUTINE tide_harmo
-
-
-   SUBROUTINE astronomic_angle
-      !!----------------------------------------------------------------------
-      !!  tj is time elapsed since 1st January 1900, 0 hour, counted in julian
-      !!  century (e.g. time in days divide by 36525)
-      !!----------------------------------------------------------------------
-      REAL(wp) ::   cosI, p, q, t2, t4, sin2I, s2, tgI2, P1, sh_tgn2, at1, at2
-      REAL(wp) ::   zqy , zsy, zday, zdj, zhfrac
-      !!----------------------------------------------------------------------
-      !
-      zqy = AINT( (nyear-1901.)/4. )
-      zsy = nyear - 1900.
-      !
-      zdj  = dayjul( nyear, nmonth, nday )
-      zday = zdj + zqy - 1.
-      !
-      zhfrac = nsec_day / 3600.
-      !
-      !----------------------------------------------------------------------
-      !  Sh_n Longitude of ascending lunar node
-      !----------------------------------------------------------------------
-      sh_N=(259.1560564-19.328185764*zsy-.0529539336*zday-.0022064139*zhfrac)*rad
-      !----------------------------------------------------------------------
-      ! T mean solar angle (Greenwhich time)
-      !----------------------------------------------------------------------
-      sh_T=(180.+zhfrac*(360./24.))*rad
-      !----------------------------------------------------------------------
-      ! h mean solar Longitude
-      !----------------------------------------------------------------------
-      sh_h=(280.1895014-.238724988*zsy+.9856473288*zday+.0410686387*zhfrac)*rad
-      !----------------------------------------------------------------------
-      ! s mean lunar Longitude
-      !----------------------------------------------------------------------
-      sh_s=(277.0256206+129.38482032*zsy+13.176396768*zday+.549016532*zhfrac)*rad
-      !----------------------------------------------------------------------
-      ! p1 Longitude of solar perigee
-      !----------------------------------------------------------------------
-      sh_p1=(281.2208569+.01717836*zsy+.000047064*zday+.000001961*zhfrac)*rad
-      !----------------------------------------------------------------------
-      ! p Longitude of lunar perigee
-      !----------------------------------------------------------------------
-      sh_p=(334.3837214+40.66246584*zsy+.111404016*zday+.004641834*zhfrac)*rad
-
-      sh_N = MOD( sh_N ,2*rpi )
-      sh_s = MOD( sh_s ,2*rpi )
-      sh_h = MOD( sh_h, 2*rpi )
-      sh_p = MOD( sh_p, 2*rpi )
-      sh_p1= MOD( sh_p1,2*rpi )
-
-      cosI = 0.913694997 -0.035692561 *cos(sh_N)
-
-      sh_I = ACOS( cosI )
-
-      sin2I   = sin(sh_I)
-      sh_tgn2 = tan(sh_N/2.0)
-
-      at1=atan(1.01883*sh_tgn2)
-      at2=atan(0.64412*sh_tgn2)
-
-      sh_xi=-at1-at2+sh_N
-
-      IF( sh_N > rpi )   sh_xi=sh_xi-2.0*rpi
-
-      sh_nu = at1 - at2
-
-      !----------------------------------------------------------------------
-      ! For constituents l2 k1 k2
-      !----------------------------------------------------------------------
-
-      tgI2 = tan(sh_I/2.0)
-      P1   = sh_p-sh_xi
-
-      t2 = tgI2*tgI2
-      t4 = t2*t2
-      sh_x1ra = sqrt( 1.0-12.0*t2*cos(2.0*P1)+36.0*t4 )
-
-      p = sin(2.0*P1)
-      q = 1.0/(6.0*t2)-cos(2.0*P1)
-      sh_R = atan(p/q)
-
-      p = sin(2.0*sh_I)*sin(sh_nu)
-      q = sin(2.0*sh_I)*cos(sh_nu)+0.3347
-      sh_nuprim = atan(p/q)
-
-      s2 = sin(sh_I)*sin(sh_I)
-      p  = s2*sin(2.0*sh_nu)
-      q  = s2*cos(2.0*sh_nu)+0.0727
-      sh_nusec = 0.5*atan(p/q)
-      !
-   END SUBROUTINE astronomic_angle
-
-
-   SUBROUTINE tide_pulse( pomega, ktide ,kc )
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE tide_pulse  ***
-      !!                      
-      !! ** Purpose : Compute tidal frequencies
-      !!----------------------------------------------------------------------
-      INTEGER                , INTENT(in ) ::   kc       ! Total number of tidal constituents
-      INTEGER , DIMENSION(kc), INTENT(in ) ::   ktide    ! Indice of tidal constituents
-      REAL(wp), DIMENSION(kc), INTENT(out) ::   pomega   ! pulsation in radians/s
-      !
-      INTEGER  ::   jh
-      REAL(wp) ::   zscale
-      REAL(wp) ::   zomega_T =  13149000.0_wp
-      REAL(wp) ::   zomega_s =    481267.892_wp
-      REAL(wp) ::   zomega_h =     36000.76892_wp
-      REAL(wp) ::   zomega_p =      4069.0322056_wp
-      REAL(wp) ::   zomega_n =      1934.1423972_wp
-      REAL(wp) ::   zomega_p1=         1.719175_wp
-      !!----------------------------------------------------------------------
-      !
-      zscale =  rad / ( 36525._wp * 86400._wp ) 
-      !
-      DO jh = 1, kc
-         pomega(jh) = (  zomega_T * Wave( ktide(jh) )%nT   &
-            &          + zomega_s * Wave( ktide(jh) )%ns   &
-            &          + zomega_h * Wave( ktide(jh) )%nh   &
-            &          + zomega_p * Wave( ktide(jh) )%np   &
-            &          + zomega_p1* Wave( ktide(jh) )%np1  ) * zscale
-      END DO
-      !
-   END SUBROUTINE tide_pulse
-
-
-   SUBROUTINE tide_vuf( pvt, put, pcor, ktide ,kc )
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE tide_vuf  ***
-      !!                      
-      !! ** Purpose : Compute nodal modulation corrections
-      !!
-      !! ** Outputs : vt: Phase of tidal potential relative to Greenwich (radians)
-      !!              ut: Phase correction u due to nodal motion (radians)
-      !!              ft: Nodal correction factor
-      !!----------------------------------------------------------------------
-      INTEGER                , INTENT(in ) ::   kc               ! Total number of tidal constituents
-      INTEGER , DIMENSION(kc), INTENT(in ) ::   ktide            ! Indice of tidal constituents
-      REAL(wp), DIMENSION(kc), INTENT(out) ::   pvt, put, pcor   !
-      !
-      INTEGER ::   jh   ! dummy loop index
-      !!----------------------------------------------------------------------
-      !
-      DO jh = 1, kc
-         !  Phase of the tidal potential relative to the Greenwhich 
-         !  meridian (e.g. the position of the fictuous celestial body). Units are radian:
-         pvt(jh) = sh_T * Wave( ktide(jh) )%nT    &
-            &    + sh_s * Wave( ktide(jh) )%ns    &
-            &    + sh_h * Wave( ktide(jh) )%nh    &
-            &    + sh_p * Wave( ktide(jh) )%np    &
-            &    + sh_p1* Wave( ktide(jh) )%np1   &
-            &    +        Wave( ktide(jh) )%shift * rad
-         !
-         !  Phase correction u due to nodal motion. Units are radian:
-         put(jh) = sh_xi     * Wave( ktide(jh) )%nksi   &
-            &    + sh_nu     * Wave( ktide(jh) )%nnu0   &
-            &    + sh_nuprim * Wave( ktide(jh) )%nnu1   &
-            &    + sh_nusec  * Wave( ktide(jh) )%nnu2   &
-            &    + sh_R      * Wave( ktide(jh) )%R
-
-         !  Nodal correction factor:
-         pcor(jh) = nodal_factort( Wave( ktide(jh) )%nformula )
-      END DO
-      !
-   END SUBROUTINE tide_vuf
-
-
-   RECURSIVE FUNCTION nodal_factort( kformula ) RESULT( zf )
-      !!----------------------------------------------------------------------
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) :: kformula
-      !
-      REAL(wp) :: zf
-      REAL(wp) :: zs, zf1, zf2
-      !!----------------------------------------------------------------------
-      !
-      SELECT CASE( kformula )
-      !
-      CASE( 0 )                  !==  formule 0, solar waves
-         zf = 1.0
-         !
-      CASE( 1 )                  !==  formule 1, compound waves (78 x 78)
-         zf=nodal_factort(78)
-         zf = zf * zf
-         !
-      CASE ( 2 )                 !==  formule 2, compound waves (78 x 0)  ===  (78) 
-       zf1= nodal_factort(78)
-       zf = nodal_factort( 0)
-       zf = zf1 * zf
-       !
-      CASE ( 4 )                 !==  formule 4,  compound waves (78 x 235) 
-         zf1 = nodal_factort( 78)
-         zf  = nodal_factort(235)
-         zf  = zf1 * zf
-         !
-      CASE ( 5 )                 !==  formule 5,  compound waves (78 *78 x 235)
-         zf1 = nodal_factort( 78)
-         zf  = nodal_factort(235)
-         zf  = zf * zf1 * zf1
-         !
-      CASE ( 6 )                 !==  formule 6,  compound waves (78 *78 x 0)
-         zf1 = nodal_factort(78)
-         zf  = nodal_factort( 0)
-         zf  = zf * zf1 * zf1 
-         !
-      CASE( 7 )                  !==  formule 7, compound waves (75 x 75)
-         zf = nodal_factort(75)
-         zf = zf * zf
-         !
-      CASE( 8 )                  !==  formule 8,  compound waves (78 x 0 x 235)
-         zf  = nodal_factort( 78)
-         zf1 = nodal_factort(  0)
-         zf2 = nodal_factort(235)
-         zf  = zf * zf1 * zf2
-         !
-      CASE( 9 )                  !==  formule 9,  compound waves (78 x 0 x 227)
-         zf  = nodal_factort( 78)
-         zf1 = nodal_factort(  0)
-         zf2 = nodal_factort(227)
-         zf  = zf * zf1 * zf2
-         !
-      CASE( 10 )                 !==  formule 10,  compound waves (78 x 227)
-         zf  = nodal_factort( 78)
-         zf1 = nodal_factort(227)
-         zf  = zf * zf1
-         !
-      CASE( 11 )                 !==  formule 11,  compound waves (75 x 0)
-!!gm bug???? zf 2 fois !
-         zf = nodal_factort(75)
-         zf1 = nodal_factort( 0)
-         zf = zf * zf1
-         !
-      CASE( 12 )                 !==  formule 12,  compound waves (78 x 78 x 78 x 0) 
-         zf1 = nodal_factort(78)
-         zf  = nodal_factort( 0)
-         zf  = zf * zf1 * zf1 * zf1
-         !
-      CASE( 13 )                 !==  formule 13, compound waves (78 x 75)
-         zf1 = nodal_factort(78)
-         zf  = nodal_factort(75)
-         zf  = zf * zf1
-         !
-      CASE( 14 )                 !==  formule 14, compound waves (235 x 0)  ===  (235)
-         zf  = nodal_factort(235)
-         zf1 = nodal_factort(  0)
-         zf  = zf * zf1
-         !
-      CASE( 15 )                 !==  formule 15, compound waves (235 x 75) 
-         zf  = nodal_factort(235)
-         zf1 = nodal_factort( 75)
-         zf  = zf * zf1
-         !
-      CASE( 16 )                 !==  formule 16, compound waves (78 x 0 x 0)  ===  (78)
-         zf  = nodal_factort(78)
-         zf1 = nodal_factort( 0)
-         zf  = zf * zf1 * zf1
-         !
-      CASE( 17 )                 !==  formule 17,  compound waves (227 x 0) 
-         zf1 = nodal_factort(227)
-         zf  = nodal_factort(  0)
-         zf  = zf * zf1
-         !
-      CASE( 18 )                 !==  formule 18,  compound waves (78 x 78 x 78 )
-         zf1 = nodal_factort(78)
-         zf  = zf1 * zf1 * zf1
-         !
-      CASE( 19 )                 !==  formule 19, compound waves (78 x 0 x 0 x 0)  ===  (78)
-!!gm bug2 ==>>>   here identical to formule 16,  a third multiplication by zf1 is missing
-         zf  = nodal_factort(78)
-         zf1 = nodal_factort( 0)
-         zf = zf * zf1 * zf1
-         !
-      CASE( 73 )                 !==  formule 73
-         zs = sin(sh_I)
-         zf = (2./3.-zs*zs)/0.5021
-         !
-      CASE( 74 )                 !==  formule 74
-         zs = sin(sh_I)
-         zf = zs * zs / 0.1578
-         !
-      CASE( 75 )                 !==  formule 75
-         zs = cos(sh_I/2)
-         zf = sin(sh_I) * zs * zs / 0.3800
-         !
-      CASE( 76 )                 !==  formule 76
-         zf = sin(2*sh_I) / 0.7214
-         !
-      CASE( 77 )                 !==  formule 77
-         zs = sin(sh_I/2)
-         zf = sin(sh_I) * zs * zs / 0.0164
-         !
-      CASE( 78 )                 !==  formule 78
-         zs = cos(sh_I/2)
-         zf = zs * zs * zs * zs / 0.9154
-         !
-      CASE( 79 )                 !==  formule 79
-         zs = sin(sh_I)
-         zf = zs * zs / 0.1565
-         !
-      CASE( 144 )                !==  formule 144
-         zs = sin(sh_I/2)
-         zf = ( 1-10*zs*zs+15*zs*zs*zs*zs ) * cos(sh_I/2) / 0.5873
-         !
-      CASE( 149 )                !==  formule 149
-         zs = cos(sh_I/2)
-         zf = zs*zs*zs*zs*zs*zs / 0.8758
-         !
-      CASE( 215 )                !==  formule 215
-         zs = cos(sh_I/2)
-         zf = zs*zs*zs*zs / 0.9154 * sh_x1ra
-         !
-      CASE( 227 )                !==  formule 227 
-         zs = sin(2*sh_I)
-         zf = sqrt( 0.8965*zs*zs+0.6001*zs*cos (sh_nu)+0.1006 )
-         !
-      CASE ( 235 )               !==  formule 235 
-         zs = sin(sh_I)
-         zf = sqrt( 19.0444*zs*zs*zs*zs + 2.7702*zs*zs*cos(2*sh_nu) + .0981 )
-         !
-      END SELECT
-      !
-   END FUNCTION nodal_factort
-
-
-   FUNCTION dayjul( kyr, kmonth, kday )
-      !!----------------------------------------------------------------------
-      !!  *** THIS ROUTINE COMPUTES THE JULIAN DAY (AS A REAL VARIABLE)
-      !!----------------------------------------------------------------------
-      INTEGER,INTENT(in) ::   kyr, kmonth, kday
-      !
-      INTEGER,DIMENSION(12) ::  idayt, idays
-      INTEGER  ::   inc, ji
-      REAL(wp) ::   dayjul, zyq
-      !
-      DATA idayt/0.,31.,59.,90.,120.,151.,181.,212.,243.,273.,304.,334./
-      !!----------------------------------------------------------------------
-      !
-      idays(1) = 0.
-      idays(2) = 31.
-      inc = 0.
-      zyq = MOD( kyr-1900. , 4. )
-      IF( zyq == 0.)   inc = 1.
-      DO ji = 3, 12
-         idays(ji)=idayt(ji)+inc
-      END DO
-      dayjul = idays(kmonth) + kday
-      !
-   END FUNCTION dayjul
-
-   !!======================================================================
-END MODULE tide_mod
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/tideini.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/tideini.F90	(revision 12384)
+++ 	(revision )
@@ -1,134 +1,0 @@
-MODULE tideini
-   !!======================================================================
-   !!                       ***  MODULE  tideini  ***
-   !! Initialization of tidal forcing
-   !!======================================================================
-   !! History :  1.0  !  2007  (O. Le Galloudec)  Original code
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and tracers variables
-   USE dom_oce        ! ocean space and time domain
-   USE phycst         ! physical constants
-   USE daymod         ! calendar
-   USE tide_mod       ! 
-   !
-   USE in_out_manager ! I/O units
-   USE iom            ! xIOs server
-   USE ioipsl         ! NetCDF IPSL library
-   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
-
-   IMPLICIT NONE
-   PUBLIC
-
-   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   omega_tide   !:
-   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   v0tide       !:
-   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   utide        !:
-   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   ftide        !:
-
-   LOGICAL , PUBLIC ::   ln_tide         !:
-   LOGICAL , PUBLIC ::   ln_tide_pot     !:
-   LOGICAL , PUBLIC ::   ln_read_load    !:
-   LOGICAL , PUBLIC ::   ln_scal_load    !:
-   LOGICAL , PUBLIC ::   ln_tide_ramp    !:
-   INTEGER , PUBLIC ::   nb_harmo        !:
-   INTEGER , PUBLIC ::   kt_tide         !:
-   REAL(wp), PUBLIC ::   rdttideramp     !:
-   REAL(wp), PUBLIC ::   rn_scal_load    !:
-   CHARACTER(lc), PUBLIC ::   cn_tide_load   !: 
-
-   INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:) ::   ntide   !:
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id$
-   !! Software governed by the CeCILL license (see ./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-   
-   SUBROUTINE tide_init
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE tide_init  ***
-      !!----------------------------------------------------------------------      
-      INTEGER  :: ji, jk
-      CHARACTER(LEN=4), DIMENSION(jpmax_harmo) :: clname
-      INTEGER  ::   ios                 ! Local integer output status for namelist read
-      !
-      NAMELIST/nam_tide/ln_tide, ln_tide_pot, ln_scal_load, ln_read_load, cn_tide_load, &
-                  &     ln_tide_ramp, rn_scal_load, rdttideramp, clname
-      !!----------------------------------------------------------------------
-      !
-      ! Read Namelist nam_tide
-      REWIND( numnam_ref )              ! Namelist nam_tide in reference namelist : Tides
-      READ  ( numnam_ref, nam_tide, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_tide in reference namelist' )
-      !
-      REWIND( numnam_cfg )              ! Namelist nam_tide in configuration namelist : Tides
-      READ  ( numnam_cfg, nam_tide, IOSTAT = ios, ERR = 902 )
-902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nam_tide in configuration namelist' )
-      IF(lwm) WRITE ( numond, nam_tide )
-      !
-      IF( ln_tide ) THEN
-         IF (lwp) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) 'tide_init : Initialization of the tidal components'
-            WRITE(numout,*) '~~~~~~~~~ '
-            WRITE(numout,*) '   Namelist nam_tide'
-            WRITE(numout,*) '      Use tidal components                       ln_tide      = ', ln_tide
-            WRITE(numout,*) '         Apply astronomical potential            ln_tide_pot  = ', ln_tide_pot
-            WRITE(numout,*) '         Use scalar approx. for load potential   ln_scal_load = ', ln_scal_load
-            WRITE(numout,*) '         Read load potential from file           ln_read_load = ', ln_read_load
-            WRITE(numout,*) '         Apply ramp on tides at startup          ln_tide_ramp = ', ln_tide_ramp
-            WRITE(numout,*) '         Fraction of SSH used in scal. approx.   rn_scal_load = ', rn_scal_load
-            WRITE(numout,*) '         Duration (days) of ramp                 rdttideramp  = ', rdttideramp
-         ENDIF
-      ELSE
-         rn_scal_load = 0._wp 
-
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tide_init : tidal components not used (ln_tide = F)'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~ '
-         RETURN
-      ENDIF
-      !
-      CALL tide_init_Wave
-      !
-      nb_harmo=0
-      DO jk = 1, jpmax_harmo
-         DO ji = 1,jpmax_harmo
-            IF( TRIM(clname(jk)) == Wave(ji)%cname_tide )   nb_harmo = nb_harmo + 1
-         END DO
-      END DO
-      !       
-      ! Ensure that tidal components have been set in namelist_cfg
-      IF( nb_harmo == 0 )   CALL ctl_stop( 'tide_init : No tidal components set in nam_tide' )
-      !
-      IF( ln_read_load.AND.(.NOT.ln_tide_pot) ) &
-          &   CALL ctl_stop('ln_read_load requires ln_tide_pot')
-      IF( ln_scal_load.AND.(.NOT.ln_tide_pot) ) &
-          &   CALL ctl_stop('ln_scal_load requires ln_tide_pot')
-      IF( ln_scal_load.AND.ln_read_load ) &
-          &   CALL ctl_stop('Choose between ln_scal_load and ln_read_load')
-      IF( ln_tide_ramp.AND.((nitend-nit000+1)*rdt/rday < rdttideramp) )   &
-         &   CALL ctl_stop('rdttideramp must be lower than run duration')
-      IF( ln_tide_ramp.AND.(rdttideramp<0.) ) &
-         &   CALL ctl_stop('rdttideramp must be positive')
-      !
-      ALLOCATE( ntide(nb_harmo) )
-      DO jk = 1, nb_harmo
-         DO ji = 1, jpmax_harmo
-            IF( TRIM(clname(jk)) == Wave(ji)%cname_tide ) THEN
-               ntide(jk) = ji
-               EXIT
-            ENDIF
-         END DO
-      END DO
-      !
-      ALLOCATE( omega_tide(nb_harmo), v0tide    (nb_harmo),   &
-         &      utide     (nb_harmo), ftide     (nb_harmo)  )
-      kt_tide = nit000
-      !
-      IF (.NOT.ln_scal_load ) rn_scal_load = 0._wp
-      !
-   END SUBROUTINE tide_init
-     
-   !!======================================================================
-END MODULE tideini
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/updtide.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/updtide.F90	(revision 12384)
+++ 	(revision )
@@ -1,81 +1,0 @@
-MODULE updtide
-   !!======================================================================
-   !!                       ***  MODULE  updtide  ***
-   !! Initialization of tidal forcing
-   !!======================================================================
-   !! History :  9.0  !  07  (O. Le Galloudec)  Original code
-   !!----------------------------------------------------------------------
-   !!   upd_tide       : update tidal potential
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers variables
-   USE dom_oce         ! ocean space and time domain
-   USE in_out_manager  ! I/O units
-   USE phycst          ! physical constant
-   USE sbctide         ! tide potential variable
-   USE tideini, ONLY: ln_tide_ramp, rdttideramp
-
-   IMPLICIT NONE
-   PUBLIC
-
-   PUBLIC   upd_tide   ! called in dynspg_... modules
-  
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id$
-   !! Software governed by the CeCILL license (see ./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE upd_tide( kt, kit, kt_offset )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE upd_tide  ***
-      !!
-      !! ** Purpose :   provide at each time step the astronomical potential
-      !!
-      !! ** Method  :   computed from pulsation and amplitude of all tide components
-      !!
-      !! ** Action  :   pot_astro   actronomical potential
-      !!----------------------------------------------------------------------      
-      INTEGER, INTENT(in)           ::   kt      ! ocean time-step index
-      INTEGER, INTENT(in), OPTIONAL ::   kit     ! external mode sub-time-step index (lk_dynspg_ts=T)
-      INTEGER, INTENT(in), OPTIONAL ::   kt_offset ! time offset in number 
-                                                     ! of internal steps             (lk_dynspg_ts=F)
-                                                     ! of external steps             (lk_dynspg_ts=T)
-      !
-      INTEGER  ::   ioffset      ! local integer
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   zt, zramp    ! local scalar
-      REAL(wp), DIMENSION(nb_harmo) ::   zwt 
-      !!----------------------------------------------------------------------      
-      !
-      !                               ! tide pulsation at model time step (or sub-time-step)
-      zt = ( kt - kt_tide ) * rdt
-      !
-      ioffset = 0
-      IF( PRESENT( kt_offset ) )   ioffset = kt_offset
-      !
-      IF( PRESENT( kit ) )   THEN
-         zt = zt + ( kit +  ioffset - 1 ) * rdt / REAL( nn_baro, wp )
-      ELSE
-         zt = zt + ioffset * rdt
-      ENDIF
-      !
-      zwt(:) = omega_tide(:) * zt
-
-      pot_astro(:,:) = 0._wp          ! update tidal potential (sum of all harmonics)
-      DO jk = 1, nb_harmo   
-         pot_astro(:,:) = pot_astro(:,:) + amp_pot(:,:,jk) * COS( zwt(jk) + phi_pot(:,:,jk) )      
-      END DO
-      !
-      IF( ln_tide_ramp ) THEN         ! linear increase if asked
-         zt = ( kt - nit000 ) * rdt
-         IF( PRESENT( kit ) )   zt = zt + ( kit + ioffset -1) * rdt / REAL( nn_baro, wp )
-         zramp = MIN(  MAX( zt / (rdttideramp*rday) , 0._wp ) , 1._wp  )
-         pot_astro(:,:) = zramp * pot_astro(:,:)
-      ENDIF
-      !
-   END SUBROUTINE upd_tide
-
-  !!======================================================================
-
-END MODULE updtide
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/STO/stopar.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/STO/stopar.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/STO/stopar.F90	(revision 12928)
@@ -112,4 +112,6 @@
    INTEGER         :: nn_trc_ord = 1          ! order of autoregressive processes
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -261,9 +263,7 @@
 
       ! Read namsto namelist : stochastic parameterization
-      REWIND( numnam_ref )              ! Namelist namdyn_adv in reference namelist : Momentum advection scheme
       READ  ( numnam_ref, namsto, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsto in reference namelist' )
 
-      REWIND( numnam_cfg )              ! Namelist namdyn_adv in configuration namelist : Momentum advection scheme
       READ  ( numnam_cfg, namsto, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namsto in configuration namelist' )
@@ -829,10 +829,8 @@
       REAL(KIND=8) :: gran   ! Gaussian random number (forced KIND=8 as in kiss_gaussian)
 
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            CALL kiss_gaussian( gran )
-            psto(ji,jj) = gran
-         END DO
-      END DO
+      DO_2D_11_11
+         CALL kiss_gaussian( gran )
+         psto(ji,jj) = gran
+      END_2D
 
    END SUBROUTINE sto_par_white
@@ -849,11 +847,9 @@
       INTEGER  :: ji, jj
 
-      DO jj = 2, jpj-1
-         DO ji = 2, jpi-1
-            psto(ji,jj) = 0.5_wp * psto(ji,jj) + 0.125_wp * &
-                              &  ( psto(ji-1,jj) + psto(ji+1,jj) +  &
-                              &    psto(ji,jj-1) + psto(ji,jj+1) )
-         END DO
-      END DO
+      DO_2D_00_00
+         psto(ji,jj) = 0.5_wp * psto(ji,jj) + 0.125_wp * &
+                           &  ( psto(ji-1,jj) + psto(ji+1,jj) +  &
+                           &    psto(ji,jj-1) + psto(ji,jj+1) )
+      END_2D
 
    END SUBROUTINE sto_par_flt
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/STO/stopts.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/STO/stopts.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/STO/stopts.F90	(revision 12928)
@@ -26,5 +26,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -95,13 +95,9 @@
       ! Eliminate any possible negative salinity
       DO jdof = 1, nn_sto_eos
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  pts_ran(ji,jj,jk,jp_sal,jdof) = MIN( ABS(pts_ran(ji,jj,jk,jp_sal,jdof)) ,  &
-                                                &      MAX(pts(ji,jj,jk,jp_sal),0._wp) )     &
-                                                &  * SIGN(1._wp,pts_ran(ji,jj,jk,jp_sal,jdof))
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, jpkm1 )
+            pts_ran(ji,jj,jk,jp_sal,jdof) = MIN( ABS(pts_ran(ji,jj,jk,jp_sal,jdof)) ,  &
+                                          &      MAX(pts(ji,jj,jk,jp_sal),0._wp) )     &
+                                          &  * SIGN(1._wp,pts_ran(ji,jj,jk,jp_sal,jdof))
+         END_3D
       END DO
 
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/STO/storng.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/STO/storng.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/STO/storng.F90	(revision 12928)
@@ -50,5 +50,4 @@
 
    ! Parameters to generate real random variates
-   REAL(KIND=wp), PARAMETER :: huge64=9223372036854775808.0  ! +1
    REAL(KIND=wp), PARAMETER :: zero=0.0, half=0.5, one=1.0, two=2.0
 
@@ -57,4 +56,6 @@
    REAL(KIND=wp), SAVE :: gran1, gran2
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -273,5 +274,5 @@
       REAL(KIND=wp) :: uran
 
-      uran = half * ( one + REAL(kiss(),wp) / huge64 )
+      uran = half * ( one + REAL(kiss(),wp) / HUGE(1._wp) )
 
    END SUBROUTINE kiss_uniform
@@ -296,6 +297,6 @@
          rsq = two
          DO WHILE ( (rsq.GE.one).OR. (rsq.EQ.zero) )
-            u1 = REAL(kiss(),wp) / huge64
-            u2 = REAL(kiss(),wp) / huge64
+            u1 = REAL(kiss(),wp) / HUGE(1._wp)
+            u2 = REAL(kiss(),wp) / HUGE(1._wp)
             rsq = u1*u1 + u2*u2
          ENDDO
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TDE/tide.h90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TDE/tide.h90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TDE/tide.h90	(revision 12928)
@@ -0,0 +1,166 @@
+   !!=====================================================================
+   !!                  ***  Include file tide.h90  ***
+   !!======================================================================
+   !! History :  3.2  !  2007  (O. Le Galloudec)  Original code
+   !!                 !  2019  (S. Mueller, N. Bruneau)  Alternative parameter set
+   !!----------------------------------------------------------------------
+   !!
+   !! ** Purpose : Inclusion of alternative variants of tidal-constituent
+   !!              parameter definitions during code preprocessing: the default
+   !!              variant includes the 34 constituents available in the FES2014
+   !!              version of the Finite Element Solution - Global Tide data
+   !!              product
+   !!              (https://www.aviso.altimetry.fr/en/data/products/auxiliary-products/global-tide-fes.html);
+   !!              also available is the default parameter set available in
+   !!              previous NEMO versions
+   !!
+   !! ** References :
+   !!       S58) Schureman, P. (1958): Manual of Harmonic Analysis and
+   !!            Prediction of Tides (Revised (1940) Edition (Reprinted 1958
+   !!            with corrections). Reprinted June 2001). U.S. Department of
+   !!            Commerce, Coast and Geodetic Survey Special Publication
+   !!            No. 98. Washington DC, United States Government Printing
+   !!            Office. 317 pp. DOI: 10.25607/OBP-155.
+   !!      CT71) Cartwright, D. E. and Tayler, R. J. (1971): New computations of
+   !!            the Tide-generating Potential. Geophys. J. R. astr. Soc. 23,
+   !!            pp. 45-74. DOI: 10.1111/j.1365-246X.1971.tb01803.x
+   !!      CE73) Cartwright, D. E. and Edden, A. C. (1973): Corrected Tables of
+   !!            Tidal Harmonics. Geophys. J. R. astr. Soc. 33,
+   !!            pp. 253-264. DOI: 10.1111/j.1365-246X.1973.tb03420.x
+   !!   FES2014) FES (Finite element Solution) - Global
+   !!            tide. https://www.aviso.altimetry.fr/en/data/products/auxiliary-products/global-tide-fes.html
+   !!
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2019)
+   !! $Id$
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+#ifndef TIDE_VAR_0
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   !                         | Name   | Equilibrium  | nt | ns | nh | np | np1 | Phase | nxi | nnu0 | nnu1 | nnu2 |  R | Nodal      | Equilibrium    | Parameters source     | Notes  |
+   !                         |        | tide         |    |    |    |    |     | shift |     |      |      |      |    | correction | tide           |                       |        |
+   !                         |        |              |    |    |    |    |     |       |     |      |      |      |    | formula    | source/comment |                       |        |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   !                         |                                                            Long-period tidal constituents                                                              |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components( 1) = tide( 'Mf'   ,  0.042054_wp ,  0 ,  2 ,  1 ,  0 ,   0 ,     0 ,  -2 ,    0 ,    0 ,    0 ,  0 ,  74 )      ! CE73           | S54 (Table 2, A6)     |        |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components( 2) = tide( 'Mm'   ,  0.022187_wp ,  0 ,  1 ,  0 , -1 ,   0 ,     0 ,   0 ,    0 ,    0 ,    0 ,  0 ,  73 )      ! CE73           | S54 (Table 2, A2)     |        |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components( 3) = tide( 'Ssa'  ,  0.019572_wp ,  0 ,  0 ,  2 ,  0 ,   0 ,     0 ,   0 ,    0 ,    0 ,    0 ,  0 ,   0 )      ! CE73           | S54 (Table 2, B6)     |        |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components( 4) = tide( 'Mtm'  ,  0.008052_wp ,  0 ,  3 ,  0 , -1 ,   0 ,     0 ,  -2 ,    0 ,    0 ,    0 ,  0 ,  74 )      ! CE73           | FES2014 (prediction   |        |
+   !                         |        |              |    |    |    |    |     |       |     |      |      |      |    |            |                | algorithm); S54       |        |
+   !                         |        |              |    |    |    |    |     |       |     |      |      |      |    |            |                | (Table 2, A7)         |        |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components( 5) = tide( 'Msf'  ,  0.003677_wp ,  0 ,  2 , -2 ,  0 ,   0 ,     0 ,   0 ,    0 ,    0 ,    0 ,  0 ,  73 )      ! CE73           | S54 (Table 2, A5)     |        |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components( 6) = tide( 'Msqm' ,  0.001287_wp ,  0 ,  4 , -2 ,  0 ,   0 ,     0 ,  -2 ,    0 ,    0 ,    0 ,  0 ,  74 )      ! CE73           | FES2014 (prediction   |        |
+   !                         |        |              |    |    |    |    |     |       |     |      |      |      |    |            |                | algorithm); S54       |        |
+   !                         |        |              |    |    |    |    |     |       |     |      |      |      |    |            |                | (Table 2, A12)        |        |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components( 7) = tide( 'Sa'   ,  0.000000_wp ,  0 ,  0 ,  1 ,  0 ,   0 ,     0 ,   0 ,    0 ,    0 ,    0 ,  0 ,   0 )      ! Meteorological | S54 (Table 2, B64)    |        |
+   !                         |        |              |    |    |    |    |     |       |     |      |      |      |    |            | tide only      |                       |        |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   !                         |                                                              Diurnal tidal constituents                                                                |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components( 8) = tide( 'K1'   , -0.142486_wp ,  1 ,  0 ,  1 ,  0 ,   0 ,    90 ,   0 ,    0 ,   -1 ,    0 ,  0 , 227 )      ! CE73           | S54 (Table 2)         | Note 1 |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components( 9) = tide( 'O1'   ,  0.101316_wp ,  1 , -2 ,  1 ,  0 ,   0 ,    90 ,   2 ,   -1 ,    0 ,    0 ,  0 ,  75 )      ! CE73           | S54 (Table 2, A14)    |        |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components(10) = tide( 'P1'   ,  0.047152_wp ,  1 ,  0 , -1 ,  0 ,   0 ,    90 ,   0 ,    0 ,    0 ,    0 ,  0 ,   0 )      ! CE73           | S54 (Table 2, B14)    |        |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components(11) = tide( 'Q1'   ,  0.019396_wp ,  1 , -3 ,  1 ,  1 ,   0 ,    90 ,   2 ,   -1 ,    0 ,    0 ,  0 ,  75 )      ! CE73           | S54 (Table 2, A15)    |        |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components(12) = tide( 'J1'   , -0.007967_wp ,  1 ,  1 ,  1 , -1 ,   0 ,    90 ,   0 ,   -1 ,    0 ,    0 ,  0 ,  76 )      ! CE73           | S54 (Table 2, A24)    | Note 1 |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components(13) = tide( 'S1'   ,  0.000000_wp ,  1 ,  0 ,  0 ,  0 ,   0 ,     0 ,   0 ,    0 ,    0 ,    0 ,  0 ,   0 )      ! Meteorological | S54 (Table 2, B71)    |        |
+   !                         |        |              |    |    |    |    |     |       |     |      |      |      |    |            | tide only      |                       |        |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   !                         |                                                            Semidiurnal tidal constituents                                                              |
+   !                         +--------+-------------+-----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components(14) = tide( 'M2'   ,  0.244081_wp ,  2 , -2 ,  2 ,  0 ,   0 ,     0 ,   2 ,   -2 ,    0 ,    0 ,  0 ,  78 )      ! CE73           | S54 (Table 2, A39)    |        |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components(15) = tide( 'S2'   ,  0.110242_wp ,  2 ,  0 ,  0 ,  0 ,   0 ,     0 ,   0 ,    0 ,    0 ,    0 ,  0 ,   0 )      ! CE73           | S54 (Table 2, B39)    |        |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components(16) = tide( 'N2'   ,  0.046732_wp ,  2 , -3 ,  2 ,  1 ,   0 ,     0 ,   2 ,   -2 ,    0 ,    0 ,  0 ,  78 )      ! CE73           | S54 (Table 2, A40)    |        |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components(17) = tide( 'K2'   ,  0.030905_wp ,  2 ,  0 ,  2 ,  0 ,   0 ,     0 ,   0 ,    0 ,    0 ,   -2 ,  0 , 235 )      ! CE73           | S54 (Table 2)         |        |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components(18) = tide( 'nu2'  ,  0.008877_wp ,  2 , -3 ,  4 , -1 ,   0 ,     0 ,   2 ,   -2 ,    0 ,    0 ,  0 ,  78 )      ! CE73           | S54 (Table 2, A43)    |        |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components(19) = tide( 'mu2'  ,  0.007463_wp ,  2 , -4 ,  4 ,  0 ,   0 ,     0 ,   2 ,   -2 ,    0 ,    0 ,  0 ,  78 )      ! CE73           | S54 (Table 2, A45)    |        |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components(20) = tide( '2N2'  ,  0.006184_wp ,  2 , -4 ,  2 ,  2 ,   0 ,     0 ,   2 ,   -2 ,    0 ,    0 ,  0 ,  78 )      ! CE73           | S54 (Table 2, A42)    |        |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components(21) = tide( 'L2'   , -0.006899_wp ,  2 , -1 ,  2 , -1 ,   0 ,     0 ,   2 ,   -2 ,    0 ,    0 , -1 , 215 )      ! CE73           | S54 (Table 2)         | Note 1 |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components(22) = tide( 'T2'   ,  0.006655_wp ,  2 ,  0 , -1 ,  0 ,   1 ,     0 ,   0 ,    0 ,    0 ,    0 ,  0 ,   0 )      ! CE73           | S54 (Table 2, B40)    |        |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components(23) = tide( 'eps2' ,  0.001804_wp ,  2 , -5 ,  4 ,  1 ,   0 ,     0 ,   2 ,   -2 ,    0 ,    0 ,  0 ,  78 )      ! CE73           | FES2014 (prediction   |        |
+   !                         |        |              |    |    |    |    |     |       |     |      |      |      |    |            |                | algorithm)            |        |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components(24) = tide( 'lam2' , -0.001800_wp ,  2 , -1 ,  0 ,  1 ,   0 ,     0 ,   2 ,   -2 ,    0 ,    0 ,  0 ,  78 )      ! CE73           | S54 (Table 2, A44)    | Note 1 |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components(25) = tide( 'R2'   , -0.000952_wp ,  2 ,  0 ,  1 ,  0 ,  -1 ,     0 ,   0 ,    0 ,    0 ,    0 ,  0 ,   0 )      ! CE73           | S54 (Table 2, B41)    | Note 1 |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   !                         |                                                            Terdiurnal tidal constituents                                                               |
+   !                         +--------+-------------+-----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components(26) = tide( 'M3'   , -0.003192_wp ,  3 , -3 ,  3 ,  0 ,   0 ,   180 ,   3 ,   -3 ,    0 ,    0 ,  0 , 149 )      ! CT71           | S54 (Table 2, A82)    | Note 2 |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   !                         |                                                                    Compound tides                                                                      |
+   !                         +--------+-------------+-----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components(27) = tide( 'MKS2' ,  0.000000_wp ,  2 , -2 ,  4 ,  0 ,   0 ,     0 ,   2 ,   -2 ,    0 ,   -2 ,  0 ,   4 )      ! Compound tide  | FES2014 (prediction   |        |
+   !                         |        |              |    |    |    |    |     |       |     |      |      |      |    |            |                | algorithm)            |        |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components(28) = tide( 'MN4'  ,  0.000000_wp ,  4 , -5 ,  4 ,  1 ,   0 ,     0 ,   4 ,   -4 ,    0 ,    0 ,  0 ,   1 )      ! Compound tide  | S54 (Table 2a)        |        |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components(29) = tide( 'MS4'  ,  0.000000_wp ,  4 , -2 ,  2 ,  0 ,   0 ,     0 ,   2 ,   -2 ,    0 ,    0 ,  0 ,  78 )      ! Compound tide  | FES2014 (prediction   | Note 3 |
+   !                         |        |              |    |    |    |    |     |       |     |      |      |      |    |            |                | algorithm); S54       |        |
+   !                         |        |              |    |    |    |    |     |       |     |      |      |      |    |            |                | (Table 2a)            |        |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   !                         |                                                                       Overtides                                                                        |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components(30) = tide( 'M4'   ,  0.000000_wp ,  4 , -4 ,  4 ,  0 ,   0 ,     0 ,   4 ,   -4 ,    0 ,    0 ,  0 ,   1 )      ! Overtide       | S54                   |        |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components(31) = tide( 'N4'   ,  0.000000_wp ,  4 , -6 ,  4 ,  2 ,   0 ,     0 ,   4 ,   -4 ,    0 ,    0 ,  0 ,   1 )      ! Overtide       | FES2014 (prediction   |        |
+   !                         |        |              |    |    |    |    |     |       |     |      |      |      |    |            |                | algorithm)            |        |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components(32) = tide( 'S4'   ,  0.000000_wp ,  4 ,  0 ,  0 ,  0 ,  0  ,     0 ,   0 ,    0 ,    0 ,    0 ,  0 ,   0 )      ! Overtide       | S54                   |        | 
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components(33) = tide( 'M6'   ,  0.000000_wp ,  6 , -6 ,  6 ,  0 ,  0  ,     0 ,   6 ,   -6 ,    0 ,    0 ,  0 ,  18 )      ! Overtide       | S54                   |        |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   tide_components(34) = tide( 'M8'   ,  0.000000_wp ,  8 , -8 ,  8 ,  0 ,  0  ,     0 ,   8 ,   -8 ,    0 ,    0 ,  0 ,  20 )      ! Overtide       | S54                   |        |
+   !                         +--------+--------------+----+----+----+----+-----+-------+-----+------+------+------+----+------------+----------------+-----------------------+--------+
+   !   Note 1: the phase shift from Table 2 of S54 has been adjusted to accomodate the negative sign of the equilibrium-tide value derived from CE73.
+   !   Note 2: the phase shift from Table 2 of S54 has been adjusted to accomodate the negative sign of the equilibrium-tide value derived from CT71.
+   !   Note 3: the nodal correction factor formulas from FES2014 and S54 differ; here, the version from FES2014 has been selected.
+#else
+   !                        !! name_tide , equitide , nt , ns , nh , np , np1 , shift , nksi , nnu0 , nnu1 , nnu2 , R , formula !!
+   !                        !!           !          !    !    !    !    !     !       !      !      !      !      !   !         !!
+   tide_components( 1) = tide(  'M2'     , 0.242297 ,  2 , -2 ,  2 ,  0 ,  0  ,    0  ,  2   , -2   ,  0   ,  0   , 0 ,    78   )
+   tide_components( 2) = tide(  'N2'     , 0.046313 ,  2 , -3 ,  2 ,  1 ,  0  ,    0  ,  2   , -2   ,  0   ,  0   , 0 ,    78   )
+   tide_components( 3) = tide( '2N2'     , 0.006184 ,  2 , -4 ,  2 ,  2 ,  0  ,    0  ,  2   , -2   ,  0   ,  0   , 0 ,    78   )
+   tide_components( 4) = tide(  'S2'     , 0.113572 ,  2 ,  0 ,  0 ,  0 ,  0  ,    0  ,  0   ,  0   ,  0   ,  0   , 0 ,     0   )
+   tide_components( 5) = tide(  'K2'     , 0.030875 ,  2 ,  0 ,  2 ,  0 ,  0  ,    0  ,  0   ,  0   ,  0   , -2   , 0 ,   235   )
+   !                         !           !          !    !    !    !    !     !       !      !      !      !      !   !         !
+   tide_components( 6) = tide(  'K1'     , 0.142408 ,  1 ,  0 ,  1 ,  0 ,  0  ,  -90  ,  0   ,  0   , -1   ,  0   , 0 ,   227   )
+   tide_components( 7) = tide(  'O1'     , 0.101266 ,  1 , -2 ,  1 ,  0 ,  0  ,  +90  ,  2   , -1   ,  0   ,  0   , 0 ,    75   )
+   tide_components( 8) = tide(  'Q1'     , 0.019387 ,  1 , -3 ,  1 ,  1 ,  0  ,  +90  ,  2   , -1   ,  0   ,  0   , 0 ,    75   )
+   tide_components( 9) = tide(  'P1'     , 0.047129 ,  1 ,  0 , -1 ,  0 ,  0  ,  +90  ,  0   ,  0   ,  0   ,  0   , 0 ,    0    )
+   !                         !           !          !    !    !    !    !     !       !      !      !      !      !   !         !
+   tide_components(10) = tide(  'M4'     , 0.000000 ,  4 , -4 ,  4 ,  0 ,  0  ,    0  ,  4   , -4   ,  0   ,  0   , 0 ,    1    )
+   !                         !           !          !    !    !    !    !     !       !      !      !      !      !   !         !
+   tide_components(11) = tide(  'Mf'     , 0.042017 ,  0 ,  2 ,  0 ,  0 ,  0  ,    0  , -2   ,  0   ,  0   ,  0   , 0 ,   74    )
+   tide_components(12) = tide(  'Mm'     , 0.022191 ,  0 ,  1 ,  0 , -1 ,  0  ,    0  ,  0   ,  0   ,  0   ,  0   , 0 ,   73    )
+   tide_components(13) = tide(  'Msqm'   , 0.000667 ,  0 ,  4 , -2 ,  0 ,  0  ,    0  , -2   ,  0   ,  0   ,  0   , 0 ,   74    )
+   tide_components(14) = tide(  'Mtm'    , 0.008049 ,  0 ,  3 ,  0 , -1 ,  0  ,    0  , -2   ,  0   ,  0   ,  0   , 0 ,   74    )
+   !                         !           !          !    !    !    !    !     !       !      !      !      !      !   !         !
+   tide_components(15) = tide(  'S1'     , 0.000000 ,  1 ,  0 ,  0 ,  0 ,  0  ,    0  ,  0   ,  0   ,  0   ,  0   , 0 ,    0    )   
+   tide_components(16) = tide(  'MU2'    , 0.005841 ,  2 , -4 ,  4 ,  0 ,  0  ,    0  ,  2   , -2   ,  0   ,  0   , 0 ,   78    )
+   tide_components(17) = tide(  'NU2'    , 0.009094 ,  2 , -3 ,  4 , -1 ,  0  ,    0  ,  2   , -2   ,  0   ,  0   , 0 ,   78    ) 
+   tide_components(18) = tide(  'L2'     , 0.006694 ,  2 , -1 ,  2 , -1 ,  0  , +180  ,  2   , -2   ,  0   ,  0   , 0 ,  215    )
+   tide_components(19) = tide(  'T2'     , 0.006614 ,  2 ,  0 , -1 ,  0 ,  1  ,    0  ,  0   ,  0   ,  0   ,  0   , 0 ,    0    )
+#endif
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TDE/tide_mod.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TDE/tide_mod.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TDE/tide_mod.F90	(revision 12928)
@@ -0,0 +1,762 @@
+MODULE tide_mod
+   !!======================================================================
+   !!                       ***  MODULE  tide_mod  ***
+   !! Compute nodal modulations corrections and pulsations
+   !!======================================================================
+   !! History :  1.0  !  2007  (O. Le Galloudec)  Original code
+   !!                 !  2019  (S. Mueller)
+   !!----------------------------------------------------------------------
+   !!
+   !! ** Reference :
+   !!       S58) Schureman, P. (1958): Manual of Harmonic Analysis and
+   !!            Prediction of Tides (Revised (1940) Edition (Reprinted 1958
+   !!            with corrections). Reprinted June 2001). U.S. Department of
+   !!            Commerce, Coast and Geodetic Survey Special Publication
+   !!            No. 98. Washington DC, United States Government Printing
+   !!            Office. 317 pp. DOI: 10.25607/OBP-155.
+   !!----------------------------------------------------------------------
+
+   USE oce, ONLY : ssh        ! sea-surface height
+   USE par_oce                ! ocean parameters
+   USE phycst, ONLY : rpi, rad, rday
+   USE daymod, ONLY : ndt05   ! half-length of time step
+   USE in_out_manager         ! I/O units
+   USE iom                    ! xIOs server
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tide_init
+   PUBLIC   tide_update           ! called by stp
+   PUBLIC   tide_init_harmonics   ! called internally and by module diaharm
+   PUBLIC   upd_tide              ! called in dynspg_... modules
+
+   INTEGER, PUBLIC, PARAMETER ::   jpmax_harmo = 64   !: maximum number of harmonic components
+
+   TYPE ::    tide
+      CHARACTER(LEN=4) ::   cname_tide = ''
+      REAL(wp)         ::   equitide
+      INTEGER          ::   nt, ns, nh, np, np1, shift
+      INTEGER          ::   nksi, nnu0, nnu1, nnu2, R
+      INTEGER          ::   nformula
+   END TYPE tide
+
+   TYPE(tide), DIMENSION(:), POINTER ::   tide_components   !: Array of selected tidal component parameters
+
+   TYPE, PUBLIC ::   tide_harmonic       !:   Oscillation parameters of harmonic tidal components
+      CHARACTER(LEN=4) ::   cname_tide   !    Name of component
+      REAL(wp)         ::   equitide     !    Amplitude of equilibrium tide
+      REAL(wp)         ::   f            !    Node factor
+      REAL(wp)         ::   omega        !    Angular velocity
+      REAL(wp)         ::   v0           !    Initial phase at prime meridian
+      REAL(wp)         ::   u            !    Phase correction
+   END type tide_harmonic
+
+   TYPE(tide_harmonic), PUBLIC, DIMENSION(:), POINTER ::   tide_harmonics   !: Oscillation parameters of selected tidal components
+
+   LOGICAL , PUBLIC ::   ln_tide             !:
+   LOGICAL , PUBLIC ::   ln_tide_pot         !:
+   INTEGER          ::   nn_tide_var         !  Variant of tidal parameter set and tide-potential computation
+   LOGICAL          ::   ln_tide_dia         !  Enable tidal diagnostic output
+   LOGICAL          ::   ln_read_load        !:
+   LOGICAL , PUBLIC ::   ln_scal_load        !:
+   LOGICAL , PUBLIC ::   ln_tide_ramp        !:
+   INTEGER , PUBLIC ::   nb_harmo            !: Number of active tidal components
+   REAL(wp), PUBLIC ::   rn_tide_ramp_dt     !:
+   REAL(wp), PUBLIC ::   rn_scal_load        !:
+   CHARACTER(lc), PUBLIC ::   cn_tide_load   !: 
+   REAL(wp)         ::   rn_tide_gamma       ! Tidal tilt factor
+
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   pot_astro            !: tidal potential
+   REAL(wp),         ALLOCATABLE, DIMENSION(:,:)   ::   pot_astro_comp       !  tidal-potential component
+   REAL(wp),         ALLOCATABLE, DIMENSION(:,:,:) ::   amp_pot, phi_pot
+   REAL(wp),         ALLOCATABLE, DIMENSION(:,:,:) ::   amp_load, phi_load
+
+   REAL(wp) ::   rn_tide_ramp_t   !   Elapsed time in seconds
+
+   REAL(wp) ::   sh_T, sh_s, sh_h, sh_p, sh_p1             ! astronomic angles
+   REAL(wp) ::   sh_xi, sh_nu, sh_nuprim, sh_nusec, sh_R   !
+   REAL(wp) ::   sh_I, sh_x1ra, sh_N                       !
+
+   ! Longitudes on 1 Jan 1900, 00h and angular velocities (units of deg and
+   ! deg/h, respectively. The values of these module variables have been copied
+   ! from subroutine astronomic_angle of the version of this module used in
+   ! release version 4.0 of NEMO.
+   REAL(wp) ::   rlon00_N  =  259.1560564_wp               ! Longitude of ascending lunar node
+   REAL(wp) ::   romega_N  = -.0022064139_wp
+   REAL(wp) ::   rlon00_T  =  180.0_wp                     ! Mean solar angle (GMT)
+   REAL(wp) ::   romega_T  =  15.0_wp
+   REAL(wp) ::   rlon00_h  =  280.1895014_wp               ! Mean solar Longitude
+   REAL(wp) ::   romega_h  =  .0410686387_wp
+   REAL(wp) ::   rlon00_s  =  277.0256206_wp               ! Mean lunar Longitude
+   REAL(wp) ::   romega_s  =  .549016532_wp
+   REAL(wp) ::   rlon00_p1 =  281.2208569_wp               ! Longitude of solar perigee
+   REAL(wp) ::   romega_p1 =  .000001961_wp
+   REAL(wp) ::   rlon00_p  =  334.3837214_wp               ! Longitude of lunar perigee
+   REAL(wp) ::   romega_p  =  .004641834_wp
+   ! Values of cos(i)*cos(epsilon), rcice, and sin(incl)*sin(epsilon), rsise,
+   ! where i is the inclination of the orbit of the Moon w.r.t. the ecliptic and
+   ! epsilon the obliquity of the ecliptic on 1 January 1900, 00h. The values of
+   ! these module variables have been copied from subroutine astronomic_angle
+   ! (computation of the cosine of inclination of orbit of Moon to the celestial
+   ! equator) of the version of this module used in release version 4.0 of NEMO.
+   REAL(wp) ::   rcice    = 0.913694997_wp
+   REAL(wp) ::   rsise    = 0.035692561_wp
+   ! Coefficients used to compute sh_xi and sh_nu in subroutine astronomic_angle
+   ! according to two equations given in the explanation of Table 6 of S58
+   REAL(wp) ::   rxinu1, rxinu2
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id$ 
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tide_init
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE tide_init  ***
+      !!----------------------------------------------------------------------      
+      INTEGER  :: ji, jk
+      CHARACTER(LEN=4), DIMENSION(jpmax_harmo) :: sn_tide_cnames ! Names of selected tidal components
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      !
+      NAMELIST/nam_tide/ln_tide, nn_tide_var, ln_tide_dia, ln_tide_pot, rn_tide_gamma, &
+         &              ln_scal_load, ln_read_load, cn_tide_load,         &
+         &              ln_tide_ramp, rn_scal_load, rn_tide_ramp_dt,      &
+         &              sn_tide_cnames
+      !!----------------------------------------------------------------------
+      !
+      ! Initialise all array elements of sn_tide_cnames, as some of them
+      ! typically do not appear in namelist_ref or namelist_cfg
+      sn_tide_cnames(:) = ''
+      ! Read Namelist nam_tide
+      READ  ( numnam_ref, nam_tide, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_tide in reference namelist' )
+      !
+      READ  ( numnam_cfg, nam_tide, IOSTAT = ios, ERR = 902 )
+902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nam_tide in configuration namelist' )
+      IF(lwm) WRITE ( numond, nam_tide )
+      !
+      IF( ln_tide ) THEN
+         IF (lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'tide_init : Initialization of the tidal components'
+            WRITE(numout,*) '~~~~~~~~~ '
+            WRITE(numout,*) '   Namelist nam_tide'
+            WRITE(numout,*) '      Use tidal components                       ln_tide         = ', ln_tide
+            WRITE(numout,*) '         Variant (1: default; 0: legacy option)  nn_tide_var     = ', nn_tide_var
+            WRITE(numout,*) '         Tidal diagnostic output                 ln_tide_dia     = ', ln_tide_dia
+            WRITE(numout,*) '         Apply astronomical potential            ln_tide_pot     = ', ln_tide_pot
+            WRITE(numout,*) '         Tidal tilt factor                       rn_tide_gamma   = ', rn_tide_gamma
+            WRITE(numout,*) '         Use scalar approx. for load potential   ln_scal_load    = ', ln_scal_load
+            WRITE(numout,*) '         Read load potential from file           ln_read_load    = ', ln_read_load
+            WRITE(numout,*) '         Apply ramp on tides at startup          ln_tide_ramp    = ', ln_tide_ramp
+            WRITE(numout,*) '         Fraction of SSH used in scal. approx.   rn_scal_load    = ', rn_scal_load
+            WRITE(numout,*) '         Duration (days) of ramp                 rn_tide_ramp_dt = ', rn_tide_ramp_dt
+         ENDIF
+      ELSE
+         rn_scal_load = 0._wp 
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tide_init : tidal components not used (ln_tide = F)'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~ '
+         RETURN
+      ENDIF
+      !
+      IF( ln_read_load.AND.(.NOT.ln_tide_pot) ) &
+          &   CALL ctl_stop('ln_read_load requires ln_tide_pot')
+      IF( ln_scal_load.AND.(.NOT.ln_tide_pot) ) &
+          &   CALL ctl_stop('ln_scal_load requires ln_tide_pot')
+      IF( ln_scal_load.AND.ln_read_load ) &
+          &   CALL ctl_stop('Choose between ln_scal_load and ln_read_load')
+      IF( ln_tide_ramp.AND.((nitend-nit000+1)*rn_Dt/rday < rn_tide_ramp_dt) )   &
+         &   CALL ctl_stop('rn_tide_ramp_dt must be lower than run duration')
+      IF( ln_tide_ramp.AND.(rn_tide_ramp_dt<0.) ) &
+         &   CALL ctl_stop('rn_tide_ramp_dt must be positive')
+      !
+      ! Compute coefficients which are used in subroutine astronomic_angle to
+      ! compute sh_xi and sh_nu according to two equations given in the
+      ! explanation of Table 6 of S58
+      rxinu1 = COS( 0.5_wp * ( ABS( ACOS( rcice + rsise ) ) ) ) / COS( 0.5_wp * ( ACOS( rcice - rsise ) ) )
+      rxinu2 = SIN( 0.5_wp * ( ABS( ACOS( rcice + rsise ) ) ) ) / SIN( 0.5_wp * ( ACOS( rcice - rsise ) ) )
+      !
+      ! Initialise array used to store tidal oscillation parameters (frequency,
+      ! amplitude, phase); also retrieve and store array of information about
+      ! selected tidal components
+      CALL tide_init_harmonics(sn_tide_cnames, tide_harmonics, tide_components)
+      !
+      ! Number of active tidal components
+      nb_harmo = size(tide_components)
+      !       
+      ! Ensure that tidal components have been set in namelist_cfg
+      IF( nb_harmo == 0 )   CALL ctl_stop( 'tide_init : No tidal components set in nam_tide' )
+      !
+      IF (.NOT.ln_scal_load ) rn_scal_load = 0._wp
+      !
+      ALLOCATE( amp_pot(jpi,jpj,nb_harmo),                      &
+           &      phi_pot(jpi,jpj,nb_harmo), pot_astro(jpi,jpj)   )
+      IF( ln_tide_dia ) ALLOCATE( pot_astro_comp(jpi,jpj) )
+      IF( ln_read_load ) THEN
+         ALLOCATE( amp_load(jpi,jpj,nb_harmo), phi_load(jpi,jpj,nb_harmo) )
+         CALL tide_init_load
+         amp_pot(:,:,:) = amp_load(:,:,:)
+         phi_pot(:,:,:) = phi_load(:,:,:)
+      ELSE		
+         amp_pot(:,:,:) = 0._wp
+         phi_pot(:,:,:) = 0._wp	 
+      ENDIF
+      !
+   END SUBROUTINE tide_init
+
+
+   SUBROUTINE tide_init_components(pcnames, ptide_comp)
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE tide_init_components  ***
+      !!
+      !! Returns pointer to array of variables of type 'tide' that contain
+      !! information about the selected tidal components
+      !! ----------------------------------------------------------------------
+      CHARACTER(LEN=4),              DIMENSION(jpmax_harmo), INTENT(in)  ::   pcnames             ! Names of selected components
+      TYPE(tide),       POINTER,     DIMENSION(:),           INTENT(out) ::   ptide_comp          ! Selected components
+      INTEGER,          ALLOCATABLE, DIMENSION(:)                        ::   icomppos            ! Indices of selected components
+      INTEGER                                                            ::   icomp, jk, jj, ji   ! Miscellaneous integers
+      LOGICAL                                                            ::   llmatch             ! Local variables used for
+      INTEGER                                                            ::   ic1, ic2            !    string comparison
+      TYPE(tide),       POINTER,     DIMENSION(:)                        ::   tide_components     ! All available components
+      
+      ! Populate local array with information about all available tidal
+      ! components
+      !
+      ! Note, here 'tide_components' locally overrides the global module
+      ! variable of the same name to enable the use of the global name in the
+      ! include file that contains the initialisation of elements of array
+      ! 'tide_components'
+      ALLOCATE(tide_components(jpmax_harmo), icomppos(jpmax_harmo))
+      ! Initialise array of indices of the selected componenents
+      icomppos(:) = 0
+      ! Include tidal component parameters for all available components
+      IF (nn_tide_var < 1) THEN
+#define TIDE_VAR_0
+#include "tide.h90"
+#undef TIDE_VAR_0
+      ELSE
+#include "tide.h90"
+      END IF
+      ! Identify the selected components that are availble
+      icomp = 0
+      DO jk = 1, jpmax_harmo
+         IF (TRIM(pcnames(jk)) /= '') THEN
+            DO jj = 1, jpmax_harmo
+               ! Find matches between selected and available constituents
+               ! (ignore capitalisation unless legacy variant has been selected)
+               IF (nn_tide_var < 1) THEN
+                  llmatch = (TRIM(pcnames(jk)) == TRIM(tide_components(jj)%cname_tide))
+               ELSE
+                  llmatch = .TRUE.
+                  ji = MAX(LEN_TRIM(pcnames(jk)), LEN_TRIM(tide_components(jj)%cname_tide))
+                  DO WHILE (llmatch.AND.(ji > 0))
+                     ic1 = IACHAR(pcnames(jk)(ji:ji))
+                     IF ((ic1 >= 97).AND.(ic1 <= 122)) ic1 = ic1 - 32
+                     ic2 = IACHAR(tide_components(jj)%cname_tide(ji:ji))
+                     IF ((ic2 >= 97).AND.(ic2 <= 122)) ic2 = ic2 - 32
+                     llmatch = (ic1 == ic2)
+                     ji = ji - 1
+                  END DO
+               END IF
+               IF (llmatch) THEN
+                  ! Count and record the match
+                  icomp = icomp + 1
+                  icomppos(icomp) = jj
+                  ! Set the capitalisation of the tidal constituent identifier
+                  ! as specified in the namelist
+                  tide_components(jj)%cname_tide = pcnames(jk)
+                  IF (lwp) WRITE(numout, '(10X,"Tidal component #",I2.2,36X,"= ",A4)') icomp, tide_components(jj)%cname_tide
+                  EXIT
+               END IF
+            END DO
+            IF ((lwp).AND.(jj > jpmax_harmo)) WRITE(numout, '(10X,"Tidal component ",A4," is not available!")') pcnames(jk)
+         END IF
+      END DO
+      
+      ! Allocate and populate reduced list of components
+      ALLOCATE(ptide_comp(icomp))
+      DO jk = 1, icomp
+         ptide_comp(jk) = tide_components(icomppos(jk))
+      END DO
+      
+      ! Release local array of available components and list of selected
+      ! components
+      DEALLOCATE(tide_components, icomppos)
+      
+   END SUBROUTINE tide_init_components
+
+
+   SUBROUTINE tide_init_harmonics(pcnames, ptide_harmo, ptide_comp)
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE tide_init_harmonics  ***
+      !!
+      !! Returns pointer to array of variables of type 'tide_harmonics' that
+      !! contain oscillation parameters of the selected harmonic tidal
+      !! components
+      !! ----------------------------------------------------------------------
+      CHARACTER(LEN=4),             DIMENSION(jpmax_harmo), INTENT(in) ::   pcnames     ! Names of selected components
+      TYPE(tide_harmonic), POINTER, DIMENSION(:)                       ::   ptide_harmo ! Oscillation parameters of tidal components
+      TYPE(tide),          POINTER, DIMENSION(:), OPTIONAL             ::   ptide_comp  ! Selected components
+      TYPE(tide),          POINTER, DIMENSION(:)                       ::   ztcomp      ! Selected components
+
+      ! Retrieve information about selected tidal components
+      ! If requested, prepare tidal component array for returning
+      IF (PRESENT(ptide_comp)) THEN
+         CALL tide_init_components(pcnames, ptide_comp)
+         ztcomp => ptide_comp
+      ELSE
+         CALL tide_init_components(pcnames, ztcomp)
+      END IF
+
+      ! Allocate and populate array of oscillation parameters
+      ALLOCATE(ptide_harmo(size(ztcomp)))
+      ptide_harmo(:)%cname_tide = ztcomp(:)%cname_tide
+      ptide_harmo(:)%equitide = ztcomp(:)%equitide
+      CALL tide_harmo(ztcomp, ptide_harmo)
+
+   END SUBROUTINE tide_init_harmonics
+
+
+   SUBROUTINE tide_init_potential
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE tide_init_potential  ***
+      !!
+      !! ** Reference :
+      !!      CT71) Cartwright, D. E. and Tayler, R. J. (1971): New computations of
+      !!            the Tide-generating Potential. Geophys. J. R. astr. Soc. 23,
+      !!            pp. 45-74. DOI: 10.1111/j.1365-246X.1971.tb01803.x
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zcons, ztmp1, ztmp2, zlat, zlon, ztmp, zamp, zcs   ! local scalar
+      !!----------------------------------------------------------------------
+
+      IF( ln_read_load ) THEN
+	 amp_pot(:,:,:) = amp_load(:,:,:)
+	 phi_pot(:,:,:) = phi_load(:,:,:)
+      ELSE		
+         amp_pot(:,:,:) = 0._wp
+         phi_pot(:,:,:) = 0._wp	 
+      ENDIF
+      DO jk = 1, nb_harmo
+         zcons = rn_tide_gamma * tide_components(jk)%equitide * tide_harmonics(jk)%f
+         DO ji = 1, jpi
+            DO jj = 1, jpj
+               ztmp1 =  tide_harmonics(jk)%f * amp_pot(ji,jj,jk) * COS( phi_pot(ji,jj,jk) &
+                  &                                                   + tide_harmonics(jk)%v0 + tide_harmonics(jk)%u )
+               ztmp2 = -tide_harmonics(jk)%f * amp_pot(ji,jj,jk) * SIN( phi_pot(ji,jj,jk) &
+                  &                                                   + tide_harmonics(jk)%v0 + tide_harmonics(jk)%u )
+               zlat = gphit(ji,jj)*rad !! latitude en radian
+               zlon = glamt(ji,jj)*rad !! longitude en radian
+               ztmp = tide_harmonics(jk)%v0 + tide_harmonics(jk)%u + tide_components(jk)%nt * zlon
+               ! le potentiel est composé des effets des astres:
+               SELECT CASE( tide_components(jk)%nt )
+               CASE( 0 )                                                  !   long-periodic tidal constituents (included unless
+                  zcs = zcons * ( 0.5_wp - 1.5_wp * SIN( zlat )**2 )      !   compatibility with original formulation is requested)
+                  IF ( nn_tide_var < 1 ) zcs = 0.0_wp
+               CASE( 1 )                                                  !   diurnal tidal constituents
+                  zcs = zcons * SIN( 2.0_wp*zlat )
+               CASE( 2 )                                                  !   semi-diurnal tidal constituents
+                  zcs = zcons * COS( zlat )**2
+               CASE( 3 )                                                  !   Terdiurnal tidal constituents; the colatitude-dependent
+                  zcs = zcons * COS( zlat )**3                            !   factor is sin(theta)^3 (Table 2 of CT71)
+               CASE DEFAULT                                               !   constituents of higher frequency are not included
+                  zcs = 0.0_wp
+               END SELECT
+               ztmp1 = ztmp1 + zcs * COS( ztmp )
+               ztmp2 = ztmp2 - zcs * SIN( ztmp )
+               zamp = SQRT( ztmp1*ztmp1 + ztmp2*ztmp2 )
+               amp_pot(ji,jj,jk) = zamp
+               phi_pot(ji,jj,jk) = ATAN2( -ztmp2 / MAX( 1.e-10_wp , zamp ) ,   &
+                  &                        ztmp1 / MAX( 1.e-10_wp,  zamp )   )
+            END DO
+         END DO
+      END DO
+      !
+   END SUBROUTINE tide_init_potential
+
+
+   SUBROUTINE tide_init_load
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE tide_init_load  ***
+      !!----------------------------------------------------------------------
+      INTEGER :: inum                 ! Logical unit of input file
+      INTEGER :: ji, jj, itide        ! dummy loop indices
+      REAL(wp), DIMENSION(jpi,jpj) ::   ztr, zti   !: workspace to read in tidal harmonics data 
+      !!----------------------------------------------------------------------
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'tide_init_load : Initialization of load potential from file'
+         WRITE(numout,*) '~~~~~~~~~~~~~~ '
+      ENDIF
+      !
+      CALL iom_open ( cn_tide_load , inum )
+      !
+      DO itide = 1, nb_harmo
+         CALL iom_get  ( inum, jpdom_data,TRIM(tide_components(itide)%cname_tide)//'_z1', ztr(:,:) )
+         CALL iom_get  ( inum, jpdom_data,TRIM(tide_components(itide)%cname_tide)//'_z2', zti(:,:) )
+         !
+         DO ji=1,jpi
+            DO jj=1,jpj
+               amp_load(ji,jj,itide) =  SQRT( ztr(ji,jj)**2. + zti(ji,jj)**2. )
+               phi_load(ji,jj,itide) = ATAN2(-zti(ji,jj), ztr(ji,jj) )
+            END DO
+         END DO
+         !
+      END DO
+      CALL iom_close( inum )
+      !
+   END SUBROUTINE tide_init_load
+
+
+   SUBROUTINE tide_update( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE tide_update  ***
+      !!----------------------------------------------------------------------      
+      INTEGER, INTENT( in ) ::   kt     ! ocean time-step
+      INTEGER               ::   jk     ! dummy loop index
+      !!----------------------------------------------------------------------
+      
+      IF( nsec_day == NINT(0.5_wp * rn_Dt) .OR. kt == nit000 ) THEN      ! start a new day
+         !
+         CALL tide_harmo(tide_components, tide_harmonics, ndt05) ! Update oscillation parameters of tidal components for start of current day
+         !
+         !
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'tide_update : Update of the components and (re)Init. the potential at kt=', kt
+            WRITE(numout,*) '~~~~~~~~~~~ '
+            DO jk = 1, nb_harmo
+               WRITE(numout,*) tide_harmonics(jk)%cname_tide, tide_harmonics(jk)%u, &
+                  &            tide_harmonics(jk)%f,tide_harmonics(jk)%v0, tide_harmonics(jk)%omega
+            END DO
+         ENDIF
+         !
+         IF( ln_tide_pot )   CALL tide_init_potential
+         !
+         rn_tide_ramp_t = (kt - nit000)*rn_Dt !   Elapsed time in seconds
+      ENDIF
+      !
+   END SUBROUTINE tide_update
+
+
+   SUBROUTINE tide_harmo( ptide_comp, ptide_harmo, psec_day )
+      !
+      TYPE(tide),          DIMENSION(:), POINTER ::   ptide_comp   ! Array of selected tidal component parameters
+      TYPE(tide_harmonic), DIMENSION(:), POINTER ::   ptide_harmo  ! Oscillation parameters of selected tidal components
+      INTEGER, OPTIONAL ::   psec_day                              ! Number of seconds since the start of the current day
+      !
+      IF (PRESENT(psec_day)) THEN 
+         CALL astronomic_angle(psec_day)
+      ELSE
+         CALL astronomic_angle(nsec_day)
+      END IF
+      CALL tide_pulse( ptide_comp, ptide_harmo )
+      CALL tide_vuf(   ptide_comp, ptide_harmo )
+      !
+   END SUBROUTINE tide_harmo
+
+
+   SUBROUTINE astronomic_angle(psec_day)
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE astronomic_angle  ***
+      !!                      
+      !! ** Purpose : Compute astronomic angles
+      !!----------------------------------------------------------------------
+      INTEGER  ::   psec_day !   Number of seconds from midnight
+      REAL(wp) ::   zp, zq, zt2, zs2, ztgI2, zP1, ztgn2, zat1, zat2
+      REAL(wp) ::   zqy , zsy, zday, zdj, zhfrac, zt
+      !!----------------------------------------------------------------------
+      !
+      ! Computation of the time from 1 Jan 1900, 00h in years
+      zqy = AINT( (nyear - 1901.0_wp) / 4.0_wp )
+      zsy = nyear - 1900.0_wp
+      !
+      zdj  = dayjul( nyear, nmonth, nday )
+      zday = zdj + zqy - 1.0_wp
+      !
+      zhfrac = psec_day / 3600.0_wp
+      !
+      zt = zsy * 365.0_wp * 24.0_wp + zday * 24.0_wp + zhfrac
+      !
+      ! Longitude of ascending lunar node
+      sh_N  = ( rlon00_N  + romega_N * zt     ) * rad
+      sh_N = MOD( sh_N,  2*rpi )
+      ! Mean solar angle (Greenwhich time)
+      sh_T  = ( rlon00_T  + romega_T * zhfrac ) * rad
+      ! Mean solar Longitude
+      sh_h  = ( rlon00_h  + romega_h * zt     ) * rad
+      sh_h = MOD( sh_h,  2*rpi )
+      ! Mean lunar Longitude
+      sh_s  = ( rlon00_s  + romega_s * zt     ) * rad
+      sh_s = MOD( sh_s,  2*rpi )
+      ! Longitude of solar perigee
+      sh_p1 = ( rlon00_p1 + romega_p1 * zt    ) * rad
+      sh_p1= MOD( sh_p1, 2*rpi )
+      ! Longitude of lunar perigee
+      sh_p  = ( rlon00_p  + romega_p  * zt    ) * rad
+      sh_p = MOD( sh_p,  2*rpi )
+      !
+      ! Inclination of the orbit of the moon w.r.t. the celestial equator, see
+      ! explanation of Table 6 of S58
+      sh_I = ACOS( rcice - rsise * COS( sh_N ) )
+      !
+      ! Computation of sh_xi and sh_nu, see explanation of Table 6 of S58
+      ztgn2 = TAN( sh_N / 2.0_wp )
+      zat1 = ATAN( rxinu1 * ztgn2 )
+      zat2 = ATAN( rxinu2 * ztgn2 )
+      sh_xi = sh_N - zat1 - zat2
+      IF( sh_N > rpi ) sh_xi = sh_xi - 2.0_wp * rpi
+      sh_nu = zat1 - zat2
+      !
+      ! Computation of sh_x1ra, sh_R, sh_nuprim, and sh_nusec used for tidal
+      ! constituents L2, K1, and K2
+      !
+      ! Computation of sh_x1ra and sh_R (Equations 204, 213, and 214 of S58)
+      ztgI2 = tan( sh_I / 2.0_wp )
+      zP1   = sh_p - sh_xi
+      zt2   = ztgI2 * ztgI2
+      sh_x1ra = SQRT( 1.0 - 12.0 * zt2 * COS( 2.0_wp * zP1 ) + 36.0_wp * zt2 * zt2 )
+      zp = SIN( 2.0_wp * zP1 )
+      zq = 1.0_wp / ( 6.0_wp * zt2 ) - COS( 2.0_wp * zP1 )
+      sh_R = ATAN( zp / zq )
+      !
+      ! Computation of sh_nuprim (Equation 224 of S58)
+      zp = SIN( 2.0_wp * sh_I ) * SIN( sh_nu )
+      zq = SIN( 2.0_wp * sh_I ) * COS( sh_nu ) + 0.3347_wp
+      sh_nuprim = ATAN( zp / zq )
+      !
+      ! Computation of sh_nusec  (Equation 232 of S58)
+      zs2 = SIN( sh_I ) * SIN( sh_I )
+      zp  = zs2 * SIN( 2.0_wp * sh_nu )
+      zq  = zs2 * COS( 2.0_wp * sh_nu ) + 0.0727_wp
+      sh_nusec = 0.5_wp * ATAN( zp / zq )
+      !
+   END SUBROUTINE astronomic_angle
+
+
+   SUBROUTINE tide_pulse( ptide_comp, ptide_harmo )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE tide_pulse  ***
+      !!                      
+      !! ** Purpose : Compute tidal frequencies
+      !!----------------------------------------------------------------------
+      TYPE(tide),          DIMENSION(:), POINTER ::   ptide_comp   ! Array of selected tidal component parameters
+      TYPE(tide_harmonic), DIMENSION(:), POINTER ::   ptide_harmo  ! Oscillation parameters of selected tidal components
+      !
+      INTEGER  ::   jh
+      REAL(wp) ::   zscale
+      !!----------------------------------------------------------------------
+      !
+      zscale =  rad / 3600.0_wp
+      !
+      DO jh = 1, size(ptide_harmo)
+         ptide_harmo(jh)%omega = (  romega_T * ptide_comp( jh )%nT   &
+            &                     + romega_s * ptide_comp( jh )%ns   &
+            &                     + romega_h * ptide_comp( jh )%nh   &
+            &                     + romega_p * ptide_comp( jh )%np   &
+            &                     + romega_p1* ptide_comp( jh )%np1  ) * zscale
+      END DO
+      !
+   END SUBROUTINE tide_pulse
+
+
+   SUBROUTINE tide_vuf( ptide_comp, ptide_harmo )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE tide_vuf  ***
+      !!                      
+      !! ** Purpose : Compute nodal modulation corrections
+      !!
+      !! ** Outputs : vt: Phase of tidal potential relative to Greenwich (radians)
+      !!              ut: Phase correction u due to nodal motion (radians)
+      !!              ft: Nodal correction factor
+      !!----------------------------------------------------------------------
+      TYPE(tide),          DIMENSION(:), POINTER ::   ptide_comp   ! Array of selected tidal component parameters
+      TYPE(tide_harmonic), DIMENSION(:), POINTER ::   ptide_harmo  ! Oscillation parameters of selected tidal components
+      !
+      INTEGER ::   jh   ! dummy loop index
+      !!----------------------------------------------------------------------
+      !
+      DO jh = 1, size(ptide_harmo)
+         !  Phase of the tidal potential relative to the Greenwhich 
+         !  meridian (e.g. the position of the fictuous celestial body). Units are radian:
+         ptide_harmo(jh)%v0 = sh_T * ptide_comp( jh )%nT    &
+            &                   + sh_s * ptide_comp( jh )%ns    &
+            &                   + sh_h * ptide_comp( jh )%nh    &
+            &                   + sh_p * ptide_comp( jh )%np    &
+            &                   + sh_p1* ptide_comp( jh )%np1   &
+            &                   +        ptide_comp( jh )%shift * rad
+         !
+         !  Phase correction u due to nodal motion. Units are radian:
+         ptide_harmo(jh)%u = sh_xi     * ptide_comp( jh )%nksi   &
+            &                  + sh_nu     * ptide_comp( jh )%nnu0   &
+            &                  + sh_nuprim * ptide_comp( jh )%nnu1   &
+            &                  + sh_nusec  * ptide_comp( jh )%nnu2   &
+            &                  + sh_R      * ptide_comp( jh )%R
+
+         !  Nodal correction factor:
+         ptide_harmo(jh)%f = nodal_factort( ptide_comp( jh )%nformula )
+      END DO
+      !
+   END SUBROUTINE tide_vuf
+
+
+   RECURSIVE FUNCTION nodal_factort( kformula ) RESULT( zf )
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION nodal_factort  ***
+      !!
+      !! ** Purpose : Compute amplitude correction factors due to nodal motion
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kformula
+      !
+      REAL(wp)            ::   zf
+      REAL(wp)            ::   zs, zf1, zf2
+      CHARACTER(LEN=3)    ::   clformula
+      !!----------------------------------------------------------------------
+      !
+      SELECT CASE( kformula )
+      !
+      CASE( 0 )                  ! Formula 0, solar waves
+         zf = 1.0
+         !
+      CASE( 1 )                  ! Formula 1, compound waves (78 x 78)
+         zf=nodal_factort( 78 )
+         zf = zf * zf
+         !
+      CASE ( 4 )                 ! Formula 4,  compound waves (78 x 235) 
+         zf1 = nodal_factort( 78 )
+         zf  = nodal_factort(235)
+         zf  = zf1 * zf
+         !
+      CASE( 18 )                 ! Formula 18,  compound waves (78 x 78 x 78 )
+         zf1 = nodal_factort( 78 )
+         zf  = zf1 * zf1 * zf1
+         !
+      CASE( 20 )                 ! Formula 20, compound waves ( 78 x 78 x 78 x 78 )
+         zf1 = nodal_factort( 78 )
+         zf  = zf1 * zf1 * zf1 * zf1
+         !
+      CASE( 73 )                 ! Formula 73 of S58
+         zs = SIN( sh_I )
+         zf = ( 2.0_wp / 3.0_wp - zs * zs ) / 0.5021_wp
+         !
+      CASE( 74 )                 ! Formula 74 of S58
+         zs = SIN(sh_I)
+         zf = zs * zs / 0.1578_wp
+         !
+      CASE( 75 )                 ! Formula 75 of S58
+         zs = COS( sh_I / 2.0_wp )
+         zf = SIN( sh_I ) * zs * zs / 0.3800_wp
+         !
+      CASE( 76 )                 ! Formula 76 of S58
+         zf = SIN( 2.0_wp * sh_I ) / 0.7214_wp
+         !
+      CASE( 78 )                 ! Formula 78 of S58
+         zs = COS( sh_I/2 )
+         zf = zs * zs * zs * zs / 0.9154_wp
+         !
+      CASE( 149 )                ! Formula 149 of S58
+         zs = COS( sh_I/2 )
+         zf = zs * zs * zs * zs * zs * zs / 0.8758_wp
+         !
+      CASE( 215 )                ! Formula 215 of S58 with typo correction (0.9154 instead of 0.9145)
+         zs = COS( sh_I/2 )
+         zf = zs * zs * zs * zs / 0.9154_wp * sh_x1ra
+         !
+      CASE( 227 )                ! Formula 227 of S58
+         zs = SIN( 2.0_wp * sh_I )
+         zf = SQRT( 0.8965_wp * zs * zs + 0.6001_wp * zs * COS( sh_nu ) + 0.1006_wp )
+         !
+      CASE ( 235 )               ! Formula 235 of S58
+         zs = SIN( sh_I )
+         zf = SQRT( 19.0444_wp * zs * zs * zs * zs + 2.7702_wp * zs * zs * cos( 2.0_wp * sh_nu ) + 0.0981_wp )
+         !
+      CASE DEFAULT
+         WRITE( clformula, '(I3)' ) kformula
+         CALL ctl_stop('nodal_factort: formula ' // clformula // ' is not available')
+      END SELECT
+      !
+   END FUNCTION nodal_factort
+
+
+   FUNCTION dayjul( kyr, kmonth, kday )
+      !!----------------------------------------------------------------------
+      !!                   ***  FUNCTION dayjul  ***
+      !!
+      !! Purpose :  compute the Julian day
+      !!----------------------------------------------------------------------
+      INTEGER,INTENT(in)    ::   kyr, kmonth, kday
+      !
+      INTEGER,DIMENSION(12) ::   idayt = (/ 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334 /)
+      INTEGER,DIMENSION(12) ::   idays
+      INTEGER               ::   inc, ji, zyq
+      REAL(wp)              ::   dayjul
+      !!----------------------------------------------------------------------
+      !
+      idays(1) = 0
+      idays(2) = 31
+      inc = 0.0_wp
+      zyq = MOD( kyr - 1900 , 4 )
+      IF( zyq == 0 ) inc = 1
+      DO ji = 3, 12
+         idays(ji) = idayt(ji) + inc
+      END DO
+      dayjul = REAL( idays(kmonth) + kday, KIND=wp )
+      !
+   END FUNCTION dayjul
+
+
+   SUBROUTINE upd_tide(pdelta, Kmm)
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE upd_tide  ***
+      !!
+      !! ** Purpose :   provide at each time step the astronomical potential
+      !!
+      !! ** Method  :   computed from pulsation and amplitude of all tide components
+      !!
+      !! ** Action  :   pot_astro   actronomical potential
+      !!----------------------------------------------------------------------      
+      REAL, INTENT(in)              ::   pdelta      ! Temporal offset in seconds
+      INTEGER, INTENT(IN)           ::   Kmm         ! Time level index
+      INTEGER                       ::   jk          ! Dummy loop index
+      REAL(wp)                      ::   zt, zramp   ! Local scalars
+      REAL(wp), DIMENSION(nb_harmo) ::   zwt         ! Temporary array
+      !!----------------------------------------------------------------------      
+      !
+      zwt(:) = tide_harmonics(:)%omega * pdelta
+      !
+      IF( ln_tide_ramp ) THEN         ! linear increase if asked
+         zt = rn_tide_ramp_t + pdelta
+         zramp = MIN(  MAX( zt / (rn_tide_ramp_dt*rday) , 0._wp ) , 1._wp  )
+      ENDIF
+      !
+      pot_astro(:,:) = 0._wp          ! update tidal potential (sum of all harmonics)
+      DO jk = 1, nb_harmo
+         IF ( .NOT. ln_tide_dia ) THEN
+            pot_astro(:,:) = pot_astro(:,:) + amp_pot(:,:,jk) * COS( zwt(jk) + phi_pot(:,:,jk) )
+         ELSE
+            pot_astro_comp(:,:) = amp_pot(:,:,jk) * COS( zwt(jk) + phi_pot(:,:,jk) )
+            pot_astro(:,:) = pot_astro(:,:) + pot_astro_comp(:,:)
+            IF ( iom_use( "tide_pot_" // TRIM( tide_harmonics(jk)%cname_tide ) ) ) THEN   ! Output tidal potential (incl. load potential)
+               IF ( ln_tide_ramp ) pot_astro_comp(:,:) = zramp * pot_astro_comp(:,:)
+               CALL iom_put( "tide_pot_" // TRIM( tide_harmonics(jk)%cname_tide ), pot_astro_comp(:,:) )
+            END IF
+         END IF
+      END DO
+      !
+      IF ( ln_tide_ramp ) pot_astro(:,:) = zramp * pot_astro(:,:)
+      !
+      IF( ln_tide_dia ) THEN          ! Output total tidal potential (incl. load potential)
+         IF ( iom_use( "tide_pot" ) ) CALL iom_put( "tide_pot", pot_astro(:,:) + rn_scal_load * ssh(:,:,Kmm) )
+      END IF
+      !
+   END SUBROUTINE upd_tide
+
+   !!======================================================================
+END MODULE tide_mod
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/eosbn2.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/eosbn2.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/eosbn2.F90	(revision 12928)
@@ -29,5 +29,4 @@
    !!   eos_insitu_pot: Compute the insitu and surface referenced potential volumic mass
    !!   eos_insitu_2d : Compute the in situ density for 2d fields
-   !!   bn2           : Compute the Brunt-Vaisala frequency
    !!   bn2           : compute the Brunt-Vaisala frequency
    !!   eos_pt_from_ct: compute the potential temperature from the Conservative Temperature
@@ -180,5 +179,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -192,9 +191,9 @@
       !!                   ***  ROUTINE eos_insitu  ***
       !!
-      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) from
+      !! ** Purpose :   Compute the in situ density (ratio rho/rho0) from
       !!       potential temperature and salinity using an equation of state
       !!       selected in the nameos namelist
       !!
-      !! ** Method  :   prd(t,s,z) = ( rho(t,s,z) - rau0 ) / rau0
+      !! ** Method  :   prd(t,s,z) = ( rho(t,s,z) - rho0 ) / rho0
       !!         with   prd    in situ density anomaly      no units
       !!                t      TEOS10: CT or EOS80: PT      Celsius
@@ -202,5 +201,5 @@
       !!                z      depth                        meters
       !!                rho    in situ density              kg/m^3
-      !!                rau0   reference density            kg/m^3
+      !!                rho0   reference density            kg/m^3
       !!
       !!     ln_teos10 : polynomial TEOS-10 equation of state is used for rho(t,s,z).
@@ -211,5 +210,5 @@
       !!
       !!     ln_seos : simplified equation of state
-      !!              prd(t,s,z) = ( -a0*(1+lambda/2*(T-T0)+mu*z+nu*(S-S0))*(T-T0) + b0*(S-S0) ) / rau0
+      !!              prd(t,s,z) = ( -a0*(1+lambda/2*(T-T0)+mu*z+nu*(S-S0))*(T-T0) + b0*(S-S0) ) / rho0
       !!              linear case function of T only: rn_alpha<>0, other coefficients = 0
       !!              linear eos function of T and S: rn_alpha and rn_beta<>0, other coefficients=0
@@ -238,12 +237,116 @@
       CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
          !
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  !
-                  zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth
-                  zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature
-                  zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
-                  ztm = tmask(ji,jj,jk)                                         ! tmask
+         DO_3D_11_11( 1, jpkm1 )
+            !
+            zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth
+            zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature
+            zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
+            ztm = tmask(ji,jj,jk)                                         ! tmask
+            !
+            zn3 = EOS013*zt   &
+               &   + EOS103*zs+EOS003
+               !
+            zn2 = (EOS022*zt   &
+               &   + EOS112*zs+EOS012)*zt   &
+               &   + (EOS202*zs+EOS102)*zs+EOS002
+               !
+            zn1 = (((EOS041*zt   &
+               &   + EOS131*zs+EOS031)*zt   &
+               &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   &
+               &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   &
+               &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001
+               !
+            zn0 = (((((EOS060*zt   &
+               &   + EOS150*zs+EOS050)*zt   &
+               &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   &
+               &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   &
+               &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   &
+               &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   &
+               &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
+               !
+            zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+            !
+            prd(ji,jj,jk) = (  zn * r1_rho0 - 1._wp  ) * ztm  ! density anomaly (masked)
+            !
+         END_3D
+         !
+      CASE( np_seos )                !==  simplified EOS  ==!
+         !
+         DO_3D_11_11( 1, jpkm1 )
+            zt  = pts  (ji,jj,jk,jp_tem) - 10._wp
+            zs  = pts  (ji,jj,jk,jp_sal) - 35._wp
+            zh  = pdep (ji,jj,jk)
+            ztm = tmask(ji,jj,jk)
+            !
+            zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt   &
+               &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs   &
+               &  - rn_nu * zt * zs
+               !                                 
+            prd(ji,jj,jk) = zn * r1_rho0 * ztm                ! density anomaly (masked)
+         END_3D
+         !
+      END SELECT
+      !
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-insitu  : ', kdim=jpk )
+      !
+      IF( ln_timing )   CALL timing_stop('eos-insitu')
+      !
+   END SUBROUTINE eos_insitu
+
+
+   SUBROUTINE eos_insitu_pot( pts, prd, prhop, pdep )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE eos_insitu_pot  ***
+      !!
+      !! ** Purpose :   Compute the in situ density (ratio rho/rho0) and the
+      !!      potential volumic mass (Kg/m3) from potential temperature and
+      !!      salinity fields using an equation of state selected in the
+      !!     namelist.
+      !!
+      !! ** Action  : - prd  , the in situ density (no units)
+      !!              - prhop, the potential volumic mass (Kg/m3)
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius]
+      !                                                                ! 2 : salinity               [psu]
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd    ! in situ density            [-]
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prhop  ! potential density (surface referenced)
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pdep   ! depth                      [m]
+      !
+      INTEGER  ::   ji, jj, jk, jsmp             ! dummy loop indices
+      INTEGER  ::   jdof
+      REAL(wp) ::   zt , zh , zstemp, zs , ztm   ! local scalars
+      REAL(wp) ::   zn , zn0, zn1, zn2, zn3      !   -      -
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign    ! local vectors
+      !!----------------------------------------------------------------------
+      !
+      IF( ln_timing )   CALL timing_start('eos-pot')
+      !
+      SELECT CASE ( neos )
+      !
+      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
+         !
+         ! Stochastic equation of state
+         IF ( ln_sto_eos ) THEN
+            ALLOCATE(zn0_sto(1:2*nn_sto_eos))
+            ALLOCATE(zn_sto(1:2*nn_sto_eos))
+            ALLOCATE(zsign(1:2*nn_sto_eos))
+            DO jsmp = 1, 2*nn_sto_eos, 2
+              zsign(jsmp)   = 1._wp
+              zsign(jsmp+1) = -1._wp
+            END DO
+            !
+            DO_3D_11_11( 1, jpkm1 )
+               !
+               ! compute density (2*nn_sto_eos) times:
+               ! (1) for t+dt, s+ds (with the random TS fluctutation computed in sto_pts)
+               ! (2) for t-dt, s-ds (with the opposite fluctuation)
+               DO jsmp = 1, nn_sto_eos*2
+                  jdof   = (jsmp + 1) / 2
+                  zh     = pdep(ji,jj,jk) * r1_Z0                                  ! depth
+                  zt     = (pts (ji,jj,jk,jp_tem) + pts_ran(ji,jj,jk,jp_tem,jdof) * zsign(jsmp)) * r1_T0    ! temperature
+                  zstemp = pts  (ji,jj,jk,jp_sal) + pts_ran(ji,jj,jk,jp_sal,jdof) * zsign(jsmp)
+                  zs     = SQRT( ABS( zstemp + rdeltaS ) * r1_S0 )   ! square root salinity
+                  ztm    = tmask(ji,jj,jk)                                         ! tmask
                   !
                   zn3 = EOS013*zt   &
@@ -260,5 +363,5 @@
                      &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001
                      !
-                  zn0 = (((((EOS060*zt   &
+                  zn0_sto(jsmp) = (((((EOS060*zt   &
                      &   + EOS150*zs+EOS050)*zt   &
                      &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   &
@@ -268,242 +371,26 @@
                      &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
                      !
-                  zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+                  zn_sto(jsmp)  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0_sto(jsmp)
+               END DO
+               !
+               ! compute stochastic density as the mean of the (2*nn_sto_eos) densities
+               prhop(ji,jj,jk) = 0._wp ; prd(ji,jj,jk) = 0._wp
+               DO jsmp = 1, nn_sto_eos*2
+                  prhop(ji,jj,jk) = prhop(ji,jj,jk) + zn0_sto(jsmp)                      ! potential density referenced at the surface
                   !
-                  prd(ji,jj,jk) = (  zn * r1_rau0 - 1._wp  ) * ztm  ! density anomaly (masked)
-                  !
+                  prd(ji,jj,jk) = prd(ji,jj,jk) + (  zn_sto(jsmp) * r1_rho0 - 1._wp  )   ! density anomaly (masked)
                END DO
-            END DO
-         END DO
-         !
-      CASE( np_seos )                !==  simplified EOS  ==!
-         !
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zt  = pts  (ji,jj,jk,jp_tem) - 10._wp
-                  zs  = pts  (ji,jj,jk,jp_sal) - 35._wp
-                  zh  = pdep (ji,jj,jk)
-                  ztm = tmask(ji,jj,jk)
-                  !
-                  zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt   &
-                     &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs   &
-                     &  - rn_nu * zt * zs
-                     !                                 
-                  prd(ji,jj,jk) = zn * r1_rau0 * ztm                ! density anomaly (masked)
-               END DO
-            END DO
-         END DO
-         !
-      END SELECT
-      !
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-insitu  : ', kdim=jpk )
-      !
-      IF( ln_timing )   CALL timing_stop('eos-insitu')
-      !
-   END SUBROUTINE eos_insitu
-
-
-   SUBROUTINE eos_insitu_pot( pts, prd, prhop, pdep )
-      !!----------------------------------------------------------------------
-      !!                  ***  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 selected in the
-      !!     namelist.
-      !!
-      !! ** Action  : - prd  , the in situ density (no units)
-      !!              - prhop, the potential volumic mass (Kg/m3)
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius]
-      !                                                                ! 2 : salinity               [psu]
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd    ! in situ density            [-]
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prhop  ! potential density (surface referenced)
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pdep   ! depth                      [m]
-      !
-      INTEGER  ::   ji, jj, jk, jsmp             ! dummy loop indices
-      INTEGER  ::   jdof
-      REAL(wp) ::   zt , zh , zstemp, zs , ztm   ! local scalars
-      REAL(wp) ::   zn , zn0, zn1, zn2, zn3      !   -      -
-      REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign    ! local vectors
-      !!----------------------------------------------------------------------
-      !
-      IF( ln_timing )   CALL timing_start('eos-pot')
-      !
-      SELECT CASE ( neos )
-      !
-      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
-         !
-         ! Stochastic equation of state
-         IF ( ln_sto_eos ) THEN
-            ALLOCATE(zn0_sto(1:2*nn_sto_eos))
-            ALLOCATE(zn_sto(1:2*nn_sto_eos))
-            ALLOCATE(zsign(1:2*nn_sto_eos))
-            DO jsmp = 1, 2*nn_sto_eos, 2
-              zsign(jsmp)   = 1._wp
-              zsign(jsmp+1) = -1._wp
-            END DO
-            !
-            DO jk = 1, jpkm1
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     !
-                     ! compute density (2*nn_sto_eos) times:
-                     ! (1) for t+dt, s+ds (with the random TS fluctutation computed in sto_pts)
-                     ! (2) for t-dt, s-ds (with the opposite fluctuation)
-                     DO jsmp = 1, nn_sto_eos*2
-                        jdof   = (jsmp + 1) / 2
-                        zh     = pdep(ji,jj,jk) * r1_Z0                                  ! depth
-                        zt     = (pts (ji,jj,jk,jp_tem) + pts_ran(ji,jj,jk,jp_tem,jdof) * zsign(jsmp)) * r1_T0    ! temperature
-                        zstemp = pts  (ji,jj,jk,jp_sal) + pts_ran(ji,jj,jk,jp_sal,jdof) * zsign(jsmp)
-                        zs     = SQRT( ABS( zstemp + rdeltaS ) * r1_S0 )   ! square root salinity
-                        ztm    = tmask(ji,jj,jk)                                         ! tmask
-                        !
-                        zn3 = EOS013*zt   &
-                           &   + EOS103*zs+EOS003
-                           !
-                        zn2 = (EOS022*zt   &
-                           &   + EOS112*zs+EOS012)*zt   &
-                           &   + (EOS202*zs+EOS102)*zs+EOS002
-                           !
-                        zn1 = (((EOS041*zt   &
-                           &   + EOS131*zs+EOS031)*zt   &
-                           &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   &
-                           &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   &
-                           &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001
-                           !
-                        zn0_sto(jsmp) = (((((EOS060*zt   &
-                           &   + EOS150*zs+EOS050)*zt   &
-                           &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   &
-                           &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   &
-                           &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   &
-                           &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   &
-                           &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
-                           !
-                        zn_sto(jsmp)  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0_sto(jsmp)
-                     END DO
-                     !
-                     ! compute stochastic density as the mean of the (2*nn_sto_eos) densities
-                     prhop(ji,jj,jk) = 0._wp ; prd(ji,jj,jk) = 0._wp
-                     DO jsmp = 1, nn_sto_eos*2
-                        prhop(ji,jj,jk) = prhop(ji,jj,jk) + zn0_sto(jsmp)                      ! potential density referenced at the surface
-                        !
-                        prd(ji,jj,jk) = prd(ji,jj,jk) + (  zn_sto(jsmp) * r1_rau0 - 1._wp  )   ! density anomaly (masked)
-                     END DO
-                     prhop(ji,jj,jk) = 0.5_wp * prhop(ji,jj,jk) * ztm / nn_sto_eos
-                     prd  (ji,jj,jk) = 0.5_wp * prd  (ji,jj,jk) * ztm / nn_sto_eos
-                  END DO
-               END DO
-            END DO
+               prhop(ji,jj,jk) = 0.5_wp * prhop(ji,jj,jk) * ztm / nn_sto_eos
+               prd  (ji,jj,jk) = 0.5_wp * prd  (ji,jj,jk) * ztm / nn_sto_eos
+            END_3D
             DEALLOCATE(zn0_sto,zn_sto,zsign)
          ! Non-stochastic equation of state
          ELSE
-            DO jk = 1, jpkm1
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     !
-                     zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth
-                     zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature
-                     zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
-                     ztm = tmask(ji,jj,jk)                                         ! tmask
-                     !
-                     zn3 = EOS013*zt   &
-                        &   + EOS103*zs+EOS003
-                        !
-                     zn2 = (EOS022*zt   &
-                        &   + EOS112*zs+EOS012)*zt   &
-                        &   + (EOS202*zs+EOS102)*zs+EOS002
-                        !
-                     zn1 = (((EOS041*zt   &
-                        &   + EOS131*zs+EOS031)*zt   &
-                        &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   &
-                        &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   &
-                        &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001
-                        !
-                     zn0 = (((((EOS060*zt   &
-                        &   + EOS150*zs+EOS050)*zt   &
-                        &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   &
-                        &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   &
-                        &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   &
-                        &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   &
-                        &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
-                        !
-                     zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
-                     !
-                     prhop(ji,jj,jk) = zn0 * ztm                           ! potential density referenced at the surface
-                     !
-                     prd(ji,jj,jk) = (  zn * r1_rau0 - 1._wp  ) * ztm      ! density anomaly (masked)
-                  END DO
-               END DO
-            END DO
-         ENDIF
-         
-      CASE( np_seos )                !==  simplified EOS  ==!
-         !
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zt  = pts  (ji,jj,jk,jp_tem) - 10._wp
-                  zs  = pts  (ji,jj,jk,jp_sal) - 35._wp
-                  zh  = pdep (ji,jj,jk)
-                  ztm = tmask(ji,jj,jk)
-                  !                                                     ! potential density referenced at the surface
-                  zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt   &
-                     &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs   &
-                     &  - rn_nu * zt * zs
-                  prhop(ji,jj,jk) = ( rau0 + zn ) * ztm
-                  !                                                     ! density anomaly (masked)
-                  zn = zn - ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zh
-                  prd(ji,jj,jk) = zn * r1_rau0 * ztm
-                  !
-               END DO
-            END DO
-         END DO
-         !
-      END SELECT
-      !
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', tab3d_2=prhop, clinfo2=' pot : ', kdim=jpk )
-      !
-      IF( ln_timing )   CALL timing_stop('eos-pot')
-      !
-   END SUBROUTINE eos_insitu_pot
-
-
-   SUBROUTINE eos_insitu_2d( pts, 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
-      !!      selected in the nameos namelist. * 2D field case
-      !!
-      !! ** Action  : - prd , the in situ density (no units) (unmasked)
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius]
-      !                                                           ! 2 : salinity               [psu]
-      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(in   ) ::   pdep  ! depth                      [m]
-      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(  out) ::   prd   ! in situ density
-      !
-      INTEGER  ::   ji, jj, jk                ! dummy loop indices
-      REAL(wp) ::   zt , zh , zs              ! local scalars
-      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      -
-      !!----------------------------------------------------------------------
-      !
-      IF( ln_timing )   CALL timing_start('eos2d')
-      !
-      prd(:,:) = 0._wp
-      !
-      SELECT CASE( neos )
-      !
-      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
-         !
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               !
-               zh  = pdep(ji,jj) * r1_Z0                                  ! depth
-               zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature
-               zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
+            DO_3D_11_11( 1, jpkm1 )
+               !
+               zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth
+               zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature
+               zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
+               ztm = tmask(ji,jj,jk)                                         ! tmask
                !
                zn3 = EOS013*zt   &
@@ -530,34 +417,118 @@
                zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
                !
-               prd(ji,jj) = zn * r1_rau0 - 1._wp               ! unmasked in situ density anomaly
-               !
-            END DO
-         END DO
-         !
-         CALL lbc_lnk( 'eosbn2', prd, 'T', 1. )                    ! Lateral boundary conditions
-         !
+               prhop(ji,jj,jk) = zn0 * ztm                           ! potential density referenced at the surface
+               !
+               prd(ji,jj,jk) = (  zn * r1_rho0 - 1._wp  ) * ztm      ! density anomaly (masked)
+            END_3D
+         ENDIF
+         
       CASE( np_seos )                !==  simplified EOS  ==!
          !
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               !
-               zt    = pts  (ji,jj,jp_tem)  - 10._wp
-               zs    = pts  (ji,jj,jp_sal)  - 35._wp
-               zh    = pdep (ji,jj)                         ! depth at the partial step level
-               !
-               zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt   &
-                  &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs   &
-                  &  - rn_nu * zt * zs
-                  !
-               prd(ji,jj) = zn * r1_rau0               ! unmasked in situ density anomaly
-               !
-            END DO
-         END DO
-         !
-         CALL lbc_lnk( 'eosbn2', prd, 'T', 1. )                    ! Lateral boundary conditions
+         DO_3D_11_11( 1, jpkm1 )
+            zt  = pts  (ji,jj,jk,jp_tem) - 10._wp
+            zs  = pts  (ji,jj,jk,jp_sal) - 35._wp
+            zh  = pdep (ji,jj,jk)
+            ztm = tmask(ji,jj,jk)
+            !                                                     ! potential density referenced at the surface
+            zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt   &
+               &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs   &
+               &  - rn_nu * zt * zs
+            prhop(ji,jj,jk) = ( rho0 + zn ) * ztm
+            !                                                     ! density anomaly (masked)
+            zn = zn - ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zh
+            prd(ji,jj,jk) = zn * r1_rho0 * ztm
+            !
+         END_3D
          !
       END SELECT
       !
-      IF(ln_ctl)   CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', tab3d_2=prhop, clinfo2=' pot : ', kdim=jpk )
+      !
+      IF( ln_timing )   CALL timing_stop('eos-pot')
+      !
+   END SUBROUTINE eos_insitu_pot
+
+
+   SUBROUTINE eos_insitu_2d( pts, pdep, prd )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE eos_insitu_2d  ***
+      !!
+      !! ** Purpose :   Compute the in situ density (ratio rho/rho0) from
+      !!      potential temperature and salinity using an equation of state
+      !!      selected in the nameos namelist. * 2D field case
+      !!
+      !! ** Action  : - prd , the in situ density (no units) (unmasked)
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius]
+      !                                                           ! 2 : salinity               [psu]
+      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(in   ) ::   pdep  ! depth                      [m]
+      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(  out) ::   prd   ! in situ density
+      !
+      INTEGER  ::   ji, jj, jk                ! dummy loop indices
+      REAL(wp) ::   zt , zh , zs              ! local scalars
+      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      -
+      !!----------------------------------------------------------------------
+      !
+      IF( ln_timing )   CALL timing_start('eos2d')
+      !
+      prd(:,:) = 0._wp
+      !
+      SELECT CASE( neos )
+      !
+      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
+         !
+         DO_2D_11_11
+            !
+            zh  = pdep(ji,jj) * r1_Z0                                  ! depth
+            zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature
+            zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
+            !
+            zn3 = EOS013*zt   &
+               &   + EOS103*zs+EOS003
+               !
+            zn2 = (EOS022*zt   &
+               &   + EOS112*zs+EOS012)*zt   &
+               &   + (EOS202*zs+EOS102)*zs+EOS002
+               !
+            zn1 = (((EOS041*zt   &
+               &   + EOS131*zs+EOS031)*zt   &
+               &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   &
+               &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   &
+               &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001
+               !
+            zn0 = (((((EOS060*zt   &
+               &   + EOS150*zs+EOS050)*zt   &
+               &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   &
+               &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   &
+               &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   &
+               &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   &
+               &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
+               !
+            zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+            !
+            prd(ji,jj) = zn * r1_rho0 - 1._wp               ! unmasked in situ density anomaly
+            !
+         END_2D
+         !
+      CASE( np_seos )                !==  simplified EOS  ==!
+         !
+         DO_2D_11_11
+            !
+            zt    = pts  (ji,jj,jp_tem)  - 10._wp
+            zs    = pts  (ji,jj,jp_sal)  - 35._wp
+            zh    = pdep (ji,jj)                         ! depth at the partial step level
+            !
+            zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt   &
+               &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs   &
+               &  - rn_nu * zt * zs
+               !
+            prd(ji,jj) = zn * r1_rho0               ! unmasked in situ density anomaly
+            !
+         END_2D
+         !
+      END SELECT
+      !
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' )
       !
       IF( ln_timing )   CALL timing_stop('eos2d')
@@ -566,5 +537,5 @@
 
 
-   SUBROUTINE rab_3d( pts, pab )
+   SUBROUTINE rab_3d( pts, pab, Kmm )
       !!----------------------------------------------------------------------
       !!                 ***  ROUTINE rab_3d  ***
@@ -576,4 +547,5 @@
       !! ** Action  : - pab     : thermal/haline expansion ratio at T-points
       !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::   Kmm   ! time level index
       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! pot. temperature & salinity
       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   pab   ! thermal/haline expansion ratio
@@ -590,78 +562,70 @@
       CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
          !
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  !
-                  zh  = gdept_n(ji,jj,jk) * r1_Z0                                ! depth
-                  zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature
-                  zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
-                  ztm = tmask(ji,jj,jk)                                         ! tmask
-                  !
-                  ! alpha
-                  zn3 = ALP003
-                  !
-                  zn2 = ALP012*zt + ALP102*zs+ALP002
-                  !
-                  zn1 = ((ALP031*zt   &
-                     &   + ALP121*zs+ALP021)*zt   &
-                     &   + (ALP211*zs+ALP111)*zs+ALP011)*zt   &
-                     &   + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001
-                     !
-                  zn0 = ((((ALP050*zt   &
-                     &   + ALP140*zs+ALP040)*zt   &
-                     &   + (ALP230*zs+ALP130)*zs+ALP030)*zt   &
-                     &   + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt   &
-                     &   + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt   &
-                     &   + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000
-                     !
-                  zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
-                  !
-                  pab(ji,jj,jk,jp_tem) = zn * r1_rau0 * ztm
-                  !
-                  ! beta
-                  zn3 = BET003
-                  !
-                  zn2 = BET012*zt + BET102*zs+BET002
-                  !
-                  zn1 = ((BET031*zt   &
-                     &   + BET121*zs+BET021)*zt   &
-                     &   + (BET211*zs+BET111)*zs+BET011)*zt   &
-                     &   + ((BET301*zs+BET201)*zs+BET101)*zs+BET001
-                     !
-                  zn0 = ((((BET050*zt   &
-                     &   + BET140*zs+BET040)*zt   &
-                     &   + (BET230*zs+BET130)*zs+BET030)*zt   &
-                     &   + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt   &
-                     &   + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt   &
-                     &   + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000
-                     !
-                  zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
-                  !
-                  pab(ji,jj,jk,jp_sal) = zn / zs * r1_rau0 * ztm
-                  !
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, jpkm1 )
+            !
+            zh  = gdept(ji,jj,jk,Kmm) * r1_Z0                                ! depth
+            zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature
+            zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
+            ztm = tmask(ji,jj,jk)                                         ! tmask
+            !
+            ! alpha
+            zn3 = ALP003
+            !
+            zn2 = ALP012*zt + ALP102*zs+ALP002
+            !
+            zn1 = ((ALP031*zt   &
+               &   + ALP121*zs+ALP021)*zt   &
+               &   + (ALP211*zs+ALP111)*zs+ALP011)*zt   &
+               &   + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001
+               !
+            zn0 = ((((ALP050*zt   &
+               &   + ALP140*zs+ALP040)*zt   &
+               &   + (ALP230*zs+ALP130)*zs+ALP030)*zt   &
+               &   + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt   &
+               &   + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt   &
+               &   + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000
+               !
+            zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+            !
+            pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm
+            !
+            ! beta
+            zn3 = BET003
+            !
+            zn2 = BET012*zt + BET102*zs+BET002
+            !
+            zn1 = ((BET031*zt   &
+               &   + BET121*zs+BET021)*zt   &
+               &   + (BET211*zs+BET111)*zs+BET011)*zt   &
+               &   + ((BET301*zs+BET201)*zs+BET101)*zs+BET001
+               !
+            zn0 = ((((BET050*zt   &
+               &   + BET140*zs+BET040)*zt   &
+               &   + (BET230*zs+BET130)*zs+BET030)*zt   &
+               &   + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt   &
+               &   + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt   &
+               &   + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000
+               !
+            zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+            !
+            pab(ji,jj,jk,jp_sal) = zn / zs * r1_rho0 * ztm
+            !
+         END_3D
          !
       CASE( np_seos )                  !==  simplified EOS  ==!
          !
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zt  = pts (ji,jj,jk,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0)
-                  zs  = pts (ji,jj,jk,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0)
-                  zh  = gdept_n(ji,jj,jk)                ! depth in meters at t-point
-                  ztm = tmask(ji,jj,jk)                  ! land/sea bottom mask = surf. mask
-                  !
-                  zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs
-                  pab(ji,jj,jk,jp_tem) = zn * r1_rau0 * ztm   ! alpha
-                  !
-                  zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt
-                  pab(ji,jj,jk,jp_sal) = zn * r1_rau0 * ztm   ! beta
-                  !
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, jpkm1 )
+            zt  = pts (ji,jj,jk,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0)
+            zs  = pts (ji,jj,jk,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0)
+            zh  = gdept(ji,jj,jk,Kmm)                ! depth in meters at t-point
+            ztm = tmask(ji,jj,jk)                  ! land/sea bottom mask = surf. mask
+            !
+            zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs
+            pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm   ! alpha
+            !
+            zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt
+            pab(ji,jj,jk,jp_sal) = zn * r1_rho0 * ztm   ! beta
+            !
+         END_3D
          !
       CASE DEFAULT
@@ -671,6 +635,6 @@
       END SELECT
       !
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pab(:,:,:,jp_tem), clinfo1=' rab_3d_t: ', &
-         &                       tab3d_2=pab(:,:,:,jp_sal), clinfo2=' rab_3d_s : ', kdim=jpk )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pab(:,:,:,jp_tem), clinfo1=' rab_3d_t: ', &
+         &                                  tab3d_2=pab(:,:,:,jp_sal), clinfo2=' rab_3d_s : ', kdim=jpk )
       !
       IF( ln_timing )   CALL timing_stop('rab_3d')
@@ -679,5 +643,5 @@
 
 
-   SUBROUTINE rab_2d( pts, pdep, pab )
+   SUBROUTINE rab_2d( pts, pdep, pab, Kmm )
       !!----------------------------------------------------------------------
       !!                 ***  ROUTINE rab_2d  ***
@@ -687,4 +651,5 @@
       !! ** Action  : - pab     : thermal/haline expansion ratio at T-points
       !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::   Kmm   ! time level index
       REAL(wp), DIMENSION(jpi,jpj,jpts)    , INTENT(in   ) ::   pts    ! pot. temperature & salinity
       REAL(wp), DIMENSION(jpi,jpj)         , INTENT(in   ) ::   pdep   ! depth                  [m]
@@ -704,78 +669,70 @@
       CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
          !
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               !
-               zh  = pdep(ji,jj) * r1_Z0                                  ! depth
-               zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature
-               zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
-               !
-               ! alpha
-               zn3 = ALP003
-               !
-               zn2 = ALP012*zt + ALP102*zs+ALP002
-               !
-               zn1 = ((ALP031*zt   &
-                  &   + ALP121*zs+ALP021)*zt   &
-                  &   + (ALP211*zs+ALP111)*zs+ALP011)*zt   &
-                  &   + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001
-                  !
-               zn0 = ((((ALP050*zt   &
-                  &   + ALP140*zs+ALP040)*zt   &
-                  &   + (ALP230*zs+ALP130)*zs+ALP030)*zt   &
-                  &   + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt   &
-                  &   + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt   &
-                  &   + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000
-                  !
-               zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
-               !
-               pab(ji,jj,jp_tem) = zn * r1_rau0
-               !
-               ! beta
-               zn3 = BET003
-               !
-               zn2 = BET012*zt + BET102*zs+BET002
-               !
-               zn1 = ((BET031*zt   &
-                  &   + BET121*zs+BET021)*zt   &
-                  &   + (BET211*zs+BET111)*zs+BET011)*zt   &
-                  &   + ((BET301*zs+BET201)*zs+BET101)*zs+BET001
-                  !
-               zn0 = ((((BET050*zt   &
-                  &   + BET140*zs+BET040)*zt   &
-                  &   + (BET230*zs+BET130)*zs+BET030)*zt   &
-                  &   + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt   &
-                  &   + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt   &
-                  &   + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000
-                  !
-               zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
-               !
-               pab(ji,jj,jp_sal) = zn / zs * r1_rau0
-               !
-               !
-            END DO
-         END DO
-         !                            ! Lateral boundary conditions
-         CALL lbc_lnk_multi( 'eosbn2', pab(:,:,jp_tem), 'T', 1. , pab(:,:,jp_sal), 'T', 1. )                    
+         DO_2D_11_11
+            !
+            zh  = pdep(ji,jj) * r1_Z0                                  ! depth
+            zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature
+            zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
+            !
+            ! alpha
+            zn3 = ALP003
+            !
+            zn2 = ALP012*zt + ALP102*zs+ALP002
+            !
+            zn1 = ((ALP031*zt   &
+               &   + ALP121*zs+ALP021)*zt   &
+               &   + (ALP211*zs+ALP111)*zs+ALP011)*zt   &
+               &   + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001
+               !
+            zn0 = ((((ALP050*zt   &
+               &   + ALP140*zs+ALP040)*zt   &
+               &   + (ALP230*zs+ALP130)*zs+ALP030)*zt   &
+               &   + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt   &
+               &   + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt   &
+               &   + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000
+               !
+            zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+            !
+            pab(ji,jj,jp_tem) = zn * r1_rho0
+            !
+            ! beta
+            zn3 = BET003
+            !
+            zn2 = BET012*zt + BET102*zs+BET002
+            !
+            zn1 = ((BET031*zt   &
+               &   + BET121*zs+BET021)*zt   &
+               &   + (BET211*zs+BET111)*zs+BET011)*zt   &
+               &   + ((BET301*zs+BET201)*zs+BET101)*zs+BET001
+               !
+            zn0 = ((((BET050*zt   &
+               &   + BET140*zs+BET040)*zt   &
+               &   + (BET230*zs+BET130)*zs+BET030)*zt   &
+               &   + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt   &
+               &   + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt   &
+               &   + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000
+               !
+            zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+            !
+            pab(ji,jj,jp_sal) = zn / zs * r1_rho0
+            !
+            !
+         END_2D
          !
       CASE( np_seos )                  !==  simplified EOS  ==!
          !
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               !
-               zt    = pts  (ji,jj,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0)
-               zs    = pts  (ji,jj,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0)
-               zh    = pdep (ji,jj)                   ! depth at the partial step level
-               !
-               zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs
-               pab(ji,jj,jp_tem) = zn * r1_rau0   ! alpha
-               !
-               zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt
-               pab(ji,jj,jp_sal) = zn * r1_rau0   ! beta
-               !
-            END DO
-         END DO
-         !                            ! Lateral boundary conditions
-         CALL lbc_lnk_multi( 'eosbn2', pab(:,:,jp_tem), 'T', 1. , pab(:,:,jp_sal), 'T', 1. )                    
+         DO_2D_11_11
+            !
+            zt    = pts  (ji,jj,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0)
+            zs    = pts  (ji,jj,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0)
+            zh    = pdep (ji,jj)                   ! depth at the partial step level
+            !
+            zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs
+            pab(ji,jj,jp_tem) = zn * r1_rho0   ! alpha
+            !
+            zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt
+            pab(ji,jj,jp_sal) = zn * r1_rho0   ! beta
+            !
+         END_2D
          !
       CASE DEFAULT
@@ -785,6 +742,6 @@
       END SELECT
       !
-      IF(ln_ctl)   CALL prt_ctl( tab2d_1=pab(:,:,jp_tem), clinfo1=' rab_2d_t: ', &
-         &                       tab2d_2=pab(:,:,jp_sal), clinfo2=' rab_2d_s : ' )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=pab(:,:,jp_tem), clinfo1=' rab_2d_t: ', &
+         &                                  tab2d_2=pab(:,:,jp_sal), clinfo2=' rab_2d_s : ' )
       !
       IF( ln_timing )   CALL timing_stop('rab_2d')
@@ -793,5 +750,5 @@
 
 
-   SUBROUTINE rab_0d( pts, pdep, pab )
+   SUBROUTINE rab_0d( pts, pdep, pab, Kmm )
       !!----------------------------------------------------------------------
       !!                 ***  ROUTINE rab_0d  ***
@@ -801,4 +758,5 @@
       !! ** Action  : - pab     : thermal/haline expansion ratio at T-points
       !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::   Kmm   ! time level index
       REAL(wp), DIMENSION(jpts)    , INTENT(in   ) ::   pts    ! pot. temperature & salinity
       REAL(wp),                      INTENT(in   ) ::   pdep   ! depth                  [m]
@@ -841,5 +799,5 @@
          zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
          !
-         pab(jp_tem) = zn * r1_rau0
+         pab(jp_tem) = zn * r1_rho0
          !
          ! beta
@@ -862,5 +820,5 @@
          zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
          !
-         pab(jp_sal) = zn / zs * r1_rau0
+         pab(jp_sal) = zn / zs * r1_rho0
          !
          !
@@ -873,8 +831,8 @@
          !
          zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs
-         pab(jp_tem) = zn * r1_rau0   ! alpha
+         pab(jp_tem) = zn * r1_rho0   ! alpha
          !
          zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt
-         pab(jp_sal) = zn * r1_rau0   ! beta
+         pab(jp_sal) = zn * r1_rho0   ! beta
          !
       CASE DEFAULT
@@ -889,5 +847,5 @@
 
 
-   SUBROUTINE bn2( pts, pab, pn2 )
+   SUBROUTINE bn2( pts, pab, pn2, Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE bn2  ***
@@ -903,4 +861,5 @@
       !!
       !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::   Kmm   ! time level index
       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pts   ! pot. temperature and salinity   [Celsius,psu]
       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pab   ! thermal/haline expansion coef.  [Celsius-1,psu-1]
@@ -913,21 +872,17 @@
       IF( ln_timing )   CALL timing_start('bn2')
       !
-      DO jk = 2, jpkm1           ! interior points only (2=< jk =< jpkm1 )
-         DO jj = 1, jpj          ! surface and bottom value set to zero one for all in istate.F90
-            DO ji = 1, jpi
-               zrw =   ( gdepw_n(ji,jj,jk  ) - gdept_n(ji,jj,jk) )   &
-                  &  / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) ) 
-                  !
-               zaw = pab(ji,jj,jk,jp_tem) * (1. - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw 
-               zbw = pab(ji,jj,jk,jp_sal) * (1. - zrw) + pab(ji,jj,jk-1,jp_sal) * zrw
-               !
-               pn2(ji,jj,jk) = grav * (  zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) )     &
-                  &                    - zbw * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )  )  &
-                  &            / e3w_n(ji,jj,jk) * wmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-      !
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2  : ', kdim=jpk )
+      DO_3D_11_11( 2, jpkm1 )
+         zrw =   ( gdepw(ji,jj,jk  ,Kmm) - gdept(ji,jj,jk,Kmm) )   &
+            &  / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) ) 
+            !
+         zaw = pab(ji,jj,jk,jp_tem) * (1. - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw 
+         zbw = pab(ji,jj,jk,jp_sal) * (1. - zrw) + pab(ji,jj,jk-1,jp_sal) * zrw
+         !
+         pn2(ji,jj,jk) = grav * (  zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) )     &
+            &                    - zbw * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )  )  &
+            &            / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk)
+      END_3D
+      !
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2  : ', kdim=jpk )
       !
       IF( ln_timing )   CALL timing_stop('bn2')
@@ -965,28 +920,26 @@
       z1_T0   = 1._wp/40._wp
       !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            !
-            zt  = ctmp   (ji,jj) * z1_T0
-            zs  = SQRT( ABS( psal(ji,jj) + zdeltaS ) * r1_S0 )
-            ztm = tmask(ji,jj,1)
-            !
-            zn = ((((-2.1385727895e-01_wp*zt   &
-               &   - 2.7674419971e-01_wp*zs+1.0728094330_wp)*zt   &
-               &   + (2.6366564313_wp*zs+3.3546960647_wp)*zs-7.8012209473_wp)*zt   &
-               &   + ((1.8835586562_wp*zs+7.3949191679_wp)*zs-3.3937395875_wp)*zs-5.6414948432_wp)*zt   &
-               &   + (((3.5737370589_wp*zs-1.5512427389e+01_wp)*zs+2.4625741105e+01_wp)*zs   &
-               &      +1.9912291000e+01_wp)*zs-3.2191146312e+01_wp)*zt   &
-               &   + ((((5.7153204649e-01_wp*zs-3.0943149543_wp)*zs+9.3052495181_wp)*zs   &
-               &      -9.4528934807_wp)*zs+3.1066408996_wp)*zs-4.3504021262e-01_wp
-               !
-            zd = (2.0035003456_wp*zt   &
-               &   -3.4570358592e-01_wp*zs+5.6471810638_wp)*zt   &
-               &   + (1.5393993508_wp*zs-6.9394762624_wp)*zs+1.2750522650e+01_wp
-               !
-            ptmp(ji,jj) = ( zt / z1_T0 + zn / zd ) * ztm
-               !
-         END DO
-      END DO
+      DO_2D_11_11
+         !
+         zt  = ctmp   (ji,jj) * z1_T0
+         zs  = SQRT( ABS( psal(ji,jj) + zdeltaS ) * r1_S0 )
+         ztm = tmask(ji,jj,1)
+         !
+         zn = ((((-2.1385727895e-01_wp*zt   &
+            &   - 2.7674419971e-01_wp*zs+1.0728094330_wp)*zt   &
+            &   + (2.6366564313_wp*zs+3.3546960647_wp)*zs-7.8012209473_wp)*zt   &
+            &   + ((1.8835586562_wp*zs+7.3949191679_wp)*zs-3.3937395875_wp)*zs-5.6414948432_wp)*zt   &
+            &   + (((3.5737370589_wp*zs-1.5512427389e+01_wp)*zs+2.4625741105e+01_wp)*zs   &
+            &      +1.9912291000e+01_wp)*zs-3.2191146312e+01_wp)*zt   &
+            &   + ((((5.7153204649e-01_wp*zs-3.0943149543_wp)*zs+9.3052495181_wp)*zs   &
+            &      -9.4528934807_wp)*zs+3.1066408996_wp)*zs-4.3504021262e-01_wp
+            !
+         zd = (2.0035003456_wp*zt   &
+            &   -3.4570358592e-01_wp*zs+5.6471810638_wp)*zt   &
+            &   + (1.5393993508_wp*zs-6.9394762624_wp)*zs+1.2750522650e+01_wp
+            !
+         ptmp(ji,jj) = ( zt / z1_T0 + zn / zd ) * ztm
+            !
+      END_2D
       !
       IF( ln_timing )   CALL timing_stop('eos_pt_from_ct')
@@ -1020,11 +973,9 @@
          !
          z1_S0 = 1._wp / 35.16504_wp
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zs= SQRT( ABS( psal(ji,jj) ) * z1_S0 )           ! square root salinity
-               ptf(ji,jj) = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs &
-                  &          - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp
-            END DO
-         END DO
+         DO_2D_11_11
+            zs= SQRT( ABS( psal(ji,jj) ) * z1_S0 )           ! square root salinity
+            ptf(ji,jj) = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs &
+               &          - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp
+         END_2D
          ptf(:,:) = ptf(:,:) * psal(:,:)
          !
@@ -1093,5 +1044,5 @@
 
 
-   SUBROUTINE eos_pen( pts, pab_pe, ppen )
+   SUBROUTINE eos_pen( pts, pab_pe, ppen, Kmm )
       !!----------------------------------------------------------------------
       !!                 ***  ROUTINE eos_pen  ***
@@ -1101,10 +1052,10 @@
       !! ** Method  :   PE is defined analytically as the vertical 
       !!                   primitive of EOS times -g integrated between 0 and z>0.
-      !!                pen is the nonlinear bsq-PE anomaly: pen = ( PE - rau0 gz ) / rau0 gz - rd
+      !!                pen is the nonlinear bsq-PE anomaly: pen = ( PE - rho0 gz ) / rho0 gz - rd
       !!                                                      = 1/z * /int_0^z rd dz - rd 
       !!                                where rd is the density anomaly (see eos_rhd function)
       !!                ab_pe are partial derivatives of PE anomaly with respect to T and S:
-      !!                    ab_pe(1) = - 1/(rau0 gz) * dPE/dT + drd/dT = - d(pen)/dT
-      !!                    ab_pe(2) =   1/(rau0 gz) * dPE/dS + drd/dS =   d(pen)/dS
+      !!                    ab_pe(1) = - 1/(rho0 gz) * dPE/dT + drd/dT = - d(pen)/dT
+      !!                    ab_pe(2) =   1/(rho0 gz) * dPE/dS + drd/dS =   d(pen)/dS
       !!
       !! ** Action  : - pen         : PE anomaly given at T-points
@@ -1113,4 +1064,5 @@
       !!                    pab_pe(:,:,:,jp_sal) is beta_pe
       !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::   Kmm   ! time level index
       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts     ! pot. temperature & salinity
       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   pab_pe  ! alpha_pe and beta_pe
@@ -1128,84 +1080,76 @@
       CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
          !
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  !
-                  zh  = gdept_n(ji,jj,jk) * r1_Z0                                ! depth
-                  zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature
-                  zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
-                  ztm = tmask(ji,jj,jk)                                         ! tmask
-                  !
-                  ! potential energy non-linear anomaly
-                  zn2 = (PEN012)*zt   &
-                     &   + PEN102*zs+PEN002
-                     !
-                  zn1 = ((PEN021)*zt   &
-                     &   + PEN111*zs+PEN011)*zt   &
-                     &   + (PEN201*zs+PEN101)*zs+PEN001
-                     !
-                  zn0 = ((((PEN040)*zt   &
-                     &   + PEN130*zs+PEN030)*zt   &
-                     &   + (PEN220*zs+PEN120)*zs+PEN020)*zt   &
-                     &   + ((PEN310*zs+PEN210)*zs+PEN110)*zs+PEN010)*zt   &
-                     &   + (((PEN400*zs+PEN300)*zs+PEN200)*zs+PEN100)*zs+PEN000
-                     !
-                  zn  = ( zn2 * zh + zn1 ) * zh + zn0
-                  !
-                  ppen(ji,jj,jk)  = zn * zh * r1_rau0 * ztm
-                  !
-                  ! alphaPE non-linear anomaly
-                  zn2 = APE002
-                  !
-                  zn1 = (APE011)*zt   &
-                     &   + APE101*zs+APE001
-                     !
-                  zn0 = (((APE030)*zt   &
-                     &   + APE120*zs+APE020)*zt   &
-                     &   + (APE210*zs+APE110)*zs+APE010)*zt   &
-                     &   + ((APE300*zs+APE200)*zs+APE100)*zs+APE000
-                     !
-                  zn  = ( zn2 * zh + zn1 ) * zh + zn0
-                  !                              
-                  pab_pe(ji,jj,jk,jp_tem) = zn * zh * r1_rau0 * ztm
-                  !
-                  ! betaPE non-linear anomaly
-                  zn2 = BPE002
-                  !
-                  zn1 = (BPE011)*zt   &
-                     &   + BPE101*zs+BPE001
-                     !
-                  zn0 = (((BPE030)*zt   &
-                     &   + BPE120*zs+BPE020)*zt   &
-                     &   + (BPE210*zs+BPE110)*zs+BPE010)*zt   &
-                     &   + ((BPE300*zs+BPE200)*zs+BPE100)*zs+BPE000
-                     !
-                  zn  = ( zn2 * zh + zn1 ) * zh + zn0
-                  !                              
-                  pab_pe(ji,jj,jk,jp_sal) = zn / zs * zh * r1_rau0 * ztm
-                  !
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, jpkm1 )
+            !
+            zh  = gdept(ji,jj,jk,Kmm) * r1_Z0                                ! depth
+            zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature
+            zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
+            ztm = tmask(ji,jj,jk)                                         ! tmask
+            !
+            ! potential energy non-linear anomaly
+            zn2 = (PEN012)*zt   &
+               &   + PEN102*zs+PEN002
+               !
+            zn1 = ((PEN021)*zt   &
+               &   + PEN111*zs+PEN011)*zt   &
+               &   + (PEN201*zs+PEN101)*zs+PEN001
+               !
+            zn0 = ((((PEN040)*zt   &
+               &   + PEN130*zs+PEN030)*zt   &
+               &   + (PEN220*zs+PEN120)*zs+PEN020)*zt   &
+               &   + ((PEN310*zs+PEN210)*zs+PEN110)*zs+PEN010)*zt   &
+               &   + (((PEN400*zs+PEN300)*zs+PEN200)*zs+PEN100)*zs+PEN000
+               !
+            zn  = ( zn2 * zh + zn1 ) * zh + zn0
+            !
+            ppen(ji,jj,jk)  = zn * zh * r1_rho0 * ztm
+            !
+            ! alphaPE non-linear anomaly
+            zn2 = APE002
+            !
+            zn1 = (APE011)*zt   &
+               &   + APE101*zs+APE001
+               !
+            zn0 = (((APE030)*zt   &
+               &   + APE120*zs+APE020)*zt   &
+               &   + (APE210*zs+APE110)*zs+APE010)*zt   &
+               &   + ((APE300*zs+APE200)*zs+APE100)*zs+APE000
+               !
+            zn  = ( zn2 * zh + zn1 ) * zh + zn0
+            !                              
+            pab_pe(ji,jj,jk,jp_tem) = zn * zh * r1_rho0 * ztm
+            !
+            ! betaPE non-linear anomaly
+            zn2 = BPE002
+            !
+            zn1 = (BPE011)*zt   &
+               &   + BPE101*zs+BPE001
+               !
+            zn0 = (((BPE030)*zt   &
+               &   + BPE120*zs+BPE020)*zt   &
+               &   + (BPE210*zs+BPE110)*zs+BPE010)*zt   &
+               &   + ((BPE300*zs+BPE200)*zs+BPE100)*zs+BPE000
+               !
+            zn  = ( zn2 * zh + zn1 ) * zh + zn0
+            !                              
+            pab_pe(ji,jj,jk,jp_sal) = zn / zs * zh * r1_rho0 * ztm
+            !
+         END_3D
          !
       CASE( np_seos )                !==  Vallis (2006) simplified EOS  ==!
          !
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zt  = pts(ji,jj,jk,jp_tem) - 10._wp  ! temperature anomaly (t-T0)
-                  zs = pts (ji,jj,jk,jp_sal) - 35._wp  ! abs. salinity anomaly (s-S0)
-                  zh  = gdept_n(ji,jj,jk)              ! depth in meters  at t-point
-                  ztm = tmask(ji,jj,jk)                ! tmask
-                  zn  = 0.5_wp * zh * r1_rau0 * ztm
-                  !                                    ! Potential Energy
-                  ppen(ji,jj,jk) = ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zn
-                  !                                    ! alphaPE
-                  pab_pe(ji,jj,jk,jp_tem) = - rn_a0 * rn_mu1 * zn
-                  pab_pe(ji,jj,jk,jp_sal) =   rn_b0 * rn_mu2 * zn
-                  !
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, jpkm1 )
+            zt  = pts(ji,jj,jk,jp_tem) - 10._wp  ! temperature anomaly (t-T0)
+            zs = pts (ji,jj,jk,jp_sal) - 35._wp  ! abs. salinity anomaly (s-S0)
+            zh  = gdept(ji,jj,jk,Kmm)              ! depth in meters  at t-point
+            ztm = tmask(ji,jj,jk)                ! tmask
+            zn  = 0.5_wp * zh * r1_rho0 * ztm
+            !                                    ! Potential Energy
+            ppen(ji,jj,jk) = ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zn
+            !                                    ! alphaPE
+            pab_pe(ji,jj,jk,jp_tem) = - rn_a0 * rn_mu1 * zn
+            pab_pe(ji,jj,jk,jp_sal) =   rn_b0 * rn_mu2 * zn
+            !
+         END_3D
          !
       CASE DEFAULT
@@ -1235,14 +1179,12 @@
       !!----------------------------------------------------------------------
       !
-      REWIND( numnam_ref )              ! Namelist nameos in reference namelist : equation of state
       READ  ( numnam_ref, nameos, IOSTAT = ios, ERR = 901 )
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nameos in reference namelist' )
       !
-      REWIND( numnam_cfg )              ! Namelist nameos in configuration namelist : equation of state
       READ  ( numnam_cfg, nameos, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nameos in configuration namelist' )
       IF(lwm) WRITE( numond, nameos )
       !
-      rau0        = 1026._wp                 !: volumic mass of reference     [kg/m3]
+      rho0        = 1026._wp                 !: volumic mass of reference     [kg/m3]
       rcp         = 3991.86795711963_wp      !: heat capacity     [J/K]
       !
@@ -1656,5 +1598,5 @@
             WRITE(numout,*) '   ==>>>   use of simplified eos:    '
             WRITE(numout,*) '              rhd(dT=T-10,dS=S-35,Z) = [-a0*(1+lambda1/2*dT+mu1*Z)*dT '
-            WRITE(numout,*) '                                       + b0*(1+lambda2/2*dT+mu2*Z)*dS - nu*dT*dS] / rau0'
+            WRITE(numout,*) '                                       + b0*(1+lambda2/2*dT+mu2*Z)*dS - nu*dT*dS] / rho0'
             WRITE(numout,*) '              with the following coefficients :'
             WRITE(numout,*) '                 thermal exp. coef.    rn_a0      = ', rn_a0
@@ -1675,8 +1617,8 @@
       END SELECT
       !
-      rau0_rcp    = rau0 * rcp 
-      r1_rau0     = 1._wp / rau0
+      rho0_rcp    = rho0 * rcp 
+      r1_rho0     = 1._wp / rho0
       r1_rcp      = 1._wp / rcp
-      r1_rau0_rcp = 1._wp / rau0_rcp 
+      r1_rho0_rcp = 1._wp / rho0_rcp 
       !
       IF(lwp) THEN
@@ -1693,9 +1635,9 @@
       IF(lwp) WRITE(numout,*)
       IF(lwp) WRITE(numout,*) '   Associated physical constant'
-      IF(lwp) WRITE(numout,*) '      volumic mass of reference           rau0  = ', rau0   , ' kg/m^3'
-      IF(lwp) WRITE(numout,*) '      1. / rau0                        r1_rau0  = ', r1_rau0, ' m^3/kg'
+      IF(lwp) WRITE(numout,*) '      volumic mass of reference           rho0  = ', rho0   , ' kg/m^3'
+      IF(lwp) WRITE(numout,*) '      1. / rho0                        r1_rho0  = ', r1_rho0, ' m^3/kg'
       IF(lwp) WRITE(numout,*) '      ocean specific heat                 rcp   = ', rcp    , ' J/Kelvin'
-      IF(lwp) WRITE(numout,*) '      rau0 * rcp                       rau0_rcp = ', rau0_rcp
-      IF(lwp) WRITE(numout,*) '      1. / ( rau0 * rcp )           r1_rau0_rcp = ', r1_rau0_rcp
+      IF(lwp) WRITE(numout,*) '      rho0 * rcp                       rho0_rcp = ', rho0_rcp
+      IF(lwp) WRITE(numout,*) '      1. / ( rho0 * rcp )           r1_rho0_rcp = ', r1_rho0_rcp
       !
    END SUBROUTINE eos_init
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traadv.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traadv.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traadv.F90	(revision 12928)
@@ -66,6 +66,4 @@
    INTEGER, PARAMETER ::   np_QCK     = 5   ! QUICK scheme
    
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -75,5 +73,5 @@
 CONTAINS
 
-   SUBROUTINE tra_adv( kt )
+   SUBROUTINE tra_adv( kt, Kbb, Kmm, pts, Krhs )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_adv  ***
@@ -81,10 +79,12 @@
       !! ** Purpose :   compute the ocean tracer advection trend.
       !!
-      !! ** Method  : - Update (ua,va) with the advection term following nadv
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !! ** Method  : - Update (uu(:,:,:,Krhs),vv(:,:,:,Krhs)) with the advection term following nadv
+      !!----------------------------------------------------------------------
+      INTEGER                                  , INTENT(in)    :: kt             ! ocean time-step index
+      INTEGER                                  , INTENT(in)    :: Kbb, Kmm, Krhs ! time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts            ! active tracers and RHS of tracer equation
       !
       INTEGER ::   jk   ! dummy loop index
-      REAL(wp), DIMENSION(jpi,jpj,jpk)        :: zun, zvn, zwn   ! 3D workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk)        :: zuu, zvv, zww   ! 3D workspace
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt, ztrds
       !!----------------------------------------------------------------------
@@ -92,53 +92,49 @@
       IF( ln_timing )   CALL timing_start('tra_adv')
       !
-      !                                          ! set time step
-      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dt =         rdt   ! at nit000             (Euler)
-      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dt = 2._wp * rdt   ! at nit000 or nit000+1 (Leapfrog)
-      ENDIF
-      !
       !                                         !==  effective transport  ==!
-      zun(:,:,jpk) = 0._wp
-      zvn(:,:,jpk) = 0._wp
-      zwn(:,:,jpk) = 0._wp
+      zuu(:,:,jpk) = 0._wp
+      zvv(:,:,jpk) = 0._wp
+      zww(:,:,jpk) = 0._wp
       IF( ln_wave .AND. ln_sdw )  THEN
          DO jk = 1, jpkm1                                                       ! eulerian transport + Stokes Drift
-            zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * ( un(:,:,jk) + usd(:,:,jk) )
-            zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * ( vn(:,:,jk) + vsd(:,:,jk) )
-            zwn(:,:,jk) = e1e2t(:,:)                 * ( wn(:,:,jk) + wsd(:,:,jk) )
+            zuu(:,:,jk) = e2u  (:,:) * e3u(:,:,jk,Kmm) * ( uu(:,:,jk,Kmm) + usd(:,:,jk) )
+            zvv(:,:,jk) = e1v  (:,:) * e3v(:,:,jk,Kmm) * ( vv(:,:,jk,Kmm) + vsd(:,:,jk) )
+            zww(:,:,jk) = e1e2t(:,:)                 * ( ww(:,:,jk) + wsd(:,:,jk) )
          END DO
       ELSE
          DO jk = 1, jpkm1
-            zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * un(:,:,jk)               ! eulerian transport only
-            zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * vn(:,:,jk)
-            zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk)
+            zuu(:,:,jk) = e2u  (:,:) * e3u(:,:,jk,Kmm) * uu(:,:,jk,Kmm)               ! eulerian transport only
+            zvv(:,:,jk) = e1v  (:,:) * e3v(:,:,jk,Kmm) * vv(:,:,jk,Kmm)
+            zww(:,:,jk) = e1e2t(:,:)                 * ww(:,:,jk)
          END DO
       ENDIF
       !
       IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                ! add z-tilde and/or vvl corrections
-         zun(:,:,:) = zun(:,:,:) + un_td(:,:,:)
-         zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:)
-      ENDIF
-      !
-      zun(:,:,jpk) = 0._wp                                                      ! no transport trough the bottom
-      zvn(:,:,jpk) = 0._wp
-      zwn(:,:,jpk) = 0._wp
+         zuu(:,:,:) = zuu(:,:,:) + un_td(:,:,:)
+         zvv(:,:,:) = zvv(:,:,:) + vn_td(:,:,:)
+      ENDIF
+      !
+      zuu(:,:,jpk) = 0._wp                                                      ! no transport trough the bottom
+      zvv(:,:,jpk) = 0._wp
+      zww(:,:,jpk) = 0._wp
       !
       IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   &
-         &              CALL ldf_eiv_trp( kt, nit000, zun, zvn, zwn, 'TRA' )   ! add the eiv transport (if necessary)
-      !
-      IF( ln_mle    )   CALL tra_mle_trp( kt, nit000, zun, zvn, zwn, 'TRA' )   ! add the mle transport (if necessary)
-      !
-      CALL iom_put( "uocetr_eff", zun )                                        ! output effective transport      
-      CALL iom_put( "vocetr_eff", zvn )
-      CALL iom_put( "wocetr_eff", zwn )
+         &              CALL ldf_eiv_trp( kt, nit000, zuu, zvv, zww, 'TRA', Kmm, Krhs )   ! add the eiv transport (if necessary)
+      !
+      IF( ln_mle    )   CALL tra_mle_trp( kt, nit000, zuu, zvv, zww, 'TRA', Kmm       )   ! add the mle transport (if necessary)
+      !
+      CALL iom_put( "uocetr_eff", zuu )                                        ! output effective transport      
+      CALL iom_put( "vocetr_eff", zvv )
+      CALL iom_put( "wocetr_eff", zww )
       !
 !!gm ???
-      IF( ln_diaptr )   CALL dia_ptr( zvn )                                    ! diagnose the effective MSF 
+      CALL dia_ptr( kt, Kmm, zvv )                                    ! diagnose the effective MSF 
 !!gm ???
       !
+
       IF( l_trdtra )   THEN                    !* Save ta and sa trends
          ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) )
-         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
-         ztrds(:,:,:) = tsa(:,:,:,jp_sal)
+         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs)
+         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs)
       ENDIF
       !
@@ -146,13 +142,13 @@
       !
       CASE ( np_CEN )                                 ! Centered scheme : 2nd / 4th order
-         CALL tra_adv_cen    ( kt, nit000, 'TRA',         zun, zvn, zwn     , tsn, tsa, jpts, nn_cen_h, nn_cen_v )
+         CALL tra_adv_cen    ( kt, nit000, 'TRA',         zuu, zvv, zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v )
       CASE ( np_FCT )                                 ! FCT scheme      : 2nd / 4th order
-         CALL tra_adv_fct    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts, nn_fct_h, nn_fct_v )
+         CALL tra_adv_fct    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v )
       CASE ( np_MUS )                                 ! MUSCL
-         CALL tra_adv_mus    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb,      tsa, jpts        , ln_mus_ups ) 
+         CALL tra_adv_mus    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) 
       CASE ( np_UBS )                                 ! UBS
-         CALL tra_adv_ubs    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts        , nn_ubs_v   )
+         CALL tra_adv_ubs    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_ubs_v   )
       CASE ( np_QCK )                                 ! QUICKEST
-         CALL tra_adv_qck    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts                     )
+         CALL tra_adv_qck    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs )
       !
       END SELECT
@@ -160,14 +156,14 @@
       IF( l_trdtra )   THEN                      ! save the advective trends for further diagnostics
          DO jk = 1, jpkm1
-            ztrdt(:,:,jk) = tsa(:,:,jk,jp_tem) - ztrdt(:,:,jk)
-            ztrds(:,:,jk) = tsa(:,:,jk,jp_sal) - ztrds(:,:,jk)
+            ztrdt(:,:,jk) = pts(:,:,jk,jp_tem,Krhs) - ztrdt(:,:,jk)
+            ztrds(:,:,jk) = pts(:,:,jk,jp_sal,Krhs) - ztrds(:,:,jk)
          END DO
-         CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrdt )
-         CALL trd_tra( kt, 'TRA', jp_sal, jptra_totad, ztrds )
+         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_totad, ztrdt )
+         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_totad, ztrds )
          DEALLOCATE( ztrdt, ztrds )
       ENDIF
       !                                              ! print mean trends (used for debugging)
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv  - Ta: ', mask1=tmask,               &
-         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' adv  - Ta: ', mask1=tmask,               &
+         &                                  tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
       !
       IF( ln_timing )   CALL timing_stop( 'tra_adv' )
@@ -194,9 +190,7 @@
       !
       !                                !==  Namelist  ==!
-      REWIND( numnam_ref )                   ! Namelist namtra_adv in reference namelist : Tracer advection scheme
       READ  ( numnam_ref, namtra_adv, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_adv in reference namelist' )
       !
-      REWIND( numnam_cfg )                   ! Namelist namtra_adv in configuration namelist : Tracer advection scheme
       READ  ( numnam_cfg, namtra_adv, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_adv in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traadv_cen.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traadv_cen.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traadv_cen.F90	(revision 12928)
@@ -36,5 +36,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -44,6 +44,6 @@
 CONTAINS
 
-   SUBROUTINE tra_adv_cen( kt, kit000, cdtype, pun, pvn, pwn,     &
-      &                                        ptn, pta, kjpt, kn_cen_h, kn_cen_v ) 
+   SUBROUTINE tra_adv_cen( kt, kit000, cdtype, pU, pV, pW,     &
+      &                    Kmm, pt, kjpt, Krhs, kn_cen_h, kn_cen_v ) 
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_adv_cen  ***
@@ -59,17 +59,17 @@
       !!                = 4  ==>> 4th order COMPACT  scheme     -      -
       !!
-      !! ** Action : - update pta  with the now advective tracer trends
+      !! ** Action : - update pt(:,:,:,:,Krhs)  with the now advective tracer trends
       !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T)
-      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T)
+      !!             - poleward advective heat and salt transport (l_diaptr=T)
       !!----------------------------------------------------------------------
-      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
-      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
-      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
-      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
-      INTEGER                              , INTENT(in   ) ::   kn_cen_h        ! =2/4 (2nd or 4th order scheme)
-      INTEGER                              , INTENT(in   ) ::   kn_cen_v        ! =2/4 (2nd or 4th order scheme)
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptn             ! now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      INTEGER                                  , INTENT(in   ) ::   kt              ! ocean time-step index
+      INTEGER                                  , INTENT(in   ) ::   Kmm, Krhs       ! ocean time level indices
+      INTEGER                                  , INTENT(in   ) ::   kit000          ! first time step index
+      CHARACTER(len=3)                         , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER                                  , INTENT(in   ) ::   kjpt            ! number of tracers
+      INTEGER                                  , INTENT(in   ) ::   kn_cen_h        ! =2/4 (2nd or 4th order scheme)
+      INTEGER                                  , INTENT(in   ) ::   kn_cen_v        ! =2/4 (2nd or 4th order scheme)
+      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation
       !
       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
@@ -89,8 +89,8 @@
       l_hst = .FALSE.
       l_ptr = .FALSE.
-      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )        l_trd = .TRUE.
-      IF(   cdtype == 'TRA' .AND. ln_diaptr )                                                 l_ptr = .TRUE. 
+      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )       l_trd = .TRUE.
+      IF(   cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) )  )    l_ptr = .TRUE. 
       IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
-         &                          iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )   l_hst = .TRUE.
+         &                          iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )  l_hst = .TRUE.
       !
       !                    
@@ -103,40 +103,28 @@
          !
          CASE(  2  )                         !* 2nd order centered
-            DO jk = 1, jpkm1
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1   ! vector opt.
-                     zwx(ji,jj,jk) = 0.5_wp * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn) )
-                     zwy(ji,jj,jk) = 0.5_wp * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn) )
-                  END DO
-               END DO
-            END DO
+            DO_3D_10_10( 1, jpkm1 )
+               zwx(ji,jj,jk) = 0.5_wp * pU(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm) )
+               zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm) )
+            END_3D
             !
          CASE(  4  )                         !* 4th order centered
             ztu(:,:,jpk) = 0._wp                   ! Bottom value : flux set to zero
             ztv(:,:,jpk) = 0._wp
-            DO jk = 1, jpkm1                       ! masked gradient
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ztu(ji,jj,jk) = ( ptn(ji+1,jj  ,jk,jn) - ptn(ji,jj,jk,jn) ) * umask(ji,jj,jk)
-                     ztv(ji,jj,jk) = ( ptn(ji  ,jj+1,jk,jn) - ptn(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
+            DO_3D_00_00( 1, jpkm1 )
+               ztu(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk)
+               ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk)
+            END_3D
             CALL lbc_lnk_multi( 'traadv_cen', ztu, 'U', -1. , ztv, 'V', -1. )   ! Lateral boundary cond.
             !
-            DO jk = 1, jpkm1                       ! Horizontal advective fluxes
-               DO jj = 2, jpjm1
-                  DO ji = 1, fs_jpim1   ! vector opt.
-                     zC2t_u = ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn)   ! C2 interpolation of T at u- & v-points (x2)
-                     zC2t_v = ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn)
-                     !                                                  ! C4 interpolation of T at u- & v-points (x2)
-                     zC4t_u =  zC2t_u + r1_6 * ( ztu(ji-1,jj,jk) - ztu(ji+1,jj,jk) )
-                     zC4t_v =  zC2t_v + r1_6 * ( ztv(ji,jj-1,jk) - ztv(ji,jj+1,jk) )
-                     !                                                  ! C4 fluxes
-                     zwx(ji,jj,jk) =  0.5_wp * pun(ji,jj,jk) * zC4t_u
-                     zwy(ji,jj,jk) =  0.5_wp * pvn(ji,jj,jk) * zC4t_v
-                  END DO
-               END DO
-            END DO         
+            DO_3D_00_10( 1, jpkm1 )
+               zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm)   ! C2 interpolation of T at u- & v-points (x2)
+               zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm)
+               !                                                  ! C4 interpolation of T at u- & v-points (x2)
+               zC4t_u =  zC2t_u + r1_6 * ( ztu(ji-1,jj,jk) - ztu(ji+1,jj,jk) )
+               zC4t_v =  zC2t_v + r1_6 * ( ztv(ji,jj-1,jk) - ztv(ji,jj+1,jk) )
+               !                                                  ! C4 fluxes
+               zwx(ji,jj,jk) =  0.5_wp * pU(ji,jj,jk) * zC4t_u
+               zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * zC4t_v
+            END_3D
             !
          CASE DEFAULT
@@ -147,21 +135,13 @@
          !
          CASE(  2  )                         !* 2nd order centered
-            DO jk = 2, jpk
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
+            DO_3D_00_00( 2, jpk )
+               zwz(ji,jj,jk) = 0.5 * pW(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) ) * wmask(ji,jj,jk)
+            END_3D
             !
          CASE(  4  )                         !* 4th order compact
-            CALL interp_4th_cpt( ptn(:,:,:,jn) , ztw )      ! ztw = interpolated value of T at w-point
-            DO jk = 2, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     zwz(ji,jj,jk) = pwn(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
+            CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw )      ! ztw = interpolated value of T at w-point
+            DO_3D_00_00( 2, jpkm1 )
+               zwz(ji,jj,jk) = pW(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk)
+            END_3D
             !
          END SELECT
@@ -169,29 +149,23 @@
          IF( ln_linssh ) THEN                !* top value   (linear free surf. only as zwz is multiplied by wmask)
             IF( ln_isfcav ) THEN                  ! ice-shelf cavities (top of the ocean)
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptn(ji,jj,mikt(ji,jj),jn) 
-                  END DO
-               END DO   
+               DO_2D_11_11
+                  zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kmm) 
+               END_2D
             ELSE                                   ! no ice-shelf cavities (only ocean surface)
-               zwz(:,:,1) = pwn(:,:,1) * ptn(:,:,1,jn)
+               zwz(:,:,1) = pW(:,:,1) * pt(:,:,1,jn,Kmm)
             ENDIF
          ENDIF
          !               
-         DO jk = 1, jpkm1              !--  Divergence of advective fluxes  --!
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn)    &
-                     &             - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )    &
-                     &                + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )    &
-                     &                + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)  ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs)    &
+               &             - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )    &
+               &                + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )    &
+               &                + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)  ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+         END_3D
          !                             ! trend diagnostics
          IF( l_trd ) THEN
-            CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) )
-            CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) )
-            CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pwn, ptn(:,:,:,jn) )
+            CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, zwx, pU, pt(:,:,:,jn,Kmm) )
+            CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, pt(:,:,:,jn,Kmm) )
+            CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwz, pW, pt(:,:,:,jn,Kmm) )
          END IF
          !                                 ! "Poleward" heat and salt transports 
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traadv_fct.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traadv_fct.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traadv_fct.F90	(revision 12928)
@@ -20,5 +20,5 @@
    USE diaptr         ! poleward transport diagnostics
    USE diaar5         ! AR5 diagnostics
-   USE phycst  , ONLY : rau0_rcp
+   USE phycst  , ONLY : rho0_rcp
    USE zdf_oce , ONLY : ln_zad_Aimp
    !
@@ -45,5 +45,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -53,6 +53,6 @@
 CONTAINS
 
-   SUBROUTINE tra_adv_fct( kt, kit000, cdtype, p2dt, pun, pvn, pwn,       &
-      &                                              ptb, ptn, pta, kjpt, kn_fct_h, kn_fct_v )
+   SUBROUTINE tra_adv_fct( kt, kit000, cdtype, p2dt, pU, pV, pW,       &
+      &                    Kbb, Kmm, pt, kjpt, Krhs, kn_fct_h, kn_fct_v )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_adv_fct  ***
@@ -66,18 +66,18 @@
       !!               - corrected flux (monotonic correction) 
       !!
-      !! ** Action : - update pta  with the now advective tracer trends
+      !! ** Action : - update pt(:,:,:,:,Krhs)  with the now advective tracer trends
       !!             - send trends to trdtra module for further diagnostics (l_trdtra=T)
-      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T)
-      !!----------------------------------------------------------------------
-      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
-      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
-      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
-      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
-      INTEGER                              , INTENT(in   ) ::   kn_fct_h        ! order of the FCT scheme (=2 or 4)
-      INTEGER                              , INTENT(in   ) ::   kn_fct_v        ! order of the FCT scheme (=2 or 4)
-      REAL(wp)                             , INTENT(in   ) ::   p2dt            ! tracer time-step
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      !!             - poleward advective heat and salt transport (ln_diaptr=T)
+      !!----------------------------------------------------------------------
+      INTEGER                                  , INTENT(in   ) ::   kt              ! ocean time-step index
+      INTEGER                                  , INTENT(in   ) ::   Kbb, Kmm, Krhs  ! ocean time level indices
+      INTEGER                                  , INTENT(in   ) ::   kit000          ! first time step index
+      CHARACTER(len=3)                         , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER                                  , INTENT(in   ) ::   kjpt            ! number of tracers
+      INTEGER                                  , INTENT(in   ) ::   kn_fct_h        ! order of the FCT scheme (=2 or 4)
+      INTEGER                                  , INTENT(in   ) ::   kn_fct_v        ! order of the FCT scheme (=2 or 4)
+      REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation
       !
       INTEGER  ::   ji, jj, jk, jn                           ! dummy loop indices  
@@ -101,7 +101,7 @@
       l_ptr = .FALSE.
       ll_zAimp = .FALSE.
-      IF( ( cdtype =='TRA' .AND. l_trdtra  ) .OR. ( cdtype =='TRC' .AND. l_trdtrc ) )       l_trd = .TRUE.
-      IF(   cdtype =='TRA' .AND. ln_diaptr )                                                l_ptr = .TRUE. 
-      IF(   cdtype =='TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR.  &
+      IF( ( cdtype == 'TRA' .AND. l_trdtra  ) .OR. ( cdtype =='TRC' .AND. l_trdtrc ) )      l_trd = .TRUE.
+      IF(   cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) )    l_ptr = .TRUE. 
+      IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR.  &
          &                         iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )  l_hst = .TRUE.
       !
@@ -128,13 +128,9 @@
       IF( ll_zAimp ) THEN
          ALLOCATE(zwdia(jpi,jpj,jpk), zwinf(jpi,jpj,jpk),zwsup(jpi,jpj,jpk))
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt. (ensure same order of calculation as below if wi=0.)
-                  zwdia(ji,jj,jk) =  1._wp + p2dt * ( MAX( wi(ji,jj,jk  ) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) ) / e3t_a(ji,jj,jk)
-                  zwinf(ji,jj,jk) =  p2dt * MIN( wi(ji,jj,jk  ) , 0._wp ) / e3t_a(ji,jj,jk)
-                  zwsup(ji,jj,jk) = -p2dt * MAX( wi(ji,jj,jk+1) , 0._wp ) / e3t_a(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            zwdia(ji,jj,jk) =  1._wp + p2dt * ( MAX( wi(ji,jj,jk  ) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) ) / e3t(ji,jj,jk,Krhs)
+            zwinf(ji,jj,jk) =  p2dt * MIN( wi(ji,jj,jk  ) , 0._wp ) / e3t(ji,jj,jk,Krhs)
+            zwsup(ji,jj,jk) = -p2dt * MAX( wi(ji,jj,jk+1) , 0._wp ) / e3t(ji,jj,jk,Krhs)
+         END_3D
       END IF
       !
@@ -143,52 +139,38 @@
          !        !==  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.
-                  ! upstream scheme
-                  zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )
-                  zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) )
-                  zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) )
-                  zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) )
-                  zwx(ji,jj,jk) = 0.5 * ( zfp_ui * ptb(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj  ,jk,jn) )
-                  zwy(ji,jj,jk) = 0.5 * ( zfp_vj * ptb(ji,jj,jk,jn) + zfm_vj * ptb(ji  ,jj+1,jk,jn) )
-               END DO
-            END DO
-         END DO
+         DO_3D_10_10( 1, jpkm1 )
+            ! upstream scheme
+            zfp_ui = pU(ji,jj,jk) + ABS( pU(ji,jj,jk) )
+            zfm_ui = pU(ji,jj,jk) - ABS( pU(ji,jj,jk) )
+            zfp_vj = pV(ji,jj,jk) + ABS( pV(ji,jj,jk) )
+            zfm_vj = pV(ji,jj,jk) - ABS( pV(ji,jj,jk) )
+            zwx(ji,jj,jk) = 0.5 * ( zfp_ui * pt(ji,jj,jk,jn,Kbb) + zfm_ui * pt(ji+1,jj  ,jk,jn,Kbb) )
+            zwy(ji,jj,jk) = 0.5 * ( zfp_vj * pt(ji,jj,jk,jn,Kbb) + zfm_vj * pt(ji  ,jj+1,jk,jn,Kbb) )
+         END_3D
          !                    !* upstream tracer flux in the k direction *!
-         DO jk = 2, jpkm1        ! Interior value ( multiplied by wmask)
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
-                  zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
-                  zwz(ji,jj,jk) = 0.5 * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 2, jpkm1 )
+            zfp_wk = pW(ji,jj,jk) + ABS( pW(ji,jj,jk) )
+            zfm_wk = pW(ji,jj,jk) - ABS( pW(ji,jj,jk) )
+            zwz(ji,jj,jk) = 0.5 * ( zfp_wk * pt(ji,jj,jk,jn,Kbb) + zfm_wk * pt(ji,jj,jk-1,jn,Kbb) ) * wmask(ji,jj,jk)
+         END_3D
          IF( ln_linssh ) THEN    ! top ocean value (only in linear free surface as zwz has been w-masked)
             IF( ln_isfcav ) THEN             ! top of the ice-shelf cavities and at the ocean surface
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)   ! linear free surface 
-                  END DO
-               END DO   
+               DO_2D_11_11
+                  zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb)   ! linear free surface 
+               END_2D
             ELSE                             ! no cavities: only at the ocean surface
-               zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)
+               zwz(:,:,1) = pW(:,:,1) * pt(:,:,1,jn,Kbb)
             ENDIF
          ENDIF
          !               
-         DO jk = 1, jpkm1     !* trend and after field with monotonic scheme
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  !                             ! total intermediate advective trends
-                  ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
-                     &      + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
-                     &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) * r1_e1e2t(ji,jj)
-                  !                             ! update and guess with monotonic sheme
-                  pta(ji,jj,jk,jn) =                     pta(ji,jj,jk,jn) +        ztra   / e3t_n(ji,jj,jk) * tmask(ji,jj,jk)
-                  zwi(ji,jj,jk)    = ( e3t_b(ji,jj,jk) * ptb(ji,jj,jk,jn) + p2dt * ztra ) / e3t_a(ji,jj,jk) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            !                             ! total intermediate advective trends
+            ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+               &      + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
+               &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) * r1_e1e2t(ji,jj)
+            !                             ! update and guess with monotonic sheme
+            pt(ji,jj,jk,jn,Krhs) =                     pt(ji,jj,jk,jn,Krhs) +        ztra   / e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk)
+            zwi(ji,jj,jk)    = ( e3t(ji,jj,jk,Kbb) * pt(ji,jj,jk,jn,Kbb) + p2dt * ztra ) / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk)
+         END_3D
          
          IF ( ll_zAimp ) THEN
@@ -196,22 +178,14 @@
             !
             ztw(:,:,1) = 0._wp ; ztw(:,:,jpk) = 0._wp ;
-            DO jk = 2, jpkm1        ! Interior value ( multiplied by wmask)
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.  
-                     zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) )
-                     zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) )
-                     ztw(ji,jj,jk) =  0.5 * e1e2t(ji,jj) * ( zfp_wk * zwi(ji,jj,jk) + zfm_wk * zwi(ji,jj,jk-1) ) * wmask(ji,jj,jk)
-                     zwz(ji,jj,jk) = zwz(ji,jj,jk) + ztw(ji,jj,jk) ! update vertical fluxes
-                  END DO
-               END DO
-            END DO
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.  
-                     pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) &
-                        &                                  * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
+            DO_3D_00_00( 2, jpkm1 )
+               zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) )
+               zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) )
+               ztw(ji,jj,jk) =  0.5 * e1e2t(ji,jj) * ( zfp_wk * zwi(ji,jj,jk) + zfm_wk * zwi(ji,jj,jk-1) ) * wmask(ji,jj,jk)
+               zwz(ji,jj,jk) = zwz(ji,jj,jk) + ztw(ji,jj,jk) ! update vertical fluxes
+            END_3D
+            DO_3D_00_00( 1, jpkm1 )
+               pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) &
+                  &                                        * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+            END_3D
             !
          END IF
@@ -228,12 +202,8 @@
          !
          CASE(  2  )                   !- 2nd order centered
-            DO jk = 1, jpkm1
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1   ! vector opt.
-                     zwx(ji,jj,jk) = 0.5_wp * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) ) - zwx(ji,jj,jk)
-                     zwy(ji,jj,jk) = 0.5_wp * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) ) - zwy(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
+            DO_3D_10_10( 1, jpkm1 )
+               zwx(ji,jj,jk) = 0.5_wp * pU(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj,jk,jn,Kmm) ) - zwx(ji,jj,jk)
+               zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj+1,jk,jn,Kmm) ) - zwy(ji,jj,jk)
+            END_3D
             !
          CASE(  4  )                   !- 4th order centered
@@ -241,58 +211,42 @@
             zltv(:,:,jpk) = 0._wp
             DO jk = 1, jpkm1                 ! Laplacian
-               DO jj = 1, jpjm1                    ! 1st derivative (gradient)
-                  DO ji = 1, fs_jpim1   ! vector opt.
-                     ztu(ji,jj,jk) = ( ptn(ji+1,jj  ,jk,jn) - ptn(ji,jj,jk,jn) ) * umask(ji,jj,jk)
-                     ztv(ji,jj,jk) = ( ptn(ji  ,jj+1,jk,jn) - ptn(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
-                  END DO
-               END DO
-               DO jj = 2, jpjm1                    ! 2nd derivative * 1/ 6
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     zltu(ji,jj,jk) = (  ztu(ji,jj,jk) + ztu(ji-1,jj,jk)  ) * r1_6
-                     zltv(ji,jj,jk) = (  ztv(ji,jj,jk) + ztv(ji,jj-1,jk)  ) * r1_6
-                  END DO
-               END DO
+               DO_2D_10_10
+                  ztu(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk)
+                  ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk)
+               END_2D
+               DO_2D_00_00
+                  zltu(ji,jj,jk) = (  ztu(ji,jj,jk) + ztu(ji-1,jj,jk)  ) * r1_6
+                  zltv(ji,jj,jk) = (  ztv(ji,jj,jk) + ztv(ji,jj-1,jk)  ) * r1_6
+               END_2D
             END DO
             CALL lbc_lnk_multi( 'traadv_fct', zltu, 'T', 1. , zltv, 'T', 1. )   ! Lateral boundary cond. (unchanged sgn)
             !
-            DO jk = 1, jpkm1                 ! Horizontal advective fluxes
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1   ! vector opt.
-                     zC2t_u = ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn)   ! 2 x C2 interpolation of T at u- & v-points
-                     zC2t_v = ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn)
-                     !                                                  ! C4 minus upstream advective fluxes 
-                     zwx(ji,jj,jk) =  0.5_wp * pun(ji,jj,jk) * ( zC2t_u + zltu(ji,jj,jk) - zltu(ji+1,jj,jk) ) - zwx(ji,jj,jk)
-                     zwy(ji,jj,jk) =  0.5_wp * pvn(ji,jj,jk) * ( zC2t_v + zltv(ji,jj,jk) - zltv(ji,jj+1,jk) ) - zwy(ji,jj,jk)
-                  END DO
-               END DO
-            END DO         
+            DO_3D_10_10( 1, jpkm1 )
+               zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm)   ! 2 x C2 interpolation of T at u- & v-points
+               zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm)
+               !                                                  ! C4 minus upstream advective fluxes 
+               zwx(ji,jj,jk) =  0.5_wp * pU(ji,jj,jk) * ( zC2t_u + zltu(ji,jj,jk) - zltu(ji+1,jj,jk) ) - zwx(ji,jj,jk)
+               zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * ( zC2t_v + zltv(ji,jj,jk) - zltv(ji,jj+1,jk) ) - zwy(ji,jj,jk)
+            END_3D
             !
          CASE(  41 )                   !- 4th order centered       ==>>   !!gm coding attempt   need to be tested
             ztu(:,:,jpk) = 0._wp             ! Bottom value : flux set to zero
             ztv(:,:,jpk) = 0._wp
-            DO jk = 1, jpkm1                 ! 1st derivative (gradient)
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1   ! vector opt.
-                     ztu(ji,jj,jk) = ( ptn(ji+1,jj  ,jk,jn) - ptn(ji,jj,jk,jn) ) * umask(ji,jj,jk)
-                     ztv(ji,jj,jk) = ( ptn(ji  ,jj+1,jk,jn) - ptn(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
+            DO_3D_10_10( 1, jpkm1 )
+               ztu(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk)
+               ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk)
+            END_3D
             CALL lbc_lnk_multi( 'traadv_fct', ztu, 'U', -1. , ztv, 'V', -1. )   ! Lateral boundary cond. (unchanged sgn)
             !
-            DO jk = 1, jpkm1                 ! Horizontal advective fluxes
-               DO jj = 2, jpjm1
-                  DO ji = 2, fs_jpim1   ! vector opt.
-                     zC2t_u = ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn)   ! 2 x C2 interpolation of T at u- & v-points (x2)
-                     zC2t_v = ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn)
-                     !                                                  ! C4 interpolation of T at u- & v-points (x2)
-                     zC4t_u =  zC2t_u + r1_6 * ( ztu(ji-1,jj  ,jk) - ztu(ji+1,jj  ,jk) )
-                     zC4t_v =  zC2t_v + r1_6 * ( ztv(ji  ,jj-1,jk) - ztv(ji  ,jj+1,jk) )
-                     !                                                  ! C4 minus upstream advective fluxes 
-                     zwx(ji,jj,jk) =  0.5_wp * pun(ji,jj,jk) * zC4t_u - zwx(ji,jj,jk)
-                     zwy(ji,jj,jk) =  0.5_wp * pvn(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
+            DO_3D_00_00( 1, jpkm1 )
+               zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm)   ! 2 x C2 interpolation of T at u- & v-points (x2)
+               zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm)
+               !                                                  ! C4 interpolation of T at u- & v-points (x2)
+               zC4t_u =  zC2t_u + r1_6 * ( ztu(ji-1,jj  ,jk) - ztu(ji+1,jj  ,jk) )
+               zC4t_v =  zC2t_v + r1_6 * ( ztv(ji  ,jj-1,jk) - ztv(ji  ,jj+1,jk) )
+               !                                                  ! C4 minus upstream advective fluxes 
+               zwx(ji,jj,jk) =  0.5_wp * pU(ji,jj,jk) * zC4t_u - zwx(ji,jj,jk)
+               zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk)
+            END_3D
             !
          END SELECT
@@ -301,22 +255,14 @@
          !
          CASE(  2  )                   !- 2nd order centered
-            DO jk = 2, jpkm1    
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     zwz(ji,jj,jk) =  (  pwn(ji,jj,jk) * 0.5_wp * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) )   &
-                        &              - zwz(ji,jj,jk)  ) * wmask(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
+            DO_3D_00_00( 2, jpkm1 )
+               zwz(ji,jj,jk) =  (  pW(ji,jj,jk) * 0.5_wp * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) )   &
+                  &              - zwz(ji,jj,jk)  ) * wmask(ji,jj,jk)
+            END_3D
             !
          CASE(  4  )                   !- 4th order COMPACT
-            CALL interp_4th_cpt( ptn(:,:,:,jn) , ztw )   ! zwt = COMPACT interpolation of T at w-point
-            DO jk = 2, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     zwz(ji,jj,jk) = ( pwn(ji,jj,jk) * ztw(ji,jj,jk) - zwz(ji,jj,jk) ) * wmask(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
+            CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw )   ! zwt = COMPACT interpolation of T at w-point
+            DO_3D_00_00( 2, jpkm1 )
+               zwz(ji,jj,jk) = ( pW(ji,jj,jk) * ztw(ji,jj,jk) - zwz(ji,jj,jk) ) * wmask(ji,jj,jk)
+            END_3D
             !
          END SELECT
@@ -326,27 +272,19 @@
          !         
          IF ( ll_zAimp ) THEN
-            DO jk = 1, jpkm1     !* trend and after field with monotonic scheme
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     !                             ! total intermediate advective trends
-                     ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
-                        &      + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
-                        &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) * r1_e1e2t(ji,jj)
-                     ztw(ji,jj,jk)  = zwi(ji,jj,jk) + p2dt * ztra / e3t_a(ji,jj,jk) * tmask(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
+            DO_3D_00_00( 1, jpkm1 )
+               !                             ! total intermediate advective trends
+               ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+                  &      + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
+                  &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) * r1_e1e2t(ji,jj)
+               ztw(ji,jj,jk)  = zwi(ji,jj,jk) + p2dt * ztra / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk)
+            END_3D
             !
             CALL tridia_solver( zwdia, zwsup, zwinf, ztw, ztw , 0 )
             !
-            DO jk = 2, jpkm1        ! Interior value ( multiplied by wmask)
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) )
-                     zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) )
-                     zwz(ji,jj,jk) =  zwz(ji,jj,jk) + 0.5 * e1e2t(ji,jj) * ( zfp_wk * ztw(ji,jj,jk) + zfm_wk * ztw(ji,jj,jk-1) ) * wmask(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
+            DO_3D_00_00( 2, jpkm1 )
+               zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) )
+               zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) )
+               zwz(ji,jj,jk) =  zwz(ji,jj,jk) + 0.5 * e1e2t(ji,jj) * ( zfp_wk * ztw(ji,jj,jk) + zfm_wk * ztw(ji,jj,jk-1) ) * wmask(ji,jj,jk)
+            END_3D
          END IF
          !
@@ -355,41 +293,29 @@
          !        !==  monotonicity algorithm  ==!
          !
-         CALL nonosc( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt )
+         CALL nonosc( Kmm, pt(:,:,:,jn,Kbb), zwx, zwy, zwz, zwi, p2dt )
          !
          !        !==  final trend with corrected fluxes  ==!
          !
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.  
-                  ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
-                     &      + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
-                     &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) * r1_e1e2t(ji,jj)
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra / e3t_n(ji,jj,jk)
-                  zwi(ji,jj,jk) = zwi(ji,jj,jk) + p2dt * ztra / e3t_a(ji,jj,jk) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+               &      + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
+               &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) * r1_e1e2t(ji,jj)
+            pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) + ztra / e3t(ji,jj,jk,Kmm)
+            zwi(ji,jj,jk) = zwi(ji,jj,jk) + p2dt * ztra / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk)
+         END_3D
          !
          IF ( ll_zAimp ) THEN
             !
             ztw(:,:,1) = 0._wp ; ztw(:,:,jpk) = 0._wp
-            DO jk = 2, jpkm1        ! Interior value ( multiplied by wmask)
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) )
-                     zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) )
-                     ztw(ji,jj,jk) = - 0.5 * e1e2t(ji,jj) * ( zfp_wk * zwi(ji,jj,jk) + zfm_wk * zwi(ji,jj,jk-1) ) * wmask(ji,jj,jk)
-                     zwz(ji,jj,jk) = zwz(ji,jj,jk) + ztw(ji,jj,jk) ! Update vertical fluxes for trend diagnostic
-                  END DO
-               END DO
-            END DO
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.  
-                     pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) &
-                        &                                * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
+            DO_3D_00_00( 2, jpkm1 )
+               zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) )
+               zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) )
+               ztw(ji,jj,jk) = - 0.5 * e1e2t(ji,jj) * ( zfp_wk * zwi(ji,jj,jk) + zfm_wk * zwi(ji,jj,jk-1) ) * wmask(ji,jj,jk)
+               zwz(ji,jj,jk) = zwz(ji,jj,jk) + ztw(ji,jj,jk) ! Update vertical fluxes for trend diagnostic
+            END_3D
+            DO_3D_00_00( 1, jpkm1 )
+               pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) &
+                  &                                        * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+            END_3D
          END IF         
          !
@@ -400,7 +326,7 @@
             !
             IF( l_trd ) THEN              ! trend diagnostics
-               CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) )
-               CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) )
-               CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) )
+               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztrdx, pU, pt(:,:,:,jn,Kmm) )
+               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztrdy, pV, pt(:,:,:,jn,Kmm) )
+               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, ztrdz, pW, pt(:,:,:,jn,Kmm) )
             ENDIF
             !                             ! heat/salt transport
@@ -428,5 +354,5 @@
 
 
-   SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, p2dt )
+   SUBROUTINE nonosc( Kmm, pbef, paa, pbb, pcc, paft, p2dt )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE nonosc  ***
@@ -441,4 +367,5 @@
       !!       in-space based differencing for fluid
       !!----------------------------------------------------------------------
+      INTEGER                          , INTENT(in   ) ::   Kmm             ! time level index 
       REAL(wp)                         , INTENT(in   ) ::   p2dt            ! tracer time-step
       REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pbef, paft      ! before & after field
@@ -466,35 +393,33 @@
       DO jk = 1, jpkm1
          ikm1 = MAX(jk-1,1)
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-
-               ! search maximum in neighbourhood
-               zup = MAX(  zbup(ji  ,jj  ,jk  ),   &
-                  &        zbup(ji-1,jj  ,jk  ), zbup(ji+1,jj  ,jk  ),   &
-                  &        zbup(ji  ,jj-1,jk  ), zbup(ji  ,jj+1,jk  ),   &
-                  &        zbup(ji  ,jj  ,ikm1), zbup(ji  ,jj  ,jk+1)  )
-
-               ! search minimum in neighbourhood
-               zdo = MIN(  zbdo(ji  ,jj  ,jk  ),   &
-                  &        zbdo(ji-1,jj  ,jk  ), zbdo(ji+1,jj  ,jk  ),   &
-                  &        zbdo(ji  ,jj-1,jk  ), zbdo(ji  ,jj+1,jk  ),   &
-                  &        zbdo(ji  ,jj  ,ikm1), zbdo(ji  ,jj  ,jk+1)  )
-
-               ! positive 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  ) )
-
-               ! negative part of the flux
-               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 = e1e2t(ji,jj) * e3t_n(ji,jj,jk) / p2dt
-               zbetup(ji,jj,jk) = ( zup            - paft(ji,jj,jk) ) / ( zpos + zrtrn ) * zbt
-               zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zdo            ) / ( zneg + zrtrn ) * zbt
-            END DO
-         END DO
+         DO_2D_00_00
+
+            ! search maximum in neighbourhood
+            zup = MAX(  zbup(ji  ,jj  ,jk  ),   &
+               &        zbup(ji-1,jj  ,jk  ), zbup(ji+1,jj  ,jk  ),   &
+               &        zbup(ji  ,jj-1,jk  ), zbup(ji  ,jj+1,jk  ),   &
+               &        zbup(ji  ,jj  ,ikm1), zbup(ji  ,jj  ,jk+1)  )
+
+            ! search minimum in neighbourhood
+            zdo = MIN(  zbdo(ji  ,jj  ,jk  ),   &
+               &        zbdo(ji-1,jj  ,jk  ), zbdo(ji+1,jj  ,jk  ),   &
+               &        zbdo(ji  ,jj-1,jk  ), zbdo(ji  ,jj+1,jk  ),   &
+               &        zbdo(ji  ,jj  ,ikm1), zbdo(ji  ,jj  ,jk+1)  )
+
+            ! positive 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  ) )
+
+            ! negative part of the flux
+            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 = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) / p2dt
+            zbetup(ji,jj,jk) = ( zup            - paft(ji,jj,jk) ) / ( zpos + zrtrn ) * zbt
+            zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zdo            ) / ( zneg + zrtrn ) * zbt
+         END_2D
       END DO
       CALL lbc_lnk_multi( 'traadv_fct', zbetup, 'T', 1. , zbetdo, 'T', 1. )   ! lateral boundary cond. (unchanged sign)
@@ -502,26 +427,22 @@
       ! 3. monotonic flux in the i & j direction (paa & pbb)
       ! ----------------------------------------
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zau = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) )
-               zbu = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) )
-               zcu =       ( 0.5  + SIGN( 0.5 , paa(ji,jj,jk) ) )
-               paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1._wp - zcu) * zbu )
-
-               zav = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) )
-               zbv = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) )
-               zcv =       ( 0.5  + SIGN( 0.5 , pbb(ji,jj,jk) ) )
-               pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1._wp - zcv) * zbv )
-
-      ! monotonic flux in the k direction, i.e. pcc
-      ! -------------------------------------------
-               za = MIN( 1., zbetdo(ji,jj,jk+1), zbetup(ji,jj,jk) )
-               zb = MIN( 1., zbetup(ji,jj,jk+1), zbetdo(ji,jj,jk) )
-               zc =       ( 0.5  + SIGN( 0.5 , pcc(ji,jj,jk+1) ) )
-               pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1._wp - zc) * zb )
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 1, jpkm1 )
+         zau = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) )
+         zbu = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) )
+         zcu =       ( 0.5  + SIGN( 0.5 , paa(ji,jj,jk) ) )
+         paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1._wp - zcu) * zbu )
+
+         zav = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) )
+         zbv = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) )
+         zcv =       ( 0.5  + SIGN( 0.5 , pbb(ji,jj,jk) ) )
+         pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1._wp - zcv) * zbv )
+
+! monotonic flux in the k direction, i.e. pcc
+! -------------------------------------------
+         za = MIN( 1., zbetdo(ji,jj,jk+1), zbetup(ji,jj,jk) )
+         zb = MIN( 1., zbetup(ji,jj,jk+1), zbetdo(ji,jj,jk) )
+         zc =       ( 0.5  + SIGN( 0.5 , pcc(ji,jj,jk+1) ) )
+         pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1._wp - zc) * zb )
+      END_3D
       CALL lbc_lnk_multi( 'traadv_fct', paa, 'U', -1. , pbb, 'V', -1. )   ! lateral boundary condition (changed sign)
       !
@@ -544,71 +465,47 @@
       !!----------------------------------------------------------------------
       
-      DO jk = 3, jpkm1        !==  build the three diagonal matrix  ==!
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zwd (ji,jj,jk) = 4._wp
-               zwi (ji,jj,jk) = 1._wp
-               zws (ji,jj,jk) = 1._wp
-               zwrm(ji,jj,jk) = 3._wp * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )
-               !
-               IF( tmask(ji,jj,jk+1) == 0._wp) THEN   ! Switch to second order centered at bottom
-                  zwd (ji,jj,jk) = 1._wp
-                  zwi (ji,jj,jk) = 0._wp
-                  zws (ji,jj,jk) = 0._wp
-                  zwrm(ji,jj,jk) = 0.5 * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )    
-               ENDIF
-            END DO
-         END DO
-      END DO
-      !
-      jk = 2                                          ! Switch to second order centered at top
-      DO jj = 1, jpj
-         DO ji = 1, jpi
+      DO_3D_11_11( 3, jpkm1 )
+         zwd (ji,jj,jk) = 4._wp
+         zwi (ji,jj,jk) = 1._wp
+         zws (ji,jj,jk) = 1._wp
+         zwrm(ji,jj,jk) = 3._wp * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )
+         !
+         IF( tmask(ji,jj,jk+1) == 0._wp) THEN   ! Switch to second order centered at bottom
             zwd (ji,jj,jk) = 1._wp
             zwi (ji,jj,jk) = 0._wp
             zws (ji,jj,jk) = 0._wp
-            zwrm(ji,jj,jk) = 0.5 * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )
-         END DO
-      END DO   
+            zwrm(ji,jj,jk) = 0.5 * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )    
+         ENDIF
+      END_3D
+      !
+      jk = 2                                          ! Switch to second order centered at top
+      DO_2D_11_11
+         zwd (ji,jj,jk) = 1._wp
+         zwi (ji,jj,jk) = 0._wp
+         zws (ji,jj,jk) = 0._wp
+         zwrm(ji,jj,jk) = 0.5 * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )
+      END_2D
       !
       !                       !==  tridiagonal solve  ==!
-      DO jj = 1, jpj                ! first recurrence
-         DO ji = 1, jpi
-            zwt(ji,jj,2) = zwd(ji,jj,2)
-         END DO
-      END DO
-      DO jk = 3, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               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 jj = 1, jpj                ! second recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
-         DO ji = 1, jpi
-            pt_out(ji,jj,2) = zwrm(ji,jj,2)
-         END DO
-      END DO
-      DO jk = 3, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               pt_out(ji,jj,jk) = zwrm(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)             
-            END DO
-         END DO
-      END DO
-
-      DO jj = 1, jpj                ! third recurrence: Xk = (Zk - Sk Xk+1 ) / Tk
-         DO ji = 1, jpi
-            pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1)
-         END DO
-      END DO
-      DO jk = jpk-2, 2, -1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - zws(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_2D_11_11
+         zwt(ji,jj,2) = zwd(ji,jj,2)
+      END_2D
+      DO_3D_11_11( 3, jpkm1 )
+         zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) /zwt(ji,jj,jk-1)
+      END_3D
+      !
+      DO_2D_11_11
+         pt_out(ji,jj,2) = zwrm(ji,jj,2)
+      END_2D
+      DO_3D_11_11( 3, jpkm1 )
+         pt_out(ji,jj,jk) = zwrm(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)             
+      END_3D
+
+      DO_2D_11_11
+         pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1)
+      END_2D
+      DO_3DS_11_11( jpk-2, 2, -1 )
+         pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - zws(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk)
+      END_3D
       !    
    END SUBROUTINE interp_4th_cpt_org
@@ -633,15 +530,11 @@
       !                      !==  build the three diagonal matrix & the RHS  ==!
       !
-      DO jk = 3, jpkm1                 ! interior (from jk=3 to jpk-1)
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               zwd (ji,jj,jk) = 3._wp * wmask(ji,jj,jk) + 1._wp                 !       diagonal
-               zwi (ji,jj,jk) =         wmask(ji,jj,jk)                         ! lower diagonal
-               zws (ji,jj,jk) =         wmask(ji,jj,jk)                         ! upper diagonal
-               zwrm(ji,jj,jk) = 3._wp * wmask(ji,jj,jk)                     &   ! RHS
-                  &           *       ( pt_in(ji,jj,jk) + pt_in(ji,jj,jk-1) )
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 3, jpkm1 )
+         zwd (ji,jj,jk) = 3._wp * wmask(ji,jj,jk) + 1._wp                 !       diagonal
+         zwi (ji,jj,jk) =         wmask(ji,jj,jk)                         ! lower diagonal
+         zws (ji,jj,jk) =         wmask(ji,jj,jk)                         ! upper diagonal
+         zwrm(ji,jj,jk) = 3._wp * wmask(ji,jj,jk)                     &   ! RHS
+            &           *       ( pt_in(ji,jj,jk) + pt_in(ji,jj,jk-1) )
+      END_3D
       !
 !!gm
@@ -656,61 +549,41 @@
       END IF
       !
-      DO jj = 2, jpjm1                 ! 2nd order centered at top & bottom
-         DO ji = fs_2, fs_jpim1
-            ikt = mikt(ji,jj) + 1            ! w-point below the 1st  wet point
-            ikb = mbkt(ji,jj)                !     -   above the last wet point
-            !
-            zwd (ji,jj,ikt) = 1._wp          ! top
-            zwi (ji,jj,ikt) = 0._wp
-            zws (ji,jj,ikt) = 0._wp
-            zwrm(ji,jj,ikt) = 0.5_wp * ( pt_in(ji,jj,ikt-1) + pt_in(ji,jj,ikt) )
-            !
-            zwd (ji,jj,ikb) = 1._wp          ! bottom
-            zwi (ji,jj,ikb) = 0._wp
-            zws (ji,jj,ikb) = 0._wp
-            zwrm(ji,jj,ikb) = 0.5_wp * ( pt_in(ji,jj,ikb-1) + pt_in(ji,jj,ikb) )            
-         END DO
-      END DO   
+      DO_2D_00_00
+         ikt = mikt(ji,jj) + 1            ! w-point below the 1st  wet point
+         ikb = MAX(mbkt(ji,jj), 2)        !     -   above the last wet point
+         !
+         zwd (ji,jj,ikt) = 1._wp          ! top
+         zwi (ji,jj,ikt) = 0._wp
+         zws (ji,jj,ikt) = 0._wp
+         zwrm(ji,jj,ikt) = 0.5_wp * ( pt_in(ji,jj,ikt-1) + pt_in(ji,jj,ikt) )
+         !
+         zwd (ji,jj,ikb) = 1._wp          ! bottom
+         zwi (ji,jj,ikb) = 0._wp
+         zws (ji,jj,ikb) = 0._wp
+         zwrm(ji,jj,ikb) = 0.5_wp * ( pt_in(ji,jj,ikb-1) + pt_in(ji,jj,ikb) )            
+      END_2D
       !
       !                       !==  tridiagonal solver  ==!
       !
-      DO jj = 2, jpjm1              !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1
-         DO ji = fs_2, fs_jpim1
-            zwt(ji,jj,2) = zwd(ji,jj,2)
-         END DO
-      END DO
-      DO jk = 3, 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 jj = 2, jpjm1              !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
-         DO ji = fs_2, fs_jpim1
-            pt_out(ji,jj,2) = zwrm(ji,jj,2)
-         END DO
-      END DO
-      DO jk = 3, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               pt_out(ji,jj,jk) = zwrm(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)             
-            END DO
-         END DO
-      END DO
-
-      DO jj = 2, jpjm1              !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk
-         DO ji = fs_2, fs_jpim1
-            pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1)
-         END DO
-      END DO
-      DO jk = jpk-2, 2, -1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - zws(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_2D_00_00
+         zwt(ji,jj,2) = zwd(ji,jj,2)
+      END_2D
+      DO_3D_00_00( 3, jpkm1 )
+         zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) /zwt(ji,jj,jk-1)
+      END_3D
+      !
+      DO_2D_00_00
+         pt_out(ji,jj,2) = zwrm(ji,jj,2)
+      END_2D
+      DO_3D_00_00( 3, jpkm1 )
+         pt_out(ji,jj,jk) = zwrm(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)             
+      END_3D
+
+      DO_2D_00_00
+         pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1)
+      END_2D
+      DO_3DS_00_00( jpk-2, 2, -1 )
+         pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - zws(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk)
+      END_3D
       !    
    END SUBROUTINE interp_4th_cpt
@@ -749,42 +622,24 @@
       kstart =  1  + klev
       !
-      DO jj = 2, jpjm1              !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1
-         DO ji = fs_2, fs_jpim1
-            zwt(ji,jj,kstart) = pD(ji,jj,kstart)
-         END DO
-      END DO
-      DO jk = kstart+1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               zwt(ji,jj,jk) = pD(ji,jj,jk) - pL(ji,jj,jk) * pU(ji,jj,jk-1) /zwt(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-      !
-      DO jj = 2, jpjm1              !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
-         DO ji = fs_2, fs_jpim1
-            pt_out(ji,jj,kstart) = pRHS(ji,jj,kstart)
-         END DO
-      END DO
-      DO jk = kstart+1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               pt_out(ji,jj,jk) = pRHS(ji,jj,jk) - pL(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)             
-            END DO
-         END DO
-      END DO
-
-      DO jj = 2, jpjm1              !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk
-         DO ji = fs_2, fs_jpim1
-            pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1)
-         END DO
-      END DO
-      DO jk = jpk-2, kstart, -1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - pU(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_2D_00_00
+         zwt(ji,jj,kstart) = pD(ji,jj,kstart)
+      END_2D
+      DO_3D_00_00( kstart+1, jpkm1 )
+         zwt(ji,jj,jk) = pD(ji,jj,jk) - pL(ji,jj,jk) * pU(ji,jj,jk-1) /zwt(ji,jj,jk-1)
+      END_3D
+      !
+      DO_2D_00_00
+         pt_out(ji,jj,kstart) = pRHS(ji,jj,kstart)
+      END_2D
+      DO_3D_00_00( kstart+1, jpkm1 )
+         pt_out(ji,jj,jk) = pRHS(ji,jj,jk) - pL(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)             
+      END_3D
+
+      DO_2D_00_00
+         pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1)
+      END_2D
+      DO_3DS_00_00( jpk-2, kstart, -1 )
+         pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - pU(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk)
+      END_3D
       !
    END SUBROUTINE tridia_solver
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traadv_mus.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traadv_mus.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traadv_mus.F90	(revision 12928)
@@ -46,5 +46,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -54,6 +54,6 @@
 CONTAINS
 
-   SUBROUTINE tra_adv_mus( kt, kit000, cdtype, p2dt, pun, pvn, pwn,             &
-      &                                              ptb, pta, kjpt, ld_msc_ups )
+   SUBROUTINE tra_adv_mus( kt, kit000, cdtype, p2dt, pU, pV, pW,             &
+      &                    Kbb, Kmm, pt, kjpt, Krhs, ld_msc_ups )
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE tra_adv_mus  ***
@@ -66,20 +66,20 @@
       !!              ld_msc_ups=T : 
       !!
-      !! ** Action : - update pta  with the now advective tracer trends
+      !! ** Action : - update pt(:,:,:,:,Krhs)  with the now advective tracer trends
       !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T)
-      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T)
+      !!             - poleward advective heat and salt transport (ln_diaptr=T)
       !!
       !! References : Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation
       !!              IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa)
       !!----------------------------------------------------------------------
-      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
-      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
-      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
-      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
-      LOGICAL                              , INTENT(in   ) ::   ld_msc_ups      ! use upstream scheme within muscl
-      REAL(wp)                             , INTENT(in   ) ::   p2dt            ! tracer time-step
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb             ! before tracer field
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      INTEGER                                  , INTENT(in   ) ::   kt              ! ocean time-step index
+      INTEGER                                  , INTENT(in   ) ::   Kbb, Kmm, Krhs  ! ocean time level indices
+      INTEGER                                  , INTENT(in   ) ::   kit000          ! first time step index
+      CHARACTER(len=3)                         , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER                                  , INTENT(in   ) ::   kjpt            ! number of tracers
+      LOGICAL                                  , INTENT(in   ) ::   ld_msc_ups      ! use upstream scheme within muscl
+      REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation
       !
       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
@@ -120,5 +120,5 @@
       l_ptr = .FALSE.
       IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )      l_trd = .TRUE.
-      IF(   cdtype == 'TRA' .AND. ln_diaptr )                                               l_ptr = .TRUE. 
+      IF(   cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) )  )   l_ptr = .TRUE. 
       IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
          &                          iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) ) l_hst = .TRUE.
@@ -131,12 +131,8 @@
          zwx(:,:,jpk) = 0._wp                   ! bottom values
          zwy(:,:,jpk) = 0._wp  
-         DO jk = 1, jpkm1                       ! interior values
-            DO jj = 1, jpjm1      
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwx(ji,jj,jk) = umask(ji,jj,jk) * ( ptb(ji+1,jj,jk,jn) - ptb(ji,jj,jk,jn) )
-                  zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( ptb(ji,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
-               END DO
-           END DO
-         END DO
+         DO_3D_10_10( 1, jpkm1 )
+            zwx(ji,jj,jk) = umask(ji,jj,jk) * ( pt(ji+1,jj,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) )
+            zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( pt(ji,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) )
+         END_3D
          ! lateral boundary conditions   (changed sign)
          CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1. , zwy, 'V', -1. )
@@ -144,63 +140,47 @@
          zslpx(:,:,jpk) = 0._wp                 ! bottom values
          zslpy(:,:,jpk) = 0._wp
-         DO jk = 1, jpkm1                       ! interior values
-            DO jj = 2, jpj
-               DO ji = fs_2, jpi   ! vector opt.
-                  zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   &
-                     &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) )
-                  zslpy(ji,jj,jk) =                    ( zwy(ji,jj,jk) + zwy(ji  ,jj-1,jk) )   &
-                     &            * ( 0.25 + SIGN( 0.25, zwy(ji,jj,jk) * zwy(ji  ,jj-1,jk) ) )
-               END DO
-            END DO
-         END DO
-         !
-         DO jk = 1, jpkm1                 !-- Slopes limitation
-            DO jj = 2, jpj
-               DO ji = fs_2, jpi   ! vector opt.
-                  zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji  ,jj,jk) ),   &
-                     &                                                 2.*ABS( zwx  (ji-1,jj,jk) ),   &
-                     &                                                 2.*ABS( zwx  (ji  ,jj,jk) ) )
-                  zslpy(ji,jj,jk) = SIGN( 1., zslpy(ji,jj,jk) ) * MIN(    ABS( zslpy(ji,jj  ,jk) ),   &
-                     &                                                 2.*ABS( zwy  (ji,jj-1,jk) ),   &
-                     &                                                 2.*ABS( zwy  (ji,jj  ,jk) ) )
-               END DO
-           END DO
-         END DO
-         !
-         DO jk = 1, jpkm1                 !-- MUSCL horizontal advective fluxes
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ! MUSCL fluxes
-                  z0u = SIGN( 0.5, pun(ji,jj,jk) )
-                  zalpha = 0.5 - z0u
-                  zu  = z0u - 0.5 * pun(ji,jj,jk) * p2dt * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
-                  zzwx = ptb(ji+1,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji+1,jj,jk)
-                  zzwy = ptb(ji  ,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji  ,jj,jk)
-                  zwx(ji,jj,jk) = pun(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
-                  !
-                  z0v = SIGN( 0.5, pvn(ji,jj,jk) )
-                  zalpha = 0.5 - z0v
-                  zv  = z0v - 0.5 * pvn(ji,jj,jk) * p2dt * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
-                  zzwx = ptb(ji,jj+1,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj+1,jk)
-                  zzwy = ptb(ji,jj  ,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj  ,jk)
-                  zwy(ji,jj,jk) = pvn(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
-               END DO
-            END DO
-         END DO
+         DO_3D_01_01( 1, jpkm1 )
+            zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   &
+               &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) )
+            zslpy(ji,jj,jk) =                    ( zwy(ji,jj,jk) + zwy(ji  ,jj-1,jk) )   &
+               &            * ( 0.25 + SIGN( 0.25, zwy(ji,jj,jk) * zwy(ji  ,jj-1,jk) ) )
+         END_3D
+         !
+         DO_3D_01_01( 1, jpkm1 )
+            zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji  ,jj,jk) ),   &
+               &                                                 2.*ABS( zwx  (ji-1,jj,jk) ),   &
+               &                                                 2.*ABS( zwx  (ji  ,jj,jk) ) )
+            zslpy(ji,jj,jk) = SIGN( 1., zslpy(ji,jj,jk) ) * MIN(    ABS( zslpy(ji,jj  ,jk) ),   &
+               &                                                 2.*ABS( zwy  (ji,jj-1,jk) ),   &
+               &                                                 2.*ABS( zwy  (ji,jj  ,jk) ) )
+         END_3D
+         !
+         DO_3D_00_00( 1, jpkm1 )
+            ! MUSCL fluxes
+            z0u = SIGN( 0.5, pU(ji,jj,jk) )
+            zalpha = 0.5 - z0u
+            zu  = z0u - 0.5 * pU(ji,jj,jk) * p2dt * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm)
+            zzwx = pt(ji+1,jj,jk,jn,Kbb) + xind(ji,jj,jk) * zu * zslpx(ji+1,jj,jk)
+            zzwy = pt(ji  ,jj,jk,jn,Kbb) + xind(ji,jj,jk) * zu * zslpx(ji  ,jj,jk)
+            zwx(ji,jj,jk) = pU(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
+            !
+            z0v = SIGN( 0.5, pV(ji,jj,jk) )
+            zalpha = 0.5 - z0v
+            zv  = z0v - 0.5 * pV(ji,jj,jk) * p2dt * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm)
+            zzwx = pt(ji,jj+1,jk,jn,Kbb) + xind(ji,jj,jk) * zv * zslpy(ji,jj+1,jk)
+            zzwy = pt(ji,jj  ,jk,jn,Kbb) + xind(ji,jj,jk) * zv * zslpy(ji,jj  ,jk)
+            zwy(ji,jj,jk) = pV(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
+         END_3D
          CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1. , zwy, 'V', -1. )   ! lateral boundary conditions   (changed sign)
          !
-         DO jk = 1, jpkm1                 !-- Tracer advective trend
-            DO jj = 2, jpjm1      
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )       &
-                  &                                     + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  ) )     &
-                  &                                   * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
-               END DO
-           END DO
-         END DO        
+         DO_3D_00_00( 1, jpkm1 )
+            pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )       &
+            &                                     + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  ) )     &
+            &                                   * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+         END_3D
          !                                ! trend diagnostics
          IF( l_trd )  THEN
-            CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptb(:,:,:,jn) )
-            CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptb(:,:,:,jn) )
+            CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, zwx, pU, pt(:,:,:,jn,Kbb) )
+            CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, pt(:,:,:,jn,Kbb) )
          END IF
          !                                 ! "Poleward" heat and salt transports 
@@ -215,58 +195,40 @@
          zwx(:,:,jpk) = 0._wp
          DO jk = 2, jpkm1                       ! interior values
-            zwx(:,:,jk) = tmask(:,:,jk) * ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) )
+            zwx(:,:,jk) = tmask(:,:,jk) * ( pt(:,:,jk-1,jn,Kbb) - pt(:,:,jk,jn,Kbb) )
          END DO
          !                                !-- Slopes of tracer
          zslpx(:,:,1) = 0._wp                   ! surface values
-         DO jk = 2, jpkm1                       ! interior value
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zslpx(ji,jj,jk) =                     ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) )  &
-                     &            * (  0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) )  )
-               END DO
-            END DO
-         END DO
-         DO jk = 2, jpkm1                 !-- Slopes limitation
-            DO jj = 1, jpj                      ! interior values
-               DO ji = 1, jpi
-                  zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji,jj,jk  ) ),   &
-                     &                                                 2.*ABS( zwx  (ji,jj,jk+1) ),   &
-                     &                                                 2.*ABS( zwx  (ji,jj,jk  ) )  )
-               END DO
-            END DO
-         END DO
-         DO jk = 1, jpk-2                 !-- vertical advective flux
-            DO jj = 2, jpjm1      
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  z0w = SIGN( 0.5, pwn(ji,jj,jk+1) )
-                  zalpha = 0.5 + z0w
-                  zw  = z0w - 0.5 * pwn(ji,jj,jk+1) * p2dt * r1_e1e2t(ji,jj) / e3w_n(ji,jj,jk+1)
-                  zzwx = ptb(ji,jj,jk+1,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk+1)
-                  zzwy = ptb(ji,jj,jk  ,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk  )
-                  zwx(ji,jj,jk+1) = pwn(ji,jj,jk+1) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) * wmask(ji,jj,jk)
-               END DO 
-            END DO
-         END DO
+         DO_3D_11_11( 2, jpkm1 )
+            zslpx(ji,jj,jk) =                     ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) )  &
+               &            * (  0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) )  )
+         END_3D
+         DO_3D_11_11( 2, jpkm1 )
+            zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji,jj,jk  ) ),   &
+               &                                                 2.*ABS( zwx  (ji,jj,jk+1) ),   &
+               &                                                 2.*ABS( zwx  (ji,jj,jk  ) )  )
+         END_3D
+         DO_3D_00_00( 1, jpk-2 )
+            z0w = SIGN( 0.5, pW(ji,jj,jk+1) )
+            zalpha = 0.5 + z0w
+            zw  = z0w - 0.5 * pW(ji,jj,jk+1) * p2dt * r1_e1e2t(ji,jj) / e3w(ji,jj,jk+1,Kmm)
+            zzwx = pt(ji,jj,jk+1,jn,Kbb) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk+1)
+            zzwy = pt(ji,jj,jk  ,jn,Kbb) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk  )
+            zwx(ji,jj,jk+1) = pW(ji,jj,jk+1) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) * wmask(ji,jj,jk)
+         END_3D
          IF( ln_linssh ) THEN                   ! top values, linear free surface only
             IF( ln_isfcav ) THEN                      ! ice-shelf cavities (top of the ocean)
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     zwx(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)
-                  END DO
-               END DO   
+               DO_2D_11_11
+                  zwx(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb)
+               END_2D
             ELSE                                      ! no cavities: only at the ocean surface
-               zwx(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)
+               zwx(:,:,1) = pW(:,:,1) * pt(:,:,1,jn,Kbb)
             ENDIF
          ENDIF
          !
-         DO jk = 1, jpkm1                 !-- vertical advective trend
-            DO jj = 2, jpjm1      
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  pta(ji,jj,jk,jn) =  pta(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            pt(ji,jj,jk,jn,Krhs) =  pt(ji,jj,jk,jn,Krhs) - ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+         END_3D
          !                                ! send trends for diagnostic
-         IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_zad, zwx, pwn, ptb(:,:,:,jn) )
+         IF( l_trd )  CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwx, pW, pt(:,:,:,jn,Kbb) )
          !
       END DO                     ! end of tracer loop
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traadv_qck.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traadv_qck.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traadv_qck.F90	(revision 12928)
@@ -21,4 +21,5 @@
    USE trdtra          ! trends manager: tracers 
    USE diaptr          ! poleward transport diagnostics
+   USE iom
    !
    USE in_out_manager  ! I/O manager
@@ -39,5 +40,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -47,6 +48,5 @@
 CONTAINS
 
-   SUBROUTINE tra_adv_qck ( kt, kit000, cdtype, p2dt, pun, pvn, pwn,      &
-      &                                       ptb, ptn, pta, kjpt )
+   SUBROUTINE tra_adv_qck ( kt, kit000, cdtype, p2dt, pU, pV, pW, Kbb, Kmm, pt, kjpt, Krhs )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_adv_qck  ***
@@ -72,5 +72,5 @@
       !!         dt = 2*rdtra and the scalar values are tb and sb
       !!
-      !!       On the vertical, the simple centered scheme used ptn
+      !!       On the vertical, the simple centered scheme used pt(:,:,:,:,Kmm)
       !!
       !!               The fluxes are bounded by the ULTIMATE limiter to
@@ -78,18 +78,18 @@
       !!            prevent the appearance of spurious numerical oscillations
       !!
-      !! ** Action : - update pta  with the now advective tracer trends
+      !! ** Action : - update pt(:,:,:,:,Krhs)  with the now advective tracer trends
       !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T)
-      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T)
+      !!             - poleward advective heat and salt transport (ln_diaptr=T)
       !!
       !! ** Reference : Leonard (1979, 1991)
       !!----------------------------------------------------------------------
-      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
-      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
-      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
-      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
-      REAL(wp)                             , INTENT(in   ) ::   p2dt            ! tracer time-step
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      INTEGER                                  , INTENT(in   ) ::   kt              ! ocean time-step index
+      INTEGER                                  , INTENT(in   ) ::   Kbb, Kmm, Krhs  ! ocean time level indices
+      INTEGER                                  , INTENT(in   ) ::   kit000          ! first time step index
+      CHARACTER(len=3)                         , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER                                  , INTENT(in   ) ::   kjpt            ! number of tracers
+      REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume transport components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation
       !!----------------------------------------------------------------------
       !
@@ -103,30 +103,29 @@
       l_trd = .FALSE.
       l_ptr = .FALSE.
-      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )      l_trd = .TRUE.
-      IF(   cdtype == 'TRA' .AND. ln_diaptr )                                               l_ptr = .TRUE. 
+      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .TRUE.
+      IF(   cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE. 
       !
       !
       !        ! horizontal fluxes are computed with the QUICKEST + ULTIMATE scheme
-      CALL tra_adv_qck_i( kt, cdtype, p2dt, pun, ptb, ptn, pta, kjpt ) 
-      CALL tra_adv_qck_j( kt, cdtype, p2dt, pvn, ptb, ptn, pta, kjpt ) 
+      CALL tra_adv_qck_i( kt, cdtype, p2dt, pU, Kbb, Kmm, pt, kjpt, Krhs ) 
+      CALL tra_adv_qck_j( kt, cdtype, p2dt, pV, Kbb, Kmm, pt, kjpt, Krhs ) 
 
       !        ! vertical fluxes are computed with the 2nd order centered scheme
-      CALL tra_adv_cen2_k( kt, cdtype, pwn,         ptn, pta, kjpt )
+      CALL tra_adv_cen2_k( kt, cdtype, pW, Kmm, pt, kjpt, Krhs )
       !
    END SUBROUTINE tra_adv_qck
 
 
-   SUBROUTINE tra_adv_qck_i( kt, cdtype, p2dt, pun,                  &
-      &                                        ptb, ptn, pta, kjpt   )
-      !!----------------------------------------------------------------------
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
-      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
-      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
-      REAL(wp)                             , INTENT(in   ) ::   p2dt       ! tracer time-step
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun        ! i-velocity components
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn   ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+   SUBROUTINE tra_adv_qck_i( kt, cdtype, p2dt, pU, Kbb, Kmm, pt, kjpt, Krhs )
+      !!----------------------------------------------------------------------
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER                                  , INTENT(in   ) ::   kt         ! ocean time-step index
+      INTEGER                                  , INTENT(in   ) ::   Kbb, Kmm, Krhs  ! ocean time level indices
+      CHARACTER(len=3)                         , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
+      INTEGER                                  , INTENT(in   ) ::   kjpt       ! number of tracers
+      REAL(wp)                                 , INTENT(in   ) ::   p2dt       ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU        ! i-velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! active tracers and RHS of tracer equation
       !!
       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
@@ -142,12 +141,8 @@
          !
 !!gm why not using a SHIFT instruction...
-         DO jk = 1, jpkm1     !--- Computation of the ustream and downstream value of the tracer and the mask
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zfc(ji,jj,jk) = ptb(ji-1,jj,jk,jn)        ! Upstream   in the x-direction for the tracer
-                  zfd(ji,jj,jk) = ptb(ji+1,jj,jk,jn)        ! Downstream in the x-direction for the tracer
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            zfc(ji,jj,jk) = pt(ji-1,jj,jk,jn,Kbb)        ! Upstream   in the x-direction for the tracer
+            zfd(ji,jj,jk) = pt(ji+1,jj,jk,jn,Kbb)        ! Downstream in the x-direction for the tracer
+         END_3D
          CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1. , zfd(:,:,:), 'T', 1. )   ! Lateral boundary conditions 
          
@@ -155,24 +150,16 @@
          ! Horizontal advective fluxes
          ! ---------------------------
-         DO jk = 1, jpkm1                             
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.         
-                  zdir = 0.5 + SIGN( 0.5, pun(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0 
-                  zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji+1,jj,jk)  ! FU in the x-direction for T 
-               END DO
-            END DO
-         END DO
-         !
-         DO jk = 1, jpkm1  
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.   
-                  zdir = 0.5 + SIGN( 0.5, pun(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0 
-                  zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * e3u_n(ji,jj,jk)
-                  zwx(ji,jj,jk)  = ABS( pun(ji,jj,jk) ) * p2dt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction)
-                  zfc(ji,jj,jk)  = zdir * ptb(ji  ,jj,jk,jn) + ( 1. - zdir ) * ptb(ji+1,jj,jk,jn)  ! FC in the x-direction for T
-                  zfd(ji,jj,jk)  = zdir * ptb(ji+1,jj,jk,jn) + ( 1. - zdir ) * ptb(ji  ,jj,jk,jn)  ! FD in the x-direction for T
-               END DO
-            END DO
-         END DO 
+         DO_3D_00_00( 1, jpkm1 )
+            zdir = 0.5 + SIGN( 0.5, pU(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0 
+            zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji+1,jj,jk)  ! FU in the x-direction for T 
+         END_3D
+         !
+         DO_3D_00_00( 1, jpkm1 )
+            zdir = 0.5 + SIGN( 0.5, pU(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0 
+            zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm)
+            zwx(ji,jj,jk)  = ABS( pU(ji,jj,jk) ) * p2dt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction)
+            zfc(ji,jj,jk)  = zdir * pt(ji  ,jj,jk,jn,Kbb) + ( 1. - zdir ) * pt(ji+1,jj,jk,jn,Kbb)  ! FC in the x-direction for T
+            zfd(ji,jj,jk)  = zdir * pt(ji+1,jj,jk,jn,Kbb) + ( 1. - zdir ) * pt(ji  ,jj,jk,jn,Kbb)  ! FD in the x-direction for T
+         END_3D
          !--- Lateral boundary conditions 
          CALL lbc_lnk_multi( 'traadv_qck', zfu(:,:,:), 'T', 1. , zfd(:,:,:), 'T', 1., zfc(:,:,:), 'T', 1.,  zwx(:,:,:), 'T', 1. )
@@ -182,11 +169,7 @@
          !
          ! Mask at the T-points in the x-direction (mask=0 or mask=1)
-         DO jk = 1, jpkm1  
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.               
-                  zfu(ji,jj,jk) = tmask(ji-1,jj,jk) + tmask(ji,jj,jk) + tmask(ji+1,jj,jk) - 2.
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            zfu(ji,jj,jk) = tmask(ji-1,jj,jk) + tmask(ji,jj,jk) + tmask(ji+1,jj,jk) - 2.
+         END_3D
          CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1. )      ! Lateral boundary conditions 
 
@@ -195,14 +178,12 @@
          DO jk = 1, jpkm1  
             !
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.               
-                  zdir = 0.5 + SIGN( 0.5, pun(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0 
-                  !--- If the second ustream point is a land point
-                  !--- the flux is computed by the 1st order UPWIND scheme
-                  zmsk = zdir * zfu(ji,jj,jk) + ( 1. - zdir ) * zfu(ji+1,jj,jk)
-                  zwx(ji,jj,jk) = zmsk * zwx(ji,jj,jk) + ( 1. - zmsk ) * zfc(ji,jj,jk)
-                  zwx(ji,jj,jk) = zwx(ji,jj,jk) * pun(ji,jj,jk)
-               END DO
-            END DO
+            DO_2D_00_00
+               zdir = 0.5 + SIGN( 0.5, pU(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0 
+               !--- If the second ustream point is a land point
+               !--- the flux is computed by the 1st order UPWIND scheme
+               zmsk = zdir * zfu(ji,jj,jk) + ( 1. - zdir ) * zfu(ji+1,jj,jk)
+               zwx(ji,jj,jk) = zmsk * zwx(ji,jj,jk) + ( 1. - zmsk ) * zfc(ji,jj,jk)
+               zwx(ji,jj,jk) = zwx(ji,jj,jk) * pU(ji,jj,jk)
+            END_2D
          END DO
          !
@@ -210,17 +191,13 @@
          !
          ! Computation of the trend
-         DO jk = 1, jpkm1  
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.  
-                  zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
-                  ! horizontal advective trends
-                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) )
-                  !--- add it to the general tracer trends
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+            ! horizontal advective trends
+            ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) )
+            !--- add it to the general tracer trends
+            pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) + ztra
+         END_3D
          !                                 ! trend diagnostics
-         IF( l_trd )   CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) )
+         IF( l_trd )   CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, zwx, pU, pt(:,:,:,jn,Kmm) )
          !
       END DO
@@ -229,16 +206,15 @@
 
 
-   SUBROUTINE tra_adv_qck_j( kt, cdtype, p2dt, pvn,                &
-      &                                        ptb, ptn, pta, kjpt )
-      !!----------------------------------------------------------------------
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
-      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
-      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
-      REAL(wp)                             , INTENT(in   ) ::   p2dt       ! tracer time-step
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pvn        ! j-velocity components
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn   ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+   SUBROUTINE tra_adv_qck_j( kt, cdtype, p2dt, pV, Kbb, Kmm, pt, kjpt, Krhs )
+      !!----------------------------------------------------------------------
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER                                  , INTENT(in   ) ::   kt         ! ocean time-step index
+      INTEGER                                  , INTENT(in   ) ::   Kbb, Kmm, Krhs  ! ocean time level indices
+      CHARACTER(len=3)                         , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
+      INTEGER                                  , INTENT(in   ) ::   kjpt       ! number of tracers
+      REAL(wp)                                 , INTENT(in   ) ::   p2dt       ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pV        ! j-velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! active tracers and RHS of tracer equation
       !!
       INTEGER  :: ji, jj, jk, jn                ! dummy loop indices
@@ -256,12 +232,10 @@
             !                                             
             !--- Computation of the ustream and downstream value of the tracer and the mask
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ! Upstream in the x-direction for the tracer
-                  zfc(ji,jj,jk) = ptb(ji,jj-1,jk,jn)
-                  ! Downstream in the x-direction for the tracer
-                  zfd(ji,jj,jk) = ptb(ji,jj+1,jk,jn)
-               END DO
-            END DO
+            DO_2D_00_00
+               ! Upstream in the x-direction for the tracer
+               zfc(ji,jj,jk) = pt(ji,jj-1,jk,jn,Kbb)
+               ! Downstream in the x-direction for the tracer
+               zfd(ji,jj,jk) = pt(ji,jj+1,jk,jn,Kbb)
+            END_2D
          END DO
          CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1. , zfd(:,:,:), 'T', 1. )   ! Lateral boundary conditions 
@@ -272,24 +246,16 @@
          ! ---------------------------
          !
-         DO jk = 1, jpkm1                             
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.         
-                  zdir = 0.5 + SIGN( 0.5, pvn(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0 
-                  zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji,jj+1,jk)  ! FU in the x-direction for T 
-               END DO
-            END DO
-         END DO
-         !
-         DO jk = 1, jpkm1  
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.   
-                  zdir = 0.5 + SIGN( 0.5, pvn(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0 
-                  zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * e3v_n(ji,jj,jk)
-                  zwy(ji,jj,jk)  = ABS( pvn(ji,jj,jk) ) * p2dt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction)
-                  zfc(ji,jj,jk)  = zdir * ptb(ji,jj  ,jk,jn) + ( 1. - zdir ) * ptb(ji,jj+1,jk,jn)  ! FC in the x-direction for T
-                  zfd(ji,jj,jk)  = zdir * ptb(ji,jj+1,jk,jn) + ( 1. - zdir ) * ptb(ji,jj  ,jk,jn)  ! FD in the x-direction for T
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            zdir = 0.5 + SIGN( 0.5, pV(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0 
+            zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji,jj+1,jk)  ! FU in the x-direction for T 
+         END_3D
+         !
+         DO_3D_00_00( 1, jpkm1 )
+            zdir = 0.5 + SIGN( 0.5, pV(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0 
+            zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * e3v(ji,jj,jk,Kmm)
+            zwy(ji,jj,jk)  = ABS( pV(ji,jj,jk) ) * p2dt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction)
+            zfc(ji,jj,jk)  = zdir * pt(ji,jj  ,jk,jn,Kbb) + ( 1. - zdir ) * pt(ji,jj+1,jk,jn,Kbb)  ! FC in the x-direction for T
+            zfd(ji,jj,jk)  = zdir * pt(ji,jj+1,jk,jn,Kbb) + ( 1. - zdir ) * pt(ji,jj  ,jk,jn,Kbb)  ! FD in the x-direction for T
+         END_3D
 
          !--- Lateral boundary conditions 
@@ -300,11 +266,7 @@
          !
          ! Mask at the T-points in the x-direction (mask=0 or mask=1)
-         DO jk = 1, jpkm1  
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.               
-                  zfu(ji,jj,jk) = tmask(ji,jj-1,jk) + tmask(ji,jj,jk) + tmask(ji,jj+1,jk) - 2.
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            zfu(ji,jj,jk) = tmask(ji,jj-1,jk) + tmask(ji,jj,jk) + tmask(ji,jj+1,jk) - 2.
+         END_3D
          CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1. )    !--- Lateral boundary conditions 
          !
@@ -312,14 +274,12 @@
          DO jk = 1, jpkm1  
             !
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.               
-                  zdir = 0.5 + SIGN( 0.5, pvn(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0 
-                  !--- If the second ustream point is a land point
-                  !--- the flux is computed by the 1st order UPWIND scheme
-                  zmsk = zdir * zfu(ji,jj,jk) + ( 1. - zdir ) * zfu(ji,jj+1,jk)
-                  zwy(ji,jj,jk) = zmsk * zwy(ji,jj,jk) + ( 1. - zmsk ) * zfc(ji,jj,jk)
-                  zwy(ji,jj,jk) = zwy(ji,jj,jk) * pvn(ji,jj,jk)
-               END DO
-            END DO
+            DO_2D_00_00
+               zdir = 0.5 + SIGN( 0.5, pV(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0 
+               !--- If the second ustream point is a land point
+               !--- the flux is computed by the 1st order UPWIND scheme
+               zmsk = zdir * zfu(ji,jj,jk) + ( 1. - zdir ) * zfu(ji,jj+1,jk)
+               zwy(ji,jj,jk) = zmsk * zwy(ji,jj,jk) + ( 1. - zmsk ) * zfc(ji,jj,jk)
+               zwy(ji,jj,jk) = zwy(ji,jj,jk) * pV(ji,jj,jk)
+            END_2D
          END DO
          !
@@ -327,17 +287,13 @@
          !
          ! Computation of the trend
-         DO jk = 1, jpkm1  
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.  
-                  zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
-                  ! horizontal advective trends
-                  ztra = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) )
-                  !--- add it to the general tracer trends
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+            ! horizontal advective trends
+            ztra = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) )
+            !--- add it to the general tracer trends
+            pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) + ztra
+         END_3D
          !                                 ! trend diagnostics
-         IF( l_trd )   CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) )
+         IF( l_trd )   CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, pt(:,:,:,jn,Kmm) )
          !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
          IF( l_ptr )   CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) )
@@ -348,15 +304,14 @@
 
 
-   SUBROUTINE tra_adv_cen2_k( kt, cdtype, pwn,           &
-     &                                    ptn, pta, kjpt )
-      !!----------------------------------------------------------------------
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER                              , INTENT(in   ) ::   kt       ! ocean time-step index
-      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
-      INTEGER                              , INTENT(in   ) ::   kjpt     ! number of tracers
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pwn      ! vertical velocity 
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptn      ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! tracer trend 
+   SUBROUTINE tra_adv_cen2_k( kt, cdtype, pW, Kmm, pt, kjpt, Krhs )
+      !!----------------------------------------------------------------------
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER                                  , INTENT(in   ) ::   kt       ! ocean time-step index
+      INTEGER                                  , INTENT(in   ) ::   Kmm, Krhs  ! ocean time level indices
+      CHARACTER(len=3)                         , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
+      INTEGER                                  , INTENT(in   ) ::   kjpt     ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pW      ! vertical velocity 
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! active tracers and RHS of tracer equation
       !
       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
@@ -371,33 +326,23 @@
          !                                                       ! ===========
          !
-         DO jk = 2, jpkm1                    !* Interior point   (w-masked 2nd order centered flux)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk-1,jn) + ptn(ji,jj,jk,jn) ) * wmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 2, jpkm1 )
+            zwz(ji,jj,jk) = 0.5 * pW(ji,jj,jk) * ( pt(ji,jj,jk-1,jn,Kmm) + pt(ji,jj,jk,jn,Kmm) ) * wmask(ji,jj,jk)
+         END_3D
          IF( ln_linssh ) THEN                !* top value   (only in linear free surf. as zwz is multiplied by wmask)
             IF( ln_isfcav ) THEN                  ! ice-shelf cavities (top of the ocean)
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptn(ji,jj,mikt(ji,jj),jn)   ! linear free surface 
-                  END DO
-               END DO   
+               DO_2D_11_11
+                  zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kmm)   ! linear free surface 
+               END_2D
             ELSE                                   ! no ocean cavities (only ocean surface)
-               zwz(:,:,1) = pwn(:,:,1) * ptn(:,:,1,jn)
+               zwz(:,:,1) = pW(:,:,1) * pt(:,:,1,jn,Kmm)
             ENDIF
          ENDIF
          !
-         DO jk = 1, jpkm1          !==  Tracer flux divergence added to the general trend  ==!
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) )   &
-                     &                                * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) )   &
+               &                                * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+         END_3D
          !                                 ! Send trends for diagnostic
-         IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pwn, ptn(:,:,:,jn) )
+         IF( l_trd )  CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwz, pW, pt(:,:,:,jn,Kmm) )
          !
       END DO
@@ -423,33 +368,29 @@
       !----------------------------------------------------------------------
       !
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zc     = puc(ji,jj,jk)                         ! Courant number
-               zcurv  = pfd(ji,jj,jk) + pfu(ji,jj,jk) - 2. * pfc(ji,jj,jk)
-               zcoef1 = 0.5 *      ( pfc(ji,jj,jk) + pfd(ji,jj,jk) )
-               zcoef2 = 0.5 * zc * ( pfd(ji,jj,jk) - pfc(ji,jj,jk) )
-               zcoef3 = ( 1. - ( zc * zc ) ) * r1_6 * zcurv
-               zfho   = zcoef1 - zcoef2 - zcoef3              !  phi_f QUICKEST 
-               !
-               zcoef1 = pfd(ji,jj,jk) - pfu(ji,jj,jk)
-               zcoef2 = ABS( zcoef1 )
-               zcoef3 = ABS( zcurv )
-               IF( zcoef3 >= zcoef2 ) THEN
-                  zfho = pfc(ji,jj,jk) 
-               ELSE
-                  zcoef3 = pfu(ji,jj,jk) + ( ( pfc(ji,jj,jk) - pfu(ji,jj,jk) ) / MAX( zc, 1.e-9 ) )    ! phi_REF
-                  IF( zcoef1 >= 0. ) THEN
-                     zfho = MAX( pfc(ji,jj,jk), zfho ) 
-                     zfho = MIN( zfho, MIN( zcoef3, pfd(ji,jj,jk) ) ) 
-                  ELSE
-                     zfho = MIN( pfc(ji,jj,jk), zfho ) 
-                     zfho = MAX( zfho, MAX( zcoef3, pfd(ji,jj,jk) ) ) 
-                  ENDIF
-               ENDIF
-               puc(ji,jj,jk) = zfho
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpkm1 )
+         zc     = puc(ji,jj,jk)                         ! Courant number
+         zcurv  = pfd(ji,jj,jk) + pfu(ji,jj,jk) - 2. * pfc(ji,jj,jk)
+         zcoef1 = 0.5 *      ( pfc(ji,jj,jk) + pfd(ji,jj,jk) )
+         zcoef2 = 0.5 * zc * ( pfd(ji,jj,jk) - pfc(ji,jj,jk) )
+         zcoef3 = ( 1. - ( zc * zc ) ) * r1_6 * zcurv
+         zfho   = zcoef1 - zcoef2 - zcoef3              !  phi_f QUICKEST 
+         !
+         zcoef1 = pfd(ji,jj,jk) - pfu(ji,jj,jk)
+         zcoef2 = ABS( zcoef1 )
+         zcoef3 = ABS( zcurv )
+         IF( zcoef3 >= zcoef2 ) THEN
+            zfho = pfc(ji,jj,jk) 
+         ELSE
+            zcoef3 = pfu(ji,jj,jk) + ( ( pfc(ji,jj,jk) - pfu(ji,jj,jk) ) / MAX( zc, 1.e-9 ) )    ! phi_REF
+            IF( zcoef1 >= 0. ) THEN
+               zfho = MAX( pfc(ji,jj,jk), zfho ) 
+               zfho = MIN( zfho, MIN( zcoef3, pfd(ji,jj,jk) ) ) 
+            ELSE
+               zfho = MIN( pfc(ji,jj,jk), zfho ) 
+               zfho = MAX( zfho, MAX( zcoef3, pfd(ji,jj,jk) ) ) 
+            ENDIF
+         ENDIF
+         puc(ji,jj,jk) = zfho
+      END_3D
       !
    END SUBROUTINE quickest
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traadv_ubs.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traadv_ubs.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traadv_ubs.F90	(revision 12928)
@@ -38,5 +38,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -46,6 +46,6 @@
 CONTAINS
 
-   SUBROUTINE tra_adv_ubs( kt, kit000, cdtype, p2dt, pun, pvn, pwn,          &
-      &                                                ptb, ptn, pta, kjpt, kn_ubs_v )
+   SUBROUTINE tra_adv_ubs( kt, kit000, cdtype, p2dt, pU, pV, pW,          &
+      &                    Kbb, Kmm, pt, kjpt, Krhs, kn_ubs_v )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_adv_ubs  ***
@@ -77,20 +77,20 @@
       !!      scheme (kn_ubs_v=4).
       !!
-      !! ** Action : - update pta  with the now advective tracer trends
+      !! ** Action : - update pt(:,:,:,:,Krhs)  with the now advective tracer trends
       !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T)
-      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T)
+      !!             - poleward advective heat and salt transport (ln_diaptr=T)
       !!
       !! Reference : Shchepetkin, A. F., J. C. McWilliams, 2005, Ocean Modelling, 9, 347-404. 
       !!             Farrow, D.E., Stevens, D.P., 1995, J. Phys. Ocean. 25, 1731Ð1741. 
       !!----------------------------------------------------------------------
-      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
-      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
-      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
-      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
-      INTEGER                              , INTENT(in   ) ::   kn_ubs_v        ! number of tracers
-      REAL(wp)                             , INTENT(in   ) ::   p2dt            ! tracer time-step
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean transport components
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      INTEGER                                  , INTENT(in   ) ::   kt              ! ocean time-step index
+      INTEGER                                  , INTENT(in   ) ::   Kbb, Kmm, Krhs  ! ocean time level indices
+      INTEGER                                  , INTENT(in   ) ::   kit000          ! first time step index
+      CHARACTER(len=3)                         , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER                                  , INTENT(in   ) ::   kjpt            ! number of tracers
+      INTEGER                                  , INTENT(in   ) ::   kn_ubs_v        ! number of tracers
+      REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume transport components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation
       !
       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
@@ -111,5 +111,5 @@
       l_ptr = .FALSE.
       IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )      l_trd = .TRUE.
-      IF(   cdtype == 'TRA' .AND. ln_diaptr )                                               l_ptr = .TRUE. 
+      IF(   cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) )  )   l_ptr = .TRUE. 
       IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
          &                          iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) ) l_hst = .TRUE.
@@ -124,59 +124,49 @@
          !                                              
          DO jk = 1, jpkm1        !==  horizontal laplacian of before tracer ==!
-            DO jj = 1, jpjm1              ! First derivative (masked gradient)
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zeeu = e2_e1u(ji,jj) * e3u_n(ji,jj,jk) * umask(ji,jj,jk)
-                  zeev = e1_e2v(ji,jj) * e3v_n(ji,jj,jk) * vmask(ji,jj,jk)
-                  ztu(ji,jj,jk) = zeeu * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) )
-                  ztv(ji,jj,jk) = zeev * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
-               END DO
-            END DO
-            DO jj = 2, jpjm1              ! Second derivative (divergence)
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zcoef = 1._wp / ( 6._wp * e3t_n(ji,jj,jk) )
-                  zltu(ji,jj,jk) = (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)  ) * zcoef
-                  zltv(ji,jj,jk) = (  ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) * zcoef
-               END DO
-            END DO
+            DO_2D_10_10
+               zeeu = e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) * umask(ji,jj,jk)
+               zeev = e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) * vmask(ji,jj,jk)
+               ztu(ji,jj,jk) = zeeu * ( pt(ji+1,jj  ,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) )
+               ztv(ji,jj,jk) = zeev * ( pt(ji  ,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) )
+            END_2D
+            DO_2D_00_00
+               zcoef = 1._wp / ( 6._wp * e3t(ji,jj,jk,Kmm) )
+               zltu(ji,jj,jk) = (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)  ) * zcoef
+               zltv(ji,jj,jk) = (  ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) * zcoef
+            END_2D
             !                                    
          END DO         
          CALL lbc_lnk( 'traadv_ubs', zltu, 'T', 1. )   ;    CALL lbc_lnk( 'traadv_ubs', zltv, 'T', 1. )   ! Lateral boundary cond. (unchanged sgn)
          !    
-         DO jk = 1, jpkm1        !==  Horizontal advective fluxes  ==!     (UBS)
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )      ! upstream transport (x2)
-                  zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) )
-                  zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) )
-                  zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) )
-                  !                                                  ! 2nd order centered advective fluxes (x2)
-                  zcenut = pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn) )
-                  zcenvt = pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn) )
-                  !                                                  ! UBS advective fluxes
-                  ztu(ji,jj,jk) = 0.5 * ( zcenut - zfp_ui * zltu(ji,jj,jk) - zfm_ui * zltu(ji+1,jj,jk) )
-                  ztv(ji,jj,jk) = 0.5 * ( zcenvt - zfp_vj * zltv(ji,jj,jk) - zfm_vj * zltv(ji,jj+1,jk) )
-               END DO
-            END DO
-         END DO         
-         !
-         zltu(:,:,:) = pta(:,:,:,jn)      ! store the initial trends before its update
+         DO_3D_10_10( 1, jpkm1 )
+            zfp_ui = pU(ji,jj,jk) + ABS( pU(ji,jj,jk) )      ! upstream transport (x2)
+            zfm_ui = pU(ji,jj,jk) - ABS( pU(ji,jj,jk) )
+            zfp_vj = pV(ji,jj,jk) + ABS( pV(ji,jj,jk) )
+            zfm_vj = pV(ji,jj,jk) - ABS( pV(ji,jj,jk) )
+            !                                                  ! 2nd order centered advective fluxes (x2)
+            zcenut = pU(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm) )
+            zcenvt = pV(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm) )
+            !                                                  ! UBS advective fluxes
+            ztu(ji,jj,jk) = 0.5 * ( zcenut - zfp_ui * zltu(ji,jj,jk) - zfm_ui * zltu(ji+1,jj,jk) )
+            ztv(ji,jj,jk) = 0.5 * ( zcenvt - zfp_vj * zltv(ji,jj,jk) - zfm_vj * zltv(ji,jj+1,jk) )
+         END_3D
+         !
+         zltu(:,:,:) = pt(:,:,:,jn,Krhs)      ! store the initial trends before its update
          !
          DO jk = 1, jpkm1        !==  add the horizontal advective trend  ==!
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                        &
-                     &             - (  ztu(ji,jj,jk) - ztu(ji-1,jj  ,jk)    &
-                     &                + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk)  ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
-               END DO
-            END DO
+            DO_2D_00_00
+               pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs)                        &
+                  &             - (  ztu(ji,jj,jk) - ztu(ji-1,jj  ,jk)    &
+                  &                + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk)  ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+            END_2D
             !                                             
          END DO
          !
-         zltu(:,:,:) = pta(:,:,:,jn) - zltu(:,:,:)    ! Horizontal advective trend used in vertical 2nd order FCT case
+         zltu(:,:,:) = pt(:,:,:,jn,Krhs) - zltu(:,:,:)    ! Horizontal advective trend used in vertical 2nd order FCT case
          !                                            ! and/or in trend diagnostic (l_trd=T) 
          !                
          IF( l_trd ) THEN                  ! trend diagnostics
-             CALL trd_tra( kt, cdtype, jn, jptra_xad, ztu, pun, ptn(:,:,:,jn) )
-             CALL trd_tra( kt, cdtype, jn, jptra_yad, ztv, pvn, ptn(:,:,:,jn) )
+             CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztu, pU, pt(:,:,:,jn,Kmm) )
+             CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztv, pV, pt(:,:,:,jn,Kmm) )
          END IF
          !     
@@ -193,85 +183,59 @@
          CASE(  2  )                   ! 2nd order FCT 
             !         
-            IF( l_trd )   zltv(:,:,:) = pta(:,:,:,jn)          ! store pta if trend diag.
+            IF( l_trd )   zltv(:,:,:) = pt(:,:,:,jn,Krhs)          ! store pt(:,:,:,:,Krhs) if trend diag.
             !
             !                          !*  upstream advection with initial mass fluxes & intermediate update  ==!
-            DO jk = 2, jpkm1                 ! Interior value (w-masked)
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
-                     zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
-                     ztw(ji,jj,jk) = 0.5_wp * (  zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn)  ) * wmask(ji,jj,jk)
-                  END DO
-               END DO
-            END DO 
+            DO_3D_11_11( 2, jpkm1 )
+               zfp_wk = pW(ji,jj,jk) + ABS( pW(ji,jj,jk) )
+               zfm_wk = pW(ji,jj,jk) - ABS( pW(ji,jj,jk) )
+               ztw(ji,jj,jk) = 0.5_wp * (  zfp_wk * pt(ji,jj,jk,jn,Kbb) + zfm_wk * pt(ji,jj,jk-1,jn,Kbb)  ) * wmask(ji,jj,jk)
+            END_3D
             IF( ln_linssh ) THEN             ! top ocean value (only in linear free surface as ztw has been w-masked)
                IF( ln_isfcav ) THEN                ! top of the ice-shelf cavities and at the ocean surface
-                  DO jj = 1, jpj
-                     DO ji = 1, jpi
-                        ztw(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)   ! linear free surface 
-                     END DO
-                  END DO   
+                  DO_2D_11_11
+                     ztw(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb)   ! linear free surface 
+                  END_2D
                ELSE                                ! no cavities: only at the ocean surface
-                  ztw(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)
+                  ztw(:,:,1) = pW(:,:,1) * pt(:,:,1,jn,Kbb)
                ENDIF
             ENDIF
             !
-            DO jk = 1, jpkm1           !* trend and after field with monotonic scheme
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
-                     pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn) +  ztak 
-                     zti(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + p2dt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
+            DO_3D_00_00( 1, jpkm1 )
+               ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+               pt(ji,jj,jk,jn,Krhs) =   pt(ji,jj,jk,jn,Krhs) +  ztak 
+               zti(ji,jj,jk)    = ( pt(ji,jj,jk,jn,Kbb) + p2dt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk)
+            END_3D
             CALL lbc_lnk( 'traadv_ubs', zti, 'T', 1. )      ! Lateral boundary conditions on zti, zsi   (unchanged sign)
             !
             !                          !*  anti-diffusive flux : high order minus low order
-            DO jk = 2, jpkm1        ! Interior value  (w-masked)
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     ztw(ji,jj,jk) = (   0.5_wp * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) )   &
-                        &              - ztw(ji,jj,jk)   ) * wmask(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
+            DO_3D_11_11( 2, jpkm1 )
+               ztw(ji,jj,jk) = (   0.5_wp * pW(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) )   &
+                  &              - ztw(ji,jj,jk)   ) * wmask(ji,jj,jk)
+            END_3D
             !                                            ! top ocean value: high order == upstream  ==>>  zwz=0
             IF( ln_linssh )   ztw(:,:, 1 ) = 0._wp       ! only ocean surface as interior zwz values have been w-masked
             !
-            CALL nonosc_z( ptb(:,:,:,jn), ztw, zti, p2dt )      !  monotonicity algorithm
+            CALL nonosc_z( Kmm, pt(:,:,:,jn,Kbb), ztw, zti, p2dt )      !  monotonicity algorithm
             !
          CASE(  4  )                               ! 4th order COMPACT
-            CALL interp_4th_cpt( ptn(:,:,:,jn) , ztw )         ! 4th order compact interpolation of T at w-point
-            DO jk = 2, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     ztw(ji,jj,jk) = pwn(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
-            IF( ln_linssh )   ztw(:,:, 1 ) = pwn(:,:,1) * ptn(:,:,1,jn)     !!gm ISF & 4th COMPACT doesn't work
+            CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw )         ! 4th order compact interpolation of T at w-point
+            DO_3D_00_00( 2, jpkm1 )
+               ztw(ji,jj,jk) = pW(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk)
+            END_3D
+            IF( ln_linssh )   ztw(:,:, 1 ) = pW(:,:,1) * pt(:,:,1,jn,Kmm)     !!gm ISF & 4th COMPACT doesn't work
             !
          END SELECT
          !
-         DO jk = 1, jpkm1        !  final trend with corrected fluxes
-            DO jj = 2, jpjm1 
-               DO ji = fs_2, fs_jpim1   ! vector opt.   
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+         END_3D
          !
          IF( l_trd )  THEN       ! vertical advective trend diagnostics
-            DO jk = 1, jpkm1                       ! (compute -w.dk[ptn]= -dk[w.ptn] + ptn.dk[w])
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     zltv(ji,jj,jk) = pta(ji,jj,jk,jn) - zltv(ji,jj,jk)                          &
-                        &           + ptn(ji,jj,jk,jn) * (  pwn(ji,jj,jk) - pwn(ji,jj,jk+1)  )   &
-                        &                              * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
-            CALL trd_tra( kt, cdtype, jn, jptra_zad, zltv )
+            DO_3D_00_00( 1, jpkm1 )
+               zltv(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs) - zltv(ji,jj,jk)                          &
+                  &           + pt(ji,jj,jk,jn,Kmm) * (  pW(ji,jj,jk) - pW(ji,jj,jk+1)  )   &
+                  &                              * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+            END_3D
+            CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zltv )
          ENDIF
          !
@@ -281,5 +245,5 @@
 
 
-   SUBROUTINE nonosc_z( pbef, pcc, paft, p2dt )
+   SUBROUTINE nonosc_z( Kmm, pbef, pcc, paft, p2dt )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE nonosc_z  ***
@@ -294,4 +258,5 @@
       !!       in-space based differencing for fluid
       !!----------------------------------------------------------------------
+      INTEGER , INTENT(in   )                          ::   Kmm    ! time level index
       REAL(wp), INTENT(in   )                          ::   p2dt   ! tracer time-step
       REAL(wp),                DIMENSION (jpi,jpj,jpk) ::   pbef   ! before field
@@ -317,11 +282,9 @@
       DO jk = 1, jpkm1     ! search maximum in neighbourhood
          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  ,jj  ,ikm1), pbef(ji  ,jj  ,jk+1),   &
-                  &                     paft(ji  ,jj  ,ikm1), paft(ji  ,jj  ,jk+1)  )
-            END DO
-         END DO
+         DO_2D_00_00
+            zbetup(ji,jj,jk) = MAX(  pbef(ji  ,jj  ,jk  ), paft(ji  ,jj  ,jk  ),   &
+               &                     pbef(ji  ,jj  ,ikm1), pbef(ji  ,jj  ,jk+1),   &
+               &                     paft(ji  ,jj  ,ikm1), paft(ji  ,jj  ,jk+1)  )
+         END_2D
       END DO
       !                    ! large positive value (+zbig) inside land
@@ -331,11 +294,9 @@
       DO jk = 1, jpkm1     ! search minimum in neighbourhood
          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  ,jj  ,ikm1), pbef(ji  ,jj  ,jk+1),   &
-                  &                     paft(ji  ,jj  ,ikm1), paft(ji  ,jj  ,jk+1)  )
-            END DO
-         END DO
+         DO_2D_00_00
+            zbetdo(ji,jj,jk) = MIN(  pbef(ji  ,jj  ,jk  ), paft(ji  ,jj  ,jk  ),   &
+               &                     pbef(ji  ,jj  ,ikm1), pbef(ji  ,jj  ,jk+1),   &
+               &                     paft(ji  ,jj  ,ikm1), paft(ji  ,jj  ,jk+1)  )
+         END_2D
       END DO
       !                    ! restore masked values to zero
@@ -345,30 +306,22 @@
       ! Positive and negative part of fluxes and beta terms
       ! ---------------------------------------------------
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ! positive & negative part of the flux
-               zpos = MAX( 0., pcc(ji  ,jj  ,jk+1) ) - MIN( 0., pcc(ji  ,jj  ,jk  ) )
-               zneg = MAX( 0., pcc(ji  ,jj  ,jk  ) ) - MIN( 0., pcc(ji  ,jj  ,jk+1) )
-               ! up & down beta terms
-               zbt = e1e2t(ji,jj) * e3t_n(ji,jj,jk) / p2dt
-               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
+      DO_3D_00_00( 1, jpkm1 )
+         ! positive & negative part of the flux
+         zpos = MAX( 0., pcc(ji  ,jj  ,jk+1) ) - MIN( 0., pcc(ji  ,jj  ,jk  ) )
+         zneg = MAX( 0., pcc(ji  ,jj  ,jk  ) ) - MIN( 0., pcc(ji  ,jj  ,jk+1) )
+         ! up & down beta terms
+         zbt = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) / p2dt
+         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_3D
       !
       ! 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.
-               za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji,jj,jk-1) )
-               zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji,jj,jk-1) )
-               zc = 0.5 * ( 1.e0 + SIGN( 1.e0, pcc(ji,jj,jk) ) )
-               pcc(ji,jj,jk) = pcc(ji,jj,jk) * ( zc * za + ( 1.e0 - zc) * zb )
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 2, jpkm1 )
+         za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji,jj,jk-1) )
+         zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji,jj,jk-1) )
+         zc = 0.5 * ( 1.e0 + SIGN( 1.e0, pcc(ji,jj,jk) ) )
+         pcc(ji,jj,jk) = pcc(ji,jj,jk) * ( zc * za + ( 1.e0 - zc) * zb )
+      END_3D
       !
    END SUBROUTINE nonosc_z
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traatf.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traatf.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traatf.F90	(revision 12928)
@@ -0,0 +1,387 @@
+MODULE traatf
+   !!======================================================================
+   !!                       ***  MODULE  traatf  ***
+   !! Ocean active tracers:  Asselin time filtering for temperature and salinity
+   !!======================================================================
+   !! History :  OPA  !  1991-11  (G. Madec)  Original code
+   !!            7.0  !  1993-03  (M. Guyon)  symetrical conditions
+   !!            8.0  !  1996-02  (G. Madec & M. Imbard)  opa release 8.0
+   !!             -   !  1996-04  (A. Weaver)  Euler forward step
+   !!            8.2  !  1999-02  (G. Madec, N. Grima)  semi-implicit pressure grad.
+   !!  NEMO      1.0  !  2002-08  (G. Madec)  F90: Free form and module
+   !!             -   !  2002-11  (C. Talandier, A-M Treguier) Open boundaries
+   !!             -   !  2005-04  (C. Deltel) Add Asselin trend in the ML budget
+   !!            2.0  !  2006-02  (L. Debreu, C. Mazauric) Agrif implementation
+   !!            3.0  !  2008-06  (G. Madec)  time stepping always done in trazdf
+   !!            3.1  !  2009-02  (G. Madec, R. Benshila)  re-introduce the vvl option
+   !!            3.3  !  2010-04  (M. Leclair, G. Madec)  semi-implicit hpg with asselin filter + modified LF-RA
+   !!             -   !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA
+   !!            4.1  !  2019-08  (A. Coward, D. Storkey) rename tranxt.F90 -> traatf.F90. Now only does time filtering.
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_atf       : time filtering on tracers
+   !!   tra_atf_fix   : time filtering on tracers : fixed    volume case
+   !!   tra_atf_vvl   : time filtering on tracers : variable volume case
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE sbc_oce         ! surface boundary condition: ocean
+   USE sbcrnf          ! river runoffs
+   USE isf_oce         ! ice shelf melting
+   USE zdf_oce         ! ocean vertical mixing
+   USE domvvl          ! variable volume
+   USE trd_oce         ! trends: ocean variables
+   USE trdtra          ! trends manager: tracers 
+   USE traqsr          ! penetrative solar radiation (needed for nksr)
+   USE phycst          ! physical constant
+   USE ldftra          ! lateral physics : tracers
+   USE ldfslp          ! lateral physics : slopes
+   USE bdy_oce  , ONLY : ln_bdy
+   USE bdytra          ! open boundary condition (bdy_tra routine)
+   !
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE prtctl          ! Print control
+   USE timing          ! Timing
+#if defined key_agrif
+   USE agrif_oce_interp
+#endif
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_atf       ! routine called by step.F90
+   PUBLIC   tra_atf_fix   ! to be used in trcnxt
+   PUBLIC   tra_atf_vvl   ! to be used in trcnxt
+
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id$
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_atf( kt, Kbb, Kmm, Kaa, pts )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE traatf  ***
+      !!
+      !! ** Purpose :   Apply the boundary condition on the after temperature  
+      !!             and salinity fields and add the Asselin time filter on now fields.
+      !! 
+      !! ** Method  :   At this stage of the computation, ta and sa are the 
+      !!             after temperature and salinity as the time stepping has
+      !!             been performed in trazdf_imp or trazdf_exp module.
+      !!
+      !!              - Apply lateral boundary conditions on (ta,sa) 
+      !!             at the local domain   boundaries through lbc_lnk call, 
+      !!             at the one-way open boundaries (ln_bdy=T), 
+      !!             at the AGRIF zoom   boundaries (lk_agrif=T)
+      !!
+      !!              - Update lateral boundary conditions on AGRIF children
+      !!             domains (lk_agrif=T)
+      !!
+      !! ** Action  : - ts(Kmm) time filtered
+      !!----------------------------------------------------------------------
+      INTEGER                                  , INTENT(in   ) :: kt             ! ocean time-step index
+      INTEGER                                  , INTENT(in   ) :: Kbb, Kmm, Kaa  ! time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts            ! active tracers 
+      !!
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   zfact            ! local scalars
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds
+      !!----------------------------------------------------------------------
+      !
+      IF( ln_timing )   CALL timing_start( 'tra_atf')
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_atf : apply Asselin time filter to "now" fields'
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+      ENDIF
+
+      ! Update after tracer on domain lateral boundaries
+      ! 
+#if defined key_agrif
+      CALL Agrif_tra                     ! AGRIF zoom boundaries
+#endif
+      !                                              ! local domain boundaries  (T-point, unchanged sign)
+      CALL lbc_lnk_multi( 'traatf', pts(:,:,:,jp_tem,Kaa), 'T', 1., pts(:,:,:,jp_sal,Kaa), 'T', 1. )
+      !
+      IF( ln_bdy )   CALL bdy_tra( kt, Kbb, pts, Kaa )  ! BDY open boundaries
+ 
+      ! trends computation initialisation
+      IF( l_trdtra )   THEN                    
+         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )
+         ztrdt(:,:,jpk) = 0._wp
+         ztrds(:,:,jpk) = 0._wp
+         IF( ln_traldf_iso ) THEN              ! diagnose the "pure" Kz diffusive trend 
+            CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_tem, jptra_zdfp, ztrdt )
+            CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_sal, jptra_zdfp, ztrds )
+         ENDIF
+         ! total trend for the non-time-filtered variables. 
+         zfact = 1.0 / rn_Dt
+         ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from pts(Kmm) terms
+         DO jk = 1, jpkm1
+            ztrdt(:,:,jk) = ( pts(:,:,jk,jp_tem,Kaa)*e3t(:,:,jk,Kaa) / e3t(:,:,jk,Kmm) - pts(:,:,jk,jp_tem,Kmm)) * zfact
+            ztrds(:,:,jk) = ( pts(:,:,jk,jp_sal,Kaa)*e3t(:,:,jk,Kaa) / e3t(:,:,jk,Kmm) - pts(:,:,jk,jp_sal,Kmm)) * zfact
+         END DO
+         CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_tem, jptra_tot, ztrdt )
+         CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_sal, jptra_tot, ztrds )
+         IF( ln_linssh ) THEN       ! linear sea surface height only
+            ! Store now fields before applying the Asselin filter 
+            ! in order to calculate Asselin filter trend later.
+            ztrdt(:,:,:) = pts(:,:,:,jp_tem,Kmm) 
+            ztrds(:,:,:) = pts(:,:,:,jp_sal,Kmm)
+         ENDIF
+      ENDIF
+
+      IF( l_1st_euler ) THEN       ! Euler time-stepping 
+         !
+         IF (l_trdtra .AND. .NOT. ln_linssh ) THEN   ! Zero Asselin filter contribution must be explicitly written out since for vvl
+            !                                        ! Asselin filter is output by tra_atf_vvl that is not called on this time step
+            ztrdt(:,:,:) = 0._wp
+            ztrds(:,:,:) = 0._wp
+            CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_tem, jptra_atf, ztrdt )
+            CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_sal, jptra_atf, ztrds )
+         END IF
+         !
+      ELSE                                            ! Leap-Frog + Asselin filter time stepping
+         !
+         IF( ln_linssh ) THEN   ;   CALL tra_atf_fix( kt, Kbb, Kmm, Kaa, nit000,        'TRA', pts, jpts )  ! linear free surface 
+         ELSE                   ;   CALL tra_atf_vvl( kt, Kbb, Kmm, Kaa, nit000, rn_Dt, 'TRA', pts, sbc_tsc, sbc_tsc_b, jpts )  ! non-linear free surface
+         ENDIF
+         !
+         CALL lbc_lnk_multi( 'traatf', pts(:,:,:,jp_tem,Kbb) , 'T', 1., pts(:,:,:,jp_sal,Kbb) , 'T', 1., &
+                  &                    pts(:,:,:,jp_tem,Kmm) , 'T', 1., pts(:,:,:,jp_sal,Kmm) , 'T', 1., &
+                  &                    pts(:,:,:,jp_tem,Kaa), 'T', 1., pts(:,:,:,jp_sal,Kaa), 'T', 1.  )
+         !
+      ENDIF     
+      !
+      IF( l_trdtra .AND. ln_linssh ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt     
+         zfact = 1._wp / rDt             
+         DO jk = 1, jpkm1
+            ztrdt(:,:,jk) = ( pts(:,:,jk,jp_tem,Kmm) - ztrdt(:,:,jk) ) * zfact
+            ztrds(:,:,jk) = ( pts(:,:,jk,jp_sal,Kmm) - ztrds(:,:,jk) ) * zfact
+         END DO
+         CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_tem, jptra_atf, ztrdt )
+         CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_sal, jptra_atf, ztrds )
+      END IF
+      IF( l_trdtra )   DEALLOCATE( ztrdt , ztrds )
+      !
+      !                        ! control print
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Kmm), clinfo1=' nxt  - Tn: ', mask1=tmask,   &
+         &                                  tab3d_2=pts(:,:,:,jp_sal,Kmm), clinfo2=       ' Sn: ', mask2=tmask )
+      !
+      IF( ln_timing )   CALL timing_stop('tra_atf')
+      !
+   END SUBROUTINE tra_atf
+
+
+   SUBROUTINE tra_atf_fix( kt, Kbb, Kmm, Kaa, kit000, cdtype, pt, kjpt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE tra_atf_fix  ***
+      !!
+      !! ** Purpose :   fixed volume: apply the Asselin time filter to the "now" field
+      !! 
+      !! ** Method  : - Apply a Asselin time filter on now fields.
+      !!
+      !! ** Action  : - pt(Kmm) ready for the next time step
+      !!----------------------------------------------------------------------
+      INTEGER                                  , INTENT(in   ) ::  kt            ! ocean time-step index
+      INTEGER                                  , INTENT(in   ) ::  Kbb, Kmm, Kaa ! time level indices
+      INTEGER                                  , INTENT(in   ) ::  kit000        ! first time step index
+      CHARACTER(len=3)                         , INTENT(in   ) ::  cdtype        ! =TRA or TRC (tracer indicator)
+      INTEGER                                  , INTENT(in   ) ::  kjpt          ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::  pt            ! tracer fields
+      !
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   ztn, ztd         ! local scalars
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_atf_fix : time filtering', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+      !
+      DO jn = 1, kjpt
+         !
+         DO_3D_00_00( 1, jpkm1 )
+            ztn = pt(ji,jj,jk,jn,Kmm)                                    
+            ztd = pt(ji,jj,jk,jn,Kaa) - 2._wp * ztn + pt(ji,jj,jk,jn,Kbb)  ! time laplacian on tracers
+            !
+            pt(ji,jj,jk,jn,Kmm) = ztn + rn_atfp * ztd                      ! pt <-- filtered pt
+         END_3D
+         !
+      END DO
+      !
+   END SUBROUTINE tra_atf_fix
+
+
+   SUBROUTINE tra_atf_vvl( kt, Kbb, Kmm, Kaa, kit000, p2dt, cdtype, pt, psbc_tc, psbc_tc_b, kjpt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE tra_atf_vvl  ***
+      !!
+      !! ** Purpose :   Time varying volume: apply the Asselin time filter  
+      !! 
+      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields.
+      !!             pt(Kmm)  = ( e3t(Kmm)*pt(Kmm) + rn_atfp*[ e3t(Kbb)*pt(Kbb) - 2 e3t(Kmm)*pt(Kmm) + e3t_a*pt(Kaa) ] )
+      !!                       /( e3t(Kmm)         + rn_atfp*[ e3t(Kbb)         - 2 e3t(Kmm)         + e3t(Kaa)    ] )
+      !!
+      !! ** Action  : - pt(Kmm) ready for the next time step
+      !!----------------------------------------------------------------------
+      INTEGER                                  , INTENT(in   ) ::  kt        ! ocean time-step index
+      INTEGER                                  , INTENT(in   ) ::  Kbb, Kmm, Kaa ! time level indices
+      INTEGER                                  , INTENT(in   ) ::  kit000    ! first time step index
+      REAL(wp)                                 , INTENT(in   ) ::  p2dt      ! time-step
+      CHARACTER(len=3)                         , INTENT(in   ) ::  cdtype    ! =TRA or TRC (tracer indicator)
+      INTEGER                                  , INTENT(in   ) ::  kjpt      ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::  pt        ! tracer fields
+      REAL(wp), DIMENSION(jpi,jpj    ,kjpt)    , INTENT(in   ) ::  psbc_tc   ! surface tracer content
+      REAL(wp), DIMENSION(jpi,jpj    ,kjpt)    , INTENT(in   ) ::  psbc_tc_b ! before surface tracer content
+      !
+      LOGICAL  ::   ll_traqsr, ll_rnf, ll_isf   ! local logical
+      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
+      REAL(wp) ::   zfact, zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar
+      REAL(wp) ::   zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d, zscale  !   -      -
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   ztrd_atf
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_atf_vvl : time filtering', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+      !
+      IF( cdtype == 'TRA' )  THEN   
+         ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration
+         ll_rnf     = ln_rnf           ! active  tracers case  and  river runoffs
+         ll_isf     = ln_isf           ! active  tracers case  and  ice shelf melting
+      ELSE                          ! passive tracers case
+         ll_traqsr  = .FALSE.          ! NO solar penetration
+         ll_rnf     = .FALSE.          ! NO river runoffs ????          !!gm BUG ?  
+         ll_isf     = .FALSE.          ! NO ice shelf melting/freezing  !!gm BUG ?? 
+      ENDIF
+      !
+      IF( ( l_trdtra .AND. cdtype == 'TRA' ) .OR. ( l_trdtrc .AND. cdtype == 'TRC' ) )   THEN
+         ALLOCATE( ztrd_atf(jpi,jpj,jpk,kjpt) )
+         ztrd_atf(:,:,:,:) = 0.0_wp
+      ENDIF
+      zfact = 1._wp / p2dt
+      zfact1 = rn_atfp * p2dt
+      zfact2 = zfact1 * r1_rho0
+      DO jn = 1, kjpt      
+         DO_3D_00_00( 1, jpkm1 )
+            ze3t_b = e3t(ji,jj,jk,Kbb)
+            ze3t_n = e3t(ji,jj,jk,Kmm)
+            ze3t_a = e3t(ji,jj,jk,Kaa)
+            !                                         ! tracer content at Before, now and after
+            ztc_b  = pt(ji,jj,jk,jn,Kbb) * ze3t_b
+            ztc_n  = pt(ji,jj,jk,jn,Kmm) * ze3t_n
+            ztc_a  = pt(ji,jj,jk,jn,Kaa) * ze3t_a
+            !
+            ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b
+            ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b
+            !
+            ze3t_f = ze3t_n + rn_atfp * ze3t_d
+            ztc_f  = ztc_n  + rn_atfp * ztc_d
+            !
+            ! Add asselin correction on scale factors:
+            zscale = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm) / ( ht(ji,jj) + 1._wp - ssmask(ji,jj) ) 
+            ze3t_f = ze3t_f - zfact2 * zscale * ( emp_b(ji,jj) - emp(ji,jj) ) 
+            IF ( ll_rnf ) ze3t_f = ze3t_f + zfact2 * zscale * (    rnf_b(ji,jj) -    rnf(ji,jj) ) 
+            IF ( ll_isf ) THEN
+               IF ( ln_isfcav_mlt ) ze3t_f = ze3t_f - zfact2 * zscale * ( fwfisf_cav_b(ji,jj) - fwfisf_cav(ji,jj) )
+               IF ( ln_isfpar_mlt ) ze3t_f = ze3t_f - zfact2 * zscale * ( fwfisf_par_b(ji,jj) - fwfisf_par(ji,jj) )
+            ENDIF
+            !
+            IF( jk == mikt(ji,jj) ) THEN           ! first level 
+               ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
+            ENDIF
+            !
+            ! solar penetration (temperature only)
+            IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )                            & 
+               &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 
+               !
+            !
+            IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )                                          &
+               &     ztc_f  = ztc_f  - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) & 
+               &                              * e3t(ji,jj,jk,Kmm) / h_rnf(ji,jj)
+
+            !
+            ! ice shelf
+            IF( ll_isf ) THEN
+               !
+               ! melt in the cavity
+               IF ( ln_isfcav_mlt ) THEN
+                  ! level fully include in the Losch_2008 ice shelf boundary layer
+                  IF ( jk >= misfkt_cav(ji,jj) .AND. jk < misfkb_cav(ji,jj) ) THEN
+                     ztc_f  = ztc_f  - zfact1 * ( risf_cav_tsc(ji,jj,jn) - risf_cav_tsc_b(ji,jj,jn) ) &
+                        &                     * e3t(ji,jj,jk,Kmm) / rhisf_tbl_cav(ji,jj)
+                  END IF
+                  ! level partially include in Losch_2008 ice shelf boundary layer 
+                  IF ( jk == misfkb_cav(ji,jj) ) THEN
+                     ztc_f  = ztc_f  - zfact1 * ( risf_cav_tsc(ji,jj,jn) - risf_cav_tsc_b(ji,jj,jn) )  &
+                            &                 * e3t(ji,jj,jk,Kmm) / rhisf_tbl_cav(ji,jj) * rfrac_tbl_cav(ji,jj)
+                  END IF
+               END IF
+               !
+               ! parametrised melt (cavity closed)
+               IF ( ln_isfpar_mlt ) THEN
+                  ! level fully include in the Losch_2008 ice shelf boundary layer
+                  IF ( jk >= misfkt_par(ji,jj) .AND. jk < misfkb_par(ji,jj) ) THEN
+                     ztc_f  = ztc_f  - zfact1 * ( risf_par_tsc(ji,jj,jn) - risf_par_tsc_b(ji,jj,jn) )  &
+                            &                 * e3t(ji,jj,jk,Kmm) / rhisf_tbl_par(ji,jj)
+                  END IF
+                  ! level partially include in Losch_2008 ice shelf boundary layer 
+                  IF ( jk == misfkb_par(ji,jj) ) THEN
+                     ztc_f  = ztc_f  - zfact1 * ( risf_par_tsc(ji,jj,jn) - risf_par_tsc_b(ji,jj,jn) )  &
+                            &                 * e3t(ji,jj,jk,Kmm) / rhisf_tbl_par(ji,jj) * rfrac_tbl_par(ji,jj)
+                  END IF
+               END IF
+               !
+               ! ice sheet coupling correction
+               IF ( ln_isfcpl ) THEN
+                  !
+                  ! at kt = nit000,  risfcpl_vol_n = 0 and risfcpl_vol_b = risfcpl_vol so contribution nul
+                  IF ( ln_rstart .AND. kt == nit000+1 ) THEN
+                     ztc_f  = ztc_f  + zfact1 * risfcpl_tsc(ji,jj,jk,jn) * r1_e1e2t(ji,jj)
+                     ! Shouldn't volume increment be spread according thanks to zscale  ?
+                     ze3t_f = ze3t_f - zfact1 * risfcpl_vol(ji,jj,jk   ) * r1_e1e2t(ji,jj)
+                  END IF
+                  !
+               END IF
+               !
+            END IF
+            !
+            ze3t_f = 1.e0 / ze3t_f
+            pt(ji,jj,jk,jn,Kmm) = ztc_f * ze3t_f    ! time filtered "now" field
+            !
+            IF( ( l_trdtra .and. cdtype == 'TRA' ) .OR. ( l_trdtrc .and. cdtype == 'TRC' ) ) THEN
+               ztrd_atf(ji,jj,jk,jn) = (ztc_f - ztc_n) * zfact/ze3t_n
+            ENDIF
+            !
+         END_3D
+         ! 
+      END DO
+      !
+      IF( ( l_trdtra .AND. cdtype == 'TRA' ) .OR. ( l_trdtrc .AND. cdtype == 'TRC' ) )   THEN
+         IF( l_trdtra .AND. cdtype == 'TRA' ) THEN 
+            CALL trd_tra( kt, Kmm, Kaa, cdtype, jp_tem, jptra_atf, ztrd_atf(:,:,:,jp_tem) )
+            CALL trd_tra( kt, Kmm, Kaa, cdtype, jp_sal, jptra_atf, ztrd_atf(:,:,:,jp_sal) )
+         ENDIF
+         IF( l_trdtrc .AND. cdtype == 'TRC' ) THEN
+            DO jn = 1, kjpt
+               CALL trd_tra( kt, Kmm, Kaa, cdtype, jn, jptra_atf, ztrd_atf(:,:,:,jn) )
+            END DO
+         ENDIF
+         DEALLOCATE( ztrd_atf )
+      ENDIF
+      !
+   END SUBROUTINE tra_atf_vvl
+
+   !!======================================================================
+END MODULE traatf
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/trabbc.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/trabbc.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/trabbc.F90	(revision 12928)
@@ -44,4 +44,6 @@
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_qgh   ! structure of input qgh (file informations, fields read)
  
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -51,5 +53,5 @@
 CONTAINS
 
-   SUBROUTINE tra_bbc( kt )
+   SUBROUTINE tra_bbc( kt, Kmm, pts, Krhs )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_bbc  ***
@@ -64,5 +66,5 @@
       !!       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= mbkt
+      !!            ta = ta + Qsf / (rho0 rcp e3T) for k= mbkt
       !!       Where Qsf is the geothermal heat flux.
       !!
@@ -73,5 +75,7 @@
       !!              Emile-Geay and Madec, 2009, Ocean Science.
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER,                                   INTENT(in   ) :: kt         ! ocean time-step index
+      INTEGER,                                   INTENT(in   ) :: Kmm, Krhs  ! time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts        ! active tracers and RHS of tracer equation
       !
       INTEGER  ::   ji, jj    ! dummy loop indices
@@ -83,22 +87,21 @@
       IF( l_trdtra )   THEN         ! Save the input temperature trend
          ALLOCATE( ztrdt(jpi,jpj,jpk) )
-         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
+         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs)
       ENDIF
       !                             !  Add the geothermal trend on temperature
-      DO jj = 2, jpjm1
-         DO ji = 2, jpim1
-            tsa(ji,jj,mbkt(ji,jj),jp_tem) = tsa(ji,jj,mbkt(ji,jj),jp_tem) + qgh_trd0(ji,jj) / e3t_n(ji,jj,mbkt(ji,jj))
-         END DO
-      END DO
+      DO_2D_00_00
+         pts(ji,jj,mbkt(ji,jj),jp_tem,Krhs) = pts(ji,jj,mbkt(ji,jj),jp_tem,Krhs) + qgh_trd0(ji,jj) / e3t(ji,jj,mbkt(ji,jj),Kmm)
+      END_2D
       !
-      CALL lbc_lnk( 'trabbc', tsa(:,:,:,jp_tem) , 'T', 1. )
+      CALL lbc_lnk( 'trabbc', pts(:,:,:,jp_tem,Krhs) , 'T', 1. )
       !
       IF( l_trdtra ) THEN        ! Send the trend for diagnostics
-         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
-         CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbc, ztrdt )
+         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)
+         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_bbc, ztrdt )
          DEALLOCATE( ztrdt )
       ENDIF
       !
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbc  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
+      CALL iom_put ( "hfgeou" , rho0_rcp * qgh_trd0(:,:) )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbc  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
       !
       IF( ln_timing )   CALL timing_stop('tra_bbc')
@@ -133,9 +136,7 @@
       !!----------------------------------------------------------------------
       !
-      REWIND( numnam_ref )              ! Namelist nambbc in reference namelist : Bottom momentum boundary condition
       READ  ( numnam_ref, nambbc, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambbc in reference namelist' )
       !
-      REWIND( numnam_cfg )              ! Namelist nambbc in configuration namelist : Bottom momentum boundary condition
       READ  ( numnam_cfg, nambbc, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambbc in configuration namelist' )
@@ -161,5 +162,5 @@
          CASE ( 1 )                          !* constant flux
             IF(lwp) WRITE(numout,*) '   ==>>>   constant heat flux  =   ', rn_geoflx_cst
-            qgh_trd0(:,:) = r1_rau0_rcp * rn_geoflx_cst
+            qgh_trd0(:,:) = r1_rho0_rcp * rn_geoflx_cst
             !
          CASE ( 2 )                          !* variable geothermal heat flux : read the geothermal fluxes in mW/m2
@@ -178,5 +179,5 @@
 
             CALL fld_read( nit000, 1, sf_qgh )                         ! Read qgh data
-            qgh_trd0(:,:) = r1_rau0_rcp * sf_qgh(1)%fnow(:,:,1) * 1.e-3 ! conversion in W/m2
+            qgh_trd0(:,:) = r1_rho0_rcp * sf_qgh(1)%fnow(:,:,1) * 1.e-3 ! conversion in W/m2
             !
          CASE DEFAULT
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/trabbl.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/trabbl.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/trabbl.F90	(revision 12928)
@@ -67,5 +67,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -89,5 +89,5 @@
 
 
-   SUBROUTINE tra_bbl( kt )
+   SUBROUTINE tra_bbl( kt, Kbb, Kmm, pts, Krhs )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE bbl  ***
@@ -101,5 +101,7 @@
       !!              is added to the general tracer trend
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt   ! ocean time-step
+      INTEGER,                                   INTENT(in   ) :: kt              ! ocean time-step
+      INTEGER,                                   INTENT(in   ) :: Kbb, Kmm, Krhs  ! time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts             ! active tracers and RHS of tracer equation
       !
       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds
@@ -110,16 +112,16 @@
       IF( l_trdtra )   THEN                         !* Save the T-S input trends
          ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )
-         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
-         ztrds(:,:,:) = tsa(:,:,:,jp_sal)
-      ENDIF
-
-      IF( l_bbl )   CALL bbl( kt, nit000, 'TRA' )   !* bbl coef. and transport (only if not already done in trcbbl)
+         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs)
+         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs)
+      ENDIF
+
+      IF( l_bbl )   CALL bbl( kt, nit000, 'TRA', Kbb, Kmm )   !* bbl coef. and transport (only if not already done in trcbbl)
 
       IF( nn_bbl_ldf == 1 ) THEN                    !* Diffusive bbl
          !
-         CALL tra_bbl_dif( tsb, tsa, jpts )
-         IF( ln_ctl )  &
-         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbl_ldf  - Ta: ', mask1=tmask, &
-            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' )
+         CALL tra_bbl_dif( pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, Kmm )
+         IF( sn_cfctl%l_prtctl )  &
+         CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_ldf  - Ta: ', mask1=tmask, &
+            &          tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' )
          ! lateral boundary conditions ; just need for outputs
          CALL lbc_lnk_multi( 'trabbl', ahu_bbl, 'U', 1. , ahv_bbl, 'V', 1. )
@@ -131,8 +133,8 @@
       IF( nn_bbl_adv /= 0 ) THEN                    !* Advective bbl
          !
-         CALL tra_bbl_adv( tsb, tsa, jpts )
-         IF(ln_ctl)   &
-         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbl_adv  - Ta: ', mask1=tmask,   &
-            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' )
+         CALL tra_bbl_adv( pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, Kmm )
+         IF(sn_cfctl%l_prtctl)   &
+         CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_adv  - Ta: ', mask1=tmask,   &
+            &          tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' )
          ! lateral boundary conditions ; just need for outputs
          CALL lbc_lnk_multi( 'trabbl', utr_bbl, 'U', 1. , vtr_bbl, 'V', 1. )
@@ -143,8 +145,8 @@
 
       IF( l_trdtra )   THEN                      ! send the trends for further diagnostics
-         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
-         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
-         CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbl, ztrdt )
-         CALL trd_tra( kt, 'TRA', jp_sal, jptra_bbl, ztrds )
+         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)
+         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:)
+         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_bbl, ztrdt )
+         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_bbl, ztrds )
          DEALLOCATE( ztrdt, ztrds )
       ENDIF
@@ -155,5 +157,5 @@
 
 
-   SUBROUTINE tra_bbl_dif( ptb, pta, kjpt )
+   SUBROUTINE tra_bbl_dif( pt, pt_rhs, kjpt, Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_bbl_dif  ***
@@ -171,5 +173,5 @@
       !!      convection is satified)
       !!
-      !! ** Action  :   pta   increased by the bbl diffusive trend
+      !! ** Action  :   pt_rhs   increased by the bbl diffusive trend
       !!
       !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
@@ -177,6 +179,7 @@
       !!----------------------------------------------------------------------
       INTEGER                              , INTENT(in   ) ::   kjpt   ! number of tracers
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb    ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta    ! tracer trend
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt     ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs ! tracer trend
+      INTEGER                              , INTENT(in   ) ::   Kmm    ! time level indices
       !
       INTEGER  ::   ji, jj, jn   ! dummy loop indices
@@ -188,22 +191,18 @@
       DO jn = 1, kjpt                                     ! tracer loop
          !                                                ! ===========
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ik = mbkt(ji,jj)                             ! bottom T-level index
-               zptb(ji,jj) = ptb(ji,jj,ik,jn)               ! bottom before T and S
-            END DO
-         END DO
+         DO_2D_11_11
+            ik = mbkt(ji,jj)                             ! bottom T-level index
+            zptb(ji,jj) = pt(ji,jj,ik,jn)                ! bottom before T and S
+         END_2D
          !               
-         DO jj = 2, jpjm1                                    ! Compute the trend
-            DO ji = 2, jpim1
-               ik = mbkt(ji,jj)                            ! bottom T-level index
-               pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn)                                                  &
-                  &             + (  ahu_bbl(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )     &
-                  &                - ahu_bbl(ji-1,jj  ) * ( zptb(ji  ,jj  ) - zptb(ji-1,jj  ) )     &
-                  &                + ahv_bbl(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )     &
-                  &                - ahv_bbl(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )  )  &
-                  &             * r1_e1e2t(ji,jj) / e3t_n(ji,jj,ik)
-            END DO
-         END DO
+         DO_2D_00_00
+            ik = mbkt(ji,jj)                            ! bottom T-level index
+            pt_rhs(ji,jj,ik,jn) = pt_rhs(ji,jj,ik,jn)                                                  &
+               &                + (  ahu_bbl(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )     &
+               &                   - ahu_bbl(ji-1,jj  ) * ( zptb(ji  ,jj  ) - zptb(ji-1,jj  ) )     &
+               &                   + ahv_bbl(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )     &
+               &                   - ahv_bbl(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )  )  &
+               &                * r1_e1e2t(ji,jj) / e3t(ji,jj,ik,Kmm)
+         END_2D
          !                                                  ! ===========
       END DO                                                ! end tracer
@@ -212,5 +211,5 @@
 
 
-   SUBROUTINE tra_bbl_adv( ptb, pta, kjpt )
+   SUBROUTINE tra_bbl_adv( pt, pt_rhs, kjpt, Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE trc_bbl  ***
@@ -228,6 +227,7 @@
       !!----------------------------------------------------------------------
       INTEGER                              , INTENT(in   ) ::   kjpt   ! number of tracers
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb    ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta    ! tracer trend
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt     ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs ! tracer trend
+      INTEGER                              , INTENT(in   ) ::   Kmm    ! time level indices
       !
       INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices
@@ -250,17 +250,17 @@
                   !
                   !                                               ! up  -slope T-point (shelf bottom point)
-                  zbtr = r1_e1e2t(iis,jj) / e3t_n(iis,jj,ikus)
-                  ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr
-                  pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra
+                  zbtr = r1_e1e2t(iis,jj) / e3t(iis,jj,ikus,Kmm)
+                  ztra = zu_bbl * ( pt(iid,jj,ikus,jn) - pt(iis,jj,ikus,jn) ) * zbtr
+                  pt_rhs(iis,jj,ikus,jn) = pt_rhs(iis,jj,ikus,jn) + ztra
                   !
                   DO jk = ikus, ikud-1                            ! down-slope upper to down T-point (deep column)
-                     zbtr = r1_e1e2t(iid,jj) / e3t_n(iid,jj,jk)
-                     ztra = zu_bbl * ( ptb(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr
-                     pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra
+                     zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,jk,Kmm)
+                     ztra = zu_bbl * ( pt(iid,jj,jk+1,jn) - pt(iid,jj,jk,jn) ) * zbtr
+                     pt_rhs(iid,jj,jk,jn) = pt_rhs(iid,jj,jk,jn) + ztra
                   END DO
                   !
-                  zbtr = r1_e1e2t(iid,jj) / e3t_n(iid,jj,ikud)
-                  ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr
-                  pta(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra
+                  zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,ikud,Kmm)
+                  ztra = zu_bbl * ( pt(iis,jj,ikus,jn) - pt(iid,jj,ikud,jn) ) * zbtr
+                  pt_rhs(iid,jj,ikud,jn) = pt_rhs(iid,jj,ikud,jn) + ztra
                ENDIF
                !
@@ -272,17 +272,17 @@
                   !
                   ! up  -slope T-point (shelf bottom point)
-                  zbtr = r1_e1e2t(ji,ijs) / e3t_n(ji,ijs,ikvs)
-                  ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr
-                  pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra
+                  zbtr = r1_e1e2t(ji,ijs) / e3t(ji,ijs,ikvs,Kmm)
+                  ztra = zv_bbl * ( pt(ji,ijd,ikvs,jn) - pt(ji,ijs,ikvs,jn) ) * zbtr
+                  pt_rhs(ji,ijs,ikvs,jn) = pt_rhs(ji,ijs,ikvs,jn) + ztra
                   !
                   DO jk = ikvs, ikvd-1                            ! down-slope upper to down T-point (deep column)
-                     zbtr = r1_e1e2t(ji,ijd) / e3t_n(ji,ijd,jk)
-                     ztra = zv_bbl * ( ptb(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr
-                     pta(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn)  + ztra
+                     zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,jk,Kmm)
+                     ztra = zv_bbl * ( pt(ji,ijd,jk+1,jn) - pt(ji,ijd,jk,jn) ) * zbtr
+                     pt_rhs(ji,ijd,jk,jn) = pt_rhs(ji,ijd,jk,jn)  + ztra
                   END DO
                   !                                               ! down-slope T-point (deep bottom point)
-                  zbtr = r1_e1e2t(ji,ijd) / e3t_n(ji,ijd,ikvd)
-                  ztra = zv_bbl * ( ptb(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr
-                  pta(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra
+                  zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,ikvd,Kmm)
+                  ztra = zv_bbl * ( pt(ji,ijs,ikvs,jn) - pt(ji,ijd,ikvd,jn) ) * zbtr
+                  pt_rhs(ji,ijd,ikvd,jn) = pt_rhs(ji,ijd,ikvd,jn) + ztra
                ENDIF
             END DO
@@ -295,5 +295,5 @@
 
 
-   SUBROUTINE bbl( kt, kit000, cdtype )
+   SUBROUTINE bbl( kt, kit000, cdtype, Kbb, Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE bbl  ***
@@ -324,4 +324,5 @@
       INTEGER         , INTENT(in   ) ::   kit000   ! first time step index
       CHARACTER(len=3), INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
+      INTEGER         , INTENT(in   ) ::   Kbb, Kmm ! ocean time level index
       !
       INTEGER  ::   ji, jj                    ! dummy loop indices
@@ -341,44 +342,40 @@
       ENDIF
       !                                        !* bottom variables (T, S, alpha, beta, depth, velocity)
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            ik = mbkt(ji,jj)                             ! bottom T-level index
-            zts (ji,jj,jp_tem) = tsb(ji,jj,ik,jp_tem)    ! bottom before T and S
-            zts (ji,jj,jp_sal) = tsb(ji,jj,ik,jp_sal)
-            !
-            zdep(ji,jj) = gdept_n(ji,jj,ik)              ! bottom T-level reference depth
-            zub (ji,jj) = un(ji,jj,mbku(ji,jj))          ! bottom velocity
-            zvb (ji,jj) = vn(ji,jj,mbkv(ji,jj))
-         END DO
-      END DO
-      !
-      CALL eos_rab( zts, zdep, zab )
+      DO_2D_11_11
+         ik = mbkt(ji,jj)                             ! bottom T-level index
+         zts (ji,jj,jp_tem) = ts(ji,jj,ik,jp_tem,Kbb) ! bottom before T and S
+         zts (ji,jj,jp_sal) = ts(ji,jj,ik,jp_sal,Kbb)
+         !
+         zdep(ji,jj) = gdept(ji,jj,ik,Kmm)            ! bottom T-level reference depth
+         zub (ji,jj) = uu(ji,jj,mbku(ji,jj),Kmm)      ! bottom velocity
+         zvb (ji,jj) = vv(ji,jj,mbkv(ji,jj),Kmm)
+      END_2D
+      !
+      CALL eos_rab( zts, zdep, zab, Kmm )
       !
       !                                   !-------------------!
       IF( nn_bbl_ldf == 1 ) THEN          !   diffusive bbl   !
          !                                !-------------------!
-         DO jj = 1, jpjm1                      ! (criteria for non zero flux: grad(rho).grad(h) < 0 )
-            DO ji = 1, fs_jpim1   ! vector opt.
-               !                                                   ! i-direction
-               za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)              ! 2*(alpha,beta) at u-point
-               zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal)
-               !                                                         ! 2*masked bottom density gradient
-               zgdrho = (  za * ( zts(ji+1,jj,jp_tem) - zts(ji,jj,jp_tem) )    &
-                  &      - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) )  ) * umask(ji,jj,1)
-               !
-               zsign  = SIGN(  0.5, -zgdrho * REAL( mgrhu(ji,jj) )  )    ! sign of ( i-gradient * i-slope )
-               ahu_bbl(ji,jj) = ( 0.5 - zsign ) * ahu_bbl_0(ji,jj)       ! masked diffusive flux coeff.
-               !
-               !                                                   ! j-direction
-               za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem)              ! 2*(alpha,beta) at v-point
-               zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal)
-               !                                                         ! 2*masked bottom density gradient
-               zgdrho = (  za * ( zts(ji,jj+1,jp_tem) - zts(ji,jj,jp_tem) )    &
-                  &      - zb * ( zts(ji,jj+1,jp_sal) - zts(ji,jj,jp_sal) )  ) * vmask(ji,jj,1)
-               !
-               zsign = SIGN(  0.5, -zgdrho * REAL( mgrhv(ji,jj) )  )     ! sign of ( j-gradient * j-slope )
-               ahv_bbl(ji,jj) = ( 0.5 - zsign ) * ahv_bbl_0(ji,jj)
-            END DO
-         END DO
+         DO_2D_10_10
+            !                                                   ! i-direction
+            za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)              ! 2*(alpha,beta) at u-point
+            zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal)
+            !                                                         ! 2*masked bottom density gradient
+            zgdrho = (  za * ( zts(ji+1,jj,jp_tem) - zts(ji,jj,jp_tem) )    &
+               &      - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) )  ) * umask(ji,jj,1)
+            !
+            zsign  = SIGN(  0.5, -zgdrho * REAL( mgrhu(ji,jj) )  )    ! sign of ( i-gradient * i-slope )
+            ahu_bbl(ji,jj) = ( 0.5 - zsign ) * ahu_bbl_0(ji,jj)       ! masked diffusive flux coeff.
+            !
+            !                                                   ! j-direction
+            za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem)              ! 2*(alpha,beta) at v-point
+            zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal)
+            !                                                         ! 2*masked bottom density gradient
+            zgdrho = (  za * ( zts(ji,jj+1,jp_tem) - zts(ji,jj,jp_tem) )    &
+               &      - zb * ( zts(ji,jj+1,jp_sal) - zts(ji,jj,jp_sal) )  ) * vmask(ji,jj,1)
+            !
+            zsign = SIGN(  0.5, -zgdrho * REAL( mgrhv(ji,jj) )  )     ! sign of ( j-gradient * j-slope )
+            ahv_bbl(ji,jj) = ( 0.5 - zsign ) * ahv_bbl_0(ji,jj)
+         END_2D
          !
       ENDIF
@@ -390,74 +387,70 @@
          !
          CASE( 1 )                                   != use of upper velocity
-            DO jj = 1, jpjm1                                 ! criteria: grad(rho).grad(h)<0  and grad(rho).grad(h)<0
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  !                                                  ! i-direction
-                  za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at u-point
-                  zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal)
-                  !                                                          ! 2*masked bottom density gradient 
-                  zgdrho = (  za * ( zts(ji+1,jj,jp_tem) - zts(ji,jj,jp_tem) )    &
-                            - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) )  ) * umask(ji,jj,1)
-                  !
-                  zsign = SIGN(  0.5, - zgdrho   * REAL( mgrhu(ji,jj) )  )   ! sign of i-gradient * i-slope
-                  zsigna= SIGN(  0.5, zub(ji,jj) * REAL( mgrhu(ji,jj) )  )   ! sign of u * i-slope
-                  !
-                  !                                                          ! bbl velocity
-                  utr_bbl(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e2u(ji,jj) * e3u_bbl_0(ji,jj) * zub(ji,jj)
-                  !
-                  !                                                  ! j-direction
-                  za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at v-point
-                  zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal)
-                  !                                                          ! 2*masked bottom density gradient
-                  zgdrho = (  za * ( zts(ji,jj+1,jp_tem) - zts(ji,jj,jp_tem) )    &
-                     &      - zb * ( zts(ji,jj+1,jp_sal) - zts(ji,jj,jp_sal) )  ) * vmask(ji,jj,1)
-                  zsign = SIGN(  0.5, - zgdrho   * REAL( mgrhv(ji,jj) )  )   ! sign of j-gradient * j-slope
-                  zsigna= SIGN(  0.5, zvb(ji,jj) * REAL( mgrhv(ji,jj) )  )   ! sign of u * i-slope
-                  !
-                  !                                                          ! bbl transport
-                  vtr_bbl(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e1v(ji,jj) * e3v_bbl_0(ji,jj) * zvb(ji,jj)
-               END DO
-            END DO
+            DO_2D_10_10
+               !                                                  ! i-direction
+               za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at u-point
+               zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal)
+               !                                                          ! 2*masked bottom density gradient 
+               zgdrho = (  za * ( zts(ji+1,jj,jp_tem) - zts(ji,jj,jp_tem) )    &
+                         - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) )  ) * umask(ji,jj,1)
+               !
+               zsign = SIGN(  0.5, - zgdrho   * REAL( mgrhu(ji,jj) )  )   ! sign of i-gradient * i-slope
+               zsigna= SIGN(  0.5, zub(ji,jj) * REAL( mgrhu(ji,jj) )  )   ! sign of u * i-slope
+               !
+               !                                                          ! bbl velocity
+               utr_bbl(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e2u(ji,jj) * e3u_bbl_0(ji,jj) * zub(ji,jj)
+               !
+               !                                                  ! j-direction
+               za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at v-point
+               zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal)
+               !                                                          ! 2*masked bottom density gradient
+               zgdrho = (  za * ( zts(ji,jj+1,jp_tem) - zts(ji,jj,jp_tem) )    &
+                  &      - zb * ( zts(ji,jj+1,jp_sal) - zts(ji,jj,jp_sal) )  ) * vmask(ji,jj,1)
+               zsign = SIGN(  0.5, - zgdrho   * REAL( mgrhv(ji,jj) )  )   ! sign of j-gradient * j-slope
+               zsigna= SIGN(  0.5, zvb(ji,jj) * REAL( mgrhv(ji,jj) )  )   ! sign of u * i-slope
+               !
+               !                                                          ! bbl transport
+               vtr_bbl(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e1v(ji,jj) * e3v_bbl_0(ji,jj) * zvb(ji,jj)
+            END_2D
             !
          CASE( 2 )                                 != bbl velocity = F( delta rho )
             zgbbl = grav * rn_gambbl
-            DO jj = 1, jpjm1                            ! criteria: rho_up > rho_down
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  !                                                  ! i-direction
-                  ! down-slope T-point i/k-index (deep)  &   up-slope T-point i/k-index (shelf)
-                  iid  = ji + MAX( 0, mgrhu(ji,jj) )
-                  iis  = ji + 1 - MAX( 0, mgrhu(ji,jj) )
-                  !
-                  ikud = mbku_d(ji,jj)
-                  ikus = mbku(ji,jj)
-                  !
-                  za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at u-point
-                  zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal)
-                  !                                                          !   masked bottom density gradient
-                  zgdrho = 0.5 * (  za * ( zts(iid,jj,jp_tem) - zts(iis,jj,jp_tem) )    &
-                     &            - zb * ( zts(iid,jj,jp_sal) - zts(iis,jj,jp_sal) )  ) * umask(ji,jj,1)
-                  zgdrho = MAX( 0.e0, zgdrho )                               ! only if shelf is denser than deep
-                  !
-                  !                                                          ! bbl transport (down-slope direction)
-                  utr_bbl(ji,jj) = e2u(ji,jj) * e3u_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhu(ji,jj) )
-                  !
-                  !                                                  ! j-direction
-                  !  down-slope T-point j/k-index (deep)  &   of the up  -slope T-point j/k-index (shelf)
-                  ijd  = jj + MAX( 0, mgrhv(ji,jj) )
-                  ijs  = jj + 1 - MAX( 0, mgrhv(ji,jj) )
-                  !
-                  ikvd = mbkv_d(ji,jj)
-                  ikvs = mbkv(ji,jj)
-                  !
-                  za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at v-point
-                  zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal)
-                  !                                                          !   masked bottom density gradient
-                  zgdrho = 0.5 * (  za * ( zts(ji,ijd,jp_tem) - zts(ji,ijs,jp_tem) )    &
-                     &            - zb * ( zts(ji,ijd,jp_sal) - zts(ji,ijs,jp_sal) )  ) * vmask(ji,jj,1)
-                  zgdrho = MAX( 0.e0, zgdrho )                               ! only if shelf is denser than deep
-                  !
-                  !                                                          ! bbl transport (down-slope direction)
-                  vtr_bbl(ji,jj) = e1v(ji,jj) * e3v_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhv(ji,jj) )
-               END DO
-            END DO
+            DO_2D_10_10
+               !                                                  ! i-direction
+               ! down-slope T-point i/k-index (deep)  &   up-slope T-point i/k-index (shelf)
+               iid  = ji + MAX( 0, mgrhu(ji,jj) )
+               iis  = ji + 1 - MAX( 0, mgrhu(ji,jj) )
+               !
+               ikud = mbku_d(ji,jj)
+               ikus = mbku(ji,jj)
+               !
+               za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at u-point
+               zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal)
+               !                                                          !   masked bottom density gradient
+               zgdrho = 0.5 * (  za * ( zts(iid,jj,jp_tem) - zts(iis,jj,jp_tem) )    &
+                  &            - zb * ( zts(iid,jj,jp_sal) - zts(iis,jj,jp_sal) )  ) * umask(ji,jj,1)
+               zgdrho = MAX( 0.e0, zgdrho )                               ! only if shelf is denser than deep
+               !
+               !                                                          ! bbl transport (down-slope direction)
+               utr_bbl(ji,jj) = e2u(ji,jj) * e3u_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhu(ji,jj) )
+               !
+               !                                                  ! j-direction
+               !  down-slope T-point j/k-index (deep)  &   of the up  -slope T-point j/k-index (shelf)
+               ijd  = jj + MAX( 0, mgrhv(ji,jj) )
+               ijs  = jj + 1 - MAX( 0, mgrhv(ji,jj) )
+               !
+               ikvd = mbkv_d(ji,jj)
+               ikvs = mbkv(ji,jj)
+               !
+               za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at v-point
+               zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal)
+               !                                                          !   masked bottom density gradient
+               zgdrho = 0.5 * (  za * ( zts(ji,ijd,jp_tem) - zts(ji,ijs,jp_tem) )    &
+                  &            - zb * ( zts(ji,ijd,jp_sal) - zts(ji,ijs,jp_sal) )  ) * vmask(ji,jj,1)
+               zgdrho = MAX( 0.e0, zgdrho )                               ! only if shelf is denser than deep
+               !
+               !                                                          ! bbl transport (down-slope direction)
+               vtr_bbl(ji,jj) = e1v(ji,jj) * e3v_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhv(ji,jj) )
+            END_2D
          END SELECT
          !
@@ -483,9 +476,7 @@
       !!----------------------------------------------------------------------
       !
-      REWIND( numnam_ref )              ! Namelist nambbl in reference namelist : Bottom boundary layer scheme
       READ  ( numnam_ref, nambbl, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambbl in reference namelist' )
       !
-      REWIND( numnam_cfg )              ! Namelist nambbl in configuration namelist : Bottom boundary layer scheme
       READ  ( numnam_cfg, nambbl, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambbl in configuration namelist' )
@@ -517,10 +508,8 @@
       !
       !                             !* vertical index of  "deep" bottom u- and v-points
-      DO jj = 1, jpjm1                    ! (the "shelf" bottom k-indices are mbku and mbkv)
-         DO ji = 1, jpim1
-            mbku_d(ji,jj) = MAX(  mbkt(ji+1,jj  ) , mbkt(ji,jj)  )   ! >= 1 as mbkt=1 over land
-            mbkv_d(ji,jj) = MAX(  mbkt(ji  ,jj+1) , mbkt(ji,jj)  )
-         END DO
-      END DO
+      DO_2D_10_10
+         mbku_d(ji,jj) = MAX(  mbkt(ji+1,jj  ) , mbkt(ji,jj)  )   ! >= 1 as mbkt=1 over land
+         mbkv_d(ji,jj) = MAX(  mbkt(ji  ,jj+1) , mbkt(ji,jj)  )
+      END_2D
       ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk
       zmbku(:,:) = REAL( mbku_d(:,:), wp )   ;     zmbkv(:,:) = REAL( mbkv_d(:,:), wp )  
@@ -530,22 +519,18 @@
       !                             !* sign of grad(H) at u- and v-points; zero if grad(H) = 0
       mgrhu(:,:) = 0   ;   mgrhv(:,:) = 0
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-            IF( gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) /= 0._wp ) THEN
-               mgrhu(ji,jj) = INT(  SIGN( 1.e0, gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) )  )
-            ENDIF
-            !
-            IF( gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) /= 0._wp ) THEN
-               mgrhv(ji,jj) = INT(  SIGN( 1.e0, gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) )  )
-            ENDIF
-         END DO
-      END DO
-      !
-      DO jj = 1, jpjm1              !* bbl thickness at u- (v-) point
-         DO ji = 1, jpim1                 ! minimum of top & bottom e3u_0 (e3v_0)
-            e3u_bbl_0(ji,jj) = MIN( e3u_0(ji,jj,mbkt(ji+1,jj  )), e3u_0(ji,jj,mbkt(ji,jj)) )
-            e3v_bbl_0(ji,jj) = MIN( e3v_0(ji,jj,mbkt(ji  ,jj+1)), e3v_0(ji,jj,mbkt(ji,jj)) )
-         END DO
-      END DO
+      DO_2D_10_10
+         IF( gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) /= 0._wp ) THEN
+            mgrhu(ji,jj) = INT(  SIGN( 1.e0, gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) )  )
+         ENDIF
+         !
+         IF( gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) /= 0._wp ) THEN
+            mgrhv(ji,jj) = INT(  SIGN( 1.e0, gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) )  )
+         ENDIF
+      END_2D
+      !
+      DO_2D_10_10
+         e3u_bbl_0(ji,jj) = MIN( e3u_0(ji,jj,mbkt(ji+1,jj  )), e3u_0(ji,jj,mbkt(ji,jj)) )
+         e3v_bbl_0(ji,jj) = MIN( e3v_0(ji,jj,mbkt(ji  ,jj+1)), e3v_0(ji,jj,mbkt(ji,jj)) )
+      END_2D
       CALL lbc_lnk_multi( 'trabbl', e3u_bbl_0, 'U', 1. , e3v_bbl_0, 'V', 1. )      ! lateral boundary conditions
       !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/tradmp.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/tradmp.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/tradmp.F90	(revision 12928)
@@ -52,5 +52,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -72,5 +72,5 @@
 
 
-   SUBROUTINE tra_dmp( kt )
+   SUBROUTINE tra_dmp( kt, Kbb, Kmm, pts, Krhs )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE tra_dmp  ***
@@ -90,5 +90,7 @@
       !! ** Action  : - tsa: tracer trends updated with the damping trend
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER,                                   INTENT(in   ) :: kt              ! ocean time-step index
+      INTEGER,                                   INTENT(in   ) :: Kbb, Kmm, Krhs  ! time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts             ! active tracers and RHS of tracer equation
       !
       INTEGER ::   ji, jj, jk, jn   ! dummy loop indices
@@ -101,5 +103,5 @@
       IF( l_trdtra )   THEN                    !* Save ta and sa trends
          ALLOCATE( ztrdts(jpi,jpj,jpk,jpts) ) 
-         ztrdts(:,:,:,:) = tsa(:,:,:,:) 
+         ztrdts(:,:,:,:) = pts(:,:,:,:,Krhs) 
       ENDIF
       !                           !==  input T-S data at kt  ==!
@@ -110,52 +112,41 @@
       CASE( 0 )                        !*  newtonian damping throughout the water column  *!
          DO jn = 1, jpts
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jn) - tsb(ji,jj,jk,jn) )
-                  END DO
-               END DO
-            END DO
+            DO_3D_00_00( 1, jpkm1 )
+               pts(ji,jj,jk,jn,Krhs) = pts(ji,jj,jk,jn,Krhs)           &
+                  &                  + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jn) - pts(ji,jj,jk,jn,Kbb) )
+            END_3D
          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.
-                  IF( avt(ji,jj,jk) <= avt_c ) THEN
-                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
-                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
-                     tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   &
-                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
-                  ENDIF
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            IF( avt(ji,jj,jk) <= avt_c ) THEN
+               pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs)   &
+                  &                      + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) )
+               pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs)   &
+                  &                      + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) )
+            ENDIF
+         END_3D
          !
       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( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN
-                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
-                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
-                     tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   &
-                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
-                  ENDIF
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN
+               pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs)   &
+                  &                      + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) )
+               pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs)   &
+                  &                      + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) )
+            ENDIF
+         END_3D
          !
       END SELECT
       !
       IF( l_trdtra )   THEN       ! trend diagnostic
-         ztrdts(:,:,:,:) = tsa(:,:,:,:) - ztrdts(:,:,:,:)
-         CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) )
-         CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) )
+         ztrdts(:,:,:,:) = pts(:,:,:,:,Krhs) - ztrdts(:,:,:,:)
+         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) )
+         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) )
          DEALLOCATE( ztrdts ) 
       ENDIF
       !                           ! Control print
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' dmp  - Ta: ', mask1=tmask,   &
-         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' dmp  - Ta: ', mask1=tmask,   &
+         &                                  tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
       !
       IF( ln_timing )   CALL timing_stop('tra_dmp')
@@ -177,9 +168,7 @@
       !!----------------------------------------------------------------------
       !
-      REWIND( numnam_ref )   ! Namelist namtra_dmp in reference namelist : T & S relaxation
       READ  ( numnam_ref, namtra_dmp, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_dmp in reference namelist' )
       !
-      REWIND( numnam_cfg )   ! Namelist namtra_dmp in configuration namelist : T & S relaxation
       READ  ( numnam_cfg, namtra_dmp, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traisf.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traisf.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traisf.F90	(revision 12928)
@@ -0,0 +1,148 @@
+MODULE traisf
+   !!==============================================================================
+   !!                       ***  MODULE  traisf  ***
+   !! Ocean active tracers:  ice shelf boundary condition
+   !!==============================================================================
+   !! History :    4.0  !  2019-09  (P. Mathiot) original file
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_isf       : update the tracer trend at ocean surface
+   !!----------------------------------------------------------------------
+   USE isf_oce                                     ! Ice shelf variables
+   USE dom_oce , ONLY : e3t, r1_e1e2t            ! ocean space domain variables
+   USE isfutils, ONLY : debug                      ! debug option
+   USE timing  , ONLY : timing_start, timing_stop  ! Timing
+   USE in_out_manager                              ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_isf   ! routine called by step.F90
+
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: trasbc.F90 10499 2019-01-10 15:12:24Z deazer $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_isf ( kt, Kmm, pts, Krhs )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_isf  ***
+      !!                   
+      !! ** Purpose :  Compute the temperature trend due to the ice shelf melting (qhoce + qhc)
+      !!
+      !! ** Action  : - update pts(:,:,:,:,Krhs) for cav, par and cpl case
+      !!----------------------------------------------------------------------
+      INTEGER                                  , INTENT(in   ) :: kt        ! ocean time step
+      INTEGER                                  , INTENT(in   ) :: Kmm, Krhs ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts       ! active tracers and RHS of tracer equation
+      !!----------------------------------------------------------------------
+      !
+      IF( ln_timing )   CALL timing_start('tra_isf')
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_isf : Ice shelf heat fluxes'
+         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+      ENDIF
+      !
+      ! cavity case
+      IF ( ln_isfcav_mlt ) CALL tra_isf_mlt(misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav, risf_cav_tsc, risf_cav_tsc_b, pts(:,:,:,:,Krhs))
+      !
+      ! parametrisation case
+      IF ( ln_isfpar_mlt ) CALL tra_isf_mlt(misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par, risf_par_tsc, risf_par_tsc_b, pts(:,:,:,:,Krhs))
+      !
+      ! ice sheet coupling case
+      IF ( ln_isfcpl ) THEN
+         !
+         ! Dynamical stability at start up after change in under ice shelf cavity geometry is achieve by correcting the divergence.
+         ! This is achieved by applying a volume flux in order to keep the horizontal divergence after remapping 
+         ! the same as at the end of the latest time step. So correction need to be apply at nit000 (euler time step) and
+         ! half of it at nit000+1 (leap frog time step).
+         ! in accordance to this, the heat content flux due to injected water need to be added in the temperature and salt trend
+         ! at time step nit000 and nit000+1
+         IF ( kt == nit000  ) CALL tra_isf_cpl(Kmm, risfcpl_tsc       , pts(:,:,:,:,Krhs))
+         IF ( kt == nit000+1) CALL tra_isf_cpl(Kmm, risfcpl_tsc*0.5_wp, pts(:,:,:,:,Krhs))
+         !
+         ! ensure 0 trend due to unconservation of the ice shelf coupling
+         IF ( ln_isfcpl_cons ) CALL tra_isf_cpl(Kmm, risfcpl_cons_tsc, pts(:,:,:,:,Krhs))
+         !
+      END IF
+      !
+      IF ( ln_isfdebug ) THEN
+         CALL debug('tra_isf: pts(:,:,:,:,Krhs) T', pts(:,:,:,1,Krhs))
+         CALL debug('tra_isf: pts(:,:,:,:,Krhs) S', pts(:,:,:,2,Krhs))
+      END IF
+      !
+      IF( ln_timing )   CALL timing_stop('tra_isf')
+      !
+   END SUBROUTINE tra_isf
+   !
+   SUBROUTINE tra_isf_mlt(ktop, kbot, phtbl, pfrac, ptsc, ptsc_b, pts)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_isf_mlt  ***
+      !!
+      !! *** Purpose :  Compute the temperature trend due to the ice shelf melting (qhoce + qhc) for cav or par case
+      !!
+      !! *** Action :: Update pts(:,:,:,:,Krhs) with the surface boundary condition trend 
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(inout) :: pts
+      !!----------------------------------------------------------------------
+      INTEGER , DIMENSION(jpi,jpj)     , INTENT(in   ) :: ktop , kbot
+      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(in   ) :: phtbl, pfrac
+      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) :: ptsc , ptsc_b
+      !!----------------------------------------------------------------------
+      INTEGER                      :: ji,jj,jk  ! loop index   
+      INTEGER                      :: ikt, ikb  ! top and bottom level of the tbl
+      REAL(wp), DIMENSION(jpi,jpj) :: ztc       ! total ice shelf tracer trend
+      !!----------------------------------------------------------------------
+      !
+      ! compute 2d total trend due to isf
+      ztc(:,:) = 0.5_wp * ( ptsc(:,:,jp_tem) + ptsc_b(:,:,jp_tem) ) / phtbl(:,:)
+      !
+      ! update pts(:,:,:,:,Krhs)
+      DO_2D_11_11
+         !
+         ikt = ktop(ji,jj)
+         ikb = kbot(ji,jj)
+         !
+         ! level fully include in the ice shelf boundary layer
+         DO jk = ikt, ikb - 1
+            pts(ji,jj,jk,jp_tem) = pts(ji,jj,jk,jp_tem) + ztc(ji,jj)
+         END DO
+         !
+         ! level partially include in ice shelf boundary layer 
+         pts(ji,jj,ikb,jp_tem) = pts(ji,jj,ikb,jp_tem) + ztc(ji,jj) * pfrac(ji,jj)
+         !
+      END_2D
+      !
+   END SUBROUTINE tra_isf_mlt
+   !
+   SUBROUTINE tra_isf_cpl( Kmm, ptsc, ptsa )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_isf_cpl  ***
+      !!
+      !! *** Action :: Update pts(:,:,:,:,Krhs) with the ice shelf coupling trend 
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(inout) :: ptsa
+      !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) :: Kmm   ! ocean time level index
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) :: ptsc
+      !!----------------------------------------------------------------------
+      INTEGER :: jk
+      !!----------------------------------------------------------------------
+      !
+      DO jk = 1,jpk
+         ptsa(:,:,jk,jp_tem) = ptsa(:,:,jk,jp_tem) + ptsc(:,:,jk,jp_tem) * r1_e1e2t(:,:) / e3t(:,:,jk,Kmm)
+         ptsa(:,:,jk,jp_sal) = ptsa(:,:,jk,jp_sal) + ptsc(:,:,jk,jp_sal) * r1_e1e2t(:,:) / e3t(:,:,jk,Kmm)
+      END DO
+      !
+   END SUBROUTINE tra_isf_cpl
+   !
+END MODULE traisf
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traldf.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traldf.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traldf.F90	(revision 12928)
@@ -38,6 +38,4 @@
    PUBLIC   tra_ldf_init   ! called by nemogcm.F90 
    
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -47,5 +45,5 @@
 CONTAINS
 
-   SUBROUTINE tra_ldf( kt )
+   SUBROUTINE tra_ldf( kt, Kbb, Kmm, pts, Krhs )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_ldf  ***
@@ -53,5 +51,7 @@
       !! ** Purpose :   compute the lateral ocean tracer physics.
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      INTEGER,                                   INTENT(in   ) :: kt              ! ocean time-step index
+      INTEGER,                                   INTENT(in   ) :: Kbb, Kmm, Krhs  ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts             ! active tracers and RHS of tracer equation
       !!
       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds
@@ -62,29 +62,29 @@
       IF( l_trdtra )   THEN                    !* Save ta and sa trends
          ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 
-         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
-         ztrds(:,:,:) = tsa(:,:,:,jp_sal)
+         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 
+         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs)
       ENDIF
       !
       SELECT CASE ( nldf_tra )                 !* compute lateral mixing trend and add it to the general trend
       CASE ( np_lap   )                                  ! laplacian: iso-level operator
-         CALL tra_ldf_lap  ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb,      tsa, jpts,  1   )
+         CALL tra_ldf_lap  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs),                   jpts,  1 )
       CASE ( np_lap_i )                                  ! laplacian: standard iso-neutral operator (Madec)
-         CALL tra_ldf_iso  ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb, tsb, tsa, jpts,  1   )
+         CALL tra_ldf_iso  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts,  1 )
       CASE ( np_lap_it )                                 ! laplacian: triad iso-neutral operator (griffies)
-         CALL tra_ldf_triad( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb, tsb, tsa, jpts,  1   )
+         CALL tra_ldf_triad( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts,  1 )
       CASE ( np_blp , np_blp_i , np_blp_it )             ! bilaplacian: iso-level & iso-neutral operators
-         CALL tra_ldf_blp  ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb      , tsa, jpts, nldf_tra )
+         CALL tra_ldf_blp  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs),             jpts, nldf_tra )
       END SELECT
       !
       IF( l_trdtra )   THEN                    !* save the horizontal diffusive trends for further diagnostics
-         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
-         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
-         CALL trd_tra( kt, 'TRA', jp_tem, jptra_ldf, ztrdt )
-         CALL trd_tra( kt, 'TRA', jp_sal, jptra_ldf, ztrds )
+         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)
+         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:)
+         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_ldf, ztrdt )
+         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_ldf, ztrds )
          DEALLOCATE( ztrdt, ztrds ) 
       ENDIF
       !                                        !* print mean trends (used for debugging)
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf  - Ta: ', mask1=tmask,               &
-         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' ldf  - Ta: ', mask1=tmask,               &
+         &                                  tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
       !
       IF( ln_timing )   CALL timing_stop('tra_ldf')
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traldf_iso.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traldf_iso.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traldf_iso.F90	(revision 12928)
@@ -40,5 +40,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -48,7 +48,7 @@
 CONTAINS
 
-  SUBROUTINE tra_ldf_iso( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   &
-      &                                                   pgui, pgvi,   &
-      &                                       ptb , ptbb, pta , kjpt, kpass )
+  SUBROUTINE tra_ldf_iso( kt, Kmm, kit000, cdtype, pahu, pahv,                    &
+      &                                            pgu , pgv    ,   pgui, pgvi,   &
+      &                                       pt , pt2 , pt_rhs , kjpt  , kpass )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_ldf_iso  ***
@@ -87,7 +87,7 @@
       !!         difft = 1/(e1e2t*e3t) dk[ zftw ]
       !!      Add this trend to the general trend (ta,sa):
-      !!         pta = pta + difft
-      !!
-      !! ** Action :   Update pta arrays with the before rotated diffusion
+      !!         pt_rhs = pt_rhs + difft
+      !!
+      !! ** Action :   Update pt_rhs arrays with the before rotated diffusion
       !!----------------------------------------------------------------------
       INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
@@ -96,10 +96,11 @@
       INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
       INTEGER                              , INTENT(in   ) ::   kpass      ! =1/2 first or second passage
+      INTEGER                              , INTENT(in   ) ::   Kmm        ! ocean time level index
       REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s]
       REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
       REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! tracer (kpass=1) or laplacian of tracer (kpass=2)
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptbb       ! tracer (only used in kpass=2)
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt         ! tracer (kpass=1) or laplacian of tracer (kpass=2)
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt2        ! tracer (only used in kpass=2)
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs     ! tracer trend
       !
       INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
@@ -108,5 +109,5 @@
       REAL(wp) ::  zmsku, zahu_w, zabe1, zcof1, zcoef3   ! local scalars
       REAL(wp) ::  zmskv, zahv_w, zabe2, zcof2, zcoef4   !   -      -
-      REAL(wp) ::  zcoef0, ze3w_2, zsign, z2dt, z1_2dt   !   -      -
+      REAL(wp) ::  zcoef0, ze3w_2, zsign                 !   -      -
       REAL(wp), DIMENSION(jpi,jpj)     ::   zdkt, zdk1t, z2d
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdit, zdjt, zftu, zftv, ztfw 
@@ -124,13 +125,8 @@
       l_hst = .FALSE.
       l_ptr = .FALSE.
-      IF( cdtype == 'TRA' .AND. ln_diaptr )                                                 l_ptr = .TRUE. 
+      IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) )     l_ptr = .TRUE. 
       IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
          &                        iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )   l_hst = .TRUE.
       !
-      !                                            ! set time step size (Euler/Leapfrog)
-      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   z2dt =     rdt      ! at nit000   (Euler)
-      ELSE                                        ;   z2dt = 2.* rdt      !             (Leapfrog)
-      ENDIF
-      z1_2dt = 1._wp / z2dt
       !
       IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0)
@@ -144,56 +140,40 @@
       IF( kpass == 1 ) THEN                  !==  first pass only  ==!
          !
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  !
-                  zmsku = wmask(ji,jj,jk) / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)          &
-                     &                           + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk) , 1._wp  )
-                  zmskv = wmask(ji,jj,jk) / MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)          &
-                     &                           + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk) , 1._wp  )
-                     !
-                  zahu_w = (   pahu(ji  ,jj,jk-1) + pahu(ji-1,jj,jk)    &
-                     &       + pahu(ji-1,jj,jk-1) + pahu(ji  ,jj,jk)  ) * zmsku
-                  zahv_w = (   pahv(ji,jj  ,jk-1) + pahv(ji,jj-1,jk)    &
-                     &       + pahv(ji,jj-1,jk-1) + pahv(ji,jj  ,jk)  ) * zmskv
-                     !
-                  ah_wslp2(ji,jj,jk) = zahu_w * wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   &
-                     &               + zahv_w * wslpj(ji,jj,jk) * wslpj(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 2, jpkm1 )
+            !
+            zmsku = wmask(ji,jj,jk) / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)          &
+               &                           + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk) , 1._wp  )
+            zmskv = wmask(ji,jj,jk) / MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)          &
+               &                           + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk) , 1._wp  )
+               !
+            zahu_w = (   pahu(ji  ,jj,jk-1) + pahu(ji-1,jj,jk)    &
+               &       + pahu(ji-1,jj,jk-1) + pahu(ji  ,jj,jk)  ) * zmsku
+            zahv_w = (   pahv(ji,jj  ,jk-1) + pahv(ji,jj-1,jk)    &
+               &       + pahv(ji,jj-1,jk-1) + pahv(ji,jj  ,jk)  ) * zmskv
+               !
+            ah_wslp2(ji,jj,jk) = zahu_w * wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   &
+               &               + zahv_w * wslpj(ji,jj,jk) * wslpj(ji,jj,jk)
+         END_3D
          !
          IF( ln_traldf_msc ) THEN                ! stabilizing vertical diffusivity coefficient
-            DO jk = 2, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     akz(ji,jj,jk) = 0.25_wp * (                                                                     &
-                        &              ( pahu(ji  ,jj,jk) + pahu(ji  ,jj,jk-1) ) / ( e1u(ji  ,jj) * e1u(ji  ,jj) )   &
-                        &            + ( pahu(ji-1,jj,jk) + pahu(ji-1,jj,jk-1) ) / ( e1u(ji-1,jj) * e1u(ji-1,jj) )   &
-                        &            + ( pahv(ji,jj  ,jk) + pahv(ji,jj  ,jk-1) ) / ( e2v(ji,jj  ) * e2v(ji,jj  ) )   &
-                        &            + ( pahv(ji,jj-1,jk) + pahv(ji,jj-1,jk-1) ) / ( e2v(ji,jj-1) * e2v(ji,jj-1) )   )
-                  END DO
-               END DO
-            END DO
+            DO_3D_00_00( 2, jpkm1 )
+               akz(ji,jj,jk) = 0.25_wp * (                                                                     &
+                  &              ( pahu(ji  ,jj,jk) + pahu(ji  ,jj,jk-1) ) / ( e1u(ji  ,jj) * e1u(ji  ,jj) )   &
+                  &            + ( pahu(ji-1,jj,jk) + pahu(ji-1,jj,jk-1) ) / ( e1u(ji-1,jj) * e1u(ji-1,jj) )   &
+                  &            + ( pahv(ji,jj  ,jk) + pahv(ji,jj  ,jk-1) ) / ( e2v(ji,jj  ) * e2v(ji,jj  ) )   &
+                  &            + ( pahv(ji,jj-1,jk) + pahv(ji,jj-1,jk-1) ) / ( e2v(ji,jj-1) * e2v(ji,jj-1) )   )
+            END_3D
             !
             IF( ln_traldf_blp ) THEN                ! bilaplacian operator
-               DO jk = 2, jpkm1
-                  DO jj = 1, jpjm1
-                     DO ji = 1, fs_jpim1
-                        akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk)   &
-                           &          * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk) )  )
-                     END DO
-                  END DO
-               END DO
+               DO_3D_10_10( 2, jpkm1 )
+                  akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk)   &
+                     &          * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) )  )
+               END_3D
             ELSEIF( ln_traldf_lap ) THEN              ! laplacian operator
-               DO jk = 2, jpkm1
-                  DO jj = 1, jpjm1
-                     DO ji = 1, fs_jpim1
-                        ze3w_2 = e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk)
-                        zcoef0 = z2dt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  )
-                        akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * z1_2dt
-                     END DO
-                  END DO
-               END DO
+               DO_3D_10_10( 2, jpkm1 )
+                  ze3w_2 = e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm)
+                  zcoef0 = rDt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  )
+                  akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * r1_Dt
+               END_3D
            ENDIF
            !
@@ -216,26 +196,18 @@
 
          ! Horizontal tracer gradient 
-         DO jk = 1, jpkm1
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zdit(ji,jj,jk) = ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) * umask(ji,jj,jk)
-                  zdjt(ji,jj,jk) = ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_10_10( 1, jpkm1 )
+            zdit(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk)
+            zdjt(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
+         END_3D
          IF( ln_zps ) THEN      ! botton and surface ocean correction of the horizontal gradient
-            DO jj = 1, jpjm1              ! bottom correction (partial bottom cell)
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn)          
-                  zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn)
-               END DO
-            END DO
+            DO_2D_10_10
+               zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn)          
+               zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn)
+            END_2D
             IF( ln_isfcav ) THEN      ! first wet level beneath a cavity
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1   ! vector opt.
-                     IF( miku(ji,jj) > 1 )   zdit(ji,jj,miku(ji,jj)) = pgui(ji,jj,jn)          
-                     IF( mikv(ji,jj) > 1 )   zdjt(ji,jj,mikv(ji,jj)) = pgvi(ji,jj,jn)     
-                  END DO
-               END DO
+               DO_2D_10_10
+                  IF( miku(ji,jj) > 1 )   zdit(ji,jj,miku(ji,jj)) = pgui(ji,jj,jn)          
+                  IF( mikv(ji,jj) > 1 )   zdjt(ji,jj,mikv(ji,jj)) = pgvi(ji,jj,jn)     
+               END_2D
             ENDIF
          ENDIF
@@ -248,39 +220,35 @@
             !
             !                             !== Vertical tracer gradient
-            zdk1t(:,:) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * wmask(:,:,jk+1)     ! level jk+1
+            zdk1t(:,:) = ( pt(:,:,jk,jn) - pt(:,:,jk+1,jn) ) * wmask(:,:,jk+1)     ! level jk+1
             !
             IF( jk == 1 ) THEN   ;   zdkt(:,:) = zdk1t(:,:)                          ! surface: zdkt(jk=1)=zdkt(jk=2)
-            ELSE                 ;   zdkt(:,:) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * wmask(:,:,jk)
+            ELSE                 ;   zdkt(:,:) = ( pt(:,:,jk-1,jn) - pt(:,:,jk,jn) ) * wmask(:,:,jk)
             ENDIF
-            DO jj = 1 , jpjm1            !==  Horizontal fluxes
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk)
-                  zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk)
-                  !
-                  zmsku = 1. / MAX(  wmask(ji+1,jj,jk  ) + wmask(ji,jj,jk+1)   &
-                     &             + wmask(ji+1,jj,jk+1) + wmask(ji,jj,jk  ), 1. )
-                  !
-                  zmskv = 1. / MAX(  wmask(ji,jj+1,jk  ) + wmask(ji,jj,jk+1)   &
-                     &             + wmask(ji,jj+1,jk+1) + wmask(ji,jj,jk  ), 1. )
-                  !
-                  zcof1 = - pahu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku
-                  zcof2 = - pahv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv
-                  !
-                  zftu(ji,jj,jk ) = (  zabe1 * zdit(ji,jj,jk)   &
-                     &               + zcof1 * (  zdkt (ji+1,jj) + zdk1t(ji,jj)      &
-                     &                          + zdk1t(ji+1,jj) + zdkt (ji,jj)  )  ) * umask(ji,jj,jk)
-                  zftv(ji,jj,jk) = (  zabe2 * zdjt(ji,jj,jk)   &
-                     &               + zcof2 * (  zdkt (ji,jj+1) + zdk1t(ji,jj)      &
-                     &                          + zdk1t(ji,jj+1) + zdkt (ji,jj)  )  ) * vmask(ji,jj,jk)                  
-               END DO
-            END DO
-            !
-            DO jj = 2 , jpjm1          !== horizontal divergence and add to pta
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  zftu(ji,jj,jk) - zftu(ji-1,jj,jk)      &
-                     &                                           + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )   &
-                     &                                        * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
-               END DO
-            END DO
+            DO_2D_10_10
+               zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm)
+               zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm)
+               !
+               zmsku = 1. / MAX(  wmask(ji+1,jj,jk  ) + wmask(ji,jj,jk+1)   &
+                  &             + wmask(ji+1,jj,jk+1) + wmask(ji,jj,jk  ), 1. )
+               !
+               zmskv = 1. / MAX(  wmask(ji,jj+1,jk  ) + wmask(ji,jj,jk+1)   &
+                  &             + wmask(ji,jj+1,jk+1) + wmask(ji,jj,jk  ), 1. )
+               !
+               zcof1 = - pahu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku
+               zcof2 = - pahv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv
+               !
+               zftu(ji,jj,jk ) = (  zabe1 * zdit(ji,jj,jk)   &
+                  &               + zcof1 * (  zdkt (ji+1,jj) + zdk1t(ji,jj)      &
+                  &                          + zdk1t(ji+1,jj) + zdkt (ji,jj)  )  ) * umask(ji,jj,jk)
+               zftv(ji,jj,jk) = (  zabe2 * zdjt(ji,jj,jk)   &
+                  &               + zcof2 * (  zdkt (ji,jj+1) + zdk1t(ji,jj)      &
+                  &                          + zdk1t(ji,jj+1) + zdkt (ji,jj)  )  ) * vmask(ji,jj,jk)                  
+            END_2D
+            !
+            DO_2D_00_00
+               pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + zsign * (  zftu(ji,jj,jk) - zftu(ji-1,jj,jk)      &
+                  &                                                 + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )   &
+                  &                                              * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+            END_2D
          END DO                                        !   End of slab  
 
@@ -288,6 +256,4 @@
          !!   III - vertical trend (full)
          !!----------------------------------------------------------------------
-         !
-         ztfw(fs_2:1,:,:) = 0._wp     ;     ztfw(jpi:fs_jpim1,:,:) = 0._wp   ! avoid to potentially manipulate NaN values
          !
          ! Vertical fluxes
@@ -296,73 +262,53 @@
          ztfw(:,:, 1 ) = 0._wp      ;      ztfw(:,:,jpk) = 0._wp
          
-         DO jk = 2, jpkm1           ! interior (2=<jk=<jpk-1)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  !
-                  zmsku = wmask(ji,jj,jk) / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)          &
-                     &                           + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk) , 1._wp  )
-                  zmskv = wmask(ji,jj,jk) / MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)          &
-                     &                           + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk) , 1._wp  )
-                     !
-                  zahu_w = (   pahu(ji  ,jj,jk-1) + pahu(ji-1,jj,jk)    &
-                     &       + pahu(ji-1,jj,jk-1) + pahu(ji  ,jj,jk)  ) * zmsku
-                  zahv_w = (   pahv(ji,jj  ,jk-1) + pahv(ji,jj-1,jk)    &
-                     &       + pahv(ji,jj-1,jk-1) + pahv(ji,jj  ,jk)  ) * zmskv
-                     !
-                  zcoef3 = - zahu_w * e2t(ji,jj) * zmsku * wslpi (ji,jj,jk)   !wslpi & j are already w-masked
-                  zcoef4 = - zahv_w * e1t(ji,jj) * zmskv * wslpj (ji,jj,jk)
-                  !
-                  ztfw(ji,jj,jk) = zcoef3 * (   zdit(ji  ,jj  ,jk-1) + zdit(ji-1,jj  ,jk)      &
-                     &                        + zdit(ji-1,jj  ,jk-1) + zdit(ji  ,jj  ,jk)  )   &
-                     &           + zcoef4 * (   zdjt(ji  ,jj  ,jk-1) + zdjt(ji  ,jj-1,jk)      &
-                     &                        + zdjt(ji  ,jj-1,jk-1) + zdjt(ji  ,jj  ,jk)  )
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 2, jpkm1 )
+            !
+            zmsku = wmask(ji,jj,jk) / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)          &
+               &                           + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk) , 1._wp  )
+            zmskv = wmask(ji,jj,jk) / MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)          &
+               &                           + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk) , 1._wp  )
+               !
+            zahu_w = (   pahu(ji  ,jj,jk-1) + pahu(ji-1,jj,jk)    &
+               &       + pahu(ji-1,jj,jk-1) + pahu(ji  ,jj,jk)  ) * zmsku
+            zahv_w = (   pahv(ji,jj  ,jk-1) + pahv(ji,jj-1,jk)    &
+               &       + pahv(ji,jj-1,jk-1) + pahv(ji,jj  ,jk)  ) * zmskv
+               !
+            zcoef3 = - zahu_w * e2t(ji,jj) * zmsku * wslpi (ji,jj,jk)   !wslpi & j are already w-masked
+            zcoef4 = - zahv_w * e1t(ji,jj) * zmskv * wslpj (ji,jj,jk)
+            !
+            ztfw(ji,jj,jk) = zcoef3 * (   zdit(ji  ,jj  ,jk-1) + zdit(ji-1,jj  ,jk)      &
+               &                        + zdit(ji-1,jj  ,jk-1) + zdit(ji  ,jj  ,jk)  )   &
+               &           + zcoef4 * (   zdjt(ji  ,jj  ,jk-1) + zdjt(ji  ,jj-1,jk)      &
+               &                        + zdjt(ji  ,jj-1,jk-1) + zdjt(ji  ,jj  ,jk)  )
+         END_3D
          !                                !==  add the vertical 33 flux  ==!
          IF( ln_traldf_lap ) THEN               ! laplacian case: eddy coef = ah_wslp2 - akz
-            DO jk = 2, jpkm1       
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w_n(ji,jj,jk) * wmask(ji,jj,jk)   &
-                        &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )             &
-                        &                            * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) )
-                  END DO
-               END DO
-            END DO
+            DO_3D_00_00( 2, jpkm1 )
+               ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk)   &
+                  &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )               &
+                  &                            * (  pt(ji,jj,jk-1,jn) -  pt(ji,jj,jk,jn) )
+            END_3D
             !
          ELSE                                   ! bilaplacian 
             SELECT CASE( kpass )
             CASE(  1  )                            ! 1st pass : eddy coef = ah_wslp2
-               DO jk = 2, jpkm1 
-                  DO jj = 2, jpjm1
-                     DO ji = fs_2, fs_jpim1
-                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk)    &
-                           &           + ah_wslp2(ji,jj,jk) * e1e2t(ji,jj)   &
-                           &           * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) / e3w_n(ji,jj,jk) * wmask(ji,jj,jk)
-                     END DO
-                  END DO
-               END DO 
-            CASE(  2  )                         ! 2nd pass : eddy flux = ah_wslp2 and akz applied on ptb  and ptbb gradients, resp.
-               DO jk = 2, jpkm1 
-                  DO jj = 2, jpjm1
-                     DO ji = fs_2, fs_jpim1
-                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w_n(ji,jj,jk) * wmask(ji,jj,jk)                      &
-                           &                            * (  ah_wslp2(ji,jj,jk) * ( ptb (ji,jj,jk-1,jn) - ptb (ji,jj,jk,jn) )   &
-                           &                               + akz     (ji,jj,jk) * ( ptbb(ji,jj,jk-1,jn) - ptbb(ji,jj,jk,jn) )   )
-                     END DO
-                  END DO
-               END DO
+               DO_3D_00_00( 2, jpkm1 )
+                  ztfw(ji,jj,jk) = ztfw(ji,jj,jk)                       &
+                     &           + ah_wslp2(ji,jj,jk)  * e1e2t(ji,jj)   &
+                     &           * ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk)
+               END_3D
+            CASE(  2  )                         ! 2nd pass : eddy flux = ah_wslp2 and akz applied on pt  and pt2 gradients, resp.
+               DO_3D_00_00( 2, jpkm1 )
+                  ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk)                  &
+                     &                            * (  ah_wslp2(ji,jj,jk) * ( pt (ji,jj,jk-1,jn) - pt (ji,jj,jk,jn) )   &
+                     &                            +         akz(ji,jj,jk) * ( pt2(ji,jj,jk-1,jn) - pt2(ji,jj,jk,jn) )   )
+               END_3D
             END SELECT
          ENDIF
          !         
-         DO jk = 1, jpkm1                 !==  Divergence of vertical fluxes added to pta  ==!
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  ztfw (ji,jj,jk) - ztfw(ji,jj,jk+1)  )   &
-                     &                                        * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + zsign * (  ztfw (ji,jj,jk) - ztfw(ji,jj,jk+1)  )   &
+               &                                              * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+         END_3D
          !
          IF( ( kpass == 1 .AND. ln_traldf_lap ) .OR.  &     !==  first pass only (  laplacian)  ==!
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traldf_lap_blp.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traldf_lap_blp.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traldf_lap_blp.F90	(revision 12928)
@@ -37,5 +37,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -45,7 +45,7 @@
 CONTAINS
 
-   SUBROUTINE tra_ldf_lap( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   &
-      &                                                    pgui, pgvi,   &
-      &                                        ptb , pta , kjpt, kpass ) 
+   SUBROUTINE tra_ldf_lap( kt, Kmm, kit000, cdtype, pahu, pahv  ,               &
+      &                                             pgu , pgv   , pgui, pgvi,   &
+      &                                             pt  , pt_rhs, kjpt, kpass ) 
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_ldf_lap  ***
@@ -59,8 +59,8 @@
       !!          difft = 1/(e1e2t*e3t) {  di-1[ pahu e2u*e3u/e1u di(tb) ]
       !!                                 + dj-1[ pahv e1v*e3v/e2v dj(tb) ] }
-      !!      Add this trend to the general tracer trend pta :
-      !!          pta = pta + difft
-      !!
-      !! ** Action  : - Update pta arrays with the before iso-level 
+      !!      Add this trend to the general tracer trend pt_rhs :
+      !!          pt_rhs = pt_rhs + difft
+      !!
+      !! ** Action  : - Update pt_rhs arrays with the before iso-level 
       !!                harmonic mixing trend.
       !!----------------------------------------------------------------------
@@ -70,9 +70,10 @@
       INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
       INTEGER                              , INTENT(in   ) ::   kpass      ! =1/2 first or second passage
+      INTEGER                              , INTENT(in   ) ::   Kmm        ! ocean time level index
       REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s]
       REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
       REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt         ! before tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs     ! tracer trend 
       !
       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
@@ -89,5 +90,5 @@
       l_hst = .FALSE.
       l_ptr = .FALSE.
-      IF( cdtype == 'TRA' .AND. ln_diaptr )                                                l_ptr = .TRUE. 
+      IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) )     l_ptr = .TRUE.
       IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
          &                        iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )  l_hst = .TRUE.
@@ -97,12 +98,8 @@
       ELSE                    ;   zsign = -1._wp
       ENDIF
-      DO jk = 1, jpkm1
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zaheeu(ji,jj,jk) = zsign * pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk)   !!gm   * umask(ji,jj,jk) pah masked!
-               zaheev(ji,jj,jk) = zsign * pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk)   !!gm   * vmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D_10_10( 1, jpkm1 )
+         zaheeu(ji,jj,jk) = zsign * pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm)   !!gm   * umask(ji,jj,jk) pah masked!
+         zaheev(ji,jj,jk) = zsign * pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm)   !!gm   * vmask(ji,jj,jk)
+      END_3D
       !
       !                             ! =========== !
@@ -110,38 +107,26 @@
          !                          ! =========== !    
          !                               
-         DO jk = 1, jpkm1              !== First derivative (gradient)  ==!
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1
-                  ztu(ji,jj,jk) = zaheeu(ji,jj,jk) * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) )
-                  ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
-               END DO
-            END DO
-         END DO  
+         DO_3D_10_10( 1, jpkm1 )
+            ztu(ji,jj,jk) = zaheeu(ji,jj,jk) * ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj,jk,jn) )
+            ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj,jk,jn) )
+         END_3D
          IF( ln_zps ) THEN                ! set gradient at bottom/top ocean level
-            DO jj = 1, jpjm1                    ! bottom
-               DO ji = 1, fs_jpim1
-                  ztu(ji,jj,mbku(ji,jj)) = zaheeu(ji,jj,mbku(ji,jj)) * pgu(ji,jj,jn)
-                  ztv(ji,jj,mbkv(ji,jj)) = zaheev(ji,jj,mbkv(ji,jj)) * pgv(ji,jj,jn)
-               END DO
-            END DO  
+            DO_2D_10_10
+               ztu(ji,jj,mbku(ji,jj)) = zaheeu(ji,jj,mbku(ji,jj)) * pgu(ji,jj,jn)
+               ztv(ji,jj,mbkv(ji,jj)) = zaheev(ji,jj,mbkv(ji,jj)) * pgv(ji,jj,jn)
+            END_2D
             IF( ln_isfcav ) THEN                ! top in ocean cavities only
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1   ! vector opt.
-                     IF( miku(ji,jj) > 1 )   ztu(ji,jj,miku(ji,jj)) = zaheeu(ji,jj,miku(ji,jj)) * pgui(ji,jj,jn) 
-                     IF( mikv(ji,jj) > 1 )   ztv(ji,jj,mikv(ji,jj)) = zaheev(ji,jj,mikv(ji,jj)) * pgvi(ji,jj,jn) 
-                  END DO
-               END DO
+               DO_2D_10_10
+                  IF( miku(ji,jj) > 1 )   ztu(ji,jj,miku(ji,jj)) = zaheeu(ji,jj,miku(ji,jj)) * pgui(ji,jj,jn) 
+                  IF( mikv(ji,jj) > 1 )   ztv(ji,jj,mikv(ji,jj)) = zaheev(ji,jj,mikv(ji,jj)) * pgvi(ji,jj,jn) 
+               END_2D
             ENDIF
          ENDIF
          !
-         DO jk = 1, jpkm1              !== Second derivative (divergence) added to the general tracer trends  ==!
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)     &
-                     &                                   + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) )   &
-                     &                                / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) )
-               END DO
-            END DO
-         END DO  
+         DO_3D_00_00( 1, jpkm1 )
+            pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)     &
+               &                                      +    ztv(ji,jj,jk) - ztv(ji,jj-1,jk) )   &
+               &                                      / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) )
+         END_3D
          !
          !                             !== "Poleward" diffusive heat or salt transports  ==!
@@ -159,7 +144,7 @@
    
 
-   SUBROUTINE tra_ldf_blp( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   &
-      &                                                    pgui, pgvi,   &
-      &                                                    ptb , pta , kjpt, kldf )
+   SUBROUTINE tra_ldf_blp( kt, Kmm, kit000, cdtype, pahu, pahv  ,             &
+      &                                             pgu , pgv   , pgui, pgvi, &
+      &                                             pt  , pt_rhs, kjpt, kldf )
       !!----------------------------------------------------------------------
       !!                 ***  ROUTINE tra_ldf_blp  ***
@@ -179,9 +164,10 @@
       INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
       INTEGER                              , INTENT(in   ) ::   kldf       ! type of operator used
+      INTEGER                              , INTENT(in   ) ::   Kmm        ! ocean time level indices
       REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s]
       REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
       REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top levels
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt         ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs     ! tracer trend
       !
       INTEGER ::   ji, jj, jk, jn   ! dummy loop indices
@@ -203,28 +189,28 @@
       zlap(:,:,:,:) = 0._wp
       !
-      SELECT CASE ( kldf )       !==  1st laplacian applied to ptb (output in zlap)  ==!
+      SELECT CASE ( kldf )       !==  1st laplacian applied to pt (output in zlap)  ==!
       !
       CASE ( np_blp    )               ! iso-level bilaplacian
-         CALL tra_ldf_lap  ( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb,      zlap, kjpt, 1 )
+         CALL tra_ldf_lap  ( kt, Kmm, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, pt,     zlap, kjpt, 1 )
       CASE ( np_blp_i  )               ! rotated   bilaplacian : standard operator (Madec)
-         CALL tra_ldf_iso  ( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, ptb, zlap, kjpt, 1 )
+         CALL tra_ldf_iso  ( kt, Kmm, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, pt, pt, zlap, kjpt, 1 )
       CASE ( np_blp_it )               ! rotated  bilaplacian : triad operator (griffies)
-         CALL tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, ptb, zlap, kjpt, 1 )
+         CALL tra_ldf_triad( kt, Kmm, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, pt, pt, zlap, kjpt, 1 )
       END SELECT
       !
       CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1. )     ! Lateral boundary conditions (unchanged sign)
       !                                               ! Partial top/bottom cell: GRADh( zlap )  
-      IF( ln_isfcav .AND. ln_zps ) THEN   ;   CALL zps_hde_isf( kt, kjpt, zlap, zglu, zglv, zgui, zgvi )  ! both top & bottom
-      ELSEIF(             ln_zps ) THEN   ;   CALL zps_hde    ( kt, kjpt, zlap, zglu, zglv )              ! only bottom 
-      ENDIF
-      !
-      SELECT CASE ( kldf )       !==  2nd laplacian applied to zlap (output in pta)  ==!
+      IF( ln_isfcav .AND. ln_zps ) THEN   ;   CALL zps_hde_isf( kt, Kmm, kjpt, zlap, zglu, zglv, zgui, zgvi )  ! both top & bottom
+      ELSEIF(             ln_zps ) THEN   ;   CALL zps_hde    ( kt, Kmm, kjpt, zlap, zglu, zglv )              ! only bottom 
+      ENDIF
+      !
+      SELECT CASE ( kldf )       !==  2nd laplacian applied to zlap (output in pt_rhs)  ==!
       !
       CASE ( np_blp    )               ! iso-level bilaplacian
-         CALL tra_ldf_lap  ( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pta,      kjpt, 2 )
+         CALL tra_ldf_lap  ( kt, Kmm, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pt_rhs,         kjpt, 2 )
       CASE ( np_blp_i  )               ! rotated   bilaplacian : standard operator (Madec)
-         CALL tra_ldf_iso  ( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, ptb, pta, kjpt, 2 )
+         CALL tra_ldf_iso  ( kt, Kmm, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pt    , pt_rhs, kjpt, 2 )
       CASE ( np_blp_it )               ! rotated  bilaplacian : triad operator (griffies)
-         CALL tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, ptb, pta, kjpt, 2 )
+         CALL tra_ldf_triad( kt, Kmm, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pt    , pt_rhs, kjpt, 2 )
       END SELECT
       !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traldf_triad.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traldf_triad.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traldf_triad.F90	(revision 12928)
@@ -40,5 +40,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -48,7 +48,7 @@
 CONTAINS
 
-  SUBROUTINE tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   &
-      &                                                     pgui, pgvi,   &
-      &                                         ptb , ptbb, pta , kjpt, kpass )
+  SUBROUTINE tra_ldf_triad( kt, Kmm, kit000, cdtype, pahu, pahv,               &
+      &                                              pgu , pgv  , pgui, pgvi , &
+      &                                         pt , pt2, pt_rhs, kjpt, kpass )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_ldf_triad  ***
@@ -66,5 +66,5 @@
       !!      see documentation for the desciption
       !!
-      !! ** Action :   pta   updated with the before rotated diffusion
+      !! ** Action :   pt_rhs   updated with the before rotated diffusion
       !!               ah_wslp2 ....
       !!               akz   stabilizing vertical diffusivity coefficient (used in trazdf_imp)
@@ -75,17 +75,18 @@
       INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
       INTEGER                              , INTENT(in   ) ::   kpass      ! =1/2 first or second passage
+      INTEGER                              , INTENT(in)    ::   Kmm        ! ocean time level indices
       REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s]
       REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu , pgv  ! tracer gradient at pstep levels
       REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! tracer (kpass=1) or laplacian of tracer (kpass=2)
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptbb       ! tracer (only used in kpass=2)
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt         ! tracer (kpass=1) or laplacian of tracer (kpass=2)
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt2        ! tracer (only used in kpass=2)
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs     ! tracer trend
       !
       INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
       INTEGER  ::  ip,jp,kp         ! dummy loop indices
       INTEGER  ::  ierr            ! local integer
-      REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3          ! local scalars
-      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4          !   -      -
-      REAL(wp) ::  zcoef0, ze3w_2, zsign, z2dt, z1_2dt  !   -      -
+      REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3    ! local scalars
+      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4    !   -      -
+      REAL(wp) ::  zcoef0, ze3w_2, zsign          !   -      -
       !
       REAL(wp) ::   zslope_skew, zslope_iso, zslope2, zbu, zbv
@@ -110,13 +111,9 @@
       l_hst = .FALSE.
       l_ptr = .FALSE.
-      IF( cdtype == 'TRA' .AND. ln_diaptr )                                                 l_ptr = .TRUE. 
-      IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
-         &                        iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )   l_hst = .TRUE.
-      !
-      !                                                        ! set time step size (Euler/Leapfrog)
-      IF( neuler == 0 .AND. kt == kit000 ) THEN   ;   z2dt =     rdt      ! at nit000   (Euler)
-      ELSE                                        ;   z2dt = 2.* rdt      !             (Leapfrog)
+      IF( cdtype == 'TRA' ) THEN
+         IF( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf') )      l_ptr = .TRUE. 
+         IF( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR.                   &
+         &   iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  )   l_hst = .TRUE.
       ENDIF
-      z1_2dt = 1._wp / z2dt
       !
       IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0)
@@ -139,23 +136,19 @@
          DO ip = 0, 1                            ! i-k triads
             DO kp = 0, 1
-               DO jk = 1, jpkm1
-                  DO jj = 1, jpjm1
-                     DO ji = 1, fs_jpim1
-                        ze3wr = 1._wp / e3w_n(ji+ip,jj,jk+kp)
-                        zbu   = e1e2u(ji,jj) * e3u_n(ji,jj,jk)
-                        zah   = 0.25_wp * pahu(ji,jj,jk)
-                        zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp)
-                        ! Subtract s-coordinate slope at t-points to give slope rel to s-surfaces (do this by *adding* gradient of depth)
-                        zslope2 = zslope_skew + ( gdept_n(ji+1,jj,jk) - gdept_n(ji,jj,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk+kp)
-                        zslope2 = zslope2 *zslope2
-                        ah_wslp2(ji+ip,jj,jk+kp) = ah_wslp2(ji+ip,jj,jk+kp) + zah * zbu * ze3wr * r1_e1e2t(ji+ip,jj) * zslope2
-                        akz     (ji+ip,jj,jk+kp) = akz     (ji+ip,jj,jk+kp) + zah * r1_e1u(ji,jj)       &
-                           &                                                      * r1_e1u(ji,jj) * umask(ji,jj,jk+kp)
-                           !
-                       IF( ln_ldfeiv_dia )   zpsi_uw(ji,jj,jk+kp) = zpsi_uw(ji,jj,jk+kp)   &
-                           &                                       + 0.25_wp * aeiu(ji,jj,jk) * e2u(ji,jj) * zslope_skew
-                     END DO
-                  END DO
-               END DO
+               DO_3D_10_10( 1, jpkm1 )
+                  ze3wr = 1._wp / e3w(ji+ip,jj,jk+kp,Kmm)
+                  zbu   = e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm)
+                  zah   = 0.25_wp * pahu(ji,jj,jk)
+                  zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp)
+                  ! Subtract s-coordinate slope at t-points to give slope rel to s-surfaces (do this by *adding* gradient of depth)
+                  zslope2 = zslope_skew + ( gdept(ji+1,jj,jk,Kmm) - gdept(ji,jj,jk,Kmm) ) * r1_e1u(ji,jj) * umask(ji,jj,jk+kp)
+                  zslope2 = zslope2 *zslope2
+                  ah_wslp2(ji+ip,jj,jk+kp) = ah_wslp2(ji+ip,jj,jk+kp) + zah * zbu * ze3wr * r1_e1e2t(ji+ip,jj) * zslope2
+                  akz     (ji+ip,jj,jk+kp) = akz     (ji+ip,jj,jk+kp) + zah * r1_e1u(ji,jj)       &
+                     &                                                      * r1_e1u(ji,jj) * umask(ji,jj,jk+kp)
+                     !
+                 IF( ln_ldfeiv_dia )   zpsi_uw(ji,jj,jk+kp) = zpsi_uw(ji,jj,jk+kp)   &
+                     &                                       + 0.25_wp * aeiu(ji,jj,jk) * e2u(ji,jj) * zslope_skew
+               END_3D
             END DO
          END DO
@@ -163,24 +156,20 @@
          DO jp = 0, 1                            ! j-k triads 
             DO kp = 0, 1
-               DO jk = 1, jpkm1
-                  DO jj = 1, jpjm1
-                     DO ji = 1, fs_jpim1
-                        ze3wr = 1.0_wp / e3w_n(ji,jj+jp,jk+kp)
-                        zbv   = e1e2v(ji,jj) * e3v_n(ji,jj,jk)
-                        zah   = 0.25_wp * pahv(ji,jj,jk)
-                        zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp)
-                        ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces
-                        !    (do this by *adding* gradient of depth)
-                        zslope2 = zslope_skew + ( gdept_n(ji,jj+1,jk) - gdept_n(ji,jj,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp)
-                        zslope2 = zslope2 * zslope2
-                        ah_wslp2(ji,jj+jp,jk+kp) = ah_wslp2(ji,jj+jp,jk+kp) + zah * zbv * ze3wr * r1_e1e2t(ji,jj+jp) * zslope2
-                        akz     (ji,jj+jp,jk+kp) = akz     (ji,jj+jp,jk+kp) + zah * r1_e2v(ji,jj)     &
-                           &                                                      * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp)
-                        !
-                        IF( ln_ldfeiv_dia )   zpsi_vw(ji,jj,jk+kp) = zpsi_vw(ji,jj,jk+kp)   &
-                           &                                       + 0.25 * aeiv(ji,jj,jk) * e1v(ji,jj) * zslope_skew
-                     END DO
-                  END DO
-               END DO
+               DO_3D_10_10( 1, jpkm1 )
+                  ze3wr = 1.0_wp / e3w(ji,jj+jp,jk+kp,Kmm)
+                  zbv   = e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm)
+                  zah   = 0.25_wp * pahv(ji,jj,jk)
+                  zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp)
+                  ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces
+                  !    (do this by *adding* gradient of depth)
+                  zslope2 = zslope_skew + ( gdept(ji,jj+1,jk,Kmm) - gdept(ji,jj,jk,Kmm) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp)
+                  zslope2 = zslope2 * zslope2
+                  ah_wslp2(ji,jj+jp,jk+kp) = ah_wslp2(ji,jj+jp,jk+kp) + zah * zbv * ze3wr * r1_e1e2t(ji,jj+jp) * zslope2
+                  akz     (ji,jj+jp,jk+kp) = akz     (ji,jj+jp,jk+kp) + zah * r1_e2v(ji,jj)     &
+                     &                                                      * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp)
+                  !
+                  IF( ln_ldfeiv_dia )   zpsi_vw(ji,jj,jk+kp) = zpsi_vw(ji,jj,jk+kp)   &
+                     &                                       + 0.25 * aeiv(ji,jj,jk) * e1v(ji,jj) * zslope_skew
+               END_3D
             END DO
          END DO
@@ -189,22 +178,14 @@
             !
             IF( ln_traldf_blp ) THEN                ! bilaplacian operator
-               DO jk = 2, jpkm1
-                  DO jj = 1, jpjm1
-                     DO ji = 1, fs_jpim1
-                        akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk)   &
-                           &          * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk) )  )
-                     END DO
-                  END DO
-               END DO
+               DO_3D_10_10( 2, jpkm1 )
+                  akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk)   &
+                     &          * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) )  )
+               END_3D
             ELSEIF( ln_traldf_lap ) THEN              ! laplacian operator
-               DO jk = 2, jpkm1
-                  DO jj = 1, jpjm1
-                     DO ji = 1, fs_jpim1
-                        ze3w_2 = e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk)
-                        zcoef0 = z2dt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  )
-                        akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * z1_2dt
-                     END DO
-                  END DO
-               END DO
+               DO_3D_10_10( 2, jpkm1 )
+                  ze3w_2 = e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm)
+                  zcoef0 = rDt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  )
+                  akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * r1_Dt
+               END_3D
            ENDIF
            !
@@ -213,5 +194,5 @@
          ENDIF
          !
-         IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' )   CALL ldf_eiv_dia( zpsi_uw, zpsi_vw )
+         IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' )   CALL ldf_eiv_dia( zpsi_uw, zpsi_vw, Kmm )
          !
       ENDIF                                  !==  end 1st pass only  ==!
@@ -226,26 +207,18 @@
          zftv(:,:,:) = 0._wp
          !
-         DO jk = 1, jpkm1        !==  before lateral T & S gradients at T-level jk  ==!
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zdit(ji,jj,jk) = ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) * umask(ji,jj,jk)
-                  zdjt(ji,jj,jk) = ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_10_10( 1, jpkm1 )
+            zdit(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk)
+            zdjt(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
+         END_3D
          IF( ln_zps .AND. l_grad_zps ) THEN    ! partial steps: correction at top/bottom ocean level
-            DO jj = 1, jpjm1                       ! bottom level
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn)
-                  zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn)
-               END DO
-            END DO
+            DO_2D_10_10
+               zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn)
+               zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn)
+            END_2D
             IF( ln_isfcav ) THEN                   ! top level (ocean cavities only)
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1   ! vector opt.
-                     IF( miku(ji,jj)  > 1 )   zdit(ji,jj,miku(ji,jj) ) = pgui(ji,jj,jn) 
-                     IF( mikv(ji,jj)  > 1 )   zdjt(ji,jj,mikv(ji,jj) ) = pgvi(ji,jj,jn) 
-                  END DO
-               END DO
+               DO_2D_10_10
+                  IF( miku(ji,jj)  > 1 )   zdit(ji,jj,miku(ji,jj) ) = pgui(ji,jj,jn) 
+                  IF( mikv(ji,jj)  > 1 )   zdjt(ji,jj,mikv(ji,jj) ) = pgvi(ji,jj,jn) 
+               END_2D
             ENDIF
          ENDIF
@@ -257,9 +230,9 @@
          DO jk = 1, jpkm1
             !                    !==  Vertical tracer gradient at level jk and jk+1
-            zdkt3d(:,:,1) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * tmask(:,:,jk+1)
+            zdkt3d(:,:,1) = ( pt(:,:,jk,jn) - pt(:,:,jk+1,jn) ) * tmask(:,:,jk+1)
             !
             !                    ! surface boundary condition: zdkt3d(jk=0)=zdkt3d(jk=1)
             IF( jk == 1 ) THEN   ;   zdkt3d(:,:,0) = zdkt3d(:,:,1)
-            ELSE                 ;   zdkt3d(:,:,0) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * tmask(:,:,jk)
+            ELSE                 ;   zdkt3d(:,:,0) = ( pt(:,:,jk-1,jn) - pt(:,:,jk,jn) ) * tmask(:,:,jk)
             ENDIF
             !
@@ -269,22 +242,20 @@
                DO ip = 0, 1              !==  Horizontal & vertical fluxes
                   DO kp = 0, 1
-                     DO jj = 1, jpjm1
-                        DO ji = 1, fs_jpim1
-                           ze1ur = r1_e1u(ji,jj)
-                           zdxt  = zdit(ji,jj,jk) * ze1ur
-                           ze3wr = 1._wp / e3w_n(ji+ip,jj,jk+kp)
-                           zdzt  = zdkt3d(ji+ip,jj,kp) * ze3wr
-                           zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp)
-                           zslope_iso  = triadi  (ji+ip,jj,jk,1-ip,kp)
-                           !
-                           zbu = 0.25_wp * e1e2u(ji,jj) * e3u_n(ji,jj,jk)
-                           ! ln_botmix_triad is .T. don't mask zah for bottom half cells    !!gm ?????   ahu is masked....
-                           zah = pahu(ji,jj,jk)
-                           zah_slp  = zah * zslope_iso
-                           IF( ln_ldfeiv )   zaei_slp = aeiu(ji,jj,jk) * zslope_skew
-                           zftu(ji   ,jj,jk   ) = zftu(ji   ,jj,jk   ) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur
-                           ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - ( zah_slp + zaei_slp) * zdxt                 * zbu * ze3wr
-                        END DO
-                     END DO
+                     DO_2D_10_10
+                        ze1ur = r1_e1u(ji,jj)
+                        zdxt  = zdit(ji,jj,jk) * ze1ur
+                        ze3wr = 1._wp / e3w(ji+ip,jj,jk+kp,Kmm)
+                        zdzt  = zdkt3d(ji+ip,jj,kp) * ze3wr
+                        zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp)
+                        zslope_iso  = triadi  (ji+ip,jj,jk,1-ip,kp)
+                        !
+                        zbu = 0.25_wp * e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm)
+                        ! ln_botmix_triad is .T. don't mask zah for bottom half cells    !!gm ?????   ahu is masked....
+                        zah = pahu(ji,jj,jk)
+                        zah_slp  = zah * zslope_iso
+                        IF( ln_ldfeiv )   zaei_slp = aeiu(ji,jj,jk) * zslope_skew
+                        zftu(ji   ,jj,jk   ) = zftu(ji   ,jj,jk   ) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur
+                        ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - ( zah_slp + zaei_slp) * zdxt                 * zbu * ze3wr
+                     END_2D
                   END DO
                END DO
@@ -292,21 +263,19 @@
                DO jp = 0, 1
                   DO kp = 0, 1
-                     DO jj = 1, jpjm1
-                        DO ji = 1, fs_jpim1
-                           ze2vr = r1_e2v(ji,jj)
-                           zdyt  = zdjt(ji,jj,jk) * ze2vr
-                           ze3wr = 1._wp / e3w_n(ji,jj+jp,jk+kp)
-                           zdzt  = zdkt3d(ji,jj+jp,kp) * ze3wr
-                           zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp)
-                           zslope_iso  = triadj(ji,jj+jp,jk,1-jp,kp)
-                           zbv = 0.25_wp * e1e2v(ji,jj) * e3v_n(ji,jj,jk)
-                           ! ln_botmix_triad is .T. don't mask zah for bottom half cells    !!gm ?????  ahv is masked...
-                           zah = pahv(ji,jj,jk)
-                           zah_slp = zah * zslope_iso
-                           IF( ln_ldfeiv )   zaei_slp = aeiv(ji,jj,jk) * zslope_skew
-                           zftv(ji,jj   ,jk   ) = zftv(ji,jj   ,jk   ) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr
-                           ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - ( zah_slp + zaei_slp ) * zdyt                * zbv * ze3wr
-                        END DO
-                     END DO
+                     DO_2D_10_10
+                        ze2vr = r1_e2v(ji,jj)
+                        zdyt  = zdjt(ji,jj,jk) * ze2vr
+                        ze3wr = 1._wp / e3w(ji,jj+jp,jk+kp,Kmm)
+                        zdzt  = zdkt3d(ji,jj+jp,kp) * ze3wr
+                        zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp)
+                        zslope_iso  = triadj(ji,jj+jp,jk,1-jp,kp)
+                        zbv = 0.25_wp * e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm)
+                        ! ln_botmix_triad is .T. don't mask zah for bottom half cells    !!gm ?????  ahv is masked...
+                        zah = pahv(ji,jj,jk)
+                        zah_slp = zah * zslope_iso
+                        IF( ln_ldfeiv )   zaei_slp = aeiv(ji,jj,jk) * zslope_skew
+                        zftv(ji,jj   ,jk   ) = zftv(ji,jj   ,jk   ) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr
+                        ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - ( zah_slp + zaei_slp ) * zdyt                * zbv * ze3wr
+                     END_2D
                   END DO
                END DO
@@ -316,22 +285,20 @@
                DO ip = 0, 1               !==  Horizontal & vertical fluxes
                   DO kp = 0, 1
-                     DO jj = 1, jpjm1
-                        DO ji = 1, fs_jpim1
-                           ze1ur = r1_e1u(ji,jj)
-                           zdxt  = zdit(ji,jj,jk) * ze1ur
-                           ze3wr = 1._wp / e3w_n(ji+ip,jj,jk+kp)
-                           zdzt  = zdkt3d(ji+ip,jj,kp) * ze3wr
-                           zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp)
-                           zslope_iso  = triadi(ji+ip,jj,jk,1-ip,kp)
-                           !
-                           zbu = 0.25_wp * e1e2u(ji,jj) * e3u_n(ji,jj,jk)
-                           ! ln_botmix_triad is .F. mask zah for bottom half cells
-                           zah = pahu(ji,jj,jk) * umask(ji,jj,jk+kp)         ! pahu(ji+ip,jj,jk)   ===>>  ????
-                           zah_slp  = zah * zslope_iso
-                           IF( ln_ldfeiv )   zaei_slp = aeiu(ji,jj,jk) * zslope_skew        ! aeit(ji+ip,jj,jk)*zslope_skew
-                           zftu(ji   ,jj,jk   ) = zftu(ji   ,jj,jk   ) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur
-                           ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - (zah_slp + zaei_slp) * zdxt * zbu * ze3wr
-                        END DO
-                     END DO
+                     DO_2D_10_10
+                        ze1ur = r1_e1u(ji,jj)
+                        zdxt  = zdit(ji,jj,jk) * ze1ur
+                        ze3wr = 1._wp / e3w(ji+ip,jj,jk+kp,Kmm)
+                        zdzt  = zdkt3d(ji+ip,jj,kp) * ze3wr
+                        zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp)
+                        zslope_iso  = triadi(ji+ip,jj,jk,1-ip,kp)
+                        !
+                        zbu = 0.25_wp * e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm)
+                        ! ln_botmix_triad is .F. mask zah for bottom half cells
+                        zah = pahu(ji,jj,jk) * umask(ji,jj,jk+kp)         ! pahu(ji+ip,jj,jk)   ===>>  ????
+                        zah_slp  = zah * zslope_iso
+                        IF( ln_ldfeiv )   zaei_slp = aeiu(ji,jj,jk) * zslope_skew        ! aeit(ji+ip,jj,jk)*zslope_skew
+                        zftu(ji   ,jj,jk   ) = zftu(ji   ,jj,jk   ) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur
+                        ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - (zah_slp + zaei_slp) * zdxt * zbu * ze3wr
+                     END_2D
                   END DO
                END DO
@@ -339,32 +306,28 @@
                DO jp = 0, 1
                   DO kp = 0, 1
-                     DO jj = 1, jpjm1
-                        DO ji = 1, fs_jpim1
-                           ze2vr = r1_e2v(ji,jj)
-                           zdyt  = zdjt(ji,jj,jk) * ze2vr
-                           ze3wr = 1._wp / e3w_n(ji,jj+jp,jk+kp)
-                           zdzt  = zdkt3d(ji,jj+jp,kp) * ze3wr
-                           zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp)
-                           zslope_iso  = triadj(ji,jj+jp,jk,1-jp,kp)
-                           zbv = 0.25_wp * e1e2v(ji,jj) * e3v_n(ji,jj,jk)
-                           ! ln_botmix_triad is .F. mask zah for bottom half cells
-                           zah = pahv(ji,jj,jk) * vmask(ji,jj,jk+kp)         ! pahv(ji,jj+jp,jk)  ????
-                           zah_slp = zah * zslope_iso
-                           IF( ln_ldfeiv )   zaei_slp = aeiv(ji,jj,jk) * zslope_skew        ! aeit(ji,jj+jp,jk)*zslope_skew
-                           zftv(ji,jj,jk) = zftv(ji,jj,jk) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr
-                           ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - (zah_slp + zaei_slp) * zdyt * zbv * ze3wr
-                        END DO
-                     END DO
+                     DO_2D_10_10
+                        ze2vr = r1_e2v(ji,jj)
+                        zdyt  = zdjt(ji,jj,jk) * ze2vr
+                        ze3wr = 1._wp / e3w(ji,jj+jp,jk+kp,Kmm)
+                        zdzt  = zdkt3d(ji,jj+jp,kp) * ze3wr
+                        zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp)
+                        zslope_iso  = triadj(ji,jj+jp,jk,1-jp,kp)
+                        zbv = 0.25_wp * e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm)
+                        ! ln_botmix_triad is .F. mask zah for bottom half cells
+                        zah = pahv(ji,jj,jk) * vmask(ji,jj,jk+kp)         ! pahv(ji,jj+jp,jk)  ????
+                        zah_slp = zah * zslope_iso
+                        IF( ln_ldfeiv )   zaei_slp = aeiv(ji,jj,jk) * zslope_skew        ! aeit(ji,jj+jp,jk)*zslope_skew
+                        zftv(ji,jj,jk) = zftv(ji,jj,jk) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr
+                        ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - (zah_slp + zaei_slp) * zdyt * zbv * ze3wr
+                     END_2D
                   END DO
                END DO
             ENDIF
             !                             !==  horizontal divergence and add to the general trend  ==!
-            DO jj = 2 , jpjm1
-               DO ji = fs_2, fs_jpim1  ! vector opt.
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  zftu(ji-1,jj,jk) - zftu(ji,jj,jk)       &
-                     &                                           + zftv(ji,jj-1,jk) - zftv(ji,jj,jk)   )   &
-                     &                                        / (  e1e2t(ji,jj) * e3t_n(ji,jj,jk)  )
-               END DO
-            END DO
+            DO_2D_00_00
+               pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + zsign * (  zftu(ji-1,jj,jk) - zftu(ji,jj,jk)       &
+                  &                                           + zftv(ji,jj-1,jk) - zftv(ji,jj,jk)   )   &
+                  &                                        / (  e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm)  )
+            END_2D
             !
          END DO
@@ -372,45 +335,29 @@
          !                                !==  add the vertical 33 flux  ==!
          IF( ln_traldf_lap ) THEN               ! laplacian case: eddy coef = ah_wslp2 - akz
-            DO jk = 2, jpkm1       
-               DO jj = 1, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w_n(ji,jj,jk) * tmask(ji,jj,jk)   &
-                        &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )             &
-                        &                            * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) )
-                  END DO
-               END DO
-            END DO
+            DO_3D_10_00( 2, jpkm1 )
+               ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk)   &
+                  &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )             &
+                  &                            * (  pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) )
+            END_3D
          ELSE                                   ! bilaplacian 
             SELECT CASE( kpass )
             CASE(  1  )                            ! 1st pass : eddy coef = ah_wslp2
-               DO jk = 2, jpkm1 
-                  DO jj = 1, jpjm1
-                     DO ji = fs_2, fs_jpim1
-                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w_n(ji,jj,jk) * tmask(ji,jj,jk)             &
-                           &                            * ah_wslp2(ji,jj,jk) * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) )
-                     END DO
-                  END DO
-               END DO 
-            CASE(  2  )                            ! 2nd pass : eddy flux = ah_wslp2 and akz applied on ptb  and ptbb gradients, resp.
-               DO jk = 2, jpkm1 
-                  DO jj = 1, jpjm1
-                     DO ji = fs_2, fs_jpim1
-                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w_n(ji,jj,jk) * tmask(ji,jj,jk)                      &
-                           &                            * (  ah_wslp2(ji,jj,jk) * ( ptb (ji,jj,jk-1,jn) - ptb (ji,jj,jk,jn) )   &
-                           &                               + akz     (ji,jj,jk) * ( ptbb(ji,jj,jk-1,jn) - ptbb(ji,jj,jk,jn) )   )
-                     END DO
-                  END DO
-               END DO
+               DO_3D_10_00( 2, jpkm1 )
+                  ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk)             &
+                     &                            * ah_wslp2(ji,jj,jk) * ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) )
+               END_3D
+            CASE(  2  )                            ! 2nd pass : eddy flux = ah_wslp2 and akz applied on pt  and pt2 gradients, resp.
+               DO_3D_10_00( 2, jpkm1 )
+                  ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk)                      &
+                     &                            * (  ah_wslp2(ji,jj,jk) * ( pt (ji,jj,jk-1,jn) - pt (ji,jj,jk,jn) )   &
+                     &                               + akz     (ji,jj,jk) * ( pt2(ji,jj,jk-1,jn) - pt2(ji,jj,jk,jn) )   )
+               END_3D
             END SELECT 
          ENDIF
          !
-         DO jk = 1, jpkm1                 !==  Divergence of vertical fluxes added to pta  ==!
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1  ! vector opt.
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk)  )   &
-                     &                                        / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) )
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + zsign * (  ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk)  )   &
+               &                                              / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) )
+         END_3D
          !
          IF( ( kpass == 1 .AND. ln_traldf_lap ) .OR.  &     !==  first pass only (  laplacian)  ==!
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/tramle.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/tramle.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/tramle.F90	(revision 12928)
@@ -45,5 +45,5 @@
 
    REAL(wp) ::   r5_21 = 5.e0 / 21.e0   ! factor used in mle streamfunction computation
-   REAL(wp) ::   rb_c                   ! ML buoyancy criteria = g rho_c /rau0 where rho_c is defined in zdfmld
+   REAL(wp) ::   rb_c                   ! ML buoyancy criteria = g rho_c /rho0 where rho_c is defined in zdfmld
    REAL(wp) ::   rc_f                   ! MLE coefficient (= rn_ce / (5 km * fo) ) in nn_mle=1 case
 
@@ -52,5 +52,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -60,42 +60,43 @@
 CONTAINS
 
-  SUBROUTINE tra_mle_trp( kt, kit000, pu, pv, pw, cdtype )
-    !!----------------------------------------------------------------------
-    !!                  ***  ROUTINE tra_mle_trp  ***
-    !!
-    !! ** Purpose :   Add to the transport the Mixed Layer Eddy induced transport
-    !!
-    !! ** Method  :   The 3 components of the Mixed Layer Eddy (MLE) induced
-    !!              transport are computed as follows :
-    !!                zu_mle = dk[ zpsi_uw ]
-    !!                zv_mle = dk[ zpsi_vw ]
-    !!                zw_mle = - di[ zpsi_uw ] - dj[ zpsi_vw ]
-    !!                where zpsi is the MLE streamfunction at uw and vw points (see the doc)
-    !!              and added to the input velocity :
-    !!                p.n = p.n + z._mle
-    !!
-    !! ** Action  : - (pun,pvn,pwn) increased by the mle transport
-    !!                CAUTION, the transport is not updated at the last line/raw
-    !!                         this may be a problem for some advection schemes
-    !!
-    !! References: Fox-Kemper et al., JPO, 38, 1145-1165, 2008
-    !!             Fox-Kemper and Ferrari, JPO, 38, 1166-1179, 2008
-    !!----------------------------------------------------------------------
-    INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index
-    INTEGER                         , INTENT(in   ) ::   kit000     ! first time step index
-    CHARACTER(len=3)                , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
-    REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu         ! in : 3 ocean transport components
-    REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pv         ! out: same 3  transport components
-    REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pw         !   increased by the MLE induced transport
-    !
-    INTEGER  ::   ji, jj, jk          ! dummy loop indices
-    INTEGER  ::   ii, ij, ik, ikmax   ! local integers
-    REAL(wp) ::   zcuw, zmuw, zc      ! local scalar
-    REAL(wp) ::   zcvw, zmvw          !   -      -
-    INTEGER , DIMENSION(jpi,jpj)     :: inml_mle
-    REAL(wp), DIMENSION(jpi,jpj)     :: zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH
-    REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpsi_uw, zpsi_vw
-    !!----------------------------------------------------------------------
-    !
+   SUBROUTINE tra_mle_trp( kt, kit000, pu, pv, pw, cdtype, Kmm )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_mle_trp  ***
+      !!
+      !! ** Purpose :   Add to the transport the Mixed Layer Eddy induced transport
+      !!
+      !! ** Method  :   The 3 components of the Mixed Layer Eddy (MLE) induced
+      !!              transport are computed as follows :
+      !!                zu_mle = dk[ zpsi_uw ]
+      !!                zv_mle = dk[ zpsi_vw ]
+      !!                zw_mle = - di[ zpsi_uw ] - dj[ zpsi_vw ]
+      !!                where zpsi is the MLE streamfunction at uw and vw points (see the doc)
+      !!              and added to the input velocity :
+      !!                p.n = p.n + z._mle
+      !!
+      !! ** Action  : - (pu,pv,pw) increased by the mle transport
+      !!                CAUTION, the transport is not updated at the last line/raw
+      !!                         this may be a problem for some advection schemes
+      !!
+      !! References: Fox-Kemper et al., JPO, 38, 1145-1165, 2008
+      !!             Fox-Kemper and Ferrari, JPO, 38, 1166-1179, 2008
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   kit000     ! first time step index
+      INTEGER                         , INTENT(in   ) ::   Kmm        ! ocean time level index
+      CHARACTER(len=3)                , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu         ! in : 3 ocean transport components
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pv         ! out: same 3  transport components
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pw         !   increased by the MLE induced transport
+      !
+      INTEGER  ::   ji, jj, jk          ! dummy loop indices
+      INTEGER  ::   ii, ij, ik, ikmax   ! local integers
+      REAL(wp) ::   zcuw, zmuw, zc      ! local scalar
+      REAL(wp) ::   zcvw, zmvw          !   -      -
+      INTEGER , DIMENSION(jpi,jpj)     :: inml_mle
+      REAL(wp), DIMENSION(jpi,jpj)     :: zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpsi_uw, zpsi_vw
+      !!----------------------------------------------------------------------
+      !
     !
     IF(ln_osm_mle.and.ln_zdfosm) THEN
@@ -105,192 +106,152 @@
        SELECT CASE( nn_mld_uv )                         ! MLD at u- & v-pts
        CASE ( 0 )                                               != min of the 2 neighbour MLDs
-          DO jj = 1, jpjm1
-             DO ji = 1, fs_jpim1   ! vector opt.
-                zhu(ji,jj) = MIN( hmle(ji+1,jj), hmle(ji,jj) )
-                zhv(ji,jj) = MIN( hmle(ji,jj+1), hmle(ji,jj) )
-             END DO
-          END DO
+          DO_2D_10_10
+             zhu(ji,jj) = MIN( hmle(ji+1,jj), hmle(ji,jj) )
+             zhv(ji,jj) = MIN( hmle(ji,jj+1), hmle(ji,jj) )
+          END_2D
        CASE ( 1 )                                               != average of the 2 neighbour MLDs
-          DO jj = 1, jpjm1
-             DO ji = 1, fs_jpim1   ! vector opt.
-                zhu(ji,jj) = MAX( hmle(ji+1,jj), hmle(ji,jj) )
-                zhv(ji,jj) = MAX( hmle(ji,jj+1), hmle(ji,jj) )
-             END DO
-          END DO
+          DO_2D_10_10
+             zhu(ji,jj) = MAX( hmle(ji+1,jj), hmle(ji,jj) )
+             zhv(ji,jj) = MAX( hmle(ji,jj+1), hmle(ji,jj) )
+          END_2D
        CASE ( 2 )                                               != max of the 2 neighbour MLDs
-          DO jj = 1, jpjm1
-             DO ji = 1, fs_jpim1   ! vector opt.
-                zhu(ji,jj) = MAX( hmle(ji+1,jj), hmle(ji,jj) )
-                zhv(ji,jj) = MAX( hmle(ji,jj+1), hmle(ji,jj) )
-             END DO
-          END DO
+          DO_2D_10_10
+             zhu(ji,jj) = MAX( hmle(ji+1,jj), hmle(ji,jj) )
+             zhv(ji,jj) = MAX( hmle(ji,jj+1), hmle(ji,jj) )
+          END_2D
        END SELECT
        IF( nn_mle == 0 ) THEN           ! Fox-Kemper et al. 2010 formulation
-          DO jj = 1, jpjm1
-             DO ji = 1, fs_jpim1   ! vector opt.
-                zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj)  * e2u(ji,jj)                                            &
-                     &           * dbdx_mle(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) )   &
-                     &           / (  MAX( rn_lf * rfu(ji,jj) , SQRT( rb_c * zhu(ji,jj) ) )   )
-                !
-                zpsim_v(ji,jj) = rn_ce * zhv(ji,jj) * zhv(ji,jj)  * e1v(ji,jj)                                            &
-                     &           * dbdy_mle(ji,jj)  * MIN( 111.e3_wp , e2v(ji,jj) )   &
-                     &           / (  MAX( rn_lf * rfv(ji,jj) , SQRT( rb_c * zhv(ji,jj) ) )   )
-             END DO
-          END DO
+          DO_2D_10_10
+             zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj)  * e2u(ji,jj)                                            &
+                  &           * dbdx_mle(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) )   &
+                  &           / (  MAX( rn_lf * rfu(ji,jj) , SQRT( rb_c * zhu(ji,jj) ) )   )
+             !
+             zpsim_v(ji,jj) = rn_ce * zhv(ji,jj) * zhv(ji,jj)  * e1v(ji,jj)                                            &
+                  &           * dbdy_mle(ji,jj)  * MIN( 111.e3_wp , e2v(ji,jj) )   &
+                  &           / (  MAX( rn_lf * rfv(ji,jj) , SQRT( rb_c * zhv(ji,jj) ) )   )
+          END_2D
           !
        ELSEIF( nn_mle == 1 ) THEN       ! New formulation (Lf = 5km fo/ff with fo=Coriolis parameter at latitude rn_lat)
-          DO jj = 1, jpjm1
-             DO ji = 1, fs_jpim1   ! vector opt.
-                zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2u(ji,jj)               &
-                     &                  * dbdx_mle(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) )
-                !
-                zpsim_v(ji,jj) = rc_f *   zhv(ji,jj)   * zhv(ji,jj)   * e1v(ji,jj)               &
-                     &                  * dbdy_mle(ji,jj) * MIN( 111.e3_wp , e2v(ji,jj) )
-             END DO
-          END DO
+          DO_2D_10_10
+             zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2u(ji,jj)               &
+                  &                  * dbdx_mle(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) )
+             !
+             zpsim_v(ji,jj) = rc_f *   zhv(ji,jj)   * zhv(ji,jj)   * e1v(ji,jj)               &
+                  &                  * dbdy_mle(ji,jj) * MIN( 111.e3_wp , e2v(ji,jj) )
+          END_2D
        ENDIF
-
     ELSE !do not use osn_mle
-       !                                      !==  MLD used for MLE  ==!
-       !                                                ! compute from the 10m density to deal with the diurnal cycle
-       inml_mle(:,:) = mbkt(:,:) + 1                    ! init. to number of ocean w-level (T-level + 1)
-       IF ( nla10 > 0 ) THEN                            ! avoid case where first level is thicker than 10m
-          DO jk = jpkm1, nlb10, -1                      ! from the bottom to nlb10 (10m)
-             DO jj = 1, jpj
-                DO ji = 1, jpi                          ! index of the w-level at the ML based
-                   IF( rhop(ji,jj,jk) > rhop(ji,jj,nla10) + rn_rho_c_mle )   inml_mle(ji,jj) = jk      ! Mixed layer
-                END DO
-             END DO
-          END DO
-       ENDIF
-       ikmax = MIN( MAXVAL( inml_mle(:,:) ), jpkm1 )                  ! max level of the computation
-
-       !
-       !
-       zmld(:,:) = 0._wp                      !==   Horizontal shape of the MLE  ==!
-       zbm (:,:) = 0._wp
-       zn2 (:,:) = 0._wp
-       DO jk = 1, ikmax                                 ! MLD and mean buoyancy and N2 over the mixed layer
-          DO jj = 1, jpj
-             DO ji = 1, jpi
-                zc = e3t_n(ji,jj,jk) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1  )  )    ! zc being 0 outside the ML t-points
-                zmld(ji,jj) = zmld(ji,jj) + zc
-                zbm (ji,jj) = zbm (ji,jj) + zc * (rau0 - rhop(ji,jj,jk) ) * r1_rau0
-                zn2 (ji,jj) = zn2 (ji,jj) + zc * (rn2(ji,jj,jk)+rn2(ji,jj,jk+1))*0.5_wp
-             END DO
-          END DO
-       END DO
-
-       SELECT CASE( nn_mld_uv )                         ! MLD at u- & v-pts
-       CASE ( 0 )                                               != min of the 2 neighbour MLDs
-          DO jj = 1, jpjm1
-             DO ji = 1, fs_jpim1   ! vector opt.
-                zhu(ji,jj) = MIN( zmld(ji+1,jj), zmld(ji,jj) )
-                zhv(ji,jj) = MIN( zmld(ji,jj+1), zmld(ji,jj) )
-             END DO
-          END DO
-       CASE ( 1 )                                               != average of the 2 neighbour MLDs
-          DO jj = 1, jpjm1
-             DO ji = 1, fs_jpim1   ! vector opt.
-                zhu(ji,jj) = ( zmld(ji+1,jj) + zmld(ji,jj) ) * 0.5_wp
-                zhv(ji,jj) = ( zmld(ji,jj+1) + zmld(ji,jj) ) * 0.5_wp
-             END DO
-          END DO
-       CASE ( 2 )                                               != max of the 2 neighbour MLDs
-          DO jj = 1, jpjm1
-             DO ji = 1, fs_jpim1   ! vector opt.
-                zhu(ji,jj) = MAX( zmld(ji+1,jj), zmld(ji,jj) )
-                zhv(ji,jj) = MAX( zmld(ji,jj+1), zmld(ji,jj) )
-             END DO
-          END DO
-       END SELECT
-       !                                                ! convert density into buoyancy
-       zbm(:,:) = + grav * zbm(:,:) / MAX( e3t_n(:,:,1), zmld(:,:) )
-       !
-       !
-       !                                      !==  Magnitude of the MLE stream function  ==!
-       !
-       !                 di[bm]  Ds
-       ! Psi = Ce  H^2 ---------------- e2u  mu(z)   where fu Lf = MAX( fu*rn_fl , (Db H)^1/2 )
-       !                  e1u   Lf fu                      and the e2u for the "transport"
-       !                                                      (not *e3u as divided by e3u at the end)
-       !
-       IF( nn_mle == 0 ) THEN           ! Fox-Kemper et al. 2010 formulation
-          DO jj = 1, jpjm1
-             DO ji = 1, fs_jpim1   ! vector opt.
-                zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj)  * e2_e1u(ji,jj)                                            &
-                     &           * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) )   &
-                     &           / (  MAX( rn_lf * rfu(ji,jj) , SQRT( rb_c * zhu(ji,jj) ) )   )
-                !
-                zpsim_v(ji,jj) = rn_ce * zhv(ji,jj) * zhv(ji,jj)  * e1_e2v(ji,jj)                                            &
-                     &           * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp , e2v(ji,jj) )   &
-                     &           / (  MAX( rn_lf * rfv(ji,jj) , SQRT( rb_c * zhv(ji,jj) ) )   )
-             END DO
-          END DO
-          !
-       ELSEIF( nn_mle == 1 ) THEN       ! New formulation (Lf = 5km fo/ff with fo=Coriolis parameter at latitude rn_lat)
-          DO jj = 1, jpjm1
-             DO ji = 1, fs_jpim1   ! vector opt.
-                zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2_e1u(ji,jj)               &
-                     &                  * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) )
-                !
-                zpsim_v(ji,jj) = rc_f *   zhv(ji,jj)   * zhv(ji,jj)   * e1_e2v(ji,jj)               &
-                     &                  * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp , e2v(ji,jj) )
-             END DO
-          END DO
-       ENDIF
-       !
-       IF( nn_conv == 1 ) THEN              ! No MLE in case of convection
-          DO jj = 1, jpjm1
-             DO ji = 1, fs_jpim1   ! vector opt.
-                IF( MIN( zn2(ji,jj) , zn2(ji+1,jj) ) < 0._wp )   zpsim_u(ji,jj) = 0._wp
-                IF( MIN( zn2(ji,jj) , zn2(ji,jj+1) ) < 0._wp )   zpsim_v(ji,jj) = 0._wp
-             END DO
-          END DO
-       ENDIF
+      !                                      !==  MLD used for MLE  ==!
+      !                                                ! compute from the 10m density to deal with the diurnal cycle
+      inml_mle(:,:) = mbkt(:,:) + 1                    ! init. to number of ocean w-level (T-level + 1)
+      IF ( nla10 > 0 ) THEN                            ! avoid case where first level is thicker than 10m
+         DO_3DS_11_11( jpkm1, nlb10, -1 )
+            IF( rhop(ji,jj,jk) > rhop(ji,jj,nla10) + rn_rho_c_mle )   inml_mle(ji,jj) = jk      ! Mixed layer
+         END_3D
+      ENDIF
+      ikmax = MIN( MAXVAL( inml_mle(:,:) ), jpkm1 )                  ! max level of the computation
+
+      !
+      !
+      zmld(:,:) = 0._wp                      !==   Horizontal shape of the MLE  ==!
+      zbm (:,:) = 0._wp
+      zn2 (:,:) = 0._wp
+      DO_3D_11_11( 1, ikmax )
+         zc = e3t(ji,jj,jk,Kmm) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1  )  )    ! zc being 0 outside the ML t-points
+         zmld(ji,jj) = zmld(ji,jj) + zc
+         zbm (ji,jj) = zbm (ji,jj) + zc * (rho0 - rhop(ji,jj,jk) ) * r1_rho0
+         zn2 (ji,jj) = zn2 (ji,jj) + zc * (rn2(ji,jj,jk)+rn2(ji,jj,jk+1))*0.5_wp
+      END_3D
+
+      SELECT CASE( nn_mld_uv )                         ! MLD at u- & v-pts
+      CASE ( 0 )                                               != min of the 2 neighbour MLDs
+         DO_2D_10_10
+            zhu(ji,jj) = MIN( zmld(ji+1,jj), zmld(ji,jj) )
+            zhv(ji,jj) = MIN( zmld(ji,jj+1), zmld(ji,jj) )
+         END_2D
+      CASE ( 1 )                                               != average of the 2 neighbour MLDs
+         DO_2D_10_10
+            zhu(ji,jj) = ( zmld(ji+1,jj) + zmld(ji,jj) ) * 0.5_wp
+            zhv(ji,jj) = ( zmld(ji,jj+1) + zmld(ji,jj) ) * 0.5_wp
+         END_2D
+      CASE ( 2 )                                               != max of the 2 neighbour MLDs
+         DO_2D_10_10
+            zhu(ji,jj) = MAX( zmld(ji+1,jj), zmld(ji,jj) )
+            zhv(ji,jj) = MAX( zmld(ji,jj+1), zmld(ji,jj) )
+         END_2D
+      END SELECT
+      !                                                ! convert density into buoyancy
+      zbm(:,:) = + grav * zbm(:,:) / MAX( e3t(:,:,1,Kmm), zmld(:,:) )
+      !
+      !
+      !                                      !==  Magnitude of the MLE stream function  ==!
+      !
+      !                 di[bm]  Ds
+      ! Psi = Ce  H^2 ---------------- e2u  mu(z)   where fu Lf = MAX( fu*rn_fl , (Db H)^1/2 )
+      !                  e1u   Lf fu                      and the e2u for the "transport"
+      !                                                      (not *e3u as divided by e3u at the end)
+      !
+      IF( nn_mle == 0 ) THEN           ! Fox-Kemper et al. 2010 formulation
+         DO_2D_10_10
+            zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj)  * e2_e1u(ji,jj)                                            &
+               &           * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) )   &
+               &           / (  MAX( rn_lf * rfu(ji,jj) , SQRT( rb_c * zhu(ji,jj) ) )   )
+               !
+            zpsim_v(ji,jj) = rn_ce * zhv(ji,jj) * zhv(ji,jj)  * e1_e2v(ji,jj)                                            &
+               &           * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp , e2v(ji,jj) )   &
+               &           / (  MAX( rn_lf * rfv(ji,jj) , SQRT( rb_c * zhv(ji,jj) ) )   )
+         END_2D
+         !
+      ELSEIF( nn_mle == 1 ) THEN       ! New formulation (Lf = 5km fo/ff with fo=Coriolis parameter at latitude rn_lat)
+         DO_2D_10_10
+            zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2_e1u(ji,jj)               &
+               &                  * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) )
+               !
+            zpsim_v(ji,jj) = rc_f *   zhv(ji,jj)   * zhv(ji,jj)   * e1_e2v(ji,jj)               &
+               &                  * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp , e2v(ji,jj) )
+         END_2D
+      ENDIF
+      !
+      IF( nn_conv == 1 ) THEN              ! No MLE in case of convection
+         DO_2D_10_10
+            IF( MIN( zn2(ji,jj) , zn2(ji+1,jj) ) < 0._wp )   zpsim_u(ji,jj) = 0._wp
+            IF( MIN( zn2(ji,jj) , zn2(ji,jj+1) ) < 0._wp )   zpsim_v(ji,jj) = 0._wp
+         END_2D
+      ENDIF
        !
     ENDIF  ! end of lm_osm_mle loop
-    !                                      !==  structure function value at uw- and vw-points  ==!
-    DO jj = 1, jpjm1
-       DO ji = 1, fs_jpim1   ! vector opt.
-          zhu(ji,jj) = 1._wp / MAX(zhu(ji,jj), rsmall)                   ! hu --> 1/hu
-          zhv(ji,jj) = 1._wp / MAX(zhv(ji,jj), rsmall) 
-       END DO
-    END DO
-    !
-    zpsi_uw(:,:,:) = 0._wp
-    zpsi_vw(:,:,:) = 0._wp
-    !
-    DO jk = 2, ikmax                                ! start from 2 : surface value = 0
-       DO jj = 1, jpjm1
-          DO ji = 1, fs_jpim1   ! vector opt.
-             zcuw = 1._wp - ( gdepw_n(ji+1,jj,jk) + gdepw_n(ji,jj,jk) ) * zhu(ji,jj)
-             zcvw = 1._wp - ( gdepw_n(ji,jj+1,jk) + gdepw_n(ji,jj,jk) ) * zhv(ji,jj)
-             zcuw = zcuw * zcuw
-             zcvw = zcvw * zcvw
-             zmuw = MAX(  0._wp , ( 1._wp - zcuw ) * ( 1._wp + r5_21 * zcuw )  )
-             zmvw = MAX(  0._wp , ( 1._wp - zcvw ) * ( 1._wp + r5_21 * zcvw )  )
-             !
-             zpsi_uw(ji,jj,jk) = zpsim_u(ji,jj) * zmuw * umask(ji,jj,jk)
-             zpsi_vw(ji,jj,jk) = zpsim_v(ji,jj) * zmvw * vmask(ji,jj,jk)
-          END DO
-       END DO
-    END DO
-    !
-    !                                      !==  transport increased by the MLE induced transport ==!
-    DO jk = 1, ikmax
-       DO jj = 1, jpjm1                          ! CAUTION pu,pv must be defined at row/column i=1 / j=1
-          DO ji = 1, fs_jpim1   ! vector opt.
-             pu(ji,jj,jk) = pu(ji,jj,jk) + ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) )
-             pv(ji,jj,jk) = pv(ji,jj,jk) + ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) )
-          END DO
-       END DO
-       DO jj = 2, jpjm1
-          DO ji = fs_2, fs_jpim1   ! vector opt.
-             pw(ji,jj,jk) = pw(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj,jk)   &
-                  &                          + zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj-1,jk) )
-          END DO
-       END DO
-    END DO
+      !
+      !                                      !==  structure function value at uw- and vw-points  ==!
+      DO_2D_10_10
+         zhu(ji,jj) = 1._wp / MAX(zhu(ji,jj), rsmall)                   ! hu --> 1/hu
+         zhv(ji,jj) = 1._wp / MAX(zhv(ji,jj), rsmall)
+      END_2D
+      !
+      zpsi_uw(:,:,:) = 0._wp
+      zpsi_vw(:,:,:) = 0._wp
+      !
+      DO_3D_10_10( 2, ikmax )
+         zcuw = 1._wp - ( gdepw(ji+1,jj,jk,Kmm) + gdepw(ji,jj,jk,Kmm) ) * zhu(ji,jj)
+         zcvw = 1._wp - ( gdepw(ji,jj+1,jk,Kmm) + gdepw(ji,jj,jk,Kmm) ) * zhv(ji,jj)
+         zcuw = zcuw * zcuw
+         zcvw = zcvw * zcvw
+         zmuw = MAX(  0._wp , ( 1._wp - zcuw ) * ( 1._wp + r5_21 * zcuw )  )
+         zmvw = MAX(  0._wp , ( 1._wp - zcvw ) * ( 1._wp + r5_21 * zcvw )  )
+         !
+         zpsi_uw(ji,jj,jk) = zpsim_u(ji,jj) * zmuw * umask(ji,jj,jk)
+         zpsi_vw(ji,jj,jk) = zpsim_v(ji,jj) * zmvw * vmask(ji,jj,jk)
+      END_3D
+      !
+      !                                      !==  transport increased by the MLE induced transport ==!
+      DO jk = 1, ikmax
+         DO_2D_10_10
+            pu(ji,jj,jk) = pu(ji,jj,jk) + ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) )
+            pv(ji,jj,jk) = pv(ji,jj,jk) + ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) )
+         END_2D
+         DO_2D_00_00
+            pw(ji,jj,jk) = pw(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj,jk)   &
+               &                          + zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj-1,jk) )
+         END_2D
+      END DO
 
     IF( cdtype == 'TRA') THEN              !==  outputs  ==!
@@ -330,9 +291,7 @@
       !!----------------------------------------------------------------------
 
-      REWIND( numnam_ref )              ! Namelist namtra_mle in reference namelist : Tracer advection scheme
       READ  ( numnam_ref, namtra_mle, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_mle in reference namelist' )
 
-      REWIND( numnam_cfg )              ! Namelist namtra_mle in configuration namelist : Tracer advection scheme
       READ  ( numnam_cfg, namtra_mle, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_mle in configuration namelist' )
@@ -368,5 +327,5 @@
       IF( ln_mle ) THEN                ! MLE initialisation
          !
-         rb_c = grav * rn_rho_c_mle /rau0        ! Mixed Layer buoyancy criteria
+         rb_c = grav * rn_rho_c_mle /rho0        ! Mixed Layer buoyancy criteria
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) '      ML buoyancy criteria = ', rb_c, ' m/s2 '
@@ -377,12 +336,10 @@
             IF( ierr /= 0 )   CALL ctl_stop( 'tra_adv_mle_init: failed to allocate arrays' )
             z1_t2 = 1._wp / ( rn_time * rn_time )
-            DO jj = 2, jpj                           ! "coriolis+ time^-1" at u- & v-points
-               DO ji = fs_2, jpi   ! vector opt.
-                  zfu = ( ff_f(ji,jj) + ff_f(ji,jj-1) ) * 0.5_wp
-                  zfv = ( ff_f(ji,jj) + ff_f(ji-1,jj) ) * 0.5_wp
-                  rfu(ji,jj) = SQRT(  zfu * zfu + z1_t2 )
-                  rfv(ji,jj) = SQRT(  zfv * zfv + z1_t2 )
-               END DO
-            END DO
+            DO_2D_01_01
+               zfu = ( ff_f(ji,jj) + ff_f(ji,jj-1) ) * 0.5_wp
+               zfv = ( ff_f(ji,jj) + ff_f(ji-1,jj) ) * 0.5_wp
+               rfu(ji,jj) = SQRT(  zfu * zfu + z1_t2 )
+               rfv(ji,jj) = SQRT(  zfv * zfv + z1_t2 )
+            END_2D
             CALL lbc_lnk_multi( 'tramle', rfu, 'U', 1. , rfv, 'V', 1. )
             !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/tranpc.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/tranpc.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/tranpc.F90	(revision 12928)
@@ -34,5 +34,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -42,5 +42,5 @@
 CONTAINS
 
-   SUBROUTINE tra_npc( kt )
+   SUBROUTINE tra_npc( kt, Kmm, Krhs, pts, Kaa )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tranpc  ***
@@ -58,5 +58,7 @@
       !! References :     Madec, et al., 1991, JPO, 21, 9, 1349-1371.
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER,                                   INTENT(in   ) :: kt              ! ocean time-step index
+      INTEGER,                                   INTENT(in   ) :: Kmm, Krhs, Kaa  ! time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts             ! active tracers and RHS of tracer equation
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -65,11 +67,11 @@
       LOGICAL  ::   l_bottom_reached, l_column_treated
       REAL(wp) ::   zta, zalfa, zsum_temp, zsum_alfa, zaw, zdz, zsum_z
-      REAL(wp) ::   zsa, zbeta, zsum_sali, zsum_beta, zbw, zrw, z1_r2dt
-      REAL(wp), PARAMETER ::   zn2_zero = 1.e-14_wp      ! acceptance criteria for neutrality (N2==0)
-      REAL(wp), DIMENSION(        jpk     ) ::   zvn2         ! vertical profile of N2 at 1 given point...
-      REAL(wp), DIMENSION(        jpk,jpts) ::   zvts, zvab   ! vertical profile of T & S , and  alpha & betaat 1 given point
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ) ::   zn2          ! N^2 
-      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) ::   zab          ! alpha and beta
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds   ! 3D workspace
+      REAL(wp) ::   zsa, zbeta, zsum_sali, zsum_beta, zbw, zrw, z1_rDt
+      REAL(wp), PARAMETER ::   zn2_zero = 1.e-14_wp             ! acceptance criteria for neutrality (N2==0)
+      REAL(wp), DIMENSION(        jpk     )   ::   zvn2         ! vertical profile of N2 at 1 given point...
+      REAL(wp), DIMENSION(        jpk,jpts)   ::   zvts, zvab   ! vertical profile of T & S , and  alpha & betaat 1 given point
+      REAL(wp), DIMENSION(jpi,jpj,jpk     )   ::   zn2          ! N^2 
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts)   ::   zab          ! alpha and beta
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds ! 3D workspace
       !
       LOGICAL, PARAMETER :: l_LB_debug = .FALSE. ! set to true if you want to follow what is
@@ -84,6 +86,6 @@
          IF( l_trdtra )   THEN                    !* Save initial after fields
             ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )
-            ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
-            ztrds(:,:,:) = tsa(:,:,:,jp_sal)
+            ztrdt(:,:,:) = pts(:,:,:,jp_tem,Kaa) 
+            ztrds(:,:,:) = pts(:,:,:,jp_sal,Kaa)
          ENDIF
          !
@@ -95,181 +97,60 @@
          ENDIF
          !
-         CALL eos_rab( tsa, zab )         ! after alpha and beta (given on T-points)
-         CALL bn2    ( tsa, zab, zn2 )    ! after Brunt-Vaisala  (given on W-points)
+         CALL eos_rab( pts(:,:,:,:,Kaa), zab, Kmm )         ! after alpha and beta (given on T-points)
+         CALL bn2    ( pts(:,:,:,:,Kaa), zab, zn2, Kmm )    ! after Brunt-Vaisala  (given on W-points)
          !
          inpcc = 0
          !
-         DO jj = 2, jpjm1                 ! interior column only
-            DO ji = fs_2, fs_jpim1
+         DO_2D_00_00
+            !
+            IF( tmask(ji,jj,2) == 1 ) THEN      ! At least 2 ocean points
+               !                                     ! consider one ocean column 
+               zvts(:,jp_tem) = pts(ji,jj,:,jp_tem,Kaa)      ! temperature
+               zvts(:,jp_sal) = pts(ji,jj,:,jp_sal,Kaa)      ! salinity
                !
-               IF( tmask(ji,jj,2) == 1 ) THEN      ! At least 2 ocean points
-                  !                                     ! consider one ocean column 
-                  zvts(:,jp_tem) = tsa(ji,jj,:,jp_tem)      ! temperature
-                  zvts(:,jp_sal) = tsa(ji,jj,:,jp_sal)      ! salinity
-                  !
-                  zvab(:,jp_tem)  = zab(ji,jj,:,jp_tem)     ! Alpha 
-                  zvab(:,jp_sal)  = zab(ji,jj,:,jp_sal)     ! Beta  
-                  zvn2(:)         = zn2(ji,jj,:)            ! N^2 
-                  !
-                  IF( l_LB_debug ) THEN                  !LB debug:
-                     lp_monitor_point = .FALSE.
-                     IF( ( ji == ilc1 ).AND.( jj == jlc1 ) ) lp_monitor_point = .TRUE.
-                     ! writing only if on CPU domain where conv region is:
-                     lp_monitor_point = (narea == nncpu).AND.lp_monitor_point                      
-                  ENDIF                                  !LB debug  end
-                  !
-                  ikbot = mbkt(ji,jj)   ! ikbot: ocean bottom T-level
-                  ikp = 1                  ! because N2 is irrelevant at the surface level (will start at ikp=2)
-                  ilayer = 0
-                  jiter  = 0
-                  l_column_treated = .FALSE.
-                  !
-                  DO WHILE ( .NOT. l_column_treated )
-                     !
-                     jiter = jiter + 1
-                     ! 
-                     IF( jiter >= 400 ) EXIT
-                     !
-                     l_bottom_reached = .FALSE.
-                     !
-                     DO WHILE ( .NOT. l_bottom_reached )
-                        !
-                        ikp = ikp + 1
-                        !
-                        !! Testing level ikp for instability
-                        !! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-                        IF( zvn2(ikp) <  -zn2_zero ) THEN ! Instability found!
-                           !
-                           ilayer = ilayer + 1    ! yet another instable portion of the water column found....
-                           !
-                           IF( lp_monitor_point ) THEN 
+               zvab(:,jp_tem)  = zab(ji,jj,:,jp_tem)     ! Alpha 
+               zvab(:,jp_sal)  = zab(ji,jj,:,jp_sal)     ! Beta  
+               zvn2(:)         = zn2(ji,jj,:)            ! N^2 
+               !
+               IF( l_LB_debug ) THEN                  !LB debug:
+                  lp_monitor_point = .FALSE.
+                  IF( ( ji == ilc1 ).AND.( jj == jlc1 ) ) lp_monitor_point = .TRUE.
+                  ! writing only if on CPU domain where conv region is:
+                  lp_monitor_point = (narea == nncpu).AND.lp_monitor_point                      
+               ENDIF                                  !LB debug  end
+               !
+               ikbot = mbkt(ji,jj)   ! ikbot: ocean bottom T-level
+               ikp = 1                  ! because N2 is irrelevant at the surface level (will start at ikp=2)
+               ilayer = 0
+               jiter  = 0
+               l_column_treated = .FALSE.
+               !
+               DO WHILE ( .NOT. l_column_treated )
+                  !
+                  jiter = jiter + 1
+                  ! 
+                  IF( jiter >= 400 ) EXIT
+                  !
+                  l_bottom_reached = .FALSE.
+                  !
+                  DO WHILE ( .NOT. l_bottom_reached )
+                     !
+                     ikp = ikp + 1
+                     !
+                     !! Testing level ikp for instability
+                     !! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+                     IF( zvn2(ikp) <  -zn2_zero ) THEN ! Instability found!
+                        !
+                        ilayer = ilayer + 1    ! yet another instable portion of the water column found....
+                        !
+                        IF( lp_monitor_point ) THEN 
+                           WRITE(numout,*)
+                           IF( ilayer == 1 .AND. jiter == 1 ) THEN   ! first time a column is spoted with an instability
                               WRITE(numout,*)
-                              IF( ilayer == 1 .AND. jiter == 1 ) THEN   ! first time a column is spoted with an instability
-                                 WRITE(numout,*)
-                                 WRITE(numout,*) 'Time step = ',kt,' !!!'
-                              ENDIF
-                              WRITE(numout,*)  ' * Iteration #',jiter,': found instable portion #',ilayer,   &
-                                 &                                    ' in column! Starting at ikp =', ikp
-                              WRITE(numout,*)  ' *** N2 for point (i,j) = ',ji,' , ',jj
-                              DO jk = 1, klc1
-                                 WRITE(numout,*) jk, zvn2(jk)
-                              END DO
-                              WRITE(numout,*)
+                              WRITE(numout,*) 'Time step = ',kt,' !!!'
                            ENDIF
-                           !
-                           IF( jiter == 1 )   inpcc = inpcc + 1 
-                           !
-                           IF( lp_monitor_point )   WRITE(numout, *) 'Negative N2 at ikp =',ikp,' for layer #', ilayer
-                           !
-                           !! ikup is the uppermost point where mixing will start:
-                           ikup = ikp - 1 ! ikup is always "at most at ikp-1", less if neutral levels overlying
-                           !
-                           !! If the points above ikp-1 have N2 == 0 they must also be mixed:
-                           IF( ikp > 2 ) THEN
-                              DO jk = ikp-1, 2, -1
-                                 IF( ABS(zvn2(jk)) < zn2_zero ) THEN
-                                    ikup = ikup - 1  ! 1 more upper level has N2=0 and must be added for the mixing
-                                 ELSE
-                                    EXIT
-                                 ENDIF
-                              END DO
-                           ENDIF
-                           !
-                           IF( ikup < 1 )   CALL ctl_stop( 'tra_npc :  PROBLEM #1')
-                           !
-                           zsum_temp = 0._wp
-                           zsum_sali = 0._wp
-                           zsum_alfa = 0._wp
-                           zsum_beta = 0._wp
-                           zsum_z    = 0._wp
-                                                    
-                           DO jk = ikup, ikbot      ! Inside the instable (and overlying neutral) portion of the column
-                              !
-                              zdz       = e3t_n(ji,jj,jk)
-                              zsum_temp = zsum_temp + zvts(jk,jp_tem)*zdz
-                              zsum_sali = zsum_sali + zvts(jk,jp_sal)*zdz
-                              zsum_alfa = zsum_alfa + zvab(jk,jp_tem)*zdz
-                              zsum_beta = zsum_beta + zvab(jk,jp_sal)*zdz
-                              zsum_z    = zsum_z    + zdz
-                              !                              
-                              IF( jk == ikbot ) EXIT ! avoid array-index overshoot in case ikbot = jpk, cause we're calling jk+1 next line
-                              !! EXIT when we have reached the last layer that is instable (N2<0) or neutral (N2=0):
-                              IF( zvn2(jk+1) > zn2_zero ) EXIT
-                           END DO
-                          
-                           ikdown = jk ! for the current unstable layer, ikdown is the deepest point with a negative or neutral N2
-                           IF( ikup == ikdown )   CALL ctl_stop( 'tra_npc :  PROBLEM #2')
-
-                           ! Mixing Temperature, salinity, alpha and beta from ikup to ikdown included:
-                           zta   = zsum_temp/zsum_z
-                           zsa   = zsum_sali/zsum_z
-                           zalfa = zsum_alfa/zsum_z
-                           zbeta = zsum_beta/zsum_z
-
-                           IF( lp_monitor_point ) THEN
-                              WRITE(numout,*) 'MIXED T, S, alfa and beta between ikup =',ikup,   &
-                                 &            ' and ikdown =',ikdown,', in layer #',ilayer
-                              WRITE(numout,*) '  => Mean temp. in that portion =', zta
-                              WRITE(numout,*) '  => Mean sali. in that portion =', zsa
-                              WRITE(numout,*) '  => Mean Alfa  in that portion =', zalfa
-                              WRITE(numout,*) '  => Mean Beta  in that portion =', zbeta
-                           ENDIF
-
-                           !! Homogenaizing the temperature, salinity, alpha and beta in this portion of the column
-                           DO jk = ikup, ikdown
-                              zvts(jk,jp_tem) = zta
-                              zvts(jk,jp_sal) = zsa
-                              zvab(jk,jp_tem) = zalfa
-                              zvab(jk,jp_sal) = zbeta
-                           END DO
-                           
-                           
-                           !! Updating N2 in the relvant portion of the water column
-                           !! Temperature, Salinity, Alpha and Beta have been homogenized in the unstable portion
-                           !! => Need to re-compute N2! will use Alpha and Beta!
-                           
-                           ikup   = MAX(2,ikup)         ! ikup can never be 1 !
-                           ik_low = MIN(ikdown+1,ikbot) ! we must go 1 point deeper than ikdown!
-                           
-                           DO jk = ikup, ik_low              ! we must go 1 point deeper than ikdown!
-
-                              !! Interpolating alfa and beta at W point:
-                              zrw =  (gdepw_n(ji,jj,jk  ) - gdept_n(ji,jj,jk)) &
-                                 & / (gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk))
-                              zaw = zvab(jk,jp_tem) * (1._wp - zrw) + zvab(jk-1,jp_tem) * zrw
-                              zbw = zvab(jk,jp_sal) * (1._wp - zrw) + zvab(jk-1,jp_sal) * zrw
-
-                              !! N2 at W point, doing exactly as in eosbn2.F90:
-                              zvn2(jk) = grav*( zaw * ( zvts(jk-1,jp_tem) - zvts(jk,jp_tem) )     &
-                                 &            - zbw * ( zvts(jk-1,jp_sal) - zvts(jk,jp_sal) )  )  &
-                                 &       / e3w_n(ji,jj,jk) * tmask(ji,jj,jk)
-
-                              !! OR, faster  => just considering the vertical gradient of density
-                              !! as only the signa maters...
-                              !zvn2(jk) = (  zaw * ( zvts(jk-1,jp_tem) - zvts(jk,jp_tem) )     &
-                              !     &      - zbw * ( zvts(jk-1,jp_sal) - zvts(jk,jp_sal) )  )
-
-                           END DO
-                        
-                           ikp = MIN(ikdown+1,ikbot)
-                           
-
-                        ENDIF  !IF( zvn2(ikp) < 0. )
-
-
-                        IF( ikp == ikbot ) l_bottom_reached = .TRUE.
-                        !
-                     END DO ! DO WHILE ( .NOT. l_bottom_reached )
-
-                     IF( ikp /= ikbot )   CALL ctl_stop( 'tra_npc :  PROBLEM #3')
-                    
-                     ! ******* At this stage ikp == ikbot ! *******
-                    
-                     IF( ilayer > 0 ) THEN      !! least an unstable layer has been found
-                        !
-                        IF( lp_monitor_point ) THEN
-                           WRITE(numout,*)
-                           WRITE(numout,*) 'After ',jiter,' iteration(s), we neutralized ',ilayer,' instable layer(s)'
-                           WRITE(numout,*) '   ==> N2 at i,j=',ji,',',jj,' now looks like this:'
+                           WRITE(numout,*)  ' * Iteration #',jiter,': found instable portion #',ilayer,   &
+                              &                                    ' in column! Starting at ikp =', ikp
+                           WRITE(numout,*)  ' *** N2 for point (i,j) = ',ji,' , ',jj
                            DO jk = 1, klc1
                               WRITE(numout,*) jk, zvn2(jk)
@@ -278,36 +159,155 @@
                         ENDIF
                         !
-                        ikp    = 1     ! starting again at the surface for the next iteration
-                        ilayer = 0
+                        IF( jiter == 1 )   inpcc = inpcc + 1 
+                        !
+                        IF( lp_monitor_point )   WRITE(numout, *) 'Negative N2 at ikp =',ikp,' for layer #', ilayer
+                        !
+                        !! ikup is the uppermost point where mixing will start:
+                        ikup = ikp - 1 ! ikup is always "at most at ikp-1", less if neutral levels overlying
+                        !
+                        !! If the points above ikp-1 have N2 == 0 they must also be mixed:
+                        IF( ikp > 2 ) THEN
+                           DO jk = ikp-1, 2, -1
+                              IF( ABS(zvn2(jk)) < zn2_zero ) THEN
+                                 ikup = ikup - 1  ! 1 more upper level has N2=0 and must be added for the mixing
+                              ELSE
+                                 EXIT
+                              ENDIF
+                           END DO
+                        ENDIF
+                        !
+                        IF( ikup < 1 )   CALL ctl_stop( 'tra_npc :  PROBLEM #1')
+                        !
+                        zsum_temp = 0._wp
+                        zsum_sali = 0._wp
+                        zsum_alfa = 0._wp
+                        zsum_beta = 0._wp
+                        zsum_z    = 0._wp
+                                                 
+                        DO jk = ikup, ikbot      ! Inside the instable (and overlying neutral) portion of the column
+                           !
+                           zdz       = e3t(ji,jj,jk,Kmm)
+                           zsum_temp = zsum_temp + zvts(jk,jp_tem)*zdz
+                           zsum_sali = zsum_sali + zvts(jk,jp_sal)*zdz
+                           zsum_alfa = zsum_alfa + zvab(jk,jp_tem)*zdz
+                           zsum_beta = zsum_beta + zvab(jk,jp_sal)*zdz
+                           zsum_z    = zsum_z    + zdz
+                           !                              
+                           IF( jk == ikbot ) EXIT ! avoid array-index overshoot in case ikbot = jpk, cause we're calling jk+1 next line
+                           !! EXIT when we have reached the last layer that is instable (N2<0) or neutral (N2=0):
+                           IF( zvn2(jk+1) > zn2_zero ) EXIT
+                        END DO
+                       
+                        ikdown = jk ! for the current unstable layer, ikdown is the deepest point with a negative or neutral N2
+                        IF( ikup == ikdown )   CALL ctl_stop( 'tra_npc :  PROBLEM #2')
+
+                        ! Mixing Temperature, salinity, alpha and beta from ikup to ikdown included:
+                        zta   = zsum_temp/zsum_z
+                        zsa   = zsum_sali/zsum_z
+                        zalfa = zsum_alfa/zsum_z
+                        zbeta = zsum_beta/zsum_z
+
+                        IF( lp_monitor_point ) THEN
+                           WRITE(numout,*) 'MIXED T, S, alfa and beta between ikup =',ikup,   &
+                              &            ' and ikdown =',ikdown,', in layer #',ilayer
+                           WRITE(numout,*) '  => Mean temp. in that portion =', zta
+                           WRITE(numout,*) '  => Mean sali. in that portion =', zsa
+                           WRITE(numout,*) '  => Mean Alfa  in that portion =', zalfa
+                           WRITE(numout,*) '  => Mean Beta  in that portion =', zbeta
+                        ENDIF
+
+                        !! Homogenaizing the temperature, salinity, alpha and beta in this portion of the column
+                        DO jk = ikup, ikdown
+                           zvts(jk,jp_tem) = zta
+                           zvts(jk,jp_sal) = zsa
+                           zvab(jk,jp_tem) = zalfa
+                           zvab(jk,jp_sal) = zbeta
+                        END DO
+                        
+                        
+                        !! Updating N2 in the relvant portion of the water column
+                        !! Temperature, Salinity, Alpha and Beta have been homogenized in the unstable portion
+                        !! => Need to re-compute N2! will use Alpha and Beta!
+                        
+                        ikup   = MAX(2,ikup)         ! ikup can never be 1 !
+                        ik_low = MIN(ikdown+1,ikbot) ! we must go 1 point deeper than ikdown!
+                        
+                        DO jk = ikup, ik_low              ! we must go 1 point deeper than ikdown!
+
+                           !! Interpolating alfa and beta at W point:
+                           zrw =  (gdepw(ji,jj,jk  ,Kmm) - gdept(ji,jj,jk,Kmm)) &
+                              & / (gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm))
+                           zaw = zvab(jk,jp_tem) * (1._wp - zrw) + zvab(jk-1,jp_tem) * zrw
+                           zbw = zvab(jk,jp_sal) * (1._wp - zrw) + zvab(jk-1,jp_sal) * zrw
+
+                           !! N2 at W point, doing exactly as in eosbn2.F90:
+                           zvn2(jk) = grav*( zaw * ( zvts(jk-1,jp_tem) - zvts(jk,jp_tem) )     &
+                              &            - zbw * ( zvts(jk-1,jp_sal) - zvts(jk,jp_sal) )  )  &
+                              &       / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk)
+
+                           !! OR, faster  => just considering the vertical gradient of density
+                           !! as only the signa maters...
+                           !zvn2(jk) = (  zaw * ( zvts(jk-1,jp_tem) - zvts(jk,jp_tem) )     &
+                           !     &      - zbw * ( zvts(jk-1,jp_sal) - zvts(jk,jp_sal) )  )
+
+                        END DO
+                     
+                        ikp = MIN(ikdown+1,ikbot)
+                        
+
+                     ENDIF  !IF( zvn2(ikp) < 0. )
+
+
+                     IF( ikp == ikbot ) l_bottom_reached = .TRUE.
+                     !
+                  END DO ! DO WHILE ( .NOT. l_bottom_reached )
+
+                  IF( ikp /= ikbot )   CALL ctl_stop( 'tra_npc :  PROBLEM #3')
+                 
+                  ! ******* At this stage ikp == ikbot ! *******
+                 
+                  IF( ilayer > 0 ) THEN      !! least an unstable layer has been found
+                     !
+                     IF( lp_monitor_point ) THEN
+                        WRITE(numout,*)
+                        WRITE(numout,*) 'After ',jiter,' iteration(s), we neutralized ',ilayer,' instable layer(s)'
+                        WRITE(numout,*) '   ==> N2 at i,j=',ji,',',jj,' now looks like this:'
+                        DO jk = 1, klc1
+                           WRITE(numout,*) jk, zvn2(jk)
+                        END DO
+                        WRITE(numout,*)
                      ENDIF
                      !
-                     IF( ikp >= ikbot )   l_column_treated = .TRUE.
-                     !
-                  END DO ! DO WHILE ( .NOT. l_column_treated )
-
-                  !! Updating tsa:
-                  tsa(ji,jj,:,jp_tem) = zvts(:,jp_tem)
-                  tsa(ji,jj,:,jp_sal) = zvts(:,jp_sal)
-
-                  !! LB:  Potentially some other global variable beside theta and S can be treated here
-                  !!      like BGC tracers.
-
-                  IF( lp_monitor_point )   WRITE(numout,*)
-
-               ENDIF ! IF( tmask(ji,jj,3) == 1 ) THEN
-
-            END DO ! ji
-         END DO ! jj
+                     ikp    = 1     ! starting again at the surface for the next iteration
+                     ilayer = 0
+                  ENDIF
+                  !
+                  IF( ikp >= ikbot )   l_column_treated = .TRUE.
+                  !
+               END DO ! DO WHILE ( .NOT. l_column_treated )
+
+               !! Updating pts:
+               pts(ji,jj,:,jp_tem,Kaa) = zvts(:,jp_tem)
+               pts(ji,jj,:,jp_sal,Kaa) = zvts(:,jp_sal)
+
+               !! LB:  Potentially some other global variable beside theta and S can be treated here
+               !!      like BGC tracers.
+
+               IF( lp_monitor_point )   WRITE(numout,*)
+
+            ENDIF ! IF( tmask(ji,jj,3) == 1 ) THEN
+
+         END_2D
          !
          IF( l_trdtra ) THEN         ! send the Non penetrative mixing trends for diagnostic
-            z1_r2dt = 1._wp / (2._wp * rdt)
-            ztrdt(:,:,:) = ( tsa(:,:,:,jp_tem) - ztrdt(:,:,:) ) * z1_r2dt
-            ztrds(:,:,:) = ( tsa(:,:,:,jp_sal) - ztrds(:,:,:) ) * z1_r2dt
-            CALL trd_tra( kt, 'TRA', jp_tem, jptra_npc, ztrdt )
-            CALL trd_tra( kt, 'TRA', jp_sal, jptra_npc, ztrds )
+            z1_rDt = 1._wp / (2._wp * rn_Dt)
+            ztrdt(:,:,:) = ( pts(:,:,:,jp_tem,Kaa) - ztrdt(:,:,:) ) * z1_rDt
+            ztrds(:,:,:) = ( pts(:,:,:,jp_sal,Kaa) - ztrds(:,:,:) ) * z1_rDt
+            CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_npc, ztrdt )
+            CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_npc, ztrds )
             DEALLOCATE( ztrdt, ztrds )
          ENDIF
          !
-         CALL lbc_lnk_multi( 'tranpc', tsa(:,:,:,jp_tem), 'T', 1., tsa(:,:,:,jp_sal), 'T', 1. )
+         CALL lbc_lnk_multi( 'tranpc', pts(:,:,:,jp_tem,Kaa), 'T', 1., pts(:,:,:,jp_sal,Kaa), 'T', 1. )
          !
          IF( lwp .AND. l_LB_debug ) THEN
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/tranxt.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/tranxt.F90	(revision 12384)
+++ 	(revision )
@@ -1,383 +1,0 @@
-MODULE tranxt
-   !!======================================================================
-   !!                       ***  MODULE  tranxt  ***
-   !! Ocean active tracers:  time stepping on temperature and salinity
-   !!======================================================================
-   !! History :  OPA  !  1991-11  (G. Madec)  Original code
-   !!            7.0  !  1993-03  (M. Guyon)  symetrical conditions
-   !!            8.0  !  1996-02  (G. Madec & M. Imbard)  opa release 8.0
-   !!             -   !  1996-04  (A. Weaver)  Euler forward step
-   !!            8.2  !  1999-02  (G. Madec, N. Grima)  semi-implicit pressure grad.
-   !!  NEMO      1.0  !  2002-08  (G. Madec)  F90: Free form and module
-   !!             -   !  2002-11  (C. Talandier, A-M Treguier) Open boundaries
-   !!             -   !  2005-04  (C. Deltel) Add Asselin trend in the ML budget
-   !!            2.0  !  2006-02  (L. Debreu, C. Mazauric) Agrif implementation
-   !!            3.0  !  2008-06  (G. Madec)  time stepping always done in trazdf
-   !!            3.1  !  2009-02  (G. Madec, R. Benshila)  re-introduce the vvl option
-   !!            3.3  !  2010-04  (M. Leclair, G. Madec)  semi-implicit hpg with asselin filter + modified LF-RA
-   !!             -   !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_nxt       : time stepping on tracers
-   !!   tra_nxt_fix   : time stepping on tracers : fixed    volume case
-   !!   tra_nxt_vvl   : time stepping on tracers : variable volume case
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers variables
-   USE dom_oce         ! ocean space and time domain variables 
-   USE sbc_oce         ! surface boundary condition: ocean
-   USE sbcrnf          ! river runoffs
-   USE sbcisf          ! ice shelf melting
-   USE zdf_oce         ! ocean vertical mixing
-   USE domvvl          ! variable volume
-   USE trd_oce         ! trends: ocean variables
-   USE trdtra          ! trends manager: tracers 
-   USE traqsr          ! penetrative solar radiation (needed for nksr)
-   USE phycst          ! physical constant
-   USE ldftra          ! lateral physics : tracers
-   USE ldfslp          ! lateral physics : slopes
-   USE bdy_oce  , ONLY : ln_bdy
-   USE bdytra          ! open boundary condition (bdy_tra routine)
-   !
-   USE in_out_manager  ! I/O manager
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE prtctl          ! Print control
-   USE timing          ! Timing
-#if defined key_agrif
-   USE agrif_oce_interp
-#endif
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_nxt       ! routine called by step.F90
-   PUBLIC   tra_nxt_fix   ! to be used in trcnxt
-   PUBLIC   tra_nxt_vvl   ! to be used in trcnxt
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id$
-   !! Software governed by the CeCILL license (see ./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tra_nxt( kt )
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE tranxt  ***
-      !!
-      !! ** Purpose :   Apply the boundary condition on the after temperature  
-      !!             and salinity fields, achieved the time stepping by adding
-      !!             the Asselin filter on now fields and swapping the fields.
-      !! 
-      !! ** Method  :   At this stage of the computation, ta and sa are the 
-      !!             after temperature and salinity as the time stepping has
-      !!             been performed in trazdf_imp or trazdf_exp module.
-      !!
-      !!              - Apply lateral boundary conditions on (ta,sa) 
-      !!             at the local domain   boundaries through lbc_lnk call, 
-      !!             at the one-way open boundaries (ln_bdy=T), 
-      !!             at the AGRIF zoom   boundaries (lk_agrif=T)
-      !!
-      !!              - Update lateral boundary conditions on AGRIF children
-      !!             domains (lk_agrif=T)
-      !!
-      !! ** Action  : - tsb & tsn ready for the next time step
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
-      !!
-      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp) ::   zfact            ! local scalars
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds
-      !!----------------------------------------------------------------------
-      !
-      IF( ln_timing )   CALL timing_start( 'tra_nxt')
-      !
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_nxt : achieve the time stepping by Asselin filter and array swap'
-         IF(lwp) WRITE(numout,*) '~~~~~~~'
-      ENDIF
-
-      ! Update after tracer on domain lateral boundaries
-      ! 
-#if defined key_agrif
-      CALL Agrif_tra                     ! AGRIF zoom boundaries
-#endif
-      !                                              ! local domain boundaries  (T-point, unchanged sign)
-      CALL lbc_lnk_multi( 'tranxt', tsa(:,:,:,jp_tem), 'T', 1., tsa(:,:,:,jp_sal), 'T', 1. )
-      !
-      IF( ln_bdy )   CALL bdy_tra( kt )  ! BDY open boundaries
- 
-      ! set time step size (Euler/Leapfrog)
-      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dt =        rdt   ! at nit000             (Euler)
-      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dt = 2._wp* rdt   ! at nit000 or nit000+1 (Leapfrog)
-      ENDIF
-
-      ! trends computation initialisation
-      IF( l_trdtra )   THEN                    
-         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )
-         ztrdt(:,:,jpk) = 0._wp
-         ztrds(:,:,jpk) = 0._wp
-         IF( ln_traldf_iso ) THEN              ! diagnose the "pure" Kz diffusive trend 
-            CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrdt )
-            CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdfp, ztrds )
-         ENDIF
-         ! total trend for the non-time-filtered variables. 
-         zfact = 1.0 / rdt
-         ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from tsn terms
-         DO jk = 1, jpkm1
-            ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem)*e3t_a(:,:,jk) / e3t_n(:,:,jk) - tsn(:,:,jk,jp_tem)) * zfact
-            ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal)*e3t_a(:,:,jk) / e3t_n(:,:,jk) - tsn(:,:,jk,jp_sal)) * zfact
-         END DO
-         CALL trd_tra( kt, 'TRA', jp_tem, jptra_tot, ztrdt )
-         CALL trd_tra( kt, 'TRA', jp_sal, jptra_tot, ztrds )
-         IF( ln_linssh ) THEN       ! linear sea surface height only
-            ! Store now fields before applying the Asselin filter 
-            ! in order to calculate Asselin filter trend later.
-            ztrdt(:,:,:) = tsn(:,:,:,jp_tem) 
-            ztrds(:,:,:) = tsn(:,:,:,jp_sal)
-         ENDIF
-      ENDIF
-
-      IF( neuler == 0 .AND. kt == nit000 ) THEN       ! Euler time-stepping at first time-step (only swap)
-         DO jn = 1, jpts
-            DO jk = 1, jpkm1
-               tsn(:,:,jk,jn) = tsa(:,:,jk,jn)    
-            END DO
-         END DO
-         IF (l_trdtra .AND. .NOT. ln_linssh ) THEN   ! Zero Asselin filter contribution must be explicitly written out since for vvl
-            !                                        ! Asselin filter is output by tra_nxt_vvl that is not called on this time step
-            ztrdt(:,:,:) = 0._wp
-            ztrds(:,:,:) = 0._wp
-            CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt )
-            CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds )
-         END IF
-         !
-      ELSE                                            ! Leap-Frog + Asselin filter time stepping
-         !
-         IF( ln_linssh ) THEN   ;   CALL tra_nxt_fix( kt, nit000,      'TRA', tsb, tsn, tsa, jpts )  ! linear free surface 
-         ELSE                   ;   CALL tra_nxt_vvl( kt, nit000, rdt, 'TRA', tsb, tsn, tsa,   &
-           &                                                                sbc_tsc, sbc_tsc_b, jpts )  ! non-linear free surface
-         ENDIF
-         !
-         CALL lbc_lnk_multi( 'tranxt', tsb(:,:,:,jp_tem), 'T', 1., tsb(:,:,:,jp_sal), 'T', 1., &
-                  &          tsn(:,:,:,jp_tem), 'T', 1., tsn(:,:,:,jp_sal), 'T', 1., &
-                  &          tsa(:,:,:,jp_tem), 'T', 1., tsa(:,:,:,jp_sal), 'T', 1.  )
-         !
-      ENDIF     
-      !
-      IF( l_trdtra .AND. ln_linssh ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt     
-         zfact = 1._wp / r2dt             
-         DO jk = 1, jpkm1
-            ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact
-            ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact
-         END DO
-         CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt )
-         CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds )
-      END IF
-      IF( l_trdtra )   DEALLOCATE( ztrdt , ztrds )
-      !
-      !                        ! control print
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' nxt  - Tn: ', mask1=tmask,   &
-         &                       tab3d_2=tsn(:,:,:,jp_sal), clinfo2=       ' Sn: ', mask2=tmask )
-      !
-      IF( ln_timing )   CALL timing_stop('tra_nxt')
-      !
-   END SUBROUTINE tra_nxt
-
-
-   SUBROUTINE tra_nxt_fix( kt, kit000, cdtype, ptb, ptn, pta, kjpt )
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE tra_nxt_fix  ***
-      !!
-      !! ** Purpose :   fixed volume: apply the Asselin time filter and 
-      !!                swap the tracer fields.
-      !! 
-      !! ** Method  : - Apply a Asselin time filter on now fields.
-      !!              - swap tracer fields to prepare the next time_step.
-      !!
-      !! ** Action  : - tsb & tsn ready for the next time step
-      !!----------------------------------------------------------------------
-      INTEGER                              , INTENT(in   ) ::  kt        ! ocean time-step index
-      INTEGER                              , INTENT(in   ) ::  kit000    ! first time step index
-      CHARACTER(len=3)                     , INTENT(in   ) ::  cdtype    ! =TRA or TRC (tracer indicator)
-      INTEGER                              , INTENT(in   ) ::  kjpt      ! number of tracers
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptb       ! before tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptn       ! now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  pta       ! tracer trend
-      !
-      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp) ::   ztn, ztd         ! local scalars
-      !!----------------------------------------------------------------------
-      !
-      IF( kt == kit000 )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping', cdtype
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-      ENDIF
-      !
-      DO jn = 1, kjpt
-         !
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  ztn = ptn(ji,jj,jk,jn)                                    
-                  ztd = pta(ji,jj,jk,jn) - 2._wp * ztn + ptb(ji,jj,jk,jn)  ! time laplacian on tracers
-                  !
-                  ptb(ji,jj,jk,jn) = ztn + atfp * ztd                      ! ptb <-- filtered ptn 
-                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                      ! ptn <-- pta
-               END DO
-           END DO
-         END DO
-         !
-      END DO
-      !
-   END SUBROUTINE tra_nxt_fix
-
-
-   SUBROUTINE tra_nxt_vvl( kt, kit000, p2dt, cdtype, ptb, ptn, pta, psbc_tc, psbc_tc_b, kjpt )
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE tra_nxt_vvl  ***
-      !!
-      !! ** Purpose :   Time varying volume: apply the Asselin time filter  
-      !!                and swap the tracer fields.
-      !! 
-      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields.
-      !!              - swap tracer fields to prepare the next time_step.
-      !!             tb  = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )
-      !!                  /( e3t_n    + atfp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )
-      !!             tn  = ta 
-      !!
-      !! ** Action  : - tsb & tsn ready for the next time step
-      !!----------------------------------------------------------------------
-      INTEGER                              , INTENT(in   ) ::  kt        ! ocean time-step index
-      INTEGER                              , INTENT(in   ) ::  kit000    ! first time step index
-      REAL(wp)                             , INTENT(in   ) ::  p2dt      ! time-step
-      CHARACTER(len=3)                     , INTENT(in   ) ::  cdtype    ! =TRA or TRC (tracer indicator)
-      INTEGER                              , INTENT(in   ) ::  kjpt      ! number of tracers
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptb       ! before tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptn       ! now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  pta       ! tracer trend
-      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::  psbc_tc   ! surface tracer content
-      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::  psbc_tc_b ! before surface tracer content
-      !
-      LOGICAL  ::   ll_traqsr, ll_rnf, ll_isf   ! local logical
-      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
-      REAL(wp) ::   zfact, zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar
-      REAL(wp) ::   zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d   !   -      -
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   ztrd_atf
-      !!----------------------------------------------------------------------
-      !
-      IF( kt == kit000 )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping', cdtype
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-      ENDIF
-      !
-      IF( cdtype == 'TRA' )  THEN   
-         ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration
-         ll_rnf     = ln_rnf           ! active  tracers case  and  river runoffs
-         ll_isf     = ln_isf           ! active  tracers case  and  ice shelf melting
-      ELSE                          ! passive tracers case
-         ll_traqsr  = .FALSE.          ! NO solar penetration
-         ll_rnf     = .FALSE.          ! NO river runoffs ????          !!gm BUG ?  
-         ll_isf     = .FALSE.          ! NO ice shelf melting/freezing  !!gm BUG ?? 
-      ENDIF
-      !
-      IF( ( l_trdtra .AND. cdtype == 'TRA' ) .OR. ( l_trdtrc .AND. cdtype == 'TRC' ) )   THEN
-         ALLOCATE( ztrd_atf(jpi,jpj,jpk,kjpt) )
-         ztrd_atf(:,:,:,:) = 0.0_wp
-      ENDIF
-      zfact = 1._wp / p2dt
-      zfact1 = atfp * p2dt
-      zfact2 = zfact1 * r1_rau0
-      DO jn = 1, kjpt      
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  ze3t_b = e3t_b(ji,jj,jk)
-                  ze3t_n = e3t_n(ji,jj,jk)
-                  ze3t_a = e3t_a(ji,jj,jk)
-                  !                                         ! tracer content at Before, now and after
-                  ztc_b  = ptb(ji,jj,jk,jn) * ze3t_b
-                  ztc_n  = ptn(ji,jj,jk,jn) * ze3t_n
-                  ztc_a  = pta(ji,jj,jk,jn) * ze3t_a
-                  !
-                  ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b
-                  ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b
-                  !
-                  ze3t_f = ze3t_n + atfp * ze3t_d
-                  ztc_f  = ztc_n  + atfp * ztc_d
-                  !
-                  IF( jk == mikt(ji,jj) ) THEN           ! first level 
-                     ze3t_f = ze3t_f - zfact2 * ( (emp_b(ji,jj)    - emp(ji,jj)   )  &
-                            &                   + (fwfisf_b(ji,jj) - fwfisf(ji,jj))  )
-                     ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
-                  ENDIF
-                  IF( ln_rnf_depth ) THEN
-                     ! Rivers are not just at the surface must go down to nk_rnf(ji,jj)
-                     IF( mikt(ji,jj) <=jk .and. jk <= nk_rnf(ji,jj)  ) THEN
-                        ze3t_f = ze3t_f - zfact2 * ( - (rnf_b(ji,jj) - rnf(ji,jj)   )  ) &
-                    &                            * ( e3t_n(ji,jj,jk) / h_rnf(ji,jj) ) 
-                     ENDIF
-                  ELSE
-                     IF( jk == mikt(ji,jj) ) THEN           ! first level 
-                        ze3t_f = ze3t_f - zfact2 * ( - (rnf_b(ji,jj)    - rnf(ji,jj)   ) ) 
-                     ENDIF
-                  ENDIF
-
-                  !
-                  ! solar penetration (temperature only)
-                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )                            & 
-                     &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 
-                     !
-                  ! river runoff
-                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )                                          &
-                     &     ztc_f  = ztc_f  - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) & 
-                     &                              * e3t_n(ji,jj,jk) / h_rnf(ji,jj)
-                     !
-                  ! ice shelf
-                  IF( ll_isf ) THEN
-                     ! level fully include in the Losch_2008 ice shelf boundary layer
-                     IF ( jk >= misfkt(ji,jj) .AND. jk < misfkb(ji,jj) )                          &
-                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
-                               &                 * e3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj)
-                     ! level partially include in Losch_2008 ice shelf boundary layer 
-                     IF ( jk == misfkb(ji,jj) )                                                   &
-                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
-                               &                 * e3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj)
-                  END IF
-                  !
-                  ze3t_f = 1.e0 / ze3t_f
-                  ptb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered
-                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)     ! ptn <-- pta
-                  !
-                  IF( ( l_trdtra .and. cdtype == 'TRA' ) .OR. ( l_trdtrc .and. cdtype == 'TRC' ) ) THEN
-                     ztrd_atf(ji,jj,jk,jn) = (ztc_f - ztc_n) * zfact/ze3t_n
-                  ENDIF
-                  !
-               END DO
-            END DO
-         END DO
-         ! 
-      END DO
-      !
-      IF( ( l_trdtra .AND. cdtype == 'TRA' ) .OR. ( l_trdtrc .AND. cdtype == 'TRC' ) )   THEN
-         IF( l_trdtra .AND. cdtype == 'TRA' ) THEN 
-            CALL trd_tra( kt, cdtype, jp_tem, jptra_atf, ztrd_atf(:,:,:,jp_tem) )
-            CALL trd_tra( kt, cdtype, jp_sal, jptra_atf, ztrd_atf(:,:,:,jp_sal) )
-         ENDIF
-         IF( l_trdtrc .AND. cdtype == 'TRC' ) THEN
-            DO jn = 1, kjpt
-               CALL trd_tra( kt, cdtype, jn, jptra_atf, ztrd_atf(:,:,:,jn) )
-            END DO
-         ENDIF
-         DEALLOCATE( ztrd_atf )
-      ENDIF
-      !
-   END SUBROUTINE tra_nxt_vvl
-
-   !!======================================================================
-END MODULE tranxt
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traqsr.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traqsr.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traqsr.F90	(revision 12928)
@@ -67,5 +67,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -75,5 +75,5 @@
 CONTAINS
 
-   SUBROUTINE tra_qsr( kt )
+   SUBROUTINE tra_qsr( kt, Kmm, pts, Krhs )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_qsr  ***
@@ -87,5 +87,5 @@
       !!         I(k) = Qsr*( rn_abs*EXP(z(k)/rn_si0) + (1.-rn_abs)*EXP(z(k)/rn_si1) )
       !!         The temperature trend associated with the solar radiation penetration 
-      !!         is given by : zta = 1/e3t dk[ I ] / (rau0*Cp)
+      !!         is given by : zta = 1/e3t dk[ I ] / (rho0*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
@@ -101,5 +101,7 @@
       !!              Morel, A. et Berthon, JF, 1989, Limnol Oceanogr 34(8), 1545-1562
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt     ! ocean time-step
+      INTEGER,                                   INTENT(in   ) :: kt            ! ocean time-step
+      INTEGER,                                   INTENT(in   ) :: Kmm, Krhs     ! time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts           ! active tracers and RHS of tracer equation
       !
       INTEGER  ::   ji, jj, jk               ! dummy loop indices
@@ -126,5 +128,5 @@
       IF( l_trdtra ) THEN      ! trends diagnostic: save the input temperature trend
          ALLOCATE( ztrdt(jpi,jpj,jpk) ) 
-         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
+         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs)
       ENDIF
       !
@@ -133,6 +135,5 @@
       !                         !-----------------------------------!
       IF( kt == nit000 ) THEN          !==  1st time step  ==!
-!!gm case neuler  not taken into account....
-         IF( ln_rstart .AND. iom_varid( numror, 'qsr_hc_b', ldstop = .FALSE. ) > 0 ) THEN    ! read in restart
+         IF( ln_rstart .AND. iom_varid( numror, 'qsr_hc_b', ldstop = .FALSE. ) > 0  .AND. .NOT.l_1st_euler ) THEN    ! read in restart
             IF(lwp) WRITE(numout,*) '          nit000-1 qsr tracer content forcing field read in the restart file'
             z1_2 = 0.5_wp
@@ -154,5 +155,5 @@
          !
          DO jk = 1, nksr
-            qsr_hc(:,:,jk) = r1_rau0_rcp * ( etot3(:,:,jk) - etot3(:,:,jk+1) )
+            qsr_hc(:,:,jk) = r1_rho0_rcp * ( etot3(:,:,jk) - etot3(:,:,jk+1) )
          END DO
          !
@@ -167,10 +168,10 @@
             DO jk = 1, nksr + 1
                DO jj = 2, jpjm1                       ! Separation in R-G-B depending of the surface Chl
-                  DO ji = fs_2, fs_jpim1
+                  DO ji = 2, jpim1
                      zchl    = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) )
                      zCtot   = 40.6  * zchl**0.459
                      zze     = 568.2 * zCtot**(-0.746)
                      IF( zze > 102. ) zze = 200.0 * zCtot**(-0.293)
-                     zpsi    = gdepw_n(ji,jj,jk) / zze
+                     zpsi    = gdepw(ji,jj,jk,Kmm) / zze
                      !
                      zlogc   = LOG( zchl )
@@ -195,47 +196,37 @@
          !
          zcoef  = ( 1. - rn_abs ) / 3._wp    !* surface equi-partition in R-G-B
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               ze0(ji,jj,1) = rn_abs * qsr(ji,jj)
-               ze1(ji,jj,1) = zcoef  * qsr(ji,jj)
-               ze2(ji,jj,1) = zcoef  * qsr(ji,jj)
-               ze3(ji,jj,1) = zcoef  * qsr(ji,jj)
-               zea(ji,jj,1) =          qsr(ji,jj)
-            END DO
+         DO_2D_00_00
+            ze0(ji,jj,1) = rn_abs * qsr(ji,jj)
+            ze1(ji,jj,1) = zcoef  * qsr(ji,jj)
+            ze2(ji,jj,1) = zcoef  * qsr(ji,jj)
+            ze3(ji,jj,1) = zcoef  * qsr(ji,jj)
+            zea(ji,jj,1) =          qsr(ji,jj)
+         END_2D
+         !
+         DO jk = 2, nksr+1                   !* interior equi-partition in R-G-B depending of vertical profile of Chl
+            DO_2D_00_00
+               zchl = MIN( 10. , MAX( 0.03, zchl3d(ji,jj,jk) ) )
+               irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 )
+               zekb(ji,jj) = rkrgb(1,irgb)
+               zekg(ji,jj) = rkrgb(2,irgb)
+               zekr(ji,jj) = rkrgb(3,irgb)
+            END_2D
+
+            DO_2D_00_00
+               zc0 = ze0(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * xsi0r       )
+               zc1 = ze1(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * zekb(ji,jj) )
+               zc2 = ze2(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * zekg(ji,jj) )
+               zc3 = ze3(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * zekr(ji,jj) )
+               ze0(ji,jj,jk) = zc0
+               ze1(ji,jj,jk) = zc1
+               ze2(ji,jj,jk) = zc2
+               ze3(ji,jj,jk) = zc3
+               zea(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * wmask(ji,jj,jk)
+            END_2D
          END DO
          !
-         DO jk = 2, nksr+1                   !* interior equi-partition in R-G-B depending of vertical profile of Chl
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  zchl = MIN( 10. , MAX( 0.03, zchl3d(ji,jj,jk) ) )
-                  irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 )
-                  zekb(ji,jj) = rkrgb(1,irgb)
-                  zekg(ji,jj) = rkrgb(2,irgb)
-                  zekr(ji,jj) = rkrgb(3,irgb)
-               END DO
-            END DO
-
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  zc0 = ze0(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * xsi0r       )
-                  zc1 = ze1(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * zekb(ji,jj) )
-                  zc2 = ze2(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * zekg(ji,jj) )
-                  zc3 = ze3(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * zekr(ji,jj) )
-                  ze0(ji,jj,jk) = zc0
-                  ze1(ji,jj,jk) = zc1
-                  ze2(ji,jj,jk) = zc2
-                  ze3(ji,jj,jk) = zc3
-                  zea(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * wmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         !
-         DO jk = 1, nksr                     !* now qsr induced heat content
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  qsr_hc(ji,jj,jk) = r1_rau0_rcp * ( zea(ji,jj,jk) - zea(ji,jj,jk+1) )
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, nksr )
+            qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( zea(ji,jj,jk) - zea(ji,jj,jk+1) )
+         END_3D
          !
          DEALLOCATE( zekb , zekg , zekr , ze0 , ze1 , ze2 , ze3 , zea , zchl3d ) 
@@ -243,36 +234,26 @@
       CASE( np_2BD  )            !==  2-bands fluxes  ==!
          !
-         zz0 =        rn_abs   * r1_rau0_rcp      ! surface equi-partition in 2-bands
-         zz1 = ( 1. - rn_abs ) * r1_rau0_rcp
-         DO jk = 1, nksr                          ! solar heat absorbed at T-point in the top 400m 
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  zc0 = zz0 * EXP( -gdepw_n(ji,jj,jk  )*xsi0r ) + zz1 * EXP( -gdepw_n(ji,jj,jk  )*xsi1r )
-                  zc1 = zz0 * EXP( -gdepw_n(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -gdepw_n(ji,jj,jk+1)*xsi1r )
-                  qsr_hc(ji,jj,jk) = qsr(ji,jj) * ( zc0 * wmask(ji,jj,jk) - zc1 * wmask(ji,jj,jk+1) ) 
-               END DO
-            END DO
-         END DO
+         zz0 =        rn_abs   * r1_rho0_rcp      ! surface equi-partition in 2-bands
+         zz1 = ( 1. - rn_abs ) * r1_rho0_rcp
+         DO_3D_00_00( 1, nksr )
+            zc0 = zz0 * EXP( -gdepw(ji,jj,jk  ,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk  ,Kmm)*xsi1r )
+            zc1 = zz0 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi1r )
+            qsr_hc(ji,jj,jk) = qsr(ji,jj) * ( zc0 * wmask(ji,jj,jk) - zc1 * wmask(ji,jj,jk+1) ) 
+         END_3D
          !
       END SELECT
       !
       !                          !-----------------------------!
-      DO jk = 1, nksr            !  update to the temp. trend  !
-         DO jj = 2, jpjm1        !-----------------------------!
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
-                  &                 + z1_2 * ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) / e3t_n(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 1, nksr )
+         pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs)   &
+            &                      + z1_2 * ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) / e3t(ji,jj,jk,Kmm)
+      END_3D
       !
       ! sea-ice: store the 1st ocean level attenuation coefficient
-      DO jj = 2, jpjm1 
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            IF( qsr(ji,jj) /= 0._wp ) THEN   ;   fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) )
-            ELSE                             ;   fraqsr_1lev(ji,jj) = 1._wp
-            ENDIF
-         END DO
-      END DO
+      DO_2D_00_00
+         IF( qsr(ji,jj) /= 0._wp ) THEN   ;   fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rho0_rcp * qsr(ji,jj) )
+         ELSE                             ;   fraqsr_1lev(ji,jj) = 1._wp
+         ENDIF
+      END_2D
       CALL lbc_lnk( 'traqsr', fraqsr_1lev(:,:), 'T', 1._wp )
       !
@@ -281,5 +262,5 @@
          zetot(:,:,nksr+1:jpk) = 0._wp     ! below ~400m set to zero
          DO jk = nksr, 1, -1
-            zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) * rau0_rcp
+            zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) * rho0_rcp
          END DO         
          CALL iom_put( 'qsr3d', zetot )   ! 3D distribution of shortwave Radiation
@@ -295,10 +276,10 @@
       !
       IF( l_trdtra ) THEN     ! qsr tracers trends saved for diagnostics
-         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
-         CALL trd_tra( kt, 'TRA', jp_tem, jptra_qsr, ztrdt )
+         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)
+         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_qsr, ztrdt )
          DEALLOCATE( ztrdt ) 
       ENDIF
       !                       ! print mean trends (used for debugging)
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' qsr  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' qsr  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
       !
       IF( ln_timing )   CALL timing_stop('tra_qsr')
@@ -336,9 +317,7 @@
       !!----------------------------------------------------------------------
       !
-      REWIND( numnam_ref )              ! Namelist namtra_qsr in reference     namelist
       READ  ( numnam_ref, namtra_qsr, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_qsr in reference namelist' )
       !
-      REWIND( numnam_cfg )              ! Namelist namtra_qsr in configuration namelist
       READ  ( numnam_cfg, namtra_qsr, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_qsr in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/trasbc.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/trasbc.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/trasbc.F90	(revision 12928)
@@ -10,4 +10,5 @@
    !!             -   !  2010-09  (C. Ethe, G. Madec) Merge TRA-TRC
    !!            3.6  !  2014-11  (P. Mathiot) isf melting forcing 
+   !!            4.1  !  2019-09  (P. Mathiot) isf moved in traisf
    !!----------------------------------------------------------------------
 
@@ -22,6 +23,4 @@
    USE sbcmod         ! ln_rnf  
    USE sbcrnf         ! River runoff  
-   USE sbcisf         ! Ice shelf   
-   USE iscplini       ! Ice sheet coupling
    USE traqsr         ! solar radiation penetration
    USE trd_oce        ! trends: ocean variables
@@ -43,5 +42,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -51,5 +50,5 @@
 CONTAINS
 
-   SUBROUTINE tra_sbc ( kt )
+   SUBROUTINE tra_sbc ( kt, Kmm, pts, Krhs )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_sbc  ***
@@ -62,6 +61,6 @@
       !!      (1) Fext, external forcing (i.e. flux through the (air+ice)-sea interface); 
       !!      (2) Fwe , tracer carried with the water that is exchanged with air+ice. 
-      !!               The input forcing fields (emp, rnf, sfx, isf) contain Fext+Fwe,
-      !!             they are simply added to the tracer trend (tsa).
+      !!               The input forcing fields (emp, rnf, sfx) contain Fext+Fwe,
+      !!             they are simply added to the tracer trend (ts(Krhs)).
       !!               In linear free surface case (ln_linssh=T), the volume of the
       !!             ocean does not change with the water exchanges at the (air+ice)-sea
@@ -69,8 +68,10 @@
       !!             concentration/dilution effect associated with water exchanges.
       !!
-      !! ** Action  : - Update tsa with the surface boundary condition trend 
+      !! ** Action  : - Update ts(Krhs) with the surface boundary condition trend 
       !!              - send trends to trdtra module for further diagnostics(l_trdtra=T)
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER,                                   INTENT(in   ) :: kt         ! ocean time-step index
+      INTEGER,                                   INTENT(in   ) :: Kmm, Krhs  ! time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts        ! active tracers and RHS of tracer equation
       !
       INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices  
@@ -90,6 +91,6 @@
       IF( l_trdtra ) THEN                    !* Save ta and sa trends
          ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 
-         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
-         ztrds(:,:,:) = tsa(:,:,:,jp_sal)
+         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs)
+         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs)
       ENDIF
       !
@@ -122,27 +123,21 @@
       ENDIF
       !                             !==  Now sbc tracer content fields  ==!
-      DO jj = 2, jpj
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj)   ! non solar heat flux
-            sbc_tsc(ji,jj,jp_sal) = r1_rau0     * sfx(ji,jj)   ! salt flux due to freezing/melting
-         END DO
-      END DO
+      DO_2D_01_00
+         sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj)   ! non solar heat flux
+         sbc_tsc(ji,jj,jp_sal) = r1_rho0     * sfx(ji,jj)   ! salt flux due to freezing/melting
+      END_2D
       IF( ln_linssh ) THEN                !* linear free surface  
-         DO jj = 2, jpj                         !==>> add concentration/dilution effect due to constant volume cell
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rau0 * emp(ji,jj) * tsn(ji,jj,1,jp_tem)
-               sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rau0 * emp(ji,jj) * tsn(ji,jj,1,jp_sal)
-            END DO
-         END DO                                 !==>> output c./d. term
-         IF( iom_use('emp_x_sst') )   CALL iom_put( "emp_x_sst", emp (:,:) * tsn(:,:,1,jp_tem) )
-         IF( iom_use('emp_x_sss') )   CALL iom_put( "emp_x_sss", emp (:,:) * tsn(:,:,1,jp_sal) )
+         DO_2D_01_00
+            sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_tem,Kmm)
+            sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_sal,Kmm)
+         END_2D
+         IF( iom_use('emp_x_sst') )   CALL iom_put( "emp_x_sst", emp (:,:) * pts(:,:,1,jp_tem,Kmm) )
+         IF( iom_use('emp_x_sss') )   CALL iom_put( "emp_x_sss", emp (:,:) * pts(:,:,1,jp_sal,Kmm) )
       ENDIF
       !
       DO jn = 1, jpts               !==  update tracer trend  ==!
-         DO jj = 2, jpj
-            DO ji = fs_2, fs_jpim1   ! vector opt.  
-               tsa(ji,jj,1,jn) = tsa(ji,jj,1,jn) + zfact * ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) / e3t_n(ji,jj,1)
-            END DO
-         END DO
+         DO_2D_01_00
+            pts(ji,jj,1,jn,Krhs) = pts(ji,jj,1,jn,Krhs) + zfact * ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) / e3t(ji,jj,1,Kmm)
+         END_2D
       END DO
       !                  
@@ -155,38 +150,4 @@
       !
       !----------------------------------------
-      !       Ice Shelf effects (ISF)
-      !     tbl treated as in Losh (2008) JGR
-      !----------------------------------------
-      !
-!!gm BUG ?   Why no differences between non-linear and linear free surface ?
-!!gm         probably taken into account in r1_hisf_tbl : to be verified
-      IF( ln_isf ) THEN
-         zfact = 0.5_wp
-         DO jj = 2, jpj
-            DO ji = fs_2, fs_jpim1
-               !
-               ikt = misfkt(ji,jj)
-               ikb = misfkb(ji,jj)
-               !
-               ! level fully include in the ice shelf boundary layer
-               ! sign - because fwf sign of evapo (rnf sign of precip)
-               DO jk = ikt, ikb - 1
-               ! compute trend
-                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)                                                &
-                     &           + zfact * ( risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem) )             &
-                     &           * r1_hisf_tbl(ji,jj)
-               END DO
-   
-               ! level partially include in ice shelf boundary layer 
-               ! compute trend
-               tsa(ji,jj,ikb,jp_tem) = tsa(ji,jj,ikb,jp_tem)                                                 &
-                  &              + zfact * ( risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem) )             &
-                  &              * r1_hisf_tbl(ji,jj) * ralpha(ji,jj)
-
-            END DO
-         END DO
-      END IF
-      !
-      !----------------------------------------
       !        River Runoff effects
       !----------------------------------------
@@ -194,21 +155,19 @@
       IF( ln_rnf ) THEN         ! input of heat and salt due to river runoff 
          zfact = 0.5_wp
-         DO jj = 2, jpj 
-            DO ji = fs_2, fs_jpim1
-               IF( rnf(ji,jj) /= 0._wp ) THEN
-                  zdep = zfact / h_rnf(ji,jj)
-                  DO jk = 1, nk_rnf(ji,jj)
-                                        tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)                                 &
-                                           &                 +  ( rnf_tsc_b(ji,jj,jp_tem) + rnf_tsc(ji,jj,jp_tem) ) * zdep
-                     IF( ln_rnf_sal )   tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)                                 &
-                                           &                 +  ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep 
-                  END DO
-               ENDIF
-            END DO  
-         END DO  
-      ENDIF
-
-      IF( iom_use('rnf_x_sst') )   CALL iom_put( "rnf_x_sst", rnf*tsn(:,:,1,jp_tem) )   ! runoff term on sst
-      IF( iom_use('rnf_x_sss') )   CALL iom_put( "rnf_x_sss", rnf*tsn(:,:,1,jp_sal) )   ! runoff term on sss
+         DO_2D_01_00
+            IF( rnf(ji,jj) /= 0._wp ) THEN
+               zdep = zfact / h_rnf(ji,jj)
+               DO jk = 1, nk_rnf(ji,jj)
+                                     pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs)                                  &
+                                        &                      +  ( rnf_tsc_b(ji,jj,jp_tem) + rnf_tsc(ji,jj,jp_tem) ) * zdep
+                  IF( ln_rnf_sal )   pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs)                                  &
+                                        &                      +  ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep 
+               END DO
+            ENDIF
+         END_2D
+      ENDIF
+
+      IF( iom_use('rnf_x_sst') )   CALL iom_put( "rnf_x_sst", rnf*pts(:,:,1,jp_tem,Kmm) )   ! runoff term on sst
+      IF( iom_use('rnf_x_sss') )   CALL iom_put( "rnf_x_sss", rnf*pts(:,:,1,jp_sal,Kmm) )   ! runoff term on sss
 
 #if defined key_asminc
@@ -221,19 +180,15 @@
       	 !
          IF( ln_linssh ) THEN 
-            DO jj = 2, jpj 
-               DO ji = fs_2, fs_jpim1
-                  ztim = ssh_iau(ji,jj) / e3t_n(ji,jj,1)
-                  tsa(ji,jj,1,jp_tem) = tsa(ji,jj,1,jp_tem) + tsn(ji,jj,1,jp_tem) * ztim
-                  tsa(ji,jj,1,jp_sal) = tsa(ji,jj,1,jp_sal) + tsn(ji,jj,1,jp_sal) * ztim
-               END DO
-            END DO
+            DO_2D_01_00
+               ztim = ssh_iau(ji,jj) / e3t(ji,jj,1,Kmm)
+               pts(ji,jj,1,jp_tem,Krhs) = pts(ji,jj,1,jp_tem,Krhs) + pts(ji,jj,1,jp_tem,Kmm) * ztim
+               pts(ji,jj,1,jp_sal,Krhs) = pts(ji,jj,1,jp_sal,Krhs) + pts(ji,jj,1,jp_sal,Kmm) * ztim
+            END_2D
          ELSE
-            DO jj = 2, jpj 
-               DO ji = fs_2, fs_jpim1
-                  ztim = ssh_iau(ji,jj) / ( ht_n(ji,jj) + 1. - ssmask(ji, jj) )
-                  tsa(ji,jj,:,jp_tem) = tsa(ji,jj,:,jp_tem) + tsn(ji,jj,:,jp_tem) * ztim
-                  tsa(ji,jj,:,jp_sal) = tsa(ji,jj,:,jp_sal) + tsn(ji,jj,:,jp_sal) * ztim
-               END DO  
-            END DO  
+            DO_2D_01_00
+               ztim = ssh_iau(ji,jj) / ( ht(ji,jj) + 1. - ssmask(ji, jj) )
+               pts(ji,jj,:,jp_tem,Krhs) = pts(ji,jj,:,jp_tem,Krhs) + pts(ji,jj,:,jp_tem,Kmm) * ztim
+               pts(ji,jj,:,jp_sal,Krhs) = pts(ji,jj,:,jp_sal,Krhs) + pts(ji,jj,:,jp_sal,Kmm) * ztim
+            END_2D
          ENDIF
          !
@@ -242,30 +197,14 @@
 #endif
       !
-      !----------------------------------------
-      !        Ice Sheet coupling imbalance correction to have conservation
-      !----------------------------------------
-      !
-      IF( ln_iscpl .AND. ln_hsb) THEN         ! input of heat and salt due to river runoff 
-         DO jk = 1,jpk
-            DO jj = 2, jpj 
-               DO ji = fs_2, fs_jpim1
-                  zdep = 1._wp / e3t_n(ji,jj,jk) 
-                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - htsc_iscpl(ji,jj,jk,jp_tem) * zdep
-                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - htsc_iscpl(ji,jj,jk,jp_sal) * zdep  
-               END DO  
-            END DO  
-         END DO
-      ENDIF
-
       IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics
-         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
-         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
-         CALL trd_tra( kt, 'TRA', jp_tem, jptra_nsr, ztrdt )
-         CALL trd_tra( kt, 'TRA', jp_sal, jptra_nsr, ztrds )
+         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)
+         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:)
+         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_nsr, ztrdt )
+         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_nsr, ztrds )
          DEALLOCATE( ztrdt , ztrds ) 
       ENDIF
       !
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' sbc  - Ta: ', mask1=tmask,   &
-         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' sbc  - Ta: ', mask1=tmask,   &
+         &                                  tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
       !
       IF( ln_timing )   CALL timing_stop('tra_sbc')
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/trazdf.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/trazdf.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/trazdf.F90	(revision 12928)
@@ -36,5 +36,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -44,5 +44,5 @@
 CONTAINS
 
-   SUBROUTINE tra_zdf( kt )
+   SUBROUTINE tra_zdf( kt, Kbb, Kmm, Krhs, pts, Kaa )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_zdf  ***
@@ -50,5 +50,7 @@
       !! ** Purpose :   compute the vertical ocean tracer physics.
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER                                  , INTENT(in)    :: kt                  ! ocean time-step index
+      INTEGER                                  , INTENT(in)    :: Kbb, Kmm, Krhs, Kaa ! time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts                 ! active tracers and RHS of tracer equation
       !
       INTEGER  ::   jk   ! Dummy loop indices
@@ -64,16 +66,12 @@
       ENDIF
       !
-      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dt =      rdt   ! at nit000, =   rdt (restarting with Euler time stepping)
-      ELSEIF( kt <= nit000 + 1           ) THEN   ;   r2dt = 2. * rdt   ! otherwise, = 2 rdt (leapfrog)
-      ENDIF
-      !
       IF( l_trdtra )   THEN                  !* Save ta and sa trends
          ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )
-         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
-         ztrds(:,:,:) = tsa(:,:,:,jp_sal)
+         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Kaa)
+         ztrds(:,:,:) = pts(:,:,:,jp_sal,Kaa)
       ENDIF
       !
       !                                      !* compute lateral mixing trend and add it to the general trend
-      CALL tra_zdf_imp( kt, nit000, 'TRA', r2dt, tsb, tsa, jpts ) 
+      CALL tra_zdf_imp( kt, nit000, 'TRA', rDt, Kbb, Kmm, Krhs, pts, Kaa, jpts ) 
 
 !!gm WHY here !   and I don't like that !
@@ -81,24 +79,24 @@
       ! JMM avoid negative salinities near river outlet ! Ugly fix
       ! JMM : restore negative salinities to small salinities:
-      WHERE( tsa(:,:,:,jp_sal) < 0._wp )   tsa(:,:,:,jp_sal) = 0.1_wp
+      WHERE( pts(:,:,:,jp_sal,Kaa) < 0._wp )   pts(:,:,:,jp_sal,Kaa) = 0.1_wp
 !!gm
 
       IF( l_trdtra )   THEN                      ! save the vertical diffusive trends for further diagnostics
          DO jk = 1, jpkm1
-            ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem)*e3t_a(:,:,jk) - tsb(:,:,jk,jp_tem)*e3t_b(:,:,jk) ) &
-               &          / (e3t_n(:,:,jk)*r2dt) ) - ztrdt(:,:,jk)
-            ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal)*e3t_a(:,:,jk) - tsb(:,:,jk,jp_sal)*e3t_b(:,:,jk) ) &
-              &           / (e3t_n(:,:,jk)*r2dt) ) - ztrds(:,:,jk)
+            ztrdt(:,:,jk) = ( ( pts(:,:,jk,jp_tem,Kaa)*e3t(:,:,jk,Kaa) - pts(:,:,jk,jp_tem,Kbb)*e3t(:,:,jk,Kbb) ) &
+               &          / (e3t(:,:,jk,Kmm)*rDt) ) - ztrdt(:,:,jk)
+            ztrds(:,:,jk) = ( ( pts(:,:,jk,jp_sal,Kaa)*e3t(:,:,jk,Kaa) - pts(:,:,jk,jp_sal,Kbb)*e3t(:,:,jk,Kbb) ) &
+              &           / (e3t(:,:,jk,Kmm)*rDt) ) - ztrds(:,:,jk)
          END DO
 !!gm this should be moved in trdtra.F90 and done on all trends
          CALL lbc_lnk_multi( 'trazdf', ztrdt, 'T', 1. , ztrds, 'T', 1. )
 !!gm
-         CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdf, ztrdt )
-         CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdf, ztrds )
+         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_zdf, ztrdt )
+         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_zdf, ztrds )
          DEALLOCATE( ztrdt , ztrds )
       ENDIF
       !                                          ! print mean trends (used for debugging)
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf  - Ta: ', mask1=tmask,               &
-         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Kaa), clinfo1=' zdf  - Ta: ', mask1=tmask,               &
+         &                                  tab3d_2=pts(:,:,:,jp_sal,Kaa), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
       !
       IF( ln_timing )   CALL timing_stop('tra_zdf')
@@ -107,5 +105,5 @@
 
  
-   SUBROUTINE tra_zdf_imp( kt, kit000, cdtype, p2dt, ptb, pta, kjpt ) 
+   SUBROUTINE tra_zdf_imp( kt, kit000, cdtype, p2dt, Kbb, Kmm, Krhs, pt, Kaa, kjpt ) 
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_zdf_imp  ***
@@ -125,13 +123,13 @@
       !!      If iso-neutral mixing, add to avt the contribution due to lateral mixing.
       !!
-      !! ** Action  : - pta  becomes the after tracer
-      !!---------------------------------------------------------------------
-      INTEGER                              , INTENT(in   ) ::   kt       ! ocean time-step index
-      INTEGER                              , INTENT(in   ) ::   kit000   ! first time step index
-      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
-      INTEGER                              , INTENT(in   ) ::   kjpt     ! number of tracers
-      REAL(wp)                             , INTENT(in   ) ::   p2dt     ! tracer time-step
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb      ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! in: tracer trend ; out: after tracer field
+      !! ** Action  : - pt(:,:,:,:,Kaa)  becomes the after tracer
+      !!---------------------------------------------------------------------
+      INTEGER                                  , INTENT(in   ) ::   kt       ! ocean time-step index
+      INTEGER                                  , INTENT(in   ) ::   Kbb, Kmm, Krhs, Kaa  ! ocean time level indices
+      INTEGER                                  , INTENT(in   ) ::   kit000   ! first time step index
+      CHARACTER(len=3)                         , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
+      INTEGER                                  , INTENT(in   ) ::   kjpt     ! number of tracers
+      REAL(wp)                                 , INTENT(in   ) ::   p2dt     ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt       ! tracers and RHS of tracer equation
       !
       INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
@@ -158,19 +156,11 @@
             IF( l_ldfslp ) THEN            ! isoneutral diffusion: add the contribution 
                IF( ln_traldf_msc  ) THEN     ! MSC iso-neutral operator 
-                  DO jk = 2, jpkm1
-                     DO jj = 2, jpjm1
-                        DO ji = fs_2, fs_jpim1   ! vector opt.
-                           zwt(ji,jj,jk) = zwt(ji,jj,jk) + akz(ji,jj,jk)  
-                        END DO
-                     END DO
-                  END DO
+                  DO_3D_00_00( 2, jpkm1 )
+                     zwt(ji,jj,jk) = zwt(ji,jj,jk) + akz(ji,jj,jk)  
+                  END_3D
                ELSE                          ! standard or triad iso-neutral operator
-                  DO jk = 2, jpkm1
-                     DO jj = 2, jpjm1
-                        DO ji = fs_2, fs_jpim1   ! vector opt.
-                           zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk)
-                        END DO
-                     END DO
-                  END DO
+                  DO_3D_00_00( 2, jpkm1 )
+                     zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk)
+                  END_3D
                ENDIF
             ENDIF
@@ -178,26 +168,18 @@
             ! Diagonal, lower (i), upper (s)  (including the bottom boundary condition since avt is masked)
             IF( ln_zad_Aimp ) THEN         ! Adaptive implicit vertical advection
-               DO jk = 1, jpkm1
-                  DO jj = 2, jpjm1
-                     DO ji = fs_2, fs_jpim1   ! vector opt. (ensure same order of calculation as below if wi=0.)
-                        zzwi = - p2dt * zwt(ji,jj,jk  ) / e3w_n(ji,jj,jk  )
-                        zzws = - p2dt * zwt(ji,jj,jk+1) / e3w_n(ji,jj,jk+1)
-                        zwd(ji,jj,jk) = e3t_a(ji,jj,jk) - zzwi - zzws   &
-                           &                 + p2dt * ( MAX( wi(ji,jj,jk  ) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) )
-                        zwi(ji,jj,jk) = zzwi + p2dt *   MIN( wi(ji,jj,jk  ) , 0._wp )
-                        zws(ji,jj,jk) = zzws - p2dt *   MAX( wi(ji,jj,jk+1) , 0._wp )
-                    END DO
-                  END DO
-               END DO
+               DO_3D_00_00( 1, jpkm1 )
+                  zzwi = - p2dt * zwt(ji,jj,jk  ) / e3w(ji,jj,jk  ,Kmm)
+                  zzws = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm)
+                  zwd(ji,jj,jk) = e3t(ji,jj,jk,Kaa) - zzwi - zzws   &
+                     &                 + p2dt * ( MAX( wi(ji,jj,jk  ) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) )
+                  zwi(ji,jj,jk) = zzwi + p2dt *   MIN( wi(ji,jj,jk  ) , 0._wp )
+                  zws(ji,jj,jk) = zzws - p2dt *   MAX( wi(ji,jj,jk+1) , 0._wp )
+               END_3D
             ELSE
-               DO jk = 1, jpkm1
-                  DO jj = 2, jpjm1
-                     DO ji = fs_2, fs_jpim1   ! vector opt.
-                        zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk  ) / e3w_n(ji,jj,jk)
-                        zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / e3w_n(ji,jj,jk+1)
-                        zwd(ji,jj,jk) = e3t_a(ji,jj,jk) - zwi(ji,jj,jk) - zws(ji,jj,jk)
-                    END DO
-                  END DO
-               END DO
+               DO_3D_00_00( 1, jpkm1 )
+                  zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk  ) / e3w(ji,jj,jk,Kmm)
+                  zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm)
+                  zwd(ji,jj,jk) = e3t(ji,jj,jk,Kaa) - zwi(ji,jj,jk) - zws(ji,jj,jk)
+               END_3D
             ENDIF
             !
@@ -218,49 +200,31 @@
             !   The solution will be in the 4d array pta.
             !   The 3d array zwt is used as a work space array.
-            !   En route to the solution pta is used a to evaluate the rhs and then 
+            !   En route to the solution pt(:,:,:,:,Kaa) is used a to evaluate the rhs and then 
             !   used as a work space array: its value is modified.
             !
-            DO jj = 2, jpjm1        !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k)
-               DO ji = fs_2, fs_jpim1            ! done one for all passive tracers (so included in the IF instruction)
-                  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
+            DO_2D_00_00
+               zwt(ji,jj,1) = zwd(ji,jj,1)
+            END_2D
+            DO_3D_00_00( 2, jpkm1 )
+               zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwt(ji,jj,jk-1)
+            END_3D
             !
          ENDIF 
          !         
-         DO jj = 2, jpjm1           !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
-            DO ji = fs_2, fs_jpim1
-               pta(ji,jj,1,jn) = e3t_b(ji,jj,1) * ptb(ji,jj,1,jn) + p2dt * e3t_n(ji,jj,1) * pta(ji,jj,1,jn)
-            END DO
-         END DO
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  zrhs = e3t_b(ji,jj,jk) * ptb(ji,jj,jk,jn) + p2dt * e3t_n(ji,jj,jk) * pta(ji,jj,jk,jn)   ! zrhs=right hand side
-                  pta(ji,jj,jk,jn) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pta(ji,jj,jk-1,jn)
-               END DO
-            END DO
-         END DO
+         DO_2D_00_00
+            pt(ji,jj,1,jn,Kaa) = e3t(ji,jj,1,Kbb) * pt(ji,jj,1,jn,Kbb) + p2dt * e3t(ji,jj,1,Kmm) * pt(ji,jj,1,jn,Krhs)
+         END_2D
+         DO_3D_00_00( 2, jpkm1 )
+            zrhs = e3t(ji,jj,jk,Kbb) * pt(ji,jj,jk,jn,Kbb) + p2dt * e3t(ji,jj,jk,Kmm) * pt(ji,jj,jk,jn,Krhs)   ! zrhs=right hand side
+            pt(ji,jj,jk,jn,Kaa) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pt(ji,jj,jk-1,jn,Kaa)
+         END_3D
          !
-         DO jj = 2, jpjm1           !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk   (result is the after tracer)
-            DO ji = fs_2, fs_jpim1
-               pta(ji,jj,jpkm1,jn) = pta(ji,jj,jpkm1,jn) / 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
-                  pta(ji,jj,jk,jn) = ( pta(ji,jj,jk,jn) - zws(ji,jj,jk) * pta(ji,jj,jk+1,jn) )   &
-                     &             / zwt(ji,jj,jk) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_2D_00_00
+            pt(ji,jj,jpkm1,jn,Kaa) = pt(ji,jj,jpkm1,jn,Kaa) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1)
+         END_2D
+         DO_3DS_00_00( jpk-2, 1, -1 )
+            pt(ji,jj,jk,jn,Kaa) = ( pt(ji,jj,jk,jn,Kaa) - zws(ji,jj,jk) * pt(ji,jj,jk+1,jn,Kaa) )   &
+               &             / zwt(ji,jj,jk) * tmask(ji,jj,jk)
+         END_3D
          !                                            ! ================= !
       END DO                                          !  end tracer loop  !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/zpshde.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/zpshde.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/zpshde.F90	(revision 12928)
@@ -31,5 +31,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -39,5 +39,5 @@
 CONTAINS
 
-   SUBROUTINE zps_hde( kt, kjpt, pta, pgtu, pgtv,   &
+   SUBROUTINE zps_hde( kt, Kmm, kjpt, pta, pgtu, pgtv,   &
       &                          prd, pgru, pgrv    )
       !!----------------------------------------------------------------------
@@ -85,4 +85,5 @@
       !!----------------------------------------------------------------------
       INTEGER                              , INTENT(in   )           ::  kt          ! ocean time-step index
+      INTEGER                              , INTENT(in   )           ::  Kmm         ! ocean time level index
       INTEGER                              , INTENT(in   )           ::  kjpt        ! number of tracers
       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   )           ::  pta         ! 4D tracers fields
@@ -105,43 +106,41 @@
       DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!
          !
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               iku = mbku(ji,jj)   ;   ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points
-               ikv = mbkv(ji,jj)   ;   ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1
-!!gm BUG ? when applied to before fields, e3w_b should be used....
-               ze3wu = e3w_n(ji+1,jj  ,iku) - e3w_n(ji,jj,iku)
-               ze3wv = e3w_n(ji  ,jj+1,ikv) - e3w_n(ji,jj,ikv)
-               !
-               ! i- direction
-               IF( ze3wu >= 0._wp ) THEN      ! case 1
-                  zmaxu =  ze3wu / e3w_n(ji+1,jj,iku)
-                  ! interpolated values of tracers
-                  zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) )
-                  ! gradient of  tracers
-                  pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
-               ELSE                           ! case 2
-                  zmaxu = -ze3wu / e3w_n(ji,jj,iku)
-                  ! interpolated values of tracers
-                  zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) )
-                  ! gradient of tracers
-                  pgtu(ji,jj,jn) = umask(ji,jj,1) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )
-               ENDIF
-               !
-               ! j- direction
-               IF( ze3wv >= 0._wp ) THEN      ! case 1
-                  zmaxv =  ze3wv / e3w_n(ji,jj+1,ikv)
-                  ! interpolated values of tracers
-                  ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) )
-                  ! gradient of tracers
-                  pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )
-               ELSE                           ! case 2
-                  zmaxv =  -ze3wv / e3w_n(ji,jj,ikv)
-                  ! interpolated values of tracers
-                  ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) )
-                  ! gradient of tracers
-                  pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) )
-               ENDIF
-            END DO
-         END DO
+         DO_2D_10_10
+            iku = mbku(ji,jj)   ;   ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points
+            ikv = mbkv(ji,jj)   ;   ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1
+!!gm BUG ? when applied to before fields, e3w(:,:,:,Kbb) should be used....
+            ze3wu = e3w(ji+1,jj  ,iku,Kmm) - e3w(ji,jj,iku,Kmm)
+            ze3wv = e3w(ji  ,jj+1,ikv,Kmm) - e3w(ji,jj,ikv,Kmm)
+            !
+            ! i- direction
+            IF( ze3wu >= 0._wp ) THEN      ! case 1
+               zmaxu =  ze3wu / e3w(ji+1,jj,iku,Kmm)
+               ! interpolated values of tracers
+               zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) )
+               ! gradient of  tracers
+               pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
+            ELSE                           ! case 2
+               zmaxu = -ze3wu / e3w(ji,jj,iku,Kmm)
+               ! interpolated values of tracers
+               zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) )
+               ! gradient of tracers
+               pgtu(ji,jj,jn) = umask(ji,jj,1) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )
+            ENDIF
+            !
+            ! j- direction
+            IF( ze3wv >= 0._wp ) THEN      ! case 1
+               zmaxv =  ze3wv / e3w(ji,jj+1,ikv,Kmm)
+               ! interpolated values of tracers
+               ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) )
+               ! gradient of tracers
+               pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )
+            ELSE                           ! case 2
+               zmaxv =  -ze3wv / e3w(ji,jj,ikv,Kmm)
+               ! interpolated values of tracers
+               ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) )
+               ! gradient of tracers
+               pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) )
+            ENDIF
+         END_2D
       END DO
       !
@@ -151,36 +150,32 @@
          pgru(:,:) = 0._wp
          pgrv(:,:) = 0._wp                ! depth of the partial step level
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               iku = mbku(ji,jj)
-               ikv = mbkv(ji,jj)
-               ze3wu  = e3w_n(ji+1,jj  ,iku) - e3w_n(ji,jj,iku)
-               ze3wv  = e3w_n(ji  ,jj+1,ikv) - e3w_n(ji,jj,ikv)
-               IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept_n(ji  ,jj,iku)     ! i-direction: case 1
-               ELSE                        ;   zhi(ji,jj) = gdept_n(ji+1,jj,iku)     ! -     -      case 2
-               ENDIF
-               IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept_n(ji,jj  ,ikv)     ! j-direction: case 1
-               ELSE                        ;   zhj(ji,jj) = gdept_n(ji,jj+1,ikv)     ! -     -      case 2
-               ENDIF
-            END DO
-         END DO
+         DO_2D_10_10
+            iku = mbku(ji,jj)
+            ikv = mbkv(ji,jj)
+            ze3wu  = e3w(ji+1,jj  ,iku,Kmm) - e3w(ji,jj,iku,Kmm)
+            ze3wv  = e3w(ji  ,jj+1,ikv,Kmm) - e3w(ji,jj,ikv,Kmm)
+            IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept(ji  ,jj,iku,Kmm)     ! i-direction: case 1
+            ELSE                        ;   zhi(ji,jj) = gdept(ji+1,jj,iku,Kmm)     ! -     -      case 2
+            ENDIF
+            IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept(ji,jj  ,ikv,Kmm)     ! j-direction: case 1
+            ELSE                        ;   zhj(ji,jj) = gdept(ji,jj+1,ikv,Kmm)     ! -     -      case 2
+            ENDIF
+         END_2D
          !
          CALL eos( zti, zhi, zri )        ! interpolated density from zti, ztj 
          CALL eos( ztj, zhj, zrj )        ! at the partial step depth output in  zri, zrj 
          !
-         DO jj = 1, jpjm1                 ! Gradient of density at the last level 
-            DO ji = 1, jpim1
-               iku = mbku(ji,jj)
-               ikv = mbkv(ji,jj)
-               ze3wu  = e3w_n(ji+1,jj  ,iku) - e3w_n(ji,jj,iku)
-               ze3wv  = e3w_n(ji  ,jj+1,ikv) - e3w_n(ji,jj,ikv)
-               IF( ze3wu >= 0._wp ) THEN   ;   pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji  ,jj    ) - prd(ji,jj,iku) )   ! i: 1
-               ELSE                        ;   pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj    ) )   ! i: 2
-               ENDIF
-               IF( ze3wv >= 0._wp ) THEN   ;   pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj      ) - prd(ji,jj,ikv) )   ! j: 1
-               ELSE                        ;   pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj    ) )   ! j: 2
-               ENDIF
-            END DO
-         END DO
+         DO_2D_10_10
+            iku = mbku(ji,jj)
+            ikv = mbkv(ji,jj)
+            ze3wu  = e3w(ji+1,jj  ,iku,Kmm) - e3w(ji,jj,iku,Kmm)
+            ze3wv  = e3w(ji  ,jj+1,ikv,Kmm) - e3w(ji,jj,ikv,Kmm)
+            IF( ze3wu >= 0._wp ) THEN   ;   pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji  ,jj    ) - prd(ji,jj,iku) )   ! i: 1
+            ELSE                        ;   pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj    ) )   ! i: 2
+            ENDIF
+            IF( ze3wv >= 0._wp ) THEN   ;   pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj      ) - prd(ji,jj,ikv) )   ! j: 1
+            ELSE                        ;   pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj    ) )   ! j: 2
+            ENDIF
+         END_2D
          CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1. , pgrv , 'V', -1. )   ! Lateral boundary conditions
          !
@@ -192,5 +187,5 @@
 
 
-   SUBROUTINE zps_hde_isf( kt, kjpt, pta, pgtu, pgtv, pgtui, pgtvi,  &
+   SUBROUTINE zps_hde_isf( kt, Kmm, kjpt, pta, pgtu, pgtv, pgtui, pgtvi,  &
       &                          prd, pgru, pgrv, pgrui, pgrvi )
       !!----------------------------------------------------------------------
@@ -241,4 +236,5 @@
       !!----------------------------------------------------------------------
       INTEGER                              , INTENT(in   )           ::  kt           ! ocean time-step index
+      INTEGER                              , INTENT(in   )           ::  Kmm          ! ocean time level index
       INTEGER                              , INTENT(in   )           ::  kjpt         ! number of tracers
       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   )           ::  pta          ! 4D tracers fields
@@ -265,44 +261,42 @@
       DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!
          !
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-
-               iku = mbku(ji,jj); ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points
-               ikv = mbkv(ji,jj); ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1
-               ze3wu = gdept_n(ji+1,jj,iku) - gdept_n(ji,jj,iku)
-               ze3wv = gdept_n(ji,jj+1,ikv) - gdept_n(ji,jj,ikv)
-               !
-               ! i- direction
-               IF( ze3wu >= 0._wp ) THEN      ! case 1
-                  zmaxu =  ze3wu / e3w_n(ji+1,jj,iku)
-                  ! interpolated values of tracers
-                  zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) )
-                  ! gradient of  tracers
-                  pgtu(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
-               ELSE                           ! case 2
-                  zmaxu = -ze3wu / e3w_n(ji,jj,iku)
-                  ! interpolated values of tracers
-                  zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) )
-                  ! gradient of tracers
-                  pgtu(ji,jj,jn) = ssumask(ji,jj) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )
-               ENDIF
-               !
-               ! j- direction
-               IF( ze3wv >= 0._wp ) THEN      ! case 1
-                  zmaxv =  ze3wv / e3w_n(ji,jj+1,ikv)
-                  ! interpolated values of tracers
-                  ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) )
-                  ! gradient of tracers
-                  pgtv(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )
-               ELSE                           ! case 2
-                  zmaxv =  -ze3wv / e3w_n(ji,jj,ikv)
-                  ! interpolated values of tracers
-                  ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) )
-                  ! gradient of tracers
-                  pgtv(ji,jj,jn) = ssvmask(ji,jj) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) )
-               ENDIF
-
-            END DO
-         END DO
+         DO_2D_10_10
+
+            iku = mbku(ji,jj); ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points
+            ikv = mbkv(ji,jj); ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1
+            ze3wu = gdept(ji+1,jj,iku,Kmm) - gdept(ji,jj,iku,Kmm)
+            ze3wv = gdept(ji,jj+1,ikv,Kmm) - gdept(ji,jj,ikv,Kmm)
+            !
+            ! i- direction
+            IF( ze3wu >= 0._wp ) THEN      ! case 1
+               zmaxu =  ze3wu / e3w(ji+1,jj,iku,Kmm)
+               ! interpolated values of tracers
+               zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) )
+               ! gradient of  tracers
+               pgtu(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
+            ELSE                           ! case 2
+               zmaxu = -ze3wu / e3w(ji,jj,iku,Kmm)
+               ! interpolated values of tracers
+               zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) )
+               ! gradient of tracers
+               pgtu(ji,jj,jn) = ssumask(ji,jj) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )
+            ENDIF
+            !
+            ! j- direction
+            IF( ze3wv >= 0._wp ) THEN      ! case 1
+               zmaxv =  ze3wv / e3w(ji,jj+1,ikv,Kmm)
+               ! interpolated values of tracers
+               ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) )
+               ! gradient of tracers
+               pgtv(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )
+            ELSE                           ! case 2
+               zmaxv =  -ze3wv / e3w(ji,jj,ikv,Kmm)
+               ! interpolated values of tracers
+               ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) )
+               ! gradient of tracers
+               pgtv(ji,jj,jn) = ssvmask(ji,jj) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) )
+            ENDIF
+
+         END_2D
       END DO
       !
@@ -313,21 +307,19 @@
          pgru(:,:)=0.0_wp   ; pgrv(:,:)=0.0_wp ; 
          !
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-
-               iku = mbku(ji,jj)
-               ikv = mbkv(ji,jj)
-               ze3wu = gdept_n(ji+1,jj,iku) - gdept_n(ji,jj,iku)
-               ze3wv = gdept_n(ji,jj+1,ikv) - gdept_n(ji,jj,ikv)
-               !
-               IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept_n(ji  ,jj,iku)    ! i-direction: case 1
-               ELSE                        ;   zhi(ji,jj) = gdept_n(ji+1,jj,iku)    ! -     -      case 2
-               ENDIF
-               IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept_n(ji,jj  ,ikv)    ! j-direction: case 1
-               ELSE                        ;   zhj(ji,jj) = gdept_n(ji,jj+1,ikv)    ! -     -      case 2
-               ENDIF
-
-            END DO
-         END DO
+         DO_2D_10_10
+
+            iku = mbku(ji,jj)
+            ikv = mbkv(ji,jj)
+            ze3wu = gdept(ji+1,jj,iku,Kmm) - gdept(ji,jj,iku,Kmm)
+            ze3wv = gdept(ji,jj+1,ikv,Kmm) - gdept(ji,jj,ikv,Kmm)
+            !
+            IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept(ji  ,jj,iku,Kmm)    ! i-direction: case 1
+            ELSE                        ;   zhi(ji,jj) = gdept(ji+1,jj,iku,Kmm)    ! -     -      case 2
+            ENDIF
+            IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept(ji,jj  ,ikv,Kmm)    ! j-direction: case 1
+            ELSE                        ;   zhj(ji,jj) = gdept(ji,jj+1,ikv,Kmm)    ! -     -      case 2
+            ENDIF
+
+         END_2D
 
          ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial
@@ -336,20 +328,18 @@
          CALL eos( ztj, zhj, zrj )
 
-         DO jj = 1, jpjm1                 ! Gradient of density at the last level 
-            DO ji = 1, jpim1
-               iku = mbku(ji,jj)
-               ikv = mbkv(ji,jj)
-               ze3wu = gdept_n(ji+1,jj,iku) - gdept_n(ji,jj,iku)
-               ze3wv = gdept_n(ji,jj+1,ikv) - gdept_n(ji,jj,ikv)
-
-               IF( ze3wu >= 0._wp ) THEN   ;   pgru(ji,jj) = ssumask(ji,jj) * ( zri(ji  ,jj    ) - prd(ji,jj,iku) )   ! i: 1
-               ELSE                        ;   pgru(ji,jj) = ssumask(ji,jj) * ( prd(ji+1,jj,iku) - zri(ji,jj    ) )   ! i: 2
-               ENDIF
-               IF( ze3wv >= 0._wp ) THEN   ;   pgrv(ji,jj) = ssvmask(ji,jj) * ( zrj(ji,jj      ) - prd(ji,jj,ikv) )   ! j: 1
-               ELSE                        ;   pgrv(ji,jj) = ssvmask(ji,jj) * ( prd(ji,jj+1,ikv) - zrj(ji,jj    ) )   ! j: 2
-               ENDIF
-
-            END DO
-         END DO
+         DO_2D_10_10
+            iku = mbku(ji,jj)
+            ikv = mbkv(ji,jj)
+            ze3wu = gdept(ji+1,jj,iku,Kmm) - gdept(ji,jj,iku,Kmm)
+            ze3wv = gdept(ji,jj+1,ikv,Kmm) - gdept(ji,jj,ikv,Kmm)
+
+            IF( ze3wu >= 0._wp ) THEN   ;   pgru(ji,jj) = ssumask(ji,jj) * ( zri(ji  ,jj    ) - prd(ji,jj,iku) )   ! i: 1
+            ELSE                        ;   pgru(ji,jj) = ssumask(ji,jj) * ( prd(ji+1,jj,iku) - zri(ji,jj    ) )   ! i: 2
+            ENDIF
+            IF( ze3wv >= 0._wp ) THEN   ;   pgrv(ji,jj) = ssvmask(ji,jj) * ( zrj(ji,jj      ) - prd(ji,jj,ikv) )   ! j: 1
+            ELSE                        ;   pgrv(ji,jj) = ssvmask(ji,jj) * ( prd(ji,jj+1,ikv) - zrj(ji,jj    ) )   ! j: 2
+            ENDIF
+
+         END_2D
 
          CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1. , pgrv , 'V', -1. )   ! Lateral boundary conditions
@@ -360,48 +350,46 @@
       !
       DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!            !
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               iku = miku(ji,jj); ikup1 = miku(ji,jj) + 1
-               ikv = mikv(ji,jj); ikvp1 = mikv(ji,jj) + 1
-               !
-               ! (ISF) case partial step top and bottom in adjacent cell in vertical
-               ! cannot used e3w because if 2 cell water column, we have ps at top and bottom
-               ! in this case e3w(i,j) - e3w(i,j+1) is not the distance between Tj~ and Tj
-               ! the only common depth between cells (i,j) and (i,j+1) is gdepw_0
-               ze3wu  =  gdept_n(ji,jj,iku) - gdept_n(ji+1,jj,iku)
-               ze3wv  =  gdept_n(ji,jj,ikv) - gdept_n(ji,jj+1,ikv) 
-
-               ! i- direction
-               IF( ze3wu >= 0._wp ) THEN      ! case 1
-                  zmaxu = ze3wu / e3w_n(ji+1,jj,ikup1)
-                  ! interpolated values of tracers
-                  zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikup1,jn) - pta(ji+1,jj,iku,jn) )
-                  ! gradient of tracers
-                  pgtui(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
-               ELSE                           ! case 2
-                  zmaxu = - ze3wu / e3w_n(ji,jj,ikup1)
-                  ! interpolated values of tracers
-                  zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikup1,jn) - pta(ji,jj,iku,jn) )
-                  ! gradient of  tracers
-                  pgtui(ji,jj,jn) = ssumask(ji,jj) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )
-               ENDIF
-               !
-               ! j- direction
-               IF( ze3wv >= 0._wp ) THEN      ! case 1
-                  zmaxv =  ze3wv / e3w_n(ji,jj+1,ikvp1)
-                  ! interpolated values of tracers
-                  ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvp1,jn) - pta(ji,jj+1,ikv,jn) )
-                  ! gradient of tracers
-                  pgtvi(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )
-               ELSE                           ! case 2
-                  zmaxv =  - ze3wv / e3w_n(ji,jj,ikvp1)
-                  ! interpolated values of tracers
-                  ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvp1,jn) - pta(ji,jj,ikv,jn) )
-                  ! gradient of tracers
-                  pgtvi(ji,jj,jn) = ssvmask(ji,jj) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) )
-               ENDIF
-
-            END DO
-         END DO
+         DO_2D_10_10
+            iku = miku(ji,jj); ikup1 = miku(ji,jj) + 1
+            ikv = mikv(ji,jj); ikvp1 = mikv(ji,jj) + 1
+            !
+            ! (ISF) case partial step top and bottom in adjacent cell in vertical
+            ! cannot used e3w because if 2 cell water column, we have ps at top and bottom
+            ! in this case e3w(i,j) - e3w(i,j+1) is not the distance between Tj~ and Tj
+            ! the only common depth between cells (i,j) and (i,j+1) is gdepw_0
+            ze3wu  =  gdept(ji,jj,iku,Kmm) - gdept(ji+1,jj,iku,Kmm)
+            ze3wv  =  gdept(ji,jj,ikv,Kmm) - gdept(ji,jj+1,ikv,Kmm) 
+
+            ! i- direction
+            IF( ze3wu >= 0._wp ) THEN      ! case 1
+               zmaxu = ze3wu / e3w(ji+1,jj,ikup1,Kmm)
+               ! interpolated values of tracers
+               zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikup1,jn) - pta(ji+1,jj,iku,jn) )
+               ! gradient of tracers
+               pgtui(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
+            ELSE                           ! case 2
+               zmaxu = - ze3wu / e3w(ji,jj,ikup1,Kmm)
+               ! interpolated values of tracers
+               zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikup1,jn) - pta(ji,jj,iku,jn) )
+               ! gradient of  tracers
+               pgtui(ji,jj,jn) = ssumask(ji,jj) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )
+            ENDIF
+            !
+            ! j- direction
+            IF( ze3wv >= 0._wp ) THEN      ! case 1
+               zmaxv =  ze3wv / e3w(ji,jj+1,ikvp1,Kmm)
+               ! interpolated values of tracers
+               ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvp1,jn) - pta(ji,jj+1,ikv,jn) )
+               ! gradient of tracers
+               pgtvi(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )
+            ELSE                           ! case 2
+               zmaxv =  - ze3wv / e3w(ji,jj,ikvp1,Kmm)
+               ! interpolated values of tracers
+               ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvp1,jn) - pta(ji,jj,ikv,jn) )
+               ! gradient of tracers
+               pgtvi(ji,jj,jn) = ssvmask(ji,jj) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) )
+            ENDIF
+
+         END_2D
          !
       END DO
@@ -411,42 +399,38 @@
          !
          pgrui(:,:)  =0.0_wp; pgrvi(:,:)  =0.0_wp;
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-
-               iku = miku(ji,jj)
-               ikv = mikv(ji,jj)
-               ze3wu  =  gdept_n(ji,jj,iku) - gdept_n(ji+1,jj,iku)
-               ze3wv  =  gdept_n(ji,jj,ikv) - gdept_n(ji,jj+1,ikv) 
-               !
-               IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept_n(ji  ,jj,iku)    ! i-direction: case 1
-               ELSE                        ;   zhi(ji,jj) = gdept_n(ji+1,jj,iku)    ! -     -      case 2
-               ENDIF
-
-               IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept_n(ji,jj  ,ikv)    ! j-direction: case 1
-               ELSE                        ;   zhj(ji,jj) = gdept_n(ji,jj+1,ikv)    ! -     -      case 2
-               ENDIF
-
-            END DO
-         END DO
+         DO_2D_10_10
+
+            iku = miku(ji,jj)
+            ikv = mikv(ji,jj)
+            ze3wu  =  gdept(ji,jj,iku,Kmm) - gdept(ji+1,jj,iku,Kmm)
+            ze3wv  =  gdept(ji,jj,ikv,Kmm) - gdept(ji,jj+1,ikv,Kmm) 
+            !
+            IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept(ji  ,jj,iku,Kmm)    ! i-direction: case 1
+            ELSE                        ;   zhi(ji,jj) = gdept(ji+1,jj,iku,Kmm)    ! -     -      case 2
+            ENDIF
+
+            IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept(ji,jj  ,ikv,Kmm)    ! j-direction: case 1
+            ELSE                        ;   zhj(ji,jj) = gdept(ji,jj+1,ikv,Kmm)    ! -     -      case 2
+            ENDIF
+
+         END_2D
          !
          CALL eos( zti, zhi, zri )        ! interpolated density from zti, ztj 
          CALL eos( ztj, zhj, zrj )        ! at the partial step depth output in  zri, zrj 
          !
-         DO jj = 1, jpjm1                 ! Gradient of density at the last level 
-            DO ji = 1, jpim1
-               iku = miku(ji,jj) 
-               ikv = mikv(ji,jj) 
-               ze3wu  =  gdept_n(ji,jj,iku) - gdept_n(ji+1,jj,iku)
-               ze3wv  =  gdept_n(ji,jj,ikv) - gdept_n(ji,jj+1,ikv) 
-
-               IF( ze3wu >= 0._wp ) THEN ; pgrui(ji,jj) = ssumask(ji,jj) * ( zri(ji  ,jj      ) - prd(ji,jj,iku) ) ! i: 1
-               ELSE                      ; pgrui(ji,jj) = ssumask(ji,jj) * ( prd(ji+1,jj  ,iku) - zri(ji,jj    ) ) ! i: 2
-               ENDIF
-               IF( ze3wv >= 0._wp ) THEN ; pgrvi(ji,jj) = ssvmask(ji,jj) * ( zrj(ji  ,jj      ) - prd(ji,jj,ikv) ) ! j: 1
-               ELSE                      ; pgrvi(ji,jj) = ssvmask(ji,jj) * ( prd(ji  ,jj+1,ikv) - zrj(ji,jj    ) ) ! j: 2
-               ENDIF
-
-            END DO
-         END DO
+         DO_2D_10_10
+            iku = miku(ji,jj) 
+            ikv = mikv(ji,jj) 
+            ze3wu  =  gdept(ji,jj,iku,Kmm) - gdept(ji+1,jj,iku,Kmm)
+            ze3wv  =  gdept(ji,jj,ikv,Kmm) - gdept(ji,jj+1,ikv,Kmm) 
+
+            IF( ze3wu >= 0._wp ) THEN ; pgrui(ji,jj) = ssumask(ji,jj) * ( zri(ji  ,jj      ) - prd(ji,jj,iku) ) ! i: 1
+            ELSE                      ; pgrui(ji,jj) = ssumask(ji,jj) * ( prd(ji+1,jj  ,iku) - zri(ji,jj    ) ) ! i: 2
+            ENDIF
+            IF( ze3wv >= 0._wp ) THEN ; pgrvi(ji,jj) = ssvmask(ji,jj) * ( zrj(ji  ,jj      ) - prd(ji,jj,ikv) ) ! j: 1
+            ELSE                      ; pgrvi(ji,jj) = ssvmask(ji,jj) * ( prd(ji  ,jj+1,ikv) - zrj(ji,jj    ) ) ! j: 2
+            ENDIF
+
+         END_2D
          CALL lbc_lnk_multi( 'zpshde', pgrui, 'U', -1. , pgrvi, 'V', -1. )   ! Lateral boundary conditions
          !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRD/trddyn.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRD/trddyn.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRD/trddyn.F90	(revision 12928)
@@ -36,5 +36,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -44,5 +44,5 @@
 CONTAINS
 
-   SUBROUTINE trd_dyn( putrd, pvtrd, ktrd, kt )
+   SUBROUTINE trd_dyn( putrd, pvtrd, ktrd, kt, Kmm )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE trd_mod  ***
@@ -55,4 +55,5 @@
       INTEGER                   , INTENT(in   ) ::   ktrd           ! trend index
       INTEGER                   , INTENT(in   ) ::   kt             ! time step
+      INTEGER                   , INTENT(in   ) ::   Kmm            ! time level index
       !!----------------------------------------------------------------------
       !
@@ -66,20 +67,20 @@
       !   3D output of momentum and/or tracers trends using IOM interface
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-      IF( ln_dyn_trd )   CALL trd_dyn_iom( putrd, pvtrd, ktrd, kt )
+      IF( ln_dyn_trd )   CALL trd_dyn_iom( putrd, pvtrd, ktrd, kt, Kmm )
          
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
       !  Integral Constraints Properties for momentum and/or tracers trends
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-      IF( ln_glo_trd )   CALL trd_glo( putrd, pvtrd, ktrd, 'DYN', kt )
+      IF( ln_glo_trd )   CALL trd_glo( putrd, pvtrd, ktrd, 'DYN', kt, Kmm )
 
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
       !  Kinetic Energy trends
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      IF( ln_KE_trd  )   CALL trd_ken( putrd, pvtrd, ktrd, kt )
+      IF( ln_KE_trd  )   CALL trd_ken( putrd, pvtrd, ktrd, kt, Kmm )
 
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
       !  Vorticity trends
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      IF( ln_vor_trd )   CALL trd_vor( putrd, pvtrd, ktrd, kt )
+      IF( ln_vor_trd )   CALL trd_vor( putrd, pvtrd, ktrd, kt, Kmm )
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -91,5 +92,5 @@
 
 
-   SUBROUTINE trd_dyn_iom( putrd, pvtrd, ktrd, kt )
+   SUBROUTINE trd_dyn_iom( putrd, pvtrd, ktrd, kt, Kmm )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE trd_dyn_iom  ***
@@ -100,4 +101,5 @@
       INTEGER                   , INTENT(in   ) ::   ktrd           ! trend index
       INTEGER                   , INTENT(in   ) ::   kt             ! time step
+      INTEGER                   , INTENT(in   ) ::   Kmm            ! time level index
       !
       INTEGER ::   ji, jj, jk   ! dummy loop indices
@@ -121,12 +123,8 @@
                               z3dx(:,:,:) = 0._wp                  ! U.dxU & V.dyV (approximation)
                               z3dy(:,:,:) = 0._wp
-                              DO jk = 1, jpkm1   ! no mask as un,vn are masked
-                                 DO jj = 2, jpjm1
-                                    DO ji = 2, jpim1
-                                       z3dx(ji,jj,jk) = un(ji,jj,jk) * ( un(ji+1,jj,jk) - un(ji-1,jj,jk) ) / ( 2._wp * e1u(ji,jj) )
-                                       z3dy(ji,jj,jk) = vn(ji,jj,jk) * ( vn(ji,jj+1,jk) - vn(ji,jj-1,jk) ) / ( 2._wp * e2v(ji,jj) )
-                                    END DO
-                                 END DO
-                              END DO
+                              DO_3D_00_00( 1, jpkm1 )
+                                 z3dx(ji,jj,jk) = uu(ji,jj,jk,Kmm) * ( uu(ji+1,jj,jk,Kmm) - uu(ji-1,jj,jk,Kmm) ) / ( 2._wp * e1u(ji,jj) )
+                                 z3dy(ji,jj,jk) = vv(ji,jj,jk,Kmm) * ( vv(ji,jj+1,jk,Kmm) - vv(ji,jj-1,jk,Kmm) ) / ( 2._wp * e2v(ji,jj) )
+                              END_3D
                               CALL lbc_lnk_multi( 'trddyn', z3dx, 'U', -1., z3dy, 'V', -1. )
                               CALL iom_put( "utrd_udx", z3dx  )
@@ -142,6 +140,6 @@
                               !                                    ! wind stress trends
                               ALLOCATE( z2dx(jpi,jpj) , z2dy(jpi,jpj) )
-                              z2dx(:,:) = ( utau_b(:,:) + utau(:,:) ) / ( e3u_n(:,:,1) * rau0 )
-                              z2dy(:,:) = ( vtau_b(:,:) + vtau(:,:) ) / ( e3v_n(:,:,1) * rau0 )
+                              z2dx(:,:) = ( utau_b(:,:) + utau(:,:) ) / ( e3u(:,:,1,Kmm) * rho0 )
+                              z2dy(:,:) = ( vtau_b(:,:) + vtau(:,:) ) / ( e3v(:,:,1,Kmm) * rho0 )
                               CALL iom_put( "utrd_tau", z2dx )
                               CALL iom_put( "vtrd_tau", z2dy )
@@ -159,7 +157,7 @@
 !                                          ikbv = mbkv(ji,jj)
 !                                          z3dx(ji,jj,jk) = 0.5 * ( rCdU_bot(ji+1,jj) + rCdU_bot(ji,jj) ) & 
-!                                               &         * un(ji,jj,ikbu) / e3u_n(ji,jj,ikbu)
+!                                               &         * uu(ji,jj,ikbu,Kmm) / e3u(ji,jj,ikbu,Kmm)
 !                                          z3dy(ji,jj,jk) = 0.5 * ( rCdU_bot(ji,jj+1) + rCdU_bot(ji,jj) ) &
-!                                               &         * vn(ji,jj,ikbv) / e3v_n(ji,jj,ikbv)
+!                                               &         * vv(ji,jj,ikbv,Kmm) / e3v(ji,jj,ikbv,Kmm)
 !                                    END DO
 !                                 END DO
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRD/trdglo.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRD/trdglo.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRD/trdglo.F90	(revision 12928)
@@ -51,5 +51,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -59,5 +59,5 @@
 CONTAINS
 
-   SUBROUTINE trd_glo( ptrdx, ptrdy, ktrd, ctype, kt )
+   SUBROUTINE trd_glo( ptrdx, ptrdy, ktrd, ctype, kt, Kmm )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE trd_glo  ***
@@ -72,8 +72,9 @@
       CHARACTER(len=3)          , INTENT(in   ) ::   ctype   ! momentum or tracers trends type (='DYN'/'TRA')
       INTEGER                   , INTENT(in   ) ::   kt      ! time step
+      INTEGER                   , INTENT(in   ) ::   Kmm     ! time level index
       !!
       INTEGER ::   ji, jj, jk      ! dummy loop indices
       INTEGER ::   ikbu, ikbv      ! local integers
-      REAL(wp)::   zvm, zvt, zvs, z1_2rau0   ! local scalars
+      REAL(wp)::   zvm, zvt, zvs, z1_2rho0   ! local scalars
       REAL(wp), DIMENSION(jpi,jpj)  :: ztswu, ztswv, z2dx, z2dy   ! 2D workspace 
       !!----------------------------------------------------------------------
@@ -84,23 +85,19 @@
       	!
       	CASE( 'TRA' )          !==  Tracers (T & S)  ==!
-      	   DO jk = 1, jpkm1       ! global sum of mask volume trend and trend*T (including interior mask)
-      	      DO jj = 1, jpj
-      	         DO ji = 1, jpi        
-      	            zvm = e1e2t(ji,jj) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
-      	            zvt = ptrdx(ji,jj,jk) * zvm
-      	            zvs = ptrdy(ji,jj,jk) * zvm
-         	         tmo(ktrd) = tmo(ktrd) + zvt   
-         	         smo(ktrd) = smo(ktrd) + zvs
-         	         t2 (ktrd) = t2(ktrd)  + zvt * tsn(ji,jj,jk,jp_tem)
-         	         s2 (ktrd) = s2(ktrd)  + zvs * tsn(ji,jj,jk,jp_sal)
-                  END DO
-               END DO
-            END DO
+      	   DO_3D_11_11( 1, jpkm1 )
+	            zvm = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) * tmask_i(ji,jj)
+	            zvt = ptrdx(ji,jj,jk) * zvm
+	            zvs = ptrdy(ji,jj,jk) * zvm
+   	         tmo(ktrd) = tmo(ktrd) + zvt   
+   	         smo(ktrd) = smo(ktrd) + zvs
+   	         t2 (ktrd) = t2(ktrd)  + zvt * ts(ji,jj,jk,jp_tem,Kmm)
+   	         s2 (ktrd) = s2(ktrd)  + zvs * ts(ji,jj,jk,jp_sal,Kmm)
+      	   END_3D
             !                       ! linear free surface: diagnose advective flux trough the fixed k=1 w-surface
             IF( ln_linssh .AND. ktrd == jptra_zad ) THEN  
-               tmo(jptra_sad) = SUM( wn(:,:,1) * tsn(:,:,1,jp_tem) * e1e2t(:,:) * tmask_i(:,:) )
-               smo(jptra_sad) = SUM( wn(:,:,1) * tsn(:,:,1,jp_sal) * e1e2t(:,:) * tmask_i(:,:)  )
-               t2 (jptra_sad) = SUM( wn(:,:,1) * tsn(:,:,1,jp_tem) * tsn(:,:,1,jp_tem) * e1e2t(:,:) * tmask_i(:,:)  )
-               s2 (jptra_sad) = SUM( wn(:,:,1) * tsn(:,:,1,jp_sal) * tsn(:,:,1,jp_sal) * e1e2t(:,:) * tmask_i(:,:)  )
+               tmo(jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_tem,Kmm) * e1e2t(:,:) * tmask_i(:,:) )
+               smo(jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_sal,Kmm) * e1e2t(:,:) * tmask_i(:,:)  )
+               t2 (jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_tem,Kmm) * ts(:,:,1,jp_tem,Kmm) * e1e2t(:,:) * tmask_i(:,:)  )
+               s2 (jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_sal,Kmm) * ts(:,:,1,jp_sal,Kmm) * e1e2t(:,:) * tmask_i(:,:)  )
             ENDIF
             !
@@ -117,31 +114,25 @@
             !
          CASE( 'DYN' )          !==  Momentum and KE  ==!        
-            DO jk = 1, jpkm1
-               DO jj = 1, jpjm1
-                  DO ji = 1, jpim1
-                     zvt = ptrdx(ji,jj,jk) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk)   &
-                        &                                     * e1e2u  (ji,jj) * e3u_n(ji,jj,jk)
-                     zvs = ptrdy(ji,jj,jk) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)   &
-                        &                                     * e1e2v  (ji,jj) * e3u_n(ji,jj,jk)
-                     umo(ktrd) = umo(ktrd) + zvt
-                     vmo(ktrd) = vmo(ktrd) + zvs
-                     hke(ktrd) = hke(ktrd) + un(ji,jj,jk) * zvt + vn(ji,jj,jk) * zvs
-                  END DO
-               END DO
-            END DO
+            DO_3D_10_10( 1, jpkm1 )
+               zvt = ptrdx(ji,jj,jk) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk)   &
+                  &                                     * e1e2u  (ji,jj) * e3u(ji,jj,jk,Kmm)
+               zvs = ptrdy(ji,jj,jk) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)   &
+                  &                                     * e1e2v  (ji,jj) * e3u(ji,jj,jk,Kmm)
+               umo(ktrd) = umo(ktrd) + zvt
+               vmo(ktrd) = vmo(ktrd) + zvs
+               hke(ktrd) = hke(ktrd) + uu(ji,jj,jk,Kmm) * zvt + vv(ji,jj,jk,Kmm) * zvs
+            END_3D
             !                 
             IF( ktrd == jpdyn_zdf ) THEN      ! zdf trend: compute separately the surface forcing trend
-               z1_2rau0 = 0.5_wp / rau0
-               DO jj = 1, jpjm1
-                  DO ji = 1, jpim1
-                     zvt = ( utau_b(ji,jj) + utau(ji,jj) ) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk)   &
-                        &                                                     * z1_2rau0       * e1e2u(ji,jj)
-                     zvs = ( vtau_b(ji,jj) + vtau(ji,jj) ) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)   &
-                        &                                                     * z1_2rau0       * e1e2v(ji,jj)
-                     umo(jpdyn_tau) = umo(jpdyn_tau) + zvt
-                     vmo(jpdyn_tau) = vmo(jpdyn_tau) + zvs
-                     hke(jpdyn_tau) = hke(jpdyn_tau) + un(ji,jj,1) * zvt + vn(ji,jj,1) * zvs
-                  END DO
-               END DO
+               z1_2rho0 = 0.5_wp / rho0
+               DO_2D_10_10
+                  zvt = ( utau_b(ji,jj) + utau(ji,jj) ) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk)   &
+                     &                                                     * z1_2rho0       * e1e2u(ji,jj)
+                  zvs = ( vtau_b(ji,jj) + vtau(ji,jj) ) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)   &
+                     &                                                     * z1_2rho0       * e1e2v(ji,jj)
+                  umo(jpdyn_tau) = umo(jpdyn_tau) + zvt
+                  vmo(jpdyn_tau) = vmo(jpdyn_tau) + zvs
+                  hke(jpdyn_tau) = hke(jpdyn_tau) + uu(ji,jj,1,Kmm) * zvt + vv(ji,jj,1,Kmm) * zvs
+               END_2D
             ENDIF
             !                       
@@ -150,14 +141,14 @@
 !               !
 !               IF( ln_drgimp ) THEN                   ! implicit drag case: compute separately the bottom friction 
-!                  z1_2rau0 = 0.5_wp / rau0
+!                  z1_2rho0 = 0.5_wp / rho0
 !                  DO jj = 1, jpjm1
 !                     DO ji = 1, jpim1
 !                        ikbu = mbku(ji,jj)                  ! deepest ocean u- & v-levels
 !                        ikbv = mbkv(ji,jj)
-!                        zvt = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * un(ji,jj,ikbu) * e1e2u(ji,jj)
-!                        zvs = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * vn(ji,jj,ikbv) * e1e2v(ji,jj)
+!                        zvt = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * uu(ji,jj,ikbu,Kmm) * e1e2u(ji,jj)
+!                        zvs = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * vv(ji,jj,ikbv,Kmm) * e1e2v(ji,jj)
 !                        umo(jpdyn_bfri) = umo(jpdyn_bfri) + zvt
 !                        vmo(jpdyn_bfri) = vmo(jpdyn_bfri) + zvs
-!                        hke(jpdyn_bfri) = hke(jpdyn_bfri) + un(ji,jj,ikbu) * zvt + vn(ji,jj,ikbv) * zvs
+!                        hke(jpdyn_bfri) = hke(jpdyn_bfri) + uu(ji,jj,ikbu,Kmm) * zvt + vv(ji,jj,ikbv,Kmm) * zvs
 !                     END DO
 !                  END DO
@@ -183,5 +174,5 @@
 
 
-   SUBROUTINE glo_dyn_wri( kt )
+   SUBROUTINE glo_dyn_wri( kt, Kmm )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE glo_dyn_wri  ***
@@ -190,4 +181,5 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER, INTENT(in) ::   Kmm  ! time level index
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -209,32 +201,24 @@
          zkepe(:,:,:) = 0._wp
    
-         CALL eos( tsn, rhd, rhop )       ! now potential density
-
-         zcof = 0.5_wp / rau0             ! Density flux at w-point
+         CALL eos( ts(:,:,:,:,Kmm), rhd, rhop )       ! now potential density
+
+         zcof = 0.5_wp / rho0             ! Density flux at w-point
          zkz(:,:,1) = 0._wp
          DO jk = 2, jpk
-            zkz(:,:,jk) = zcof * e1e2t(:,:) * wn(:,:,jk) * ( rhop(:,:,jk) + rhop(:,:,jk-1) ) * tmask_i(:,:)
+            zkz(:,:,jk) = zcof * e1e2t(:,:) * ww(:,:,jk) * ( rhop(:,:,jk) + rhop(:,:,jk-1) ) * tmask_i(:,:)
          END DO
          
-         zcof   = 0.5_wp / rau0           ! Density flux at u and v-points
-         DO jk = 1, jpkm1
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  zkx(ji,jj,jk) = zcof * e2u(ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) )
-                  zky(ji,jj,jk) = zcof * e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) )
-               END DO
-            END DO
-         END DO
+         zcof   = 0.5_wp / rho0           ! Density flux at u and v-points
+         DO_3D_10_10( 1, jpkm1 )
+            zkx(ji,jj,jk) = zcof * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) )
+            zky(ji,jj,jk) = zcof * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) )
+         END_3D
          
-         DO jk = 1, jpkm1                 ! Density flux divergence at t-point
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  zkepe(ji,jj,jk) = - (  zkz(ji,jj,jk) - zkz(ji  ,jj  ,jk+1)               &
-                     &                 + zkx(ji,jj,jk) - zkx(ji-1,jj  ,jk  )               &
-                     &                 + zky(ji,jj,jk) - zky(ji  ,jj-1,jk  )   )           &
-                     &              / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) * tmask(ji,jj,jk) * tmask_i(ji,jj)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            zkepe(ji,jj,jk) = - (  zkz(ji,jj,jk) - zkz(ji  ,jj  ,jk+1)               &
+               &                 + zkx(ji,jj,jk) - zkx(ji-1,jj  ,jk  )               &
+               &                 + zky(ji,jj,jk) - zky(ji  ,jj-1,jk  )   )           &
+               &              / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) ) * tmask(ji,jj,jk) * tmask_i(ji,jj)
+         END_3D
 
          ! I.2 Basin averaged kinetic energy trend
@@ -242,5 +226,5 @@
          peke = 0._wp
          DO jk = 1, jpkm1
-            peke = peke + SUM( zkepe(:,:,jk) * gdept_n(:,:,jk) * e1e2t(:,:) * e3t_n(:,:,jk) )
+            peke = peke + SUM( zkepe(:,:,jk) * gdept(:,:,jk,Kmm) * e1e2t(:,:) * e3t(:,:,jk,Kmm) )
          END DO
          peke = grav * peke
@@ -363,5 +347,5 @@
  9546    FORMAT(' 0 < horizontal diffusion                                  : ', e20.13)
  9547    FORMAT(' 0 < vertical diffusion                                    : ', e20.13)
- 9548    FORMAT(' pressure gradient u2 = - 1/rau0 u.dz(rhop)                : ', e20.13, '  u.dz(rhop) =', e20.13)
+ 9548    FORMAT(' pressure gradient u2 = - 1/rho0 u.dz(rhop)                : ', e20.13, '  u.dz(rhop) =', e20.13)
          !
          ! Save potential to kinetic energy conversion for next time step
@@ -506,5 +490,5 @@
 
 
-   SUBROUTINE trd_glo_init
+   SUBROUTINE trd_glo_init( Kmm )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE trd_glo_init  ***
@@ -512,4 +496,5 @@
       !! ** Purpose :   Read the namtrd namelist
       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   Kmm   ! time level index
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
       !!----------------------------------------------------------------------
@@ -524,5 +509,5 @@
       tvolt = 0._wp
       DO jk = 1, jpkm1
-         tvolt = tvolt + SUM( e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) )
+         tvolt = tvolt + SUM( e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) * tmask_i(:,:) )
       END DO
       CALL mpp_sum( 'trdglo', tvolt )   ! sum over the global domain
@@ -538,12 +523,8 @@
       tvolv = 0._wp
 
-      DO jk = 1, jpk
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               tvolu = tvolu + e1u(ji,jj) * e2u(ji,jj) * e3u_n(ji,jj,jk) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk)
-               tvolv = tvolv + e1v(ji,jj) * e2v(ji,jj) * e3v_n(ji,jj,jk) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 1, jpk )
+         tvolu = tvolu + e1u(ji,jj) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk)
+         tvolv = tvolv + e1v(ji,jj) * e2v(ji,jj) * e3v(ji,jj,jk,Kmm) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)
+      END_3D
       CALL mpp_sum( 'trdglo', tvolu )   ! sums over the global domain
       CALL mpp_sum( 'trdglo', tvolv )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRD/trdini.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRD/trdini.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRD/trdini.F90	(revision 12928)
@@ -25,6 +25,4 @@
    PUBLIC   trd_init   ! called by nemogcm.F90 module
 
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -34,5 +32,5 @@
 CONTAINS
 
-   SUBROUTINE trd_init
+   SUBROUTINE trd_init( Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE trd_init  ***
@@ -40,4 +38,5 @@
       !! ** Purpose :   Initialization of trend diagnostics
       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   Kmm  ! time level index
       INTEGER ::   ios   ! local integer
       !!
@@ -46,9 +45,7 @@
       !!----------------------------------------------------------------------
       !
-      REWIND( numnam_ref )              ! Namelist namtrd in reference namelist : trends diagnostic
       READ  ( numnam_ref, namtrd, IOSTAT = ios, ERR = 901 )
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrd in reference namelist' )
       !
-      REWIND( numnam_cfg )              ! Namelist namtrd in configuration namelist : trends diagnostic
       READ  ( numnam_cfg, namtrd, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrd in configuration namelist' )
@@ -96,5 +93,5 @@
 
       !                             ! diagnostic initialization  
-      IF( ln_glo_trd )   CALL trd_glo_init      ! global domain averaged trends
+      IF( ln_glo_trd )   CALL trd_glo_init( Kmm )      ! global domain averaged trends
       IF( ln_tra_mxl )   CALL trd_mxl_init      ! mixed-layer          trends  
       IF( ln_vor_trd )   CALL trd_vor_init      ! barotropic vorticity trends
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRD/trdken.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRD/trdken.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRD/trdken.F90	(revision 12928)
@@ -40,5 +40,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -59,5 +59,5 @@
 
 
-   SUBROUTINE trd_ken( putrd, pvtrd, ktrd, kt )
+   SUBROUTINE trd_ken( putrd, pvtrd, ktrd, kt, Kmm )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE trd_ken  ***
@@ -67,5 +67,5 @@
       !! ** Method  : - apply lbc to the input masked velocity trends 
       !!              - compute the associated KE trend:
-      !!          zke = 0.5 * (  mi-1[ un * putrd * bu ] + mj-1[ vn * pvtrd * bv]  ) / bt
+      !!          zke = 0.5 * (  mi-1[ uu(Kmm) * putrd * bu ] + mj-1[ vv(Kmm) * pvtrd * bv]  ) / bt
       !!      where bu, bv, bt are the volume of u-, v- and t-boxes. 
       !!              - vertical diffusion case (jpdyn_zdf): 
@@ -80,4 +80,5 @@
       INTEGER                   , INTENT(in   ) ::   ktrd           ! trend index
       INTEGER                   , INTENT(in   ) ::   kt             ! time step
+      INTEGER                   , INTENT(in   ) ::   Kmm            ! time level index
       !
       INTEGER ::   ji, jj, jk       ! dummy loop indices
@@ -92,7 +93,7 @@
       nkstp = kt
       DO jk = 1, jpkm1
-         bu   (:,:,jk) =    e1e2u(:,:) * e3u_n(:,:,jk)
-         bv   (:,:,jk) =    e1e2v(:,:) * e3v_n(:,:,jk)
-         r1_bt(:,:,jk) = r1_e1e2t(:,:) / e3t_n(:,:,jk) * tmask(:,:,jk)
+         bu   (:,:,jk) =    e1e2u(:,:) * e3u(:,:,jk,Kmm)
+         bv   (:,:,jk) =    e1e2v(:,:) * e3v(:,:,jk,Kmm)
+         r1_bt(:,:,jk) = r1_e1e2t(:,:) / e3t(:,:,jk,Kmm) * tmask(:,:,jk)
       END DO
       !
@@ -100,14 +101,10 @@
       zke(1,:, : ) = 0._wp
       zke(:,1, : ) = 0._wp
-      DO jk = 1, jpkm1
-         DO jj = 2, jpj
-            DO ji = 2, jpi
-               zke(ji,jj,jk) = 0.5_wp * rau0 *( un(ji  ,jj,jk) * putrd(ji  ,jj,jk) * bu(ji  ,jj,jk)  &
-                  &                           + un(ji-1,jj,jk) * putrd(ji-1,jj,jk) * bu(ji-1,jj,jk)  &
-                  &                           + vn(ji,jj  ,jk) * pvtrd(ji,jj  ,jk) * bv(ji,jj  ,jk)  &
-                  &                           + vn(ji,jj-1,jk) * pvtrd(ji,jj-1,jk) * bv(ji,jj-1,jk)  ) * r1_bt(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D_01_01( 1, jpkm1 )
+         zke(ji,jj,jk) = 0.5_wp * rho0 *( uu(ji  ,jj,jk,Kmm) * putrd(ji  ,jj,jk) * bu(ji  ,jj,jk)  &
+            &                           + uu(ji-1,jj,jk,Kmm) * putrd(ji-1,jj,jk) * bu(ji-1,jj,jk)  &
+            &                           + vv(ji,jj  ,jk,Kmm) * pvtrd(ji,jj  ,jk) * bv(ji,jj  ,jk)  &
+            &                           + vv(ji,jj-1,jk,Kmm) * pvtrd(ji,jj-1,jk) * bv(ji,jj-1,jk)  ) * r1_bt(ji,jj,jk)
+      END_3D
       !
       SELECT CASE( ktrd )
@@ -122,13 +119,11 @@
          !                   !                                          ! wind stress trends
                                  ALLOCATE( z2dx(jpi,jpj) , z2dy(jpi,jpj) , zke2d(jpi,jpj) )
-                           z2dx(:,:) = un(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1e2u(:,:) * umask(:,:,1)
-                           z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1e2v(:,:) * vmask(:,:,1)
+                           z2dx(:,:) = uu(:,:,1,Kmm) * ( utau_b(:,:) + utau(:,:) ) * e1e2u(:,:) * umask(:,:,1)
+                           z2dy(:,:) = vv(:,:,1,Kmm) * ( vtau_b(:,:) + vtau(:,:) ) * e1e2v(:,:) * vmask(:,:,1)
                            zke2d(1,:) = 0._wp   ;   zke2d(:,1) = 0._wp
-                           DO jj = 2, jpj
-                              DO ji = 2, jpi
-                                 zke2d(ji,jj) = r1_rau0 * 0.5_wp * (   z2dx(ji,jj) + z2dx(ji-1,jj)   &
-                                 &                                   + z2dy(ji,jj) + z2dy(ji,jj-1)   ) * r1_bt(ji,jj,1)
-                              END DO
-                           END DO
+                           DO_2D_01_01
+                              zke2d(ji,jj) = r1_rho0 * 0.5_wp * (   z2dx(ji,jj) + z2dx(ji-1,jj)   &
+                              &                                   + z2dy(ji,jj) + z2dy(ji,jj-1)   ) * r1_bt(ji,jj,1)
+                           END_2D
                                  CALL iom_put( "ketrd_tau"   , zke2d )  ! 
                                  DEALLOCATE( z2dx , z2dy , zke2d )
@@ -141,6 +136,6 @@
 !                  ikbu = mbku(ji,jj)         ! deepest ocean u- & v-levels
 !                  ikbv = mbkv(ji,jj)   
-!                  z2dx(ji,jj) = un(ji,jj,ikbu) * bfrua(ji,jj) * un(ji,jj,ikbu)
-!                  z2dy(ji,jj) = vn(ji,jj,ikbu) * bfrva(ji,jj) * vn(ji,jj,ikbv)
+!                  z2dx(ji,jj) = uu(ji,jj,ikbu,Kmm) * bfrua(ji,jj) * uu(ji,jj,ikbu,Kmm)
+!                  z2dy(ji,jj) = vv(ji,jj,ikbu,Kmm) * bfrva(ji,jj) * vv(ji,jj,ikbv,Kmm)
 !               END DO
 !            END DO
@@ -157,5 +152,5 @@
          CASE( jpdyn_atf )   ;   CALL iom_put( "ketrd_atf"   , zke )    ! asselin filter trends 
 !! a faire !!!!  idee changer dynnxt pour avoir un appel a jpdyn_bfr avant le swap !!!
-!! reflechir a une possible sauvegarde du "vrai" un,vn pour le calcul de atf....
+!! reflechir a une possible sauvegarde du "vrai" uu(Kmm),vv(Kmm) pour le calcul de atf....
 !
 !         IF( ln_drgimp ) THEN                                          ! bottom friction (implicit case)
@@ -164,6 +159,6 @@
 !                  ikbu = mbku(ji,jj)          ! deepest ocean u- & v-levels
 !                  ikbv = mbkv(ji,jj)
-!                  z2dx(ji,jj) = un(ji,jj,ikbu) * bfrua(ji,jj) * un(ji,jj,ikbu) / e3u_n(ji,jj,ikbu)
-!                  z2dy(ji,jj) = un(ji,jj,ikbu) * bfrva(ji,jj) * vn(ji,jj,ikbv) / e3v_n(ji,jj,ikbv)
+!                  z2dx(ji,jj) = uu(ji,jj,ikbu,Kmm) * bfrua(ji,jj) * uu(ji,jj,ikbu,Kmm) / e3u(ji,jj,ikbu,Kmm)
+!                  z2dy(ji,jj) = uu(ji,jj,ikbu,Kmm) * bfrva(ji,jj) * vv(ji,jj,ikbv,Kmm) / e3v(ji,jj,ikbv,Kmm)
 !               END DO
 !            END DO
@@ -179,9 +174,9 @@
         CASE( jpdyn_ken )   ;   ! kinetic energy
                     ! called in dynnxt.F90 before asselin time filter
-                    ! with putrd=ua and pvtrd=va
+                    ! with putrd=uu(Krhs) and pvtrd=vv(Krhs)
                     zke(:,:,:) = 0.5_wp * zke(:,:,:)
                     CALL iom_put( "KE", zke )
                     !
-                    CALL ken_p2k( kt , zke )
+                    CALL ken_p2k( kt , zke, Kmm )
                       CALL iom_put( "ketrd_convP2K", zke )     ! conversion -rau*g*w
          !
@@ -191,5 +186,5 @@
 
 
-   SUBROUTINE ken_p2k( kt , pconv )
+   SUBROUTINE ken_p2k( kt , pconv, Kmm )
       !!---------------------------------------------------------------------
       !!                 ***  ROUTINE ken_p2k  ***
@@ -202,4 +197,5 @@
       !!---------------------------------------------------------------------- 
       INTEGER                   , INTENT(in   ) ::   kt      ! ocean time-step index
+      INTEGER                   , INTENT(in   ) ::   Kmm     ! time level index
       REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pconv   ! 
       !
@@ -211,23 +207,19 @@
       !
       ! Local constant initialization 
-      zcoef = - rau0 * grav * 0.5_wp      
+      zcoef = - rho0 * grav * 0.5_wp      
       
       !  Surface value (also valid in partial step case)
-      zconv(:,:,1) = zcoef * ( 2._wp * rhd(:,:,1) ) * wn(:,:,1) * e3w_n(:,:,1)
+      zconv(:,:,1) = zcoef * ( 2._wp * rhd(:,:,1) ) * ww(:,:,1) * e3w(:,:,1,Kmm)
 
       ! interior value (2=<jk=<jpkm1)
       DO jk = 2, jpk
-         zconv(:,:,jk) = zcoef * ( rhd(:,:,jk) + rhd(:,:,jk-1) ) * wn(:,:,jk) * e3w_n(:,:,jk)
+         zconv(:,:,jk) = zcoef * ( rhd(:,:,jk) + rhd(:,:,jk-1) ) * ww(:,:,jk) * e3w(:,:,jk,Kmm)
       END DO
 
       ! conv value on T-point
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zcoef = 0.5_wp / e3t_n(ji,jj,jk)
-               pconv(ji,jj,jk) = zcoef * ( zconv(ji,jj,jk) + zconv(ji,jj,jk+1) ) * tmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpkm1 )
+         zcoef = 0.5_wp / e3t(ji,jj,jk,Kmm)
+         pconv(ji,jj,jk) = zcoef * ( zconv(ji,jj,jk) + zconv(ji,jj,jk+1) ) * tmask(ji,jj,jk)
+      END_3D
       !
    END SUBROUTINE ken_p2k
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRD/trdmxl.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRD/trdmxl.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRD/trdmxl.F90	(revision 12928)
@@ -68,4 +68,6 @@
    INTEGER ::   ionce, icount                   
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -86,5 +88,5 @@
 
 
-   SUBROUTINE trd_tra_mxl( ptrdx, ptrdy, ktrd, kt, p2dt, kmxln )
+   SUBROUTINE trd_tra_mxl( ptrdx, ptrdy, ktrd, kt, p2dt, kmxln, Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE trd_tra_mng  ***
@@ -98,4 +100,5 @@
       INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index
       INTEGER                   , INTENT(in   ) ::   kt      ! time step index
+      INTEGER                   , INTENT(in   ) ::   Kmm     ! time level index
       REAL(wp)                  , INTENT(in   ) ::   p2dt    ! time step  [s]
       REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   kmxln   ! number of t-box for the vertical average 
@@ -116,11 +119,7 @@
          !
          wkx(:,:,:) = 0._wp         !==  now ML weights for vertical averaging  ==!
-         DO jk = 1, jpktrd               ! initialize wkx with vertical scale factor in mixed-layer
-            DO jj = 1,jpj
-               DO ji = 1,jpi
-                  IF( jk - kmxln(ji,jj) < 0 )   wkx(ji,jj,jk) = e3t_n(ji,jj,jk) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, jpktrd )
+            IF( jk - kmxln(ji,jj) < 0 )   wkx(ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk)
+         END_3D
          hmxl(:,:) = 0._wp               ! NOW mixed-layer depth
          DO jk = 1, jpktrd
@@ -136,6 +135,6 @@
          tml(:,:) = 0._wp   ;   sml(:,:) = 0._wp
          DO jk = 1, jpktrd
-            tml(:,:) = tml(:,:) + wkx(:,:,jk) * tsn(:,:,jk,jp_tem)
-            sml(:,:) = sml(:,:) + wkx(:,:,jk) * tsn(:,:,jk,jp_sal)
+            tml(:,:) = tml(:,:) + wkx(:,:,jk) * ts(:,:,jk,jp_tem,Kmm)
+            sml(:,:) = sml(:,:) + wkx(:,:,jk) * ts(:,:,jk,jp_sal,Kmm)
          END DO
          !
@@ -371,5 +370,5 @@
          hmxlbn(:,:) = hmxl(:,:)
 
-         IF( ln_ctl ) THEN
+         IF( sn_cfctl%l_prtctl ) THEN
             WRITE(numout,*) '             we reach kt == nit000 + 1 = ', nit000+1
             CALL prt_ctl(tab2d_1=tmlbb   , clinfo1=' tmlbb   -   : ', mask1=tmask)
@@ -380,5 +379,5 @@
       END IF
 
-      IF( ( ln_rstart ) .AND. ( kt == nit000 ) .AND. ( ln_ctl ) ) THEN
+      IF( ( ln_rstart ) .AND. ( kt == nit000 ) .AND. sn_cfctl%l_prtctl ) THEN
          IF( ln_trdmxl_instant ) THEN
             WRITE(numout,*) '             restart from kt == nit000 = ', nit000
@@ -548,5 +547,5 @@
          hmxlbn         (:,:)   = hmxl    (:,:)
          
-         IF( ln_ctl ) THEN
+         IF( sn_cfctl%l_prtctl ) THEN
             IF( ln_trdmxl_instant ) THEN
                CALL prt_ctl(tab2d_1=tmlbb   , clinfo1=' tmlbb   -   : ', mask1=tmask)
@@ -732,9 +731,7 @@
       !!----------------------------------------------------------------------
       !
-      REWIND( numnam_ref )              ! Namelist namtrd_mxl in reference namelist : mixed layer trends diagnostic
       READ  ( numnam_ref, namtrd_mxl, IOSTAT = ios, ERR = 901 )
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrd_mxl in reference namelist' )
 
-      REWIND( numnam_cfg )              ! Namelist namtrd_mxl in configuration namelist : mixed layer trends diagnostic
       READ  ( numnam_cfg, namtrd_mxl, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrd_mxl in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRD/trdpen.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRD/trdpen.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRD/trdpen.F90	(revision 12928)
@@ -35,6 +35,4 @@
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   rab_pe   ! partial derivatives of PE anomaly with respect to T and S
 
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -55,5 +53,5 @@
 
 
-   SUBROUTINE trd_pen( ptrdx, ptrdy, ktrd, kt, pdt )
+   SUBROUTINE trd_pen( ptrdx, ptrdy, ktrd, kt, pdt, Kmm )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE trd_tra_mng  ***
@@ -66,4 +64,5 @@
       INTEGER                   , INTENT(in) ::   ktrd           ! tracer trend index
       INTEGER                   , INTENT(in) ::   kt             ! time step index
+      INTEGER                   , INTENT(in) ::   Kmm            ! time level index
       REAL(wp)                  , INTENT(in) ::   pdt            ! time step [s]
       !
@@ -77,5 +76,5 @@
       IF( kt /= nkstp ) THEN     ! full eos: set partial derivatives at the 1st call of kt time step
          nkstp = kt
-         CALL eos_pen( tsn, rab_PE, zpe )
+         CALL eos_pen( ts(:,:,:,:,Kmm), rab_PE, zpe, Kmm )
          CALL iom_put( "alphaPE", rab_pe(:,:,:,jp_tem) )
          CALL iom_put( "betaPE" , rab_pe(:,:,:,jp_sal) )
@@ -95,8 +94,8 @@
                                 IF( ln_linssh ) THEN                   ! cst volume : adv flux through z=0 surface
                                    ALLOCATE( z2d(jpi,jpj) )
-                                   z2d(:,:) = wn(:,:,1) * ( &
-                                     &   - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * tsn(:,:,1,jp_tem)    &
-                                     &   + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * tsn(:,:,1,jp_sal)    &
-                                     & ) / e3t_n(:,:,1)
+                                   z2d(:,:) = ww(:,:,1) * ( &
+                                     &   - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * ts(:,:,1,jp_tem,Kmm)    &
+                                     &   + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * ts(:,:,1,jp_sal,Kmm)    &
+                                     & ) / e3t(:,:,1,Kmm)
                                    CALL iom_put( "petrd_sad" , z2d )
                                    DEALLOCATE( z2d )
@@ -112,12 +111,4 @@
       CASE ( jptra_bbc  )   ;   CALL iom_put( "petrd_bbc" , zpe )   ! bottom bound cond (geoth flux)
       CASE ( jptra_atf  )   ;   CALL iom_put( "petrd_atf" , zpe )   ! asselin time filter (last trend)
-                                !IF( ln_linssh ) THEN                   ! cst volume : ssh term (otherwise include in e3t variation)
-                                !   ALLOCATE( z2d(jpi,jpj) )
-                                !   z2d(:,:) = ( ssha(:,:) - sshb(:,:) )                 &
-                                !      &     * (   dPE_dt(:,:,1) * tsn(:,:,1,jp_tem)    &
-                                !      &         + dPE_ds(:,:,1) * tsn(:,:,1,jp_sal)  ) / ( e3t_n(:,:,1) * pdt )
-                                !   CALL iom_put( "petrd_sad" , z2d )
-                                !   DEALLOCATE( z2d )
-                                !ENDIF
          !
       END SELECT
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRD/trdtra.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRD/trdtra.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRD/trdtra.F90	(revision 12928)
@@ -41,5 +41,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -60,5 +60,5 @@
 
 
-   SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pun, ptra )
+   SUBROUTINE trd_tra( kt, Kmm, Krhs, ctype, ktra, ktrd, ptrd, pu, ptra )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE trd_tra  ***
@@ -77,6 +77,7 @@
       INTEGER                         , INTENT(in)           ::   ktra    ! tracer index
       INTEGER                         , INTENT(in)           ::   ktrd    ! tracer trend index
+      INTEGER                         , INTENT(in)           ::   Kmm, Krhs ! time level indices
       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)           ::   ptrd    ! tracer trend  or flux
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   pun     ! now velocity 
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   pu      ! now velocity 
       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   ptra    ! now tracer variable
       !
@@ -94,11 +95,11 @@
          SELECT CASE( ktrd )
          !                            ! advection: transform the advective flux into a trend
-         CASE( jptra_xad )   ;   CALL trd_tra_adv( ptrd, pun, ptra, 'X', trdtx ) 
-         CASE( jptra_yad )   ;   CALL trd_tra_adv( ptrd, pun, ptra, 'Y', trdty ) 
-         CASE( jptra_zad )   ;   CALL trd_tra_adv( ptrd, pun, ptra, 'Z', trdt  ) 
+         CASE( jptra_xad )   ;   CALL trd_tra_adv( ptrd, pu, ptra, 'X', trdtx, Kmm ) 
+         CASE( jptra_yad )   ;   CALL trd_tra_adv( ptrd, pu, ptra, 'Y', trdty, Kmm ) 
+         CASE( jptra_zad )   ;   CALL trd_tra_adv( ptrd, pu, ptra, 'Z', trdt, Kmm )
          CASE( jptra_bbc,    &        ! qsr, bbc: on temperature only, send to trd_tra_mng
             &  jptra_qsr )   ;   trdt(:,:,:) = ptrd(:,:,:) * tmask(:,:,:)
                                  ztrds(:,:,:) = 0._wp
-                                 CALL trd_tra_mng( trdt, ztrds, ktrd, kt )
+                                 CALL trd_tra_mng( trdt, ztrds, ktrd, kt, Kmm )
  !!gm Gurvan, verify the jptra_evd trend please !
          CASE( jptra_evd )   ;   avt_evd(:,:,:) = ptrd(:,:,:) * tmask(:,:,:)
@@ -114,10 +115,10 @@
          !                            ! advection: transform the advective flux into a trend
          !                            !            and send T & S trends to trd_tra_mng
-         CASE( jptra_xad  )   ;   CALL trd_tra_adv( ptrd , pun  , ptra, 'X'  , ztrds ) 
-                                  CALL trd_tra_mng( trdtx, ztrds, ktrd, kt   )
-         CASE( jptra_yad  )   ;   CALL trd_tra_adv( ptrd , pun  , ptra, 'Y'  , ztrds ) 
-                                  CALL trd_tra_mng( trdty, ztrds, ktrd, kt   )
-         CASE( jptra_zad  )   ;   CALL trd_tra_adv( ptrd , pun  , ptra, 'Z'  , ztrds ) 
-                                  CALL trd_tra_mng( trdt , ztrds, ktrd, kt   )
+         CASE( jptra_xad  )   ;   CALL trd_tra_adv( ptrd , pu  , ptra, 'X'  , ztrds, Kmm ) 
+                                  CALL trd_tra_mng( trdtx, ztrds, ktrd, kt, Kmm   )
+         CASE( jptra_yad  )   ;   CALL trd_tra_adv( ptrd , pu  , ptra, 'Y'  , ztrds, Kmm ) 
+                                  CALL trd_tra_mng( trdty, ztrds, ktrd, kt, Kmm   )
+         CASE( jptra_zad  )   ;   CALL trd_tra_adv( ptrd , pu  , ptra, 'Z'  , ztrds, Kmm ) 
+                                  CALL trd_tra_mng( trdt , ztrds, ktrd, kt, Kmm   )
          CASE( jptra_zdfp )           ! diagnose the "PURE" Kz trend (here: just before the swap)
             !                         ! iso-neutral diffusion case otherwise jptra_zdf is "PURE"
@@ -127,28 +128,28 @@
             zwt(:,:,jpk) = 0._wp   ;   zws(:,:,jpk) = 0._wp
             DO jk = 2, jpk
-               zwt(:,:,jk) = avt(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / e3w_n(:,:,jk) * tmask(:,:,jk)
-               zws(:,:,jk) = avs(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / e3w_n(:,:,jk) * tmask(:,:,jk)
+               zwt(:,:,jk) = avt(:,:,jk) * ( ts(:,:,jk-1,jp_tem,Krhs) - ts(:,:,jk,jp_tem,Krhs) ) / e3w(:,:,jk,Kmm) * tmask(:,:,jk)
+               zws(:,:,jk) = avs(:,:,jk) * ( ts(:,:,jk-1,jp_sal,Krhs) - ts(:,:,jk,jp_sal,Krhs) ) / e3w(:,:,jk,Kmm) * tmask(:,:,jk)
             END DO
             !
             ztrdt(:,:,jpk) = 0._wp   ;   ztrds(:,:,jpk) = 0._wp
             DO jk = 1, jpkm1
-               ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t_n(:,:,jk)
-               ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t_n(:,:,jk) 
+               ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t(:,:,jk,Kmm)
+               ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t(:,:,jk,Kmm) 
             END DO
-            CALL trd_tra_mng( ztrdt, ztrds, jptra_zdfp, kt )  
+            CALL trd_tra_mng( ztrdt, ztrds, jptra_zdfp, kt, Kmm )  
             !
             !                         ! Also calculate EVD trend at this point. 
             zwt(:,:,:) = 0._wp   ;   zws(:,:,:) = 0._wp            ! vertical diffusive fluxes
             DO jk = 2, jpk
-               zwt(:,:,jk) = avt_evd(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / e3w_n(:,:,jk) * tmask(:,:,jk)
-               zws(:,:,jk) = avt_evd(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / e3w_n(:,:,jk) * tmask(:,:,jk)
+               zwt(:,:,jk) = avt_evd(:,:,jk) * ( ts(:,:,jk-1,jp_tem,Krhs) - ts(:,:,jk,jp_tem,Krhs) ) / e3w(:,:,jk,Kmm) * tmask(:,:,jk)
+               zws(:,:,jk) = avt_evd(:,:,jk) * ( ts(:,:,jk-1,jp_sal,Krhs) - ts(:,:,jk,jp_sal,Krhs) ) / e3w(:,:,jk,Kmm) * tmask(:,:,jk)
             END DO
             !
             ztrdt(:,:,jpk) = 0._wp   ;   ztrds(:,:,jpk) = 0._wp
             DO jk = 1, jpkm1
-               ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t_n(:,:,jk)
-               ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t_n(:,:,jk) 
+               ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t(:,:,jk,Kmm)
+               ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t(:,:,jk,Kmm) 
             END DO
-            CALL trd_tra_mng( ztrdt, ztrds, jptra_evd, kt )  
+            CALL trd_tra_mng( ztrdt, ztrds, jptra_evd, kt, Kmm )  
             !
             DEALLOCATE( zwt, zws, ztrdt )
@@ -156,5 +157,5 @@
          CASE DEFAULT                 ! other trends: mask and send T & S trends to trd_tra_mng
             ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:)
-            CALL trd_tra_mng( trdt, ztrds, ktrd, kt )  
+            CALL trd_tra_mng( trdt, ztrds, ktrd, kt, Kmm )  
          END SELECT
       ENDIF
@@ -164,12 +165,12 @@
          SELECT CASE( ktrd )
          !                            ! advection: transform the advective flux into a masked trend
-         CASE( jptra_xad )   ;   CALL trd_tra_adv( ptrd , pun , ptra, 'X', ztrds ) 
-         CASE( jptra_yad )   ;   CALL trd_tra_adv( ptrd , pun , ptra, 'Y', ztrds ) 
-         CASE( jptra_zad )   ;   CALL trd_tra_adv( ptrd , pun , ptra, 'Z', ztrds ) 
+         CASE( jptra_xad )   ;   CALL trd_tra_adv( ptrd , pu , ptra, 'X', ztrds, Kmm ) 
+         CASE( jptra_yad )   ;   CALL trd_tra_adv( ptrd , pu , ptra, 'Y', ztrds, Kmm ) 
+         CASE( jptra_zad )   ;   CALL trd_tra_adv( ptrd , pu , ptra, 'Z', ztrds, Kmm ) 
          CASE DEFAULT                 ! other trends: just masked 
                                  ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:)
          END SELECT
          !                            ! send trend to trd_trc
-         CALL trd_trc( ztrds, ktra, ktrd, kt ) 
+         CALL trd_trc( ztrds, ktra, ktrd, kt, Kmm ) 
          !
       ENDIF
@@ -178,5 +179,5 @@
 
 
-   SUBROUTINE trd_tra_adv( pf, pun, ptn, cdir, ptrd )
+   SUBROUTINE trd_tra_adv( pf, pu, pt, cdir, ptrd, Kmm )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE trd_tra_adv  ***
@@ -191,8 +192,9 @@
       !!----------------------------------------------------------------------
       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pf      ! advective flux in one direction
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pun     ! now velocity   in one direction
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   ptn     ! now or before tracer 
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pu      ! now velocity   in one direction
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pt      ! now or before tracer 
       CHARACTER(len=1)                , INTENT(in   ) ::   cdir    ! X/Y/Z direction
       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   ptrd    ! advective trend in one direction
+      INTEGER,  INTENT(in)                            ::   Kmm     ! time level index
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -211,18 +213,14 @@
       ptrd(:,:,jpk) = 0._wp
       !
-      DO jk = 1, jpkm1         ! advective trend
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ptrd(ji,jj,jk) = - (     pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik)                        &
-                 &                  - ( pun(ji,jj,jk) - pun(ji-ii,jj-ij,jk-ik) ) * ptn(ji,jj,jk)  )   &
-                 &              * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) * tmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 1, jpkm1 )
+         ptrd(ji,jj,jk) = - (     pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik)                        &
+           &                  - ( pu(ji,jj,jk) - pu(ji-ii,jj-ij,jk-ik) ) * pt(ji,jj,jk)  )   &
+           &              * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk)
+      END_3D
       !
    END SUBROUTINE trd_tra_adv
 
 
-   SUBROUTINE trd_tra_mng( ptrdx, ptrdy, ktrd, kt )
+   SUBROUTINE trd_tra_mng( ptrdx, ptrdy, ktrd, kt, Kmm )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE trd_tra_mng  ***
@@ -236,18 +234,15 @@
       INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index
       INTEGER                   , INTENT(in   ) ::   kt      ! time step
-      !!----------------------------------------------------------------------
-
-      IF( neuler == 0 .AND. kt == nit000    ) THEN   ;   r2dt =      rdt      ! = rdt (restart with Euler time stepping)
-      ELSEIF(               kt <= nit000 + 1) THEN   ;   r2dt = 2. * rdt      ! = 2 rdt (leapfrog)
-      ENDIF
+      INTEGER                   , INTENT(in   ) ::   Kmm     ! time level index
+      !!----------------------------------------------------------------------
 
       !                   ! 3D output of tracers trends using IOM interface
-      IF( ln_tra_trd )   CALL trd_tra_iom ( ptrdx, ptrdy, ktrd, kt )
+      IF( ln_tra_trd )   CALL trd_tra_iom ( ptrdx, ptrdy, ktrd, kt, Kmm )
 
       !                   ! Integral Constraints Properties for tracers trends                                       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-      IF( ln_glo_trd )   CALL trd_glo( ptrdx, ptrdy, ktrd, 'TRA', kt )
+      IF( ln_glo_trd )   CALL trd_glo( ptrdx, ptrdy, ktrd, 'TRA', kt, Kmm )
 
       !                   ! Potential ENergy trends
-      IF( ln_PE_trd  )   CALL trd_pen( ptrdx, ptrdy, ktrd, kt, r2dt )
+      IF( ln_PE_trd  )   CALL trd_pen( ptrdx, ptrdy, ktrd, kt, rDt, Kmm )
 
       !                   ! Mixed layer trends for active tracers
@@ -282,5 +277,5 @@
          CASE ( jptra_atf )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_atf, '3D' )   ! asselin time filter (last trend)
                                    !
-                                       CALL trd_mxl( kt, r2dt )                             ! trends: Mixed-layer (output)
+                                       CALL trd_mxl( kt, rDt )                             ! trends: Mixed-layer (output)
          END SELECT
          !
@@ -290,5 +285,5 @@
 
 
-   SUBROUTINE trd_tra_iom( ptrdx, ptrdy, ktrd, kt )
+   SUBROUTINE trd_tra_iom( ptrdx, ptrdy, ktrd, kt, Kmm )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE trd_tra_iom  ***
@@ -300,4 +295,5 @@
       INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index
       INTEGER                   , INTENT(in   ) ::   kt      ! time step
+      INTEGER                   , INTENT(in   ) ::   Kmm     ! time level index
       !!
       INTEGER ::   ji, jj, jk   ! dummy loop indices
@@ -326,6 +322,6 @@
                                   IF( ln_linssh ) THEN                   ! cst volume : adv flux through z=0 surface
                                      ALLOCATE( z2dx(jpi,jpj), z2dy(jpi,jpj) )
-                                     z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / e3t_n(:,:,1)
-                                     z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / e3t_n(:,:,1)
+                                     z2dx(:,:) = ww(:,:,1) * ts(:,:,1,jp_tem,Kmm) / e3t(:,:,1,Kmm)
+                                     z2dy(:,:) = ww(:,:,1) * ts(:,:,1,jp_sal,Kmm) / e3t(:,:,1,Kmm)
                                      CALL iom_put( "ttrd_sad", z2dx )
                                      CALL iom_put( "strd_sad", z2dy )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRD/trdtrc.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRD/trdtrc.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRD/trdtrc.F90	(revision 12928)
@@ -9,6 +9,7 @@
 CONTAINS
 
-   SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt )
+   SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt, Kmm )
       INTEGER ::   kt, kjn, ktrd   
+      INTEGER ::   Kmm            ! time level index
       REAL    ::   ptrtrd(:,:,:)  
       WRITE(*,*) 'trd_trc : You should not have seen this print! error?', ptrtrd(1,1,1)
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRD/trdvor.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRD/trdvor.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRD/trdvor.F90	(revision 12928)
@@ -56,5 +56,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -78,5 +78,5 @@
 
 
-   SUBROUTINE trd_vor( putrd, pvtrd, ktrd, kt )
+   SUBROUTINE trd_vor( putrd, pvtrd, ktrd, kt, Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE trd_vor  ***
@@ -88,4 +88,5 @@
       INTEGER                   , INTENT(in   ) ::   ktrd           ! trend index
       INTEGER                   , INTENT(in   ) ::   kt             ! time step
+      INTEGER                   , INTENT(in   ) ::   Kmm            ! time level index
       !
       INTEGER ::   ji, jj   ! dummy loop indices
@@ -94,27 +95,25 @@
 
       SELECT CASE( ktrd ) 
-      CASE( jpdyn_hpg )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_prg )   ! Hydrostatique Pressure Gradient 
-      CASE( jpdyn_keg )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_keg )   ! KE Gradient 
-      CASE( jpdyn_rvo )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_rvo )   ! Relative Vorticity 
-      CASE( jpdyn_pvo )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_pvo )   ! Planetary Vorticity Term 
-      CASE( jpdyn_ldf )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_ldf )   ! Horizontal Diffusion 
-      CASE( jpdyn_zad )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_zad )   ! Vertical Advection 
-      CASE( jpdyn_spg )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_spg )   ! Surface Pressure Grad. 
+      CASE( jpdyn_hpg )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_prg, Kmm )   ! Hydrostatique Pressure Gradient 
+      CASE( jpdyn_keg )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_keg, Kmm )   ! KE Gradient 
+      CASE( jpdyn_rvo )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_rvo, Kmm )   ! Relative Vorticity 
+      CASE( jpdyn_pvo )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_pvo, Kmm )   ! Planetary Vorticity Term 
+      CASE( jpdyn_ldf )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_ldf, Kmm )   ! Horizontal Diffusion 
+      CASE( jpdyn_zad )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_zad, Kmm )   ! Vertical Advection 
+      CASE( jpdyn_spg )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_spg, Kmm )   ! Surface Pressure Grad. 
       CASE( jpdyn_zdf )                                                      ! Vertical Diffusion 
          ztswu(:,:) = 0.e0   ;   ztswv(:,:) = 0.e0
-         DO jj = 2, jpjm1                                                             ! wind stress trends
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( e3u_n(ji,jj,1) * rau0 )
-               ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( e3v_n(ji,jj,1) * rau0 )
-            END DO
-         END DO
-         !
-         CALL trd_vor_zint( putrd, pvtrd, jpvor_zdf )                             ! zdf trend including surf./bot. stresses 
-         CALL trd_vor_zint( ztswu, ztswv, jpvor_swf )                             ! surface wind stress 
+         DO_2D_00_00
+            ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( e3u(ji,jj,1,Kmm) * rho0 )
+            ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( e3v(ji,jj,1,Kmm) * rho0 )
+         END_2D
+         !
+         CALL trd_vor_zint( putrd, pvtrd, jpvor_zdf, Kmm )                             ! zdf trend including surf./bot. stresses 
+         CALL trd_vor_zint( ztswu, ztswv, jpvor_swf, Kmm )                             ! surface wind stress 
       CASE( jpdyn_bfr )
-         CALL trd_vor_zint( putrd, pvtrd, jpvor_bfr )                             ! Bottom stress
+         CALL trd_vor_zint( putrd, pvtrd, jpvor_bfr, Kmm )                             ! Bottom stress
          !
       CASE( jpdyn_atf )       ! last trends: perform the output of 2D vorticity trends
-         CALL trd_vor_iom( kt )
+         CALL trd_vor_iom( kt, Kmm )
       END SELECT
       !
@@ -122,5 +121,5 @@
 
 
-   SUBROUTINE trd_vor_zint_2d( putrdvor, pvtrdvor, ktrd )
+   SUBROUTINE trd_vor_zint_2d( putrdvor, pvtrdvor, ktrd, Kmm )
       !!----------------------------------------------------------------------------
       !!                  ***  ROUTINE trd_vor_zint  ***
@@ -150,4 +149,5 @@
       !!----------------------------------------------------------------------
       INTEGER                     , INTENT(in   ) ::   ktrd       ! ocean trend index
+      INTEGER                     , INTENT(in   ) ::   Kmm        ! time level index
       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   putrdvor   ! u vorticity trend 
       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pvtrdvor   ! v vorticity trend
@@ -171,22 +171,20 @@
       !
       CASE( jpvor_bfr )        ! bottom friction
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1 
-               ikbu = mbkv(ji,jj)
-               ikbv = mbkv(ji,jj)            
-               zudpvor(ji,jj) = putrdvor(ji,jj) * e3u_n(ji,jj,ikbu) * e1u(ji,jj) * umask(ji,jj,ikbu)
-               zvdpvor(ji,jj) = pvtrdvor(ji,jj) * e3v_n(ji,jj,ikbv) * e2v(ji,jj) * vmask(ji,jj,ikbv)
-            END DO
-         END DO
+         DO_2D_00_00
+            ikbu = mbkv(ji,jj)
+            ikbv = mbkv(ji,jj)            
+            zudpvor(ji,jj) = putrdvor(ji,jj) * e3u(ji,jj,ikbu,Kmm) * e1u(ji,jj) * umask(ji,jj,ikbu)
+            zvdpvor(ji,jj) = pvtrdvor(ji,jj) * e3v(ji,jj,ikbv,Kmm) * e2v(ji,jj) * vmask(ji,jj,ikbv)
+         END_2D
          !
       CASE( jpvor_swf )        ! wind stress
-         zudpvor(:,:) = putrdvor(:,:) * e3u_n(:,:,1) * e1u(:,:) * umask(:,:,1)
-         zvdpvor(:,:) = pvtrdvor(:,:) * e3v_n(:,:,1) * e2v(:,:) * vmask(:,:,1)
+         zudpvor(:,:) = putrdvor(:,:) * e3u(:,:,1,Kmm) * e1u(:,:) * umask(:,:,1)
+         zvdpvor(:,:) = pvtrdvor(:,:) * e3v(:,:,1,Kmm) * e2v(:,:) * vmask(:,:,1)
          !
       END SELECT
 
       ! Average except for Beta.V
-      zudpvor(:,:) = zudpvor(:,:) * r1_hu_n(:,:)
-      zvdpvor(:,:) = zvdpvor(:,:) * r1_hv_n(:,:)
+      zudpvor(:,:) = zudpvor(:,:) * r1_hu(:,:,Kmm)
+      zvdpvor(:,:) = zvdpvor(:,:) * r1_hv(:,:,Kmm)
    
       ! Curl
@@ -207,5 +205,5 @@
 
 
-   SUBROUTINE trd_vor_zint_3d( putrdvor, pvtrdvor, ktrd )
+   SUBROUTINE trd_vor_zint_3d( putrdvor, pvtrdvor, ktrd , Kmm )
       !!----------------------------------------------------------------------------
       !!                  ***  ROUTINE trd_vor_zint  ***
@@ -236,4 +234,5 @@
       !
       INTEGER                         , INTENT(in   ) ::   ktrd       ! ocean trend index
+      INTEGER                         , INTENT(in   ) ::   Kmm        ! time level index
       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   putrdvor   ! u vorticity trend 
       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pvtrdvor   ! v vorticity trend
@@ -257,6 +256,6 @@
       ! putrdvor and pvtrdvor terms
       DO jk = 1,jpk
-        zudpvor(:,:) = zudpvor(:,:) + putrdvor(:,:,jk) * e3u_n(:,:,jk) * e1u(:,:) * umask(:,:,jk)
-        zvdpvor(:,:) = zvdpvor(:,:) + pvtrdvor(:,:,jk) * e3v_n(:,:,jk) * e2v(:,:) * vmask(:,:,jk)
+        zudpvor(:,:) = zudpvor(:,:) + putrdvor(:,:,jk) * e3u(:,:,jk,Kmm) * e1u(:,:) * umask(:,:,jk)
+        zvdpvor(:,:) = zvdpvor(:,:) + pvtrdvor(:,:,jk) * e3v(:,:,jk,Kmm) * e2v(:,:) * vmask(:,:,jk)
       END DO
 
@@ -273,10 +272,10 @@
          END DO
          ! Average of the Curl and Surface mask
-         vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * r1_hu_n(:,:) * fmask(:,:,1)
+         vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * r1_hu(:,:,Kmm) * fmask(:,:,1)
       ENDIF
       !
       ! Average 
-      zudpvor(:,:) = zudpvor(:,:) * r1_hu_n(:,:)
-      zvdpvor(:,:) = zvdpvor(:,:) * r1_hv_n(:,:)
+      zudpvor(:,:) = zudpvor(:,:) * r1_hu(:,:,Kmm)
+      zvdpvor(:,:) = zvdpvor(:,:) * r1_hv(:,:,Kmm)
       !
       ! Curl
@@ -298,5 +297,5 @@
 
 
-   SUBROUTINE trd_vor_iom( kt )
+   SUBROUTINE trd_vor_iom( kt , Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE trd_vor  ***
@@ -306,9 +305,10 @@
       !!----------------------------------------------------------------------
       INTEGER                   , INTENT(in   ) ::   kt             ! time step
+      INTEGER                   , INTENT(in   ) ::   Kmm            ! time level index
       !
       INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
       INTEGER  ::   it, itmod        ! local integers
       REAL(wp) ::   zmean            ! local scalars
-      REAL(wp), DIMENSION(jpi,jpj) :: zun, zvn
+      REAL(wp), DIMENSION(jpi,jpj) :: zuu, zvv
       !!----------------------------------------------------------------------
 
@@ -327,6 +327,6 @@
 
       vor_avr   (:,:) = 0._wp
-      zun       (:,:) = 0._wp
-      zvn       (:,:) = 0._wp
+      zuu       (:,:) = 0._wp
+      zvv       (:,:) = 0._wp
       vor_avrtot(:,:) = 0._wp
       vor_avrres(:,:) = 0._wp
@@ -334,16 +334,16 @@
       ! Vertically averaged velocity
       DO jk = 1, jpk - 1
-         zun(:,:) = zun(:,:) + e1u(:,:) * un(:,:,jk) * e3u_n(:,:,jk)
-         zvn(:,:) = zvn(:,:) + e2v(:,:) * vn(:,:,jk) * e3v_n(:,:,jk)
+         zuu(:,:) = zuu(:,:) + e1u(:,:) * uu(:,:,jk,Kmm) * e3u(:,:,jk,Kmm)
+         zvv(:,:) = zvv(:,:) + e2v(:,:) * vv(:,:,jk,Kmm) * e3v(:,:,jk,Kmm)
       END DO
  
-      zun(:,:) = zun(:,:) * r1_hu_n(:,:)
-      zvn(:,:) = zvn(:,:) * r1_hv_n(:,:)
+      zuu(:,:) = zuu(:,:) * r1_hu(:,:,Kmm)
+      zvv(:,:) = zvv(:,:) * r1_hv(:,:,Kmm)
 
       ! Curl
       DO ji = 1, jpim1
          DO jj = 1, jpjm1
-            vor_avr(ji,jj) = (  ( zvn(ji+1,jj) - zvn(ji,jj) )    &
-               &              - ( zun(ji,jj+1) - zun(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) * fmask(ji,jj,1)
+            vor_avr(ji,jj) = (  ( zvv(ji+1,jj) - zvv(ji,jj) )    &
+               &              - ( zuu(ji,jj+1) - zuu(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) * fmask(ji,jj,1)
          END DO
       END DO
@@ -385,5 +385,5 @@
          ! III.1 compute total trend
          ! ------------------------
-         zmean = 1._wp / (  REAL( nmoydpvor, wp ) * 2._wp * rdt  )
+         zmean = 1._wp / (  REAL( nmoydpvor, wp ) * 2._wp * rn_Dt  )
          vor_avrtot(:,:) = (  vor_avr(:,:) - vor_avrbn(:,:) + vor_avrb(:,:) - vor_avrbb(:,:) ) * zmean
 
@@ -504,11 +504,11 @@
       ENDIF
 #if defined key_diainstant
-      zsto = nn_write*rdt
+      zsto = nn_write*rn_Dt
       clop = "inst("//TRIM(clop)//")"
 #else
-      zsto = rdt
+      zsto = rn_Dt
       clop = "ave("//TRIM(clop)//")"
 #endif
-      zout = nn_trd*rdt
+      zout = nn_trd*rn_Dt
 
       IF(lwp) WRITE(numout,*) '               netCDF initialization'
@@ -516,5 +516,5 @@
       ! II.2 Compute julian date from starting date of the run
       ! ------------------------
-      CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )
+      CALL ymds2ju( nyear, nmonth, nday, rn_Dt, zjulian )
       zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
       IF(lwp) WRITE(numout,*)' '  
@@ -528,5 +528,5 @@
       IF(lwp) WRITE(numout,*) ' Name of NETCDF file ', clhstnam
       CALL histbeg( clhstnam, jpi, glamf, jpj, gphif,1, jpi,   &  ! Horizontal grid : glamt and gphit
-         &          1, jpj, nit000-1, zjulian, rdt, nh_t, nidvor, domain_id=nidom, snc4chunks=snc4set )
+         &          1, jpj, nit000-1, zjulian, rn_Dt, nh_t, nidvor, domain_id=nidom, snc4chunks=snc4set )
       CALL wheneq( jpi*jpj, fmask, 1, 1., ndexvor1, ndimvor1 )    ! surface
 
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/USR/README-setup-configs
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/USR/README-setup-configs	(revision 12384)
+++ 	(revision )
@@ -1,53 +1,0 @@
-==============================================================
-== HOW TO set up user’s configuration in NEMO version 4.0 : ==
-==============================================================
-This document describes how a configuration is set up in NEMO.
-
-In NEMO 4.0 two types of configurations can be build: global/regional and idealized.
-
-- create ./cfgs/your_config
-- case 1: regional or global 
-    => ln_read_cfg = .true. in ./cfgs/your_config/EXP00/namelist_cfg (i.e. read domain_cfg.nc)
-- case 2: idealized 
-    =>in ./cfgs/your_config/EXP00/namelist_cfg :
-      ln_read_cfg = .false. (need to define usrdef_hgr.F90 and usrdef_zgr.F90) 
-      ln_usr = .true.       (need to define usrdef_sbc.F90)    
-    => copy ./src/OCE/USR in ./cfgs/your_config/MY_SRC routines nedeed to set up domain, forcing fields and initial state
-    
-  Routines in NEMOGCM/NEMO/OCE/USR define analytically the domain, the initial state and the surface boundary conditions for the reference configuration GYRE.
-	  •	usrdef_hgr.F90 and usrdef_zgr.F90 : define horizontal and vertical grid
-	  •	usrdef_sbc.F90    : provides at each time-step the surface boundary condition, i.e. the momentum, heat and freshwater fluxes
-	  •	usrdef_istate.F90 : defines initialization of the dynamics and tracers
-	  •	usrdef_fmask.F90  : used just in ORCA CONFIGURATIONS for alteration of f-point land/ocean mask in some straits 
-	  •	usrdef_closea.F90 : used just in ORCA CONFIGURATIONS for specific treatments associated with closed seas
-	  •	usrdef_nam.F90    : set the domain characteristics of a user configuration
-
-  Other analytical examples are given in ./tests.
-
-===========================================
-== The domain_cfg.nc file must contain : ==
-===========================================
-   int ORCA  , ORCA_index            : configuration name, configuration resolution
-   int jpiglo, jpjglo , jpkglo       : global domain sizes 
-   int jperio                        : lateral global domain b.c. 
-   int ln_zco, ln_zps, ln_sco        : flags for z-coordinate, z-coordinate with partial steps and s-coordinate 
-   int ln_isfcav                     : flag  for ice shelf cavities 
-   double glamt, glamu, glamv, glamf : geographic position 
-   double gphit, gphiu, gphiv, gphif : geographic position
-   double iff, ff_f, ff_t            : Coriolis parameter (if not on the sphere)
-   double e1t, e1u, e1v, e1f         : horizontal scale factors
-   double e2t, e2u, e2v, e2f         : horizontal scale factors
-   double ie1e2u_v, e1e2u, e1e2v     : U and V surfaces (if grid size reduction in some straits)
-   double e3t_1d, e3w_1d             : reference vertical scale factors at T and W points
-   double e3t_0, e3u_0, e3v_0, e3f_0, e3w_0 : vertical scale factors 3D coordinate at T,U,V,F and W points
-   double e3uw_0,e3vw_0              : vertical scale factors 3D coordinate at UW and VW points
-   int bottom_level, top_level       : last wet T-points, 1st wet T-points (for ice shelf cavities)
-
-=======================================
-= HOW TO CREATE domain_cfg.nc file : ==
-=======================================
-Two options are possible :
-
- - users can create with his own tool the domain_cfg.nc with all mandatory fields.  
-
- - tool is available in ./tools/DOMAINcfg based on NEMO 3.6 version. See ./tools/DOMAINcfg/README.
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/USR/README.rst
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/USR/README.rst	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/USR/README.rst	(revision 12928)
@@ -0,0 +1,280 @@
+******************************
+Setting up a new configuration
+******************************
+
+.. todo::
+
+
+
+.. contents::
+   :local:
+
+Starting from an existing configuration
+=======================================
+
+There are three options to build a new configuration from an existing one.
+
+Option 1: Duplicate an existing configuration
+---------------------------------------------
+
+The NEMO so-called Reference Configurations cover a number of major features for NEMO setup
+(global, regional, 1D, using embedded zoom with AGRIF...)
+
+One can create a new configuration by duplicating one of the reference configurations
+(``ORCA2_ICE_PISCES`` in the following example)
+
+.. code-block:: console
+
+   $ ./makenemo –n 'ORCA2_ICE_PISCES_MINE' -r 'ORCA2_ICE_PISCES' -m 'my_arch'
+
+Option 2: Duplicate with differences
+------------------------------------
+
+Create and compile a new configuration based on a reference configuration
+(``ORCA2_ICE_PISCES`` in the following example) but with different pre-processor options.
+For this either add ``add_key`` or ``del_key`` keys as required; e.g.
+
+.. code-block:: console
+
+   $ ./makenemo –n 'ORCA2_ICE_PISCES_MINE' -r 'ORCA2_ICE_PISCES' -m 'my_arch' del_key 'key_iomput' add_key 'key_diahth'
+
+Option 3: Use the SIREN tools to subset an existing model
+---------------------------------------------------------
+
+Define a regional configuration which is a {sub,super}-set of an existing configuration.
+
+This last option employs the SIREN software tools that are included in the standard distribution.
+The software is written in Fortran 95 and available in the :file:`./tools/SIREN` directory.
+SIREN allows you to create your own regional configuration embedded in a wider one.
+
+SIREN is a set of programs to create all the input files you need to
+run a NEMO regional configuration.
+
+:Demo:     Set of GLORYS files (GLObal ReanalYSis on the ORCA025 grid),
+           as well as examples of namelists are available `here`_.
+:Doc:      :forge:`chrome/site/doc/SIREN/html/index.html`
+:Support:  Any questions or comments regarding the use of SIREN should be posted in
+  :forge:`the corresponding forum <discussion/forum/2>`.
+
+.. _here: https://prodn.idris.fr/thredds/catalog/ipsl_public/rron463/catalog.html
+
+Creating a completely new configuration
+=======================================
+
+From NEMO version 4.0 there are two ways to build configurations from scratch.
+The appropriate method to use depends largely on the target configuration.
+Method 1 is for more complex/realistic global or regional configurations and
+method 2 is intended for simpler, idealised configurations whose
+domains and characteristics can be described in simple geometries and formulae.
+
+Option 1: Create and use a domain configuration file
+----------------------------------------------------
+
+This method is used by each of the reference configurations,
+so that downloading their input files linked to their description can help.
+Although starting from scratch,
+it is advisable to create the directory structure to house your new configuration by
+duplicating the closest reference configuration to your target application.
+For example, if your application requires both ocean ice and passive tracers,
+then use the ``ORCA2_ICE_PISCES`` as template,
+and execute following command to build your ``MY_NEW_CONFIG`` configuration:
+
+.. code-block:: sh
+
+   $ ./makenemo –n 'MY_NEW_CONFIG' -r 'ORCA2_ICE_PISCES' -m 'my_arch'
+
+where ``MY_NEW_CONFIG`` can be substituted with
+a suitably descriptive name for your new configuration.
+
+The purpose of this step is simply to create and populate the appropriate :file:`WORK`,
+:file:`MY_SRC` and :file:`EXP00` subdirectories for your new configuration.
+Other choices for the base reference configuration might be
+
+:GYRE:  If your target application is ocean-only
+:AMM12: If your target application is regional with open boundaries
+
+All the domain information for your new configuration will be contained within
+a netcdf file called :file:`domain_cfg.nc` which you will need to create and
+place in the :file:`./cfgs/MY_NEW_CONFIG/EXP00` sub-directory.
+Firstly though, ensure that your configuration is set to use such a file by checking that
+
+.. code-block:: fortran
+
+   ln_read_cfg = .true.
+
+in :file:`./cfgs/MY_NEW_CONFIG/EXP00/namelist_cfg`
+
+Create the :file:`domain_cfg.nc` file which must contain the following fields
+
+.. code-block:: c
+
+   /* configuration name, configuration resolution                 */
+   int    ORCA, ORCA_index
+   /* global domain sizes                                          */
+   int    jpiglo, jpjglo, jpkglo
+   /* lateral global domain b.c.                                   */
+   int    jperio
+   /* flags for z-coord, z-coord with partial steps and s-coord    */
+   int    ln_zco, ln_zps, ln_sco
+   /* flag  for ice shelf cavities                                 */
+   int    ln_isfcav
+   /* geographic position                                          */
+   double glamt, glamu, glamv, glamf
+   /* geographic position                                          */
+   double gphit, gphiu, gphiv, gphif
+   /* Coriolis parameter (if not on the sphere)                    */
+   double iff, ff_f, ff_t
+   /* horizontal scale factors                                     */
+   double e1t, e1u, e1v, e1f
+   /* horizontal scale factors                                     */
+   double e2t, e2u, e2v, e2f
+   /* U and V surfaces (if grid size reduction in some straits)    */
+   double ie1e2u_v, e1e2u, e1e2v
+   /* reference vertical scale factors at T and W points           */
+   double e3t_1d, e3w_1d
+   /* vertical scale factors 3D coordinate at T,U,V,F and W points */
+   double e3t_0, e3u_0, e3v_0, e3f_0, e3w_0
+   /* vertical scale factors 3D coordinate at UW and VW points     */
+   double e3uw_0, e3vw_0
+   /* last wet T-points, 1st wet T-points (for ice shelf cavities) */
+   int    bottom_level, top_level
+
+There are two options for creating a :file:`domain_cfg.nc` file:
+
+- Users can use tools of their own choice to build a :file:`domain_cfg.nc` with all mandatory fields.
+- Users can adapt and apply the supplied tool available in :file:`./tools/DOMAINcfg`.
+  This tool is based on code extracted from NEMO version 3.6 and will allow similar choices for
+  the horizontal and vertical grids that were available internally to that version.
+  See :ref:`tools <DOMAINcfg>` for details.
+
+Option 2: Adapt the usr_def configuration module of NEMO for you own purposes
+-----------------------------------------------------------------------------
+
+This method is intended for configuring easily simple/idealised configurations which
+are often used as demonstrators or for process evaluation and comparison.
+This method can be used whenever the domain geometry has a simple mathematical description and
+the ocean initial state and boundary forcing is described analytically.
+As a start, consider the case of starting a completely new ocean-only test case based on
+the ``LOCK_EXCHANGE`` example.
+
+.. note::
+
+   We probably need an even more basic example than this with only one namelist and
+   minimal changes to the usrdef modules
+
+Firstly, construct the directory structure, starting in the :file:`cfgs` directory:
+
+.. code-block:: console
+
+   $ ./makenemo -n 'MY_NEW_TEST' -t 'LOCK_EXCHANGE' -m 'my_arch'
+
+where the ``-t`` option has been used to locate the new configuration in
+the :file:`tests` subdirectory
+(it is recommended practice to keep full configurations and idealised cases clearly distinguishable).
+This command will create (amongst others) the following files and directories::
+
+   ./tests/MY_NEW_TEST:
+   BLD  EXP00  MY_SRC WORK  cpp_MY_NEW_TEST.fcm
+
+   ./tests/MY_NEW_TEST/EXP00:
+   context_nemo.xml  domain_def_nemo.xml  field_def_nemo-oce.xml  file_def_nemo-oce.xml  iodef.xml
+   namelist_cfg      namelist_ref
+
+   ./tests/MY_NEW_TEST/MY_SRC:
+   usrdef_hgr.F90  usrdef_nam.F90  usrdef_zgr.F90  usrdef_istate.F90  usrdef_sbc.F90  zdfini.F90
+
+The key to setting up an idealised configuration lies in
+adapting a small set of short Fortran 90 modules which
+should be dropped into the :file:`MY_SRC` directory.
+Here the ``LOCK_EXCHANGE`` example is using 5 such routines but the full set that is available in
+the :file:`src/OCE/USR` directory is::
+
+   ./src/OCE/USR:
+   usrdef_closea.F90  usrdef_fmask.F90  usrdef_hgr.F90  usrdef_istate.F90
+   usrdef_nam.F90     usrdef_sbc.F90    usrdef_zgr.F90
+
+Before discussing these in more detail it is worth noting the various namelist controls that
+engage the different user-defined aspects.
+These controls are set using two new logical switches or are implied by the settings of existing ones.
+For example, the mandatory requirement for an idealised configuration is to provide routines which
+define the horizontal and vertical domains.
+Templates for these are provided in the :file:`usrdef_hgr.F90` and :file:`usrdef_zgr.F90` modules.
+The application of these modules is activated whenever:
+
+.. code-block:: fortran
+
+   ln_read_cfg = .false.
+
+in any configuration's :file:`namelist_cfg` file.
+This setting also activates the reading of an optional ``&nam_usrdef`` namelist which can be used to
+supply configuration specific settings.
+These need to be declared and read in the :file:`usrdef_nam.F90` module.
+
+Another explicit control is available in the ``&namsbc`` namelist which
+activates the use of analytical forcing.
+With
+
+.. code-block:: fortran
+
+   ln_usr = .true.
+
+Other usrdef modules are activated by less explicit means.
+For example, code in :file:`usrdef_istate.F90` is used to
+define initial temperature and salinity fields if
+
+.. code-block:: fortran
+
+   ln_tsd_init   = .false.
+
+in the ``&namtsd`` namelist.
+The remaining modules, namely :file:`usrdef_closea.F90` :file:`usrdef_fmask.F90` are specific to
+ORCA configurations and set local variations of some specific fields for
+the various resolutions of the global models.
+They do not need to be considered here in the context of idealised cases but
+it is worth noting that all configuration specific code has now been isolated in the usrdef modules.
+In the case of these last two modules, they are activated only if an ORCA configuration is detected.
+Currently,
+this requires a specific integer variable named ``ORCA`` to be set in a :file:`domain_cfg.nc` file.
+
+.. note::
+
+   This would be less confusing if the ``cn_cfg`` string is read directly as
+   a character attribue from the :file:`domain_cfg.nc`.
+
+So, in most cases, the set up of idealised model configurations can be completed by
+copying the template routines from :file:`./src/OCE/USR` into
+your new :file:`./cfgs/MY_NEW_TEST/MY_SRC` directory and
+editing the appropriate modules as needed.
+The default set are those used for the GYRE reference configuration.
+The contents of :file:`MY_SRC` directories from other idealised configurations may provide
+more convenient templates if they share common characteristics with your target application.
+
+Whatever the starting point,
+it should not require too many changes or additional lines of code to produce routines in
+:file:`./src/OCE/USR` that define analytically the domain,
+the initial state and the surface boundary conditions for your new configuration.
+
+To summarize, the base set of modules is:
+
+:usrdef_hgr.F90:    Define horizontal grid
+:usrdef_zgr.F90:    Define vertical grid
+:usrdef_sbc.F90:    Provides at each time-step the surface boundary condition,
+   i.e. the momentum, heat and freshwater fluxes
+:usrdef_istate.F90: Defines initialization of the dynamics and tracers
+:usrdef_nam.F90:    Configuration-specific namelist processing to
+   set any associated run-time parameters
+
+with two specialised ORCA modules
+(not related to idealised configurations but used to isolate configuration specific code that
+is used in ORCA2 reference configurations and established global configurations using
+the ORCA tripolar grid):
+
+:usrdef_fmask.F90:  only used in ORCA configurations for
+   alteration of f-point land/ocean mask in some straits
+:usrdef_closea.F90: only used in ORCA configurations for
+   specific treatments associated with closed seas
+
+From version 4.0, the NEMO release includes a :file:`tests` subdirectory containing available and
+up to date :doc:`test cases <tests>` build by the community.
+These will not be fully supported as are NEMO reference configurations,
+but should provide a source of raw material.
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/USR/usrdef_fmask.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/USR/usrdef_fmask.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/USR/usrdef_fmask.F90	(revision 12928)
@@ -26,6 +26,4 @@
    PUBLIC   usr_def_fmask    ! routine called by dommsk.F90
 
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/USR/usrdef_hgr.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/USR/usrdef_hgr.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/USR/usrdef_hgr.F90	(revision 12928)
@@ -26,4 +26,6 @@
    PUBLIC   usr_def_hgr   ! called in domhgr.F90
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -105,5 +107,5 @@
       IF( ln_bench ) THEN     ! benchmark: forced the resolution to be 106 km 
          ze1 = 106000._wp     ! but keep (lat,lon) at the right nn_GYRE resolution
-         CALL ctl_warn( ' GYRE used as Benchmark: e1=e2=106km, no need to adjust rdt, ahm,aht ' )
+         CALL ctl_warn( ' GYRE used as Benchmark: e1=e2=106km, no need to adjust rn_Dt, ahm,aht ' )
       ENDIF
       IF( nprint==1 .AND. lwp )   THEN
@@ -112,30 +114,28 @@
       ENDIF
       !   
-      DO jj = 1, jpj 
-         DO ji = 1, jpi 
-            zim1 = REAL( ji + nimpp - 1 ) - 1.   ;   zim05 = REAL( ji + nimpp - 1 ) - 1.5 
-            zjm1 = REAL( jj + njmpp - 1 ) - 1.   ;   zjm05 = REAL( jj + njmpp - 1 ) - 1.5 
-            !   
-            !glamt(i,j) longitude at T-point
-            !gphit(i,j) latitude at T-point  
-            plamt(ji,jj) = zlam0 + zim05 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha
-            pphit(ji,jj) = zphi0 - zim05 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha
-            !   
-            !glamu(i,j) longitude at U-point
-            !gphiu(i,j) latitude at U-point
-            plamu(ji,jj) = zlam0 + zim1  * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha
-            pphiu(ji,jj) = zphi0 - zim1  * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha
-            !   
-            !glamv(i,j) longitude at V-point
-            !gphiv(i,j) latitude at V-point
-            plamv(ji,jj) = zlam0 + zim05 * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha
-            pphiv(ji,jj) = zphi0 - zim05 * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha
-            !
-            !glamf(i,j) longitude at F-point
-            !gphif(i,j) latitude at F-point 
-            plamf(ji,jj) = zlam0 + zim1  * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha
-            pphif(ji,jj) = zphi0 - zim1  * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha
-         END DO
-      END DO
+      DO_2D_11_11
+         zim1 = REAL( ji + nimpp - 1 ) - 1.   ;   zim05 = REAL( ji + nimpp - 1 ) - 1.5 
+         zjm1 = REAL( jj + njmpp - 1 ) - 1.   ;   zjm05 = REAL( jj + njmpp - 1 ) - 1.5 
+         !   
+         !glamt(i,j) longitude at T-point
+         !gphit(i,j) latitude at T-point  
+         plamt(ji,jj) = zlam0 + zim05 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha
+         pphit(ji,jj) = zphi0 - zim05 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha
+         !   
+         !glamu(i,j) longitude at U-point
+         !gphiu(i,j) latitude at U-point
+         plamu(ji,jj) = zlam0 + zim1  * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha
+         pphiu(ji,jj) = zphi0 - zim1  * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha
+         !   
+         !glamv(i,j) longitude at V-point
+         !gphiv(i,j) latitude at V-point
+         plamv(ji,jj) = zlam0 + zim05 * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha
+         pphiv(ji,jj) = zphi0 - zim05 * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha
+         !
+         !glamf(i,j) longitude at F-point
+         !gphif(i,j) latitude at F-point 
+         plamf(ji,jj) = zlam0 + zim1  * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha
+         pphif(ji,jj) = zphi0 - zim1  * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha
+      END_2D
       !
       !                       !== Horizontal scale factors ==! (in meters)
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/USR/usrdef_istate.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/USR/usrdef_istate.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/USR/usrdef_istate.F90	(revision 12928)
@@ -24,4 +24,6 @@
    PUBLIC   usr_def_istate   ! called in istate.F90
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -59,24 +61,20 @@
       pssh(:,:)   = 0._wp
       !
-      DO jk = 1, jpk             ! horizontally uniform T & S profiles
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               pts(ji,jj,jk,jp_tem) =  (  (  16. - 12. * TANH( (pdept(ji,jj,jk) - 400) / 700 ) )   &
-                    &           * (-TANH( (500. - pdept(ji,jj,jk)) / 150. ) + 1.) / 2.             &
-                    &           + ( 15. * ( 1. - TANH( (pdept(ji,jj,jk)-50.) / 1500.) )            &
-                    &           - 1.4 * TANH((pdept(ji,jj,jk)-100.) / 100.)                        &
-                    &           + 7.  * (1500. - pdept(ji,jj,jk) ) / 1500.)                        &
-                    &           * (-TANH( (pdept(ji,jj,jk) - 500.) / 150.) + 1.) / 2.  ) * ptmask(ji,jj,jk)
+      DO_3D_11_11( 1, jpk )
+         pts(ji,jj,jk,jp_tem) =  (  (  16. - 12. * TANH( (pdept(ji,jj,jk) - 400) / 700 ) )   &
+              &           * (-TANH( (500. - pdept(ji,jj,jk)) / 150. ) + 1.) / 2.             &
+              &           + ( 15. * ( 1. - TANH( (pdept(ji,jj,jk)-50.) / 1500.) )            &
+              &           - 1.4 * TANH((pdept(ji,jj,jk)-100.) / 100.)                        &
+              &           + 7.  * (1500. - pdept(ji,jj,jk) ) / 1500.)                        &
+              &           * (-TANH( (pdept(ji,jj,jk) - 500.) / 150.) + 1.) / 2.  ) * ptmask(ji,jj,jk)
 
-               pts(ji,jj,jk,jp_sal) =  (  (  36.25 - 1.13 * TANH( (pdept(ji,jj,jk) - 305) / 460 ) )  &
-                    &         * (-TANH((500. - pdept(ji,jj,jk)) / 150.) + 1.) / 2                  &
-                    &         + ( 35.55 + 1.25 * (5000. - pdept(ji,jj,jk)) / 5000.                 &
-                    &         - 1.62 * TANH( (pdept(ji,jj,jk) - 60.  ) / 650. )                    &
-                    &         + 0.2  * TANH( (pdept(ji,jj,jk) - 35.  ) / 100. )                    &
-                    &         + 0.2  * TANH( (pdept(ji,jj,jk) - 1000.) / 5000.) )                  &
-                    &         * (-TANH( (pdept(ji,jj,jk) - 500.) / 150.) + 1.) / 2  ) * ptmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+         pts(ji,jj,jk,jp_sal) =  (  (  36.25 - 1.13 * TANH( (pdept(ji,jj,jk) - 305) / 460 ) )  &
+              &         * (-TANH((500. - pdept(ji,jj,jk)) / 150.) + 1.) / 2                  &
+              &         + ( 35.55 + 1.25 * (5000. - pdept(ji,jj,jk)) / 5000.                 &
+              &         - 1.62 * TANH( (pdept(ji,jj,jk) - 60.  ) / 650. )                    &
+              &         + 0.2  * TANH( (pdept(ji,jj,jk) - 35.  ) / 100. )                    &
+              &         + 0.2  * TANH( (pdept(ji,jj,jk) - 1000.) / 5000.) )                  &
+              &         * (-TANH( (pdept(ji,jj,jk) - 500.) / 150.) + 1.) / 2  ) * ptmask(ji,jj,jk)
+      END_3D
       !   
    END SUBROUTINE usr_def_istate
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/USR/usrdef_nam.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/USR/usrdef_nam.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/USR/usrdef_nam.F90	(revision 12928)
@@ -59,5 +59,4 @@
       !!----------------------------------------------------------------------
       !
-      REWIND( numnam_cfg )          ! Namelist namusr_def (exist in namelist_cfg only)
       READ  ( numnam_cfg, namusr_def, IOSTAT = ios, ERR = 902 )
 902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namusr_def in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/USR/usrdef_sbc.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/USR/usrdef_sbc.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/USR/usrdef_sbc.F90	(revision 12928)
@@ -31,5 +31,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -39,5 +39,5 @@
 CONTAINS
 
-   SUBROUTINE usrdef_sbc_oce( kt )
+   SUBROUTINE usrdef_sbc_oce( kt, Kbb )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE usrdef_sbc  ***
@@ -55,4 +55,5 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! ocean time step
+      INTEGER, INTENT(in) ::   Kbb  ! ocean time index
       !!
       INTEGER  ::   ji, jj                 ! dummy loop indices
@@ -88,5 +89,5 @@
 
       ! current day (in hours) since january the 1st of the current year
-      ztime = REAL( kt ) * rdt / (rmmss * rhhmm)   &       !  total incrementation (in hours)
+      ztime = REAL( kt ) * rn_Dt / (rmmss * rhhmm)   &       !  total incrementation (in hours)
          &      - (nyear  - 1) * rjjhh * zyydd             !  minus years since beginning of experiment (in hours)
 
@@ -109,26 +110,24 @@
       ztrp= - 40.e0        ! retroaction term on heat fluxes (W/m2/K)
       zconv = 3.16e-5      ! convertion factor: 1 m/yr => 3.16e-5 mm/s
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            ! domain from 15 deg to 50 deg between 27 and 28  degC at 15N, -3
-            ! and 13 degC at 50N 53.5 + or - 11 = 1/4 period :
-            ! 64.5 in summer, 42.5 in winter
-            t_star = zTstar * ( 1. + 1. / 50. * zcos_sais2 )                &
-               &                    * COS( rpi * (gphit(ji,jj) - 5.)               &
-               &                    / ( 53.5 * ( 1 + 11 / 53.5 * zcos_sais2 ) * 2.) )
-            ! 23.5 deg : tropics
-            qsr (ji,jj) =  230 * COS( 3.1415 * ( gphit(ji,jj) - 23.5 * zcos_sais1 ) / ( 0.9 * 180 ) )
-            qns (ji,jj) = ztrp * ( tsb(ji,jj,1,jp_tem) - t_star ) - qsr(ji,jj)
-            IF( gphit(ji,jj) >= 14.845 .AND. 37.2 >= gphit(ji,jj) ) THEN    ! zero at 37.8 deg, max at 24.6 deg
-               emp  (ji,jj) =   zemp_S * zconv   &
-                  &         * SIN( rpi / 2 * (gphit(ji,jj) - 37.2) / (24.6 - 37.2) )  &
-                  &         * ( 1 - zemp_sais / zemp_S * zcos_sais1)
-            ELSE
-               emp (ji,jj) =  - zemp_N * zconv   &
-                  &         * SIN( rpi / 2 * (gphit(ji,jj) - 37.2) / (46.8 - 37.2) )  &
-                  &         * ( 1 - zemp_sais / zemp_N * zcos_sais1 )
-            ENDIF
-         END DO
-      END DO
+      DO_2D_11_11
+         ! domain from 15 deg to 50 deg between 27 and 28  degC at 15N, -3
+         ! and 13 degC at 50N 53.5 + or - 11 = 1/4 period :
+         ! 64.5 in summer, 42.5 in winter
+         t_star = zTstar * ( 1. + 1. / 50. * zcos_sais2 )                &
+            &                    * COS( rpi * (gphit(ji,jj) - 5.)               &
+            &                    / ( 53.5 * ( 1 + 11 / 53.5 * zcos_sais2 ) * 2.) )
+         ! 23.5 deg : tropics
+         qsr (ji,jj) =  230 * COS( 3.1415 * ( gphit(ji,jj) - 23.5 * zcos_sais1 ) / ( 0.9 * 180 ) )
+         qns (ji,jj) = ztrp * ( ts(ji,jj,1,jp_tem,Kbb) - t_star ) - qsr(ji,jj)
+         IF( gphit(ji,jj) >= 14.845 .AND. 37.2 >= gphit(ji,jj) ) THEN    ! zero at 37.8 deg, max at 24.6 deg
+            emp  (ji,jj) =   zemp_S * zconv   &
+               &         * SIN( rpi / 2 * (gphit(ji,jj) - 37.2) / (24.6 - 37.2) )  &
+               &         * ( 1 - zemp_sais / zemp_S * zcos_sais1)
+         ELSE
+            emp (ji,jj) =  - zemp_N * zconv   &
+               &         * SIN( rpi / 2 * (gphit(ji,jj) - 37.2) / (46.8 - 37.2) )  &
+               &         * ( 1 - zemp_sais / zemp_N * zcos_sais1 )
+         ENDIF
+      END_2D
 
       zsumemp = GLOB_SUM( 'usrdef_sbc', emp  (:,:)   ) 
@@ -155,5 +154,5 @@
       !accumulates days of previous months of this year
       ! day (in hours) since january the 1st
-      ztime = FLOAT( kt ) * rdt / (rmmss * rhhmm)  &  ! incrementation in hour
+      ztime = FLOAT( kt ) * rn_Dt / (rmmss * rhhmm)  &  ! incrementation in hour
          &     - (nyear - 1) * rjjhh * zyydd          !  - nber of hours the precedent years
       ztimemax = ((5.*30.)+21.)* 24.               ! 21th june     in hours
@@ -166,24 +165,20 @@
       ztau_sais = 0.015
       ztaun = ztau - ztau_sais * COS( (ztime - ztimemax) / (ztimemin - ztimemax) * rpi )
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-           ! domain from 15deg to 50deg and 1/2 period along 14deg
-           ! so 5/4 of half period with seasonal cycle
-           utau(ji,jj) = - ztaun * SIN( rpi * (gphiu(ji,jj) - 15.) / (29.-15.) )
-           vtau(ji,jj) =   ztaun * SIN( rpi * (gphiv(ji,jj) - 15.) / (29.-15.) )
-         END DO
-      END DO
+      DO_2D_11_11
+        ! domain from 15deg to 50deg and 1/2 period along 14deg
+        ! so 5/4 of half period with seasonal cycle
+        utau(ji,jj) = - ztaun * SIN( rpi * (gphiu(ji,jj) - 15.) / (29.-15.) )
+        vtau(ji,jj) =   ztaun * SIN( rpi * (gphiv(ji,jj) - 15.) / (29.-15.) )
+      END_2D
 
       ! module of wind stress and wind speed at T-point
       zcoef = 1. / ( zrhoa * zcdrag ) 
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vect. opt.
-            ztx = utau(ji-1,jj  ) + utau(ji,jj) 
-            zty = vtau(ji  ,jj-1) + vtau(ji,jj) 
-            zmod = 0.5 * SQRT( ztx * ztx + zty * zty )
-            taum(ji,jj) = zmod
-            wndm(ji,jj) = SQRT( zmod * zcoef )
-         END DO
-      END DO
+      DO_2D_00_00
+         ztx = utau(ji-1,jj  ) + utau(ji,jj) 
+         zty = vtau(ji  ,jj-1) + vtau(ji,jj) 
+         zmod = 0.5 * SQRT( ztx * ztx + zty * zty )
+         taum(ji,jj) = zmod
+         wndm(ji,jj) = SQRT( zmod * zcoef )
+      END_2D
       CALL lbc_lnk_multi( 'usrdef_sbc', taum(:,:), 'T', 1. , wndm(:,:), 'T', 1. )
 
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/USR/usrdef_zgr.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/USR/usrdef_zgr.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/USR/usrdef_zgr.F90	(revision 12928)
@@ -29,6 +29,4 @@
    PUBLIC   usr_def_zgr        ! called by domzgr.F90
 
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -204,5 +202,5 @@
       CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. )           ! set surrounding land to zero (here jperio=0 ==>> closed)
       !
-      k_bot(:,:) = NINT( z2d(:,:) )           ! =jpkm1 over the ocean point, =0 elsewhere
+      k_bot(:,:) = NINT( z2d(:,:) )          ! =jpkm1 over the ocean point, =0 elsewhere
       !
       k_top(:,:) = MIN( 1 , k_bot(:,:) )     ! = 1    over the ocean point, =0 elsewhere
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfddm.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfddm.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfddm.F90	(revision 12928)
@@ -30,5 +30,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -38,5 +38,5 @@
 CONTAINS
 
-   SUBROUTINE zdf_ddm( kt, p_avm, p_avt, p_avs )
+   SUBROUTINE zdf_ddm( kt, Kmm, p_avm, p_avt, p_avs )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE zdf_ddm  ***
@@ -68,5 +68,6 @@
       !! References :   Merryfield et al., JPO, 29, 1124-1142, 1999.
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step indexocean time step
+      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index
+      INTEGER, INTENT(in   ) ::   Kmm      ! ocean time level index
       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   p_avm   !  Kz on momentum    (w-points)
       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   p_avt   !  Kz on temperature (w-points)
@@ -91,47 +92,43 @@
 !!gm                            and many acces in memory
          
-         DO jj = 1, jpj                !==  R=zrau = (alpha / beta) (dk[t] / dk[s])  ==!
-            DO ji = 1, jpi
-               zrw =   ( gdepw_n(ji,jj,jk  ) - gdept_n(ji,jj,jk) )   &
-!!gm please, use e3w_n below 
-                  &  / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) ) 
-               !
-               zaw = (  rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem) * zrw  )  &
-                   &    * tmask(ji,jj,jk) * tmask(ji,jj,jk-1)
-               zbw = (  rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal) * zrw  )  &
-                   &    * tmask(ji,jj,jk) * tmask(ji,jj,jk-1)
-               !
-               zdt = zaw * ( tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) )
-               zds = zbw * ( tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) 
-               IF( ABS( zds) <= 1.e-20_wp )   zds = 1.e-20_wp
-               zrau(ji,jj) = MAX(  1.e-20, zdt / zds  )    ! only retains positive value of zrau
-            END DO
-         END DO
+         DO_2D_11_11
+            zrw =   ( gdepw(ji,jj,jk  ,Kmm) - gdept(ji,jj,jk,Kmm) )   &
+!!gm please, use e3w(:,:,:,Kmm) below 
+               &  / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) ) 
+            !
+            zaw = (  rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem) * zrw  )  &
+                &    * tmask(ji,jj,jk) * tmask(ji,jj,jk-1)
+            zbw = (  rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal) * zrw  )  &
+                &    * tmask(ji,jj,jk) * tmask(ji,jj,jk-1)
+            !
+            zdt = zaw * ( ts(ji,jj,jk-1,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm) )
+            zds = zbw * ( ts(ji,jj,jk-1,jp_sal,Kmm) - ts(ji,jj,jk,jp_sal,Kmm) ) 
+            IF( ABS( zds) <= 1.e-20_wp )   zds = 1.e-20_wp
+            zrau(ji,jj) = MAX(  1.e-20, zdt / zds  )    ! only retains positive value of zrau
+         END_2D
 
-         DO jj = 1, jpj                !==  indicators  ==!
-            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._wp
-               ELSE                                       ;   zmsks(ji,jj) = 1._wp
-               ENDIF
-               ! salt fingering indicator: msksf=1 if R>1; 0 elsewhere            
-               IF( zrau(ji,jj) <= 1.             ) THEN   ;   zmskf(ji,jj) = 0._wp
-               ELSE                                       ;   zmskf(ji,jj) = 1._wp
-               ENDIF
-               ! diffusive layering indicators: 
-               !     ! mskdl1=1 if 0< R <1; 0 elsewhere
-               IF( zrau(ji,jj) >= 1.             ) THEN   ;   zmskd1(ji,jj) = 0._wp
-               ELSE                                       ;   zmskd1(ji,jj) = 1._wp
-               ENDIF
-               !     ! mskdl2=1 if 0< R <0.5; 0 elsewhere
-               IF( zrau(ji,jj) >= 0.5            ) THEN   ;   zmskd2(ji,jj) = 0._wp
-               ELSE                                       ;   zmskd2(ji,jj) = 1._wp
-               ENDIF
-               !   mskdl3=1 if 0.5< R <1; 0 elsewhere
-               IF( zrau(ji,jj) <= 0.5 .OR. zrau(ji,jj) >= 1. ) THEN   ;   zmskd3(ji,jj) = 0._wp
-               ELSE                                                   ;   zmskd3(ji,jj) = 1._wp
-               ENDIF
-            END DO
-         END DO
+         DO_2D_11_11
+            ! stability indicator: msks=1 if rn2>0; 0 elsewhere
+            IF( rn2(ji,jj,jk) + 1.e-12  <= 0. ) THEN   ;   zmsks(ji,jj) = 0._wp
+            ELSE                                       ;   zmsks(ji,jj) = 1._wp
+            ENDIF
+            ! salt fingering indicator: msksf=1 if R>1; 0 elsewhere            
+            IF( zrau(ji,jj) <= 1.             ) THEN   ;   zmskf(ji,jj) = 0._wp
+            ELSE                                       ;   zmskf(ji,jj) = 1._wp
+            ENDIF
+            ! diffusive layering indicators: 
+            !     ! mskdl1=1 if 0< R <1; 0 elsewhere
+            IF( zrau(ji,jj) >= 1.             ) THEN   ;   zmskd1(ji,jj) = 0._wp
+            ELSE                                       ;   zmskd1(ji,jj) = 1._wp
+            ENDIF
+            !     ! mskdl2=1 if 0< R <0.5; 0 elsewhere
+            IF( zrau(ji,jj) >= 0.5            ) THEN   ;   zmskd2(ji,jj) = 0._wp
+            ELSE                                       ;   zmskd2(ji,jj) = 1._wp
+            ENDIF
+            !   mskdl3=1 if 0.5< R <1; 0 elsewhere
+            IF( zrau(ji,jj) <= 0.5 .OR. zrau(ji,jj) >= 1. ) THEN   ;   zmskd3(ji,jj) = 0._wp
+            ELSE                                                   ;   zmskd3(ji,jj) = 1._wp
+            ENDIF
+         END_2D
          ! mask zmsk in order to have avt and avs masked
          zmsks(:,:) = zmsks(:,:) * wmask(:,:,jk)
@@ -141,27 +138,25 @@
          ! ------------------
          ! Constant eddy coefficient: reset to the background value
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zinr = 1._wp / zrau(ji,jj)
-               ! salt fingering
-               zrr = zrau(ji,jj) / rn_hsbfr
-               zrr = zrr * zrr
-               zavfs = rn_avts / ( 1 + zrr*zrr*zrr ) * zmsks(ji,jj) * zmskf(ji,jj)
-               zavft = 0.7 * zavfs * zinr
-               ! 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 * zrau(ji,jj) - 0.85 ) * zmskd3(ji,jj)   &
-                  &                             +  0.15 * zrau(ji,jj)          * zmskd2(ji,jj)  )
-               ! add to the eddy viscosity coef. previously computed
-               p_avs(ji,jj,jk) = p_avt(ji,jj,jk) + zavfs + zavds
-               p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zavft + zavdt
-               p_avm(ji,jj,jk) = p_avm(ji,jj,jk) + MAX( zavft + zavdt, zavfs + zavds )
-            END DO
-         END DO
+         DO_2D_11_11
+            zinr = 1._wp / zrau(ji,jj)
+            ! salt fingering
+            zrr = zrau(ji,jj) / rn_hsbfr
+            zrr = zrr * zrr
+            zavfs = rn_avts / ( 1 + zrr*zrr*zrr ) * zmsks(ji,jj) * zmskf(ji,jj)
+            zavft = 0.7 * zavfs * zinr
+            ! 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 * zrau(ji,jj) - 0.85 ) * zmskd3(ji,jj)   &
+               &                             +  0.15 * zrau(ji,jj)          * zmskd2(ji,jj)  )
+            ! add to the eddy viscosity coef. previously computed
+            p_avs(ji,jj,jk) = p_avt(ji,jj,jk) + zavfs + zavds
+            p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zavft + zavdt
+            p_avm(ji,jj,jk) = p_avm(ji,jj,jk) + MAX( zavft + zavdt, zavfs + zavds )
+         END_2D
          !                                                ! ===============
       END DO                                              !   End of slab
       !                                                   ! ===============
       !
-      IF(ln_ctl) THEN
+      IF(sn_cfctl%l_prtctl) THEN
          CALL prt_ctl(tab3d_1=avt , clinfo1=' ddm  - t: ', tab3d_2=avs , clinfo2=' s: ', kdim=jpk)
       ENDIF
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfdrg.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfdrg.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfdrg.F90	(revision 12928)
@@ -73,5 +73,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -81,5 +81,5 @@
 CONTAINS
 
-   SUBROUTINE zdf_drg( kt, k_mk, pCdmin, pCdmax, pz0, pke0, pCd0,   &   ! <<== in 
+   SUBROUTINE zdf_drg( kt, Kmm, k_mk, pCdmin, pCdmax, pz0, pke0, pCd0,   &   ! <<== in 
       &                                                     pCdU )      ! ==>> out : bottom drag [m/s]
       !!----------------------------------------------------------------------
@@ -99,4 +99,5 @@
       !!----------------------------------------------------------------------
       INTEGER                 , INTENT(in   ) ::   kt       ! ocean time-step index
+      INTEGER                 , INTENT(in   ) ::   Kmm      ! ocean time level index
       !                       !               !!         !==  top or bottom variables  ==!
       INTEGER , DIMENSION(:,:), INTENT(in   ) ::   k_mk     ! wet level (1st or last)
@@ -114,35 +115,31 @@
       !
       IF( l_log_not_linssh ) THEN     !==  "log layer"  ==!   compute Cd and -Cd*|U|
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               imk = k_mk(ji,jj)          ! ocean bottom level at t-points
-               zut = un(ji,jj,imk) + un(ji-1,jj,imk)     ! 2 x velocity at t-point
-               zvt = vn(ji,jj,imk) + vn(ji,jj-1,imk)
-               zzz = 0.5_wp * e3t_n(ji,jj,imk)           ! altitude below/above (top/bottom) the boundary
-               !
+         DO_2D_00_00
+            imk = k_mk(ji,jj)          ! ocean bottom level at t-points
+            zut = uu(ji,jj,imk,Kmm) + uu(ji-1,jj,imk,Kmm)     ! 2 x velocity at t-point
+            zvt = vv(ji,jj,imk,Kmm) + vv(ji,jj-1,imk,Kmm)
+            zzz = 0.5_wp * e3t(ji,jj,imk,Kmm)           ! altitude below/above (top/bottom) the boundary
+            !
 !!JC: possible WAD implementation should modify line below if layers vanish
-               zcd = (  vkarmn / LOG( zzz / pz0 )  )**2
-               zcd = pCd0(ji,jj) * MIN(  MAX( pCdmin , zcd ) , pCdmax  )   ! here pCd0 = mask*boost
-               pCdU(ji,jj) = - zcd * SQRT(  0.25 * ( zut*zut + zvt*zvt ) + pke0  )
-            END DO
-         END DO
+            zcd = (  vkarmn / LOG( zzz / pz0 )  )**2
+            zcd = pCd0(ji,jj) * MIN(  MAX( pCdmin , zcd ) , pCdmax  )   ! here pCd0 = mask*boost
+            pCdU(ji,jj) = - zcd * SQRT(  0.25 * ( zut*zut + zvt*zvt ) + pke0  )
+         END_2D
       ELSE                                            !==  standard Cd  ==!
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               imk = k_mk(ji,jj)    ! ocean bottom level at t-points
-               zut = un(ji,jj,imk) + un(ji-1,jj,imk)     ! 2 x velocity at t-point
-               zvt = vn(ji,jj,imk) + vn(ji,jj-1,imk)
-               !                                                           ! here pCd0 = mask*boost * drag
-               pCdU(ji,jj) = - pCd0(ji,jj) * SQRT(  0.25 * ( zut*zut + zvt*zvt ) + pke0  )
-            END DO
-         END DO
-      ENDIF
-      !
-      IF(ln_ctl)   CALL prt_ctl( tab2d_1=pCdU, clinfo1=' Cd*U ')
+         DO_2D_00_00
+            imk = k_mk(ji,jj)    ! ocean bottom level at t-points
+            zut = uu(ji,jj,imk,Kmm) + uu(ji-1,jj,imk,Kmm)     ! 2 x velocity at t-point
+            zvt = vv(ji,jj,imk,Kmm) + vv(ji,jj-1,imk,Kmm)
+            !                                                           ! here pCd0 = mask*boost * drag
+            pCdU(ji,jj) = - pCd0(ji,jj) * SQRT(  0.25 * ( zut*zut + zvt*zvt ) + pke0  )
+         END_2D
+      ENDIF
+      !
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=pCdU, clinfo1=' Cd*U ')
       !
    END SUBROUTINE zdf_drg
 
 
-   SUBROUTINE zdf_drg_exp( kt, pub, pvb, pua, pva )
+   SUBROUTINE zdf_drg_exp( kt, Kmm, pub, pvb, pua, pva )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE zdf_drg_exp  ***
@@ -157,4 +154,5 @@
       !!---------------------------------------------------------------------
       INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   Kmm        ! time level indices
       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pub, pvb   ! the two components of the before velocity
       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva   ! the two components of the velocity tendency
@@ -167,6 +165,6 @@
       !!---------------------------------------------------------------------
       !
-!!gm bug : time step is only rdt (not 2 rdt if euler start !)
-      zm1_2dt = - 1._wp / ( 2._wp * rdt )
+!!gm bug : time step is only rn_Dt (not 2 rn_Dt if euler start !)
+      zm1_2dt = - 1._wp / ( 2._wp * rn_Dt )
 
       IF( l_trddyn ) THEN      ! trends: store the input trends
@@ -176,32 +174,28 @@
       ENDIF
 
-      DO jj = 2, jpjm1
-         DO ji = 2, jpim1
-            ikbu = mbku(ji,jj)          ! deepest wet ocean u- & v-levels
-            ikbv = mbkv(ji,jj)
+      DO_2D_00_00
+         ikbu = mbku(ji,jj)          ! deepest wet ocean u- & v-levels
+         ikbv = mbkv(ji,jj)
+         !
+         ! Apply stability criteria on absolute value  : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt)
+         zCdu = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / e3u(ji,jj,ikbu,Kmm)
+         zCdv = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / e3v(ji,jj,ikbv,Kmm)
+         !
+         pua(ji,jj,ikbu) = pua(ji,jj,ikbu) + MAX(  zCdu , zm1_2dt  ) * pub(ji,jj,ikbu)
+         pva(ji,jj,ikbv) = pva(ji,jj,ikbv) + MAX(  zCdv , zm1_2dt  ) * pvb(ji,jj,ikbv)
+      END_2D
+      !
+      IF( ln_isfcav ) THEN        ! ocean cavities
+         DO_2D_00_00
+            ikbu = miku(ji,jj)          ! first wet ocean u- & v-levels
+            ikbv = mikv(ji,jj)
             !
             ! Apply stability criteria on absolute value  : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt)
-            zCdu = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / e3u_n(ji,jj,ikbu)
-            zCdv = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / e3v_n(ji,jj,ikbv)
+            zCdu = 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / e3u(ji,jj,ikbu,Kmm)    ! NB: Cdtop masked
+            zCdv = 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) / e3v(ji,jj,ikbv,Kmm)
             !
             pua(ji,jj,ikbu) = pua(ji,jj,ikbu) + MAX(  zCdu , zm1_2dt  ) * pub(ji,jj,ikbu)
             pva(ji,jj,ikbv) = pva(ji,jj,ikbv) + MAX(  zCdv , zm1_2dt  ) * pvb(ji,jj,ikbv)
-         END DO
-      END DO
-      !
-      IF( ln_isfcav ) THEN        ! ocean cavities
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               ikbu = miku(ji,jj)          ! first wet ocean u- & v-levels
-               ikbv = mikv(ji,jj)
-               !
-               ! Apply stability criteria on absolute value  : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt)
-               zCdu = 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / e3u_n(ji,jj,ikbu)    ! NB: Cdtop masked
-               zCdv = 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) / e3v_n(ji,jj,ikbv)
-               !
-               pua(ji,jj,ikbu) = pua(ji,jj,ikbu) + MAX(  zCdu , zm1_2dt  ) * pub(ji,jj,ikbu)
-               pva(ji,jj,ikbv) = pva(ji,jj,ikbv) + MAX(  zCdv , zm1_2dt  ) * pvb(ji,jj,ikbv)
-           END DO
-         END DO
+         END_2D
       ENDIF
       !
@@ -209,10 +203,10 @@
          ztrdu(:,:,:) = pua(:,:,:) - ztrdu(:,:,:)
          ztrdv(:,:,:) = pva(:,:,:) - ztrdv(:,:,:)
-         CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt )
+         CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt, Kmm )
          DEALLOCATE( ztrdu, ztrdv )
       ENDIF
       !                                          ! print mean trends (used for debugging)
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pua, clinfo1=' bfr  - Ua: ', mask1=umask,               &
-         &                       tab3d_2=pva, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pua, clinfo1=' bfr  - Ua: ', mask1=umask,               &
+         &                                  tab3d_2=pva, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
       !
    END SUBROUTINE zdf_drg_exp
@@ -236,8 +230,6 @@
       !                     !==  drag nature  ==!
       !
-      REWIND( numnam_ref )                   ! Namelist namdrg in reference namelist
       READ  ( numnam_ref, namdrg, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam( ios , 'namdrg in reference namelist' )
-      REWIND( numnam_cfg )                   ! Namelist namdrg in configuration namelist
       READ  ( numnam_cfg, namdrg, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam( ios , 'namdrg in configuration namelist' )
@@ -335,9 +327,7 @@
       !                          !==  read namlist  ==!
       !
-      REWIND( numnam_ref )                   ! Namelist cl_namdrg in reference namelist
       IF(ll_top)   READ  ( numnam_ref, namdrg_top, IOSTAT = ios, ERR = 901)
       IF(ll_bot)   READ  ( numnam_ref, namdrg_bot, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam( ios , TRIM(cl_namref) )
-      REWIND( numnam_cfg )                   ! Namelist cd_namdrg in configuration namelist
       IF(ll_top)   READ  ( numnam_cfg, namdrg_top, IOSTAT = ios, ERR = 902 )
       IF(ll_bot)   READ  ( numnam_cfg, namdrg_bot, IOSTAT = ios, ERR = 902 )
@@ -431,11 +421,9 @@
             l_log_not_linssh = .FALSE.    !- don't update Cd at each time step
             !
-            DO jj = 1, jpj                   ! pCd0 = mask (and boosted) logarithmic drag coef. 
-               DO ji = 1, jpi
-                  zzz =  0.5_wp * e3t_0(ji,jj,k_mk(ji,jj))
-                  zcd = (  vkarmn / LOG( zzz / rn_z0 )  )**2
-                  pCd0(ji,jj) = zmsk_boost(ji,jj) * MIN(  MAX( rn_Cd0 , zcd ) , rn_Cdmax  )  ! rn_Cd0 < Cd0 < rn_Cdmax
-               END DO
-            END DO
+            DO_2D_11_11
+               zzz =  0.5_wp * e3t_0(ji,jj,k_mk(ji,jj))
+               zcd = (  vkarmn / LOG( zzz / rn_z0 )  )**2
+               pCd0(ji,jj) = zmsk_boost(ji,jj) * MIN(  MAX( rn_Cd0 , zcd ) , rn_Cdmax  )  ! rn_Cd0 < Cd0 < rn_Cdmax
+            END_2D
          ELSE                       !* Cd updated at each time-step ==> pCd0 = mask * boost
             IF(lwp) WRITE(numout,*)
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfevd.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfevd.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfevd.F90	(revision 12928)
@@ -31,4 +31,6 @@
    PUBLIC   zdf_evd    ! called by step.F90
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -38,5 +40,5 @@
 CONTAINS
 
-   SUBROUTINE zdf_evd( kt, p_avm, p_avt )
+   SUBROUTINE zdf_evd( kt, Kmm, Krhs, p_avm, p_avt )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE zdf_evd  ***
@@ -56,4 +58,5 @@
       !!----------------------------------------------------------------------
       INTEGER                    , INTENT(in   ) ::   kt             ! ocean time-step indexocean time step
+      INTEGER                    , INTENT(in   ) ::   Kmm, Krhs      ! time level indices
       REAL(wp), DIMENSION(:,:,:) , INTENT(inout) ::   p_avm, p_avt   !  momentum and tracer Kz (w-points)
       !
@@ -84,14 +87,10 @@
 !         END WHERE
          !
-         DO jk = 1, jpkm1 
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) THEN
-                     p_avt(ji,jj,jk) = rn_evd * wmask(ji,jj,jk)
-                     p_avm(ji,jj,jk) = rn_evd * wmask(ji,jj,jk)
-                  ENDIF
-               END DO
-            END DO
-         END DO 
+         DO_3D_00_00( 1, jpkm1 )
+            IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) THEN
+               p_avt(ji,jj,jk) = rn_evd * wmask(ji,jj,jk)
+               p_avm(ji,jj,jk) = rn_evd * wmask(ji,jj,jk)
+            ENDIF
+         END_3D
          !
          zavm_evd(:,:,:) = p_avm(:,:,:) - zavm_evd(:,:,:)   ! change in avm due to evd
@@ -104,12 +103,8 @@
 !         END WHERE
 
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 )   &
-                     p_avt(ji,jj,jk) = rn_evd * wmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 )   &
+               p_avt(ji,jj,jk) = rn_evd * wmask(ji,jj,jk)
+         END_3D
          !
       END SELECT 
@@ -117,5 +112,5 @@
       zavt_evd(:,:,:) = p_avt(:,:,:) - zavt_evd(:,:,:)   ! change in avt due to evd
       CALL iom_put( "avt_evd", zavt_evd )              ! output this change
-      IF( l_trdtra ) CALL trd_tra( kt, 'TRA', jp_tem, jptra_evd, zavt_evd )
+      IF( l_trdtra ) CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_evd, zavt_evd )
       !
    END SUBROUTINE zdf_evd
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfgls.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfgls.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfgls.F90	(revision 12928)
@@ -104,5 +104,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -124,5 +124,5 @@
 
 
-   SUBROUTINE zdf_gls( kt, p_sh2, p_avm, p_avt )
+   SUBROUTINE zdf_gls( kt, Kbb, Kmm, p_sh2, p_avm, p_avt )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE zdf_gls  ***
@@ -134,4 +134,5 @@
       !!
       INTEGER                   , INTENT(in   ) ::   kt             ! ocean time step
+      INTEGER                   , INTENT(in   ) ::   Kbb, Kmm       ! ocean time level indices
       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   p_sh2          ! shear production term
       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   p_avm, p_avt   !  momentum and tracer Kz (w-points)
@@ -166,27 +167,23 @@
 
       ! Compute surface, top and bottom friction at T-points
-      DO jj = 2, jpjm1          
-         DO ji = fs_2, fs_jpim1   ! vector opt.         
-            !
-            ! surface friction
-            ustar2_surf(ji,jj) = r1_rau0 * taum(ji,jj) * tmask(ji,jj,1)
-            !   
+      DO_2D_00_00
+         !
+         ! surface friction
+         ustar2_surf(ji,jj) = r1_rho0 * taum(ji,jj) * tmask(ji,jj,1)
+         !   
 !!gm Rq we may add here r_ke0(_top/_bot) ?  ==>> think about that...
-          ! bottom friction (explicit before friction)
-          zmsku = ( 2._wp - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) )
-          zmskv = ( 2._wp - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) )     ! (CAUTION: CdU<0)
-          ustar2_bot(ji,jj) = - rCdU_bot(ji,jj) * SQRT(  ( zmsku*( ub(ji,jj,mbkt(ji,jj))+ub(ji-1,jj,mbkt(ji,jj)) ) )**2  &
-             &                                         + ( zmskv*( vb(ji,jj,mbkt(ji,jj))+vb(ji,jj-1,mbkt(ji,jj)) ) )**2  )
-         END DO
-      END DO
+       ! bottom friction (explicit before friction)
+       zmsku = ( 2._wp - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) )
+       zmskv = ( 2._wp - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) )     ! (CAUTION: CdU<0)
+       ustar2_bot(ji,jj) = - rCdU_bot(ji,jj) * SQRT(  ( zmsku*( uu(ji,jj,mbkt(ji,jj),Kbb)+uu(ji-1,jj,mbkt(ji,jj),Kbb) ) )**2  &
+          &                                         + ( zmskv*( vv(ji,jj,mbkt(ji,jj),Kbb)+vv(ji,jj-1,mbkt(ji,jj),Kbb) ) )**2  )
+      END_2D
       IF( ln_isfcav ) THEN       !top friction
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) )
-               zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) )     ! (CAUTION: CdU<0)
-               ustar2_top(ji,jj) = - rCdU_top(ji,jj) * SQRT(  ( zmsku*( ub(ji,jj,mikt(ji,jj))+ub(ji-1,jj,mikt(ji,jj)) ) )**2  &
-                  &                                         + ( zmskv*( vb(ji,jj,mikt(ji,jj))+vb(ji,jj-1,mikt(ji,jj)) ) )**2  )
-            END DO
-         END DO
+         DO_2D_00_00
+            zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) )
+            zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) )     ! (CAUTION: CdU<0)
+            ustar2_top(ji,jj) = - rCdU_top(ji,jj) * SQRT(  ( zmsku*( uu(ji,jj,mikt(ji,jj),Kbb)+uu(ji-1,jj,mikt(ji,jj),Kbb) ) )**2  &
+               &                                         + ( zmskv*( vv(ji,jj,mikt(ji,jj),Kbb)+vv(ji,jj-1,mikt(ji,jj),Kbb) ) )**2  )
+         END_2D
       ENDIF
    
@@ -206,11 +203,7 @@
       END SELECT
       !
-      DO jk = 2, jpkm1              !==  Compute dissipation rate  ==!
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               eps(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / hmxl_n(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D_10_10( 2, jpkm1 )
+         eps(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / hmxl_n(ji,jj,jk)
+      END_3D
 
       ! Save tke at before time step
@@ -219,14 +212,10 @@
 
       IF( nn_clos == 0 ) THEN    ! Mellor-Yamada
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1 
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zup   = hmxl_n(ji,jj,jk) * gdepw_n(ji,jj,mbkt(ji,jj)+1)
-                  zdown = vkarmn * gdepw_n(ji,jj,jk) * ( -gdepw_n(ji,jj,jk) + gdepw_n(ji,jj,mbkt(ji,jj)+1) )
-                  zcoef = ( zup / MAX( zdown, rsmall ) )
-                  zwall (ji,jj,jk) = ( 1._wp + re2 * zcoef*zcoef ) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 2, jpkm1 )
+            zup   = hmxl_n(ji,jj,jk) * gdepw(ji,jj,mbkt(ji,jj)+1,Kmm)
+            zdown = vkarmn * gdepw(ji,jj,jk,Kmm) * ( -gdepw(ji,jj,jk,Kmm) + gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) )
+            zcoef = ( zup / MAX( zdown, rsmall ) )
+            zwall (ji,jj,jk) = ( 1._wp + re2 * zcoef*zcoef ) * tmask(ji,jj,jk)
+         END_3D
       ENDIF
 
@@ -244,46 +233,42 @@
       ! Warning : after this step, en : right hand side of the matrix
 
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               !
-               buoy = - p_avt(ji,jj,jk) * rn2(ji,jj,jk)     ! stratif. destruction
-               !
-               diss = eps(ji,jj,jk)                         ! dissipation
-               !
-               zdir = 0.5_wp + SIGN( 0.5_wp, p_sh2(ji,jj,jk) + buoy )   ! zdir =1(=0) if shear(ji,jj,jk)+buoy >0(<0)
-               !
-               zesh2 = zdir*(p_sh2(ji,jj,jk)+buoy)+(1._wp-zdir)*p_sh2(ji,jj,jk)          ! production term
-               zdiss = zdir*(diss/en(ji,jj,jk))   +(1._wp-zdir)*(diss-buoy)/en(ji,jj,jk) ! dissipation term
+      DO_3D_00_00( 2, jpkm1 )
+         !
+         buoy = - p_avt(ji,jj,jk) * rn2(ji,jj,jk)     ! stratif. destruction
+         !
+         diss = eps(ji,jj,jk)                         ! dissipation
+         !
+         zdir = 0.5_wp + SIGN( 0.5_wp, p_sh2(ji,jj,jk) + buoy )   ! zdir =1(=0) if shear(ji,jj,jk)+buoy >0(<0)
+         !
+         zesh2 = zdir*(p_sh2(ji,jj,jk)+buoy)+(1._wp-zdir)*p_sh2(ji,jj,jk)          ! production term
+         zdiss = zdir*(diss/en(ji,jj,jk))   +(1._wp-zdir)*(diss-buoy)/en(ji,jj,jk) ! dissipation term
 !!gm better coding, identical results
 !               zesh2 =   p_sh2(ji,jj,jk) + zdir*buoy               ! production term
 !               zdiss = ( diss - (1._wp-zdir)*buoy ) / en(ji,jj,jk) ! dissipation term
 !!gm
-               !
-               ! Compute a wall function from 1. to rsc_psi*zwall/rsc_psi0
-               ! Note that as long that Dirichlet boundary conditions are NOT set at the first and last levels (GOTM style)
-               ! there is no need to set a boundary condition for zwall_psi at the top and bottom boundaries.
-               ! Otherwise, this should be rsc_psi/rsc_psi0
-               IF( ln_sigpsi ) THEN
-                  zsigpsi = MIN( 1._wp, zesh2 / eps(ji,jj,jk) )     ! 0. <= zsigpsi <= 1.
-                  zwall_psi(ji,jj,jk) = rsc_psi /   & 
-                     &     (  zsigpsi * rsc_psi + (1._wp-zsigpsi) * rsc_psi0 / MAX( zwall(ji,jj,jk), 1._wp )  )
-               ELSE
-                  zwall_psi(ji,jj,jk) = 1._wp
-               ENDIF
-               !
-               ! building the matrix
-               zcof = rfact_tke * tmask(ji,jj,jk)
-               !                                        ! lower diagonal, in fact not used for jk = 2 (see surface conditions)
-               zd_lw(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk  ) + p_avm(ji,jj,jk-1) ) / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk) )
-               !                                        ! upper diagonal, in fact not used for jk = ibotm1 (see bottom conditions)
-               zd_up(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk  ) ) / ( e3t_n(ji,jj,jk  ) * e3w_n(ji,jj,jk) )
-               !                                        ! diagonal
-               zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk)  + rdt * zdiss * wmask(ji,jj,jk) 
-               !                                        ! right hand side in en
-               en(ji,jj,jk) = en(ji,jj,jk) + rdt * zesh2 * wmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+         !
+         ! Compute a wall function from 1. to rsc_psi*zwall/rsc_psi0
+         ! Note that as long that Dirichlet boundary conditions are NOT set at the first and last levels (GOTM style)
+         ! there is no need to set a boundary condition for zwall_psi at the top and bottom boundaries.
+         ! Otherwise, this should be rsc_psi/rsc_psi0
+         IF( ln_sigpsi ) THEN
+            zsigpsi = MIN( 1._wp, zesh2 / eps(ji,jj,jk) )     ! 0. <= zsigpsi <= 1.
+            zwall_psi(ji,jj,jk) = rsc_psi /   & 
+               &     (  zsigpsi * rsc_psi + (1._wp-zsigpsi) * rsc_psi0 / MAX( zwall(ji,jj,jk), 1._wp )  )
+         ELSE
+            zwall_psi(ji,jj,jk) = 1._wp
+         ENDIF
+         !
+         ! building the matrix
+         zcof = rfact_tke * tmask(ji,jj,jk)
+         !                                        ! lower diagonal, in fact not used for jk = 2 (see surface conditions)
+         zd_lw(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk  ) + p_avm(ji,jj,jk-1) ) / ( e3t(ji,jj,jk-1,Kmm) * e3w(ji,jj,jk,Kmm) )
+         !                                        ! upper diagonal, in fact not used for jk = ibotm1 (see bottom conditions)
+         zd_up(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk  ) ) / ( e3t(ji,jj,jk  ,Kmm) * e3w(ji,jj,jk,Kmm) )
+         !                                        ! diagonal
+         zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk)  + rn_Dt * zdiss * wmask(ji,jj,jk) 
+         !                                        ! right hand side in en
+         en(ji,jj,jk) = en(ji,jj,jk) + rn_Dt * zesh2 * wmask(ji,jj,jk)
+      END_3D
       !
       zdiag(:,:,jpk) = 1._wp
@@ -306,5 +291,5 @@
       ! 
       ! One level below
-      en   (:,:,2) =  MAX(  rc02r * ustar2_surf(:,:) * (  1._wp + rsbc_tke1 * ((zhsro(:,:)+gdepw_n(:,:,2))   &
+      en   (:,:,2) =  MAX(  rc02r * ustar2_surf(:,:) * (  1._wp + rsbc_tke1 * ((zhsro(:,:)+gdepw(:,:,2,Kmm))   &
          &                 / zhsro(:,:) )**(1.5_wp*ra_sf)  )**(2._wp/3._wp)                      , rn_emin   )
       zd_lw(:,:,2) = 0._wp 
@@ -325,9 +310,9 @@
       zdiag(:,:,2) = zdiag(:,:,2) +  zd_lw(:,:,2) ! Remove zd_lw from zdiag
       zd_lw(:,:,2) = 0._wp
-      zkar (:,:)   = (rl_sf + (vkarmn-rl_sf)*(1.-EXP(-rtrans*gdept_n(:,:,1)/zhsro(:,:)) ))
+      zkar (:,:)   = (rl_sf + (vkarmn-rl_sf)*(1.-EXP(-rtrans*gdept(:,:,1,Kmm)/zhsro(:,:)) ))
       zflxs(:,:)   = rsbc_tke2 * ustar2_surf(:,:)**1.5_wp * zkar(:,:) &
-          &                    * (  ( zhsro(:,:)+gdept_n(:,:,1) ) / zhsro(:,:)  )**(1.5_wp*ra_sf)
-!!gm why not   :                        * ( 1._wp + gdept_n(:,:,1) / zhsro(:,:) )**(1.5_wp*ra_sf)
-      en(:,:,2) = en(:,:,2) + zflxs(:,:) / e3w_n(:,:,2)
+          &                    * (  ( zhsro(:,:)+gdept(:,:,1,Kmm) ) / zhsro(:,:)  )**(1.5_wp*ra_sf)
+!!gm why not   :                        * ( 1._wp + gdept(:,:,1,Kmm) / zhsro(:,:) )**(1.5_wp*ra_sf)
+      en(:,:,2) = en(:,:,2) + zflxs(:,:) / e3w(:,:,2,Kmm)
       !
       !
@@ -342,75 +327,67 @@
          !                      ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = rn_lmin
          !                      ! Balance between the production and the dissipation terms
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
+         DO_2D_00_00
 !!gm This means that bottom and ocean w-level above have a specified "en" value.   Sure ????
 !!   With thick deep ocean level thickness, this may be quite large, no ???
 !!   in particular in ocean cavities where top stratification can be large...
-               ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
-               ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1
+            ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
+            ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1
+            !
+            z_en =  MAX( rc02r * ustar2_bot(ji,jj), rn_emin )
+            !
+            ! Dirichlet condition applied at: 
+            !     Bottom level (ibot)      &      Just above it (ibotm1)   
+            zd_lw(ji,jj,ibot) = 0._wp   ;   zd_lw(ji,jj,ibotm1) = 0._wp
+            zd_up(ji,jj,ibot) = 0._wp   ;   zd_up(ji,jj,ibotm1) = 0._wp
+            zdiag(ji,jj,ibot) = 1._wp   ;   zdiag(ji,jj,ibotm1) = 1._wp
+            en   (ji,jj,ibot) = z_en    ;   en   (ji,jj,ibotm1) = z_en
+         END_2D
+         !
+         IF( ln_isfcav) THEN     ! top boundary   (ocean cavity)
+            DO_2D_00_00
+               itop   = mikt(ji,jj)       ! k   top w-point
+               itopp1 = mikt(ji,jj) + 1   ! k+1 1st w-point below the top one
+               !                                                ! mask at the ocean surface points
+               z_en = MAX( rc02r * ustar2_top(ji,jj), rn_emin ) * ( 1._wp - tmask(ji,jj,1) )
                !
-               z_en =  MAX( rc02r * ustar2_bot(ji,jj), rn_emin )
-               !
+ !!gm TO BE VERIFIED !!!
                ! Dirichlet condition applied at: 
-               !     Bottom level (ibot)      &      Just above it (ibotm1)   
-               zd_lw(ji,jj,ibot) = 0._wp   ;   zd_lw(ji,jj,ibotm1) = 0._wp
-               zd_up(ji,jj,ibot) = 0._wp   ;   zd_up(ji,jj,ibotm1) = 0._wp
-               zdiag(ji,jj,ibot) = 1._wp   ;   zdiag(ji,jj,ibotm1) = 1._wp
-               en   (ji,jj,ibot) = z_en    ;   en   (ji,jj,ibotm1) = z_en
-            END DO
-         END DO
-         !
-         IF( ln_isfcav) THEN     ! top boundary   (ocean cavity)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  itop   = mikt(ji,jj)       ! k   top w-point
-                  itopp1 = mikt(ji,jj) + 1   ! k+1 1st w-point below the top one
-                  !                                                ! mask at the ocean surface points
-                  z_en = MAX( rc02r * ustar2_top(ji,jj), rn_emin ) * ( 1._wp - tmask(ji,jj,1) )
-                  !
- !!gm TO BE VERIFIED !!!
-                  ! Dirichlet condition applied at: 
-                  !     top level (itop)         &      Just below it (itopp1)   
-                  zd_lw(ji,jj,itop) = 0._wp   ;   zd_lw(ji,jj,itopp1) = 0._wp
-                  zd_up(ji,jj,itop) = 0._wp   ;   zd_up(ji,jj,itopp1) = 0._wp
-                  zdiag(ji,jj,itop) = 1._wp   ;   zdiag(ji,jj,itopp1) = 1._wp
-                  en   (ji,jj,itop) = z_en    ;   en   (ji,jj,itopp1) = z_en
-               END DO
-            END DO
+               !     top level (itop)         &      Just below it (itopp1)   
+               zd_lw(ji,jj,itop) = 0._wp   ;   zd_lw(ji,jj,itopp1) = 0._wp
+               zd_up(ji,jj,itop) = 0._wp   ;   zd_up(ji,jj,itopp1) = 0._wp
+               zdiag(ji,jj,itop) = 1._wp   ;   zdiag(ji,jj,itopp1) = 1._wp
+               en   (ji,jj,itop) = z_en    ;   en   (ji,jj,itopp1) = z_en
+            END_2D
          ENDIF
          !
       CASE ( 1 )             ! Neumman boundary condition
          !                      
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
-               ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1
-               !
-               z_en =  MAX( rc02r * ustar2_bot(ji,jj), rn_emin )
+         DO_2D_00_00
+            ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
+            ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1
+            !
+            z_en =  MAX( rc02r * ustar2_bot(ji,jj), rn_emin )
+            !
+            ! Bottom level Dirichlet condition:
+            !     Bottom level (ibot)      &      Just above it (ibotm1)   
+            !         Dirichlet            !         Neumann
+            zd_lw(ji,jj,ibot) = 0._wp   !   ! Remove zd_up from zdiag
+            zdiag(ji,jj,ibot) = 1._wp   ;   zdiag(ji,jj,ibotm1) = zdiag(ji,jj,ibotm1) + zd_up(ji,jj,ibotm1)
+            zd_up(ji,jj,ibot) = 0._wp   ;   zd_up(ji,jj,ibotm1) = 0._wp
+         END_2D
+         IF( ln_isfcav) THEN     ! top boundary   (ocean cavity)
+            DO_2D_00_00
+               itop   = mikt(ji,jj)       ! k   top w-point
+               itopp1 = mikt(ji,jj) + 1   ! k+1 1st w-point below the top one
+               !                                                ! mask at the ocean surface points
+               z_en = MAX( rc02r * ustar2_top(ji,jj), rn_emin ) * ( 1._wp - tmask(ji,jj,1) )
                !
                ! Bottom level Dirichlet condition:
                !     Bottom level (ibot)      &      Just above it (ibotm1)   
                !         Dirichlet            !         Neumann
-               zd_lw(ji,jj,ibot) = 0._wp   !   ! Remove zd_up from zdiag
-               zdiag(ji,jj,ibot) = 1._wp   ;   zdiag(ji,jj,ibotm1) = zdiag(ji,jj,ibotm1) + zd_up(ji,jj,ibotm1)
-               zd_up(ji,jj,ibot) = 0._wp   ;   zd_up(ji,jj,ibotm1) = 0._wp
-            END DO
-         END DO
-         IF( ln_isfcav) THEN     ! top boundary   (ocean cavity)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  itop   = mikt(ji,jj)       ! k   top w-point
-                  itopp1 = mikt(ji,jj) + 1   ! k+1 1st w-point below the top one
-                  !                                                ! mask at the ocean surface points
-                  z_en = MAX( rc02r * ustar2_top(ji,jj), rn_emin ) * ( 1._wp - tmask(ji,jj,1) )
-                  !
-                  ! Bottom level Dirichlet condition:
-                  !     Bottom level (ibot)      &      Just above it (ibotm1)   
-                  !         Dirichlet            !         Neumann
-                  zd_lw(ji,jj,itop) = 0._wp   !   ! Remove zd_up from zdiag
-                  zdiag(ji,jj,itop) = 1._wp   ;   zdiag(ji,jj,itopp1) = zdiag(ji,jj,itopp1) + zd_up(ji,jj,itopp1)
-                  zd_up(ji,jj,itop) = 0._wp   ;   zd_up(ji,jj,itopp1) = 0._wp
-               END DO
-            END DO
+               zd_lw(ji,jj,itop) = 0._wp   !   ! Remove zd_up from zdiag
+               zdiag(ji,jj,itop) = 1._wp   ;   zdiag(ji,jj,itopp1) = zdiag(ji,jj,itopp1) + zd_up(ji,jj,itopp1)
+               zd_up(ji,jj,itop) = 0._wp   ;   zd_up(ji,jj,itopp1) = 0._wp
+            END_2D
          ENDIF
          !
@@ -420,25 +397,13 @@
       ! ----------------------------------------------------------
       !
-      DO jk = 2, jpkm1                             ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1    ! vector opt.
-               zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-      DO jk = 2, jpk                               ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1    ! vector opt.
-               zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-      DO jk = jpk-1, 2, -1                         ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1    ! vector opt.
-               en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 2, jpkm1 )
+         zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1)
+      END_3D
+      DO_3D_00_00( 2, jpk )
+         zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1)
+      END_3D
+      DO_3DS_00_00( jpk-1, 2, -1 )
+         en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk)
+      END_3D
       !                                            ! set the minimum value of tke 
       en(:,:,:) = MAX( en(:,:,:), rn_emin )
@@ -453,38 +418,22 @@
       !
       CASE( 0 )               ! k-kl  (Mellor-Yamada)
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  psi(ji,jj,jk)  = eb(ji,jj,jk) * hmxl_b(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 2, jpkm1 )
+            psi(ji,jj,jk)  = eb(ji,jj,jk) * hmxl_b(ji,jj,jk)
+         END_3D
          !
       CASE( 1 )               ! k-eps
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  psi(ji,jj,jk)  = eps(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 2, jpkm1 )
+            psi(ji,jj,jk)  = eps(ji,jj,jk)
+         END_3D
          !
       CASE( 2 )               ! k-w
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  psi(ji,jj,jk)  = SQRT( eb(ji,jj,jk) ) / ( rc0 * hmxl_b(ji,jj,jk) )
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 2, jpkm1 )
+            psi(ji,jj,jk)  = SQRT( eb(ji,jj,jk) ) / ( rc0 * hmxl_b(ji,jj,jk) )
+         END_3D
          !
       CASE( 3 )               ! generic
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  psi(ji,jj,jk)  = rc02 * eb(ji,jj,jk) * hmxl_b(ji,jj,jk)**rnn 
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 2, jpkm1 )
+            psi(ji,jj,jk)  = rc02 * eb(ji,jj,jk) * hmxl_b(ji,jj,jk)**rnn 
+         END_3D
          !
       END SELECT
@@ -497,43 +446,39 @@
       ! Warning : after this step, en : right hand side of the matrix
 
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               !
-               ! psi / k
-               zratio = psi(ji,jj,jk) / eb(ji,jj,jk) 
-               !
-               ! psi3+ : stable : B=-KhN²<0 => N²>0 if rn2>0 zdir = 1 (stable) otherwise zdir = 0 (unstable)
-               zdir = 0.5_wp + SIGN( 0.5_wp, rn2(ji,jj,jk) )
-               !
-               rpsi3 = zdir * rpsi3m + ( 1._wp - zdir ) * rpsi3p
-               !
-               ! shear prod. - stratif. destruction
-               prod = rpsi1 * zratio * p_sh2(ji,jj,jk)
-               !
-               ! stratif. destruction
-               buoy = rpsi3 * zratio * (- p_avt(ji,jj,jk) * rn2(ji,jj,jk) )
-               !
-               ! shear prod. - stratif. destruction
-               diss = rpsi2 * zratio * zwall(ji,jj,jk) * eps(ji,jj,jk)
-               !
-               zdir = 0.5_wp + SIGN( 0.5_wp, prod + buoy )     ! zdir =1(=0) if shear(ji,jj,jk)+buoy >0(<0)
-               !
-               zesh2 = zdir * ( prod + buoy )          + (1._wp - zdir ) * prod                        ! production term
-               zdiss = zdir * ( diss / psi(ji,jj,jk) ) + (1._wp - zdir ) * (diss-buoy) / psi(ji,jj,jk) ! dissipation term
-               !                                                        
-               ! building the matrix
-               zcof = rfact_psi * zwall_psi(ji,jj,jk) * tmask(ji,jj,jk)
-               !                                               ! lower diagonal
-               zd_lw(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk  ) + p_avm(ji,jj,jk-1) ) / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk) )
-               !                                               ! upper diagonal
-               zd_up(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk  ) ) / ( e3t_n(ji,jj,jk  ) * e3w_n(ji,jj,jk) )
-               !                                               ! diagonal
-               zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) + rdt * zdiss * wmask(ji,jj,jk)
-               !                                               ! right hand side in psi
-               psi(ji,jj,jk) = psi(ji,jj,jk) + rdt * zesh2 * wmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 2, jpkm1 )
+         !
+         ! psi / k
+         zratio = psi(ji,jj,jk) / eb(ji,jj,jk) 
+         !
+         ! psi3+ : stable : B=-KhN²<0 => N²>0 if rn2>0 zdir = 1 (stable) otherwise zdir = 0 (unstable)
+         zdir = 0.5_wp + SIGN( 0.5_wp, rn2(ji,jj,jk) )
+         !
+         rpsi3 = zdir * rpsi3m + ( 1._wp - zdir ) * rpsi3p
+         !
+         ! shear prod. - stratif. destruction
+         prod = rpsi1 * zratio * p_sh2(ji,jj,jk)
+         !
+         ! stratif. destruction
+         buoy = rpsi3 * zratio * (- p_avt(ji,jj,jk) * rn2(ji,jj,jk) )
+         !
+         ! shear prod. - stratif. destruction
+         diss = rpsi2 * zratio * zwall(ji,jj,jk) * eps(ji,jj,jk)
+         !
+         zdir = 0.5_wp + SIGN( 0.5_wp, prod + buoy )     ! zdir =1(=0) if shear(ji,jj,jk)+buoy >0(<0)
+         !
+         zesh2 = zdir * ( prod + buoy )          + (1._wp - zdir ) * prod                        ! production term
+         zdiss = zdir * ( diss / psi(ji,jj,jk) ) + (1._wp - zdir ) * (diss-buoy) / psi(ji,jj,jk) ! dissipation term
+         !                                                        
+         ! building the matrix
+         zcof = rfact_psi * zwall_psi(ji,jj,jk) * tmask(ji,jj,jk)
+         !                                               ! lower diagonal
+         zd_lw(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk  ) + p_avm(ji,jj,jk-1) ) / ( e3t(ji,jj,jk-1,Kmm) * e3w(ji,jj,jk,Kmm) )
+         !                                               ! upper diagonal
+         zd_up(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk  ) ) / ( e3t(ji,jj,jk  ,Kmm) * e3w(ji,jj,jk,Kmm) )
+         !                                               ! diagonal
+         zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) + rn_Dt * zdiss * wmask(ji,jj,jk)
+         !                                               ! right hand side in psi
+         psi(ji,jj,jk) = psi(ji,jj,jk) + rn_Dt * zesh2 * wmask(ji,jj,jk)
+      END_3D
       !
       zdiag(:,:,jpk) = 1._wp
@@ -554,6 +499,6 @@
          !
          ! One level below
-         zkar    (:,:)   = (rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdepw_n(:,:,2)/zhsro(:,:) )))
-         zdep    (:,:)   = (zhsro(:,:) + gdepw_n(:,:,2)) * zkar(:,:)
+         zkar    (:,:)   = (rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdepw(:,:,2,Kmm)/zhsro(:,:) )))
+         zdep    (:,:)   = (zhsro(:,:) + gdepw(:,:,2,Kmm)) * zkar(:,:)
          psi     (:,:,2) = rc0**rpp * en(:,:,2)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
          zd_lw(:,:,2) = 0._wp
@@ -575,11 +520,11 @@
          !
          ! Set psi vertical flux at the surface:
-         zkar (:,:)   = rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdept_n(:,:,1)/zhsro(:,:) )) ! Lengh scale slope
-         zdep (:,:)   = ((zhsro(:,:) + gdept_n(:,:,1)) / zhsro(:,:))**(rmm*ra_sf)
+         zkar (:,:)   = rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdept(:,:,1,Kmm)/zhsro(:,:) )) ! Lengh scale slope
+         zdep (:,:)   = ((zhsro(:,:) + gdept(:,:,1,Kmm)) / zhsro(:,:))**(rmm*ra_sf)
          zflxs(:,:)   = (rnn + rsbc_tke1 * (rnn + rmm*ra_sf) * zdep(:,:))*(1._wp + rsbc_tke1*zdep(:,:))**(2._wp*rmm/3._wp-1_wp)
          zdep (:,:)   = rsbc_psi1 * (zwall_psi(:,:,1)*p_avm(:,:,1)+zwall_psi(:,:,2)*p_avm(:,:,2)) * &
-            &           ustar2_surf(:,:)**rmm * zkar(:,:)**rnn * (zhsro(:,:) + gdept_n(:,:,1))**(rnn-1.)
+            &           ustar2_surf(:,:)**rmm * zkar(:,:)**rnn * (zhsro(:,:) + gdept(:,:,1,Kmm))**(rnn-1.)
          zflxs(:,:)   = zdep(:,:) * zflxs(:,:)
-         psi  (:,:,2) = psi(:,:,2) + zflxs(:,:) / e3w_n(:,:,2)
+         psi  (:,:,2) = psi(:,:,2) + zflxs(:,:) / e3w(:,:,2,Kmm)
          !
       END SELECT
@@ -596,49 +541,45 @@
          !                      ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = vkarmn * r_z0_bot
          !                      ! Balance between the production and the dissipation terms
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
-               ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1
-               zdep(ji,jj) = vkarmn * r_z0_bot
-               psi (ji,jj,ibot) = rc0**rpp * en(ji,jj,ibot)**rmm * zdep(ji,jj)**rnn
-               zd_lw(ji,jj,ibot) = 0._wp
-               zd_up(ji,jj,ibot) = 0._wp
-               zdiag(ji,jj,ibot) = 1._wp
-               !
-               ! Just above last level, Dirichlet condition again (GOTM like)
-               zdep(ji,jj) = vkarmn * ( r_z0_bot + e3t_n(ji,jj,ibotm1) )
-               psi (ji,jj,ibotm1) = rc0**rpp * en(ji,jj,ibot  )**rmm * zdep(ji,jj)**rnn
-               zd_lw(ji,jj,ibotm1) = 0._wp
-               zd_up(ji,jj,ibotm1) = 0._wp
-               zdiag(ji,jj,ibotm1) = 1._wp
-            END DO
-         END DO
+         DO_2D_00_00
+            ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
+            ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1
+            zdep(ji,jj) = vkarmn * r_z0_bot
+            psi (ji,jj,ibot) = rc0**rpp * en(ji,jj,ibot)**rmm * zdep(ji,jj)**rnn
+            zd_lw(ji,jj,ibot) = 0._wp
+            zd_up(ji,jj,ibot) = 0._wp
+            zdiag(ji,jj,ibot) = 1._wp
+            !
+            ! Just above last level, Dirichlet condition again (GOTM like)
+            zdep(ji,jj) = vkarmn * ( r_z0_bot + e3t(ji,jj,ibotm1,Kmm) )
+            psi (ji,jj,ibotm1) = rc0**rpp * en(ji,jj,ibot  )**rmm * zdep(ji,jj)**rnn
+            zd_lw(ji,jj,ibotm1) = 0._wp
+            zd_up(ji,jj,ibotm1) = 0._wp
+            zdiag(ji,jj,ibotm1) = 1._wp
+         END_2D
          !
       CASE ( 1 )             ! Neumman boundary condition
          !                      
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
-               ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1
-               !
-               ! Bottom level Dirichlet condition:
-               zdep(ji,jj) = vkarmn * r_z0_bot
-               psi (ji,jj,ibot) = rc0**rpp * en(ji,jj,ibot)**rmm * zdep(ji,jj)**rnn
-               !
-               zd_lw(ji,jj,ibot) = 0._wp
-               zd_up(ji,jj,ibot) = 0._wp
-               zdiag(ji,jj,ibot) = 1._wp
-               !
-               ! Just above last level: Neumann condition with flux injection
-               zdiag(ji,jj,ibotm1) = zdiag(ji,jj,ibotm1) + zd_up(ji,jj,ibotm1) ! Remove zd_up from zdiag
-               zd_up(ji,jj,ibotm1) = 0.
-               !
-               ! Set psi vertical flux at the bottom:
-               zdep(ji,jj) = r_z0_bot + 0.5_wp*e3t_n(ji,jj,ibotm1)
-               zflxb = rsbc_psi2 * ( p_avm(ji,jj,ibot) + p_avm(ji,jj,ibotm1) )   &
-                  &  * (0.5_wp*(en(ji,jj,ibot)+en(ji,jj,ibotm1)))**rmm * zdep(ji,jj)**(rnn-1._wp)
-               psi(ji,jj,ibotm1) = psi(ji,jj,ibotm1) + zflxb / e3w_n(ji,jj,ibotm1)
-            END DO
-         END DO
+         DO_2D_00_00
+            ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
+            ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1
+            !
+            ! Bottom level Dirichlet condition:
+            zdep(ji,jj) = vkarmn * r_z0_bot
+            psi (ji,jj,ibot) = rc0**rpp * en(ji,jj,ibot)**rmm * zdep(ji,jj)**rnn
+            !
+            zd_lw(ji,jj,ibot) = 0._wp
+            zd_up(ji,jj,ibot) = 0._wp
+            zdiag(ji,jj,ibot) = 1._wp
+            !
+            ! Just above last level: Neumann condition with flux injection
+            zdiag(ji,jj,ibotm1) = zdiag(ji,jj,ibotm1) + zd_up(ji,jj,ibotm1) ! Remove zd_up from zdiag
+            zd_up(ji,jj,ibotm1) = 0.
+            !
+            ! Set psi vertical flux at the bottom:
+            zdep(ji,jj) = r_z0_bot + 0.5_wp*e3t(ji,jj,ibotm1,Kmm)
+            zflxb = rsbc_psi2 * ( p_avm(ji,jj,ibot) + p_avm(ji,jj,ibotm1) )   &
+               &  * (0.5_wp*(en(ji,jj,ibot)+en(ji,jj,ibotm1)))**rmm * zdep(ji,jj)**(rnn-1._wp)
+            psi(ji,jj,ibotm1) = psi(ji,jj,ibotm1) + zflxb / e3w(ji,jj,ibotm1,Kmm)
+         END_2D
          !
       END SELECT
@@ -647,25 +588,13 @@
       ! ----------------
       !
-      DO jk = 2, jpkm1                             ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1    ! vector opt.
-               zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-      DO jk = 2, jpk                               ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1    ! vector opt.
-               zd_lw(ji,jj,jk) = psi(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-      DO jk = jpk-1, 2, -1                         ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1    ! vector opt.
-               psi(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * psi(ji,jj,jk+1) ) / zdiag(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 2, jpkm1 )
+         zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1)
+      END_3D
+      DO_3D_00_00( 2, jpk )
+         zd_lw(ji,jj,jk) = psi(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1)
+      END_3D
+      DO_3DS_00_00( jpk-1, 2, -1 )
+         psi(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * psi(ji,jj,jk+1) ) / zdiag(ji,jj,jk)
+      END_3D
 
       ! Set dissipation
@@ -675,29 +604,17 @@
       !
       CASE( 0 )               ! k-kl  (Mellor-Yamada)
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / MAX( psi(ji,jj,jk), rn_epsmin)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / MAX( psi(ji,jj,jk), rn_epsmin)
+         END_3D
          !
       CASE( 1 )               ! k-eps
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  eps(ji,jj,jk) = psi(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            eps(ji,jj,jk) = psi(ji,jj,jk)
+         END_3D
          !
       CASE( 2 )               ! k-w
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  eps(ji,jj,jk) = rc04 * en(ji,jj,jk) * psi(ji,jj,jk) 
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            eps(ji,jj,jk) = rc04 * en(ji,jj,jk) * psi(ji,jj,jk) 
+         END_3D
          !
       CASE( 3 )               ! generic
@@ -705,11 +622,7 @@
          zex1  =      ( 1.5_wp + rmm/rnn )
          zex2  = -1._wp / rnn
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  eps(ji,jj,jk) = zcoef * en(ji,jj,jk)**zex1 * psi(ji,jj,jk)**zex2
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            eps(ji,jj,jk) = zcoef * en(ji,jj,jk)**zex1 * psi(ji,jj,jk)**zex2
+         END_3D
          !
       END SELECT
@@ -717,16 +630,12 @@
       ! Limit dissipation rate under stable stratification
       ! --------------------------------------------------
-      DO jk = 1, jpkm1 ! Note that this set boundary conditions on hmxl_n at the same time
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1    ! vector opt.
-               ! limitation
-               eps   (ji,jj,jk)  = MAX( eps(ji,jj,jk), rn_epsmin )
-               hmxl_n(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / eps(ji,jj,jk)
-               ! Galperin criterium (NOTE : Not required if the proper value of C3 in stable cases is calculated) 
-               zrn2 = MAX( rn2(ji,jj,jk), rsmall )
-               IF( ln_length_lim )   hmxl_n(ji,jj,jk) = MIN(  rn_clim_galp * SQRT( 2._wp * en(ji,jj,jk) / zrn2 ), hmxl_n(ji,jj,jk) )
-            END DO
-         END DO
-      END DO 
+      DO_3D_00_00( 1, jpkm1 )
+         ! limitation
+         eps   (ji,jj,jk)  = MAX( eps(ji,jj,jk), rn_epsmin )
+         hmxl_n(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / eps(ji,jj,jk)
+         ! Galperin criterium (NOTE : Not required if the proper value of C3 in stable cases is calculated) 
+         zrn2 = MAX( rn2(ji,jj,jk), rsmall )
+         IF( ln_length_lim )   hmxl_n(ji,jj,jk) = MIN(  rn_clim_galp * SQRT( 2._wp * en(ji,jj,jk) / zrn2 ), hmxl_n(ji,jj,jk) )
+      END_3D
 
       !
@@ -737,51 +646,43 @@
       !
       CASE ( 0 , 1 )             ! Galperin or Kantha-Clayson stability functions
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ! zcof =  l²/q²
-                  zcof = hmxl_b(ji,jj,jk) * hmxl_b(ji,jj,jk) / ( 2._wp*eb(ji,jj,jk) )
-                  ! Gh = -N²l²/q²
-                  gh = - rn2(ji,jj,jk) * zcof
-                  gh = MIN( gh, rgh0   )
-                  gh = MAX( gh, rghmin )
-                  ! Stability functions from Kantha and Clayson (if C2=C3=0 => Galperin)
-                  sh = ra2*( 1._wp-6._wp*ra1/rb1 ) / ( 1.-3.*ra2*gh*(6.*ra1+rb2*( 1._wp-rc3 ) ) )
-                  sm = ( rb1**(-1._wp/3._wp) + ( 18._wp*ra1*ra1 + 9._wp*ra1*ra2*(1._wp-rc2) )*sh*gh ) / (1._wp-9._wp*ra1*ra2*gh)
-                  !
-                  ! Store stability function in zstt and zstm
-                  zstt(ji,jj,jk) = rc_diff * sh * tmask(ji,jj,jk)
-                  zstm(ji,jj,jk) = rc_diff * sm * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 2, jpkm1 )
+            ! zcof =  l²/q²
+            zcof = hmxl_b(ji,jj,jk) * hmxl_b(ji,jj,jk) / ( 2._wp*eb(ji,jj,jk) )
+            ! Gh = -N²l²/q²
+            gh = - rn2(ji,jj,jk) * zcof
+            gh = MIN( gh, rgh0   )
+            gh = MAX( gh, rghmin )
+            ! Stability functions from Kantha and Clayson (if C2=C3=0 => Galperin)
+            sh = ra2*( 1._wp-6._wp*ra1/rb1 ) / ( 1.-3.*ra2*gh*(6.*ra1+rb2*( 1._wp-rc3 ) ) )
+            sm = ( rb1**(-1._wp/3._wp) + ( 18._wp*ra1*ra1 + 9._wp*ra1*ra2*(1._wp-rc2) )*sh*gh ) / (1._wp-9._wp*ra1*ra2*gh)
+            !
+            ! Store stability function in zstt and zstm
+            zstt(ji,jj,jk) = rc_diff * sh * tmask(ji,jj,jk)
+            zstm(ji,jj,jk) = rc_diff * sm * tmask(ji,jj,jk)
+         END_3D
          !
       CASE ( 2, 3 )               ! Canuto stability functions
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ! zcof =  l²/q²
-                  zcof = hmxl_b(ji,jj,jk)*hmxl_b(ji,jj,jk) / ( 2._wp * eb(ji,jj,jk) )
-                  ! Gh = -N²l²/q²
-                  gh = - rn2(ji,jj,jk) * zcof
-                  gh = MIN( gh, rgh0   )
-                  gh = MAX( gh, rghmin )
-                  gh = gh * rf6
-                  ! Gm =  M²l²/q² Shear number
-                  shr = p_sh2(ji,jj,jk) / MAX( p_avm(ji,jj,jk), rsmall )
-                  gm = MAX( shr * zcof , 1.e-10 )
-                  gm = gm * rf6
-                  gm = MIN ( (rd0 - rd1*gh + rd3*gh*gh) / (rd2-rd4*gh) , gm )
-                  ! Stability functions from Canuto
-                  rcff = rd0 - rd1*gh +rd2*gm + rd3*gh*gh - rd4*gh*gm + rd5*gm*gm
-                  sm = (rs0 - rs1*gh + rs2*gm) / rcff
-                  sh = (rs4 - rs5*gh + rs6*gm) / rcff
-                  !
-                  ! Store stability function in zstt and zstm
-                  zstt(ji,jj,jk) = rc_diff * sh * tmask(ji,jj,jk)
-                  zstm(ji,jj,jk) = rc_diff * sm * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 2, jpkm1 )
+            ! zcof =  l²/q²
+            zcof = hmxl_b(ji,jj,jk)*hmxl_b(ji,jj,jk) / ( 2._wp * eb(ji,jj,jk) )
+            ! Gh = -N²l²/q²
+            gh = - rn2(ji,jj,jk) * zcof
+            gh = MIN( gh, rgh0   )
+            gh = MAX( gh, rghmin )
+            gh = gh * rf6
+            ! Gm =  M²l²/q² Shear number
+            shr = p_sh2(ji,jj,jk) / MAX( p_avm(ji,jj,jk), rsmall )
+            gm = MAX( shr * zcof , 1.e-10 )
+            gm = gm * rf6
+            gm = MIN ( (rd0 - rd1*gh + rd3*gh*gh) / (rd2-rd4*gh) , gm )
+            ! Stability functions from Canuto
+            rcff = rd0 - rd1*gh +rd2*gm + rd3*gh*gh - rd4*gh*gm + rd5*gm*gm
+            sm = (rs0 - rs1*gh + rs2*gm) / rcff
+            sh = (rs4 - rs5*gh + rs6*gm) / rcff
+            !
+            ! Store stability function in zstt and zstm
+            zstt(ji,jj,jk) = rc_diff * sh * tmask(ji,jj,jk)
+            zstm(ji,jj,jk) = rc_diff * sm * tmask(ji,jj,jk)
+         END_3D
          !
       END SELECT
@@ -794,9 +695,7 @@
       ! default value, in case jpk > mbkt(ji,jj)+1. Not needed but avoid a bug when looking for undefined values (-fpe0)
       zstm(:,:,jpk) = 0.  
-      DO jj = 2, jpjm1                ! update bottom with good values
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            zstm(ji,jj,mbkt(ji,jj)+1) = zstm(ji,jj,mbkt(ji,jj))
-         END DO
-      END DO
+      DO_2D_00_00
+         zstm(ji,jj,mbkt(ji,jj)+1) = zstm(ji,jj,mbkt(ji,jj))
+      END_2D
 
       zstt(:,:,  1) = wmask(:,:,  1)  ! default value not needed but avoid a bug when looking for undefined values (-fpe0)
@@ -811,18 +710,14 @@
       !     later overwritten by surface/bottom boundaries conditions, so we don't really care of p_avm(:,:1) and p_avm(:,:jpk)
       !     for zd_lw and zd_up but they have to be defined to avoid a bug when looking for undefined values (-fpe0)
-      DO jk = 1, jpk
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zsqen = SQRT( 2._wp * en(ji,jj,jk) ) * hmxl_n(ji,jj,jk)
-               zavt  = zsqen * zstt(ji,jj,jk)
-               zavm  = zsqen * zstm(ji,jj,jk)
-               p_avt(ji,jj,jk) = MAX( zavt, avtb(jk) ) * wmask(ji,jj,jk) ! apply mask for zdfmxl routine
-               p_avm(ji,jj,jk) = MAX( zavm, avmb(jk) )                   ! Note that avm is not masked at the surface and the bottom
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 1, jpk )
+         zsqen = SQRT( 2._wp * en(ji,jj,jk) ) * hmxl_n(ji,jj,jk)
+         zavt  = zsqen * zstt(ji,jj,jk)
+         zavm  = zsqen * zstm(ji,jj,jk)
+         p_avt(ji,jj,jk) = MAX( zavt, avtb(jk) ) * wmask(ji,jj,jk) ! apply mask for zdfmxl routine
+         p_avm(ji,jj,jk) = MAX( zavm, avmb(jk) )                   ! Note that avm is not masked at the surface and the bottom
+      END_3D
       p_avt(:,:,1) = 0._wp
       !
-      IF(ln_ctl) THEN
+      IF(sn_cfctl%l_prtctl) THEN
          CALL prt_ctl( tab3d_1=en   , clinfo1=' gls  - e: ', tab3d_2=p_avt, clinfo2=' t: ', kdim=jpk)
          CALL prt_ctl( tab3d_1=p_avm, clinfo1=' gls  - m: ', kdim=jpk )
@@ -857,9 +752,7 @@
       !!----------------------------------------------------------
       !
-      REWIND( numnam_ref )              ! Namelist namzdf_gls in reference namelist : Vertical eddy diffivity and viscosity using gls turbulent closure scheme
       READ  ( numnam_ref, namzdf_gls, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namzdf_gls in reference namelist' )
 
-      REWIND( numnam_cfg )              ! Namelist namzdf_gls in configuration namelist : Vertical eddy diffivity and viscosity using gls turbulent closure scheme
       READ  ( numnam_cfg, namzdf_gls, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namzdf_gls in configuration namelist' )
@@ -1114,14 +1007,14 @@
       rc04  = rc03 * rc0
       rsbc_tke1 = -3._wp/2._wp*rn_crban*ra_sf*rl_sf                      ! Dirichlet + Wave breaking
-      rsbc_tke2 = rdt * rn_crban / rl_sf                                 ! Neumann + Wave breaking 
+      rsbc_tke2 = rn_Dt * rn_crban / rl_sf                                 ! Neumann + Wave breaking 
       zcr = MAX(rsmall, rsbc_tke1**(1./(-ra_sf*3._wp/2._wp))-1._wp )
       rtrans = 0.2_wp / zcr                                              ! Ad. inverse transition length between log and wave layer 
       rsbc_zs1  = rn_charn/grav                                          ! Charnock formula for surface roughness
       rsbc_zs2  = rn_frac_hs / 0.85_wp / grav * 665._wp                  ! Rascle formula for surface roughness 
-      rsbc_psi1 = -0.5_wp * rdt * rc0**(rpp-2._wp*rmm) / rsc_psi
-      rsbc_psi2 = -0.5_wp * rdt * rc0**rpp * rnn * vkarmn**rnn / rsc_psi ! Neumann + NO Wave breaking 
-      !
-      rfact_tke = -0.5_wp / rsc_tke * rdt                                ! Cst used for the Diffusion term of tke
-      rfact_psi = -0.5_wp / rsc_psi * rdt                                ! Cst used for the Diffusion term of tke
+      rsbc_psi1 = -0.5_wp * rn_Dt * rc0**(rpp-2._wp*rmm) / rsc_psi
+      rsbc_psi2 = -0.5_wp * rn_Dt * rc0**rpp * rnn * vkarmn**rnn / rsc_psi ! Neumann + NO Wave breaking 
+      !
+      rfact_tke = -0.5_wp / rsc_tke * rn_Dt                                ! Cst used for the Diffusion term of tke
+      rfact_psi = -0.5_wp / rsc_psi * rn_Dt                                ! Cst used for the Diffusion term of tke
       !
       !                                !* Wall proximity function
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfiwm.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfiwm.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfiwm.F90	(revision 12928)
@@ -23,4 +23,5 @@
    USE phycst         ! physical constants
    !
+   USE fldread        ! field read
    USE prtctl         ! Print control
    USE in_out_manager ! I/O manager
@@ -49,5 +50,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -69,5 +70,5 @@
 
 
-   SUBROUTINE zdf_iwm( kt, p_avm, p_avt, p_avs )
+   SUBROUTINE zdf_iwm( kt, Kmm, p_avm, p_avt, p_avs )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE zdf_iwm  ***
@@ -87,10 +88,10 @@
       !!              This is divided into three components:
       !!                 1. Bottom-intensified low-mode dissipation at critical slopes
-      !!                     zemx_iwm(z) = ( ecri_iwm / rau0 ) * EXP( -(H-z)/hcri_iwm )
+      !!                     zemx_iwm(z) = ( ecri_iwm / rho0 ) * EXP( -(H-z)/hcri_iwm )
       !!                                   / ( 1. - EXP( - H/hcri_iwm ) ) * hcri_iwm
       !!              where hcri_iwm is the characteristic length scale of the bottom 
       !!              intensification, ecri_iwm a map of available power, and H the ocean depth.
       !!                 2. Pycnocline-intensified low-mode dissipation
-      !!                     zemx_iwm(z) = ( epyc_iwm / rau0 ) * ( sqrt(rn2(z))^nn_zpyc )
+      !!                     zemx_iwm(z) = ( epyc_iwm / rho0 ) * ( sqrt(rn2(z))^nn_zpyc )
       !!                                   / SUM( sqrt(rn2(z))^nn_zpyc * e3w(z) )
       !!              where epyc_iwm is a map of available power, and nn_zpyc
@@ -98,5 +99,5 @@
       !!              energy dissipation.
       !!                 3. WKB-height dependent high mode dissipation
-      !!                     zemx_iwm(z) = ( ebot_iwm / rau0 ) * rn2(z) * EXP(-z_wkb(z)/hbot_iwm)
+      !!                     zemx_iwm(z) = ( ebot_iwm / rho0 ) * rn2(z) * EXP(-z_wkb(z)/hbot_iwm)
       !!                                   / SUM( rn2(z) * EXP(-z_wkb(z)/hbot_iwm) * e3w(z) )
       !!              where hbot_iwm is the characteristic length scale of the WKB bottom 
@@ -118,4 +119,5 @@
       !!----------------------------------------------------------------------
       INTEGER                    , INTENT(in   ) ::   kt             ! ocean time step
+      INTEGER                    , INTENT(in   ) ::   Kmm            ! time level index
       REAL(wp), DIMENSION(:,:,:) , INTENT(inout) ::   p_avm          ! momentum Kz (w-points)
       REAL(wp), DIMENSION(:,:,:) , INTENT(inout) ::   p_avt, p_avs   ! tracer   Kz (w-points)
@@ -148,28 +150,22 @@
       !                       !* Critical slope mixing: distribute energy over the time-varying ocean depth,
       !                                                 using an exponential decay from the seafloor.
-      DO jj = 1, jpj                ! part independent of the level
-         DO ji = 1, jpi
-            zhdep(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1)       ! depth of the ocean
-            zfact(ji,jj) = rau0 * (  1._wp - EXP( -zhdep(ji,jj) / hcri_iwm(ji,jj) )  )
-            IF( zfact(ji,jj) /= 0._wp )   zfact(ji,jj) = ecri_iwm(ji,jj) / zfact(ji,jj)
-         END DO
-      END DO
-!!gm gde3w ==>>>  check for ssh taken into account.... seem OK gde3w_n=gdept_n - sshn
-      DO jk = 2, jpkm1              ! complete with the level-dependent part
-         DO jj = 1, jpj             
-            DO ji = 1, jpi
-               IF ( zfact(ji,jj) == 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN   ! optimization
-                  zemx_iwm(ji,jj,jk) = 0._wp
-               ELSE
-                  zemx_iwm(ji,jj,jk) = zfact(ji,jj) * (  EXP( ( gde3w_n(ji,jj,jk  ) - zhdep(ji,jj) ) / hcri_iwm(ji,jj) )     &
-                       &                               - EXP( ( gde3w_n(ji,jj,jk-1) - zhdep(ji,jj) ) / hcri_iwm(ji,jj) ) )   &
-                       &                            / ( gde3w_n(ji,jj,jk) - gde3w_n(ji,jj,jk-1) )
-               ENDIF
-            END DO
-         END DO
-!!gm delta(gde3w_n) = e3t_n  !!  Please verify the grid-point position w versus t-point
+      DO_2D_11_11
+         zhdep(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1)       ! depth of the ocean
+         zfact(ji,jj) = rho0 * (  1._wp - EXP( -zhdep(ji,jj) / hcri_iwm(ji,jj) )  )
+         IF( zfact(ji,jj) /= 0._wp )   zfact(ji,jj) = ecri_iwm(ji,jj) / zfact(ji,jj)
+      END_2D
+!!gm gde3w ==>>>  check for ssh taken into account.... seem OK gde3w_n=gdept(:,:,:,Kmm) - ssh(:,:,Kmm)
+      DO_3D_11_11( 2, jpkm1 )
+         IF ( zfact(ji,jj) == 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN   ! optimization
+            zemx_iwm(ji,jj,jk) = 0._wp
+         ELSE
+            zemx_iwm(ji,jj,jk) = zfact(ji,jj) * (  EXP( ( gde3w(ji,jj,jk  ) - zhdep(ji,jj) ) / hcri_iwm(ji,jj) )     &
+                 &                               - EXP( ( gde3w(ji,jj,jk-1) - zhdep(ji,jj) ) / hcri_iwm(ji,jj) ) )   &
+                 &                            / ( gde3w(ji,jj,jk) - gde3w(ji,jj,jk-1) )
+         ENDIF
+      END_3D
+!!gm delta(gde3w) = e3t(:,:,:,Kmm)  !!  Please verify the grid-point position w versus t-point
 !!gm it seems to me that only 1/hcri_iwm  is used ==>  compute it one for all
 
-      END DO
 
       !                        !* Pycnocline-intensified mixing: distribute energy over the time-varying 
@@ -182,12 +178,10 @@
          zfact(:,:) = 0._wp
          DO jk = 2, jpkm1              ! part independent of the level
-            zfact(:,:) = zfact(:,:) + e3w_n(:,:,jk) * SQRT(  MAX( 0._wp, rn2(:,:,jk) )  ) * wmask(:,:,jk)
-         END DO
-         !
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_iwm(ji,jj) / ( rau0 * zfact(ji,jj) )
-            END DO
-         END DO
+            zfact(:,:) = zfact(:,:) + e3w(:,:,jk,Kmm) * SQRT(  MAX( 0._wp, rn2(:,:,jk) )  ) * wmask(:,:,jk)
+         END DO
+         !
+         DO_2D_11_11
+            IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_iwm(ji,jj) / ( rho0 * zfact(ji,jj) )
+         END_2D
          !
          DO jk = 2, jpkm1              ! complete with the level-dependent part
@@ -199,12 +193,10 @@
          zfact(:,:) = 0._wp
          DO jk = 2, jpkm1              ! part independent of the level
-            zfact(:,:) = zfact(:,:) + e3w_n(:,:,jk) * MAX( 0._wp, rn2(:,:,jk) ) * wmask(:,:,jk)
-         END DO
-         !
-         DO jj= 1, jpj
-            DO ji = 1, jpi
-               IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_iwm(ji,jj) / ( rau0 * zfact(ji,jj) )
-            END DO
-         END DO
+            zfact(:,:) = zfact(:,:) + e3w(:,:,jk,Kmm) * MAX( 0._wp, rn2(:,:,jk) ) * wmask(:,:,jk)
+         END DO
+         !
+         DO_2D_11_11
+            IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_iwm(ji,jj) / ( rho0 * zfact(ji,jj) )
+         END_2D
          !
          DO jk = 2, jpkm1              ! complete with the level-dependent part
@@ -220,10 +212,10 @@
       zfact(:,:)   = 0._wp
       DO jk = 2, jpkm1
-         zfact(:,:) = zfact(:,:) + e3w_n(:,:,jk) * SQRT(  MAX( 0._wp, rn2(:,:,jk) )  ) * wmask(:,:,jk)
+         zfact(:,:) = zfact(:,:) + e3w(:,:,jk,Kmm) * SQRT(  MAX( 0._wp, rn2(:,:,jk) )  ) * wmask(:,:,jk)
          zwkb(:,:,jk) = zfact(:,:)
       END DO
 !!gm even better:
 !      DO jk = 2, jpkm1
-!         zwkb(:,:) = zwkb(:,:) + e3w_n(:,:,jk) * SQRT(  MAX( 0._wp, rn2(:,:,jk) )  )
+!         zwkb(:,:) = zwkb(:,:) + e3w(:,:,jk,Kmm) * SQRT(  MAX( 0._wp, rn2(:,:,jk) )  )
 !      END DO
 !      zfact(:,:) = zwkb(:,:,jpkm1)
@@ -231,26 +223,18 @@
 !!gm
       !
-      DO jk = 2, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( zfact(ji,jj) /= 0 )   zwkb(ji,jj,jk) = zhdep(ji,jj) * ( zfact(ji,jj) - zwkb(ji,jj,jk) )   &
-                  &                                     * wmask(ji,jj,jk) / zfact(ji,jj)
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 2, jpkm1 )
+         IF( zfact(ji,jj) /= 0 )   zwkb(ji,jj,jk) = zhdep(ji,jj) * ( zfact(ji,jj) - zwkb(ji,jj,jk) )   &
+            &                                     * wmask(ji,jj,jk) / zfact(ji,jj)
+      END_3D
       zwkb(:,:,1) = zhdep(:,:) * wmask(:,:,1)
       !
-      DO jk = 2, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF ( rn2(ji,jj,jk) <= 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN   ! optimization
-                  zweight(ji,jj,jk) = 0._wp
-               ELSE
-                  zweight(ji,jj,jk) = rn2(ji,jj,jk) * hbot_iwm(ji,jj)    &
-                     &   * (  EXP( -zwkb(ji,jj,jk) / hbot_iwm(ji,jj) ) - EXP( -zwkb(ji,jj,jk-1) / hbot_iwm(ji,jj) )  )
-               ENDIF
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 2, jpkm1 )
+         IF ( rn2(ji,jj,jk) <= 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN   ! optimization
+            zweight(ji,jj,jk) = 0._wp
+         ELSE
+            zweight(ji,jj,jk) = rn2(ji,jj,jk) * hbot_iwm(ji,jj)    &
+               &   * (  EXP( -zwkb(ji,jj,jk) / hbot_iwm(ji,jj) ) - EXP( -zwkb(ji,jj,jk-1) / hbot_iwm(ji,jj) )  )
+         ENDIF
+      END_3D
       !
       zfact(:,:) = 0._wp
@@ -259,20 +243,18 @@
       END DO
       !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = ebot_iwm(ji,jj) / ( rau0 * zfact(ji,jj) )
-         END DO
-      END DO
+      DO_2D_11_11
+         IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = ebot_iwm(ji,jj) / ( rho0 * zfact(ji,jj) )
+      END_2D
       !
       DO jk = 2, jpkm1              ! complete with the level-dependent part
          zemx_iwm(:,:,jk) = zemx_iwm(:,:,jk) + zweight(:,:,jk) * zfact(:,:) * wmask(:,:,jk)   &
-            &                                / ( gde3w_n(:,:,jk) - gde3w_n(:,:,jk-1) )
-!!gm  use of e3t_n just above?
+            &                                / ( gde3w(:,:,jk) - gde3w(:,:,jk-1) )
+!!gm  use of e3t(:,:,:,Kmm) just above?
       END DO
       !
 !!gm  this is to be replaced by just a constant value znu=1.e-6 m2/s
       ! Calculate molecular kinematic viscosity
-      znu_t(:,:,:) = 1.e-4_wp * (  17.91_wp - 0.53810_wp * tsn(:,:,:,jp_tem) + 0.00694_wp * tsn(:,:,:,jp_tem) * tsn(:,:,:,jp_tem)  &
-         &                                  + 0.02305_wp * tsn(:,:,:,jp_sal)  ) * tmask(:,:,:) * r1_rau0
+      znu_t(:,:,:) = 1.e-4_wp * (  17.91_wp - 0.53810_wp * ts(:,:,:,jp_tem,Kmm) + 0.00694_wp * ts(:,:,:,jp_tem,Kmm) * ts(:,:,:,jp_tem,Kmm)  &
+         &                                  + 0.02305_wp * ts(:,:,:,jp_sal,Kmm)  ) * tmask(:,:,:) * r1_rho0
       DO jk = 2, jpkm1
          znu_w(:,:,jk) = 0.5_wp * ( znu_t(:,:,jk-1) + znu_t(:,:,jk) ) * wmask(:,:,jk)
@@ -291,15 +273,11 @@
       !
       IF( ln_mevar ) THEN              ! Variable mixing efficiency case : modify zav_wave in the
-         DO jk = 2, jpkm1              ! energetic (Reb > 480) and buoyancy-controlled (Reb <10.224 ) regimes
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  IF( zReb(ji,jj,jk) > 480.00_wp ) THEN
-                     zav_wave(ji,jj,jk) = 3.6515_wp * znu_w(ji,jj,jk) * SQRT( zReb(ji,jj,jk) )
-                  ELSEIF( zReb(ji,jj,jk) < 10.224_wp ) THEN
-                     zav_wave(ji,jj,jk) = 0.052125_wp * znu_w(ji,jj,jk) * zReb(ji,jj,jk) * SQRT( zReb(ji,jj,jk) )
-                  ENDIF
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 2, jpkm1 )
+            IF( zReb(ji,jj,jk) > 480.00_wp ) THEN
+               zav_wave(ji,jj,jk) = 3.6515_wp * znu_w(ji,jj,jk) * SQRT( zReb(ji,jj,jk) )
+            ELSEIF( zReb(ji,jj,jk) < 10.224_wp ) THEN
+               zav_wave(ji,jj,jk) = 0.052125_wp * znu_w(ji,jj,jk) * zReb(ji,jj,jk) * SQRT( zReb(ji,jj,jk) )
+            ENDIF
+         END_3D
       ENDIF
       !
@@ -311,14 +289,10 @@
          zztmp = 0._wp
 !!gm used of glosum 3D....
-         DO jk = 2, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zztmp = zztmp + e3w_n(ji,jj,jk) * e1e2t(ji,jj)   &
-                     &          * MAX( 0._wp, rn2(ji,jj,jk) ) * zav_wave(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj)
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 2, jpkm1 )
+            zztmp = zztmp + e3w(ji,jj,jk,Kmm) * e1e2t(ji,jj)   &
+               &          * MAX( 0._wp, rn2(ji,jj,jk) ) * zav_wave(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj)
+         END_3D
          CALL mpp_sum( 'zdfiwm', zztmp )
-         zztmp = rau0 * zztmp ! Global integral of rauo * Kz * N^2 = power contributing to mixing 
+         zztmp = rho0 * zztmp ! Global integral of rauo * Kz * N^2 = power contributing to mixing 
          !
          IF(lwp) THEN
@@ -337,16 +311,12 @@
       IF( ln_tsdiff ) THEN          !* Option for differential mixing of salinity and temperature
          ztmp1 = 0.505_wp + 0.495_wp * TANH( 0.92_wp * ( LOG10( 1.e-20_wp ) - 0.60_wp ) )
-         DO jk = 2, jpkm1              ! Calculate S/T diffusivity ratio as a function of Reb
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  ztmp2 = zReb(ji,jj,jk) * 5._wp * r1_6
-                  IF ( ztmp2 > 1.e-20_wp .AND. wmask(ji,jj,jk) == 1._wp ) THEN
-                     zav_ratio(ji,jj,jk) = 0.505_wp + 0.495_wp * TANH( 0.92_wp * ( LOG10(ztmp2) - 0.60_wp ) )
-                  ELSE
-                     zav_ratio(ji,jj,jk) = ztmp1 * wmask(ji,jj,jk)
-                  ENDIF
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 2, jpkm1 )
+            ztmp2 = zReb(ji,jj,jk) * 5._wp * r1_6
+            IF ( ztmp2 > 1.e-20_wp .AND. wmask(ji,jj,jk) == 1._wp ) THEN
+               zav_ratio(ji,jj,jk) = 0.505_wp + 0.495_wp * TANH( 0.92_wp * ( LOG10(ztmp2) - 0.60_wp ) )
+            ELSE
+               zav_ratio(ji,jj,jk) = ztmp1 * wmask(ji,jj,jk)
+            ENDIF
+         END_3D
          CALL iom_put( "av_ratio", zav_ratio )
          DO jk = 2, jpkm1           !* update momentum & tracer diffusivity with wave-driven mixing
@@ -368,5 +338,5 @@
                                     !* output useful diagnostics: Kz*N^2 , 
 !!gm Kz*N2 should take into account the ratio avs/avt if it is used.... (see diaar5)
-                                    !  vertical integral of rau0 * Kz * N^2 , energy density (zemx_iwm)
+                                    !  vertical integral of rho0 * Kz * N^2 , energy density (zemx_iwm)
       IF( iom_use("bflx_iwm") .OR. iom_use("pcmap_iwm") ) THEN
          ALLOCATE( z2d(jpi,jpj) , z3d(jpi,jpj,jpk) )
@@ -374,7 +344,7 @@
          z2d(:,:) = 0._wp
          DO jk = 2, jpkm1
-            z2d(:,:) = z2d(:,:) + e3w_n(:,:,jk) * z3d(:,:,jk) * wmask(:,:,jk)
-         END DO
-         z2d(:,:) = rau0 * z2d(:,:)
+            z2d(:,:) = z2d(:,:) + e3w(:,:,jk,Kmm) * z3d(:,:,jk) * wmask(:,:,jk)
+         END DO
+         z2d(:,:) = rho0 * z2d(:,:)
          CALL iom_put( "bflx_iwm", z3d )
          CALL iom_put( "pcmap_iwm", z2d )
@@ -383,5 +353,5 @@
       CALL iom_put( "emix_iwm", zemx_iwm )
       
-      IF(ln_ctl)   CALL prt_ctl(tab3d_1=zav_wave , clinfo1=' iwm - av_wave: ', tab3d_2=avt, clinfo2=' avt: ', kdim=jpk)
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl(tab3d_1=zav_wave , clinfo1=' iwm - av_wave: ', tab3d_2=avt, clinfo2=' avt: ', kdim=jpk)
       !
    END SUBROUTINE zdf_iwm
@@ -414,17 +384,29 @@
       !!              de Lavergne et al. in prep., 2017
       !!----------------------------------------------------------------------
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      INTEGER  ::   inum         ! local integer
+      INTEGER  ::   ifpr               ! dummy loop indices
+      INTEGER  ::   inum               ! local integer
       INTEGER  ::   ios
       REAL(wp) ::   zbot, zpyc, zcri   ! local scalars
-      !!
-      NAMELIST/namzdf_iwm/ nn_zpyc, ln_mevar, ln_tsdiff
-      !!----------------------------------------------------------------------
-      !
-      REWIND( numnam_ref )              ! Namelist namzdf_iwm in reference namelist : Wave-driven mixing
+      !
+      CHARACTER(len=256)            ::   cn_dir                 ! Root directory for location of ssr files
+      INTEGER, PARAMETER            ::   jpiwm  = 5             ! maximum number of files to read
+      INTEGER, PARAMETER            ::   jp_mpb = 1
+      INTEGER, PARAMETER            ::   jp_mpp = 2
+      INTEGER, PARAMETER            ::   jp_mpc = 3
+      INTEGER, PARAMETER            ::   jp_dsb = 4
+      INTEGER, PARAMETER            ::   jp_dsc = 5
+      !
+      TYPE(FLD_N), DIMENSION(jpiwm) ::   slf_iwm                ! array of namelist informations
+      TYPE(FLD_N)                   ::   sn_mpb, sn_mpp, sn_mpc ! informations about Mixing Power field to be read
+      TYPE(FLD_N)                   ::   sn_dsb, sn_dsc         ! informations about Decay Scale field to be read
+      TYPE(FLD  ), DIMENSION(jpiwm) ::   sf_iwm                 ! structure of input fields (file informations, fields read)
+      !
+      NAMELIST/namzdf_iwm/ nn_zpyc, ln_mevar, ln_tsdiff, &
+         &                 cn_dir, sn_mpb, sn_mpp, sn_mpc, sn_dsb, sn_dsc
+      !!----------------------------------------------------------------------
+      !
       READ  ( numnam_ref, namzdf_iwm, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namzdf_iwm in reference namelist' )
       !
-      REWIND( numnam_cfg )              ! Namelist namzdf_iwm in configuration namelist : Wave-driven mixing
       READ  ( numnam_cfg, namzdf_iwm, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namzdf_iwm in configuration namelist' )
@@ -456,32 +438,36 @@
       IF( zdf_iwm_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_iwm_init : unable to allocate iwm arrays' )
       !
+      ! store namelist information in an array
+      slf_iwm(jp_mpb) = sn_mpb ; slf_iwm(jp_mpp) = sn_mpp ; slf_iwm(jp_mpc) = sn_mpc
+      slf_iwm(jp_dsb) = sn_dsb ; slf_iwm(jp_dsc) = sn_dsc
+      !
+      DO ifpr= 1, jpiwm
+         ALLOCATE( sf_iwm(ifpr)%fnow(jpi,jpj,1)   )
+         IF( slf_iwm(ifpr)%ln_tint )ALLOCATE( sf_iwm(ifpr)%fdta(jpi,jpj,1,2) )
+      END DO
+
+      ! fill sf_iwm with sf_iwm and control print
+      CALL fld_fill( sf_iwm, slf_iwm , cn_dir, 'zdfiwm_init', 'iwm input file', 'namiwm' )
+
+      !                             ! hard-coded default definition (to be defined in namelist ?)
+      sf_iwm(jp_mpb)%fnow(:,:,1) = 1.e-6
+      sf_iwm(jp_mpp)%fnow(:,:,1) = 1.e-6
+      sf_iwm(jp_mpc)%fnow(:,:,1) = 1.e-10
+      sf_iwm(jp_dsb)%fnow(:,:,1) = 100.
+      sf_iwm(jp_dsc)%fnow(:,:,1) = 100.
+
       !                             ! read necessary fields
-      CALL iom_open('mixing_power_bot',inum)       ! energy flux for high-mode wave breaking [W/m2]
-      CALL iom_get  (inum, jpdom_data, 'field', ebot_iwm, 1 ) 
-      CALL iom_close(inum)
-      !
-      CALL iom_open('mixing_power_pyc',inum)       ! energy flux for pynocline-intensified wave breaking [W/m2]
-      CALL iom_get  (inum, jpdom_data, 'field', epyc_iwm, 1 )
-      CALL iom_close(inum)
-      !
-      CALL iom_open('mixing_power_cri',inum)       ! energy flux for critical slope wave breaking [W/m2]
-      CALL iom_get  (inum, jpdom_data, 'field', ecri_iwm, 1 )
-      CALL iom_close(inum)
-      !
-      CALL iom_open('decay_scale_bot',inum)        ! spatially variable decay scale for high-mode wave breaking [m]
-      CALL iom_get  (inum, jpdom_data, 'field', hbot_iwm, 1 )
-      CALL iom_close(inum)
-      !
-      CALL iom_open('decay_scale_cri',inum)        ! spatially variable decay scale for critical slope wave breaking [m]
-      CALL iom_get  (inum, jpdom_data, 'field', hcri_iwm, 1 )
-      CALL iom_close(inum)
-
-      ebot_iwm(:,:) = ebot_iwm(:,:) * ssmask(:,:)
-      epyc_iwm(:,:) = epyc_iwm(:,:) * ssmask(:,:)
-      ecri_iwm(:,:) = ecri_iwm(:,:) * ssmask(:,:)
+      CALL fld_read( nit000, 1, sf_iwm )
+
+      ebot_iwm(:,:) = sf_iwm(1)%fnow(:,:,1) * ssmask(:,:) ! energy flux for high-mode wave breaking [W/m2]
+      epyc_iwm(:,:) = sf_iwm(2)%fnow(:,:,1) * ssmask(:,:) ! energy flux for pynocline-intensified wave breaking [W/m2]
+      ecri_iwm(:,:) = sf_iwm(3)%fnow(:,:,1) * ssmask(:,:) ! energy flux for critical slope wave breaking [W/m2]
+      hbot_iwm(:,:) = sf_iwm(4)%fnow(:,:,1)               ! spatially variable decay scale for high-mode wave breaking [m]
+      hcri_iwm(:,:) = sf_iwm(5)%fnow(:,:,1)               ! spatially variable decay scale for critical slope wave breaking [m]
 
       zbot = glob_sum( 'zdfiwm', e1e2t(:,:) * ebot_iwm(:,:) )
       zpyc = glob_sum( 'zdfiwm', e1e2t(:,:) * epyc_iwm(:,:) )
       zcri = glob_sum( 'zdfiwm', e1e2t(:,:) * ecri_iwm(:,:) )
+
       IF(lwp) THEN
          WRITE(numout,*) '      High-mode wave-breaking energy:             ', zbot * 1.e-12_wp, 'TW'
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfmxl.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfmxl.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfmxl.F90	(revision 12928)
@@ -12,4 +12,5 @@
    !!----------------------------------------------------------------------
    USE oce            ! ocean dynamics and tracers variables
+   USE isf_oce        ! ice shelf
    USE dom_oce        ! ocean space and time domain variables
    USE trc_oce  , ONLY: l_offline         ! ocean space and time domain variables
@@ -35,4 +36,6 @@
    REAL(wp), PUBLIC ::   avt_c = 5.e-4_wp   ! Kz criterion for the turbocline depth
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -57,5 +60,5 @@
 
 
-   SUBROUTINE zdf_mxl( kt )
+   SUBROUTINE zdf_mxl( kt, Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE zdfmxl  ***
@@ -75,4 +78,5 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER, INTENT(in) ::   Kmm  ! ocean time level index
       !
       INTEGER  ::   ji, jj, jk      ! dummy loop indices
@@ -93,34 +97,24 @@
       nmln(:,:)  = nlb10               ! Initialization to the number of w ocean point
       hmlp(:,:)  = 0._wp               ! here hmlp used as a dummy variable, integrating vertically N^2
-      zN2_c = grav * rho_c * r1_rau0   ! convert density criteria into N^2 criteria
-      DO jk = nlb10, jpkm1
-         DO jj = 1, jpj                ! Mixed layer level: w-level 
-            DO ji = 1, jpi
-               ikt = mbkt(ji,jj)
-               hmlp(ji,jj) = hmlp(ji,jj) + MAX( rn2b(ji,jj,jk) , 0._wp ) * e3w_n(ji,jj,jk)
-               IF( hmlp(ji,jj) < zN2_c )   nmln(ji,jj) = MIN( jk , ikt ) + 1   ! Mixed layer level
-            END DO
-         END DO
-      END DO
+      zN2_c = grav * rho_c * r1_rho0   ! convert density criteria into N^2 criteria
+      DO_3D_11_11( nlb10, jpkm1 )
+         ikt = mbkt(ji,jj)
+         hmlp(ji,jj) = hmlp(ji,jj) + MAX( rn2b(ji,jj,jk) , 0._wp ) * e3w(ji,jj,jk,Kmm)
+         IF( hmlp(ji,jj) < zN2_c )   nmln(ji,jj) = MIN( jk , ikt ) + 1   ! Mixed layer level
+      END_3D
       !
       ! w-level of the turbocline and mixing layer (iom_use)
       imld(:,:) = mbkt(:,:) + 1        ! Initialization to the number of w ocean point
-      DO jk = jpkm1, nlb10, -1         ! from the bottom to nlb10 
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( avt (ji,jj,jk) < avt_c * wmask(ji,jj,jk) )   imld(ji,jj) = jk      ! Turbocline 
-            END DO
-         END DO
-      END DO
+      DO_3DS_11_11( jpkm1, nlb10, -1 )
+         IF( avt (ji,jj,jk) < avt_c * wmask(ji,jj,jk) )   imld(ji,jj) = jk      ! Turbocline 
+      END_3D
       ! depth of the mixing and mixed layers
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            iiki = imld(ji,jj)
-            iikn = nmln(ji,jj)
-            hmld (ji,jj) = gdepw_n(ji,jj,iiki  ) * ssmask(ji,jj)    ! Turbocline depth 
-            hmlp (ji,jj) = gdepw_n(ji,jj,iikn  ) * ssmask(ji,jj)    ! Mixed layer depth
-            hmlpt(ji,jj) = gdept_n(ji,jj,iikn-1) * ssmask(ji,jj)    ! depth of the last T-point inside the mixed layer
-         END DO
-      END DO
+      DO_2D_11_11
+         iiki = imld(ji,jj)
+         iikn = nmln(ji,jj)
+         hmld (ji,jj) = gdepw(ji,jj,iiki  ,Kmm) * ssmask(ji,jj)    ! Turbocline depth 
+         hmlp (ji,jj) = gdepw(ji,jj,iikn  ,Kmm) * ssmask(ji,jj)    ! Mixed layer depth
+         hmlpt(ji,jj) = gdept(ji,jj,iikn-1,Kmm) * ssmask(ji,jj)    ! depth of the last T-point inside the mixed layer
+      END_2D
       !
       IF( .NOT.l_offline ) THEN
@@ -137,5 +131,5 @@
       ENDIF
       !
-      IF(ln_ctl)   CALL prt_ctl( tab2d_1=REAL(nmln,wp), clinfo1=' nmln : ', tab2d_2=hmlp, clinfo2=' hmlp : ' )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=REAL(nmln,wp), clinfo1=' nmln : ', tab2d_2=hmlp, clinfo2=' hmlp : ' )
       !
    END SUBROUTINE zdf_mxl
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfosm.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfosm.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfosm.F90	(revision 12928)
@@ -49,5 +49,5 @@
    !!----------------------------------------------------------------------
    USE oce            ! ocean dynamics and active tracers
-                      ! uses wn from previous time step (which is now wb) to calculate hbl
+                      ! uses ww from previous time step (which is now wb) to calculate hbl
    USE dom_oce        ! ocean space and time domain
    USE zdf_oce        ! ocean vertical physics
@@ -139,7 +139,9 @@
    INTEGER :: idebug = 236
    INTEGER :: jdebug = 228
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: zdfosm.F90 12317 2020-01-14 12:40:47Z agn $
+   !! $Id$
    !! Software governed by the CeCILL license (see ./LICENSE)
    !!----------------------------------------------------------------------
@@ -171,5 +173,5 @@
 
 
-   SUBROUTINE zdf_osm( kt, p_avm, p_avt )
+   SUBROUTINE zdf_osm( kt, Kbb, Kmm, Krhs, p_avm, p_avt )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE zdf_osm  ***
@@ -206,5 +208,6 @@
       !!         the equation number. (LMD94, here after)
       !!----------------------------------------------------------------------
-      INTEGER                   , INTENT(in   ) ::   kt            ! ocean time step
+      INTEGER                   , INTENT(in   ) ::  kt             ! ocean time step
+      INTEGER                   , INTENT(in   ) ::  Kbb, Kmm, Krhs ! ocean time level indices
       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::  p_avm, p_avt   ! momentum and tracer Kz (w-points)
       !!
@@ -378,104 +381,92 @@
      zz0 =       rn_abs       ! surface equi-partition in 2-bands
      zz1 =  1. - rn_abs
-     DO jj = 2, jpjm1
-        DO ji = 2, jpim1
-           ! Surface downward irradiance (so always +ve)
-           zrad0(ji,jj) = qsr(ji,jj) * r1_rau0_rcp
-           ! Downwards irradiance at base of boundary layer
-           zradh(ji,jj) = zrad0(ji,jj) * ( zz0 * EXP( -hbl(ji,jj)/rn_si0 ) + zz1 * EXP( -hbl(ji,jj)/rn_si1) )
-           ! Downwards irradiance averaged over depth of the OSBL
-           zradav(ji,jj) = zrad0(ji,jj) * ( zz0 * ( 1.0 - EXP( -hbl(ji,jj)/rn_si0 ) )*rn_si0 &
-                 &                         + zz1 * ( 1.0 - EXP( -hbl(ji,jj)/rn_si1 ) )*rn_si1 ) / hbl(ji,jj)
-        END DO
-     END DO
+     DO_2D_00_00
+        ! Surface downward irradiance (so always +ve)
+        zrad0(ji,jj) = qsr(ji,jj) * r1_rho0_rcp
+        ! Downwards irradiance at base of boundary layer
+        zradh(ji,jj) = zrad0(ji,jj) * ( zz0 * EXP( -hbl(ji,jj)/rn_si0 ) + zz1 * EXP( -hbl(ji,jj)/rn_si1) )
+        ! Downwards irradiance averaged over depth of the OSBL
+        zradav(ji,jj) = zrad0(ji,jj) * ( zz0 * ( 1.0 - EXP( -hbl(ji,jj)/rn_si0 ) )*rn_si0 &
+              &                         + zz1 * ( 1.0 - EXP( -hbl(ji,jj)/rn_si1 ) )*rn_si1 ) / hbl(ji,jj)
+     END_2D
      ! Turbulent surface fluxes and fluxes averaged over depth of the OSBL
-     DO jj = 2, jpjm1
-        DO ji = 2, jpim1
-           zthermal = rab_n(ji,jj,1,jp_tem)
-           zbeta    = rab_n(ji,jj,1,jp_sal)
-           ! Upwards surface Temperature flux for non-local term
-           zwth0(ji,jj) = - qns(ji,jj) * r1_rau0_rcp * tmask(ji,jj,1)
-           ! Upwards surface salinity flux for non-local term
-           zws0(ji,jj) = - ( ( emp(ji,jj)-rnf(ji,jj) ) * tsn(ji,jj,1,jp_sal)  + sfx(ji,jj) ) * r1_rau0 * tmask(ji,jj,1)
-           ! Non radiative upwards surface buoyancy flux
-           zwb0(ji,jj) = grav * zthermal * zwth0(ji,jj) -  grav * zbeta * zws0(ji,jj)
-           ! turbulent heat flux averaged over depth of OSBL
-           zwthav(ji,jj) = 0.5 * zwth0(ji,jj) - ( 0.5*( zrad0(ji,jj) + zradh(ji,jj) ) - zradav(ji,jj) )
-           ! turbulent salinity flux averaged over depth of the OBSL
-           zwsav(ji,jj) = 0.5 * zws0(ji,jj)
-           ! turbulent buoyancy flux averaged over the depth of the OBSBL
-           zwbav(ji,jj) = grav  * zthermal * zwthav(ji,jj) - grav  * zbeta * zwsav(ji,jj)
-           ! Surface upward velocity fluxes
-           zuw0(ji,jj) = -utau(ji,jj) * r1_rau0 * tmask(ji,jj,1)
-           zvw0(ji,jj) = -vtau(ji,jj) * r1_rau0 * tmask(ji,jj,1)
-           ! Friction velocity (zustar), at T-point : LMD94 eq. 2
-           zustar(ji,jj) = MAX( SQRT( SQRT( zuw0(ji,jj) * zuw0(ji,jj) + zvw0(ji,jj) * zvw0(ji,jj) ) ), 1.0e-8 )
-           zcos_wind(ji,jj) = -zuw0(ji,jj) / ( zustar(ji,jj) * zustar(ji,jj) )
-           zsin_wind(ji,jj) = -zvw0(ji,jj) / ( zustar(ji,jj) * zustar(ji,jj) )
-        END DO
-     END DO
+     DO_2D_00_00
+        zthermal = rab_n(ji,jj,1,jp_tem)
+        zbeta    = rab_n(ji,jj,1,jp_sal)
+        ! Upwards surface Temperature flux for non-local term
+        zwth0(ji,jj) = - qns(ji,jj) * r1_rho0_rcp * tmask(ji,jj,1)
+        ! Upwards surface salinity flux for non-local term
+        zws0(ji,jj) = - ( ( emp(ji,jj)-rnf(ji,jj) ) * ts(ji,jj,1,jp_sal,Kmm)  + sfx(ji,jj) ) * r1_rho0 * tmask(ji,jj,1)
+        ! Non radiative upwards surface buoyancy flux
+        zwb0(ji,jj) = grav * zthermal * zwth0(ji,jj) -  grav * zbeta * zws0(ji,jj)
+        ! turbulent heat flux averaged over depth of OSBL
+        zwthav(ji,jj) = 0.5 * zwth0(ji,jj) - ( 0.5*( zrad0(ji,jj) + zradh(ji,jj) ) - zradav(ji,jj) )
+        ! turbulent salinity flux averaged over depth of the OBSL
+        zwsav(ji,jj) = 0.5 * zws0(ji,jj)
+        ! turbulent buoyancy flux averaged over the depth of the OBSBL
+        zwbav(ji,jj) = grav  * zthermal * zwthav(ji,jj) - grav  * zbeta * zwsav(ji,jj)
+        ! Surface upward velocity fluxes
+        zuw0(ji,jj) = -utau(ji,jj) * r1_rho0 * tmask(ji,jj,1)
+        zvw0(ji,jj) = -vtau(ji,jj) * r1_rho0 * tmask(ji,jj,1)
+        ! Friction velocity (zustar), at T-point : LMD94 eq. 2
+        zustar(ji,jj) = MAX( SQRT( SQRT( zuw0(ji,jj) * zuw0(ji,jj) + zvw0(ji,jj) * zvw0(ji,jj) ) ), 1.0e-8 )
+        zcos_wind(ji,jj) = -zuw0(ji,jj) / ( zustar(ji,jj) * zustar(ji,jj) )
+        zsin_wind(ji,jj) = -zvw0(ji,jj) / ( zustar(ji,jj) * zustar(ji,jj) )
+     END_2D
      ! Calculate Stokes drift in direction of wind (zustke) and Stokes penetration depth (dstokes)
      SELECT CASE (nn_osm_wave)
      ! Assume constant La#=0.3
      CASE(0)
-        DO jj = 2, jpjm1
-           DO ji = 2, jpim1
-              zus_x = zcos_wind(ji,jj) * zustar(ji,jj) / 0.3**2
-              zus_y = zsin_wind(ji,jj) * zustar(ji,jj) / 0.3**2
-              zustke(ji,jj) = MAX ( SQRT( zus_x*zus_x + zus_y*zus_y), 1.0e-8 )
-              ! dstokes(ji,jj) set to constant value rn_osm_dstokes from namelist in zdf_osm_init
-           END DO
-        END DO
+        DO_2D_00_00
+           zus_x = zcos_wind(ji,jj) * zustar(ji,jj) / 0.3**2
+           zus_y = zsin_wind(ji,jj) * zustar(ji,jj) / 0.3**2
+           zustke(ji,jj) = MAX ( SQRT( zus_x*zus_x + zus_y*zus_y), 1.0e-8 )
+           ! dstokes(ji,jj) set to constant value rn_osm_dstokes from namelist in zdf_osm_init
+        END_2D
      ! Assume Pierson-Moskovitz wind-wave spectrum
      CASE(1)
-        DO jj = 2, jpjm1
-           DO ji = 2, jpim1
-              ! Use wind speed wndm included in sbc_oce module
-              zustke(ji,jj) = MAX ( 0.016 * wndm(ji,jj), 1.0e-8 )
-              dstokes(ji,jj) = MAX( 0.12 * wndm(ji,jj)**2 / grav, 5.e-1)
-           END DO
-        END DO
+        DO_2D_00_00
+           ! Use wind speed wndm included in sbc_oce module
+           zustke(ji,jj) = MAX ( 0.016 * wndm(ji,jj), 1.0e-8 )
+           dstokes(ji,jj) = MAX( 0.12 * wndm(ji,jj)**2 / grav, 5.e-1)
+        END_2D
      ! Use ECMWF wave fields as output from SBCWAVE
      CASE(2)
         zfac =  2.0_wp * rpi / 16.0_wp
-        DO jj = 2, jpjm1
-           DO ji = 2, jpim1
-              ! The Langmur number from the ECMWF model appears to give La<0.3 for wind-driven seas.
-              !    The coefficient 0.8 gives La=0.3  in this situation.
-              ! It could represent the effects of the spread of wave directions
-              ! around the mean wind. The effect of this adjustment needs to be tested.
-              zabsstke = SQRT(ut0sd(ji,jj)**2 + vt0sd(ji,jj)**2)
-              zustke(ji,jj) = MAX (0.8 * ( zcos_wind(ji,jj) * ut0sd(ji,jj) + zsin_wind(ji,jj)  * vt0sd(ji,jj) ), 1.0e-8)
-              dstokes(ji,jj) = MAX(zfac * hsw(ji,jj)*hsw(ji,jj) / ( MAX(zabsstke*wmp(ji,jj), 1.0e-7 ) ), 5.0e-1) !rn_osm_dstokes !
-           END DO
-        END DO
+        DO_2D_00_00
+           ! The Langmur number from the ECMWF model appears to give La<0.3 for wind-driven seas.
+           !    The coefficient 0.8 gives La=0.3  in this situation.
+           ! It could represent the effects of the spread of wave directions
+           ! around the mean wind. The effect of this adjustment needs to be tested.
+           zabsstke = SQRT(ut0sd(ji,jj)**2 + vt0sd(ji,jj)**2)
+           zustke(ji,jj) = MAX (0.8 * ( zcos_wind(ji,jj) * ut0sd(ji,jj) + zsin_wind(ji,jj)  * vt0sd(ji,jj) ), 1.0e-8)
+           dstokes(ji,jj) = MAX(zfac * hsw(ji,jj)*hsw(ji,jj) / ( MAX(zabsstke*wmp(ji,jj), 1.0e-7 ) ), 5.0e-1) !rn_osm_dstokes !
+        END_2D
      END SELECT
 
      ! Langmuir velocity scale (zwstrl), La # (zla)
      ! mixed scale (zvstr), convective velocity scale (zwstrc)
-     DO jj = 2, jpjm1
-        DO ji = 2, jpim1
-           ! Langmuir velocity scale (zwstrl), at T-point
-           zwstrl(ji,jj) = ( zustar(ji,jj) * zustar(ji,jj) * zustke(ji,jj) )**pthird
-           zla(ji,jj) = MAX(MIN(SQRT ( zustar(ji,jj) / ( zwstrl(ji,jj) + epsln ) )**3, 4.0), 0.2)
-           IF(zla(ji,jj) > 0.45) dstokes(ji,jj) = MIN(dstokes(ji,jj), 0.5_wp*hbl(ji,jj))
-           ! Velocity scale that tends to zustar for large Langmuir numbers
-           zvstr(ji,jj) = ( zwstrl(ji,jj)**3  + &
-                & ( 1.0 - EXP( -0.5 * zla(ji,jj)**2 ) ) * zustar(ji,jj) * zustar(ji,jj) * zustar(ji,jj) )**pthird
-
-           ! limit maximum value of Langmuir number as approximate treatment for shear turbulence.
-           ! Note zustke and zwstrl are not amended.
-           !
-           ! get convective velocity (zwstrc), stabilty scale (zhol) and logical conection flag lconv
-           IF ( zwbav(ji,jj) > 0.0) THEN
-              zwstrc(ji,jj) = ( 2.0 * zwbav(ji,jj) * 0.9 * hbl(ji,jj) )**pthird
-              zhol(ji,jj) = -0.9 * hbl(ji,jj) * 2.0 * zwbav(ji,jj) / (zvstr(ji,jj)**3 + epsln )
-              lconv(ji,jj) = .TRUE.
-           ELSE
-              zhol(ji,jj) = -hbl(ji,jj) *  2.0 * zwbav(ji,jj)/ (zvstr(ji,jj)**3  + epsln )
-              lconv(ji,jj) = .FALSE.
-           ENDIF
-        END DO
-     END DO
+     DO_2D_00_00
+        ! Langmuir velocity scale (zwstrl), at T-point
+        zwstrl(ji,jj) = ( zustar(ji,jj) * zustar(ji,jj) * zustke(ji,jj) )**pthird
+        zla(ji,jj) = MAX(MIN(SQRT ( zustar(ji,jj) / ( zwstrl(ji,jj) + epsln ) )**3, 4.0), 0.2)
+        IF(zla(ji,jj) > 0.45) dstokes(ji,jj) = MIN(dstokes(ji,jj), 0.5_wp*hbl(ji,jj))
+        ! Velocity scale that tends to zustar for large Langmuir numbers
+        zvstr(ji,jj) = ( zwstrl(ji,jj)**3  + &
+             & ( 1.0 - EXP( -0.5 * zla(ji,jj)**2 ) ) * zustar(ji,jj) * zustar(ji,jj) * zustar(ji,jj) )**pthird
+
+        ! limit maximum value of Langmuir number as approximate treatment for shear turbulence.
+        ! Note zustke and zwstrl are not amended.
+        !
+        ! get convective velocity (zwstrc), stabilty scale (zhol) and logical conection flag lconv
+        IF ( zwbav(ji,jj) > 0.0) THEN
+           zwstrc(ji,jj) = ( 2.0 * zwbav(ji,jj) * 0.9 * hbl(ji,jj) )**pthird
+           zhol(ji,jj) = -0.9 * hbl(ji,jj) * 2.0 * zwbav(ji,jj) / (zvstr(ji,jj)**3 + epsln )
+           lconv(ji,jj) = .TRUE.
+        ELSE
+           zhol(ji,jj) = -hbl(ji,jj) *  2.0 * zwbav(ji,jj)/ (zvstr(ji,jj)**3  + epsln )
+           lconv(ji,jj) = .FALSE.
+        ENDIF
+     END_2D
 
      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -486,34 +477,28 @@
      ! zdf_osm_zmld_horizontal_gradients need halo values for ibld, so must
      ! previously exist for hbl also.
-      hbl(:,:) = MAX(hbl(:,:), gdepw_n(:,:,4) )
+      hbl(:,:) = MAX(hbl(:,:), gdepw(:,:,4,Kmm) )
       ibld(:,:) = 4
-      DO jk = 5, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF ( hbl(ji,jj) >= gdepw_n(ji,jj,jk) ) THEN
-                  ibld(ji,jj) = MIN(mbkt(ji,jj), jk)
-               ENDIF
-            END DO
-         END DO
-      END DO
-
-      DO jj = 2, jpjm1
-         DO ji = 2, jpim1
-            zhbl(ji,jj) = gdepw_n(ji,jj,ibld(ji,jj))
-            imld(ji,jj) = MAX(3,ibld(ji,jj) - MAX( INT( dh(ji,jj) / e3t_n(ji, jj, ibld(ji,jj) )) , 1 ))
-            zhml(ji,jj) = gdepw_n(ji,jj,imld(ji,jj))
-         END DO
-      END DO
+      DO_3D_11_11( 5, jpkm1 )
+         IF ( hbl(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) THEN
+            ibld(ji,jj) = MIN(mbkt(ji,jj), jk)
+         ENDIF
+      END_3D
+
+      DO_2D_00_00
+         zhbl(ji,jj) = gdepw(ji,jj,ibld(ji,jj),Kmm)
+         imld(ji,jj) = MAX(3,ibld(ji,jj) - MAX( INT( dh(ji,jj) / e3t(ji, jj, ibld(ji,jj), Kmm )) , 1 ))
+         zhml(ji,jj) = gdepw(ji,jj,imld(ji,jj),Kmm)
+      END_2D
       ! Averages over well-mixed and boundary layer
       ! Alan: do we need zb_nl?, zb_ml?
-      CALL zdf_osm_vertical_average(ibld, zt_bl, zs_bl, zu_bl, zv_bl, zdt_bl, zds_bl, zdb_bl, zdu_bl, zdv_bl)
-      CALL zdf_osm_vertical_average(imld, zt_ml, zs_ml, zu_ml, zv_ml, zdt_ml, zds_ml, zdb_ml, zdu_ml, zdv_ml)
+      CALL zdf_osm_vertical_average(ibld, zt_bl, zs_bl, zu_bl, zv_bl, zdt_bl, zds_bl, zdb_bl, zdu_bl, zdv_bl, Kmm, Kbb )
+      CALL zdf_osm_vertical_average(imld, zt_ml, zs_ml, zu_ml, zv_ml, zdt_ml, zds_ml, zdb_ml, zdu_ml, zdv_ml, Kmm, Kbb )
 ! External gradient
-      CALL zdf_osm_external_gradients( zdtdz_ext, zdsdz_ext, zdbdz_ext )
+      CALL zdf_osm_external_gradients( zdtdz_ext, zdsdz_ext, zdbdz_ext, Kmm )
 
 
       IF ( ln_osm_mle ) THEN
-         CALL zdf_osm_zmld_horizontal_gradients( zmld, zdtdx, zdtdy, zdsdx, zdsdy, dbdx_mle, dbdy_mle )
-         CALL zdf_osm_mle_parameters( hmle, zwb_fk, zvel_mle, zdiff_mle )
+         CALL zdf_osm_zmld_horizontal_gradients( zmld, zdtdx, zdtdy, zdsdx, zdsdy, dbdx_mle, dbdy_mle, Kmm )
+         CALL zdf_osm_mle_parameters( hmle, zwb_fk, zvel_mle, zdiff_mle, Kmm )
        ENDIF
 
@@ -521,39 +506,34 @@
       CALL zdf_osm_calculate_dhdt( zdhdt, zdhdt_2 )
       ! Calculate averages over depth of boundary layer
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               zhbl_t(ji,jj) = hbl(ji,jj) + (zdhdt(ji,jj) - wn(ji,jj,ibld(ji,jj)))* rn_rdt ! certainly need wn here, so subtract it
-               ! adjustment to represent limiting by ocean bottom
-               zhbl_t(ji,jj) = MIN(zhbl_t(ji,jj), gdepw_n(ji,jj, mbkt(ji,jj) + 1) - depth_tol)! ht_n(:,:))
-            END DO
-         END DO
+      DO_2D_00_00
+         zhbl_t(ji,jj) = hbl(ji,jj) + (zdhdt(ji,jj) - ww(ji,jj,ibld(ji,jj)))* rn_Dt ! certainly need wn here, so subtract it
+         ! adjustment to represent limiting by ocean bottom
+         zhbl_t(ji,jj) = MIN(zhbl_t(ji,jj), gdepw(ji,jj, mbkt(ji,jj) + 1,Kmm) - depth_tol)! ht_n(:,:))
+      END_2D
 
       imld(:,:) = ibld(:,:)           ! use imld to hold previous blayer index
       ibld(:,:) = 4
 
-      DO jk = 4, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               IF ( zhbl_t(ji,jj) >= gdepw_n(ji,jj,jk) ) THEN
-                  ibld(ji,jj) = jk
-               ENDIF
-            END DO
-         END DO
-      END DO
+
+      DO_3D_00_00( 4, jpkm1 )
+         IF ( zhbl_t(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) THEN
+            ibld(ji,jj) = jk
+         ENDIF
+      END_3D
 
 !
 ! Step through model levels taking account of buoyancy change to determine the effect on dhdt
 !
-      CALL zdf_osm_timestep_hbl( zdhdt, zdhdt_2 )
+      CALL zdf_osm_timestep_hbl( zdhdt, zdhdt_2, Kmm )
       ! Alan: do we need zb_ml?
-      CALL zdf_osm_vertical_average( ibld, zt_bl, zs_bl, zu_bl, zv_bl, zdt_bl, zds_bl, zdb_bl, zdu_bl, zdv_bl )
+      CALL zdf_osm_vertical_average( ibld, zt_bl, zs_bl, zu_bl, zv_bl, zdt_bl, zds_bl, zdb_bl, zdu_bl, zdv_bl, Kmm, Kbb )
 !
 !
-      CALL zdf_osm_pycnocline_thickness( dh, zdh )
+      CALL zdf_osm_pycnocline_thickness( dh, zdh, Kmm )
       dstokes(:,:) = MIN ( dstokes(:,:), hbl(:,:)/3. )  !  Limit delta for shallow boundary layers for calculating flux-gradient terms.
 !
     ! Average over the depth of the mixed layer in the convective boundary layer
     ! Alan: do we need zb_ml?
-    CALL zdf_osm_vertical_average( imld, zt_ml, zs_ml, zu_ml, zv_ml, zdt_ml, zds_ml, zdb_ml, zdu_ml, zdv_ml )
+    CALL zdf_osm_vertical_average( imld, zt_ml, zs_ml, zu_ml, zv_ml, zdt_ml, zds_ml, zdb_ml, zdu_ml, zdv_ml, Kmm, Kbb )
     ! rotate mean currents and changes onto wind align co-ordinates
     !
@@ -564,24 +544,22 @@
      zwth_ent = 0._wp
      zws_ent = 0._wp
-     DO jj = 2, jpjm1
-        DO ji = 2, jpim1
-           IF ( ibld(ji,jj) < mbkt(ji,jj) ) THEN
-              IF ( lconv(ji,jj) ) THEN
-         	 zuw_bse(ji,jj) = -0.0075*((zvstr(ji,jj)**3+0.5*zwstrc(ji,jj)**3)**pthird*zdu_ml(ji,jj) + &
-                      &                    1.5*zustar(ji,jj)**2*(zhbl(ji,jj)-zhml(ji,jj)) )/ &
-                      &                     ( zhml(ji,jj)*MIN(zla(ji,jj)**(8./3.),1.) + epsln)
-	         zvw_bse(ji,jj) = 0.01*(-(zvstr(ji,jj)**3+0.5*zwstrc(ji,jj)**3)**pthird*zdv_ml(ji,jj)+ &
-                      &                    2.0*ff_t(ji,jj)*zustke(ji,jj)*dstokes(ji,jj)*zla(ji,jj))
-                 IF ( zdb_ml(ji,jj) > 0._wp ) THEN
-                    zwth_ent(ji,jj) = zwb_ent(ji,jj) * zdt_ml(ji,jj) / (zdb_ml(ji,jj) + epsln)
-                    zws_ent(ji,jj) = zwb_ent(ji,jj) * zds_ml(ji,jj) / (zdb_ml(ji,jj) + epsln)
-                 ENDIF
-              ELSE
-                 zwth_ent(ji,jj) = -2.0 * zwthav(ji,jj) * ( (1.0 - 0.8) - ( 1.0 - 0.8)**(3.0/2.0) )
-                 zws_ent(ji,jj) = -2.0 * zwsav(ji,jj) * ( (1.0 - 0.8 ) - ( 1.0 - 0.8 )**(3.0/2.0) )
+     DO_2D_00_00
+        IF ( ibld(ji,jj) < mbkt(ji,jj) ) THEN
+           IF ( lconv(ji,jj) ) THEN
+      	 zuw_bse(ji,jj) = -0.0075*((zvstr(ji,jj)**3+0.5*zwstrc(ji,jj)**3)**pthird*zdu_ml(ji,jj) + &
+                   &                    1.5*zustar(ji,jj)**2*(zhbl(ji,jj)-zhml(ji,jj)) )/ &
+                   &                     ( zhml(ji,jj)*MIN(zla(ji,jj)**(8./3.),1.) + epsln)
+              zvw_bse(ji,jj) = 0.01*(-(zvstr(ji,jj)**3+0.5*zwstrc(ji,jj)**3)**pthird*zdv_ml(ji,jj)+ &
+                   &                    2.0*ff_t(ji,jj)*zustke(ji,jj)*dstokes(ji,jj)*zla(ji,jj))
+              IF ( zdb_ml(ji,jj) > 0._wp ) THEN
+                 zwth_ent(ji,jj) = zwb_ent(ji,jj) * zdt_ml(ji,jj) / (zdb_ml(ji,jj) + epsln)
+                 zws_ent(ji,jj) = zwb_ent(ji,jj) * zds_ml(ji,jj) / (zdb_ml(ji,jj) + epsln)
               ENDIF
+           ELSE
+              zwth_ent(ji,jj) = -2.0 * zwthav(ji,jj) * ( (1.0 - 0.8) - ( 1.0 - 0.8)**(3.0/2.0) )
+              zws_ent(ji,jj) = -2.0 * zwsav(ji,jj) * ( (1.0 - 0.8 ) - ( 1.0 - 0.8 )**(3.0/2.0) )
            ENDIF
-        END DO
-     END DO
+        ENDIF
+     END_2D
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -589,80 +567,76 @@
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 
-      CALL zdf_osm_external_gradients( zdtdz_ext, zdsdz_ext, zdbdz_ext )
-      CALL zdf_osm_pycnocline_scalar_profiles( zdtdz_pyc, zdsdz_pyc, zdbdz_pyc )
-      CALL zdf_osm_pycnocline_shear_profiles( zdudz_pyc, zdvdz_pyc )
+      CALL zdf_osm_external_gradients( zdtdz_ext, zdsdz_ext, zdbdz_ext, Kmm )
+      CALL zdf_osm_pycnocline_scalar_profiles( zdtdz_pyc, zdsdz_pyc, zdbdz_pyc, Kmm )
+      CALL zdf_osm_pycnocline_shear_profiles( zdudz_pyc, zdvdz_pyc, Kmm )
        !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
        ! Eddy viscosity/diffusivity and non-gradient terms in the flux-gradient relationship
        !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 
-       DO jj = 2, jpjm1
-          DO ji = 2, jpim1
-             IF ( lconv(ji,jj) ) THEN
-               zdifml_sc(ji,jj) = zhml(ji,jj) * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird
-               zvisml_sc(ji,jj) = zdifml_sc(ji,jj)
-               zdifpyc_sc(ji,jj) = 0.165 * ( zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3 )**pthird * zdh(ji,jj)
-               zvispyc_sc(ji,jj) = 0.142 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * zdh(ji,jj)
-               zbeta_d_sc(ji,jj) = 1.0 - (0.165 / 0.8 * zdh(ji,jj) / zhbl(ji,jj) )**p2third
-               zbeta_v_sc(ji,jj) = 1.0 -  2.0 * (0.142 /0.375) * zdh(ji,jj) / ( zhml(ji,jj) + epsln )
-             ELSE
-               zdifml_sc(ji,jj) = zvstr(ji,jj) * zhbl(ji,jj) * EXP ( -( zhol(ji,jj) / 0.6_wp )**2 )
-               zvisml_sc(ji,jj) = zvstr(ji,jj) * zhbl(ji,jj) * EXP ( -( zhol(ji,jj) / 0.6_wp )**2 )
-             END IF
-          END DO
-       END DO
+       DO_2D_00_00
+          IF ( lconv(ji,jj) ) THEN
+            zdifml_sc(ji,jj) = zhml(ji,jj) * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird
+            zvisml_sc(ji,jj) = zdifml_sc(ji,jj)
+            zdifpyc_sc(ji,jj) = 0.165 * ( zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3 )**pthird * zdh(ji,jj)
+            zvispyc_sc(ji,jj) = 0.142 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * zdh(ji,jj)
+            zbeta_d_sc(ji,jj) = 1.0 - (0.165 / 0.8 * zdh(ji,jj) / zhbl(ji,jj) )**p2third
+            zbeta_v_sc(ji,jj) = 1.0 -  2.0 * (0.142 /0.375) * zdh(ji,jj) / ( zhml(ji,jj) + epsln )
+          ELSE
+            zdifml_sc(ji,jj) = zvstr(ji,jj) * zhbl(ji,jj) * EXP ( -( zhol(ji,jj) / 0.6_wp )**2 )
+            zvisml_sc(ji,jj) = zvstr(ji,jj) * zhbl(ji,jj) * EXP ( -( zhol(ji,jj) / 0.6_wp )**2 )
+         END IF
+       END_2D
 !
-       DO jj = 2, jpjm1
-          DO ji = 2, jpim1
-             IF ( lconv(ji,jj) ) THEN
-                DO jk = 2, imld(ji,jj)   ! mixed layer diffusivity
-                    zznd_ml = gdepw_n(ji,jj,jk) / zhml(ji,jj)
+       DO_2D_00_00
+          IF ( lconv(ji,jj) ) THEN
+             DO jk = 2, imld(ji,jj)   ! mixed layer diffusivity
+                 zznd_ml = gdepw(ji,jj,jk,Kmm) / zhml(ji,jj)
+                 !
+                 zdiffut(ji,jj,jk) = 0.8   * zdifml_sc(ji,jj) * zznd_ml * ( 1.0 - zbeta_d_sc(ji,jj) * zznd_ml    )**1.5
+                 !
+                 zviscos(ji,jj,jk) = 0.375 * zvisml_sc(ji,jj) * zznd_ml * ( 1.0 - zbeta_v_sc(ji,jj) * zznd_ml    ) &
+                      &            *                                      ( 1.0 -               0.5 * zznd_ml**2 )
+             END DO
+             ! pycnocline - if present linear profile
+             IF ( zdh(ji,jj) > 0._wp ) THEN
+                zgamma_b = 6.0
+                DO jk = imld(ji,jj)+1 , ibld(ji,jj)
+                    zznd_pyc = -( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) / zdh(ji,jj)
                     !
-                    zdiffut(ji,jj,jk) = 0.8   * zdifml_sc(ji,jj) * zznd_ml * ( 1.0 - zbeta_d_sc(ji,jj) * zznd_ml    )**1.5
+                    zdiffut(ji,jj,jk) = zdifpyc_sc(ji,jj) * EXP( zgamma_b * zznd_pyc )
                     !
-                    zviscos(ji,jj,jk) = 0.375 * zvisml_sc(ji,jj) * zznd_ml * ( 1.0 - zbeta_v_sc(ji,jj) * zznd_ml    ) &
-                         &            *                                      ( 1.0 -               0.5 * zznd_ml**2 )
+                    zviscos(ji,jj,jk) = zvispyc_sc(ji,jj) * EXP( zgamma_b * zznd_pyc )
                 END DO
-                ! pycnocline - if present linear profile
-                IF ( zdh(ji,jj) > 0._wp ) THEN
-                   zgamma_b = 6.0
-                   DO jk = imld(ji,jj)+1 , ibld(ji,jj)
-                       zznd_pyc = -( gdepw_n(ji,jj,jk) - zhml(ji,jj) ) / zdh(ji,jj)
-                       !
-                       zdiffut(ji,jj,jk) = zdifpyc_sc(ji,jj) * EXP( zgamma_b * zznd_pyc )
-                       !
-                       zviscos(ji,jj,jk) = zvispyc_sc(ji,jj) * EXP( zgamma_b * zznd_pyc )
-                   END DO
-                   IF ( ibld_ext == 0 ) THEN
-                       zdiffut(ji,jj,ibld(ji,jj)) = 0._wp
-                       zviscos(ji,jj,ibld(ji,jj)) = 0._wp
-                   ELSE
-                       zdiffut(ji,jj,ibld(ji,jj)) = zdhdt(ji,jj) * ( hbl(ji,jj) - gdepw_n(ji, jj, ibld(ji,jj)-1) )
-                       zviscos(ji,jj,ibld(ji,jj)) = zdhdt(ji,jj) * ( hbl(ji,jj) - gdepw_n(ji, jj, ibld(ji,jj)-1) )
-                   ENDIF
-                ENDIF
-                ! Temporary fix to ensure zdiffut is +ve; won't be necessary with wn taken out
-                zdiffut(ji,jj,ibld(ji,jj)) = MAX(zdhdt(ji,jj) * e3t_n(ji,jj,ibld(ji,jj)), 1.e-6)
-                zviscos(ji,jj,ibld(ji,jj)) = MAX(zdhdt(ji,jj) * e3t_n(ji,jj,ibld(ji,jj)), 1.e-5)
-                ! could be taken out, take account of entrainment represents as a diffusivity
-                ! should remove w from here, represents entrainment
-             ELSE
-             ! stable conditions
-                DO jk = 2, ibld(ji,jj)
-                   zznd_ml = gdepw_n(ji,jj,jk) / zhbl(ji,jj)
-                   zdiffut(ji,jj,jk) = 0.75 * zdifml_sc(ji,jj) * zznd_ml * ( 1.0 - zznd_ml )**1.5
-                   zviscos(ji,jj,jk) = 0.375 * zvisml_sc(ji,jj) * zznd_ml * (1.0 - zznd_ml) * ( 1.0 - zznd_ml**2 )
-                END DO
-
                 IF ( ibld_ext == 0 ) THEN
                    zdiffut(ji,jj,ibld(ji,jj)) = 0._wp
                    zviscos(ji,jj,ibld(ji,jj)) = 0._wp
                 ELSE
-                   zdiffut(ji,jj,ibld(ji,jj)) = MAX(zdhdt(ji,jj), 0._wp) * e3w_n(ji, jj, ibld(ji,jj))
-                   zviscos(ji,jj,ibld(ji,jj)) = MAX(zdhdt(ji,jj), 0._wp) * e3w_n(ji, jj, ibld(ji,jj))
+                   zdiffut(ji,jj,ibld(ji,jj)) = zdhdt(ji,jj) * ( hbl(ji,jj) - gdepw(ji, jj, ibld(ji,jj)-1, Kmm) )
+                   zviscos(ji,jj,ibld(ji,jj)) = zdhdt(ji,jj) * ( hbl(ji,jj) - gdepw(ji, jj, ibld(ji,jj)-1, Kmm) )
                 ENDIF
-             ENDIF   ! end if ( lconv )
-             !
-          END DO  ! end of ji loop
-       END DO     ! end of jj loop
+             ENDIF
+             ! Temporary fix to ensure zdiffut is +ve; won't be necessary with ww taken out
+             zdiffut(ji,jj,ibld(ji,jj)) = MAX(zdhdt(ji,jj) * e3t(ji,jj,ibld(ji,jj), Kmm), 1.e-6)
+             zviscos(ji,jj,ibld(ji,jj)) = MAX(zdhdt(ji,jj) * e3t(ji,jj,ibld(ji,jj), Kmm), 1.e-5)
+             ! could be taken out, take account of entrainment represents as a diffusivity
+             ! should remove w from here, represents entrainment
+          ELSE
+          ! stable conditions
+             DO jk = 2, ibld(ji,jj)
+                zznd_ml = gdepw(ji,jj,jk, Kmm) / zhbl(ji,jj)
+                zdiffut(ji,jj,jk) = 0.75 * zdifml_sc(ji,jj) * zznd_ml * ( 1.0 - zznd_ml )**1.5
+                zviscos(ji,jj,jk) = 0.375 * zvisml_sc(ji,jj) * zznd_ml * (1.0 - zznd_ml) * ( 1.0 - zznd_ml**2 )
+             END DO
+
+             IF ( ibld_ext == 0 ) THEN
+                zdiffut(ji,jj,ibld(ji,jj)) = 0._wp
+                zviscos(ji,jj,ibld(ji,jj)) = 0._wp
+             ELSE
+                zdiffut(ji,jj,ibld(ji,jj)) = MAX(zdhdt(ji,jj), 0._wp) * e3w(ji, jj, ibld(ji,jj), Kmm)
+                zviscos(ji,jj,ibld(ji,jj)) = MAX(zdhdt(ji,jj), 0._wp) * e3w(ji, jj, ibld(ji,jj), Kmm)
+             ENDIF
+          ENDIF   ! end if ( lconv )
+          !
+       END_2D
 
        !
@@ -681,27 +655,25 @@
 
 
-       DO jj = 2, jpjm1
-          DO ji = 2, jpim1
-            IF ( lconv(ji,jj) ) THEN
-              DO jk = 2, imld(ji,jj)
-                 zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj)
-                 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 1.35 * EXP ( -zznd_d ) * ( 1.0 - EXP ( -2.0 * zznd_d ) ) * zsc_wth_1(ji,jj)
-                 !
-                 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 1.35 * EXP ( -zznd_d ) * ( 1.0 - EXP ( -2.0 * zznd_d ) ) *  zsc_ws_1(ji,jj)
-              END DO ! end jk loop
-            ELSE     ! else for if (lconv)
+       DO_2D_00_00
+         IF ( lconv(ji,jj) ) THEN
+           DO jk = 2, imld(ji,jj)
+              zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj)
+              ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 1.35 * EXP ( -zznd_d ) * ( 1.0 - EXP ( -2.0 * zznd_d ) ) * zsc_wth_1(ji,jj)
+              !
+              ghams(ji,jj,jk) = ghams(ji,jj,jk) + 1.35 * EXP ( -zznd_d ) * ( 1.0 - EXP ( -2.0 * zznd_d ) ) *  zsc_ws_1(ji,jj)
+           END DO ! end jk loop
+         ELSE     ! else for if (lconv)
  ! Stable conditions
-               DO jk = 2, ibld(ji,jj)
-                  zznd_d=gdepw_n(ji,jj,jk) / dstokes(ji,jj)
-                  ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 1.5 * EXP ( -0.9 * zznd_d ) &
-                       &          *                 ( 1.0 - EXP ( -4.0 * zznd_d ) ) * zsc_wth_1(ji,jj)
-                  !
-                  ghams(ji,jj,jk) = ghams(ji,jj,jk) + 1.5 * EXP ( -0.9 * zznd_d ) &
-                       &          *                 ( 1.0 - EXP ( -4.0 * zznd_d ) ) *  zsc_ws_1(ji,jj)
-               END DO
-            ENDIF               ! endif for check on lconv
-
-          END DO  ! end of ji loop
-       END DO     ! end of jj loop
+            DO jk = 2, ibld(ji,jj)
+               zznd_d=gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj)
+               ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 1.5 * EXP ( -0.9 * zznd_d ) &
+                    &          *                 ( 1.0 - EXP ( -4.0 * zznd_d ) ) * zsc_wth_1(ji,jj)
+               !
+               ghams(ji,jj,jk) = ghams(ji,jj,jk) + 1.5 * EXP ( -0.9 * zznd_d ) &
+                    &          *                 ( 1.0 - EXP ( -4.0 * zznd_d ) ) *  zsc_ws_1(ji,jj)
+            END DO
+         ENDIF               ! endif for check on lconv
+
+       END_2D
 
 ! Stokes term in flux-gradient relationship (note in zsc_uw_n don't use zvstr since term needs to go to zero as zwstrl goes to zero)
@@ -718,27 +690,25 @@
           IF ( iom_use("ghamv_00") ) CALL iom_put( "ghamv_00", wmask*ghamv )
        END IF
-       DO jj = 2, jpjm1
-          DO ji = 2, jpim1
-             IF ( lconv(ji,jj) ) THEN
-                DO jk = 2, imld(ji,jj)
-                   zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj)
-                   ghamu(ji,jj,jk) = ghamu(ji,jj,jk) +      ( -0.05 * EXP ( -0.4 * zznd_d )   * zsc_uw_1(ji,jj)   &
-                        &          +                        0.00125 * EXP (      - zznd_d )   * zsc_uw_2(ji,jj) ) &
-                        &          *                          ( 1.0 - EXP ( -2.0 * zznd_d ) )
+       DO_2D_00_00
+          IF ( lconv(ji,jj) ) THEN
+             DO jk = 2, imld(ji,jj)
+                zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj)
+                ghamu(ji,jj,jk) = ghamu(ji,jj,jk) +      ( -0.05 * EXP ( -0.4 * zznd_d )   * zsc_uw_1(ji,jj)   &
+                     &          +                        0.00125 * EXP (      - zznd_d )   * zsc_uw_2(ji,jj) ) &
+                     &          *                          ( 1.0 - EXP ( -2.0 * zznd_d ) )
 !
-                   ghamv(ji,jj,jk) = ghamv(ji,jj,jk) - 0.65 *  0.15 * EXP (      - zznd_d )                       &
-                        &          *                          ( 1.0 - EXP ( -2.0 * zznd_d ) ) * zsc_vw_1(ji,jj)
-                END DO   ! end jk loop
-             ELSE
+                ghamv(ji,jj,jk) = ghamv(ji,jj,jk) - 0.65 *  0.15 * EXP (      - zznd_d )                       &
+                     &          *                          ( 1.0 - EXP ( -2.0 * zznd_d ) ) * zsc_vw_1(ji,jj)
+             END DO   ! end jk loop
+          ELSE
 ! Stable conditions
-                DO jk = 2, ibld(ji,jj) ! corrected to ibld
-                   zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj)
-                   ghamu(ji,jj,jk) = ghamu(ji,jj,jk) - 0.75 *   1.3 * EXP ( -0.5 * zznd_d )                       &
-                        &                                   * ( 1.0 - EXP ( -4.0 * zznd_d ) ) * zsc_uw_1(ji,jj)
-                   ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + 0._wp
-                END DO   ! end jk loop
-             ENDIF
-          END DO  ! ji loop
-       END DO     ! jj loo
+             DO jk = 2, ibld(ji,jj) ! corrected to ibld
+                zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj)
+                ghamu(ji,jj,jk) = ghamu(ji,jj,jk) - 0.75 *   1.3 * EXP ( -0.5 * zznd_d )                       &
+                     &                                   * ( 1.0 - EXP ( -4.0 * zznd_d ) ) * zsc_uw_1(ji,jj)
+                ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + 0._wp
+             END DO   ! end jk loop
+          ENDIF
+       END_2D
 
 ! Buoyancy term in flux-gradient relationship [note : includes ROI ratio (X0.3) and pressure (X0.5)]
@@ -752,27 +722,25 @@
        ENDWHERE
 
-       DO jj = 2, jpjm1
-          DO ji = 2, jpim1
-             IF (lconv(ji,jj) ) THEN
-                DO jk = 2, imld(ji,jj)
-                   zznd_ml = gdepw_n(ji,jj,jk) / zhml(ji,jj)
-                   ! calculate turbulent length scale
-                   zl_c = 0.9 * ( 1.0 - EXP ( - 7.0 * ( zznd_ml - zznd_ml**3 / 3.0 ) ) )                                           &
-                        &     * ( 1.0 - EXP ( -15.0 * (     1.1 - zznd_ml          ) ) )
-                   zl_l = 2.0 * ( 1.0 - EXP ( - 2.0 * ( zznd_ml - zznd_ml**3 / 3.0 ) ) )                                           &
-                        &     * ( 1.0 - EXP ( - 5.0 * (     1.0 - zznd_ml          ) ) ) * ( 1.0 + dstokes(ji,jj) / zhml (ji,jj) )
-                   zl_eps = zl_l + ( zl_c - zl_l ) / ( 1.0 + EXP ( -3.0 * LOG10 ( - zhol(ji,jj) ) ) ) ** (3.0/2.0)
-                   ! non-gradient buoyancy terms
-                   ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * 0.5 * zsc_wth_1(ji,jj) * zl_eps * zhml(ji,jj) / ( 0.15 + zznd_ml )
-                   ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * 0.5 *  zsc_ws_1(ji,jj) * zl_eps * zhml(ji,jj) / ( 0.15 + zznd_ml )
-                END DO
-             ELSE
-                DO jk = 2, ibld(ji,jj)
-                   ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zsc_wth_1(ji,jj)
-                   ghams(ji,jj,jk) = ghams(ji,jj,jk) +  zsc_ws_1(ji,jj)
-                END DO
-             ENDIF
-          END DO   ! ji loop
-       END DO      ! jj loop
+       DO_2D_00_00
+          IF (lconv(ji,jj) ) THEN
+             DO jk = 2, imld(ji,jj)
+                zznd_ml = gdepw(ji,jj,jk,Kmm) / zhml(ji,jj)
+                ! calculate turbulent length scale
+                zl_c = 0.9 * ( 1.0 - EXP ( - 7.0 * ( zznd_ml - zznd_ml**3 / 3.0 ) ) )                                           &
+                   &     * ( 1.0 - EXP ( -15.0 * (     1.1 - zznd_ml          ) ) )
+                zl_l = 2.0 * ( 1.0 - EXP ( - 2.0 * ( zznd_ml - zznd_ml**3 / 3.0 ) ) )                                           &
+                   &     * ( 1.0 - EXP ( - 5.0 * (     1.0 - zznd_ml          ) ) ) * ( 1.0 + dstokes(ji,jj) / zhml (ji,jj) )
+                zl_eps = zl_l + ( zl_c - zl_l ) / ( 1.0 + EXP ( -3.0 * LOG10 ( - zhol(ji,jj) ) ) ) ** (3.0/2.0)
+                ! non-gradient buoyancy terms
+                ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * 0.5 * zsc_wth_1(ji,jj) * zl_eps * zhml(ji,jj) / ( 0.15 + zznd_ml )
+                ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * 0.5 *  zsc_ws_1(ji,jj) * zl_eps * zhml(ji,jj) / ( 0.15 + zznd_ml )
+             END DO
+          ELSE
+             DO jk = 2, ibld(ji,jj)
+                ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zsc_wth_1(ji,jj)
+                ghams(ji,jj,jk) = ghams(ji,jj,jk) +  zsc_ws_1(ji,jj)
+             END DO
+          ENDIF
+       END_2D
 
        WHERE ( lconv )
@@ -785,23 +753,21 @@
        ENDWHERE
 
-       DO jj = 2, jpjm1
-          DO ji = 2, jpim1
-             IF ( lconv(ji,jj) ) THEN
-                DO jk = 2 , imld(ji,jj)
-                   zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj)
-                   ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + 0.3 * 0.5 * ( zsc_uw_1(ji,jj) +   0.125 * EXP( -0.5 * zznd_d )     &
-                        &                                                            * (   1.0 - EXP( -0.5 * zznd_d ) )   &
-                        &                                          * zsc_uw_2(ji,jj)                                    )
-                   ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zsc_vw_1(ji,jj)
-                END DO  ! jk loop
-             ELSE
-             ! stable conditions
-                DO jk = 2, ibld(ji,jj)
-                   ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zsc_uw_1(ji,jj)
-                   ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zsc_vw_1(ji,jj)
-                END DO
-             ENDIF
-          END DO        ! ji loop
-       END DO           ! jj loop
+       DO_2D_00_00
+          IF ( lconv(ji,jj) ) THEN
+             DO jk = 2 , imld(ji,jj)
+                zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj)
+                ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + 0.3 * 0.5 * ( zsc_uw_1(ji,jj) +   0.125 * EXP( -0.5 * zznd_d )     &
+                     &                                                            * (   1.0 - EXP( -0.5 * zznd_d ) )   &
+                     &                                          * zsc_uw_2(ji,jj)                                    )
+                ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zsc_vw_1(ji,jj)
+             END DO  ! jk loop
+          ELSE
+          ! stable conditions
+             DO jk = 2, ibld(ji,jj)
+                ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zsc_uw_1(ji,jj)
+                ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zsc_vw_1(ji,jj)
+             END DO
+          ENDIF
+       END_2D
 
        IF(ln_dia_osm) THEN
@@ -819,31 +785,29 @@
        ENDWHERE
 
-       DO jj = 2, jpjm1
-          DO ji = 2, jpim1
-            IF ( lconv(ji,jj) ) THEN
-               DO jk = 2, imld(ji,jj)
-                  zznd_ml=gdepw_n(ji,jj,jk) / zhml(ji,jj)
-                  ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * zsc_wth_1(ji,jj)                &
-                       &          * ( -2.0 + 2.75 * (       ( 1.0 + 0.6 * zznd_ml**4 )      &
-                       &                               - EXP(     - 6.0 * zznd_ml    ) ) )  &
-                       &          * ( 1.0 - EXP( - 15.0 * (         1.0 - zznd_ml    ) ) )
-                  !
-                  ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * zsc_ws_1(ji,jj)  &
-                       &          * ( -2.0 + 2.75 * (       ( 1.0 + 0.6 * zznd_ml**4 )      &
-                       &                               - EXP(     - 6.0 * zznd_ml    ) ) )  &
-                       &          * ( 1.0 - EXP ( -15.0 * (         1.0 - zznd_ml    ) ) )
-               END DO
-            ELSE
-               DO jk = 2, ibld(ji,jj)
-                  zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj)
-                  znd = gdepw_n(ji,jj,jk) / zhbl(ji,jj)
-                  ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * ( -4.06 * EXP( -2.0 * zznd_d ) * (1.0 - EXP( -4.0 * zznd_d ) ) + &
-               &  7.5 * EXP ( -10.0 * ( 0.95 - znd )**2 ) * ( 1.0 - znd ) ) * zsc_wth_1(ji,jj)
-                  ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * ( -4.06 * EXP( -2.0 * zznd_d ) * (1.0 - EXP( -4.0 * zznd_d ) ) + &
-               &  7.5 * EXP ( -10.0 * ( 0.95 - znd )**2 ) * ( 1.0 - znd ) ) * zsc_ws_1(ji,jj)
-               END DO
-            ENDIF
-          ENDDO    ! ji loop
-       END DO      ! jj loop
+       DO_2D_00_00
+         IF ( lconv(ji,jj) ) THEN
+            DO jk = 2, imld(ji,jj)
+               zznd_ml=gdepw(ji,jj,jk,Kmm) / zhml(ji,jj)
+               ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * zsc_wth_1(ji,jj)                &
+                    &          * ( -2.0 + 2.75 * (       ( 1.0 + 0.6 * zznd_ml**4 )      &
+                    &                               - EXP(     - 6.0 * zznd_ml    ) ) )  &
+                    &          * ( 1.0 - EXP( - 15.0 * (         1.0 - zznd_ml    ) ) )
+               !
+               ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * zsc_ws_1(ji,jj)  &
+                    &          * ( -2.0 + 2.75 * (       ( 1.0 + 0.6 * zznd_ml**4 )      &
+                    &                               - EXP(     - 6.0 * zznd_ml    ) ) )  &
+                    &          * ( 1.0 - EXP ( -15.0 * (         1.0 - zznd_ml    ) ) )
+            END DO
+         ELSE
+            DO jk = 2, ibld(ji,jj)
+               zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj)
+               znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj)
+               ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * ( -4.06 * EXP( -2.0 * zznd_d ) * (1.0 - EXP( -4.0 * zznd_d ) ) + &
+            &  7.5 * EXP ( -10.0 * ( 0.95 - znd )**2 ) * ( 1.0 - znd ) ) * zsc_wth_1(ji,jj)
+               ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * ( -4.06 * EXP( -2.0 * zznd_d ) * (1.0 - EXP( -4.0 * zznd_d ) ) + &
+            &  7.5 * EXP ( -10.0 * ( 0.95 - znd )**2 ) * ( 1.0 - znd ) ) * zsc_ws_1(ji,jj)
+            END DO
+         ENDIF
+       END_2D
 
        WHERE ( lconv )
@@ -857,38 +821,36 @@
        ENDWHERE
 
-       DO jj = 2, jpjm1
-          DO ji = 2, jpim1
-             IF ( lconv(ji,jj) ) THEN
-               DO jk = 2, imld(ji,jj)
-                  zznd_ml = gdepw_n(ji,jj,jk) / zhml(ji,jj)
-                  zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj)
+       DO_2D_00_00
+          IF ( lconv(ji,jj) ) THEN
+            DO jk = 2, imld(ji,jj)
+               zznd_ml = gdepw(ji,jj,jk,Kmm) / zhml(ji,jj)
+               zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj)
+               ghamu(ji,jj,jk) = ghamu(ji,jj,jk)&
+                    & + 0.3 * ( -2.0 + 2.5 * ( 1.0 + 0.1 * zznd_ml**4 ) - EXP ( -8.0 * zznd_ml ) ) * zsc_uw_1(ji,jj)
+               !
+               ghamv(ji,jj,jk) = ghamv(ji,jj,jk)&
+                    & + 0.3 * 0.1 * ( EXP( -zznd_d ) + EXP( -5.0 * ( 1.0 - zznd_ml ) ) ) * zsc_vw_1(ji,jj)
+            END DO
+          ELSE
+            DO jk = 2, ibld(ji,jj)
+               znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj)
+               zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj)
+               IF ( zznd_d <= 2.0 ) THEN
+                  ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + 0.5 * 0.3 &
+                       &*  ( 2.25 - 3.0  * ( 1.0 - EXP( - 1.25 * zznd_d ) ) * ( 1.0 - EXP( -2.0 * zznd_d ) ) ) * zsc_uw_1(ji,jj)
+                  !
+               ELSE
                   ghamu(ji,jj,jk) = ghamu(ji,jj,jk)&
-                       & + 0.3 * ( -2.0 + 2.5 * ( 1.0 + 0.1 * zznd_ml**4 ) - EXP ( -8.0 * zznd_ml ) ) * zsc_uw_1(ji,jj)
+                       & + 0.5 * 0.3 * ( 1.0 - EXP( -5.0 * ( 1.0 - znd ) ) ) * zsc_uw_2(ji,jj)
                   !
-                  ghamv(ji,jj,jk) = ghamv(ji,jj,jk)&
-                       & + 0.3 * 0.1 * ( EXP( -zznd_d ) + EXP( -5.0 * ( 1.0 - zznd_ml ) ) ) * zsc_vw_1(ji,jj)
-               END DO
-             ELSE
-               DO jk = 2, ibld(ji,jj)
-                  znd = gdepw_n(ji,jj,jk) / zhbl(ji,jj)
-                  zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj)
-                  IF ( zznd_d <= 2.0 ) THEN
-                     ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + 0.5 * 0.3 &
-                          &*  ( 2.25 - 3.0  * ( 1.0 - EXP( - 1.25 * zznd_d ) ) * ( 1.0 - EXP( -2.0 * zznd_d ) ) ) * zsc_uw_1(ji,jj)
-                     !
-                  ELSE
-                     ghamu(ji,jj,jk) = ghamu(ji,jj,jk)&
-                          & + 0.5 * 0.3 * ( 1.0 - EXP( -5.0 * ( 1.0 - znd ) ) ) * zsc_uw_2(ji,jj)
-                     !
-                  ENDIF
-
-                  ghamv(ji,jj,jk) = ghamv(ji,jj,jk)&
-                       & + 0.3 * 0.15 * SIN( 3.14159 * ( 0.65 * zznd_d ) ) * EXP( -0.25 * zznd_d**2 ) * zsc_vw_1(ji,jj)
-                  ghamv(ji,jj,jk) = ghamv(ji,jj,jk)&
-                       & + 0.3 * 0.15 * EXP( -5.0 * ( 1.0 - znd ) ) * ( 1.0 - EXP( -20.0 * ( 1.0 - znd ) ) ) * zsc_vw_2(ji,jj)
-               END DO
-             ENDIF
-          END DO
-       END DO
+               ENDIF
+
+               ghamv(ji,jj,jk) = ghamv(ji,jj,jk)&
+                    & + 0.3 * 0.15 * SIN( 3.14159 * ( 0.65 * zznd_d ) ) * EXP( -0.25 * zznd_d**2 ) * zsc_vw_1(ji,jj)
+               ghamv(ji,jj,jk) = ghamv(ji,jj,jk)&
+                    & + 0.3 * 0.15 * EXP( -5.0 * ( 1.0 - znd ) ) * ( 1.0 - EXP( -20.0 * ( 1.0 - znd ) ) ) * zsc_vw_2(ji,jj)
+            END DO
+          ENDIF
+       END_2D
 
        IF(ln_dia_osm) THEN
@@ -903,31 +865,29 @@
 ! Make surface forced velocity non-gradient terms go to zero at the base of the mixed layer.
 
-      DO jj = 2, jpjm1
-         DO ji = 2, jpim1
-            IF ( lconv(ji,jj) ) THEN
-               DO jk = 2, ibld(ji,jj)
-                  znd = ( gdepw_n(ji,jj,jk) - zhml(ji,jj) ) / zhml(ji,jj) !ALMG to think about
-                  IF ( znd >= 0.0 ) THEN
-                     ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * ( 1.0 - EXP( -30.0 * znd**2 ) )
-                     ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * ( 1.0 - EXP( -30.0 * znd**2 ) )
-                  ELSE
-                     ghamu(ji,jj,jk) = 0._wp
-                     ghamv(ji,jj,jk) = 0._wp
-                  ENDIF
-               END DO
-            ELSE
-               DO jk = 2, ibld(ji,jj)
-                  znd = ( gdepw_n(ji,jj,jk) - zhml(ji,jj) ) / zhml(ji,jj) !ALMG to think about
-                  IF ( znd >= 0.0 ) THEN
-                     ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * ( 1.0 - EXP( -10.0 * znd**2 ) )
-                     ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * ( 1.0 - EXP( -10.0 * znd**2 ) )
-                  ELSE
-                     ghamu(ji,jj,jk) = 0._wp
-                     ghamv(ji,jj,jk) = 0._wp
-                  ENDIF
-               END DO
-            ENDIF
-         END DO
-      END DO
+      DO_2D_00_00
+         IF ( lconv(ji,jj) ) THEN
+            DO jk = 2, ibld(ji,jj)
+               znd = ( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) / zhml(ji,jj) !ALMG to think about
+               IF ( znd >= 0.0 ) THEN
+                  ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * ( 1.0 - EXP( -30.0 * znd**2 ) )
+                  ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * ( 1.0 - EXP( -30.0 * znd**2 ) )
+               ELSE
+                  ghamu(ji,jj,jk) = 0._wp
+                  ghamv(ji,jj,jk) = 0._wp
+               ENDIF
+            END DO
+         ELSE
+            DO jk = 2, ibld(ji,jj)
+               znd = ( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) / zhml(ji,jj) !ALMG to think about
+               IF ( znd >= 0.0 ) THEN
+                  ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * ( 1.0 - EXP( -10.0 * znd**2 ) )
+                  ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * ( 1.0 - EXP( -10.0 * znd**2 ) )
+               ELSE
+                  ghamu(ji,jj,jk) = 0._wp
+                  ghamv(ji,jj,jk) = 0._wp
+               ENDIF
+            END DO
+         ENDIF
+      END_2D
 
        IF(ln_dia_osm) THEN
@@ -938,46 +898,42 @@
        ! Temporary fix to avoid instabilities when zdb_bl becomes very very small
        zsc_uw_1 = 0._wp ! 50.0 * zla**(8.0/3.0) * zustar**2 * zhbl / ( zdb_bl + epsln )
-       DO jj = 2, jpjm1
-          DO ji = 2, jpim1
-             IF ( ibld(ji,jj) + ibld_ext < mbkt(ji,jj) ) THEN
-                DO jk= 2, ibld(ji,jj)
-                   znd = gdepw_n(ji,jj,jk) / zhbl(ji,jj)
-                   ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zdiffut(ji,jj,jk) * zdtdz_pyc(ji,jj,jk)
-                   ghams(ji,jj,jk) = ghams(ji,jj,jk) + zdiffut(ji,jj,jk) * zdsdz_pyc(ji,jj,jk)
-                   ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zviscos(ji,jj,jk) * zdudz_pyc(ji,jj,jk)
-                   ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zsc_uw_1(ji,jj) * ( 1.0 - znd )**(7.0/4.0) * zdbdz_pyc(ji,jj,jk)
-                   ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zviscos(ji,jj,jk) * zdvdz_pyc(ji,jj,jk)
-                END DO
-             END IF
-          END DO
-       END DO
+       DO_2D_00_00
+          IF ( ibld(ji,jj) + ibld_ext < mbkt(ji,jj) ) THEN
+             DO jk= 2, ibld(ji,jj)
+                znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj)
+                ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zdiffut(ji,jj,jk) * zdtdz_pyc(ji,jj,jk)
+                ghams(ji,jj,jk) = ghams(ji,jj,jk) + zdiffut(ji,jj,jk) * zdsdz_pyc(ji,jj,jk)
+                ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zviscos(ji,jj,jk) * zdudz_pyc(ji,jj,jk)
+                ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zsc_uw_1(ji,jj) * ( 1.0 - znd )**(7.0/4.0) * zdbdz_pyc(ji,jj,jk)
+                ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zviscos(ji,jj,jk) * zdvdz_pyc(ji,jj,jk)
+             END DO
+          END IF
+       END_2D
 
 ! Entrainment contribution.
 
-       DO jj=2, jpjm1
-          DO ji = 2, jpim1
-            IF ( lconv(ji,jj) .AND. ibld(ji,jj) + ibld_ext < mbkt(ji,jj)) THEN
-               DO jk = 1, imld(ji,jj) - 1
-                  znd=gdepw_n(ji,jj,jk) / zhml(ji,jj)
-                  ! ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zwth_ent(ji,jj) * znd
-                  ! ghams(ji,jj,jk) = ghams(ji,jj,jk) + zws_ent(ji,jj) * znd
-                  ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zuw_bse(ji,jj) * znd
-                  ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zvw_bse(ji,jj) * znd
-               END DO
-               DO jk = imld(ji,jj), ibld(ji,jj)
-                  znd = -( gdepw_n(ji,jj,jk) - zhml(ji,jj) ) / zdh(ji,jj)
-                  ! ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zwth_ent(ji,jj) * ( 1.0 + znd )
-                  ! ghams(ji,jj,jk) = ghams(ji,jj,jk) + zws_ent(ji,jj) * ( 1.0 + znd )
-                  ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zuw_bse(ji,jj) * ( 1.0 + znd )
-                  ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zvw_bse(ji,jj) * ( 1.0 + znd )
-                END DO
-             ENDIF
-
-             ghamt(ji,jj,ibld(ji,jj)+ibld_ext) = 0._wp
-             ghams(ji,jj,ibld(ji,jj)+ibld_ext) = 0._wp
-             ghamu(ji,jj,ibld(ji,jj)+ibld_ext) = 0._wp
-             ghamv(ji,jj,ibld(ji,jj)+ibld_ext) = 0._wp
-          END DO       ! ji loop
-       END DO          ! jj loop
+       DO_2D_00_00
+          IF ( lconv(ji,jj) .AND. ibld(ji,jj) + ibld_ext < mbkt(ji,jj)) THEN
+             DO jk = 1, imld(ji,jj) - 1
+                znd=gdepw(ji,jj,jk,kmm) / zhml(ji,jj)
+                ! ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zwth_ent(ji,jj) * znd
+                ! ghams(ji,jj,jk) = ghams(ji,jj,jk) + zws_ent(ji,jj) * znd
+                ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zuw_bse(ji,jj) * znd
+                ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zvw_bse(ji,jj) * znd
+             END DO
+             DO jk = imld(ji,jj), ibld(ji,jj)
+                znd = -( gdepw(ji,jj,jk,kmm) - zhml(ji,jj) ) / zdh(ji,jj)
+                ! ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zwth_ent(ji,jj) * ( 1.0 + znd )
+                ! ghams(ji,jj,jk) = ghams(ji,jj,jk) + zws_ent(ji,jj) * ( 1.0 + znd )
+                ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zuw_bse(ji,jj) * ( 1.0 + znd )
+                ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zvw_bse(ji,jj) * ( 1.0 + znd )
+             END DO
+          ENDIF
+
+          ghamt(ji,jj,ibld(ji,jj)+ibld_ext) = 0._wp
+          ghams(ji,jj,ibld(ji,jj)+ibld_ext) = 0._wp
+          ghamu(ji,jj,ibld(ji,jj)+ibld_ext) = 0._wp
+          ghamv(ji,jj,ibld(ji,jj)+ibld_ext) = 0._wp
+       END_2D
 
        IF(ln_dia_osm) THEN
@@ -1001,13 +957,11 @@
        ! rotate non-gradient velocity terms back to model reference frame
 
-       DO jj = 2, jpjm1
-          DO ji = 2, jpim1
-             DO jk = 2, ibld(ji,jj)
-                ztemp = ghamu(ji,jj,jk)
-                ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * zcos_wind(ji,jj) - ghamv(ji,jj,jk) * zsin_wind(ji,jj)
-                ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * zcos_wind(ji,jj) + ztemp * zsin_wind(ji,jj)
-             END DO
+       DO_2D_00_00
+          DO jk = 2, ibld(ji,jj)
+             ztemp = ghamu(ji,jj,jk)
+             ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * zcos_wind(ji,jj) - ghamv(ji,jj,jk) * zsin_wind(ji,jj)
+             ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * zcos_wind(ji,jj) + ztemp * zsin_wind(ji,jj)
           END DO
-       END DO
+       END_2D
 
        IF(ln_dia_osm) THEN
@@ -1019,40 +973,30 @@
 ! KPP-style Ri# mixing
        IF( ln_kpprimix) THEN
-          DO jk = 2, jpkm1           !* Shear production at uw- and vw-points (energy conserving form)
-             DO jj = 1, jpjm1
-                DO ji = 1, jpim1   ! vector opt.
-                   z3du(ji,jj,jk) = 0.5 * (  un(ji,jj,jk-1) -  un(ji  ,jj,jk) )   &
-                        &                 * (  ub(ji,jj,jk-1) -  ub(ji  ,jj,jk) ) * wumask(ji,jj,jk) &
-                        &                 / (  e3uw_n(ji,jj,jk) * e3uw_b(ji,jj,jk) )
-                   z3dv(ji,jj,jk) = 0.5 * (  vn(ji,jj,jk-1) -  vn(ji,jj  ,jk) )   &
-                        &                 * (  vb(ji,jj,jk-1) -  vb(ji,jj  ,jk) ) * wvmask(ji,jj,jk) &
-                        &                 / (  e3vw_n(ji,jj,jk) * e3vw_b(ji,jj,jk) )
-                END DO
+          DO_3D_10_10( 2, jpkm1 )
+             z3du(ji,jj,jk) = 0.5 * (  uu(ji,jj,jk-1,Kmm) -  uu(ji  ,jj,jk,Kmm) )   &
+                  &                 * (  uu(ji,jj,jk-1,Kbb) -  uu(ji  ,jj,jk,Kbb) ) * wumask(ji,jj,jk) &
+                  &                 / (  e3uw(ji,jj,jk,Kmm) * e3uw(ji,jj,jk,Kbb) )
+             z3dv(ji,jj,jk) = 0.5 * (  vv(ji,jj,jk-1,Kmm) -  vv(ji,jj  ,jk,Kmm) )   &
+                  &                 * (  vv(ji,jj,jk-1,Kbb) -  vv(ji,jj  ,jk,Kbb) ) * wvmask(ji,jj,jk) &
+                  &                 / (  e3vw(ji,jj,jk,Kmm) * e3vw(ji,jj,jk,Kbb) )
+          END_3D
+      !
+         DO_3D_00_00( 2, jpkm1 )
+            !                                          ! shear prod. at w-point weightened by mask
+            zesh2  =  ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   &
+               &    + ( z3dv(ji,jj-1,jk) + z3dv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) )
+            !                                          ! local Richardson number
+            zri   = MAX( rn2b(ji,jj,jk), 0._wp ) / MAX(zesh2, epsln)
+            zfri =  MIN( zri / rn_riinfty , 1.0_wp )
+            zfri  = ( 1.0_wp - zfri * zfri )
+            zrimix(ji,jj,jk)  =  zfri * zfri  * zfri * wmask(ji, jj, jk)
+         END_3D
+
+          DO_2D_00_00
+             DO jk = ibld(ji,jj) + 1, jpkm1
+                zdiffut(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri
+                zviscos(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri
              END DO
-          END DO
-      !
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1   ! vector opt.
-                  !                                          ! shear prod. at w-point weightened by mask
-                  zesh2  =  ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   &
-                     &    + ( z3dv(ji,jj-1,jk) + z3dv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) )
-                  !                                          ! local Richardson number
-                  zri   = MAX( rn2b(ji,jj,jk), 0._wp ) / MAX(zesh2, epsln)
-                  zfri =  MIN( zri / rn_riinfty , 1.0_wp )
-                  zfri  = ( 1.0_wp - zfri * zfri )
-                  zrimix(ji,jj,jk)  =  zfri * zfri  * zfri * wmask(ji, jj, jk)
-                END DO
-             END DO
-          END DO
-
-          DO jj = 2, jpjm1
-             DO ji = 2, jpim1
-                DO jk = ibld(ji,jj) + 1, jpkm1
-                   zdiffut(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri
-                   zviscos(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri
-                END DO
-             END DO
-          END DO
+          END_2D
 
        END IF ! ln_kpprimix = .true.
@@ -1060,11 +1004,9 @@
 ! KPP-style set diffusivity large if unstable below BL
        IF( ln_convmix) THEN
-          DO jj = 2, jpjm1
-             DO ji = 2, jpim1
-                DO jk = ibld(ji,jj) + 1, jpkm1
-                  IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) zdiffut(ji,jj,jk) = rn_difconv
-                END DO
+          DO_2D_00_00
+             DO jk = ibld(ji,jj) + 1, jpkm1
+               IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) zdiffut(ji,jj,jk) = rn_difconv
              END DO
-          END DO
+          END_2D
        END IF ! ln_convmix = .true.
 
@@ -1072,41 +1014,39 @@
  
        IF ( ln_osm_mle ) THEN  ! set up diffusivity and non-gradient mixing
-          DO jj = 2 , jpjm1
-             DO ji = 2, jpim1
-                IF ( lconv(ji,jj) .AND. mld_prof(ji,jj) - ibld(ji,jj) > 1 ) THEN ! MLE mmixing extends below the OSBL.
-            ! Calculate MLE flux profiles
-                   ! DO jk = 1, mld_prof(ji,jj)
-                   !    znd = - gdepw_n(ji,jj,jk) / MAX(zhmle(ji,jj),epsln)
-                   !    ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + &
-                   !         & zwt_fk(ji,jj) * ( 1.0 - ( 2.0 * znd + 1.0 )**2 ) * ( 1.0 + r5_21 * ( 2.0 * znd + 1.0 )**2 )
-                   !    ghams(ji,jj,jk) = ghams(ji,jj,jk) + &
-                   !         & zws_fk(ji,jj) * ( 1.0 - ( 2.0 * znd + 1.0 )**2 ) * ( 1.0 + r5_21 * ( 2.0 * znd + 1.0 )**2 )
-                   ! END DO
-            ! Calculate MLE flux contribution from surface fluxes
-                   DO jk = 1, ibld(ji,jj)
-                     znd = gdepw_n(ji,jj,jk) / MAX(zhbl(ji,jj),epsln)
-                     ghamt(ji,jj,jk) = ghamt(ji,jj,jk) - zwth0(ji,jj) * ( 1.0 - znd )
-                     ghams(ji,jj,jk) = ghams(ji,jj,jk) - zws0(ji,jj) * ( 1.0 - znd )
-                    END DO
-                    DO jk = 1, mld_prof(ji,jj)
-                      znd = gdepw_n(ji,jj,jk) / MAX(zhmle(ji,jj),epsln)
-                      ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zwth0(ji,jj) * ( 1.0 - znd )
-                      ghams(ji,jj,jk) = ghams(ji,jj,jk) + zws0(ji,jj) * ( 1.0 -znd )
-                    END DO
-            ! Viscosity for MLEs
-                    DO jk = ibld(ji,jj), mld_prof(ji,jj)
-                      zdiffut(ji,jj,jk) = MAX( zdiffut(ji,jj,jk), zdiff_mle(ji,jj) )
-                    END DO
-            ! Iterate to find approx vertical index for depth 1.1*zhmle(ji,jj)
-                    jl = MIN(mld_prof(ji,jj) + 2, mbkt(ji,jj))
-                    jl = MIN( MAX(INT( 0.1 * zhmle(ji,jj) / e3t_n(ji,jj,jl)), 2 ) + mld_prof(ji,jj), mbkt(ji,jj))
-                    DO jk = mld_prof(ji,jj),  jl
-                       zdiffut(ji,jj,jk) = MAX( zdiffut(ji,jj,jk), zdiff_mle(ji,jj) * &
-                            & ( gdepw_n(ji,jj,jk) - gdepw_n(ji,jj,jl) ) / &
-                            & ( gdepw_n(ji,jj,mld_prof(ji,jj)) - gdepw_n(ji,jj,jl) - epsln))
-                    END DO
-                ENDIF
-            END DO
-          END DO
+          DO_2D_00_00
+             IF ( lconv(ji,jj) .AND. mld_prof(ji,jj) - ibld(ji,jj) > 1 ) THEN ! MLE mmixing extends below the OSBL.
+         ! Calculate MLE flux profiles
+                ! DO jk = 1, mld_prof(ji,jj)
+                !    znd = - gdepw(ji,jj,jk, Kmm ) / MAX(zhmle(ji,jj),epsln)
+                !    ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + &
+                !         & zwt_fk(ji,jj) * ( 1.0 - ( 2.0 * znd + 1.0 )**2 ) * ( 1.0 + r5_21 * ( 2.0 * znd + 1.0 )**2 )
+                !    ghams(ji,jj,jk) = ghams(ji,jj,jk) + &
+                !         & zws_fk(ji,jj) * ( 1.0 - ( 2.0 * znd + 1.0 )**2 ) * ( 1.0 + r5_21 * ( 2.0 * znd + 1.0 )**2 )
+                ! END DO
+         ! Calculate MLE flux contribution from surface fluxes
+                DO jk = 1, ibld(ji,jj)
+                  znd = gdepw(ji,jj,jk, Kmm ) / MAX(zhbl(ji,jj),epsln)
+                  ghamt(ji,jj,jk) = ghamt(ji,jj,jk) - zwth0(ji,jj) * ( 1.0 - znd )
+                  ghams(ji,jj,jk) = ghams(ji,jj,jk) - zws0(ji,jj) * ( 1.0 - znd )
+                 END DO
+                 DO jk = 1, mld_prof(ji,jj)
+                   znd = gdepw(ji,jj,jk, Kmm ) / MAX(zhmle(ji,jj),epsln)
+                   ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zwth0(ji,jj) * ( 1.0 - znd )
+                   ghams(ji,jj,jk) = ghams(ji,jj,jk) + zws0(ji,jj) * ( 1.0 -znd )
+                 END DO
+         ! Viscosity for MLEs
+                 DO jk = ibld(ji,jj), mld_prof(ji,jj)
+                   zdiffut(ji,jj,jk) = MAX( zdiffut(ji,jj,jk), zdiff_mle(ji,jj) )
+                 END DO
+         ! Iterate to find approx vertical index for depth 1.1*zhmle(ji,jj)
+                 jl = MIN(mld_prof(ji,jj) + 2, mbkt(ji,jj))
+                 jl = MIN( MAX(INT( 0.1 * zhmle(ji,jj) / e3t(ji,jj,jl, Kmm ) ), 2 ) + mld_prof(ji,jj), mbkt(ji,jj))
+                 DO jk = mld_prof(ji,jj),  jl
+                    zdiffut(ji,jj,jk) = MAX( zdiffut(ji,jj,jk), zdiff_mle(ji,jj) * &
+                         & ( gdepw(ji,jj,jk, Kmm ) - gdepw(ji,jj,jl, Kmm ) ) / &
+                         & ( gdepw(ji,jj,mld_prof(ji,jj), Kmm ) - gdepw(ji,jj,jl, Kmm ) - epsln))
+                 END DO
+             ENDIF
+          END_2D
        ENDIF
 
@@ -1123,29 +1063,21 @@
        ! GN 25/8: need to change tmask --> wmask
 
-     DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-             DO ji = 2, jpim1
-                p_avt(ji,jj,jk) = MAX( zdiffut(ji,jj,jk), avtb(jk) ) * tmask(ji,jj,jk)
-                p_avm(ji,jj,jk) = MAX( zviscos(ji,jj,jk), avmb(jk) ) * tmask(ji,jj,jk)
-             END DO
-         END DO
-     END DO
+     DO_3D_00_00( 2, jpkm1 )
+          p_avt(ji,jj,jk) = MAX( zdiffut(ji,jj,jk), avtb(jk) ) * tmask(ji,jj,jk)
+          p_avm(ji,jj,jk) = MAX( zviscos(ji,jj,jk), avmb(jk) ) * tmask(ji,jj,jk)
+     END_3D
       ! Lateral boundary conditions on ghamu and ghamv, currently on W-grid  (sign unchanged), needed to caclulate gham[uv] on u and v grids
      CALL lbc_lnk_multi( 'zdfosm', p_avt, 'W', 1. , p_avm, 'W', 1.,   &
       &                  ghamu, 'W', 1. , ghamv, 'W', 1. )
-       DO jk = 2, jpkm1
-           DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  ghamu(ji,jj,jk) = ( ghamu(ji,jj,jk) + ghamu(ji+1,jj,jk) ) &
-                     &  / MAX( 1., tmask(ji,jj,jk) + tmask (ji + 1,jj,jk) ) * umask(ji,jj,jk)
-
-                  ghamv(ji,jj,jk) = ( ghamv(ji,jj,jk) + ghamv(ji,jj+1,jk) ) &
-                      &  / MAX( 1., tmask(ji,jj,jk) + tmask (ji,jj+1,jk) ) * vmask(ji,jj,jk)
-
-                  ghamt(ji,jj,jk) =  ghamt(ji,jj,jk) * tmask(ji,jj,jk)
-                  ghams(ji,jj,jk) =  ghams(ji,jj,jk) * tmask(ji,jj,jk)
-               END DO
-           END DO
-        END DO
+       DO_3D_00_00( 2, jpkm1 )
+            ghamu(ji,jj,jk) = ( ghamu(ji,jj,jk) + ghamu(ji+1,jj,jk) ) &
+               &  / MAX( 1., tmask(ji,jj,jk) + tmask (ji + 1,jj,jk) ) * umask(ji,jj,jk)
+
+            ghamv(ji,jj,jk) = ( ghamv(ji,jj,jk) + ghamv(ji,jj+1,jk) ) &
+                &  / MAX( 1., tmask(ji,jj,jk) + tmask (ji,jj+1,jk) ) * vmask(ji,jj,jk)
+
+            ghamt(ji,jj,jk) =  ghamt(ji,jj,jk) * tmask(ji,jj,jk)
+            ghams(ji,jj,jk) =  ghams(ji,jj,jk) * tmask(ji,jj,jk)
+       END_3D
         ! Lateral boundary conditions on final outputs for hbl,  on T-grid (sign unchanged)
         CALL lbc_lnk_multi( 'zdfosm', hbl, 'T', 1., dh, 'T', 1., hmle, 'T', 1. )
@@ -1161,5 +1093,5 @@
             IF ( iom_use("us_x") ) CALL iom_put( "us_x", tmask(:,:,1)*zustke*zcos_wind )   ! x surface Stokes drift
             IF ( iom_use("us_y") ) CALL iom_put( "us_y", tmask(:,:,1)*zustke*zsin_wind )  ! y surface Stokes drift
-            IF ( iom_use("wind_wave_abs_power") ) CALL iom_put( "wind_wave_abs_power", 1000.*rau0*tmask(:,:,1)*zustar**2*zustke )
+            IF ( iom_use("wind_wave_abs_power") ) CALL iom_put( "wind_wave_abs_power", 1000.*rho0*tmask(:,:,1)*zustar**2*zustke )
          ! Stokes drift read in from sbcwave  (=2).
          CASE(2)
@@ -1171,5 +1103,5 @@
             IF ( iom_use("hsw_NP") ) CALL iom_put( "hsw_NP", (0.22/grav)*wndm**2*tmask(:,:,1) )                   ! significant wave height from NP spectrum
             IF ( iom_use("wndm") ) CALL iom_put( "wndm", wndm*tmask(:,:,1) )                   ! U_10
-            IF ( iom_use("wind_wave_abs_power") ) CALL iom_put( "wind_wave_abs_power", 1000.*rau0*tmask(:,:,1)*zustar**2* &
+            IF ( iom_use("wind_wave_abs_power") ) CALL iom_put( "wind_wave_abs_power", 1000.*rho0*tmask(:,:,1)*zustar**2* &
                  & SQRT(ut0sd**2 + vt0sd**2 ) )
          END SELECT
@@ -1196,6 +1128,6 @@
          IF ( iom_use("zvstr") ) CALL iom_put( "zvstr", tmask(:,:,1)*zvstr )         ! mixed velocity scale
          IF ( iom_use("zla") ) CALL iom_put( "zla", tmask(:,:,1)*zla )         ! langmuir #
-         IF ( iom_use("wind_power") ) CALL iom_put( "wind_power", 1000.*rau0*tmask(:,:,1)*zustar**3 ) ! BL depth internal to zdf_osm routine
-         IF ( iom_use("wind_wave_power") ) CALL iom_put( "wind_wave_power", 1000.*rau0*tmask(:,:,1)*zustar**2*zustke )
+         IF ( iom_use("wind_power") ) CALL iom_put( "wind_power", 1000.*rho0*tmask(:,:,1)*zustar**3 ) ! BL depth internal to zdf_osm routine
+         IF ( iom_use("wind_wave_power") ) CALL iom_put( "wind_wave_power", 1000.*rho0*tmask(:,:,1)*zustar**2*zustke )
          IF ( iom_use("zhbl") ) CALL iom_put( "zhbl", tmask(:,:,1)*zhbl )               ! BL depth internal to zdf_osm routine
          IF ( iom_use("zhml") ) CALL iom_put( "zhml", tmask(:,:,1)*zhml )               ! ML depth internal to zdf_osm routine
@@ -1229,5 +1161,5 @@
 
    ! Alan: do we need zb?
-   SUBROUTINE zdf_osm_vertical_average( jnlev_av, zt, zs, zu, zv, zdt, zds, zdb, zdu, zdv )
+   SUBROUTINE zdf_osm_vertical_average( jnlev_av, zt, zs, zu, zv, zdt, zds, zdb, zdu, zdv, Kmm, Kbb )
      !!---------------------------------------------------------------------
      !!                   ***  ROUTINE zdf_vertical_average  ***
@@ -1240,5 +1172,6 @@
      !!----------------------------------------------------------------------
 
-        INTEGER, DIMENSION(jpi,jpj) :: jnlev_av  ! Number of levels to average over.
+       INTEGER, INTENT(in) ::   Kmm, Kbb          ! time-level indices
+        INTEGER, DIMENSION(jpi,jpj) :: jnlev_av   ! Number of levels to average over.
 
         ! Alan: do we need zb?
@@ -1256,35 +1189,33 @@
         zu   = 0._wp
         zv   = 0._wp
-        DO jj = 2, jpjm1                                 !  Vertical slab
-         DO ji = 2, jpim1
-            zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1??
-            zbeta    = rab_n(ji,jj,1,jp_sal)
-               ! average over depth of boundary layer
-            zthick = epsln
-            DO jk = 2, jnlev_av(ji,jj)
-               zthick = zthick + e3t_n(ji,jj,jk)
-               zt(ji,jj)   = zt(ji,jj)  + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_tem)
-               zs(ji,jj)   = zs(ji,jj)  + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal)
-               zu(ji,jj)   = zu(ji,jj)  + e3t_n(ji,jj,jk) &
-                     &            * ( ub(ji,jj,jk) + ub(ji - 1,jj,jk) ) &
-                     &            / MAX( 1. , umask(ji,jj,jk) + umask(ji - 1,jj,jk) )
-               zv(ji,jj)   = zv(ji,jj)  + e3t_n(ji,jj,jk) &
-                     &            * ( vb(ji,jj,jk) + vb(ji,jj - 1,jk) ) &
-                     &            / MAX( 1. , vmask(ji,jj,jk) + vmask(ji,jj - 1,jk) )
-            END DO
-            zt(ji,jj) = zt(ji,jj) / zthick
-            zs(ji,jj) = zs(ji,jj) / zthick
-            zu(ji,jj) = zu(ji,jj) / zthick
-            zv(ji,jj) = zv(ji,jj) / zthick
-            ! Alan: do we need zb?
-            zdt(ji,jj) = zt(ji,jj) - tsn(ji,jj,ibld(ji,jj)+ibld_ext,jp_tem)
-            zds(ji,jj) = zs(ji,jj) - tsn(ji,jj,ibld(ji,jj)+ibld_ext,jp_sal)
-            zdu(ji,jj) = zu(ji,jj) - ( ub(ji,jj,ibld(ji,jj)+ibld_ext) + ub(ji-1,jj,ibld(ji,jj)+ibld_ext ) ) &
-                     &    / MAX(1. , umask(ji,jj,ibld(ji,jj)+ibld_ext ) + umask(ji-1,jj,ibld(ji,jj)+ibld_ext ) )
-            zdv(ji,jj) = zv(ji,jj) - ( vb(ji,jj,ibld(ji,jj)+ibld_ext) + vb(ji,jj-1,ibld(ji,jj)+ibld_ext ) ) &
-                     &   / MAX(1. , vmask(ji,jj,ibld(ji,jj)+ibld_ext ) + vmask(ji,jj-1,ibld(ji,jj)+ibld_ext ) )
-            zdb(ji,jj) = grav * zthermal * zdt(ji,jj) - grav * zbeta * zds(ji,jj)
+        DO_2D_00_00
+         zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1??
+         zbeta    = rab_n(ji,jj,1,jp_sal)
+            ! average over depth of boundary layer
+         zthick = epsln
+         DO jk = 2, jnlev_av(ji,jj)
+            zthick = zthick + e3t(ji,jj,jk, Kmm )
+            zt(ji,jj)   = zt(ji,jj)  + e3t(ji,jj,jk, Kmm ) * ts(ji,jj,jk,jp_tem, Kmm )
+            zs(ji,jj)   = zs(ji,jj)  + e3t(ji,jj,jk, Kmm ) * ts(ji,jj,jk,jp_sal, Kmm )
+            zu(ji,jj)   = zu(ji,jj)  + e3t(ji,jj,jk, Kmm ) &
+                  &            * ( uu(ji,jj,jk, Kbb ) + uu(ji - 1,jj,jk, Kbb ) ) &
+                  &            / MAX( 1. , umask(ji,jj,jk) + umask(ji - 1,jj,jk) )
+            zv(ji,jj)   = zv(ji,jj)  + e3t(ji,jj,jk, Kmm ) &
+                  &            * ( vv(ji,jj,jk, Kbb ) + vv(ji,jj - 1,jk, Kbb ) ) &
+                  &            / MAX( 1. , vmask(ji,jj,jk) + vmask(ji,jj - 1,jk) )
          END DO
-        END DO
+         zt(ji,jj) = zt(ji,jj) / zthick
+         zs(ji,jj) = zs(ji,jj) / zthick
+         zu(ji,jj) = zu(ji,jj) / zthick
+         zv(ji,jj) = zv(ji,jj) / zthick
+         ! Alan: do we need zb?
+         zdt(ji,jj) = zt(ji,jj) - ts(ji,jj,ibld(ji,jj)+ibld_ext,jp_tem, Kmm )
+         zds(ji,jj) = zs(ji,jj) - ts(ji,jj,ibld(ji,jj)+ibld_ext,jp_sal, Kmm )
+         zdu(ji,jj) = zu(ji,jj) - ( uu(ji,jj,ibld(ji,jj)+ibld_ext, Kbb ) + uu(ji-1,jj,ibld(ji,jj)+ibld_ext, Kbb ) ) &
+                  &    / MAX(1. , umask(ji,jj,ibld(ji,jj)+ibld_ext ) + umask(ji-1,jj,ibld(ji,jj)+ibld_ext ) )
+         zdv(ji,jj) = zv(ji,jj) - ( vv(ji,jj,ibld(ji,jj)+ibld_ext, Kbb ) + vv(ji,jj-1,ibld(ji,jj)+ibld_ext, Kbb ) ) &
+                  &   / MAX(1. , vmask(ji,jj,ibld(ji,jj)+ibld_ext ) + vmask(ji,jj-1,ibld(ji,jj)+ibld_ext ) )
+         zdb(ji,jj) = grav * zthermal * zdt(ji,jj) - grav * zbeta * zds(ji,jj)
+      END_2D
    END SUBROUTINE zdf_osm_vertical_average
 
@@ -1306,17 +1237,15 @@
         REAL(wp) :: ztemp
 
-        DO jj = 2, jpjm1
-           DO ji = 2, jpim1
-              ztemp = zu(ji,jj)
-              zu(ji,jj) = zu(ji,jj) * zcos_w(ji,jj) + zv(ji,jj) * zsin_w(ji,jj)
-              zv(ji,jj) = zv(ji,jj) * zcos_w(ji,jj) - ztemp * zsin_w(ji,jj)
-              ztemp = zdu(ji,jj)
-              zdu(ji,jj) = zdu(ji,jj) * zcos_w(ji,jj) + zdv(ji,jj) * zsin_w(ji,jj)
-              zdv(ji,jj) = zdv(ji,jj) * zsin_w(ji,jj) - ztemp * zsin_w(ji,jj)
-           END DO
-        END DO
+        DO_2D_00_00
+           ztemp = zu(ji,jj)
+           zu(ji,jj) = zu(ji,jj) * zcos_w(ji,jj) + zv(ji,jj) * zsin_w(ji,jj)
+           zv(ji,jj) = zv(ji,jj) * zcos_w(ji,jj) - ztemp * zsin_w(ji,jj)
+           ztemp = zdu(ji,jj)
+           zdu(ji,jj) = zdu(ji,jj) * zcos_w(ji,jj) + zdv(ji,jj) * zsin_w(ji,jj)
+           zdv(ji,jj) = zdv(ji,jj) * zsin_w(ji,jj) - ztemp * zsin_w(ji,jj)
+        END_2D
     END SUBROUTINE zdf_osm_velocity_rotation
 
-    SUBROUTINE zdf_osm_external_gradients( zdtdz, zdsdz, zdbdz )
+    SUBROUTINE zdf_osm_external_gradients( zdtdz, zdsdz, zdbdz, Kmm )
      !!---------------------------------------------------------------------
      !!                   ***  ROUTINE zdf_osm_external_gradients  ***
@@ -1328,4 +1257,5 @@
      !!----------------------------------------------------------------------
 
+       INTEGER, INTENT(in) ::   Kmm                  ! time-level index
      REAL(wp), DIMENSION(jpi,jpj) :: zdtdz, zdsdz, zdbdz   ! External gradients of temperature, salinity and buoyancy.
 
@@ -1334,23 +1264,22 @@
 
 
-     DO jj = 2, jpjm1
-        DO ji = 2, jpim1
-           IF ( ibld(ji,jj) + ibld_ext < mbkt(ji,jj) ) THEN
-              zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1??
-              zbeta    = rab_n(ji,jj,1,jp_sal)
-              jkb = ibld(ji,jj) + ibld_ext
-              jkb1 = MIN(jkb + 1, mbkt(ji,jj))
-              zdtdz(ji,jj) = - ( tsn(ji,jj,jkb1,jp_tem) - tsn(ji,jj,jkb,jp_tem ) ) &
-                   &   / e3t_n(ji,jj,ibld(ji,jj))
-              zdsdz(ji,jj) = - ( tsn(ji,jj,jkb1,jp_sal) - tsn(ji,jj,jkb,jp_sal ) ) &
-                   &   / e3t_n(ji,jj,ibld(ji,jj))
-              zdbdz(ji,jj) = grav * zthermal * zdtdz(ji,jj) - grav * zbeta * zdsdz(ji,jj)
-           END IF
-        END DO
-     END DO
+     DO_2D_00_00
+        IF ( ibld(ji,jj) + ibld_ext < mbkt(ji,jj) ) THEN
+           zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1??
+           zbeta    = rab_n(ji,jj,1,jp_sal)
+           jkb = ibld(ji,jj) + ibld_ext
+           jkb1 = MIN(jkb + 1, mbkt(ji,jj))
+           zdtdz(ji,jj) = - ( ts(ji,jj,jkb1,jp_tem, Kmm ) - ts(ji,jj,jkb,jp_tem, Kmm ) ) &
+                &   / e3t(ji,jj,ibld(ji,jj), Kmm )
+           zdsdz(ji,jj) = - ( ts(ji,jj,jkb1,jp_sal, Kmm ) - ts(ji,jj,jkb,jp_sal, Kmm ) ) &
+                &   / e3t(ji,jj,ibld(ji,jj), Kmm )
+           zdbdz(ji,jj) = grav * zthermal * zdtdz(ji,jj) - grav * zbeta * zdsdz(ji,jj)
+        END IF
+     END_2D
     END SUBROUTINE zdf_osm_external_gradients
 
-    SUBROUTINE zdf_osm_pycnocline_scalar_profiles( zdtdz, zdsdz, zdbdz )
-
+    SUBROUTINE zdf_osm_pycnocline_scalar_profiles( zdtdz, zdsdz, zdbdz, Kmm )
+
+       INTEGER, INTENT(in) ::   Kmm                  ! time-level index
      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdtdz, zdsdz, zdbdz      ! gradients in the pycnocline
 
@@ -1360,72 +1289,70 @@
      REAL(wp) :: zzeta_s=0.3, ztmp
 
-     DO jj = 2, jpjm1
-        DO ji = 2, jpim1
-           IF ( ibld(ji,jj) + ibld_ext < mbkt(ji,jj) ) THEN
-              IF ( lconv(ji,jj) ) THEN  ! convective conditions
-                    IF ( zdbdz_ext(ji,jj) > 0._wp .AND. &
-                         & (zdhdt(ji,jj) > 0._wp .AND. ln_osm_mle .AND. zdb_bl(ji,jj) > rn_osm_mle_thresh &
-                         &  .OR.  zdb_bl(ji,jj) > 0._wp)) THEN  ! zdhdt could be <0 due to FK, hence check zdhdt>0
+     DO_2D_00_00
+        IF ( ibld(ji,jj) + ibld_ext < mbkt(ji,jj) ) THEN
+           IF ( lconv(ji,jj) ) THEN  ! convective conditions
+                 IF ( zdbdz_ext(ji,jj) > 0._wp .AND. &
+                      & (zdhdt(ji,jj) > 0._wp .AND. ln_osm_mle .AND. zdb_bl(ji,jj) > rn_osm_mle_thresh &
+                      &  .OR.  zdb_bl(ji,jj) > 0._wp)) THEN  ! zdhdt could be <0 due to FK, hence check zdhdt>0
+                    ztmp = 1._wp/MAX(zdh(ji,jj), epsln)
+                    ztgrad = 0.5 * zdt_ml(ji,jj) * ztmp + zdtdz_ext(ji,jj)
+                    zsgrad = 0.5 * zds_ml(ji,jj) * ztmp + zdsdz_ext(ji,jj)
+                    zbgrad = 0.5 * zdb_ml(ji,jj) * ztmp + zdbdz_ext(ji,jj)
+                    zgamma_b_nd = zdbdz_ext(ji,jj) * zdh(ji,jj) / MAX(zdb_ml(ji,jj), epsln)
+                    zgamma_c = ( 3.14159 / 4.0 ) * ( 0.5 + zgamma_b_nd ) /&
+                         & ( 1.0 - 0.25 * SQRT( 3.14159 / 6.0 ) - 2.0 * zgamma_b_nd * zzeta_s )**2 ! check
+                    DO jk = 2, ibld(ji,jj)+ibld_ext
+                       znd = -( gdepw(ji,jj,jk, Kmm ) - zhbl(ji,jj) ) * ztmp
+                       IF ( znd <= zzeta_s ) THEN
+                          zdtdz(ji,jj,jk) = zdtdz_ext(ji,jj) + 0.5 * zdt_ml(ji,jj) * ztmp * &
+                               & EXP( -6.0 * ( znd -zzeta_s )**2 )
+                          zdsdz(ji,jj,jk) = zdsdz_ext(ji,jj) + 0.5 * zds_ml(ji,jj) * ztmp * &
+                               & EXP( -6.0 * ( znd -zzeta_s )**2 )
+                          zdbdz(ji,jj,jk) = zdbdz_ext(ji,jj) + 0.5 * zdb_ml(ji,jj) * ztmp * &
+                               & EXP( -6.0 * ( znd -zzeta_s )**2 )
+                       ELSE
+                          zdtdz(ji,jj,jk) =  ztgrad * EXP( -zgamma_c * ( znd - zzeta_s )**2 )
+                          zdsdz(ji,jj,jk) =  zsgrad * EXP( -zgamma_c * ( znd - zzeta_s )**2 )
+                          zdbdz(ji,jj,jk) =  zbgrad * EXP( -zgamma_c * ( znd - zzeta_s )**2 )
+                       ENDIF
+                    END DO
+                 ENDIF ! If condition not satisfied, no pycnocline present. Gradients have been initialised to zero, so do nothing
+           ELSE
+              ! stable conditions
+              ! if pycnocline profile only defined when depth steady of increasing.
+              IF ( zdhdt(ji,jj) >= 0.0 ) THEN        ! Depth increasing, or steady.
+                 IF ( zdb_bl(ji,jj) > 0._wp ) THEN
+                    IF ( zhol(ji,jj) >= 0.5 ) THEN      ! Very stable - 'thick' pycnocline
+                       ztmp = 1._wp/MAX(zhbl(ji,jj), epsln)
+                       ztgrad = zdt_bl(ji,jj) * ztmp
+                       zsgrad = zds_bl(ji,jj) * ztmp
+                       zbgrad = zdb_bl(ji,jj) * ztmp
+                       DO jk = 2, ibld(ji,jj)
+                          znd = gdepw(ji,jj,jk, Kmm ) * ztmp
+                          zdtdz(ji,jj,jk) =  ztgrad * EXP( -15.0 * ( znd - 0.9 )**2 )
+                          zdbdz(ji,jj,jk) =  zbgrad * EXP( -15.0 * ( znd - 0.9 )**2 )
+                          zdsdz(ji,jj,jk) =  zsgrad * EXP( -15.0 * ( znd - 0.9 )**2 )
+                       END DO
+                    ELSE                                   ! Slightly stable - 'thin' pycnoline - needed when stable layer begins to form.
                        ztmp = 1._wp/MAX(zdh(ji,jj), epsln)
-                       ztgrad = 0.5 * zdt_ml(ji,jj) * ztmp + zdtdz_ext(ji,jj)
-                       zsgrad = 0.5 * zds_ml(ji,jj) * ztmp + zdsdz_ext(ji,jj)
-                       zbgrad = 0.5 * zdb_ml(ji,jj) * ztmp + zdbdz_ext(ji,jj)
-                       zgamma_b_nd = zdbdz_ext(ji,jj) * zdh(ji,jj) / MAX(zdb_ml(ji,jj), epsln)
-                       zgamma_c = ( 3.14159 / 4.0 ) * ( 0.5 + zgamma_b_nd ) /&
-                            & ( 1.0 - 0.25 * SQRT( 3.14159 / 6.0 ) - 2.0 * zgamma_b_nd * zzeta_s )**2 ! check
-                       DO jk = 2, ibld(ji,jj)+ibld_ext
-                          znd = -( gdepw_n(ji,jj,jk) - zhbl(ji,jj) ) * ztmp
-                          IF ( znd <= zzeta_s ) THEN
-                             zdtdz(ji,jj,jk) = zdtdz_ext(ji,jj) + 0.5 * zdt_ml(ji,jj) * ztmp * &
-                                  & EXP( -6.0 * ( znd -zzeta_s )**2 )
-                             zdsdz(ji,jj,jk) = zdsdz_ext(ji,jj) + 0.5 * zds_ml(ji,jj) * ztmp * &
-                                  & EXP( -6.0 * ( znd -zzeta_s )**2 )
-                             zdbdz(ji,jj,jk) = zdbdz_ext(ji,jj) + 0.5 * zdb_ml(ji,jj) * ztmp * &
-                                  & EXP( -6.0 * ( znd -zzeta_s )**2 )
-                          ELSE
-                             zdtdz(ji,jj,jk) =  ztgrad * EXP( -zgamma_c * ( znd - zzeta_s )**2 )
-                             zdsdz(ji,jj,jk) =  zsgrad * EXP( -zgamma_c * ( znd - zzeta_s )**2 )
-                             zdbdz(ji,jj,jk) =  zbgrad * EXP( -zgamma_c * ( znd - zzeta_s )**2 )
-                          ENDIF
+                       ztgrad = zdt_bl(ji,jj) * ztmp
+                       zsgrad = zds_bl(ji,jj) * ztmp
+                       zbgrad = zdb_bl(ji,jj) * ztmp
+                       DO jk = 2, ibld(ji,jj)
+                          znd = -( gdepw(ji,jj,jk, Kmm ) - zhml(ji,jj) ) * ztmp
+                          zdtdz(ji,jj,jk) =  ztgrad * EXP( -1.75 * ( znd + 0.75 )**2 )
+                          zdbdz(ji,jj,jk) =  zbgrad * EXP( -1.75 * ( znd + 0.75 )**2 )
+                          zdsdz(ji,jj,jk) =  zsgrad * EXP( -1.75 * ( znd + 0.75 )**2 )
                        END DO
-                    ENDIF ! If condition not satisfied, no pycnocline present. Gradients have been initialised to zero, so do nothing
-              ELSE
-                 ! stable conditions
-                 ! if pycnocline profile only defined when depth steady of increasing.
-                 IF ( zdhdt(ji,jj) >= 0.0 ) THEN        ! Depth increasing, or steady.
-                    IF ( zdb_bl(ji,jj) > 0._wp ) THEN
-                       IF ( zhol(ji,jj) >= 0.5 ) THEN      ! Very stable - 'thick' pycnocline
-                          ztmp = 1._wp/MAX(zhbl(ji,jj), epsln)
-                          ztgrad = zdt_bl(ji,jj) * ztmp
-                          zsgrad = zds_bl(ji,jj) * ztmp
-                          zbgrad = zdb_bl(ji,jj) * ztmp
-                          DO jk = 2, ibld(ji,jj)
-                             znd = gdepw_n(ji,jj,jk) * ztmp
-                             zdtdz(ji,jj,jk) =  ztgrad * EXP( -15.0 * ( znd - 0.9 )**2 )
-                             zdbdz(ji,jj,jk) =  zbgrad * EXP( -15.0 * ( znd - 0.9 )**2 )
-                             zdsdz(ji,jj,jk) =  zsgrad * EXP( -15.0 * ( znd - 0.9 )**2 )
-                          END DO
-                       ELSE                                   ! Slightly stable - 'thin' pycnoline - needed when stable layer begins to form.
-                          ztmp = 1._wp/MAX(zdh(ji,jj), epsln)
-                          ztgrad = zdt_bl(ji,jj) * ztmp
-                          zsgrad = zds_bl(ji,jj) * ztmp
-                          zbgrad = zdb_bl(ji,jj) * ztmp
-                          DO jk = 2, ibld(ji,jj)
-                             znd = -( gdepw_n(ji,jj,jk) - zhml(ji,jj) ) * ztmp
-                             zdtdz(ji,jj,jk) =  ztgrad * EXP( -1.75 * ( znd + 0.75 )**2 )
-                             zdbdz(ji,jj,jk) =  zbgrad * EXP( -1.75 * ( znd + 0.75 )**2 )
-                             zdsdz(ji,jj,jk) =  zsgrad * EXP( -1.75 * ( znd + 0.75 )**2 )
-                          END DO
-                       ENDIF ! IF (zhol >=0.5)
-                    ENDIF    ! IF (zdb_bl> 0.)
-                 ENDIF       ! IF (zdhdt >= 0) zdhdt < 0 not considered since pycnocline profile is zero and profile arrays are intialized to zero
-              ENDIF          ! IF (lconv)
-           END IF      ! IF ( ibld(ji,jj) + ibld_ext < mbkt(ji,jj) )
-        END DO
-     END DO
+                    ENDIF ! IF (zhol >=0.5)
+                 ENDIF    ! IF (zdb_bl> 0.)
+              ENDIF       ! IF (zdhdt >= 0) zdhdt < 0 not considered since pycnocline profile is zero and profile arrays are intialized to zero
+           ENDIF          ! IF (lconv)
+        END IF      ! IF ( ibld(ji,jj) + ibld_ext < mbkt(ji,jj) )
+     END_2D
 
     END SUBROUTINE zdf_osm_pycnocline_scalar_profiles
 
-    SUBROUTINE zdf_osm_pycnocline_shear_profiles( zdudz, zdvdz )
+    SUBROUTINE zdf_osm_pycnocline_shear_profiles( zdudz, zdvdz, Kmm )
       !!---------------------------------------------------------------------
       !!                   ***  ROUTINE zdf_osm_pycnocline_shear_profiles  ***
@@ -1437,4 +1364,5 @@
       !!----------------------------------------------------------------------
 
+       INTEGER, INTENT(in) ::   Kmm                  ! time-level index
       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdudz, zdvdz
 
@@ -1443,46 +1371,44 @@
       REAL(wp) :: zzeta_v = 0.45
       !
-      DO jj = 2, jpjm1
-         DO ji = 2, jpim1
+      DO_2D_00_00
+         !
+         IF ( ibld(ji,jj) + ibld_ext < mbkt(ji,jj) ) THEN
+            IF ( lconv (ji,jj) ) THEN
+               ! Unstable conditions
+               zugrad = 0.7 * zdu_ml(ji,jj) / zdh(ji,jj) + 0.3 * zustar(ji,jj)*zustar(ji,jj) / &
+                    &      ( ( ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * zhml(ji,jj) ) * &
+                    &      MIN(zla(ji,jj)**(8.0/3.0) + epsln, 0.12 ))
+               !Alan is this right?
+               zvgrad = ( 0.7 * zdv_ml(ji,jj) + &
+                    &    2.0 * ff_t(ji,jj) * zustke(ji,jj) * dstokes(ji,jj) / &
+                    &          ( ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird  + epsln ) &
+                    &      )/ (zdh(ji,jj)  + epsln )
+               DO jk = 2, ibld(ji,jj) - 1 + ibld_ext
+                  znd = -( gdepw(ji,jj,jk, Kmm ) - zhbl(ji,jj) ) / (zdh(ji,jj) + epsln ) - zzeta_v
+                  IF ( znd <= 0.0 ) THEN
+                     zdudz(ji,jj,jk) = 1.25 * zugrad * EXP( 3.0 * znd )
+                     zdvdz(ji,jj,jk) = 1.25 * zvgrad * EXP( 3.0 * znd )
+                  ELSE
+                     zdudz(ji,jj,jk) = 1.25 * zugrad * EXP( -2.0 * znd )
+                     zdvdz(ji,jj,jk) = 1.25 * zvgrad * EXP( -2.0 * znd )
+                  ENDIF
+               END DO
+            ELSE
+               ! stable conditions
+               zugrad = 3.25 * zdu_bl(ji,jj) / zhbl(ji,jj)
+               zvgrad = 2.75 * zdv_bl(ji,jj) / zhbl(ji,jj)
+               DO jk = 2, ibld(ji,jj)
+                  znd = gdepw(ji,jj,jk, Kmm ) / zhbl(ji,jj)
+                  IF ( znd < 1.0 ) THEN
+                     zdudz(ji,jj,jk) = zugrad * EXP( -40.0 * ( znd - 1.0 )**2 )
+                  ELSE
+                     zdudz(ji,jj,jk) = zugrad * EXP( -20.0 * ( znd - 1.0 )**2 )
+                  ENDIF
+                  zdvdz(ji,jj,jk) = zvgrad * EXP( -20.0 * ( znd - 0.85 )**2 )
+               END DO
+            ENDIF
             !
-            IF ( ibld(ji,jj) + ibld_ext < mbkt(ji,jj) ) THEN
-               IF ( lconv (ji,jj) ) THEN
-                  ! Unstable conditions
-                  zugrad = 0.7 * zdu_ml(ji,jj) / zdh(ji,jj) + 0.3 * zustar(ji,jj)*zustar(ji,jj) / &
-                       &      ( ( ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * zhml(ji,jj) ) * &
-                       &      MIN(zla(ji,jj)**(8.0/3.0) + epsln, 0.12 ))
-                  !Alan is this right?
-                  zvgrad = ( 0.7 * zdv_ml(ji,jj) + &
-                       &    2.0 * ff_t(ji,jj) * zustke(ji,jj) * dstokes(ji,jj) / &
-                       &          ( ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird  + epsln ) &
-                       &      )/ (zdh(ji,jj)  + epsln )
-                  DO jk = 2, ibld(ji,jj) - 1 + ibld_ext
-                     znd = -( gdepw_n(ji,jj,jk) - zhbl(ji,jj) ) / (zdh(ji,jj) + epsln ) - zzeta_v
-                     IF ( znd <= 0.0 ) THEN
-                        zdudz(ji,jj,jk) = 1.25 * zugrad * EXP( 3.0 * znd )
-                        zdvdz(ji,jj,jk) = 1.25 * zvgrad * EXP( 3.0 * znd )
-                     ELSE
-                        zdudz(ji,jj,jk) = 1.25 * zugrad * EXP( -2.0 * znd )
-                        zdvdz(ji,jj,jk) = 1.25 * zvgrad * EXP( -2.0 * znd )
-                     ENDIF
-                  END DO
-               ELSE
-                  ! stable conditions
-                  zugrad = 3.25 * zdu_bl(ji,jj) / zhbl(ji,jj)
-                  zvgrad = 2.75 * zdv_bl(ji,jj) / zhbl(ji,jj)
-                  DO jk = 2, ibld(ji,jj)
-                     znd = gdepw_n(ji,jj,jk) / zhbl(ji,jj)
-                     IF ( znd < 1.0 ) THEN
-                        zdudz(ji,jj,jk) = zugrad * EXP( -40.0 * ( znd - 1.0 )**2 )
-                     ELSE
-                        zdudz(ji,jj,jk) = zugrad * EXP( -20.0 * ( znd - 1.0 )**2 )
-                     ENDIF
-                     zdvdz(ji,jj,jk) = zvgrad * EXP( -20.0 * ( znd - 0.85 )**2 )
-                  END DO
-               ENDIF
-               !
-            END IF      ! IF ( ibld(ji,jj) + ibld_ext < mbkt(ji,jj) )
-         END DO
-      END DO
+         END IF      ! IF ( ibld(ji,jj) + ibld_ext < mbkt(ji,jj) )
+      END_2D
     END SUBROUTINE zdf_osm_pycnocline_shear_profiles
 
@@ -1508,61 +1434,60 @@
     REAL(wp) :: alpha_bc = 0.5
 
-    DO jj = 2, jpjm1
-       DO ji = 2, jpim1
-          IF ( lconv(ji,jj) ) THEN    ! Convective
-             ! Alan is this right?  Yes, it's a bit different from the previous relationship
-             ! zwb_ent(ji,jj) = - 2.0 * 0.2 * zwbav(ji,jj) &
-             !   &            - ( 0.15 * ( 1.0 - EXP( -1.5 * zla(ji,jj) ) ) * zustar(ji,jj)**3 + 0.03 * zwstrl(ji,jj)**3 ) / zhml(ji,jj)
-             zwcor = ABS(ff_t(ji,jj)) * zhbl(ji,jj) + epsln
-             zrf_conv = TANH( ( zwstrc(ji,jj) / zwcor )**0.69 )
-             zrf_shear = TANH( ( zustar(ji,jj) / zwcor )**0.69 )
-             zrf_langmuir = TANH( ( zwstrl(ji,jj) / zwcor )**0.69 )
-             zr_stokes = 1.0 - EXP( -25.0 * dstokes(ji,jj) / hbl(ji,jj) &
-                  &                  * ( 1.0 + 4.0 * dstokes(ji,jj) / hbl(ji,jj) ) )
-
-             zwb_ent(ji,jj) = - 2.0 * 0.2 * zrf_conv * zwbav(ji,jj) &
-                  &                  - 0.15 * zrf_shear * zustar(ji,jj)**3 /zhml(ji,jj) &
-                  &         + zr_stokes * ( 0.15 * EXP( -1.5 * zla(ji,jj) ) * zrf_shear * zustar(ji,jj)**3 &
-                  &                                         - zrf_langmuir * 0.03 * zwstrl(ji,jj)**3 ) / zhml(ji,jj)
-             !
-             zwb_min = dh(ji,jj) * zwb0(ji,jj) / zhml(ji,jj) + zwb_ent(ji,jj)
-
-             IF ( ln_osm_mle ) THEN
-                  !  zwb_fk_b(ji,jj) = zwb_fk(ji,jj) *  hmle(ji,jj) / ( 6.0 * hbl(ji,jj) ) * ( 6.0 * hbl(ji,jj) / hmle(ji,jj) - 1.0 + &
-                ! &            ( 1.0 - 2.0 * hbl(ji,jj) / hmle(ji,jj))**3 )          ! Fox-Kemper buoyancy flux average over OSBL
-                IF ( hmle(ji,jj) > hbl(ji,jj) ) THEN
-                   zwb_fk_b(ji,jj) = zwb_fk(ji,jj) *  &
-                        (1.0 + hmle(ji,jj) / ( 6.0 * hbl(ji,jj) ) * (-1.0 + ( 1.0 - 2.0 * hbl(ji,jj) / hmle(ji,jj))**3) )
+    DO_2D_00_00
+       IF ( lconv(ji,jj) ) THEN    ! Convective
+          ! Alan is this right?  Yes, it's a bit different from the previous relationship
+          ! zwb_ent(ji,jj) = - 2.0 * 0.2 * zwbav(ji,jj) &
+          !   &            - ( 0.15 * ( 1.0 - EXP( -1.5 * zla(ji,jj) ) ) * zustar(ji,jj)**3 + 0.03 * zwstrl(ji,jj)**3 ) / zhml(ji,jj)
+          zwcor = ABS(ff_t(ji,jj)) * zhbl(ji,jj) + epsln
+          zrf_conv = TANH( ( zwstrc(ji,jj) / zwcor )**0.69 )
+          zrf_shear = TANH( ( zustar(ji,jj) / zwcor )**0.69 )
+          zrf_langmuir = TANH( ( zwstrl(ji,jj) / zwcor )**0.69 )
+          zr_stokes = 1.0 - EXP( -25.0 * dstokes(ji,jj) / hbl(ji,jj) &
+               &                  * ( 1.0 + 4.0 * dstokes(ji,jj) / hbl(ji,jj) ) )
+
+          zwb_ent(ji,jj) = - 2.0 * 0.2 * zrf_conv * zwbav(ji,jj) &
+               &                  - 0.15 * zrf_shear * zustar(ji,jj)**3 /zhml(ji,jj) &
+               &         + zr_stokes * ( 0.15 * EXP( -1.5 * zla(ji,jj) ) * zrf_shear * zustar(ji,jj)**3 &
+               &                                         - zrf_langmuir * 0.03 * zwstrl(ji,jj)**3 ) / zhml(ji,jj)
+          !
+          zwb_min = dh(ji,jj) * zwb0(ji,jj) / zhml(ji,jj) + zwb_ent(ji,jj)
+
+          IF ( ln_osm_mle ) THEN
+            !  zwb_fk_b(ji,jj) = zwb_fk(ji,jj) *  hmle(ji,jj) / ( 6.0 * hbl(ji,jj) ) * ( 6.0 * hbl(ji,jj) / hmle(ji,jj) - 1.0 + &
+          ! &            ( 1.0 - 2.0 * hbl(ji,jj) / hmle(ji,jj))**3 )          ! Fox-Kemper buoyancy flux average over OSBL
+             IF ( hmle(ji,jj) > hbl(ji,jj) ) THEN
+                zwb_fk_b(ji,jj) = zwb_fk(ji,jj) *  &
+                     (1.0 + hmle(ji,jj) / ( 6.0 * hbl(ji,jj) ) * (-1.0 + ( 1.0 - 2.0 * hbl(ji,jj) / hmle(ji,jj))**3) )
+             ELSE
+                zwb_fk_b(ji,jj) = 0.5 * zwb_fk(ji,jj) * hmle(ji,jj) / hbl(ji,jj)
+             ENDIF
+             zvel_max = ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**p2third / hbl(ji,jj)
+             IF ( ( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) < 0.0 ) THEN
+                ! OSBL is deepening, entrainment > restratification
+                IF ( zdb_bl(ji,jj) > 0.0 .and. zdbdz_ext(ji,jj) > 0.0 ) THEN
+                   zdhdt(ji,jj) = -( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) / ( zvel_max + MAX(zdb_bl(ji,jj), 1.0e-15) )
                 ELSE
-                   zwb_fk_b(ji,jj) = 0.5 * zwb_fk(ji,jj) * hmle(ji,jj) / hbl(ji,jj)
+                   zdhdt(ji,jj) = -( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) /  MAX( zvel_max, 1.0e-15)
                 ENDIF
-                zvel_max = ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**p2third / hbl(ji,jj)
-                IF ( ( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) < 0.0 ) THEN
-                   ! OSBL is deepening, entrainment > restratification
-                   IF ( zdb_bl(ji,jj) > 0.0 .and. zdbdz_ext(ji,jj) > 0.0 ) THEN
-                      zdhdt(ji,jj) = -( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) / ( zvel_max + MAX(zdb_bl(ji,jj), 1.0e-15) )
-                   ELSE
-                      zdhdt(ji,jj) = -( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) /  MAX( zvel_max, 1.0e-15)
-                   ENDIF
-                ELSE
-                   ! OSBL shoaling due to restratification flux. This is the velocity defined in Fox-Kemper et al (2008)
-                   zdhdt(ji,jj) = - zvel_mle(ji,jj)
-
-
-                ENDIF
-
              ELSE
-                ! Fox-Kemper not used.
-
-                  zvel_max = - ( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_rdt / hbl(ji,jj) ) * zwb_ent(ji,jj) / &
-                  &        ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird
-                  zdhdt(ji,jj) = -zwb_ent(ji,jj) / ( zvel_max + MAX(zdb_bl(ji,jj), 1.0e-15) )
-                ! added ajgn 23 July as temporay fix
+                ! OSBL shoaling due to restratification flux. This is the velocity defined in Fox-Kemper et al (2008)
+                zdhdt(ji,jj) = - zvel_mle(ji,jj)
+
 
              ENDIF
 
-             zdhdt_2(ji,jj) = 0._wp
-
-                ! commented out ajgn 23 July as temporay fix
+          ELSE
+             ! Fox-Kemper not used.
+
+               zvel_max = - ( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_Dt / hbl(ji,jj) ) * zwb_ent(ji,jj) / &
+               &        ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird
+               zdhdt(ji,jj) = -zwb_ent(ji,jj) / ( zvel_max + MAX(zdb_bl(ji,jj), 1.0e-15) )
+             ! added ajgn 23 July as temporay fix
+
+          ENDIF
+
+          zdhdt_2(ji,jj) = 0._wp
+
+             ! commented out ajgn 23 July as temporay fix
 !                 IF ( zdb_ml(ji,jj) > 0.0 .and. zdbdz_ext(ji,jj) > 0.0 ) THEN
 ! !additional term to account for thickness of pycnocline on dhdt. Small correction, so could get rid of this if necessary.
@@ -1580,20 +1505,19 @@
 !                         zdhdt(ji,jj) = zdhdt(ji,jj) + zdhdt_2(ji,jj)
 !                 ENDIF
-            ELSE                        ! Stable
-                zdhdt(ji,jj) = ( 0.06 + 0.52 * zhol(ji,jj) / 2.0 ) * zvstr(ji,jj)**3 / hbl(ji,jj) + zwbav(ji,jj)
-                zdhdt_2(ji,jj) = 0._wp
-                IF ( zdhdt(ji,jj) < 0._wp ) THEN
-                   ! For long timsteps factor in brackets slows the rapid collapse of the OSBL
-                    zpert = 2.0 * ( 1.0 + 0.0 * 2.0 * zvstr(ji,jj) * rn_rdt / hbl(ji,jj) ) * zvstr(ji,jj)**2 / hbl(ji,jj)
-                ELSE
-                    zpert = MAX( 2.0 * ( 1.0 + 0.0 * 2.0 * zvstr(ji,jj) * rn_rdt / hbl(ji,jj) ) * zvstr(ji,jj)**2 / hbl(ji,jj), zdb_bl(ji,jj) )
-                ENDIF
-                zdhdt(ji,jj) = 2.0 * zdhdt(ji,jj) / zpert
-            ENDIF
-         END DO
-      END DO
+         ELSE                        ! Stable
+             zdhdt(ji,jj) = ( 0.06 + 0.52 * zhol(ji,jj) / 2.0 ) * zvstr(ji,jj)**3 / hbl(ji,jj) + zwbav(ji,jj)
+             zdhdt_2(ji,jj) = 0._wp
+             IF ( zdhdt(ji,jj) < 0._wp ) THEN
+                ! For long timsteps factor in brackets slows the rapid collapse of the OSBL
+                 zpert = 2.0 * ( 1.0 + 0.0 * 2.0 * zvstr(ji,jj) * rn_Dt / hbl(ji,jj) ) * zvstr(ji,jj)**2 / hbl(ji,jj)
+             ELSE
+                 zpert = MAX( 2.0 * ( 1.0 + 0.0 * 2.0 * zvstr(ji,jj) * rn_Dt / hbl(ji,jj) ) * zvstr(ji,jj)**2 / hbl(ji,jj), zdb_bl(ji,jj) )
+             ENDIF
+             zdhdt(ji,jj) = 2.0 * zdhdt(ji,jj) / zpert
+         ENDIF
+      END_2D
     END SUBROUTINE zdf_osm_calculate_dhdt
 
-    SUBROUTINE zdf_osm_timestep_hbl( zdhdt, zdhdt_2 )
+    SUBROUTINE zdf_osm_timestep_hbl( zdhdt, zdhdt_2, Kmm )
      !!---------------------------------------------------------------------
      !!                   ***  ROUTINE zdf_osm_timestep_hbl  ***
@@ -1609,4 +1533,5 @@
 
 
+       INTEGER, INTENT(in) ::   Kmm                  ! time-level index
     REAL(wp), DIMENSION(jpi,jpj) :: zdhdt, zdhdt_2   ! rates of change of hbl.
 
@@ -1615,83 +1540,81 @@
     REAL(wp) :: zthermal, zbeta
 
-     DO jj = 2, jpjm1
-         DO ji = 2, jpim1
-           IF ( ibld(ji,jj) - imld(ji,jj) > 1 ) THEN
+     DO_2D_00_00
+        IF ( ibld(ji,jj) - imld(ji,jj) > 1 ) THEN
 !
 ! If boundary layer changes by more than one level, need to check for stable layers between initial and final depths.
 !
-              zhbl_s = hbl(ji,jj)
-              jm = imld(ji,jj)
-              zthermal = rab_n(ji,jj,1,jp_tem)
-              zbeta = rab_n(ji,jj,1,jp_sal)
-
-
-              IF ( lconv(ji,jj) ) THEN
+           zhbl_s = hbl(ji,jj)
+           jm = imld(ji,jj)
+           zthermal = rab_n(ji,jj,1,jp_tem)
+           zbeta = rab_n(ji,jj,1,jp_sal)
+
+
+           IF ( lconv(ji,jj) ) THEN
 !unstable
 
-                 IF( ln_osm_mle ) THEN
-                    zvel_max = ( zwstrl(ji,jj)**3 + zwstrc(ji,jj)**3 )**p2third / hbl(ji,jj)
+              IF( ln_osm_mle ) THEN
+                 zvel_max = ( zwstrl(ji,jj)**3 + zwstrc(ji,jj)**3 )**p2third / hbl(ji,jj)
+              ELSE
+
+                 zvel_max = -( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_Dt / hbl(ji,jj) ) * zwb_ent(ji,jj) / &
+                   &      ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird
+
+              ENDIF
+
+              DO jk = imld(ji,jj), ibld(ji,jj)
+                 zdb = MAX( grav * ( zthermal * ( zt_bl(ji,jj) - ts(ji,jj,jm,jp_tem,Kmm) ) &
+                      & - zbeta * ( zs_bl(ji,jj) - ts(ji,jj,jm,jp_sal,Kmm) ) ), &
+                      &  0.0 ) + zvel_max
+
+
+                 IF ( ln_osm_mle ) THEN
+                    zhbl_s = zhbl_s + MIN( &
+                     & rn_Dt * ( ( -zwb_ent(ji,jj) - 2.0 * zwb_fk_b(ji,jj) )/ zdb + zdhdt_2(ji,jj) ) / FLOAT(ibld(ji,jj) - imld(ji,jj) ), &
+                     & e3w(ji,jj,jm, Kmm ) )
                  ELSE
-
-                    zvel_max = -( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_rdt / hbl(ji,jj) ) * zwb_ent(ji,jj) / &
-                      &      ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird
-
+                   zhbl_s = zhbl_s + MIN( &
+                     & rn_Dt * (  -zwb_ent(ji,jj) / zdb + zdhdt_2(ji,jj) ) / FLOAT(ibld(ji,jj) - imld(ji,jj) ), &
+                     & e3w(ji,jj,jm, Kmm ) )
                  ENDIF
 
-                 DO jk = imld(ji,jj), ibld(ji,jj)
-                    zdb = MAX( grav * ( zthermal * ( zt_bl(ji,jj) - tsn(ji,jj,jm,jp_tem) ) &
-                         & - zbeta * ( zs_bl(ji,jj) - tsn(ji,jj,jm,jp_sal) ) ), &
-                         &  0.0 ) + zvel_max
-
-
-                    IF ( ln_osm_mle ) THEN
-                       zhbl_s = zhbl_s + MIN( &
-                        & rn_rdt * ( ( -zwb_ent(ji,jj) - 2.0 * zwb_fk_b(ji,jj) )/ zdb + zdhdt_2(ji,jj) ) / FLOAT(ibld(ji,jj) - imld(ji,jj) ), &
-                        & e3w_n(ji,jj,jm) )
-                    ELSE
-                      zhbl_s = zhbl_s + MIN( &
-                        & rn_rdt * (  -zwb_ent(ji,jj) / zdb + zdhdt_2(ji,jj) ) / FLOAT(ibld(ji,jj) - imld(ji,jj) ), &
-                        & e3w_n(ji,jj,jm) )
-                    ENDIF
-
-                    zhbl_s = MIN(zhbl_s,  gdepw_n(ji,jj, mbkt(ji,jj) + 1) - depth_tol)
-
-                    IF ( zhbl_s >= gdepw_n(ji,jj,jm+1) ) jm = jm + 1
-                 END DO
-                 hbl(ji,jj) = zhbl_s
-                 ibld(ji,jj) = jm
-             ELSE
+                 zhbl_s = MIN(zhbl_s,  gdepw(ji,jj, mbkt(ji,jj) + 1, Kmm ) - depth_tol)
+
+                 IF ( zhbl_s >= gdepw(ji,jj,jm+1, Kmm) ) jm = jm + 1
+              END DO
+              hbl(ji,jj) = zhbl_s
+              ibld(ji,jj) = jm
+          ELSE
 ! stable
-                 DO jk = imld(ji,jj), ibld(ji,jj)
-                    zdb = MAX( &
-                         & grav * ( zthermal * ( zt_bl(ji,jj) - tsn(ji,jj,jm,jp_tem) )&
-                         &           - zbeta * ( zs_bl(ji,jj) - tsn(ji,jj,jm,jp_sal) ) ),&
-                         & 0.0 ) + &
-             &       2.0 * zvstr(ji,jj)**2 / zhbl_s
-
-                    ! Alan is thuis right? I have simply changed hbli to hbl
-                    zhol(ji,jj) = -zhbl_s / ( ( zvstr(ji,jj)**3 + epsln )/ zwbav(ji,jj) )
-                    zdhdt(ji,jj) = -( zwbav(ji,jj) - 0.04 / 2.0 * zwstrl(ji,jj)**3 / zhbl_s - 0.15 / 2.0 * ( 1.0 - EXP( -1.5 * zla(ji,jj) ) ) * &
-               &                  zustar(ji,jj)**3 / zhbl_s ) * ( 0.725 + 0.225 * EXP( -7.5 * zhol(ji,jj) ) )
-                    zdhdt(ji,jj) = zdhdt(ji,jj) + zwbav(ji,jj)
-                    zhbl_s = zhbl_s + MIN( zdhdt(ji,jj) / zdb * rn_rdt / FLOAT( ibld(ji,jj) - imld(ji,jj) ), e3w_n(ji,jj,jm) )
-
-                    zhbl_s = MIN(zhbl_s, gdepw_n(ji,jj, mbkt(ji,jj) + 1) - depth_tol)
-                    IF ( zhbl_s >= gdepw_n(ji,jj,jm) ) jm = jm + 1
-                 END DO
-             ENDIF   ! IF ( lconv )
-             hbl(ji,jj) = MAX(zhbl_s, gdepw_n(ji,jj,4) )
-             ibld(ji,jj) = MAX(jm, 4 )
-           ELSE
+              DO jk = imld(ji,jj), ibld(ji,jj)
+                 zdb = MAX( &
+                      & grav * ( zthermal * ( zt_bl(ji,jj) - ts(ji,jj,jm,jp_tem, Kmm) )&
+                      &           - zbeta * ( zs_bl(ji,jj) - ts(ji,jj,jm,jp_sal, Kmm) ) ),&
+                      & 0.0 ) + &
+          &       2.0 * zvstr(ji,jj)**2 / zhbl_s
+
+                 ! Alan is thuis right? I have simply changed hbli to hbl
+                 zhol(ji,jj) = -zhbl_s / ( ( zvstr(ji,jj)**3 + epsln )/ zwbav(ji,jj) )
+                 zdhdt(ji,jj) = -( zwbav(ji,jj) - 0.04 / 2.0 * zwstrl(ji,jj)**3 / zhbl_s - 0.15 / 2.0 * ( 1.0 - EXP( -1.5 * zla(ji,jj) ) ) * &
+            &                  zustar(ji,jj)**3 / zhbl_s ) * ( 0.725 + 0.225 * EXP( -7.5 * zhol(ji,jj) ) )
+                 zdhdt(ji,jj) = zdhdt(ji,jj) + zwbav(ji,jj)
+                 zhbl_s = zhbl_s + MIN( zdhdt(ji,jj) / zdb * rn_Dt / FLOAT( ibld(ji,jj) - imld(ji,jj) ), e3w(ji,jj,jm, Kmm ) )
+
+                 zhbl_s = MIN(zhbl_s, gdepw(ji,jj, mbkt(ji,jj) + 1, Kmm ) - depth_tol)
+                 IF ( zhbl_s >= gdepw(ji,jj,jm, Kmm ) ) jm = jm + 1
+              END DO
+          ENDIF   ! IF ( lconv )
+          hbl(ji,jj) = MAX(zhbl_s, gdepw(ji,jj,4, Kmm ) )
+          ibld(ji,jj) = MAX(jm, 4 )
+        ELSE
 ! change zero or one model level.
-             hbl(ji,jj) = MAX(zhbl_t(ji,jj), gdepw_n(ji,jj,4) )
-           ENDIF
-           zhbl(ji,jj) = gdepw_n(ji,jj,ibld(ji,jj))
-         END DO
-      END DO
+          hbl(ji,jj) = MAX(zhbl_t(ji,jj), gdepw(ji,jj,4, Kmm ) )
+        ENDIF
+        zhbl(ji,jj) = gdepw(ji,jj,ibld(ji,jj), Kmm )
+      END_2D
 
     END SUBROUTINE zdf_osm_timestep_hbl
 
-    SUBROUTINE zdf_osm_pycnocline_thickness( dh, zdh )
+    SUBROUTINE zdf_osm_pycnocline_thickness( dh, zdh, Kmm )
       !!---------------------------------------------------------------------
       !!                   ***  ROUTINE zdf_osm_pycnocline_thickness  ***
@@ -1707,4 +1630,5 @@
       !!----------------------------------------------------------------------
 
+       INTEGER, INTENT(in) ::   Kmm               ! time-level index
       REAL(wp), DIMENSION(jpi,jpj) :: dh, zdh     ! pycnocline thickness.
       !
@@ -1714,30 +1638,10 @@
 
 
-      DO jj = 2, jpjm1
-         DO ji = 2, jpim1
-            IF ( lconv(ji,jj) ) THEN
-
-               IF( ln_osm_mle ) THEN
-                  IF ( ( zwb_ent(ji,jj) + zwb_fk_b(ji,jj) ) < 0._wp ) THEN
-                     ! OSBL is deepening. Note wb_fk_b is zero if ln_osm_mle=F
-                     IF ( zdb_bl(ji,jj) > 0._wp .and. zdbdz_ext(ji,jj) > 0._wp)THEN
-                        IF ( ( zwstrc(ji,jj) / zvstr(ji,jj) )**3 <= 0.5 ) THEN  ! near neutral stability
-                           zari = MIN( 1.5 * ( zdb_bl(ji,jj) / ( zdbdz_ext(ji,jj) * zhbl(ji,jj) ) ) / &
-                                (1.0 + zdb_bl(ji,jj)**2 / ( 4.5 * zvstr(ji,jj)**2 * zdbdz_ext(ji,jj) ) ), 0.2 )
-                        ELSE                                                     ! unstable
-                           zari = MIN( 1.5 * ( zdb_bl(ji,jj) / ( zdbdz_ext(ji,jj) * zhbl(ji,jj) ) ) / &
-                                (1.0 + zdb_bl(ji,jj)**2 / ( 4.5 * zwstrc(ji,jj)**2 * zdbdz_ext(ji,jj) ) ), 0.2 )
-                        ENDIF
-                        ztau = 0.2 * hbl(ji,jj) / (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird
-                        zddhdt = zari * hbl(ji,jj)
-                     ELSE
-                        ztau = 0.2 * hbl(ji,jj) / ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird
-                        zddhdt = 0.2 * hbl(ji,jj)
-                     ENDIF
-                  ELSE
-                     ztau = 0.2 * hbl(ji,jj) / ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird
-                     zddhdt = 0.2 * hbl(ji,jj)
-                  ENDIF
-               ELSE ! ln_osm_mle
+      DO_2D_00_00
+         IF ( lconv(ji,jj) ) THEN
+
+            IF( ln_osm_mle ) THEN
+               IF ( ( zwb_ent(ji,jj) + zwb_fk_b(ji,jj) ) < 0._wp ) THEN
+                  ! OSBL is deepening. Note wb_fk_b is zero if ln_osm_mle=F
                   IF ( zdb_bl(ji,jj) > 0._wp .and. zdbdz_ext(ji,jj) > 0._wp)THEN
                      IF ( ( zwstrc(ji,jj) / zvstr(ji,jj) )**3 <= 0.5 ) THEN  ! near neutral stability
@@ -1748,47 +1652,65 @@
                              (1.0 + zdb_bl(ji,jj)**2 / ( 4.5 * zwstrc(ji,jj)**2 * zdbdz_ext(ji,jj) ) ), 0.2 )
                      ENDIF
-                     ztau = hbl(ji,jj) / (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird
+                     ztau = 0.2 * hbl(ji,jj) / (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird
                      zddhdt = zari * hbl(ji,jj)
                   ELSE
-                     ztau = hbl(ji,jj) / ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird
+                     ztau = 0.2 * hbl(ji,jj) / ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird
                      zddhdt = 0.2 * hbl(ji,jj)
                   ENDIF
-
-               END IF  ! ln_osm_mle
-
-               dh(ji,jj) = dh(ji,jj) * EXP( -rn_rdt / ztau ) + zddhdt * ( 1.0 - EXP( -rn_rdt / ztau ) )
-               ! Alan: this hml is never defined or used
-            ELSE   ! IF (lconv)
-               ztau = hbl(ji,jj) / zvstr(ji,jj)
-               IF ( zdhdt(ji,jj) >= 0.0 ) THEN    ! probably shouldn't include wm here
-                  ! boundary layer deepening
-                  IF ( zdb_bl(ji,jj) > 0._wp ) THEN
-                     ! pycnocline thickness set by stratification - use same relationship as for neutral conditions.
-                     zari = MIN( 4.5 * ( zvstr(ji,jj)**2 ) &
-                          & / ( zdb_bl(ji,jj) * zhbl(ji,jj) ) + 0.01  , 0.2 )
-                     zddhdt = MIN( zari, 0.2 ) * hbl(ji,jj)
-                  ELSE
-                     zddhdt = 0.2 * hbl(ji,jj)
+               ELSE
+                  ztau = 0.2 * hbl(ji,jj) / ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird
+                  zddhdt = 0.2 * hbl(ji,jj)
+               ENDIF
+            ELSE ! ln_osm_mle
+               IF ( zdb_bl(ji,jj) > 0._wp .and. zdbdz_ext(ji,jj) > 0._wp)THEN
+                  IF ( ( zwstrc(ji,jj) / zvstr(ji,jj) )**3 <= 0.5 ) THEN  ! near neutral stability
+                     zari = MIN( 1.5 * ( zdb_bl(ji,jj) / ( zdbdz_ext(ji,jj) * zhbl(ji,jj) ) ) / &
+                          (1.0 + zdb_bl(ji,jj)**2 / ( 4.5 * zvstr(ji,jj)**2 * zdbdz_ext(ji,jj) ) ), 0.2 )
+                  ELSE                                                     ! unstable
+                     zari = MIN( 1.5 * ( zdb_bl(ji,jj) / ( zdbdz_ext(ji,jj) * zhbl(ji,jj) ) ) / &
+                          (1.0 + zdb_bl(ji,jj)**2 / ( 4.5 * zwstrc(ji,jj)**2 * zdbdz_ext(ji,jj) ) ), 0.2 )
                   ENDIF
-               ELSE     ! IF(dhdt < 0)
+                  ztau = hbl(ji,jj) / (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird
+                  zddhdt = zari * hbl(ji,jj)
+               ELSE
+                  ztau = hbl(ji,jj) / ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird
                   zddhdt = 0.2 * hbl(ji,jj)
-               ENDIF    ! IF (dhdt >= 0)
-               dh(ji,jj) = dh(ji,jj) * EXP( -rn_rdt / ztau )+ zddhdt * ( 1.0 - EXP( -rn_rdt / ztau ) )
-               IF ( zdhdt(ji,jj) < 0._wp .and. dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zddhdt       ! can be a problem with dh>hbl for rapid collapse
-               ! Alan: this hml is never defined or used -- do we need it?
-            ENDIF       ! IF (lconv)
-
-            hml(ji,jj) = hbl(ji,jj) - dh(ji,jj)
-            inhml = MAX( INT( dh(ji,jj) / e3t_n(ji,jj,ibld(ji,jj)) ) , 1 )
-            imld(ji,jj) = MAX( ibld(ji,jj) - inhml, 3)
-            zhml(ji,jj) = gdepw_n(ji,jj,imld(ji,jj))
-            zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj)
-         END DO
-      END DO
+               ENDIF
+
+            END IF  ! ln_osm_mle
+
+            dh(ji,jj) = dh(ji,jj) * EXP( -rn_Dt / ztau ) + zddhdt * ( 1.0 - EXP( -rn_Dt / ztau ) )
+            ! Alan: this hml is never defined or used
+         ELSE   ! IF (lconv)
+            ztau = hbl(ji,jj) / zvstr(ji,jj)
+            IF ( zdhdt(ji,jj) >= 0.0 ) THEN    ! probably shouldn't include wm here
+               ! boundary layer deepening
+               IF ( zdb_bl(ji,jj) > 0._wp ) THEN
+                  ! pycnocline thickness set by stratification - use same relationship as for neutral conditions.
+                  zari = MIN( 4.5 * ( zvstr(ji,jj)**2 ) &
+                       & / ( zdb_bl(ji,jj) * zhbl(ji,jj) ) + 0.01  , 0.2 )
+                  zddhdt = MIN( zari, 0.2 ) * hbl(ji,jj)
+               ELSE
+                  zddhdt = 0.2 * hbl(ji,jj)
+               ENDIF
+            ELSE     ! IF(dhdt < 0)
+               zddhdt = 0.2 * hbl(ji,jj)
+            ENDIF    ! IF (dhdt >= 0)
+            dh(ji,jj) = dh(ji,jj) * EXP( -rn_Dt / ztau )+ zddhdt * ( 1.0 - EXP( -rn_Dt / ztau ) )
+            IF ( zdhdt(ji,jj) < 0._wp .and. dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zddhdt       ! can be a problem with dh>hbl for rapid collapse
+            ! Alan: this hml is never defined or used -- do we need it?
+         ENDIF       ! IF (lconv)
+
+         hml(ji,jj) = hbl(ji,jj) - dh(ji,jj)
+         inhml = MAX( INT( dh(ji,jj) / e3t(ji,jj,ibld(ji,jj), Kmm) ) , 1 )
+         imld(ji,jj) = MAX( ibld(ji,jj) - inhml, 3)
+         zhml(ji,jj) = gdepw(ji,jj,imld(ji,jj), Kmm)
+         zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj)
+      END_2D
 
     END SUBROUTINE zdf_osm_pycnocline_thickness
 
 
-   SUBROUTINE zdf_osm_zmld_horizontal_gradients( zmld, zdtdx, zdtdy, zdsdx, zdsdy, dbdx_mle, dbdy_mle )
+   SUBROUTINE zdf_osm_zmld_horizontal_gradients( zmld, zdtdx, zdtdy, zdsdx, zdsdy, dbdx_mle, dbdy_mle, Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE zdf_osm_horizontal_gradients  ***
@@ -1801,5 +1723,5 @@
       !!             Fox-Kemper and Ferrari, JPO, 38, 1166-1179, 2008
 
-
+       INTEGER, INTENT(in) ::   Kmm                          ! time-level index
       REAL(wp), DIMENSION(jpi,jpj)     :: dbdx_mle, dbdy_mle ! MLE horiz gradients at u & v points
       REAL(wp), DIMENSION(jpi,jpj)     :: zmld ! ==  estimated FK BLD used for MLE horiz gradients  == !
@@ -1819,20 +1741,14 @@
       mld_prof(:,:)  = nlb10               ! Initialization to the number of w ocean point
       zmld(:,:)  = 0._wp               ! here hmlp used as a dummy variable, integrating vertically N^2
-      zN2_c = grav * rn_osm_mle_rho_c * r1_rau0   ! convert density criteria into N^2 criteria
-      DO jk = nlb10, jpkm1
-         DO jj = 1, jpj                ! Mixed layer level: w-level 
-            DO ji = 1, jpi
-               ikt = mbkt(ji,jj)
-               zmld(ji,jj) = zmld(ji,jj) + MAX( rn2b(ji,jj,jk) , 0._wp ) * e3w_n(ji,jj,jk)
-               IF( zmld(ji,jj) < zN2_c )   mld_prof(ji,jj) = MIN( jk , ikt ) + 1   ! Mixed layer level
-            END DO
-         END DO
-      END DO
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            mld_prof(ji,jj) = MAX(mld_prof(ji,jj),ibld(ji,jj))
-            zmld(ji,jj) = gdepw_n(ji,jj,mld_prof(ji,jj))
-         END DO
-      END DO
+      zN2_c = grav * rn_osm_mle_rho_c * r1_rho0   ! convert density criteria into N^2 criteria
+      DO_3D_11_11( nlb10, jpkm1 )            ! Mixed layer level: w-level
+         ikt = mbkt(ji,jj)
+         zmld(ji,jj) = zmld(ji,jj) + MAX( rn2b(ji,jj,jk) , 0._wp ) * e3w(ji,jj,jk, Kmm )
+         IF( zmld(ji,jj) < zN2_c )   mld_prof(ji,jj) = MIN( jk , ikt ) + 1   ! Mixed layer level
+      END_3D
+      DO_2D_11_11
+         mld_prof(ji,jj) = MAX(mld_prof(ji,jj),ibld(ji,jj))
+         zmld(ji,jj) = gdepw(ji,jj,mld_prof(ji,jj), Kmm )
+      END_2D
       ! ensure mld_prof .ge. ibld
       !
@@ -1841,54 +1757,42 @@
       ztm(:,:) = 0._wp
       zsm(:,:) = 0._wp
-      DO jk = 1, ikmax                                 ! MLD and mean buoyancy and N2 over the mixed layer
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zc = e3t_n(ji,jj,jk) * REAL( MIN( MAX( 0, mld_prof(ji,jj)-jk ) , 1  )  )    ! zc being 0 outside the ML t-points
-               ztm(ji,jj) = ztm(ji,jj) + zc * tsn(ji,jj,jk,jp_tem)
-               zsm(ji,jj) = zsm(ji,jj) + zc * tsn(ji,jj,jk,jp_sal)
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, ikmax )                ! MLD and mean buoyancy and N2 over the mixed layer
+         zc = e3t(ji,jj,jk, Kmm ) * REAL( MIN( MAX( 0, mld_prof(ji,jj)-jk ) , 1  )  )    ! zc being 0 outside the ML t-points
+         ztm(ji,jj) = ztm(ji,jj) + zc * ts(ji,jj,jk,jp_tem, Kmm )
+         zsm(ji,jj) = zsm(ji,jj) + zc * ts(ji,jj,jk,jp_sal, Kmm )
+      END_3D
       ! average temperature and salinity.
-      ztm(:,:) = ztm(:,:) / MAX( e3t_n(:,:,1), zmld(:,:) )
-      zsm(:,:) = zsm(:,:) / MAX( e3t_n(:,:,1), zmld(:,:) )
+      ztm(:,:) = ztm(:,:) / MAX( e3t(:,:,1, Kmm), zmld(:,:) )
+      zsm(:,:) = zsm(:,:) / MAX( e3t(:,:,1, Kmm), zmld(:,:) )
       ! calculate horizontal gradients at u & v points
 
-      DO jj = 2, jpjm1
-         DO ji = 1, jpim1
-            zdtdx(ji,jj) = ( ztm(ji+1,jj) - ztm( ji,jj) )  * umask(ji,jj,1) / e1u(ji,jj)
-            zdsdx(ji,jj) = ( zsm(ji+1,jj) - zsm( ji,jj) )  * umask(ji,jj,1) / e1u(ji,jj)
-            zmld_midu(ji,jj) = 0.25_wp * (zmld(ji+1,jj) + zmld( ji,jj))
-            ztsm_midu(ji,jj,jp_tem) = 0.5_wp * ( ztm(ji+1,jj) + ztm( ji,jj) )
-            ztsm_midu(ji,jj,jp_sal) = 0.5_wp * ( zsm(ji+1,jj) + zsm( ji,jj) )
-         END DO
-      END DO
-
-      DO jj = 1, jpjm1
-         DO ji = 2, jpim1
-            zdtdy(ji,jj) = ( ztm(ji,jj+1) - ztm( ji,jj) ) * vmask(ji,jj,1) / e1v(ji,jj)
-            zdsdy(ji,jj) = ( zsm(ji,jj+1) - zsm( ji,jj) ) * vmask(ji,jj,1) / e1v(ji,jj)
-            zmld_midv(ji,jj) = 0.25_wp * (zmld(ji,jj+1) + zmld( ji,jj))
-            ztsm_midv(ji,jj,jp_tem) = 0.5_wp * ( ztm(ji,jj+1) + ztm( ji,jj) )
-            ztsm_midv(ji,jj,jp_sal) = 0.5_wp * ( zsm(ji,jj+1) + zsm( ji,jj) )
-         END DO
-      END DO
-
-      CALL eos_rab(ztsm_midu, zmld_midu, zabu)
-      CALL eos_rab(ztsm_midv, zmld_midv, zabv)
-
-      DO jj = 2, jpjm1
-         DO ji = 1, jpim1
-            dbdx_mle(ji,jj) = grav*(zdtdx(ji,jj)*zabu(ji,jj,jp_tem) - zdsdx(ji,jj)*zabu(ji,jj,jp_sal))
-         END DO
-      END DO
-      DO jj = 1, jpjm1
-         DO ji = 2, jpim1
-            dbdy_mle(ji,jj) = grav*(zdtdy(ji,jj)*zabv(ji,jj,jp_tem) - zdsdy(ji,jj)*zabv(ji,jj,jp_sal))
-         END DO
-      END DO
+      DO_2D_00_10
+         zdtdx(ji,jj) = ( ztm(ji+1,jj) - ztm( ji,jj) )  * umask(ji,jj,1) / e1u(ji,jj)
+         zdsdx(ji,jj) = ( zsm(ji+1,jj) - zsm( ji,jj) )  * umask(ji,jj,1) / e1u(ji,jj)
+         zmld_midu(ji,jj) = 0.25_wp * (zmld(ji+1,jj) + zmld( ji,jj))
+         ztsm_midu(ji,jj,jp_tem) = 0.5_wp * ( ztm(ji+1,jj) + ztm( ji,jj) )
+         ztsm_midu(ji,jj,jp_sal) = 0.5_wp * ( zsm(ji+1,jj) + zsm( ji,jj) )
+      END_2D
+
+      DO_2D_10_00
+         zdtdy(ji,jj) = ( ztm(ji,jj+1) - ztm( ji,jj) ) * vmask(ji,jj,1) / e1v(ji,jj)
+         zdsdy(ji,jj) = ( zsm(ji,jj+1) - zsm( ji,jj) ) * vmask(ji,jj,1) / e1v(ji,jj)
+         zmld_midv(ji,jj) = 0.25_wp * (zmld(ji,jj+1) + zmld( ji,jj))
+         ztsm_midv(ji,jj,jp_tem) = 0.5_wp * ( ztm(ji,jj+1) + ztm( ji,jj) )
+         ztsm_midv(ji,jj,jp_sal) = 0.5_wp * ( zsm(ji,jj+1) + zsm( ji,jj) )
+      END_2D
+
+      CALL eos_rab(ztsm_midu, zmld_midu, zabu, Kmm )
+      CALL eos_rab(ztsm_midv, zmld_midv, zabv, Kmm )
+
+      DO_2D_00_10
+         dbdx_mle(ji,jj) = grav*(zdtdx(ji,jj)*zabu(ji,jj,jp_tem) - zdsdx(ji,jj)*zabu(ji,jj,jp_sal))
+      END_2D
+      DO_2D_10_00
+         dbdy_mle(ji,jj) = grav*(zdtdy(ji,jj)*zabv(ji,jj,jp_tem) - zdsdy(ji,jj)*zabv(ji,jj,jp_sal))
+      END_2D
 
  END SUBROUTINE zdf_osm_zmld_horizontal_gradients
-  SUBROUTINE zdf_osm_mle_parameters( hmle, zwb_fk, zvel_mle, zdiff_mle )
+  SUBROUTINE zdf_osm_mle_parameters( hmle, zwb_fk, zvel_mle, zdiff_mle, Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE zdf_osm_mle_parameters  ***
@@ -1901,4 +1805,5 @@
       !!             Fox-Kemper and Ferrari, JPO, 38, 1166-1179, 2008
 
+       INTEGER, INTENT(in) ::   Kmm     ! time-level index
       REAL(wp), DIMENSION(jpi,jpj)     :: hmle, zwb_fk, zvel_mle, zdiff_mle
       INTEGER  ::   ji, jj, jk          ! dummy loop indices
@@ -1908,71 +1813,55 @@
 
       mld_prof(:,:) = 4
-      DO jk = 5, jpkm1
-        DO jj = 2, jpjm1
-          DO ji = 2, jpim1
-            IF ( hmle(ji,jj) >= gdepw_n(ji,jj,jk) ) mld_prof(ji,jj) = MIN(mbkt(ji,jj), jk)
-          END DO
-        END DO
-      END DO
-      ! DO jj = 2, jpjm1
-      !    DO ji = 1, jpim1
-      !       zhmle(ji,jj) = gdepw_n(ji,jj,mld_prof(ji,jj))
-      !    END DO
-      !  END DO
+      DO_3D_00_00( 5, jpkm1 )
+         IF ( hmle(ji,jj) >= gdepw(ji,jj,jk, Kmm ) ) mld_prof(ji,jj) = MIN(mbkt(ji,jj), jk)
+      END_3D
+      ! DO_2D_00_10
+      !    zhmle(ji,jj) = gdepw(ji,jj,mld_prof(ji,jj), Kmm )
+      !  END_2D
    ! Timestep mixed layer eddy depth.
-      DO jj = 2, jpjm1
-        DO ji = 2, jpim1
-          zdb_mle = grav * (rhop(ji,jj,mld_prof(ji,jj)) - rhop(ji,jj,ibld(ji,jj) )) * r1_rau0 ! check ALMG
-          IF ( lconv(ji,jj) .and. ( zdb_bl(ji,jj) < rn_osm_mle_thresh .and. mld_prof(ji,jj) > ibld(ji,jj) .and. zdb_mle > 0.0 ) ) THEN
-             hmle(ji,jj) = hmle(ji,jj) + zwb0(ji,jj) * rn_rdt / MAX( zdb_mle, rn_osm_mle_thresh )  ! MLE layer deepening through encroachment. Don't have a good maximum value for deepening, so use threshold buoyancy.
+      DO_2D_00_00
+       zdb_mle = grav * (rhop(ji,jj,mld_prof(ji,jj)) - rhop(ji,jj,ibld(ji,jj) )) * r1_rho0 ! check ALMG
+       IF ( lconv(ji,jj) .and. ( zdb_bl(ji,jj) < rn_osm_mle_thresh .and. mld_prof(ji,jj) > ibld(ji,jj) .and. zdb_mle > 0.0 ) ) THEN
+          hmle(ji,jj) = hmle(ji,jj) + zwb0(ji,jj) * rn_Dt / MAX( zdb_mle, rn_osm_mle_thresh )  ! MLE layer deepening through encroachment. Don't have a good maximum value for deepening, so use threshold buoyancy.
+       ELSE
+         ! MLE layer relaxes towards mixed layer depth on timescale tau_mle, or tau_mle/10
+          ! IF ( hmle(ji,jj) > zmld(ji,jj) ) THEN
+          !   hmle(ji,jj) = hmle(ji,jj) - ( hmle(ji,jj) - zmld(ji,jj) ) * rn_Dt / rn_osm_mle_tau
+          ! ELSE
+          !   hmle(ji,jj) = hmle(ji,jj) - 10.0 * ( hmle(ji,jj) - zmld(ji,jj) ) * rn_Dt / rn_osm_mle_tau ! fast relaxation if MLE layer shallower than MLD
+          ! ENDIF
+          IF ( hmle(ji,jj) > hbl(ji,jj) ) THEN
+            hmle(ji,jj) = hmle(ji,jj) - ( hmle(ji,jj) - hbl(ji,jj) ) * rn_Dt / rn_osm_mle_tau
           ELSE
-            ! MLE layer relaxes towards mixed layer depth on timescale tau_mle, or tau_mle/10
-             ! IF ( hmle(ji,jj) > zmld(ji,jj) ) THEN
-             !   hmle(ji,jj) = hmle(ji,jj) - ( hmle(ji,jj) - zmld(ji,jj) ) * rn_rdt / rn_osm_mle_tau
-             ! ELSE
-             !   hmle(ji,jj) = hmle(ji,jj) - 10.0 * ( hmle(ji,jj) - zmld(ji,jj) ) * rn_rdt / rn_osm_mle_tau ! fast relaxation if MLE layer shallower than MLD
-             ! ENDIF
-             IF ( hmle(ji,jj) > hbl(ji,jj) ) THEN
-               hmle(ji,jj) = hmle(ji,jj) - ( hmle(ji,jj) - hbl(ji,jj) ) * rn_rdt / rn_osm_mle_tau
-             ELSE
-               hmle(ji,jj) = hmle(ji,jj) - 10.0 * ( hmle(ji,jj) - hbl(ji,jj) ) * rn_rdt / rn_osm_mle_tau ! fast relaxation if MLE layer shallower than MLD
-             ENDIF
+            hmle(ji,jj) = hmle(ji,jj) - 10.0 * ( hmle(ji,jj) - hbl(ji,jj) ) * rn_Dt / rn_osm_mle_tau ! fast relaxation if MLE layer shallower than MLD
           ENDIF
-          hmle(ji,jj) = MIN(hmle(ji,jj), ht_n(ji,jj))
-        END DO
-      END DO
+       ENDIF
+       hmle(ji,jj) = MIN(hmle(ji,jj), ht(ji,jj))
+      END_2D
 
       mld_prof = 4
-      DO jk = 5, jpkm1
-        DO jj = 2, jpjm1
-          DO ji = 2, jpim1
-            IF ( hmle(ji,jj) >= gdepw_n(ji,jj,jk) ) mld_prof(ji,jj) = MIN(mbkt(ji,jj), jk)
-          END DO
-        END DO
-      END DO
-      DO jj = 2, jpjm1
-         DO ji = 2, jpim1
-            zhmle(ji,jj) = gdepw_n(ji,jj, mld_prof(ji,jj))
-         END DO
-       END DO
+      DO_3D_00_00( 5, jpkm1 )
+        IF ( hmle(ji,jj) >= gdepw(ji,jj,jk, Kmm ) ) mld_prof(ji,jj) = MIN(mbkt(ji,jj), jk)
+      END_3D
+      DO_2D_00_00
+         zhmle(ji,jj) = gdepw(ji,jj, mld_prof(ji,jj), Kmm )
+      END_2D
    ! Calculate vertical buoyancy, heat and salinity fluxes due to MLE.
 
-      DO jj = 2, jpjm1
-        DO ji = 2, jpim1
-          IF ( lconv(ji,jj) ) THEN
-             ztmp =  r1_ft(ji,jj) *  MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf
-             ! zwt_fk(ji,jj) = 0.5_wp * ztmp * ( dbdx_mle(ji,jj) * zdtdx(ji,jj) + dbdy_mle(ji,jj) * zdtdy(ji,jj) &
-             !      & + dbdx_mle(ji-1,jj) * zdtdx(ji-1,jj) + dbdy_mle(ji,jj-1) * zdtdy(ji,jj-1) )
-             ! zws_fk(ji,jj) = 0.5_wp * ztmp * ( dbdx_mle(ji,jj) * zdsdx(ji,jj) + dbdy_mle(ji,jj) * zdsdy(ji,jj) &
-             !      & + dbdx_mle(ji-1,jj) * zdsdx(ji-1,jj) + dbdy_mle(ji,jj-1) * zdsdy(ji,jj-1) )
-             zdbds_mle = SQRT( 0.5_wp * ( dbdx_mle(ji,jj) * dbdx_mle(ji,jj) + dbdy_mle(ji,jj) * dbdy_mle(ji,jj) &
-                  & + dbdx_mle(ji-1,jj) * dbdx_mle(ji-1,jj) + dbdy_mle(ji,jj-1) * dbdy_mle(ji,jj-1) ) )
-             zwb_fk(ji,jj) = rn_osm_mle_ce * hmle(ji,jj) * hmle(ji,jj) *ztmp * zdbds_mle * zdbds_mle
-      ! This vbelocity scale, defined in Fox-Kemper et al (2008), is needed for calculating dhdt.
-             zvel_mle(ji,jj) = zdbds_mle * ztmp * hmle(ji,jj) * tmask(ji,jj,1) 
-             zdiff_mle(ji,jj) = 1.e-4_wp * ztmp * zdbds_mle * zhmle(ji,jj)**3  / rn_osm_mle_lf
-          ENDIF
-        END DO
-      END DO
+      DO_2D_00_00
+        IF ( lconv(ji,jj) ) THEN
+           ztmp =  r1_ft(ji,jj) *  MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf
+           ! zwt_fk(ji,jj) = 0.5_wp * ztmp * ( dbdx_mle(ji,jj) * zdtdx(ji,jj) + dbdy_mle(ji,jj) * zdtdy(ji,jj) &
+           !      & + dbdx_mle(ji-1,jj) * zdtdx(ji-1,jj) + dbdy_mle(ji,jj-1) * zdtdy(ji,jj-1) )
+           ! zws_fk(ji,jj) = 0.5_wp * ztmp * ( dbdx_mle(ji,jj) * zdsdx(ji,jj) + dbdy_mle(ji,jj) * zdsdy(ji,jj) &
+           !      & + dbdx_mle(ji-1,jj) * zdsdx(ji-1,jj) + dbdy_mle(ji,jj-1) * zdsdy(ji,jj-1) )
+           zdbds_mle = SQRT( 0.5_wp * ( dbdx_mle(ji,jj) * dbdx_mle(ji,jj) + dbdy_mle(ji,jj) * dbdy_mle(ji,jj) &
+                & + dbdx_mle(ji-1,jj) * dbdx_mle(ji-1,jj) + dbdy_mle(ji,jj-1) * dbdy_mle(ji,jj-1) ) )
+           zwb_fk(ji,jj) = rn_osm_mle_ce * hmle(ji,jj) * hmle(ji,jj) *ztmp * zdbds_mle * zdbds_mle
+    ! This vbelocity scale, defined in Fox-Kemper et al (2008), is needed for calculating dhdt.
+           zvel_mle(ji,jj) = zdbds_mle * ztmp * hmle(ji,jj) * tmask(ji,jj,1) 
+           zdiff_mle(ji,jj) = 1.e-4_wp * ztmp * zdbds_mle * zhmle(ji,jj)**3  / rn_osm_mle_lf
+        ENDIF
+      END_2D
 END SUBROUTINE zdf_osm_mle_parameters
 
@@ -1980,5 +1869,5 @@
 
 
-   SUBROUTINE zdf_osm_init
+   SUBROUTINE zdf_osm_init( Kmm ) 
      !!----------------------------------------------------------------------
      !!                  ***  ROUTINE zdf_osm_init  ***
@@ -1992,4 +1881,6 @@
      !! ** input   :   Namlist namosm
      !!----------------------------------------------------------------------
+     INTEGER, INTENT(in)    :: Kmm ! time level index (middle)
+     !
      INTEGER  ::   ios            ! local integer
      INTEGER  ::   ji, jj, jk     ! dummy loop indices
@@ -2006,9 +1897,7 @@
      !!----------------------------------------------------------------------
      !
-     REWIND( numnam_ref )              ! Namelist namzdf_osm in reference namelist : Osmosis ML model
      READ  ( numnam_ref, namzdf_osm, IOSTAT = ios, ERR = 901)
 901  IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_osm in reference namelist' )
 
-     REWIND( numnam_cfg )              ! Namelist namzdf_tke in configuration namelist : Turbulent Kinetic Energy
      READ  ( numnam_cfg, namzdf_osm, IOSTAT = ios, ERR = 902 )
 902  IF( ios >  0 ) CALL ctl_nam ( ios , 'namzdf_osm in configuration namelist' )
@@ -2049,9 +1938,9 @@
      IF( ln_osm_mle ) THEN
 ! Initialise Fox-Kemper parametrization
-         REWIND( numnam_ref )              ! Namelist namosm_mle in reference namelist : Tracer advection scheme
+         ! Namelist namosm_mle in reference namelist : Tracer advection scheme
          READ  ( numnam_ref, namosm_mle, IOSTAT = ios, ERR = 903)
 903      IF( ios /= 0 )   CALL ctl_nam ( ios , 'namosm_mle in reference namelist')
 
-         REWIND( numnam_cfg )              ! Namelist namosm_mle in configuration namelist : Tracer advection scheme
+         ! Namelist namosm_mle in configuration namelist : Tracer advection scheme
          READ  ( numnam_cfg, namosm_mle, IOSTAT = ios, ERR = 904 )
 904      IF( ios >  0 )   CALL ctl_nam ( ios , 'namosm_mle in configuration namelist')
@@ -2087,5 +1976,5 @@
       IF( ln_osm_mle ) THEN                ! MLE initialisation
          !
-         rb_c = grav * rn_osm_mle_rho_c /rau0        ! Mixed Layer buoyancy criteria
+         rb_c = grav * rn_osm_mle_rho_c /rho0        ! Mixed Layer buoyancy criteria
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) '      ML buoyancy criteria = ', rb_c, ' m/s2 '
@@ -2110,5 +1999,5 @@
       ENDIF
 
-     call osm_rst( nit000, 'READ' ) !* read or initialize hbl, dh, hmle
+     call osm_rst( nit000, Kmm, 'READ' ) !* read or initialize hbl, dh, hmle
 
 
@@ -2147,13 +2036,9 @@
         etmean(:,:,:) = 0.e0
 
-        DO jk = 1, jpkm1
-           DO jj = 2, jpjm1
-              DO ji = 2, 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)  )
-              END DO
-           END DO
-        END DO
+        DO_3D_00_00( 1, jpkm1 )
+           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)  )
+        END_3D
 
      CASE ( 1 )                ! horizontal average
@@ -2165,16 +2050,12 @@
         etmean(:,:,:) = 0.e0
 
-        DO jk = 1, jpkm1
-           DO jj = 2, jpjm1
-              DO ji = 2, jpim1   ! vector opt.
-                 etmean(ji,jj,jk) = tmask(ji, jj,jk)                           &
-                      & / MAX( 1., 2.* tmask(ji,jj,jk)                           &
-                      &      +.5 * ( tmask(ji-1,jj+1,jk) + tmask(ji-1,jj-1,jk)   &
-                      &             +tmask(ji+1,jj+1,jk) + tmask(ji+1,jj-1,jk) ) &
-                      &      +1. * ( tmask(ji-1,jj  ,jk) + tmask(ji  ,jj+1,jk)   &
-                      &             +tmask(ji  ,jj-1,jk) + tmask(ji+1,jj  ,jk) ) )
-              END DO
-           END DO
-        END DO
+        DO_3D_00_00( 1, jpkm1 )
+           etmean(ji,jj,jk) = tmask(ji, jj,jk)                           &
+                & / MAX( 1., 2.* tmask(ji,jj,jk)                           &
+                &      +.5 * ( tmask(ji-1,jj+1,jk) + tmask(ji-1,jj-1,jk)   &
+                &             +tmask(ji+1,jj+1,jk) + tmask(ji+1,jj-1,jk) ) &
+                &      +1. * ( tmask(ji-1,jj  ,jk) + tmask(ji  ,jj+1,jk)   &
+                &             +tmask(ji  ,jj-1,jk) + tmask(ji+1,jj  ,jk) ) )
+        END_3D
 
      CASE DEFAULT
@@ -2208,5 +2089,5 @@
 
 
-   SUBROUTINE osm_rst( kt, cdrw )
+   SUBROUTINE osm_rst( kt, Kmm, cdrw )
      !!---------------------------------------------------------------------
      !!                   ***  ROUTINE osm_rst  ***
@@ -2218,5 +2099,6 @@
      !!----------------------------------------------------------------------
 
-     INTEGER, INTENT(in) :: kt
+     INTEGER         , INTENT(in) ::   kt     ! ocean time step index
+     INTEGER         , INTENT(in) ::   Kmm    ! ocean time level index (middle)
      CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag
 
@@ -2236,9 +2118,9 @@
         id1 = iom_varid( numror, 'wn'   , ldstop = .FALSE. )
         IF( id1 > 0 ) THEN                       ! 'wn' exists; read
-           CALL iom_get( numror, jpdom_autoglo, 'wn', wn, ldxios = lrxios )
-           WRITE(numout,*) ' ===>>>> :  wn read from restart file'
+           CALL iom_get( numror, jpdom_autoglo, 'wn', ww, ldxios = lrxios )
+           WRITE(numout,*) ' ===>>>> :  ww read from restart file'
         ELSE
-           wn(:,:,:) = 0._wp
-           WRITE(numout,*) ' ===>>>> :  wn not in restart file, set to zero initially'
+           ww(:,:,:) = 0._wp
+           WRITE(numout,*) ' ===>>>> :  ww not in restart file, set to zero initially'
         END IF
 
@@ -2270,5 +2152,5 @@
      IF( TRIM(cdrw) == 'WRITE') THEN     !* Write hbli into the restart file, then return
         IF(lwp) WRITE(numout,*) '---- osm-rst ----'
-         CALL iom_rstput( kt, nitrst, numrow, 'wn'     , wn,   ldxios = lwxios )
+         CALL iom_rstput( kt, nitrst, numrow, 'wn'     , ww  , ldxios = lwxios )
          CALL iom_rstput( kt, nitrst, numrow, 'hbl'    , hbl,  ldxios = lwxios )
          CALL iom_rstput( kt, nitrst, numrow, 'dh'     , dh,   ldxios = lwxios )
@@ -2284,28 +2166,22 @@
      IF( lwp ) WRITE(numout,*) ' ===>>>> : calculating hbl computed from stratification'
      ! w-level of the mixing and mixed layers
-     CALL eos_rab( tsn, rab_n )
-     CALL bn2(tsn, rab_n, rn2)
+     CALL eos_rab( ts(:,:,:,:,Kmm), rab_n, Kmm )
+     CALL bn2(ts(:,:,:,:,Kmm), rab_n, rn2, Kmm)
      imld_rst(:,:)  = nlb10         ! Initialization to the number of w ocean point
      hbl(:,:)  = 0._wp              ! here hbl used as a dummy variable, integrating vertically N^2
-     zN2_c = grav * rho_c * r1_rau0 ! convert density criteria into N^2 criteria
+     zN2_c = grav * rho_c * r1_rho0 ! convert density criteria into N^2 criteria
      !
      hbl(:,:)  = 0._wp              ! here hbl used as a dummy variable, integrating vertically N^2
-     DO jk = 1, jpkm1
-        DO jj = 1, jpj              ! Mixed layer level: w-level
-           DO ji = 1, jpi
-              ikt = mbkt(ji,jj)
-              hbl(ji,jj) = hbl(ji,jj) + MAX( rn2(ji,jj,jk) , 0._wp ) * e3w_n(ji,jj,jk)
-              IF( hbl(ji,jj) < zN2_c )   imld_rst(ji,jj) = MIN( jk , ikt ) + 1   ! Mixed layer level
-           END DO
-        END DO
-     END DO
+     DO_3D_11_11( 1, jpkm1 )
+        ikt = mbkt(ji,jj)
+        hbl(ji,jj) = hbl(ji,jj) + MAX( rn2(ji,jj,jk) , 0._wp ) * e3w(ji,jj,jk,Kmm)
+        IF( hbl(ji,jj) < zN2_c )   imld_rst(ji,jj) = MIN( jk , ikt ) + 1   ! Mixed layer level
+     END_3D
      !
-     DO jj = 1, jpj
-        DO ji = 1, jpi
-           iiki = MAX(4,imld_rst(ji,jj))
-           hbl (ji,jj) = gdepw_n(ji,jj,iiki  )    ! Turbocline depth
-           dh (ji,jj) = e3t_n(ji,jj,iiki-1  )     ! Turbocline depth
-        END DO
-     END DO
+     DO_2D_11_11
+        iiki = MAX(4,imld_rst(ji,jj))
+        hbl (ji,jj) = gdepw(ji,jj,iiki, Kmm )    ! Turbocline depth
+        dh (ji,jj) = e3t(ji,jj,iiki-1,  Kmm )    ! Turbocline depth
+     END_2D
 
      WRITE(numout,*) ' ===>>>> : hbl computed from stratification'
@@ -2316,10 +2192,10 @@
      END IF
 
-     wn(:,:,:) = 0._wp
+     ww(:,:,:) = 0._wp
      WRITE(numout,*) ' ===>>>> :  wn not in restart file, set to zero initially'
    END SUBROUTINE osm_rst
 
 
-   SUBROUTINE tra_osm( kt )
+   SUBROUTINE tra_osm( kt, Kmm, pts, Krhs )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_osm  ***
@@ -2331,5 +2207,8 @@
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt, ztrds   ! 3D workspace
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) :: kt
+      INTEGER                                  , INTENT(in)    :: kt        ! time step index
+      INTEGER                                  , INTENT(in)    :: Kmm, Krhs ! time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts       ! active tracers and RHS of tracer equation
+      !
       INTEGER :: ji, jj, jk
       !
@@ -2341,34 +2220,29 @@
 
       IF( l_trdtra )   THEN                    !* Save ta and sa trends
-         ALLOCATE( ztrdt(jpi,jpj,jpk) )   ;    ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
-         ALLOCATE( ztrds(jpi,jpj,jpk) )   ;    ztrds(:,:,:) = tsa(:,:,:,jp_sal)
+         ALLOCATE( ztrdt(jpi,jpj,jpk) )   ;    ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs)
+         ALLOCATE( ztrds(jpi,jpj,jpk) )   ;    ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs)
       ENDIF
 
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               tsa(ji,jj,jk,jp_tem) =  tsa(ji,jj,jk,jp_tem)                      &
-                  &                 - (  ghamt(ji,jj,jk  )  &
-                  &                    - ghamt(ji,jj,jk+1) ) /e3t_n(ji,jj,jk)
-               tsa(ji,jj,jk,jp_sal) =  tsa(ji,jj,jk,jp_sal)                      &
-                  &                 - (  ghams(ji,jj,jk  )  &
-                  &                    - ghams(ji,jj,jk+1) ) / e3t_n(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 1, jpkm1 )
+         pts(ji,jj,jk,jp_tem,Krhs) =  pts(ji,jj,jk,jp_tem,Krhs)                      &
+            &                 - (  ghamt(ji,jj,jk  )  &
+            &                    - ghamt(ji,jj,jk+1) ) /e3t(ji,jj,jk,Kmm)
+         pts(ji,jj,jk,jp_sal,Krhs) =  pts(ji,jj,jk,jp_sal,Krhs)                      &
+            &                 - (  ghams(ji,jj,jk  )  &
+            &                    - ghams(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm)
+      END_3D
 
       ! save the non-local tracer flux trends for diagnostics
       IF( l_trdtra )   THEN
-         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
-         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
-
-         CALL trd_tra( kt, 'TRA', jp_tem, jptra_osm, ztrdt )
-         CALL trd_tra( kt, 'TRA', jp_sal, jptra_osm, ztrds )
+         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)
+         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:)
+         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_osm, ztrdt )
+         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_osm, ztrds )
          DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds )
       ENDIF
 
-      IF(ln_ctl) THEN
-         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' osm  - Ta: ', mask1=tmask,   &
-         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      IF(sn_cfctl%l_prtctl) THEN
+         CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' osm  - Ta: ', mask1=tmask,   &
+         &             tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
       ENDIF
       !
@@ -2393,5 +2267,5 @@
 
 
-   SUBROUTINE dyn_osm( kt )
+   SUBROUTINE dyn_osm( kt, Kmm, puu, pvv, Krhs )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dyn_osm  ***
@@ -2402,5 +2276,7 @@
       !! ** Method  :   ???
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   !
+      INTEGER                             , INTENT( in )  ::  kt          ! ocean time step index
+      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation
       !
       INTEGER :: ji, jj, jk   ! dummy loop indices
@@ -2414,16 +2290,12 @@
       !code saving tracer trends removed, replace with trdmxl_oce
 
-      DO jk = 1, jpkm1           ! add non-local u and v fluxes
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               ua(ji,jj,jk) =  ua(ji,jj,jk)                      &
-                  &                 - (  ghamu(ji,jj,jk  )  &
-                  &                    - ghamu(ji,jj,jk+1) ) / e3u_n(ji,jj,jk)
-               va(ji,jj,jk) =  va(ji,jj,jk)                      &
-                  &                 - (  ghamv(ji,jj,jk  )  &
-                  &                    - ghamv(ji,jj,jk+1) ) / e3v_n(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 1, jpkm1 )
+         puu(ji,jj,jk,Krhs) =  puu(ji,jj,jk,Krhs)                      &
+            &                 - (  ghamu(ji,jj,jk  )  &
+            &                    - ghamu(ji,jj,jk+1) ) / e3u(ji,jj,jk,Kmm)
+         pvv(ji,jj,jk,Krhs) =  pvv(ji,jj,jk,Krhs)                      &
+            &                 - (  ghamv(ji,jj,jk  )  &
+            &                    - ghamv(ji,jj,jk+1) ) / e3v(ji,jj,jk,Kmm)
+      END_3D
       !
       ! code for saving tracer trends removed
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfphy.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfphy.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfphy.F90	(revision 12928)
@@ -56,10 +56,10 @@
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: zdfphy.F90 12178 2019-12-11 11:02:38Z agn $
+   !! $Id$
    !! Software governed by the CeCILL license (see ./LICENSE)
    !!----------------------------------------------------------------------
 CONTAINS
 
-   SUBROUTINE zdf_phy_init
+   SUBROUTINE zdf_phy_init( Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE zdf_phy_init  ***
@@ -70,4 +70,6 @@
       !!                set horizontal shape and vertical profile of background mixing coef.
       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in)    :: Kmm ! time level index (middle)
+      !
       INTEGER ::   jk            ! dummy loop indices
       INTEGER ::   ioptio, ios   ! local integers
@@ -91,9 +93,7 @@
       !
       !                           !==  Namelist  ==!
-      REWIND( numnam_ref )              ! Namelist namzdf in reference namelist : Vertical mixing parameters
       READ  ( numnam_ref, namzdf, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namzdf in reference namelist' )
       !
-      REWIND( numnam_cfg )              ! Namelist namzdf in reference namelist : Vertical mixing parameters
       READ  ( numnam_cfg, namzdf, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namzdf in configuration namelist' )
@@ -191,8 +191,8 @@
       ioptio = 0 
       IF( ln_zdfcst ) THEN   ;   ioptio = ioptio + 1   ;    nzdf_phy = np_CST   ;   ENDIF
-      IF( ln_zdfric ) THEN   ;   ioptio = ioptio + 1   ;    nzdf_phy = np_RIC   ;   CALL zdf_ric_init   ;   ENDIF
-      IF( ln_zdftke ) THEN   ;   ioptio = ioptio + 1   ;    nzdf_phy = np_TKE   ;   CALL zdf_tke_init   ;   ENDIF
-      IF( ln_zdfgls ) THEN   ;   ioptio = ioptio + 1   ;    nzdf_phy = np_GLS   ;   CALL zdf_gls_init   ;   ENDIF
-      IF( ln_zdfosm ) THEN   ;   ioptio = ioptio + 1   ;    nzdf_phy = np_OSM   ;   CALL zdf_osm_init   ;   ENDIF
+      IF( ln_zdfric ) THEN   ;   ioptio = ioptio + 1   ;    nzdf_phy = np_RIC   ;   CALL zdf_ric_init          ;   ENDIF
+      IF( ln_zdftke ) THEN   ;   ioptio = ioptio + 1   ;    nzdf_phy = np_TKE   ;   CALL zdf_tke_init( Kmm )   ;   ENDIF
+      IF( ln_zdfgls ) THEN   ;   ioptio = ioptio + 1   ;    nzdf_phy = np_GLS   ;   CALL zdf_gls_init          ;   ENDIF
+      IF( ln_zdfosm ) THEN   ;   ioptio = ioptio + 1   ;    nzdf_phy = np_OSM   ;   CALL zdf_osm_init( Kmm )   ;   ENDIF
       !
       IF( ioptio /= 1 )    CALL ctl_stop( 'zdf_phy_init: one and only one vertical diffusion option has to be defined ' )
@@ -219,5 +219,5 @@
 
 
-   SUBROUTINE zdf_phy( kt )
+   SUBROUTINE zdf_phy( kt, Kbb, Kmm, Krhs )
       !!----------------------------------------------------------------------
       !!                     ***  ROUTINE zdf_phy  ***
@@ -231,5 +231,6 @@
       !!                bottom stress.....                               <<<<====verifier !
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER, INTENT(in) ::   kt         ! ocean time-step index
+      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs   ! ocean time level indices
       !
       INTEGER ::   ji, jj, jk   ! dummy loop indice
@@ -242,9 +243,9 @@
          !
          !                       !* bottom drag
-         CALL zdf_drg( kt, mbkt    , r_Cdmin_bot, r_Cdmax_bot,   &   ! <<== in 
+         CALL zdf_drg( kt, Kmm, mbkt , r_Cdmin_bot, r_Cdmax_bot,   &   ! <<== in 
             &              r_z0_bot,   r_ke0_bot,    rCd0_bot,   &
             &                                        rCdU_bot  )     ! ==>> out : bottom drag [m/s]
          IF( ln_isfcav ) THEN    !* top drag   (ocean cavities)
-            CALL zdf_drg( kt, mikt    , r_Cdmin_top, r_Cdmax_top,   &   ! <<== in 
+            CALL zdf_drg( kt, Kmm, mikt , r_Cdmin_top, r_Cdmax_top,   &   ! <<== in 
                &              r_z0_top,   r_ke0_top,    rCd0_top,   &
                &                                        rCdU_top  )     ! ==>> out : bottom drag [m/s]
@@ -255,12 +256,12 @@
       !
       IF( l_zdfsh2 )   &         !* shear production at w-points (energy conserving form)
-         CALL zdf_sh2( ub, vb, un, vn, avm_k,   &     ! <<== in
-            &                           zsh2    )     ! ==>> out : shear production
+         CALL zdf_sh2( Kbb, Kmm, avm_k,   &     ! <<== in
+            &                     zsh2    )     ! ==>> out : shear production
       !
       SELECT CASE ( nzdf_phy )                  !* Vertical eddy viscosity and diffusivity coefficients at w-points
-      CASE( np_RIC )   ;   CALL zdf_ric( kt, gdept_n, zsh2, avm_k, avt_k )    ! Richardson number dependent Kz
-      CASE( np_TKE )   ;   CALL zdf_tke( kt         , zsh2, avm_k, avt_k )    ! TKE closure scheme for Kz
-      CASE( np_GLS )   ;   CALL zdf_gls( kt         , zsh2, avm_k, avt_k )    ! GLS closure scheme for Kz
-      CASE( np_OSM )   ;   CALL zdf_osm( kt               , avm_k, avt_k )    ! OSMOSIS closure scheme for Kz
+      CASE( np_RIC )   ;   CALL zdf_ric( kt,      Kmm, zsh2, avm_k, avt_k )    ! Richardson number dependent Kz
+      CASE( np_TKE )   ;   CALL zdf_tke( kt, Kbb, Kmm, zsh2, avm_k, avt_k )    ! TKE closure scheme for Kz
+      CASE( np_GLS )   ;   CALL zdf_gls( kt, Kbb, Kmm, zsh2, avm_k, avt_k )    ! GLS closure scheme for Kz
+      CASE( np_OSM )   ;   CALL zdf_osm( kt, Kbb, Kmm, Krhs, avm_k, avt_k )    ! OSMOSIS closure scheme for Kz
 !     CASE( np_CST )                                  ! Constant Kz (reset avt, avm to the background value)
 !         ! avt_k and avm_k set one for all at initialisation phase
@@ -281,9 +282,9 @@
       ENDIF
       !
-      IF( ln_zdfevd )   CALL zdf_evd( kt, avm, avt )  !* convection: enhanced vertical eddy diffusivity
+      IF( ln_zdfevd )   CALL zdf_evd( kt, Kmm, Krhs, avm, avt )  !* convection: enhanced vertical eddy diffusivity
       !
       !                                         !* double diffusive mixing
       IF( ln_zdfddm ) THEN                            ! update avt and compute avs
-                        CALL zdf_ddm( kt, avm, avt, avs )
+                        CALL zdf_ddm( kt, Kmm,  avm, avt, avs )
       ELSE                                            ! same mixing on all tracers
          avs(2:jpim1,2:jpjm1,1:jpkm1) = avt(2:jpim1,2:jpjm1,1:jpkm1)
@@ -291,6 +292,6 @@
       !
       !                                         !* wave-induced mixing 
-      IF( ln_zdfswm )   CALL zdf_swm( kt, avm, avt, avs )   ! surface  wave (Qiao et al. 2004) 
-      IF( ln_zdfiwm )   CALL zdf_iwm( kt, avm, avt, avs )   ! internal wave (de Lavergne et al 2017)
+      IF( ln_zdfswm )   CALL zdf_swm( kt, Kmm, avm, avt, avs )   ! surface  wave (Qiao et al. 2004) 
+      IF( ln_zdfiwm )   CALL zdf_iwm( kt, Kmm, avm, avt, avs )   ! internal wave (de Lavergne et al 2017)
 
 #if defined key_agrif 
@@ -313,5 +314,5 @@
       ENDIF
       !
-      CALL zdf_mxl( kt )                        !* mixed layer depth, and level
+      CALL zdf_mxl( kt, Kmm )                        !* mixed layer depth, and level
       !
       IF( lrst_oce ) THEN                       !* write TKE, GLS or RIC fields in the restart file
@@ -319,5 +320,5 @@
          IF( ln_zdfgls )   CALL gls_rst( kt, 'WRITE' )
          IF( ln_zdfric )   CALL ric_rst( kt, 'WRITE' ) 
-         ! NB. OSMOSIS restart (osm_rst) will be called in step.F90 after wn has been updated
+         ! NB. OSMOSIS restart (osm_rst) will be called in step.F90 after ww has been updated
       ENDIF
       !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfric.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfric.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfric.F90	(revision 12928)
@@ -50,5 +50,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -78,9 +78,7 @@
       !!----------------------------------------------------------------------
       !
-      REWIND( numnam_ref )              ! Namelist namzdf_ric in reference namelist : Vertical diffusion Kz depends on Richardson number
       READ  ( numnam_ref, namzdf_ric, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_ric in reference namelist' )
 
-      REWIND( numnam_cfg )              ! Namelist namzdf_ric in configuration namelist : Vertical diffusion Kz depends on Richardson number
       READ  ( numnam_cfg, namzdf_ric, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namzdf_ric in configuration namelist' )
@@ -112,5 +110,5 @@
 
 
-   SUBROUTINE zdf_ric( kt, pdept, p_sh2, p_avm, p_avt )
+   SUBROUTINE zdf_ric( kt, Kmm, p_sh2, p_avm, p_avt )
       !!----------------------------------------------------------------------
       !!                 ***  ROUTINE zdfric  ***
@@ -125,5 +123,5 @@
       !!                    avt = avm0 / (1 + rn_alp*ri)
       !!                with ri  = N^2 / dz(u)**2
-      !!                         = e3w**2 * rn2/[ mi( dk(ub) )+mj( dk(vb) ) ]
+      !!                         = e3w**2 * rn2/[ mi( dk(uu(:,:,:,Kbb)) )+mj( dk(vv(:,:,:,Kbb)) ) ]
       !!                    avm0= rn_avmri / (1 + rn_alp*Ri)**nn_ric
       !!                where ri is the before local Richardson number,
@@ -152,5 +150,5 @@
       !!----------------------------------------------------------------------
       INTEGER                   , INTENT(in   ) ::   kt             ! ocean time-step
-      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pdept          ! depth of t-point  [m]
+      INTEGER                   , INTENT(in   ) ::   Kmm            ! ocean time level index
       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   p_sh2          ! shear production term
       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   p_avm, p_avt   ! momentum and tracer Kz (w-points)
@@ -162,15 +160,11 @@
       !
       !                       !==  avm and avt = F(Richardson number)  ==!
-      DO jk = 2, jpkm1
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1              ! coefficient = F(richardson number) (avm-weighted Ri)
-               zcfRi = 1._wp / (  1._wp + rn_alp * MAX(  0._wp , avm(ji,jj,jk) * rn2(ji,jj,jk) / ( p_sh2(ji,jj,jk) + 1.e-20 ) )  )
-               zav   = rn_avmri * zcfRi**nn_ric
-               !                          ! avm and avt coefficients
-               p_avm(ji,jj,jk) = MAX(  zav         , avmb(jk)  ) * wmask(ji,jj,jk)
-               p_avt(ji,jj,jk) = MAX(  zav * zcfRi , avtb(jk)  ) * wmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D_10_10( 2, jpkm1 )
+         zcfRi = 1._wp / (  1._wp + rn_alp * MAX(  0._wp , avm(ji,jj,jk) * rn2(ji,jj,jk) / ( p_sh2(ji,jj,jk) + 1.e-20 ) )  )
+         zav   = rn_avmri * zcfRi**nn_ric
+         !                          ! avm and avt coefficients
+         p_avm(ji,jj,jk) = MAX(  zav         , avmb(jk)  ) * wmask(ji,jj,jk)
+         p_avt(ji,jj,jk) = MAX(  zav * zcfRi , avtb(jk)  ) * wmask(ji,jj,jk)
+      END_3D
       !
 !!gm BUG <<<<====  This param can't work at low latitude 
@@ -179,21 +173,15 @@
       IF( ln_mldw ) THEN      !==  set a minimum value in the Ekman layer  ==!
          !
-         DO jj = 2, jpjm1        !* Ekman depth
-            DO ji = 2, jpim1
-               zustar = SQRT( taum(ji,jj) * r1_rau0 )
-               zhek   = rn_ekmfc * zustar / ( ABS( ff_t(ji,jj) ) + rsmall )   ! Ekman depth
-               zh_ekm(ji,jj) = MAX(  rn_mldmin , MIN( zhek , rn_mldmax )  )   ! set allowed range
-            END DO
-         END DO
-         DO jk = 2, jpkm1        !* minimum mixing coeff. within the Ekman layer
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  IF( pdept(ji,jj,jk) < zh_ekm(ji,jj) ) THEN
-                     p_avm(ji,jj,jk) = MAX(  p_avm(ji,jj,jk), rn_wvmix  ) * wmask(ji,jj,jk)
-                     p_avt(ji,jj,jk) = MAX(  p_avt(ji,jj,jk), rn_wtmix  ) * wmask(ji,jj,jk)
-                  ENDIF
-               END DO
-            END DO
-         END DO
+         DO_2D_00_00
+            zustar = SQRT( taum(ji,jj) * r1_rho0 )
+            zhek   = rn_ekmfc * zustar / ( ABS( ff_t(ji,jj) ) + rsmall )   ! Ekman depth
+            zh_ekm(ji,jj) = MAX(  rn_mldmin , MIN( zhek , rn_mldmax )  )   ! set allowed range
+         END_2D
+         DO_3D_00_00( 2, jpkm1 )
+            IF( gdept(ji,jj,jk,Kmm) < zh_ekm(ji,jj) ) THEN
+               p_avm(ji,jj,jk) = MAX(  p_avm(ji,jj,jk), rn_wvmix  ) * wmask(ji,jj,jk)
+               p_avt(ji,jj,jk) = MAX(  p_avt(ji,jj,jk), rn_wtmix  ) * wmask(ji,jj,jk)
+            ENDIF
+         END_3D
       ENDIF
       !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfsh2.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfsh2.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfsh2.F90	(revision 12928)
@@ -11,4 +11,5 @@
    !!   zdf_sh2       : compute mixing the shear production term of TKE
    !!----------------------------------------------------------------------
+   USE oce
    USE dom_oce        ! domain: ocean
    !
@@ -21,4 +22,6 @@
    PUBLIC   zdf_sh2        ! called by zdftke, zdfglf, and zdfric
    
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -28,5 +31,5 @@
 CONTAINS
 
-   SUBROUTINE zdf_sh2( pub, pvb, pun, pvn, p_avm, p_sh2  ) 
+   SUBROUTINE zdf_sh2( Kbb, Kmm, p_avm, p_sh2  ) 
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE zdf_sh2  ***
@@ -47,5 +50,5 @@
       !! References :   Bruchard, OM 2002
       !! ---------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:,:) , INTENT(in   ) ::   pub, pvb, pun, pvn   ! before, now horizontal velocities
+      INTEGER                    , INTENT(in   ) ::   Kbb, Kmm             ! ocean time level indices
       REAL(wp), DIMENSION(:,:,:) , INTENT(in   ) ::   p_avm                ! vertical eddy viscosity (w-points)
       REAL(wp), DIMENSION(:,:,:) , INTENT(  out) ::   p_sh2                ! shear production of TKE (w-points)
@@ -56,20 +59,16 @@
       !
       DO jk = 2, jpkm1
-         DO jj = 1, jpjm1        !* 2 x shear production at uw- and vw-points (energy conserving form)
-            DO ji = 1, jpim1
-               zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) &
-                  &         * (   pun(ji,jj,jk-1) -   pun(ji,jj,jk) ) &
-                  &         * (   pub(ji,jj,jk-1) -   pub(ji,jj,jk) ) / ( e3uw_n(ji,jj,jk) * e3uw_b(ji,jj,jk) ) * wumask(ji,jj,jk)
-               zsh2v(ji,jj) = ( p_avm(ji,jj+1,jk) + p_avm(ji,jj,jk) ) &
-                  &         * (   pvn(ji,jj,jk-1) -   pvn(ji,jj,jk) ) &
-                  &         * (   pvb(ji,jj,jk-1) -   pvb(ji,jj,jk) ) / ( e3vw_n(ji,jj,jk) * e3vw_b(ji,jj,jk) ) * wvmask(ji,jj,jk)
-            END DO
-         END DO
-         DO jj = 2, jpjm1        !* shear production at w-point
-            DO ji = 2, jpim1           ! coast mask: =2 at the coast ; =1 otherwise (NB: wmask useless as zsh2 are masked)
-               p_sh2(ji,jj,jk) = 0.25 * (   ( zsh2u(ji-1,jj) + zsh2u(ji,jj) ) * ( 2. - umask(ji-1,jj,jk) * umask(ji,jj,jk) )   &
-                  &                       + ( zsh2v(ji,jj-1) + zsh2v(ji,jj) ) * ( 2. - vmask(ji,jj-1,jk) * vmask(ji,jj,jk) )   )
-            END DO
-         END DO
+         DO_2D_10_10
+            zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) &
+               &         * (   uu(ji,jj,jk-1,Kmm) -   uu(ji,jj,jk,Kmm) ) &
+               &         * (   uu(ji,jj,jk-1,Kbb) -   uu(ji,jj,jk,Kbb) ) / ( e3uw(ji,jj,jk,Kmm) * e3uw(ji,jj,jk,Kbb) ) * wumask(ji,jj,jk)
+            zsh2v(ji,jj) = ( p_avm(ji,jj+1,jk) + p_avm(ji,jj,jk) ) &
+               &         * (   vv(ji,jj,jk-1,Kmm) -   vv(ji,jj,jk,Kmm) ) &
+               &         * (   vv(ji,jj,jk-1,Kbb) -   vv(ji,jj,jk,Kbb) ) / ( e3vw(ji,jj,jk,Kmm) * e3vw(ji,jj,jk,Kbb) ) * wvmask(ji,jj,jk)
+         END_2D
+         DO_2D_00_00
+            p_sh2(ji,jj,jk) = 0.25 * (   ( zsh2u(ji-1,jj) + zsh2u(ji,jj) ) * ( 2. - umask(ji-1,jj,jk) * umask(ji,jj,jk) )   &
+               &                       + ( zsh2v(ji,jj-1) + zsh2v(ji,jj) ) * ( 2. - vmask(ji,jj-1,jk) * vmask(ji,jj,jk) )   )
+         END_2D
       END DO 
       !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfswm.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfswm.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfswm.F90	(revision 12928)
@@ -27,4 +27,6 @@
    PUBLIC zdf_swm_init    ! routine called in zdf_phy_init
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -34,5 +36,5 @@
 CONTAINS
 
-   SUBROUTINE zdf_swm( kt, p_avm, p_avt, p_avs )
+   SUBROUTINE zdf_swm( kt, Kmm, p_avm, p_avt, p_avs )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE zdf_swm ***
@@ -52,4 +54,5 @@
       !!---------------------------------------------------------------------
       INTEGER                    , INTENT(in   ) ::   kt             ! ocean time step
+      INTEGER                    , INTENT(in   ) ::   Kmm            ! time level index
       REAL(wp), DIMENSION(:,:,:) , INTENT(inout) ::   p_avm          ! momentum Kz (w-points)
       REAL(wp), DIMENSION(:,:,:) , INTENT(inout) ::   p_avt, p_avs   ! tracer   Kz (w-points)
@@ -60,15 +63,11 @@
       !
       zcoef = 1._wp * 0.353553_wp
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               zqb = zcoef * hsw(ji,jj) * tsd2d(ji,jj) * EXP( -3. * wnum(ji,jj) * gdepw_n(ji,jj,jk) ) * wmask(ji,jj,jk)
-               !
-               p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zqb
-               p_avs(ji,jj,jk) = p_avs(ji,jj,jk) + zqb
-               p_avm(ji,jj,jk) = p_avm(ji,jj,jk) + zqb
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 2, jpkm1 )
+         zqb = zcoef * hsw(ji,jj) * tsd2d(ji,jj) * EXP( -3. * wnum(ji,jj) * gdepw(ji,jj,jk,Kmm) ) * wmask(ji,jj,jk)
+         !
+         p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zqb
+         p_avs(ji,jj,jk) = p_avs(ji,jj,jk) + zqb
+         p_avm(ji,jj,jk) = p_avm(ji,jj,jk) + zqb
+      END_3D
       !
    END SUBROUTINE zdf_swm
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdftke.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdftke.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdftke.F90	(revision 12928)
@@ -89,5 +89,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -109,5 +109,5 @@
 
 
-   SUBROUTINE zdf_tke( kt, p_sh2, p_avm, p_avt )
+   SUBROUTINE zdf_tke( kt, Kbb, Kmm, p_sh2, p_avm, p_avt )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE zdf_tke  ***
@@ -155,16 +155,17 @@
       !!----------------------------------------------------------------------
       INTEGER                   , INTENT(in   ) ::   kt             ! ocean time step
+      INTEGER                   , INTENT(in   ) ::   Kbb, Kmm       ! ocean time level indices
       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   p_sh2          ! shear production term
       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   p_avm, p_avt   !  momentum and tracer Kz (w-points)
       !!----------------------------------------------------------------------
       !
-      CALL tke_tke( gdepw_n, e3t_n, e3w_n, p_sh2, p_avm, p_avt )   ! now tke (en)
-      !
-      CALL tke_avn( gdepw_n, e3t_n, e3w_n,        p_avm, p_avt )   ! now avt, avm, dissl
+      CALL tke_tke( Kbb, Kmm, p_sh2, p_avm, p_avt )   ! now tke (en)
+      !
+      CALL tke_avn( Kbb, Kmm,        p_avm, p_avt )   ! now avt, avm, dissl
       !
   END SUBROUTINE zdf_tke
 
 
-   SUBROUTINE tke_tke( pdepw, p_e3t, p_e3w, p_sh2, p_avm, p_avt )
+   SUBROUTINE tke_tke( Kbb, Kmm, p_sh2, p_avm, p_avt )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE tke_tke  ***
@@ -186,6 +187,5 @@
       USE zdf_oce , ONLY : en   ! ocean vertical physics
       !!
-      REAL(wp), DIMENSION(:,:,:) , INTENT(in   ) ::   pdepw          ! depth of w-points
-      REAL(wp), DIMENSION(:,:,:) , INTENT(in   ) ::   p_e3t, p_e3w   ! level thickness (t- & w-points)
+      INTEGER                    , INTENT(in   ) ::   Kbb, Kmm       ! ocean time level indices
       REAL(wp), DIMENSION(:,:,:) , INTENT(in   ) ::   p_sh2          ! shear production term
       REAL(wp), DIMENSION(:,:,:) , INTENT(in   ) ::   p_avm, p_avt   ! vertical eddy viscosity & diffusivity (w-points)
@@ -206,7 +206,7 @@
       !!--------------------------------------------------------------------
       !
-      zbbrau = rn_ebb / rau0       ! Local constant initialisation
-      zfact1 = -.5_wp * rdt 
-      zfact2 = 1.5_wp * rdt * rn_ediss
+      zbbrau = rn_ebb / rho0       ! Local constant initialisation
+      zfact1 = -.5_wp * rn_Dt 
+      zfact2 = 1.5_wp * rn_Dt * rn_ediss
       zfact3 = 0.5_wp       * rn_ediss
       !
@@ -214,17 +214,8 @@
       !                     !  Surface/top/bottom boundary condition on tke
       !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-      
-      DO jj = 2, jpjm1            ! en(1)   = rn_ebb taum / rau0  (min value rn_emin0)
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1)
-         END DO
-      END DO
-      IF ( ln_isfcav ) THEN
-         DO jj = 2, jpjm1            ! en(mikt(ji,jj))   = rn_emin
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               en(ji,jj,mikt(ji,jj)) = rn_emin * tmask(ji,jj,1)
-            END DO
-         END DO
-      ENDIF
+      ! 
+      DO_2D_00_00
+         en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1)
+      END_2D
       !
       !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
@@ -232,5 +223,5 @@
       !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
       !
-      !   en(bot)   = (ebb0/rau0)*0.5*sqrt(u_botfr^2+v_botfr^2) (min value rn_emin)
+      !   en(bot)   = (ebb0/rho0)*0.5*sqrt(u_botfr^2+v_botfr^2) (min value rn_emin)
       ! where ebb0 does not includes surface wave enhancement (i.e. ebb0=3.75)
       ! Note that stress averaged is done using an wet-only calculation of u and v at t-point like in zdfsh2
@@ -238,25 +229,23 @@
       IF( ln_drg ) THEN       !== friction used as top/bottom boundary condition on TKE
          !
-         DO jj = 2, jpjm1           ! bottom friction
-            DO ji = fs_2, fs_jpim1     ! vector opt.
-               zmsku = ( 2. - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) )
-               zmskv = ( 2. - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) )
-               !                       ! where 0.001875 = (rn_ebb0/rau0) * 0.5 = 3.75*0.5/1000. (CAUTION CdU<0)
-               zebot = - 0.001875_wp * rCdU_bot(ji,jj) * SQRT(  ( zmsku*( ub(ji,jj,mbkt(ji,jj))+ub(ji-1,jj,mbkt(ji,jj)) ) )**2  &
-                  &                                           + ( zmskv*( vb(ji,jj,mbkt(ji,jj))+vb(ji,jj-1,mbkt(ji,jj)) ) )**2  )
-               en(ji,jj,mbkt(ji,jj)+1) = MAX( zebot, rn_emin ) * ssmask(ji,jj)
-            END DO
-         END DO
+         DO_2D_00_00
+            zmsku = ( 2. - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) )
+            zmskv = ( 2. - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) )
+            !                       ! where 0.001875 = (rn_ebb0/rho0) * 0.5 = 3.75*0.5/1000. (CAUTION CdU<0)
+            zebot = - 0.001875_wp * rCdU_bot(ji,jj) * SQRT(  ( zmsku*( uu(ji,jj,mbkt(ji,jj),Kbb)+uu(ji-1,jj,mbkt(ji,jj),Kbb) ) )**2  &
+               &                                           + ( zmskv*( vv(ji,jj,mbkt(ji,jj),Kbb)+vv(ji,jj-1,mbkt(ji,jj),Kbb) ) )**2  )
+            en(ji,jj,mbkt(ji,jj)+1) = MAX( zebot, rn_emin ) * ssmask(ji,jj)
+         END_2D
          IF( ln_isfcav ) THEN       ! top friction
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) )
-                  zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) )
-                  !                             ! where 0.001875 = (rn_ebb0/rau0) * 0.5 = 3.75*0.5/1000.  (CAUTION CdU<0)
-                  zetop = - 0.001875_wp * rCdU_top(ji,jj) * SQRT(  ( zmsku*( ub(ji,jj,mikt(ji,jj))+ub(ji-1,jj,mikt(ji,jj)) ) )**2  &
-                     &                                           + ( zmskv*( vb(ji,jj,mikt(ji,jj))+vb(ji,jj-1,mikt(ji,jj)) ) )**2  )
-                  en(ji,jj,mikt(ji,jj)) = MAX( zetop, rn_emin ) * (1._wp - tmask(ji,jj,1))   ! masked at ocean surface
-               END DO
-            END DO
+            DO_2D_00_00
+               zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) )
+               zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) )
+               !                             ! where 0.001875 = (rn_ebb0/rho0) * 0.5 = 3.75*0.5/1000.  (CAUTION CdU<0)
+               zetop = - 0.001875_wp * rCdU_top(ji,jj) * SQRT(  ( zmsku*( uu(ji,jj,mikt(ji,jj),Kbb)+uu(ji-1,jj,mikt(ji,jj),Kbb) ) )**2  &
+                  &                                           + ( zmskv*( vv(ji,jj,mikt(ji,jj),Kbb)+vv(ji,jj-1,mikt(ji,jj),Kbb) ) )**2  )
+               ! (1._wp - tmask(ji,jj,1)) * ssmask(ji,jj) = 1 where ice shelves are present
+               en(ji,jj,mikt(ji,jj)) = en(ji,jj,1)           * tmask(ji,jj,1) &
+                  &                  + MAX( zetop, rn_emin ) * (1._wp - tmask(ji,jj,1)) * ssmask(ji,jj)
+            END_2D
          ENDIF
          !
@@ -268,48 +257,36 @@
          !
          !                        !* total energy produce by LC : cumulative sum over jk
-         zpelc(:,:,1) =  MAX( rn2b(:,:,1), 0._wp ) * pdepw(:,:,1) * p_e3w(:,:,1)
+         zpelc(:,:,1) =  MAX( rn2b(:,:,1), 0._wp ) * gdepw(:,:,1,Kmm) * e3w(:,:,1,Kmm)
          DO jk = 2, jpk
-            zpelc(:,:,jk)  = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0._wp ) * pdepw(:,:,jk) * p_e3w(:,:,jk)
+            zpelc(:,:,jk)  = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0._wp ) * gdepw(:,:,jk,Kmm) * e3w(:,:,jk,Kmm)
          END DO
          !                        !* finite Langmuir Circulation depth
          zcof = 0.5 * 0.016 * 0.016 / ( zrhoa * zcdrag )
          imlc(:,:) = mbkt(:,:) + 1       ! Initialization to the number of w ocean point (=2 over land)
-         DO jk = jpkm1, 2, -1
-            DO jj = 1, jpj               ! Last w-level at which zpelc>=0.5*us*us 
-               DO ji = 1, jpi            !      with us=0.016*wind(starting from jpk-1)
-                  zus  = zcof * taum(ji,jj)
-                  IF( zpelc(ji,jj,jk) > zus )   imlc(ji,jj) = jk
-               END DO
-            END DO
-         END DO
+         DO_3DS_11_11( jpkm1, 2, -1 )
+            zus  = zcof * taum(ji,jj)
+            IF( zpelc(ji,jj,jk) > zus )   imlc(ji,jj) = jk
+         END_3D
          !                               ! finite LC depth
-         DO jj = 1, jpj 
-            DO ji = 1, jpi
-               zhlc(ji,jj) = pdepw(ji,jj,imlc(ji,jj))
-            END DO
-         END DO
+         DO_2D_11_11
+            zhlc(ji,jj) = gdepw(ji,jj,imlc(ji,jj),Kmm)
+         END_2D
          zcof = 0.016 / SQRT( zrhoa * zcdrag )
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zus  = zcof * SQRT( taum(ji,jj) )           ! Stokes drift
-               zfr_i(ji,jj) = ( 1._wp - 4._wp * fr_i(ji,jj) ) * zus * zus * zus * tmask(ji,jj,1) ! zus > 0. ok
-               IF (zfr_i(ji,jj) < 0. ) zfr_i(ji,jj) = 0.
-            END DO
-         END DO         
-         DO jk = 2, jpkm1         !* TKE Langmuir circulation source term added to en
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  IF ( zfr_i(ji,jj) /= 0. ) THEN               
-                     ! vertical velocity due to LC   
-                     IF ( pdepw(ji,jj,jk) - zhlc(ji,jj) < 0 .AND. wmask(ji,jj,jk) /= 0. ) THEN
-                        !                                           ! vertical velocity due to LC
-                        zwlc = rn_lc * SIN( rpi * pdepw(ji,jj,jk) / zhlc(ji,jj) )   ! warning: optimization: zus^3 is in zfr_i
-                        !                                           ! TKE Langmuir circulation source term
-                        en(ji,jj,jk) = en(ji,jj,jk) + rdt * zfr_i(ji,jj) * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj)
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         END DO
+         DO_2D_00_00
+            zus  = zcof * SQRT( taum(ji,jj) )           ! Stokes drift
+            zfr_i(ji,jj) = ( 1._wp - 4._wp * fr_i(ji,jj) ) * zus * zus * zus * tmask(ji,jj,1) ! zus > 0. ok
+            IF (zfr_i(ji,jj) < 0. ) zfr_i(ji,jj) = 0.
+         END_2D
+         DO_3D_00_00( 2, jpkm1 )
+            IF ( zfr_i(ji,jj) /= 0. ) THEN               
+               ! vertical velocity due to LC   
+               IF ( gdepw(ji,jj,jk,Kmm) - zhlc(ji,jj) < 0 .AND. wmask(ji,jj,jk) /= 0. ) THEN
+                  !                                           ! vertical velocity due to LC
+                  zwlc = rn_lc * SIN( rpi * gdepw(ji,jj,jk,Kmm) / zhlc(ji,jj) )   ! warning: optimization: zus^3 is in zfr_i
+                  !                                           ! TKE Langmuir circulation source term
+                  en(ji,jj,jk) = en(ji,jj,jk) + rn_Dt * zfr_i(ji,jj) * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj)
+               ENDIF
+            ENDIF
+         END_3D
          !
       ENDIF
@@ -323,78 +300,50 @@
       !
       IF( nn_pdl == 1 ) THEN      !* Prandtl number = F( Ri )
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  !                             ! local Richardson number
-                  zri = MAX( rn2b(ji,jj,jk), 0._wp ) * p_avm(ji,jj,jk) / ( p_sh2(ji,jj,jk) + rn_bshear )
-                  !                             ! inverse of Prandtl number
-                  apdlr(ji,jj,jk) = MAX(  0.1_wp,  ri_cri / MAX( ri_cri , zri )  )
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 2, jpkm1 )
+            !                             ! local Richardson number
+            zri = MAX( rn2b(ji,jj,jk), 0._wp ) * p_avm(ji,jj,jk) / ( p_sh2(ji,jj,jk) + rn_bshear )
+            !                             ! inverse of Prandtl number
+            apdlr(ji,jj,jk) = MAX(  0.1_wp,  ri_cri / MAX( ri_cri , zri )  )
+         END_3D
       ENDIF
       !         
-      DO jk = 2, jpkm1           !* Matrix and right hand side in en
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zcof   = zfact1 * tmask(ji,jj,jk)
-               !                                   ! A minimum of 2.e-5 m2/s is imposed on TKE vertical
-               !                                   ! eddy coefficient (ensure numerical stability)
-               zzd_up = zcof * MAX(  p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk  ) , 2.e-5_wp  )   &  ! upper diagonal
-                  &          /    (  p_e3t(ji,jj,jk  ) * p_e3w(ji,jj,jk  )  )
-               zzd_lw = zcof * MAX(  p_avm(ji,jj,jk  ) + p_avm(ji,jj,jk-1) , 2.e-5_wp  )   &  ! lower diagonal
-                  &          /    (  p_e3t(ji,jj,jk-1) * p_e3w(ji,jj,jk  )  )
-               !
-               zd_up(ji,jj,jk) = zzd_up            ! Matrix (zdiag, zd_up, zd_lw)
-               zd_lw(ji,jj,jk) = zzd_lw
-               zdiag(ji,jj,jk) = 1._wp - zzd_lw - zzd_up + zfact2 * dissl(ji,jj,jk) * wmask(ji,jj,jk)
-               !
-               !                                   ! right hand side in en
-               en(ji,jj,jk) = en(ji,jj,jk) + rdt * (  p_sh2(ji,jj,jk)                          &   ! shear
-                  &                                 - p_avt(ji,jj,jk) * rn2(ji,jj,jk)          &   ! stratification
-                  &                                 + zfact3 * dissl(ji,jj,jk) * en(ji,jj,jk)  &   ! dissipation
-                  &                                ) * wmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 2, jpkm1 )
+         zcof   = zfact1 * tmask(ji,jj,jk)
+         !                                   ! A minimum of 2.e-5 m2/s is imposed on TKE vertical
+         !                                   ! eddy coefficient (ensure numerical stability)
+         zzd_up = zcof * MAX(  p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk  ) , 2.e-5_wp  )   &  ! upper diagonal
+            &          /    (  e3t(ji,jj,jk  ,Kmm) * e3w(ji,jj,jk  ,Kmm)  )
+         zzd_lw = zcof * MAX(  p_avm(ji,jj,jk  ) + p_avm(ji,jj,jk-1) , 2.e-5_wp  )   &  ! lower diagonal
+            &          /    (  e3t(ji,jj,jk-1,Kmm) * e3w(ji,jj,jk  ,Kmm)  )
+         !
+         zd_up(ji,jj,jk) = zzd_up            ! Matrix (zdiag, zd_up, zd_lw)
+         zd_lw(ji,jj,jk) = zzd_lw
+         zdiag(ji,jj,jk) = 1._wp - zzd_lw - zzd_up + zfact2 * dissl(ji,jj,jk) * wmask(ji,jj,jk)
+         !
+         !                                   ! right hand side in en
+         en(ji,jj,jk) = en(ji,jj,jk) + rn_Dt * (  p_sh2(ji,jj,jk)                        &   ! shear
+            &                                 - p_avt(ji,jj,jk) * rn2(ji,jj,jk)          &   ! stratification
+            &                                 + zfact3 * dissl(ji,jj,jk) * en(ji,jj,jk)  &   ! dissipation
+            &                                ) * wmask(ji,jj,jk)
+      END_3D
       !                          !* Matrix inversion from level 2 (tke prescribed at level 1)
-      DO jk = 3, jpkm1                             ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1    ! vector opt.
-               zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-      DO jj = 2, jpjm1                             ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(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.
-               zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) *zd_lw(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-      DO jj = 2, jpjm1                             ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            en(ji,jj,jpkm1) = zd_lw(ji,jj,jpkm1) / zdiag(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) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-      DO jk = 2, jpkm1                             ! set the minimum value of tke
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) * wmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 3, jpkm1 )
+         zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1)
+      END_3D
+      DO_2D_00_00
+         zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1)    ! Surface boudary conditions on tke
+      END_2D
+      DO_3D_00_00( 3, jpkm1 )
+         zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) *zd_lw(ji,jj,jk-1)
+      END_3D
+      DO_2D_00_00
+         en(ji,jj,jpkm1) = zd_lw(ji,jj,jpkm1) / zdiag(ji,jj,jpkm1)
+      END_2D
+      DO_3DS_00_00( jpk-2, 2, -1 )
+         en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk)
+      END_3D
+      DO_3D_00_00( 2, jpkm1 )
+         en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) * wmask(ji,jj,jk)
+      END_3D
       !
       !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
@@ -402,38 +351,28 @@
       !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 !!gm BUG : in the exp  remove the depth of ssh !!!
-!!gm       i.e. use gde3w in argument (pdepw)
+!!gm       i.e. use gde3w in argument (gdepw(:,:,:,Kmm))
       
       
       IF( nn_etau == 1 ) THEN           !* penetration below the mixed layer (rn_efr fraction)
-         DO jk = 2, jpkm1                       ! rn_eice =0 ON below sea-ice, =4 OFF when ice fraction > 0.25
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) )   &
-                     &                                 * MAX(0.,1._wp - rn_eice *fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 2, jpkm1 )
+            en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) )   &
+               &                                 * MAX(0.,1._wp - rn_eice *fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1)
+         END_3D
       ELSEIF( nn_etau == 2 ) THEN       !* act only at the base of the mixed layer (jk=nmln)  (rn_efr fraction)
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               jk = nmln(ji,jj)
-               en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) )   &
-                  &                                 * MAX(0.,1._wp - rn_eice *fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1)
-            END DO
-         END DO
+         DO_2D_00_00
+            jk = nmln(ji,jj)
+            en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) )   &
+               &                                 * MAX(0.,1._wp - rn_eice *fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1)
+         END_2D
       ELSEIF( nn_etau == 3 ) THEN       !* penetration belox the mixed layer (HF variability)
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ztx2 = utau(ji-1,jj  ) + utau(ji,jj)
-                  zty2 = vtau(ji  ,jj-1) + vtau(ji,jj)
-                  ztau = 0.5_wp * SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask(ji,jj,1)    ! module of the mean stress 
-                  zdif = taum(ji,jj) - ztau                            ! mean of modulus - modulus of the mean 
-                  zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add )  ! apply some modifications...
-                  en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) )   &
-                     &                        * MAX(0.,1._wp - rn_eice *fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 2, jpkm1 )
+            ztx2 = utau(ji-1,jj  ) + utau(ji,jj)
+            zty2 = vtau(ji  ,jj-1) + vtau(ji,jj)
+            ztau = 0.5_wp * SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask(ji,jj,1)    ! module of the mean stress 
+            zdif = taum(ji,jj) - ztau                            ! mean of modulus - modulus of the mean 
+            zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add )  ! apply some modifications...
+            en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) )   &
+               &                        * MAX(0.,1._wp - rn_eice *fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1)
+         END_3D
       ENDIF
       !
@@ -441,5 +380,5 @@
 
 
-   SUBROUTINE tke_avn( pdepw, p_e3t, p_e3w, p_avm, p_avt )
+   SUBROUTINE tke_avn( Kbb, Kmm, p_avm, p_avt )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE tke_avn  ***
@@ -477,6 +416,5 @@
       USE zdf_oce , ONLY : en, avtb, avmb, avtb_2d   ! ocean vertical physics
       !!
-      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pdepw          ! depth (w-points)
-      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   p_e3t, p_e3w   ! level thickness (t- & w-points)
+      INTEGER                   , INTENT(in   ) ::   Kbb, Kmm       ! ocean time level indices
       REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_avm, p_avt   ! vertical eddy viscosity & diffusivity (w-points)
       !
@@ -498,23 +436,17 @@
       zmxld(:,:,:)  = rmxl_min
       !
-      IF( ln_mxl0 ) THEN            ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rau0*g)
-         zraug = vkarmn * 2.e5_wp / ( rau0 * grav )
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               zmxlm(ji,jj,1) = MAX( rn_mxl0, zraug * taum(ji,jj) * tmask(ji,jj,1) )
-            END DO
-         END DO
+      IF( ln_mxl0 ) THEN            ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rho0*g)
+         zraug = vkarmn * 2.e5_wp / ( rho0 * grav )
+         DO_2D_00_00
+            zmxlm(ji,jj,1) = MAX( rn_mxl0, zraug * taum(ji,jj) * tmask(ji,jj,1) )
+         END_2D
       ELSE 
          zmxlm(:,:,1) = rn_mxl0
       ENDIF
       !
-      DO jk = 2, jpkm1              ! interior value : l=sqrt(2*e/n^2)
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zrn2 = MAX( rn2(ji,jj,jk), rsmall )
-               zmxlm(ji,jj,jk) = MAX(  rmxl_min,  SQRT( 2._wp * en(ji,jj,jk) / zrn2 )  )
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 2, jpkm1 )
+         zrn2 = MAX( rn2(ji,jj,jk), rsmall )
+         zmxlm(ji,jj,jk) = MAX(  rmxl_min,  SQRT( 2._wp * en(ji,jj,jk) / zrn2 )  )
+      END_3D
       !
       !                     !* Physical limits for the mixing length
@@ -526,72 +458,44 @@
       !
  !!gm Not sure of that coding for ISF....
-      ! where wmask = 0 set zmxlm == p_e3w
+      ! where wmask = 0 set zmxlm == e3w(:,:,:,Kmm)
       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( pdepw(ji,jj,jk) - pdepw(ji,jj,mikt(ji,jj)), zmxlm(ji,jj,jk),   &
-                  &            pdepw(ji,jj,mbkt(ji,jj)+1) - pdepw(ji,jj,jk) )
-                  ! wmask prevent zmxlm = 0 if jk = mikt(ji,jj)
-                  zmxlm(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN( zmxlm(ji,jj,jk) , p_e3w(ji,jj,jk) ) * (1 - wmask(ji,jj,jk))
-                  zmxld(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN( zmxlm(ji,jj,jk) , p_e3w(ji,jj,jk) ) * (1 - wmask(ji,jj,jk))
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 2, jpkm1 )
+            zemxl = MIN( gdepw(ji,jj,jk,Kmm) - gdepw(ji,jj,mikt(ji,jj),Kmm), zmxlm(ji,jj,jk),   &
+            &            gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) - gdepw(ji,jj,jk,Kmm) )
+            ! wmask prevent zmxlm = 0 if jk = mikt(ji,jj)
+            zmxlm(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN( zmxlm(ji,jj,jk) , e3w(ji,jj,jk,Kmm) ) * (1 - wmask(ji,jj,jk))
+            zmxld(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN( zmxlm(ji,jj,jk) , e3w(ji,jj,jk,Kmm) ) * (1 - wmask(ji,jj,jk))
+         END_3D
          !
       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( p_e3w(ji,jj,jk), zmxlm(ji,jj,jk) )
-                  zmxlm(ji,jj,jk) = zemxl
-                  zmxld(ji,jj,jk) = zemxl
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 2, jpkm1 )
+            zemxl = MIN( e3w(ji,jj,jk,Kmm), zmxlm(ji,jj,jk) )
+            zmxlm(ji,jj,jk) = zemxl
+            zmxld(ji,jj,jk) = zemxl
+         END_3D
          !
       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) + p_e3t(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) + p_e3t(ji,jj,jk+1), zmxlm(ji,jj,jk) )
-                  zmxlm(ji,jj,jk) = zemxl
-                  zmxld(ji,jj,jk) = zemxl
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 2, jpkm1 )
+            zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk-1) + e3t(ji,jj,jk-1,Kmm), zmxlm(ji,jj,jk) )
+         END_3D
+         DO_3DS_00_00( jpkm1, 2, -1 )
+            zemxl = MIN( zmxlm(ji,jj,jk+1) + e3t(ji,jj,jk+1,Kmm), zmxlm(ji,jj,jk) )
+            zmxlm(ji,jj,jk) = zemxl
+            zmxld(ji,jj,jk) = zemxl
+         END_3D
          !
       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) + p_e3t(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) + p_e3t(ji,jj,jk+1), zmxlm(ji,jj,jk) )
-               END DO
-            END DO
-         END DO
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               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
+         DO_3D_00_00( 2, jpkm1 )
+            zmxld(ji,jj,jk) = MIN( zmxld(ji,jj,jk-1) + e3t(ji,jj,jk-1,Kmm), zmxlm(ji,jj,jk) )
+         END_3D
+         DO_3DS_00_00( jpkm1, 2, -1 )
+            zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk+1) + e3t(ji,jj,jk+1,Kmm), zmxlm(ji,jj,jk) )
+         END_3D
+         DO_3D_00_00( 2, jpkm1 )
+            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_3D
          !
       END SELECT
@@ -600,28 +504,20 @@
       !                     !  Vertical eddy viscosity and diffusivity  (avm and avt)
       !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-      DO jk = 1, jpkm1            !* vertical eddy viscosity & diffivity at w-points
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zsqen = SQRT( en(ji,jj,jk) )
-               zav   = rn_ediff * zmxlm(ji,jj,jk) * zsqen
-               p_avm(ji,jj,jk) = MAX( zav,                  avmb(jk) ) * wmask(ji,jj,jk)
-               p_avt(ji,jj,jk) = MAX( zav, avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk)
-               dissl(ji,jj,jk) = zsqen / zmxld(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 1, jpkm1 )
+         zsqen = SQRT( en(ji,jj,jk) )
+         zav   = rn_ediff * zmxlm(ji,jj,jk) * zsqen
+         p_avm(ji,jj,jk) = MAX( zav,                  avmb(jk) ) * wmask(ji,jj,jk)
+         p_avt(ji,jj,jk) = MAX( zav, avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk)
+         dissl(ji,jj,jk) = zsqen / zmxld(ji,jj,jk)
+      END_3D
       !
       !
       IF( nn_pdl == 1 ) THEN      !* Prandtl number case: update avt
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  p_avt(ji,jj,jk)   = MAX( apdlr(ji,jj,jk) * p_avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * tmask(ji,jj,jk)
-              END DO
-            END DO
-         END DO
-      ENDIF
-      !
-      IF(ln_ctl) THEN
+         DO_3D_00_00( 2, jpkm1 )
+            p_avt(ji,jj,jk)   = MAX( apdlr(ji,jj,jk) * p_avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk)
+         END_3D
+      ENDIF
+      !
+      IF(sn_cfctl%l_prtctl) THEN
          CALL prt_ctl( tab3d_1=en   , clinfo1=' tke  - e: ', tab3d_2=p_avt, clinfo2=' t: ', kdim=jpk)
          CALL prt_ctl( tab3d_1=p_avm, clinfo1=' tke  - m: ', kdim=jpk )
@@ -631,5 +527,5 @@
 
 
-   SUBROUTINE zdf_tke_init
+   SUBROUTINE zdf_tke_init( Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE zdf_tke_init  ***
@@ -647,6 +543,7 @@
       USE zdf_oce , ONLY : ln_zdfiwm   ! Internal Wave Mixing flag
       !!
-      INTEGER ::   ji, jj, jk   ! dummy loop indices
-      INTEGER ::   ios
+      INTEGER, INTENT(in) ::   Kmm          ! time level index
+      INTEGER             ::   ji, jj, jk   ! dummy loop indices
+      INTEGER             ::   ios
       !!
       NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb , rn_emin  ,          &
@@ -656,9 +553,7 @@
       !!----------------------------------------------------------------------
       !
-      REWIND( numnam_ref )              ! Namelist namzdf_tke in reference namelist : Turbulent Kinetic Energy
       READ  ( numnam_ref, namzdf_tke, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_tke in reference namelist' )
 
-      REWIND( numnam_cfg )              ! Namelist namzdf_tke in configuration namelist : Turbulent Kinetic Energy
       READ  ( numnam_cfg, namzdf_tke, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namzdf_tke in configuration namelist' )
@@ -725,5 +620,5 @@
       ENDIF
       
-      IF( nn_etau == 2  )   CALL zdf_mxl( nit000 )      ! Initialization of nmln 
+      IF( nn_etau == 2  )   CALL zdf_mxl( nit000, Kmm )      ! Initialization of nmln 
 
       !                               !* depth of penetration of surface tke
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/do_loop_substitute.h90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/do_loop_substitute.h90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/do_loop_substitute.h90	(revision 12928)
@@ -0,0 +1,103 @@
+#if defined show_comments
+! These comments are not intended to be retained during preprocessing; i.e. do not define "show_comments"
+!!----------------------------------------------------------------------
+!! NEMO/OCE 4.0 , NEMO Consortium (2018)
+!! Software governed by the CeCILL license (see ./LICENSE)
+!!----------------------------------------------------------------------
+! This header file contains preprocessor definitions and macros used in the do-loop substitutions introduced
+! between version 4.0 and 4.2. The primary aim of these macros is to assist in future applications of tiling
+! to improve performance. This is expected to be achieved by alternative versions of these macros in selected
+! locations. The initial introduction of these macros simply replaces all identifiable nested 2D- and 3D-loops
+! with single line statements (and adjusts indenting accordingly). Do loops are identifiable if they comform
+! to either:
+!                                       DO jk = ....
+!   DO jj = ....                           DO jj = ...
+!      DO ji = ....                           DO ji = ...
+!         .                   OR                 .  
+!         .                                      .
+!     END DO                                  END DO
+!   END DO                                 END DO
+!                                       END DO
+! and white-space variants thereof.
+!
+! Additionally, only loops with recognised jj and ji loops limits are treated; these are:
+! Lower limits of 1, 2 or fs_2
+! Upper limits of jpi, jpim1 or fs_jpim1 (for ji) or jpj, jpjm1 or fs_jpjm1 (for jj)
+!
+! The macro naming convention takes the form: DO_2D_BT_LR where: 
+!   B is the Bottom offset from the PE's inner domain;
+!   T is the Top    offset from the PE's inner domain;
+!   L is the Left   offset from the PE's inner domain;
+!   R is the Right  offset from the PE's inner domain
+!
+! So, given an inner domain of 2,jpim1 and 2,jpjm1, a typical example would replace:
+! 
+!   DO jj = 2, jpj
+!      DO ji = 1, jpim1
+!         .
+!         .
+!      END DO
+!   END DO
+!
+! with:
+!
+!   DO_2D_01_10
+!      .
+!      .
+!   END_2D
+! 
+! similar conventions apply to the 3D loops macros. jk loop limits are retained through macro arguments and are not restricted. This
+! includes the possibility of strides for which an extra set of DO_3DS macros are defined.
+!
+! In the following definitions the inner PE domain is defined by start indices of (___kIs_, __kJs_) and end indices of (__kIe_, __kJe_)
+! The following macros are defined just below: ___kIs_, __kJs_, ___kIsm1_, __kJsm1_, ___kIe_, __kJe_, ___kIep1_, __kJep1_. 
+! These names are chosen to, hopefully, avoid any future, unintended matches elsewhere in the code.
+!
+#endif
+#define __kIs_     2
+#define __kJs_     2
+#define __kIsm1_   1
+#define __kJsm1_   1
+
+#define __kIe_     jpim1
+#define __kJe_     jpjm1
+#define __kIep1_   jpi
+#define __kJep1_   jpj
+
+#define DO_2D_00_00   DO jj = __kJs_, __kJe_   ;   DO ji = __kIs_, __kIe_
+#define DO_2D_00_01   DO jj = __kJs_, __kJe_   ;   DO ji = __kIs_, __kIep1_
+#define DO_2D_00_10   DO jj = __kJs_, __kJe_   ;   DO ji = __kIsm1_, __kIe_
+#define DO_2D_00_11   DO jj = __kJs_, __kJe_   ;   DO ji = __kIsm1_, __kIep1_
+ 
+#define DO_2D_01_00   DO jj = __kJs_, __kJep1_   ;   DO ji = __kIs_, __kIe_
+#define DO_2D_01_01   DO jj = __kJs_, __kJep1_   ;   DO ji = __kIs_, __kIep1_
+#define DO_2D_01_10   DO jj = __kJs_, __kJep1_   ;   DO ji = __kIsm1_, __kIe_
+#define DO_2D_01_11   DO jj = __kJs_, __kJep1_   ;   DO ji = __kIsm1_, __kIep1_
+ 
+#define DO_2D_10_00   DO jj = __kJsm1_, __kJe_   ;   DO ji = __kIs_, __kIe_
+#define DO_2D_10_10   DO jj = __kJsm1_, __kJe_   ;   DO ji = __kIsm1_, __kIe_
+#define DO_2D_10_11   DO jj = __kJsm1_, __kJe_   ;   DO ji = __kIsm1_, __kIep1_
+ 
+#define DO_2D_11_00   DO jj = __kJsm1_, __kJep1_   ;   DO ji = __kIs_, __kIe_
+#define DO_2D_11_01   DO jj = __kJsm1_, __kJep1_   ;   DO ji = __kIs_, __kIep1_
+#define DO_2D_11_10   DO jj = __kJsm1_, __kJep1_   ;   DO ji = __kIsm1_, __kIe_
+#define DO_2D_11_11   DO jj = __kJsm1_, __kJep1_   ;   DO ji = __kIsm1_, __kIep1_
+
+#define DO_3D_00_00(ks,ke)   DO jk = ks, ke   ;   DO_2D_00_00
+#define DO_3D_00_10(ks,ke)   DO jk = ks, ke   ;   DO_2D_00_10
+ 
+#define DO_3D_01_01(ks,ke)   DO jk = ks, ke   ;   DO_2D_01_01
+ 
+#define DO_3D_10_00(ks,ke)   DO jk = ks, ke   ;   DO_2D_10_00
+#define DO_3D_10_10(ks,ke)   DO jk = ks, ke   ;   DO_2D_10_10
+#define DO_3D_10_11(ks,ke)   DO jk = ks, ke   ;   DO_2D_10_11
+ 
+#define DO_3D_11_11(ks,ke)   DO jk = ks, ke   ;   DO_2D_11_11
+
+#define DO_3DS_00_00(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_00_00
+#define DO_3DS_01_01(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_01_01
+#define DO_3DS_10_10(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_10_10
+#define DO_3DS_11_11(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_11_11
+
+#define END_2D   END DO   ;   END DO
+#define END_3D   END DO   ;   END DO   ;   END DO
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/lib_fortran.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/lib_fortran.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/lib_fortran.F90	(revision 12928)
@@ -63,4 +63,6 @@
 #endif
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -215,64 +217,60 @@
       IF( SIZE(p2d,2) /= jpj ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_2d, the second dimension is not equal to jpj' ) 
       !
-      DO jj = 1, jpj
-         DO ji = 1, jpi 
+      DO_2D_11_11
+         IF( MOD(mig(ji), 3) == 1 .AND. MOD(mjg(jj), 3) == 1 ) THEN   ! bottom left corber of a 3x3 box
+            ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1                  ! right position of the box
+            jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1                  ! upper position of the box
+            IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN                    ! the box is fully included in the local mpi domain
+               p2d(ji:ji2,jj:jj2) = SUM(p2d(ji:ji2,jj:jj2))
+            ENDIF
+         ENDIF
+      END_2D
+      CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1. )
+      IF( nbondi /= -1 ) THEN
+         IF( MOD(mig(    1), 3) == 1 )   p2d(    1,:) = p2d(    2,:)
+         IF( MOD(mig(    1), 3) == 2 )   p2d(    2,:) = p2d(    1,:)
+      ENDIF
+      IF( nbondi /=  1 ) THEN
+         IF( MOD(mig(jpi-2), 3) == 1 )   p2d(  jpi,:) = p2d(jpi-1,:)
+         IF( MOD(mig(jpi-2), 3) == 0 )   p2d(jpi-1,:) = p2d(  jpi,:)
+      ENDIF
+      IF( nbondj /= -1 ) THEN
+         IF( MOD(mjg(    1), 3) == 1 )   p2d(:,    1) = p2d(:,    2)
+         IF( MOD(mjg(    1), 3) == 2 )   p2d(:,    2) = p2d(:,    1)
+      ENDIF
+      IF( nbondj /=  1 ) THEN
+         IF( MOD(mjg(jpj-2), 3) == 1 )   p2d(:,  jpj) = p2d(:,jpj-1)
+         IF( MOD(mjg(jpj-2), 3) == 0 )   p2d(:,jpj-1) = p2d(:,  jpj)
+      ENDIF
+      CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1. )
+
+   END SUBROUTINE sum3x3_2d
+
+   SUBROUTINE sum3x3_3d( p3d )
+      !!-----------------------------------------------------------------------
+      !!                  ***  routine sum3x3_3d  ***
+      !!
+      !! ** Purpose : sum over 3x3 boxes
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION (:,:,:), INTENT(inout) ::   p3d
+      !
+      INTEGER ::   ji, ji2, jj, jj2, jn     ! dummy loop indices
+      INTEGER ::   ipn                      ! Third dimension size
+      !!----------------------------------------------------------------------
+      !
+      IF( SIZE(p3d,1) /= jpi ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_3d, the first dimension is not equal to jpi' ) 
+      IF( SIZE(p3d,2) /= jpj ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_3d, the second dimension is not equal to jpj' ) 
+      ipn = SIZE(p3d,3)
+      !
+      DO jn = 1, ipn
+         DO_2D_11_11
             IF( MOD(mig(ji), 3) == 1 .AND. MOD(mjg(jj), 3) == 1 ) THEN   ! bottom left corber of a 3x3 box
                ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1                  ! right position of the box
                jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1                  ! upper position of the box
                IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN                    ! the box is fully included in the local mpi domain
-                  p2d(ji:ji2,jj:jj2) = SUM(p2d(ji:ji2,jj:jj2))
+                  p3d(ji:ji2,jj:jj2,jn) = SUM(p3d(ji:ji2,jj:jj2,jn))
                ENDIF
             ENDIF
-         END DO
-      END DO
-      CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1. )
-      IF( nbondi /= -1 ) THEN
-         IF( MOD(mig(    1), 3) == 1 )   p2d(    1,:) = p2d(    2,:)
-         IF( MOD(mig(    1), 3) == 2 )   p2d(    2,:) = p2d(    1,:)
-      ENDIF
-      IF( nbondi /=  1 ) THEN
-         IF( MOD(mig(jpi-2), 3) == 1 )   p2d(  jpi,:) = p2d(jpi-1,:)
-         IF( MOD(mig(jpi-2), 3) == 0 )   p2d(jpi-1,:) = p2d(  jpi,:)
-      ENDIF
-      IF( nbondj /= -1 ) THEN
-         IF( MOD(mjg(    1), 3) == 1 )   p2d(:,    1) = p2d(:,    2)
-         IF( MOD(mjg(    1), 3) == 2 )   p2d(:,    2) = p2d(:,    1)
-      ENDIF
-      IF( nbondj /=  1 ) THEN
-         IF( MOD(mjg(jpj-2), 3) == 1 )   p2d(:,  jpj) = p2d(:,jpj-1)
-         IF( MOD(mjg(jpj-2), 3) == 0 )   p2d(:,jpj-1) = p2d(:,  jpj)
-      ENDIF
-      CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1. )
-
-   END SUBROUTINE sum3x3_2d
-
-   SUBROUTINE sum3x3_3d( p3d )
-      !!-----------------------------------------------------------------------
-      !!                  ***  routine sum3x3_3d  ***
-      !!
-      !! ** Purpose : sum over 3x3 boxes
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION (:,:,:), INTENT(inout) ::   p3d
-      !
-      INTEGER ::   ji, ji2, jj, jj2, jn     ! dummy loop indices
-      INTEGER ::   ipn                      ! Third dimension size
-      !!----------------------------------------------------------------------
-      !
-      IF( SIZE(p3d,1) /= jpi ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_3d, the first dimension is not equal to jpi' ) 
-      IF( SIZE(p3d,2) /= jpj ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_3d, the second dimension is not equal to jpj' ) 
-      ipn = SIZE(p3d,3)
-      !
-      DO jn = 1, ipn
-         DO jj = 1, jpj
-            DO ji = 1, jpi 
-               IF( MOD(mig(ji), 3) == 1 .AND. MOD(mjg(jj), 3) == 1 ) THEN   ! bottom left corber of a 3x3 box
-                  ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1                  ! right position of the box
-                  jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1                  ! upper position of the box
-                  IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN                    ! the box is fully included in the local mpi domain
-                     p3d(ji:ji2,jj:jj2,jn) = SUM(p3d(ji:ji2,jj:jj2,jn))
-                  ENDIF
-               ENDIF
-            END DO
-         END DO
+         END_2D
       END DO
       CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1. )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/nemogcm.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/nemogcm.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/nemogcm.F90	(revision 12928)
@@ -46,5 +46,5 @@
    USE closea         ! treatment of closed seas (for ln_closea)
    USE usrdef_nam     ! user defined configuration
-   USE tideini        ! tidal components initialization   (tide_ini routine)
+   USE tide_mod, ONLY : tide_init ! tidal components initialization   (tide_init routine)
    USE bdy_oce,  ONLY : ln_bdy
    USE bdyini         ! open boundary cond. setting       (bdy_init routine)
@@ -59,6 +59,7 @@
    USE diaobs         ! Observation diagnostics       (dia_obs_init routine)
    USE diacfl         ! CFL diagnostics               (dia_cfl_init routine)
-   USE diaharm        ! tidal harmonics diagnostics  (dia_harm_init routine)
+   USE diamlr         ! IOM context management for multiple-linear-regression analysis
    USE step           ! NEMO time-stepping                 (stp     routine)
+   USE isfstp         ! ice shelf                     (isf_stp_init routine)
    USE icbini         ! handle bergs, initialisation
    USE icbstp         ! handle bergs, calving, themodynamics and transport
@@ -69,9 +70,9 @@
    USE stopar         ! Stochastic param.: ???
    USE stopts         ! Stochastic param.: ???
-   USE diurnal_bulk   ! diurnal bulk SST 
+   USE diu_layers     ! diurnal bulk SST and coolskin
    USE step_diu       ! diurnal bulk SST timestepping (called from here if run offline)
    USE crsini         ! initialise grid coarsening utility
-   USE diatmb         ! Top,middle,bottom output
    USE dia25h         ! 25h mean output
+   USE diadetide      ! Weights computation for daily detiding of model diagnostics
    USE sbc_oce , ONLY : lk_oasis
    USE wet_dry        ! Wetting and drying setting   (wad_init routine)
@@ -83,4 +84,5 @@
 #endif
    !
+   USE in_out_manager ! I/O manager
    USE lib_mpp        ! distributed memory computing
    USE mppini         ! shared/distributed memory setting (mpp_init routine)
@@ -140,4 +142,5 @@
       !                            !-----------------------!
 #if defined key_agrif
+      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices
       CALL Agrif_Declare_Var_dom   ! AGRIF: set the meshes for DOM
       CALL Agrif_Declare_Var       !  "      "   "   "      "  DYN/TRA 
@@ -158,4 +161,7 @@
       !                            !==   time stepping   ==!
       !                            !-----------------------!
+      !
+      !                                               !== set the model time-step  ==!
+      !
       istp = nit000
       !
@@ -172,4 +178,5 @@
       !
       ! Recursive update from highest nested level to lowest:
+      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices
       CALL Agrif_step_child_adj(Agrif_Update_All)
       !
@@ -263,5 +270,5 @@
       INTEGER ::   ios, ilocal_comm   ! local integers
       !!
-      NAMELIST/namctl/ ln_ctl   , sn_cfctl, nn_print, nn_ictls, nn_ictle,   &
+      NAMELIST/namctl/ sn_cfctl,  nn_print, nn_ictls, nn_ictle,             &
          &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,             &
          &             ln_timing, ln_diacfl
@@ -307,22 +314,43 @@
       IF( lwm )   CALL ctl_opn(     numout,        'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
       ! open reference and configuration namelist files
-                  CALL ctl_opn( numnam_ref,        'namelist_ref',     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
-                  CALL ctl_opn( numnam_cfg,        'namelist_cfg',     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
+                  CALL load_nml( numnam_ref,        'namelist_ref',                                           -1, lwm )
+                  CALL load_nml( numnam_cfg,        'namelist_cfg',                                           -1, lwm )
       IF( lwm )   CALL ctl_opn(     numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
       ! open /dev/null file to be able to supress output write easily
+      IF( Agrif_Root() ) THEN
                   CALL ctl_opn(     numnul,           '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
-      !
+#ifdef key_agrif
+      ELSE
+                  numnul = Agrif_Parent(numnul)   
+#endif
+      ENDIF
       !                             !--------------------!
-      !                             ! Open listing units !  -> need ln_ctl from namctl to define lwp
+      !                             ! Open listing units !  -> need sn_cfctl from namctl to define lwp
       !                             !--------------------!
       !
-      REWIND( numnam_ref )              ! Namelist namctl in reference namelist
       READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namctl in reference namelist' )
-      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist
       READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namctl in configuration namelist' )
       !
-      lwp = (narea == 1) .OR. ln_ctl    ! control of all listing output print
+      ! finalize the definition of namctl variables
+      IF( sn_cfctl%l_allon ) THEN
+         ! Turn on all options.
+         CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. )
+         ! Ensure all processors are active
+         sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1
+      ELSEIF( sn_cfctl%l_config ) THEN
+         ! Activate finer control of report outputs
+         ! optionally switch off output from selected areas (note this only
+         ! applies to output which does not involve global communications)
+         IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. &
+           & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    &
+           &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. )
+      ELSE
+         ! turn off all options.
+         CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. )
+      ENDIF
+      !
+      lwp = (narea == 1) .OR. sn_cfctl%l_oceout    ! control of all listing output print
       !
       IF(lwp) THEN                      ! open listing units
@@ -356,17 +384,4 @@
       ENDIF
       !
-      ! finalize the definition of namctl variables
-      IF( sn_cfctl%l_config ) THEN
-         ! Activate finer control of report outputs
-         ! optionally switch off output from selected areas (note this only
-         ! applies to output which does not involve global communications)
-         IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. &
-           & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    &
-           &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. )
-      ELSE
-         ! Use ln_ctl to turn on or off all options.
-         CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. )
-      ENDIF
-      !
       IF(lwm) WRITE( numond, namctl )
       !
@@ -375,8 +390,6 @@
       !                             !------------------------------------!
       !
-      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist
       READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
 903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist' )
-      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist
       READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist' )   
@@ -398,4 +411,7 @@
       CALL nemo_alloc()
 
+      ! Initialise time level indices
+      Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa
+
       !                             !-------------------------------!
       !                             !  NEMO general initialization  !
@@ -412,33 +428,35 @@
       IF( lk_c1d       )   CALL     c1d_init        ! 1D column configuration
                            CALL     wad_init        ! Wetting and drying options
-                           CALL     dom_init("OPA") ! Domain
-      IF( ln_crs       )   CALL     crs_init        ! coarsened grid: domain initialization 
-      IF( ln_ctl       )   CALL prt_ctl_init        ! Print control
+                           CALL     dom_init( Nbb, Nnn, Naa, "OPA") ! Domain
+      IF( ln_crs       )   CALL     crs_init(      Nnn )       ! coarsened grid: domain initialization 
+      IF( sn_cfctl%l_prtctl )   &
+         &                 CALL prt_ctl_init        ! Print control
       
-      CALL diurnal_sst_bulk_init                ! diurnal sst
+                           CALL diurnal_sst_bulk_init       ! diurnal sst
       IF( ln_diurnal   )   CALL diurnal_sst_coolskin_init   ! cool skin   
       !                            
-      IF( ln_diurnal_only ) THEN                   ! diurnal only: a subset of the initialisation routines
-         CALL  istate_init                            ! ocean initial state (Dynamics and tracers)
-         CALL     sbc_init                            ! Forcings : surface module
-         CALL tra_qsr_init                            ! penetrative solar radiation qsr
-         IF( ln_diaobs ) THEN                         ! Observation & model comparison
-            CALL dia_obs_init                            ! Initialize observational data
-            CALL dia_obs( nit000 - 1 )                   ! Observation operator for restart
+      IF( ln_diurnal_only ) THEN                    ! diurnal only: a subset of the initialisation routines
+         CALL  istate_init( Nbb, Nnn, Naa )         ! ocean initial state (Dynamics and tracers)
+         CALL     sbc_init( Nbb, Nnn, Naa )         ! Forcings : surface module
+         CALL tra_qsr_init                          ! penetrative solar radiation qsr
+         IF( ln_diaobs ) THEN                       ! Observation & model comparison
+            CALL dia_obs_init( Nnn )                ! Initialize observational data
+            CALL dia_obs( nit000 - 1, Nnn )         ! Observation operator for restart
          ENDIF     
-         IF( lk_asminc )   CALL asm_inc_init          ! Assimilation increments
+         IF( lk_asminc )   CALL asm_inc_init( Nbb, Nnn, Nrhs )   ! Assimilation increments
          !
          RETURN                                       ! end of initialization
       ENDIF
+      !
       
-                           CALL  istate_init    ! ocean initial state (Dynamics and tracers)
+                           CALL  istate_init( Nbb, Nnn, Naa )    ! ocean initial state (Dynamics and tracers)
 
       !                                      ! external forcing 
-                           CALL    tide_init    ! tidal harmonics
-                           CALL     sbc_init    ! surface boundary conditions (including sea-ice)
-                           CALL     bdy_init    ! Open boundaries initialisation
+                           CALL    tide_init                     ! tidal harmonics
+                           CALL     sbc_init( Nbb, Nnn, Naa )    ! surface boundary conditions (including sea-ice)
+                           CALL     bdy_init                     ! Open boundaries initialisation
 
       !                                      ! Ocean physics
-                           CALL zdf_phy_init    ! Vertical physics
+                           CALL zdf_phy_init( Nnn )    ! Vertical physics
                                      
       !                                         ! Lateral physics
@@ -456,19 +474,22 @@
 
       !                                      ! Dynamics
-      IF( lk_c1d       )   CALL dyn_dmp_init      ! internal momentum damping
-                           CALL dyn_adv_init      ! advection (vector or flux form)
-                           CALL dyn_vor_init      ! vorticity term including Coriolis
-                           CALL dyn_ldf_init      ! lateral mixing
-                           CALL dyn_hpg_init      ! horizontal gradient of Hydrostatic pressure
-                           CALL dyn_spg_init      ! surface pressure gradient
+      IF( lk_c1d       )   CALL dyn_dmp_init         ! internal momentum damping
+                           CALL dyn_adv_init         ! advection (vector or flux form)
+                           CALL dyn_vor_init         ! vorticity term including Coriolis
+                           CALL dyn_ldf_init         ! lateral mixing
+                           CALL dyn_hpg_init( Nnn )  ! horizontal gradient of Hydrostatic pressure
+                           CALL dyn_spg_init         ! surface pressure gradient
 
 #if defined key_top
       !                                      ! Passive tracers
-                           CALL     trc_init
+                           CALL     trc_init( Nbb, Nnn, Naa )
 #endif
       IF( l_ldfslp     )   CALL ldf_slp_init    ! slope of lateral mixing
 
       !                                      ! Icebergs
-                           CALL icb_init( rdt, nit000)   ! initialise icebergs instance
+                           CALL icb_init( rn_Dt, nit000)   ! initialise icebergs instance
+
+                                                ! ice shelf
+                           CALL isf_init( Nbb, Nnn, Naa )
 
       !                                      ! Misc. options
@@ -477,18 +498,18 @@
      
       !                                      ! Diagnostics
-                           CALL     flo_init    ! drifting Floats
+                           CALL     flo_init( Nnn )    ! drifting Floats
       IF( ln_diacfl    )   CALL dia_cfl_init    ! Initialise CFL diagnostics
-                           CALL dia_ptr_init    ! Poleward TRansports initialization
+!                           CALL dia_ptr_init    ! Poleward TRansports initialization
                            CALL dia_dct_init    ! Sections tranports
-                           CALL dia_hsb_init    ! heat content, salt content and volume budgets
-                           CALL     trd_init    ! Mixed-layer/Vorticity/Integral constraints trends
-                           CALL dia_obs_init    ! Initialize observational data
-                           CALL dia_tmb_init    ! TMB outputs
-                           CALL dia_25h_init    ! 25h mean  outputs
-                           CALL dia_harm_init   ! tidal harmonics outputs
-     IF( ln_diaobs    )    CALL dia_obs( nit000-1 )   ! Observation operator for restart
+                           CALL dia_hsb_init( Nnn )    ! heat content, salt content and volume budgets
+                           CALL     trd_init( Nnn )    ! Mixed-layer/Vorticity/Integral constraints trends
+                           CALL dia_obs_init( Nnn )    ! Initialize observational data
+                           CALL dia_25h_init( Nbb )    ! 25h mean  outputs
+                           CALL dia_detide_init ! Weights computation for daily detiding of model diagnostics
+      IF( ln_diaobs    )   CALL dia_obs( nit000-1, Nnn )   ! Observation operator for restart
+                           CALL dia_mlr_init    ! Initialisation of IOM context management for multiple-linear-regression analysis
 
       !                                      ! Assimilation increments
-      IF( lk_asminc    )   CALL asm_inc_init    ! Initialize assimilation increments
+      IF( lk_asminc    )   CALL asm_inc_init( Nbb, Nnn, Nrhs )   ! Initialize assimilation increments
       !
       IF(lwp) WRITE(numout,cform_aaa)           ! Flag AAAAAAA
@@ -513,5 +534,6 @@
          WRITE(numout,*) '~~~~~~~~'
          WRITE(numout,*) '   Namelist namctl'
-         WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl
+         WRITE(numout,*) '                              sn_cfctl%l_glochk  = ', sn_cfctl%l_glochk
+         WRITE(numout,*) '                              sn_cfctl%l_allon   = ', sn_cfctl%l_allon
          WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config
          WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat
@@ -519,6 +541,7 @@
          WRITE(numout,*) '                              sn_cfctl%l_oceout  = ', sn_cfctl%l_oceout
          WRITE(numout,*) '                              sn_cfctl%l_layout  = ', sn_cfctl%l_layout
-         WRITE(numout,*) '                              sn_cfctl%l_mppout  = ', sn_cfctl%l_mppout
-         WRITE(numout,*) '                              sn_cfctl%l_mpptop  = ', sn_cfctl%l_mpptop
+         WRITE(numout,*) '                              sn_cfctl%l_prtctl  = ', sn_cfctl%l_prtctl
+         WRITE(numout,*) '                              sn_cfctl%l_prttrc  = ', sn_cfctl%l_prttrc
+         WRITE(numout,*) '                              sn_cfctl%l_oasout  = ', sn_cfctl%l_oasout
          WRITE(numout,*) '                              sn_cfctl%procmin   = ', sn_cfctl%procmin  
          WRITE(numout,*) '                              sn_cfctl%procmax   = ', sn_cfctl%procmax  
@@ -558,5 +581,5 @@
       !                             ! Parameter control
       !
-      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints
+      IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN              ! sub-domain area indices for the control prints
          IF( lk_mpp .AND. jpnij > 1 ) THEN
             isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain
@@ -619,9 +642,5 @@
       IF( numstp          /= -1 )   CLOSE( numstp          )   ! time-step file
       IF( numrun          /= -1 )   CLOSE( numrun          )   ! run statistics file
-      IF( numnam_ref      /= -1 )   CLOSE( numnam_ref      )   ! oce reference namelist
-      IF( numnam_cfg      /= -1 )   CLOSE( numnam_cfg      )   ! oce configuration namelist
       IF( lwm.AND.numond  /= -1 )   CLOSE( numond          )   ! oce output namelist
-      IF( numnam_ice_ref  /= -1 )   CLOSE( numnam_ice_ref  )   ! ice reference namelist
-      IF( numnam_ice_cfg  /= -1 )   CLOSE( numnam_ice_cfg  )   ! ice configuration namelist
       IF( lwm.AND.numoni  /= -1 )   CLOSE( numoni          )   ! ice output namelist
       IF( numevo_ice      /= -1 )   CLOSE( numevo_ice      )   ! ice variables (temp. evolution)
@@ -688,6 +707,7 @@
       sn_cfctl%l_oceout  = setto
       sn_cfctl%l_layout  = setto
-      sn_cfctl%l_mppout  = setto
-      sn_cfctl%l_mpptop  = setto
+      sn_cfctl%l_prtctl  = setto
+      sn_cfctl%l_prttrc  = setto
+      sn_cfctl%l_oasout  = setto
    END SUBROUTINE nemo_set_cfctl
 
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/oce.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/oce.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/oce.F90	(revision 12928)
@@ -8,4 +8,5 @@
    !!            3.3  !  2010-09  (C. Ethe) TRA-TRC merge: add ts, gtsu, gtsv 4D arrays
    !!            3.7  !  2014-01  (G. Madec) suppression of curl and before hdiv from in-core memory
+   !!            4.1  !  2019-08  (A. Coward, D. Storkey) rename prognostic variables in preparation for new time scheme
    !!----------------------------------------------------------------------
    USE par_oce        ! ocean parameters
@@ -17,16 +18,15 @@
    PUBLIC oce_alloc ! routine called by nemo_init in nemogcm.F90
 
-   !! dynamics and tracer fields                            ! before ! now    ! after  ! the after trends becomes the fields
-   !! --------------------------                            ! fields ! fields ! trends ! only after tra_zdf and dyn_spg
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   ub   ,  un    , ua     !: i-horizontal velocity        [m/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   vb   ,  vn    , va     !: j-horizontal velocity        [m/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::           wn             !: vertical velocity            [m/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::           wi             !: vertical vel. (adaptive-implicit) [m/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::           hdivn          !: horizontal divergence        [s-1]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tsb  ,  tsn   , tsa    !: 4D T-S fields                  [Celsius,psu] 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   rab_b,  rab_n          !: thermal/haline expansion coef. [Celsius-1,psu-1]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   rn2b ,  rn2            !: brunt-vaisala frequency**2     [s-2]
+   !! dynamics and tracer fields
+   !! --------------------------                            
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)   ::   uu   ,  vv     !: horizontal velocities        [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   ww             !: vertical velocity            [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   wi             !: vertical vel. (adaptive-implicit) [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   hdiv           !: horizontal divergence        [s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   ts             !: 4D T-S fields                  [Celsius,psu] 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)   ::   rab_b,  rab_n  !: thermal/haline expansion coef. [Celsius-1,psu-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   rn2b ,  rn2    !: brunt-vaisala frequency**2     [s-2]
    !
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rhd    !: in situ density anomalie rhd=(rho-rau0)/rau0  [no units]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rhd    !: in situ density anomalie rhd=(rho-rho0)/rho0  [no units]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rhop   !: potential volumic mass                           [kg/m3]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   Cu_adv                   !: vertical Courant number (adaptive-implicit)
@@ -34,7 +34,5 @@
    !! free surface                                      !  before  ! now    ! after  !
    !! ------------                                      !  fields  ! fields ! fields !
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub_b   ,  un_b  ,  ua_b  !: Barotropic velocities at u-point [m/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vb_b   ,  vn_b  ,  va_b  !: Barotropic velocities at v-point [m/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshb   ,  sshn  ,  ssha  !: sea surface height at t-point [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ssh, uu_b,  vv_b   !: SSH [m] and barotropic velocities [m/s]
 
    !! Arrays at barotropic time step:                   ! befbefore! before !  now   ! after  !
@@ -67,5 +65,6 @@
 
    !! Energy budget of the leads (open water embedded in sea ice)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fraqsr_1lev        !: fraction of solar net radiation absorbed in the first ocean level [-]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fraqsr_1lev  !: fraction of solar net radiation absorbed in the first ocean level [-]
+   INTEGER, PUBLIC, DIMENSION(2) :: noce_array                             !: unused array but seems to be needed to prevent agrif from creating an empty module
 
    !!----------------------------------------------------------------------
@@ -84,15 +83,12 @@
       !
       ierr(:) = 0 
-      ALLOCATE( ub   (jpi,jpj,jpk)      , un   (jpi,jpj,jpk)      , ua(jpi,jpj,jpk)       ,     &
-         &      vb   (jpi,jpj,jpk)      , vn   (jpi,jpj,jpk)      , va(jpi,jpj,jpk)       ,     &          
-         &      wn   (jpi,jpj,jpk)      , hdivn(jpi,jpj,jpk)      ,                             &
-         &      tsb  (jpi,jpj,jpk,jpts) , tsn  (jpi,jpj,jpk,jpts) , tsa(jpi,jpj,jpk,jpts) ,     &
+      ALLOCATE( uu   (jpi,jpj,jpk,jpt)  , vv   (jpi,jpj,jpk,jpt) ,                              &          
+         &      ww   (jpi,jpj,jpk)      , hdiv(jpi,jpj,jpk)      ,                              &
+         &      ts   (jpi,jpj,jpk,jpts,jpt),                                                    &
          &      rab_b(jpi,jpj,jpk,jpts) , rab_n(jpi,jpj,jpk,jpts) ,                             &
          &      rn2b (jpi,jpj,jpk)      , rn2  (jpi,jpj,jpk)      ,                             &
          &      rhd  (jpi,jpj,jpk)      , rhop (jpi,jpj,jpk)                              , STAT=ierr(1) )
          !
-      ALLOCATE( sshb(jpi,jpj)     , sshn(jpi,jpj)   , ssha(jpi,jpj)   ,     &
-         &      ub_b(jpi,jpj)     , un_b(jpi,jpj)   , ua_b(jpi,jpj)   ,     &
-         &      vb_b(jpi,jpj)     , vn_b(jpi,jpj)   , va_b(jpi,jpj)   ,     &
+      ALLOCATE( ssh(jpi,jpj,jpt)  , uu_b(jpi,jpj,jpt) , vv_b(jpi,jpj,jpt) , &
          &      spgu  (jpi,jpj)   , spgv(jpi,jpj)                     ,     &
          &      gtsu(jpi,jpj,jpts), gtsv(jpi,jpj,jpts)                ,     &
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/par_oce.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/par_oce.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/par_oce.F90	(revision 12928)
@@ -27,4 +27,5 @@
    !                                   !  with the extended grids used in the under ice shelf configurations to 
    !                                   !  be used without redundant rows when the ice shelves are not in use.
+   LOGICAL       ::   ln_closea        !: (=T) special treatment of closed sea
    ! 
 
@@ -35,4 +36,7 @@
    CHARACTER(lc) ::   cn_cfg           !: name of the configuration
    INTEGER       ::   nn_cfg           !: resolution of the configuration 
+
+   ! time dimension
+   INTEGER, PUBLIC, PARAMETER :: jpt = 3    !: time dimension
 
    ! global domain size               !!! * total computational domain *
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/step.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/step.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/step.F90	(revision 12928)
@@ -31,4 +31,5 @@
    !!             -   !  2015-11  (J. Chanut) free surface simplification (remove filtered free surface)
    !!            4.0  !  2017-05  (G. Madec)  introduction of the vertical physics manager (zdfphy)
+   !!            4.1  !  2019-08  (A. Coward, D. Storkey) rewrite in preparation for new timestepping scheme
    !!----------------------------------------------------------------------
 
@@ -44,4 +45,9 @@
 
    PUBLIC   stp   ! called by nemogcm.F90
+
+   !!----------------------------------------------------------------------
+   !! time level indices
+   !!----------------------------------------------------------------------
+   INTEGER, PUBLIC :: Nbb, Nnn, Naa, Nrhs          !! used by nemo_init
 
    !!----------------------------------------------------------------------
@@ -81,5 +87,7 @@
       !! ---------------------------------------------------------------------
 #if defined key_agrif
+      IF( nstop > 0 ) return   ! avoid to go further if an error was detected during previous time step 
       kstp = nit000 + Agrif_Nb_Step()
+      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices
       IF( lk_agrif_debug ) THEN
          IF( Agrif_Root() .and. lwp)   WRITE(*,*) '---'
@@ -95,4 +103,14 @@
       !
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! model timestep
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !
+      IF( l_1st_euler ) THEN  
+         ! start or restart with Euler 1st time-step
+         rDt =  rn_Dt   
+         r1_Dt = 1._wp / rDt
+      ENDIF
+      !
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
       ! update I/O and calendar 
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
@@ -100,5 +118,7 @@
                              
       IF( kstp == nit000 ) THEN                       ! initialize IOM context (must be done after nemo_init for AGRIF+XIOS+OASIS)
-                             CALL iom_init(      cxios_context          )  ! for model grid (including passible AGRIF zoom)
+                             CALL iom_init( cxios_context, ld_closedef=.FALSE. )   ! for model grid (including passible AGRIF zoom)
+         IF( lk_diamlr   )   CALL dia_mlr_iom_init    ! with additional setup for multiple-linear-regression analysis
+                             CALL iom_init_closedef
                              IF( ln_crs      )   CALL iom_init( TRIM(cxios_context)//"_crs" )  ! for coarse grid
                              CALL dia_hth_init    ! extra ML depth diagnostics, thermocline depths
@@ -109,10 +129,11 @@
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! Update external forcing (tides, open boundaries, and surface boundary condition (including sea-ice)
-      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-      IF( ln_tide    )   CALL sbc_tide( kstp )                   ! update tide potential
-      IF( ln_apr_dyn )   CALL sbc_apr ( kstp )                   ! atmospheric pressure (NB: call before bdy_dta which needs ssh_ib) 
-      IF( ln_bdy     )   CALL bdy_dta ( kstp, kt_offset = +1 )   ! update dynamic & tracer data at open boundaries
-                         CALL sbc     ( kstp )                   ! Sea Boundary Condition (including sea-ice)
+      ! Update external forcing (tides, open boundaries, ice shelf interaction and surface boundary condition (including sea-ice)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF( ln_tide    )   CALL tide_update( kstp )                     ! update tide potential
+      IF( ln_apr_dyn )   CALL sbc_apr ( kstp )                        ! atmospheric pressure (NB: call before bdy_dta which needs ssh_ib) 
+      IF( ln_bdy     )   CALL bdy_dta ( kstp, Nnn )                   ! update dynamic & tracer data at open boundaries
+      IF( ln_isf     )   CALL isf_stp ( kstp, Nnn )
+                         CALL sbc     ( kstp, Nbb, Nnn )              ! Sea Boundary Condition (including sea-ice)
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -120,5 +141,5 @@
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
       IF( ln_sto_eos ) CALL sto_par( kstp )          ! Stochastic parameters
-      IF( ln_sto_eos ) CALL sto_pts( tsn  )          ! Random T/S fluctuations
+      IF( ln_sto_eos ) CALL sto_pts( ts(:,:,:,:,Nnn)  )          ! Random T/S fluctuations
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -126,33 +147,33 @@
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
       !  THERMODYNAMICS
-                         CALL eos_rab( tsb, rab_b )       ! before local thermal/haline expension ratio at T-points
-                         CALL eos_rab( tsn, rab_n )       ! now    local thermal/haline expension ratio at T-points
-                         CALL bn2    ( tsb, rab_b, rn2b ) ! before Brunt-Vaisala frequency
-                         CALL bn2    ( tsn, rab_n, rn2  ) ! now    Brunt-Vaisala frequency
+                         CALL eos_rab( ts(:,:,:,:,Nbb), rab_b, Nnn )       ! before local thermal/haline expension ratio at T-points
+                         CALL eos_rab( ts(:,:,:,:,Nnn), rab_n, Nnn )       ! now    local thermal/haline expension ratio at T-points
+                         CALL bn2    ( ts(:,:,:,:,Nbb), rab_b, rn2b, Nnn ) ! before Brunt-Vaisala frequency
+                         CALL bn2    ( ts(:,:,:,:,Nnn), rab_n, rn2, Nnn  ) ! now    Brunt-Vaisala frequency
 
       !  VERTICAL PHYSICS
-                         CALL zdf_phy( kstp )         ! vertical physics update (top/bot drag, avt, avs, avm + MLD)
+                         CALL zdf_phy( kstp, Nbb, Nnn, Nrhs )   ! vertical physics update (top/bot drag, avt, avs, avm + MLD)
 
       !  LATERAL  PHYSICS
       !
       IF( l_ldfslp ) THEN                             ! slope of lateral mixing
-                         CALL eos( tsb, rhd, gdept_0(:,:,:) )               ! before in situ density
-
-         IF( ln_zps .AND. .NOT. ln_isfcav)                               &
-            &            CALL zps_hde    ( kstp, jpts, tsb, gtsu, gtsv,  &  ! Partial steps: before horizontal gradient
-            &                                          rhd, gru , grv    )  ! of t, s, rd at the last ocean level
-
-         IF( ln_zps .AND.       ln_isfcav)                               &
-            &            CALL zps_hde_isf( kstp, jpts, tsb, gtsu, gtsv, gtui, gtvi,  &  ! Partial steps for top cell (ISF)
-            &                                          rhd, gru , grv , grui, grvi   )  ! of t, s, rd at the first ocean level
+                         CALL eos( ts(:,:,:,:,Nbb), rhd, gdept_0(:,:,:) )               ! before in situ density
+
+         IF( ln_zps .AND. .NOT. ln_isfcav)                                    &
+            &            CALL zps_hde    ( kstp, Nnn, jpts, ts(:,:,:,:,Nbb), gtsu, gtsv,  &  ! Partial steps: before horizontal gradient
+            &                                          rhd, gru , grv    )       ! of t, s, rd at the last ocean level
+
+         IF( ln_zps .AND.       ln_isfcav)                                                &
+            &            CALL zps_hde_isf( kstp, Nnn, jpts, ts(:,:,:,:,Nbb), gtsu, gtsv, gtui, gtvi,  &  ! Partial steps for top cell (ISF)
+            &                                          rhd, gru , grv , grui, grvi   )       ! of t, s, rd at the first ocean level
          IF( ln_traldf_triad ) THEN 
-                         CALL ldf_slp_triad( kstp )                       ! before slope for triad operator
+                         CALL ldf_slp_triad( kstp, Nbb, Nnn )             ! before slope for triad operator
          ELSE     
-                         CALL ldf_slp     ( kstp, rhd, rn2b )             ! before slope for standard operator
+                         CALL ldf_slp     ( kstp, rhd, rn2b, Nbb, Nnn )   ! before slope for standard operator
          ENDIF
       ENDIF
-      !                                                                   ! eddy diffusivity coeff.
-      IF( l_ldftra_time .OR. l_ldfeiv_time )   CALL ldf_tra( kstp )       !       and/or eiv coeff.
-      IF( l_ldfdyn_time                    )   CALL ldf_dyn( kstp )       ! eddy viscosity coeff. 
+      !                                                                        ! eddy diffusivity coeff.
+      IF( l_ldftra_time .OR. l_ldfeiv_time )   CALL ldf_tra( kstp, Nbb, Nnn )  !       and/or eiv coeff.
+      IF( l_ldfdyn_time                    )   CALL ldf_dyn( kstp, Nbb )       ! eddy viscosity coeff. 
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -160,57 +181,58 @@
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 
-                            CALL ssh_nxt       ( kstp )  ! after ssh (includes call to div_hor)
-      IF( .NOT.ln_linssh )  CALL dom_vvl_sf_nxt( kstp )  ! after vertical scale factors 
-                            CALL wzv           ( kstp )  ! now cross-level velocity 
-      IF( ln_zad_Aimp )     CALL wAimp         ( kstp )  ! Adaptive-implicit vertical advection partitioning
-                            CALL eos    ( tsn, rhd, rhop, gdept_n(:,:,:) )  ! now in situ density for hpg computation
+                            CALL ssh_nxt       ( kstp, Nbb, Nnn, ssh, Naa )    ! after ssh (includes call to div_hor)
+      IF( .NOT.ln_linssh )  CALL dom_vvl_sf_nxt( kstp, Nbb, Nnn,      Naa )    ! after vertical scale factors 
+                            CALL wzv           ( kstp, Nbb, Nnn, ww,  Naa )    ! now cross-level velocity 
+      IF( ln_zad_Aimp )     CALL wAimp         ( kstp,      Nnn           )  ! Adaptive-implicit vertical advection partitioning
+                            CALL eos    ( ts(:,:,:,:,Nnn), rhd, rhop, gdept(:,:,:,Nnn) )  ! now in situ density for hpg computation
                             
                             
-                         ua(:,:,:) = 0._wp            ! set dynamics trends to zero
-                         va(:,:,:) = 0._wp
+                         uu(:,:,:,Nrhs) = 0._wp            ! set dynamics trends to zero
+                         vv(:,:,:,Nrhs) = 0._wp
 
       IF(  lk_asminc .AND. ln_asmiau .AND. ln_dyninc )   &
-               &         CALL dyn_asm_inc   ( kstp )  ! apply dynamics assimilation increment
-      IF( ln_bdy     )   CALL bdy_dyn3d_dmp ( kstp )  ! bdy damping trends
+               &         CALL dyn_asm_inc   ( kstp, Nbb, Nnn, uu, vv, Nrhs )  ! apply dynamics assimilation increment
+      IF( ln_bdy     )   CALL bdy_dyn3d_dmp ( kstp, Nbb,      uu, vv, Nrhs )  ! bdy damping trends
 #if defined key_agrif
       IF(.NOT. Agrif_Root())  & 
                &         CALL Agrif_Sponge_dyn        ! momentum sponge
 #endif
-                         CALL dyn_adv       ( kstp )  ! advection (vector or flux form)
-                         CALL dyn_vor       ( kstp )  ! vorticity term including Coriolis
-                         CALL dyn_ldf       ( kstp )  ! lateral mixing
-      IF( ln_zdfosm  )   CALL dyn_osm       ( kstp )  ! OSMOSIS non-local velocity fluxes
-                         CALL dyn_hpg       ( kstp )  ! horizontal gradient of Hydrostatic pressure
-                         CALL dyn_spg       ( kstp )  ! surface pressure gradient
-
-                                                      ! With split-explicit free surface, since now transports have been updated and ssha as well
+                         CALL dyn_adv( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! advection (VF or FF)	==> RHS
+                         CALL dyn_vor( kstp,      Nnn      , uu, vv, Nrhs )  ! vorticity           	==> RHS
+                         CALL dyn_ldf( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! lateral mixing
+      IF( ln_zdfosm  )   CALL dyn_osm( kstp,      Nnn      , uu, vv, Nrhs )  ! OSMOSIS non-local velocity fluxes ==> RHS
+                         CALL dyn_hpg( kstp,      Nnn      , uu, vv, Nrhs )  ! horizontal gradient of Hydrostatic pressure
+                         CALL dyn_spg( kstp, Nbb, Nnn, Nrhs, uu, vv, ssh, uu_b, vv_b, Naa )  ! surface pressure gradient
+
+                                                      ! With split-explicit free surface, since now transports have been updated and ssh(:,:,Nrhs) as well
       IF( ln_dynspg_ts ) THEN                         ! vertical scale factors and vertical velocity need to be updated
-                            CALL div_hor    ( kstp )              ! Horizontal divergence  (2nd call in time-split case)
-         IF(.NOT.ln_linssh) CALL dom_vvl_sf_nxt( kstp, kcall=2 )  ! after vertical scale factors (update depth average component)
-      ENDIF
-                         CALL dyn_zdf       ( kstp )  ! vertical diffusion
-
-      IF( ln_dynspg_ts ) THEN                         
-                            CALL wzv        ( kstp )              ! now cross-level velocity 
-         IF( ln_zad_Aimp )  CALL wAimp      ( kstp )  ! Adaptive-implicit vertical advection partitioning
-      ENDIF
+                            CALL div_hor       ( kstp, Nbb, Nnn )                ! Horizontal divergence  (2nd call in time-split case)
+         IF(.NOT.ln_linssh) CALL dom_vvl_sf_nxt( kstp, Nbb, Nnn, Naa, kcall=2 )  ! after vertical scale factors (update depth average component)
+      ENDIF
+                            CALL dyn_zdf    ( kstp, Nbb, Nnn, Nrhs, uu, vv, Naa  )  ! vertical diffusion
+      IF( ln_dynspg_ts ) THEN                                                       ! vertical scale factors and vertical velocity need to be updated
+                            CALL wzv        ( kstp, Nbb, Nnn, ww, Naa )             ! now cross-level velocity 
+         IF( ln_zad_Aimp )  CALL wAimp      ( kstp,      Nnn )                      ! Adaptive-implicit vertical advection partitioning
+      ENDIF
+      
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
       ! cool skin
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<      
-      IF ( ln_diurnal )  CALL stp_diurnal( kstp )
+      IF ( ln_diurnal )  CALL diurnal_layers( kstp )
       
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
       ! diagnostics and outputs
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-      IF( ln_floats  )   CALL flo_stp ( kstp )        ! drifting Floats
-      IF( ln_diacfl  )   CALL dia_cfl ( kstp )        ! Courant number diagnostics
-      IF( ll_diahth  )   CALL dia_hth ( kstp )        ! Thermocline depth (20 degres isotherm depth)
-      IF( ln_diadct  )   CALL dia_dct ( kstp )        ! Transports
-                         CALL dia_ar5 ( kstp )        ! ar5 diag
-      IF( ln_diaharm )   CALL dia_harm( kstp )        ! Tidal harmonic analysis
-                         CALL dia_wri ( kstp )        ! ocean model: outputs
-      !
-      IF( ln_crs     )   CALL crs_fld       ( kstp )  ! ocean model: online field coarsening & output
+      IF( ln_floats  )   CALL flo_stp   ( kstp, Nbb, Nnn )      ! drifting Floats
+      IF( ln_diacfl  )   CALL dia_cfl   ( kstp,      Nnn )      ! Courant number diagnostics
+                         CALL dia_hth   ( kstp,      Nnn )      ! Thermocline depth (20 degres isotherm depth)
+      IF( ln_diadct  )   CALL dia_dct   ( kstp,      Nnn )      ! Transports
+                         CALL dia_ar5   ( kstp,      Nnn )      ! ar5 diag
+                         CALL dia_ptr   ( kstp,      Nnn )      ! Poleward adv/ldf TRansports diagnostics
+                         CALL dia_wri   ( kstp,      Nnn )      ! ocean model: outputs
+      IF( ln_crs     )   CALL crs_fld   ( kstp,      Nnn )      ! ocean model: online field coarsening & output
+      IF( lk_diadetide ) CALL dia_detide( kstp )                ! Weights computation for daily detiding of model diagnostics
+      IF( lk_diamlr  )   CALL dia_mlr                           ! Update time used in multiple-linear-regression analysis
       
 #if defined key_top
@@ -218,5 +240,5 @@
       ! Passive Tracer Model
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-                         CALL trc_stp       ( kstp )  ! time-stepping
+                         CALL trc_stp       ( kstp, Nbb, Nnn, Nrhs, Naa )  ! time-stepping
 #endif
 
@@ -224,32 +246,30 @@
       ! Active tracers                              
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-                         tsa(:,:,:,:) = 0._wp         ! set tracer trends to zero
+                         ts(:,:,:,:,Nrhs) = 0._wp         ! set tracer trends to zero
 
       IF(  lk_asminc .AND. ln_asmiau .AND. &
-         & ln_trainc )   CALL tra_asm_inc   ( kstp )  ! apply tracer assimilation increment
-                         CALL tra_sbc       ( kstp )  ! surface boundary condition
-      IF( ln_traqsr  )   CALL tra_qsr       ( kstp )  ! penetrative solar radiation qsr
-      IF( ln_trabbc  )   CALL tra_bbc       ( kstp )  ! bottom heat flux
-      IF( ln_trabbl  )   CALL tra_bbl       ( kstp )  ! advective (and/or diffusive) bottom boundary layer scheme
-      IF( ln_tradmp  )   CALL tra_dmp       ( kstp )  ! internal damping trends
-      IF( ln_bdy     )   CALL bdy_tra_dmp   ( kstp )  ! bdy damping trends
+         & ln_trainc )   CALL tra_asm_inc( kstp, Nbb, Nnn, ts, Nrhs )  ! apply tracer assimilation increment
+                         CALL tra_sbc    ( kstp,      Nnn, ts, Nrhs )  ! surface boundary condition
+      IF( ln_traqsr  )   CALL tra_qsr    ( kstp,      Nnn, ts, Nrhs )  ! penetrative solar radiation qsr
+      IF( ln_isf     )   CALL tra_isf    ( kstp,      Nnn, ts, Nrhs )  ! ice shelf heat flux
+      IF( ln_trabbc  )   CALL tra_bbc    ( kstp,      Nnn, ts, Nrhs )  ! bottom heat flux
+      IF( ln_trabbl  )   CALL tra_bbl    ( kstp, Nbb, Nnn, ts, Nrhs )  ! advective (and/or diffusive) bottom boundary layer scheme
+      IF( ln_tradmp  )   CALL tra_dmp    ( kstp, Nbb, Nnn, ts, Nrhs )  ! internal damping trends
+      IF( ln_bdy     )   CALL bdy_tra_dmp( kstp, Nbb,      ts, Nrhs )  ! bdy damping trends
 #if defined key_agrif
       IF(.NOT. Agrif_Root())  & 
                &         CALL Agrif_Sponge_tra        ! tracers sponge
 #endif
-                         CALL tra_adv       ( kstp )  ! horizontal & vertical advection
-      IF( ln_zdfosm  )   CALL tra_osm       ( kstp )  ! OSMOSIS non-local tracer fluxes
+                         CALL tra_adv    ( kstp, Nbb, Nnn, ts, Nrhs )  ! hor. + vert. advection	==> RHS
+      IF( ln_zdfosm  )   CALL tra_osm    ( kstp,      Nnn, ts, Nrhs )  ! OSMOSIS non-local tracer fluxes ==> RHS
       IF( lrst_oce .AND. ln_zdfosm ) &
-           &             CALL osm_rst( kstp, 'WRITE' )! write OSMOSIS outputs + wn (so must do here) to restarts
-                         CALL tra_ldf       ( kstp )  ! lateral mixing
-
-!!gm : why CALL to dia_ptr has been moved here??? (use trends info?)
-      IF( ln_diaptr  )   CALL dia_ptr                 ! Poleward adv/ldf TRansports diagnostics
-!!gm
-                         CALL tra_zdf       ( kstp )  ! vertical mixing and after tracer fields
-      IF( ln_zdfnpc  )   CALL tra_npc       ( kstp )  ! update after fields by non-penetrative convection
-
-      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! Set boundary conditions and Swap
+           &             CALL osm_rst    ( kstp,      Nnn, 'WRITE'  )  ! write OSMOSIS outputs + ww (so must do here) to restarts
+                         CALL tra_ldf    ( kstp, Nbb, Nnn, ts, Nrhs )  ! lateral mixing
+
+                         CALL tra_zdf    ( kstp, Nbb, Nnn, Nrhs, ts, Naa  )  ! vertical mixing and after tracer fields
+      IF( ln_zdfnpc  )   CALL tra_npc    ( kstp,      Nnn, Nrhs, ts, Naa  )  ! update after fields by non-penetrative convection
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Set boundary conditions, time filter and swap time levels
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 !!jc1: For agrif, it would be much better to finalize tracers/momentum here (e.g. bdy conditions) and move the swap 
@@ -266,11 +286,18 @@
 !!    place.
 !! 
-!!jc2: dynnxt must be the latest call. e3t_b are indeed updated in that routine
-                         CALL tra_nxt       ( kstp )  ! finalize (bcs) tracer fields at next time step and swap
-                         CALL dyn_nxt       ( kstp )  ! finalize (bcs) velocities at next time step and swap (always called after tra_nxt)
-                         CALL ssh_swp       ( kstp )  ! swap of sea surface height
-      IF(.NOT.ln_linssh) CALL dom_vvl_sf_swp( kstp )  ! swap of vertical scale factors
-      !
-      IF( ln_diahsb  )   CALL dia_hsb       ( kstp )  ! - ML - global conservation diagnostics
+!!jc2: dynnxt must be the latest call. e3t(:,:,:,Nbb) are indeed updated in that routine
+                         CALL tra_atf       ( kstp, Nbb, Nnn, Naa, ts )                      ! time filtering of "now" tracer arrays
+                         CALL dyn_atf       ( kstp, Nbb, Nnn, Naa, uu, vv, e3t, e3u, e3v  )  ! time filtering of "now" velocities and scale factors
+                         CALL ssh_atf       ( kstp, Nbb, Nnn, Naa, ssh )                     ! time filtering of "now" sea surface height
+      !
+      ! Swap time levels
+      Nrhs = Nbb
+      Nbb = Nnn
+      Nnn = Naa
+      Naa = Nrhs
+      !
+      IF(.NOT.ln_linssh) CALL dom_vvl_sf_update( kstp, Nbb, Nnn, Naa )  ! recompute vertical scale factors
+      !
+      IF( ln_diahsb  )   CALL dia_hsb       ( kstp, Nbb, Nnn )  ! - ML - global conservation diagnostics
 
 !!gm : This does not only concern the dynamics ==>>> add a new title
@@ -279,22 +306,31 @@
 !!jc: That would be better, but see comment above
 !!
-      IF( lrst_oce   )   CALL rst_write    ( kstp )   ! write output ocean restart file
+      IF( lrst_oce   )   CALL rst_write    ( kstp, Nbb, Nnn )   ! write output ocean restart file
       IF( ln_sto_eos )   CALL sto_rst_write( kstp )   ! write restart file for stochastic parameters
 
 #if defined key_agrif
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! AGRIF
+      ! AGRIF recursive integration
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<      
-                         CALL Agrif_Integrate_ChildGrids( stp )  ! allows to finish all the Child Grids before updating
-
-                         IF( Agrif_NbStepint() == 0 ) CALL Agrif_update_all( ) ! Update all components
-#endif
-      IF( ln_diaobs  )   CALL dia_obs      ( kstp )      ! obs-minus-model (assimilation) diagnostics (call after dynamics update)
-
+                         Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs      ! agrif_oce module copies of time level indices
+                         CALL Agrif_Integrate_ChildGrids( stp )       ! allows to finish all the Child Grids before updating
+#endif
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
       ! Control
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-                         CALL stp_ctl      ( kstp, indic )
-                         
+                         CALL stp_ctl      ( kstp, Nbb, Nnn, indic )
+#if defined key_agrif
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! AGRIF update
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<      
+      IF( Agrif_NbStepint() == 0 .AND. nstop == 0 ) THEN
+                         CALL Agrif_update_all( )                  ! Update all components
+      ENDIF
+#endif
+      IF( ln_diaobs  )   CALL dia_obs      ( kstp, Nnn )      ! obs-minus-model (assimilation) diagnostics (call after dynamics update)
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! File manipulation at the end of the first time step
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<                         
       IF( kstp == nit000 ) THEN                          ! 1st time step only
                                         CALL iom_close( numror )   ! close input  ocean restart file
@@ -307,18 +343,27 @@
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 !!gm why lk_oasis and not lk_cpl ????
-      IF( lk_oasis   )   CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges
+      IF( lk_oasis   )   CALL sbc_cpl_snd( kstp, Nbb, Nnn )        ! coupled mode : field exchanges
       !
 #if defined key_iomput
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Finalize contextes if end of simulation or error detected
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<                         
       IF( kstp == nitend .OR. indic < 0 ) THEN 
                       CALL iom_context_finalize(      cxios_context          ) ! needed for XIOS+AGRIF
-                      IF(lrxios) CALL iom_context_finalize(      crxios_context          )
+         IF( lrxios ) CALL iom_context_finalize(      crxios_context         )
          IF( ln_crs ) CALL iom_context_finalize( trim(cxios_context)//"_crs" ) ! 
       ENDIF
 #endif
       !
+      IF( l_1st_euler ) THEN         ! recover Leap-frog timestep
+         rDt = 2._wp * rn_Dt   
+         r1_Dt = 1._wp / rDt
+         l_1st_euler = .FALSE.      
+      ENDIF
+      !
       IF( ln_timing )   CALL timing_stop('stp')
       !
    END SUBROUTINE stp
-   
+   !
    !!======================================================================
 END MODULE step
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/step_oce.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/step_oce.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/step_oce.F90	(revision 12928)
@@ -19,8 +19,12 @@
    USE sbccpl          ! surface boundary condition: coupled formulation (call send at end of step)
    USE sbcapr          ! surface boundary condition: atmospheric pressure
-   USE sbctide         ! Tide initialisation
+   USE tide_mod, ONLY : ln_tide, tide_update
    USE sbcwave         ! Wave intialisation
 
+   USE isf_oce         ! ice shelf boundary condition
+   USE isfstp          ! ice shelf boundary condition     (isf_stp routine)
+
    USE traqsr          ! solar radiation penetration      (tra_qsr routine)
+   USE traisf          ! ice shelf                        (tra_isf routine)
    USE trasbc          ! surface boundary condition       (tra_sbc routine)
    USE trabbc          ! bottom boundary condition        (tra_bbc routine)
@@ -30,5 +34,5 @@
    USE traldf          ! lateral mixing                   (tra_ldf routine)
    USE trazdf          ! vertical mixing                  (tra_zdf routine)
-   USE tranxt          ! time-stepping                    (tra_nxt routine)
+   USE traatf          ! time filtering                   (tra_atf routine)
    USE tranpc          ! non-penetrative convection       (tra_npc routine)
 
@@ -43,5 +47,5 @@
    USE dynspg          ! surface pressure gradient        (dyn_spg routine)
 
-   USE dynnxt          ! time-stepping                    (dyn_nxt routine)
+   USE dynatf          ! time-filtering                   (dyn_atf routine)
 
    USE stopar          ! Stochastic parametrization       (sto_par routine)
@@ -66,7 +70,5 @@
    USE zdfosm  , ONLY : osm_rst, dyn_osm, tra_osm      ! OSMOSIS routines used in step.F90
 
-   USE step_diu        ! Time stepping for diurnal sst
-   USE diurnal_bulk    ! diurnal SST bulk routines  (diurnal_sst_takaya routine) 
-   USE cool_skin       ! diurnal cool skin correction (diurnal_sst_coolskin routine)   
+   USE diu_layers      ! diurnal SST bulk and coolskin routines
    USE sbc_oce         ! surface fluxes  
    
@@ -79,7 +81,8 @@
    USE diahth          ! thermocline depth                (dia_hth routine)
    USE diahsb          ! heat, salt and volume budgets    (dia_hsb routine)
-   USE diaharm
    USE diacfl
    USE diaobs          ! Observation operator
+   USE diadetide       ! Weights computation for daily detiding of model diagnostics
+   USE diamlr          ! IOM context management for multiple-linear-regression analysis
    USE flo_oce         ! floats variables
    USE floats          ! floats computation               (flo_stp routine)
@@ -107,5 +110,5 @@
 #endif
 #if defined key_top
-   USE trcstp           ! passive tracer time-stepping      (trc_stp routine)
+   USE trcstp, ONLY : trc_stp    ! passive tracer time-stepping      (trc_stp routine)
 #endif
    !!----------------------------------------------------------------------
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/stpctl.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/stpctl.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/stpctl.F90	(revision 12928)
@@ -42,5 +42,5 @@
 CONTAINS
 
-   SUBROUTINE stp_ctl( kt, kindic )
+   SUBROUTINE stp_ctl( kt, Kbb, Kmm, kindic )
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE stp_ctl  ***
@@ -60,4 +60,5 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index
+      INTEGER, INTENT(in   ) ::   Kbb, Kmm      ! ocean time level index
       INTEGER, INTENT(inout) ::   kindic   ! error indicator
       !!
@@ -72,5 +73,5 @@
       !
       ll_wrtstp  = ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend )
-      ll_colruns = ll_wrtstp .AND. ( ln_ctl .OR. sn_cfctl%l_runstat )
+      ll_colruns = ll_wrtstp .AND. ( sn_cfctl%l_runstat )
       ll_wrtruns = ll_colruns .AND. lwm
       IF( kt == nit000 .AND. lwp ) THEN
@@ -82,5 +83,5 @@
          !                                ! open run.stat file(s) at start whatever
          !                                ! the value of sn_cfctl%ptimincr
-         IF( lwm .AND. ( ln_ctl .OR. sn_cfctl%l_runstat ) ) THEN
+         IF( lwm .AND. ( sn_cfctl%l_runstat ) ) THEN
             CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
             clname = 'run.stat.nc'
@@ -111,13 +112,13 @@
       !                                   !==  test of extrema  ==!
       IF( ll_wd ) THEN
-         zmax(1) = MAXVAL(  ABS( sshn(:,:) + ssh_ref*tmask(:,:,1) )  )        ! ssh max 
+         zmax(1) = MAXVAL(  ABS( ssh(:,:,Kmm) + ssh_ref*tmask(:,:,1) )  )        ! ssh max 
       ELSE
-         zmax(1) = MAXVAL(  ABS( sshn(:,:) )  )                               ! ssh max
-      ENDIF
-      zmax(2) = MAXVAL(  ABS( un(:,:,:) )  )                                  ! velocity max (zonal only)
-      zmax(3) = MAXVAL( -tsn(:,:,:,jp_sal) , mask = tmask(:,:,:) == 1._wp )   ! minus salinity max
-      zmax(4) = MAXVAL(  tsn(:,:,:,jp_sal) , mask = tmask(:,:,:) == 1._wp )   !       salinity max
-      zmax(5) = MAXVAL( -tsn(:,:,:,jp_tem) , mask = tmask(:,:,:) == 1._wp )   ! minus temperature max
-      zmax(6) = MAXVAL(  tsn(:,:,:,jp_tem) , mask = tmask(:,:,:) == 1._wp )   !       temperature max
+         zmax(1) = MAXVAL(  ABS( ssh(:,:,Kmm) )  )                               ! ssh max
+      ENDIF
+      zmax(2) = MAXVAL(  ABS( uu(:,:,:,Kmm) )  )                                  ! velocity max (zonal only)
+      zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp )   ! minus salinity max
+      zmax(4) = MAXVAL(  ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp )   !       salinity max
+      zmax(5) = MAXVAL( -ts(:,:,:,jp_tem,Kmm) , mask = tmask(:,:,:) == 1._wp )   ! minus temperature max
+      zmax(6) = MAXVAL(  ts(:,:,:,jp_tem,Kmm) , mask = tmask(:,:,:) == 1._wp )   !       temperature max
       zmax(7) = REAL( nstop , wp )                                            ! stop indicator
       IF( ln_zad_Aimp ) THEN
@@ -147,5 +148,5 @@
       END IF
       !                                   !==  error handling  ==!
-      IF( ( ln_ctl .OR. lsomeoce ) .AND. (   &             ! have use mpp_max (because ln_ctl=.T.) or contains some ocean points
+      IF( ( sn_cfctl%l_glochk .OR. lsomeoce ) .AND. (   &  ! domain contains some ocean points, check for sensible ranges
          &  zmax(1) >   20._wp .OR.   &                    ! too large sea surface height ( > 20 m )
          &  zmax(2) >   10._wp .OR.   &                    ! too large velocity ( > 10 m/s)
@@ -154,14 +155,16 @@
          &  zmax(4) <    0._wp .OR.   &                    ! too large sea surface salinity (keep this line for sea-ice)
          &  ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) ) THEN   ! NaN encounter in the tests
-         IF( lk_mpp .AND. ln_ctl ) THEN
-            CALL mpp_maxloc( 'stpctl', ABS(sshn)        , ssmask(:,:)  , zzz, ih  )
-            CALL mpp_maxloc( 'stpctl', ABS(un)          , umask (:,:,:), zzz, iu  )
-            CALL mpp_minloc( 'stpctl', tsn(:,:,:,jp_sal), tmask (:,:,:), zzz, is1 )
-            CALL mpp_maxloc( 'stpctl', tsn(:,:,:,jp_sal), tmask (:,:,:), zzz, is2 )
+         IF( lk_mpp .AND. sn_cfctl%l_glochk ) THEN
+            ! have use mpp_max (because sn_cfctl%l_glochk=.T. and distributed)
+            CALL mpp_maxloc( 'stpctl', ABS(ssh(:,:,Kmm))        , ssmask(:,:)  , zzz, ih  )
+            CALL mpp_maxloc( 'stpctl', ABS(uu(:,:,:,Kmm))          , umask (:,:,:), zzz, iu  )
+            CALL mpp_minloc( 'stpctl', ts(:,:,:,jp_sal,Kmm), tmask (:,:,:), zzz, is1 )
+            CALL mpp_maxloc( 'stpctl', ts(:,:,:,jp_sal,Kmm), tmask (:,:,:), zzz, is2 )
          ELSE
-            ih(:)  = MAXLOC( ABS( sshn(:,:)   )                              ) + (/ nimpp - 1, njmpp - 1    /)
-            iu(:)  = MAXLOC( ABS( un  (:,:,:) )                              ) + (/ nimpp - 1, njmpp - 1, 0 /)
-            is1(:) = MINLOC( tsn(:,:,:,jp_sal), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /)
-            is2(:) = MAXLOC( tsn(:,:,:,jp_sal), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /)
+            ! find local min and max locations
+            ih(:)  = MAXLOC( ABS( ssh(:,:,Kmm)   )                              ) + (/ nimpp - 1, njmpp - 1    /)
+            iu(:)  = MAXLOC( ABS( uu  (:,:,:,Kmm) )                              ) + (/ nimpp - 1, njmpp - 1, 0 /)
+            is1(:) = MINLOC( ts(:,:,:,jp_sal,Kmm), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /)
+            is2(:) = MAXLOC( ts(:,:,:,jp_sal,Kmm), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /)
          ENDIF
          
@@ -173,7 +176,7 @@
          WRITE(ctmp6,*) '      ===> output of last computed fields in output.abort.nc file'
          
-         CALL dia_wri_state( 'output.abort' )     ! create an output.abort file
+         CALL dia_wri_state( Kmm, 'output.abort' )     ! create an output.abort file
          
-         IF( .NOT. ln_ctl ) THEN
+         IF( .NOT. sn_cfctl%l_glochk ) THEN
             WRITE(ctmp8,*) 'E R R O R message from sub-domain: ', narea
             CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp8, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ctmp6 )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/timing.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/timing.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/timing.F90	(revision 12928)
@@ -390,5 +390,5 @@
             WRITE(numtime,'(A28,F11.6,A2, F4.1,A3,A25,I8)') 'Waiting  global time : ',timing_glob(4*ji-1)   &
                &                                                         , ' (',      zperc,' %)',   ' on MPI rank : ', ji
-            zsypd = rn_rdt * REAL(nitend-nit000-1, wp) / (timing_glob(4*ji) * 365.)
+            zsypd = rn_Dt * REAL(nitend-nit000-1, wp) / (timing_glob(4*ji) * 365.)
             WRITE(numtime,'(A28,F11.6,A7,F10.3,A2,A15,I8)') 'Total           time : ',timing_glob(4*ji  )   &
                &                                                         , ' (SYPD: ', zsypd, ')',   ' on MPI rank : ', ji
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/trc_oce.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/trc_oce.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/trc_oce.F90	(revision 12928)
@@ -26,5 +26,4 @@
    LOGICAL , PUBLIC ::   l_co2cpl  = .false.   !: atmospheric pco2 recieved from oasis
    LOGICAL , PUBLIC ::   l_offline = .false.   !: offline passive tracers flag
-   INTEGER , PUBLIC ::   nn_dttrc              !: frequency of step on passive tracers
    REAL(wp), PUBLIC ::   r_si2                 !: largest depth of extinction (blue & 0.01 mg.m-3)  (RGB)
    !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/vectopt_loop_substitute.h90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/vectopt_loop_substitute.h90	(revision 12384)
+++ 	(revision )
@@ -1,18 +1,0 @@
-   !!----------------------------------------------------------------------
-   !!                   ***  vectopt_loop_substitute  ***
-   !!----------------------------------------------------------------------
-   !! ** purpose :   substitute the inner loop start/end indices with CPP macro
-   !!                allow unrolling of do-loop (useful with vector processors)
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id$ 
-   !! Software governed by the CeCILL license (see ./LICENSE)
-   !!----------------------------------------------------------------------
-#if defined key_vectopt_loop
-#  define   fs_2       1
-#  define   fs_jpim1   jpi
-#else
-#  define   fs_2       2
-#  define   fs_jpim1   jpim1
-#endif
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OFF/dtadyn.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OFF/dtadyn.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OFF/dtadyn.F90	(revision 12928)
@@ -13,4 +13,5 @@
    !!             3.3  ! 2010-11 (C. Ethe) Full reorganization of the off-line: phasing with the on-line
    !!             3.4  ! 2011-05 (C. Ethe) Use of fldread
+   !!             4.1  ! 2019-08 (A. Coward, D. Storkey) split dta_dyn_sf_swp -> dta_dyn_sf_atf and dta_dyn_sf_interp
    !!----------------------------------------------------------------------
 
@@ -46,9 +47,10 @@
    PRIVATE
 
-   PUBLIC   dta_dyn_init       ! called by opa.F90
-   PUBLIC   dta_dyn            ! called by step.F90
-   PUBLIC   dta_dyn_sed_init   ! called by opa.F90
-   PUBLIC   dta_dyn_sed        ! called by step.F90
-   PUBLIC   dta_dyn_swp        ! called by step.F90
+   PUBLIC   dta_dyn_init       ! called by nemo_init
+   PUBLIC   dta_dyn            ! called by nemo_gcm
+   PUBLIC   dta_dyn_sed_init   ! called by nemo_init
+   PUBLIC   dta_dyn_sed        ! called by nemo_gcm
+   PUBLIC   dta_dyn_atf        ! called by nemo_gcm
+   PUBLIC   dta_dyn_sf_interp  ! called by nemo_gcm
 
    CHARACTER(len=100) ::   cn_dir          !: Root directory for location of ssr files
@@ -87,4 +89,6 @@
    INTEGER, SAVE  :: nprevrec, nsecdyn
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OFF 4.0 , NEMO Consortium (2018)
@@ -94,5 +98,5 @@
 CONTAINS
 
-   SUBROUTINE dta_dyn( kt )
+   SUBROUTINE dta_dyn( kt, Kbb, Kmm, Kaa )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dta_dyn  ***
@@ -105,5 +109,6 @@
       !!             - interpolates data if needed
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER, INTENT(in) ::   kt             ! ocean time-step index
+      INTEGER, INTENT(in) ::   Kbb, Kmm, Kaa  ! ocean time level indices
       !
       INTEGER             ::   ji, jj, jk
@@ -121,8 +126,8 @@
       CALL fld_read( kt, 1, sf_dyn )      !=  read data at kt time step   ==!
       !
-      IF( l_ldfslp .AND. .NOT.lk_c1d )   CALL  dta_dyn_slp( kt )    ! Computation of slopes
-      !
-      tsn(:,:,:,jp_tem) = sf_dyn(jf_tem)%fnow(:,:,:)  * tmask(:,:,:)    ! temperature
-      tsn(:,:,:,jp_sal) = sf_dyn(jf_sal)%fnow(:,:,:)  * tmask(:,:,:)    ! salinity
+      IF( l_ldfslp .AND. .NOT.lk_c1d )   CALL  dta_dyn_slp( kt, Kbb, Kmm )    ! Computation of slopes
+      !
+      ts(:,:,:,jp_tem,Kmm) = sf_dyn(jf_tem)%fnow(:,:,:)  * tmask(:,:,:)    ! temperature
+      ts(:,:,:,jp_sal,Kmm) = sf_dyn(jf_sal)%fnow(:,:,:)  * tmask(:,:,:)    ! salinity
       wndm(:,:)         = sf_dyn(jf_wnd)%fnow(:,:,1)  * tmask(:,:,1)    ! wind speed - needed for gas exchange
       fmmflx(:,:)       = sf_dyn(jf_fmf)%fnow(:,:,1)  * tmask(:,:,1)    ! downward salt flux (v3.5+)
@@ -132,10 +137,10 @@
       IF( ln_dynrnf ) THEN 
          rnf (:,:)      = sf_dyn(jf_rnf)%fnow(:,:,1) * tmask(:,:,1)    ! E-P
-         IF( ln_dynrnf_depth .AND. .NOT. ln_linssh )    CALL  dta_dyn_hrnf
-      ENDIF
-      !
-      un(:,:,:)        = sf_dyn(jf_uwd)%fnow(:,:,:) * umask(:,:,:)    ! effective u-transport
-      vn(:,:,:)        = sf_dyn(jf_vwd)%fnow(:,:,:) * vmask(:,:,:)    ! effective v-transport
-      wn(:,:,:)        = sf_dyn(jf_wwd)%fnow(:,:,:) * tmask(:,:,:)    ! effective v-transport
+         IF( ln_dynrnf_depth .AND. .NOT. ln_linssh )    CALL  dta_dyn_hrnf(Kmm)
+      ENDIF
+      !
+      uu(:,:,:,Kmm)        = sf_dyn(jf_uwd)%fnow(:,:,:) * umask(:,:,:)    ! effective u-transport
+      vv(:,:,:,Kmm)        = sf_dyn(jf_vwd)%fnow(:,:,:) * vmask(:,:,:)    ! effective v-transport
+      ww(:,:,:)        = sf_dyn(jf_wwd)%fnow(:,:,:) * tmask(:,:,:)    ! effective v-transport
       !
       IF( .NOT.ln_linssh ) THEN
@@ -144,5 +149,5 @@
          emp_b  (:,:)   = sf_dyn(jf_empb)%fnow(:,:,1) * tmask(:,:,1)    ! E-P
          zemp   (:,:)   = ( 0.5_wp * ( emp(:,:) + emp_b(:,:) ) + rnf(:,:) + fwbcorr ) * tmask(:,:,1)
-         CALL dta_dyn_ssh( kt, zhdivtr, sshb, zemp, ssha, e3t_a(:,:,:) )  !=  ssh, vertical scale factor & vertical transport
+         CALL dta_dyn_ssh( kt, zhdivtr, ssh(:,:,Kbb), zemp, ssh(:,:,Kaa), e3t(:,:,:,Kaa) )  !=  ssh, vertical scale factor & vertical transport
          DEALLOCATE( zemp , zhdivtr )
          !                                           Write in the tracer restart file
@@ -152,15 +157,15 @@
             IF(lwp) WRITE(numout,*) 'dta_dyn_ssh : ssh field written in tracer restart file at it= ', kt,' date= ', ndastp
             IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-            CALL iom_rstput( kt, nitrst, numrtw, 'sshn', ssha )
-            CALL iom_rstput( kt, nitrst, numrtw, 'sshb', sshn )
+            CALL iom_rstput( kt, nitrst, numrtw, 'sshn', ssh(:,:,Kaa) )
+            CALL iom_rstput( kt, nitrst, numrtw, 'sshb', ssh(:,:,Kmm) )
          ENDIF
       ENDIF
       !
-      CALL eos    ( tsn, rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop
-      CALL eos_rab( tsn, rab_n )       ! now    local thermal/haline expension ratio at T-points
-      CALL bn2    ( tsn, rab_n, rn2 ) ! before Brunt-Vaisala frequency need for zdfmxl
-
-      rn2b(:,:,:) = rn2(:,:,:)         ! need for zdfmxl
-      CALL zdf_mxl( kt )                                                   ! In any case, we need mxl
+      CALL eos    ( ts(:,:,:,:,Kmm), rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop
+      CALL eos_rab( ts(:,:,:,:,Kmm), rab_n, Kmm )       ! now    local thermal/haline expension ratio at T-points
+      CALL bn2    ( ts(:,:,:,:,Kmm), rab_n, rn2, Kmm )  ! before Brunt-Vaisala frequency need for zdfmxl
+
+      rn2b(:,:,:) = rn2(:,:,:)         ! needed for zdfmxl
+      CALL zdf_mxl( kt, Kmm )          ! In any case, we need mxl
       !
       hmld(:,:)       = sf_dyn(jf_mld)%fnow(:,:,1) * tmask(:,:,1)    ! mixed layer depht
@@ -174,12 +179,12 @@
       !
       !
-      CALL eos( tsn, rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop
-      !
-      IF(ln_ctl) THEN                  ! print control
-         CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' tn      - : ', mask1=tmask,  kdim=jpk   )
-         CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_sal), clinfo1=' sn      - : ', mask1=tmask,  kdim=jpk   )
-         CALL prt_ctl(tab3d_1=un               , clinfo1=' un      - : ', mask1=umask,  kdim=jpk   )
-         CALL prt_ctl(tab3d_1=vn               , clinfo1=' vn      - : ', mask1=vmask,  kdim=jpk   )
-         CALL prt_ctl(tab3d_1=wn               , clinfo1=' wn      - : ', mask1=tmask,  kdim=jpk   )
+      CALL eos( ts(:,:,:,:,Kmm), rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop
+      !
+      IF(sn_cfctl%l_prtctl) THEN                 ! print control
+         CALL prt_ctl(tab3d_1=ts(:,:,:,jp_tem,Kmm), clinfo1=' tn      - : ', mask1=tmask,  kdim=jpk   )
+         CALL prt_ctl(tab3d_1=ts(:,:,:,jp_sal,Kmm), clinfo1=' sn      - : ', mask1=tmask,  kdim=jpk   )
+         CALL prt_ctl(tab3d_1=uu(:,:,:,Kmm)               , clinfo1=' uu(:,:,:,Kmm)      - : ', mask1=umask,  kdim=jpk   )
+         CALL prt_ctl(tab3d_1=vv(:,:,:,Kmm)               , clinfo1=' vv(:,:,:,Kmm)      - : ', mask1=vmask,  kdim=jpk   )
+         CALL prt_ctl(tab3d_1=ww               , clinfo1=' ww      - : ', mask1=tmask,  kdim=jpk   )
          CALL prt_ctl(tab3d_1=avt              , clinfo1=' kz      - : ', mask1=tmask,  kdim=jpk   )
          CALL prt_ctl(tab3d_1=uslp             , clinfo1=' slp  - u : ', tab3d_2=vslp, clinfo2=' v : ', kdim=jpk)
@@ -192,5 +197,5 @@
 
 
-   SUBROUTINE dta_dyn_init
+   SUBROUTINE dta_dyn_init( Kbb, Kmm, Kaa )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dta_dyn_init  ***
@@ -199,4 +204,6 @@
       !! ** Method  : - read the data namdta_dyn namelist
       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   Kbb, Kmm, Kaa  ! ocean time level indices
+      !
       INTEGER  :: ierr, ierr0, ierr1, ierr2, ierr3   ! return error code
       INTEGER  :: ifpr                               ! dummy loop indice
@@ -225,8 +232,6 @@
       !!----------------------------------------------------------------------
       !
-      REWIND( numnam_ref )              ! Namelist namdta_dyn in reference namelist : Offline: init. of dynamical data
       READ  ( numnam_ref, namdta_dyn, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdta_dyn in reference namelist' )
-      REWIND( numnam_cfg )              ! Namelist namdta_dyn in configuration namelist : Offline: init. of dynamical data
       READ  ( numnam_cfg, namdta_dyn, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdta_dyn in configuration namelist' )
@@ -281,8 +286,9 @@
       ! Open file for each variable to get his number of dimension
       DO ifpr = 1, jfld
-         CALL fld_clopn( sf_dyn(ifpr), nyear, nmonth, nday )
+         CALL fld_def( sf_dyn(ifpr) )
+         CALL iom_open( sf_dyn(ifpr)%clname, sf_dyn(ifpr)%num )
          idv   = iom_varid( sf_dyn(ifpr)%num , slf_d(ifpr)%clvar )        ! id of the variable sdjf%clvar
          idimv = iom_file ( sf_dyn(ifpr)%num )%ndims(idv)                 ! number of dimension for variable sdjf%clvar
-         IF( sf_dyn(ifpr)%num /= 0 )   CALL iom_close( sf_dyn(ifpr)%num ) ! close file if already open
+         CALL iom_close( sf_dyn(ifpr)%num )                               ! close file if already open
          ierr1=0
          IF( idimv == 3 ) THEN    ! 2D variable
@@ -312,55 +318,51 @@
         IF( .NOT. sf_dyn(jf_uwd)%ln_clim .AND. ln_rsttr .AND.    &                     ! Restart: read in restart file
            iom_varid( numrtr, 'sshn', ldstop = .FALSE. ) > 0 ) THEN
-           IF(lwp) WRITE(numout,*) ' sshn forcing fields read in the restart file for initialisation'
-           CALL iom_get( numrtr, jpdom_autoglo, 'sshn', sshn(:,:)   )
-           CALL iom_get( numrtr, jpdom_autoglo, 'sshb', sshb(:,:)   )
+           IF(lwp) WRITE(numout,*) ' ssh(:,:,Kmm) forcing fields read in the restart file for initialisation'
+           CALL iom_get( numrtr, jpdom_autoglo, 'sshn', ssh(:,:,Kmm)   )
+           CALL iom_get( numrtr, jpdom_autoglo, 'sshb', ssh(:,:,Kbb)   )
         ELSE
-           IF(lwp) WRITE(numout,*) ' sshn forcing fields read in the restart file for initialisation'
+           IF(lwp) WRITE(numout,*) ' ssh(:,:,Kmm) forcing fields read in the restart file for initialisation'
            CALL iom_open( 'restart', inum )
-           CALL iom_get( inum, jpdom_autoglo, 'sshn', sshn(:,:)   )
-           CALL iom_get( inum, jpdom_autoglo, 'sshb', sshb(:,:)   )
+           CALL iom_get( inum, jpdom_autoglo, 'sshn', ssh(:,:,Kmm)   )
+           CALL iom_get( inum, jpdom_autoglo, 'sshb', ssh(:,:,Kbb)   )
            CALL iom_close( inum )                                        ! close file
         ENDIF
         !
         DO jk = 1, jpkm1
-           e3t_n(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + sshn(:,:) * tmask(:,:,1) / ( ht_0(:,:) + 1.0 - tmask(:,:,1) ) )
+           e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + ssh(:,:,Kmm) * tmask(:,:,1) / ( ht_0(:,:) + 1.0 - tmask(:,:,1) ) )
         ENDDO
-        e3t_a(:,:,jpk) = e3t_0(:,:,jpk)
+        e3t(:,:,jpk,Kaa) = e3t_0(:,:,jpk)
 
         ! Horizontal scale factor interpolations
         ! --------------------------------------
-        CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' )
-        CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' )
+        CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' )
+        CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' )
 
         ! Vertical scale factor interpolations
         ! ------------------------------------
-        CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n(:,:,:), 'W' )
+        CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w(:,:,:,Kmm), 'W' )
   
-        e3t_b(:,:,:)  = e3t_n(:,:,:)
-        e3u_b(:,:,:)  = e3u_n(:,:,:)
-        e3v_b(:,:,:)  = e3v_n(:,:,:)
+        e3t(:,:,:,Kbb)  = e3t(:,:,:,Kmm)
+        e3u(:,:,:,Kbb)  = e3u(:,:,:,Kmm)
+        e3v(:,:,:,Kbb)  = e3v(:,:,:,Kmm)
 
         ! t- and w- points depth
         ! ----------------------
-        gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)
-        gdepw_n(:,:,1) = 0.0_wp
-
-        DO jk = 2, jpk
-           DO jj = 1,jpj
-              DO ji = 1,jpi
-                !    zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))   ! 0 everywhere
-                !    tmask = wmask, ie everywhere expect at jk = mikt
-                                                                   ! 1 for jk =
-                                                                   ! mikt
-                 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))
-                 gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1)
-                 gdept_n(ji,jj,jk) =      zcoef  * ( gdepw_n(ji,jj,jk  ) + 0.5 * e3w_n(ji,jj,jk))  &
-                     &                + (1-zcoef) * ( gdept_n(ji,jj,jk-1) + e3w_n(ji,jj,jk))
-              END DO
-           END DO
-        END DO
-
-        gdept_b(:,:,:) = gdept_n(:,:,:)
-        gdepw_b(:,:,:) = gdepw_n(:,:,:)
+        gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm)
+        gdepw(:,:,1,Kmm) = 0.0_wp
+
+        DO_3D_11_11( 2, jpk )
+          !    zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))   ! 0 everywhere
+          !    tmask = wmask, ie everywhere expect at jk = mikt
+                                                             ! 1 for jk =
+                                                             ! mikt
+           zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))
+           gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm)
+           gdept(ji,jj,jk,Kmm) =      zcoef  * ( gdepw(ji,jj,jk  ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm))  &
+               &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm))
+        END_3D
+
+        gdept(:,:,:,Kbb) = gdept(:,:,:,Kmm)
+        gdepw(:,:,:,Kbb) = gdepw(:,:,:,Kmm)
         !
       ENDIF
@@ -374,30 +376,26 @@
          !
          nk_rnf(:,:) = 0                               ! set the number of level over which river runoffs are applied
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( h_rnf(ji,jj) > 0._wp ) THEN
-                  jk = 2
-                  DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1
-                  END DO
-                  nk_rnf(ji,jj) = jk
-               ELSEIF( h_rnf(ji,jj) == -1._wp   ) THEN   ;  nk_rnf(ji,jj) = 1
-               ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN   ;  nk_rnf(ji,jj) = mbkt(ji,jj)
-               ELSE
-                  CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999'  )
-                  WRITE(999,*) 'ji, jj, h_rnf(ji,jj) :', ji, jj, h_rnf(ji,jj)
-               ENDIF
+         DO_2D_11_11
+            IF( h_rnf(ji,jj) > 0._wp ) THEN
+               jk = 2
+               DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1
+               END DO
+               nk_rnf(ji,jj) = jk
+            ELSEIF( h_rnf(ji,jj) == -1._wp   ) THEN   ;  nk_rnf(ji,jj) = 1
+            ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN   ;  nk_rnf(ji,jj) = mbkt(ji,jj)
+            ELSE
+               CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999'  )
+               WRITE(999,*) 'ji, jj, h_rnf(ji,jj) :', ji, jj, h_rnf(ji,jj)
+            ENDIF
+         END_2D
+         DO_2D_11_11
+            h_rnf(ji,jj) = 0._wp
+            DO jk = 1, nk_rnf(ji,jj)
+               h_rnf(ji,jj) = h_rnf(ji,jj) + e3t(ji,jj,jk,Kmm)
             END DO
-         END DO
-         DO jj = 1, jpj                                ! set the associated depth
-            DO ji = 1, jpi
-               h_rnf(ji,jj) = 0._wp
-               DO jk = 1, nk_rnf(ji,jj)
-                  h_rnf(ji,jj) = h_rnf(ji,jj) + e3t_n(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         END_2D
       ELSE                                       ! runoffs applied at the surface
          nk_rnf(:,:) = 1
-         h_rnf (:,:) = e3t_n(:,:,1)
+         h_rnf (:,:) = e3t(:,:,1,Kmm)
       ENDIF
       nkrnf_max = MAXVAL( nk_rnf(:,:) )
@@ -411,9 +409,9 @@
       IF(lwp) WRITE(numout,*) ' '
       !
-      CALL dta_dyn( nit000 )
+      CALL dta_dyn( nit000, Kbb, Kmm, Kaa )
       !
    END SUBROUTINE dta_dyn_init
 
-   SUBROUTINE dta_dyn_sed( kt )
+   SUBROUTINE dta_dyn_sed( kt, Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dta_dyn  ***
@@ -427,4 +425,5 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER, INTENT(in) ::   Kmm  ! ocean time level index
       !
       !!----------------------------------------------------------------------
@@ -439,12 +438,12 @@
       CALL fld_read( kt, 1, sf_dyn )      !=  read data at kt time step   ==!
       !
-      tsn(:,:,:,jp_tem) = sf_dyn(jf_tem)%fnow(:,:,:)  * tmask(:,:,:)    ! temperature
-      tsn(:,:,:,jp_sal) = sf_dyn(jf_sal)%fnow(:,:,:)  * tmask(:,:,:)    ! salinity
-      !
-      CALL eos    ( tsn, rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop
-
-      IF(ln_ctl) THEN                  ! print control
-         CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' tn      - : ', mask1=tmask,  kdim=jpk   )
-         CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_sal), clinfo1=' sn      - : ', mask1=tmask,  kdim=jpk   )
+      ts(:,:,:,jp_tem,Kmm) = sf_dyn(jf_tem)%fnow(:,:,:)  * tmask(:,:,:)    ! temperature
+      ts(:,:,:,jp_sal,Kmm) = sf_dyn(jf_sal)%fnow(:,:,:)  * tmask(:,:,:)    ! salinity
+      !
+      CALL eos    ( ts(:,:,:,:,Kmm), rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop
+
+      IF(sn_cfctl%l_prtctl) THEN                     ! print control
+         CALL prt_ctl(tab3d_1=ts(:,:,:,jp_tem,Kmm), clinfo1=' tn      - : ', mask1=tmask,  kdim=jpk   )
+         CALL prt_ctl(tab3d_1=ts(:,:,:,jp_sal,Kmm), clinfo1=' sn      - : ', mask1=tmask,  kdim=jpk   )
       ENDIF
       !
@@ -454,5 +453,5 @@
 
 
-   SUBROUTINE dta_dyn_sed_init
+   SUBROUTINE dta_dyn_sed_init( Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dta_dyn_init  ***
@@ -461,4 +460,6 @@
       !! ** Method  : - read the data namdta_dyn namelist
       !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) :: Kmm                   ! ocean time level index
+      !
       INTEGER  :: ierr, ierr0, ierr1, ierr2, ierr3   ! return error code
       INTEGER  :: ifpr                               ! dummy loop indice
@@ -475,8 +476,6 @@
       !!----------------------------------------------------------------------
       !
-      REWIND( numnam_ref )              ! Namelist namdta_dyn in reference namelist : Offline: init. of dynamical data
       READ  ( numnam_ref, namdta_dyn, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdta_dyn in reference namelist' )
-      REWIND( numnam_cfg )              ! Namelist namdta_dyn in configuration namelist : Offline: init. of dynamical data
       READ  ( numnam_cfg, namdta_dyn, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdta_dyn in configuration namelist' )
@@ -508,8 +507,9 @@
       ! Open file for each variable to get his number of dimension
       DO ifpr = 1, jfld
-         CALL fld_clopn( sf_dyn(ifpr), nyear, nmonth, nday )
+         CALL fld_def( sf_dyn(ifpr) )
+         CALL iom_open( sf_dyn(ifpr)%clname, sf_dyn(ifpr)%num )
          idv   = iom_varid( sf_dyn(ifpr)%num , slf_d(ifpr)%clvar )        ! id of the variable sdjf%clvar
          idimv = iom_file ( sf_dyn(ifpr)%num )%ndims(idv)                 ! number of dimension for variable sdjf%clvar
-         IF( sf_dyn(ifpr)%num /= 0 )   CALL iom_close( sf_dyn(ifpr)%num ) ! close file if already open
+         CALL iom_close( sf_dyn(ifpr)%num )                               ! close file if already open
          ierr1=0
          IF( idimv == 3 ) THEN    ! 2D variable
@@ -525,16 +525,40 @@
       END DO
       !
-      CALL dta_dyn_sed( nit000 )
+      CALL dta_dyn_sed( nit000, Kmm )
       !
    END SUBROUTINE dta_dyn_sed_init
 
-   SUBROUTINE dta_dyn_swp( kt )
+   SUBROUTINE dta_dyn_atf( kt, Kbb, Kmm, Kaa )
      !!---------------------------------------------------------------------
       !!                    ***  ROUTINE dta_dyn_swp  ***
       !!
-      !! ** Purpose :   Swap and the data and compute the vertical scale factor 
-      !!              at U/V/W pointand the depht
-      !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) :: kt       ! time step
+      !! ** Purpose :   Asselin time filter of now SSH
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) :: kt             ! time step
+      INTEGER, INTENT(in) :: Kbb, Kmm, Kaa  ! ocean time level indices
+      !
+      !!---------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dta_dyn_atf : Asselin time filter of sea surface height'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
+      ENDIF
+
+      ssh(:,:,Kmm) = ssh(:,:,Kmm) + rn_atfp * ( ssh(:,:,Kbb) - 2 * ssh(:,:,Kmm) + ssh(:,:,Kaa))  
+
+      !! Do we also need to time filter e3t??
+      !
+   END SUBROUTINE dta_dyn_atf
+   
+   SUBROUTINE dta_dyn_sf_interp( kt, Kmm )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE dta_dyn_sf_interp  ***
+      !!
+      !! ** Purpose :   Calculate scale factors at U/V/W points and depths
+      !!                given the after e3t field
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) :: kt   ! time step
+      INTEGER, INTENT(in) :: Kmm  ! ocean time level indices
       !
       INTEGER             :: ji, jj, jk
@@ -542,52 +566,26 @@
       !!---------------------------------------------------------------------
 
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'ssh_swp : Asselin time filter and swap of sea surface height'
-         IF(lwp) WRITE(numout,*) '~~~~~~~ '
-      ENDIF
-
-      sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:))  ! before <-- now filtered
-      sshn(:,:) = ssha(:,:)
-
-      e3t_n(:,:,:) = e3t_a(:,:,:)
-
-      ! Reconstruction of all vertical scale factors at now and before time steps
-      ! =============================================================================
-
       ! Horizontal scale factor interpolations
       ! --------------------------------------
-      CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' )
-      CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' )
+      CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' )
+      CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' )
 
       ! Vertical scale factor interpolations
       ! ------------------------------------
-      CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W' )
-
-      e3t_b(:,:,:)  = e3t_n(:,:,:)
-      e3u_b(:,:,:)  = e3u_n(:,:,:)
-      e3v_b(:,:,:)  = e3v_n(:,:,:)
+      CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W' )
 
       ! t- and w- points depth
       ! ----------------------
-      gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)
-      gdepw_n(:,:,1) = 0.0_wp
-      !
-      DO jk = 2, jpk
-         DO jj = 1,jpj
-            DO ji = 1,jpi
-               zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))
-               gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1)
-               gdept_n(ji,jj,jk) =      zcoef  * ( gdepw_n(ji,jj,jk  ) + 0.5 * e3w_n(ji,jj,jk))  &
-                  &                + (1-zcoef) * ( gdept_n(ji,jj,jk-1) + e3w_n(ji,jj,jk))
-            END DO
-         END DO
-      END DO
-      !
-      gdept_b(:,:,:) = gdept_n(:,:,:)
-      gdepw_b(:,:,:) = gdepw_n(:,:,:)
-      !
-   END SUBROUTINE dta_dyn_swp
-   
+      gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm)
+      gdepw(:,:,1,Kmm) = 0.0_wp
+      !
+      DO_3D_11_11( 2, jpk )
+         zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))
+         gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm)
+         gdept(ji,jj,jk,Kmm) =      zcoef  * ( gdepw(ji,jj,jk  ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm))  &
+            &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm))
+      END_3D
+      !
+   END SUBROUTINE dta_dyn_sf_interp
 
    SUBROUTINE dta_dyn_ssh( kt, phdivtr, psshb,  pemp, pssha, pe3ta )
@@ -595,5 +593,5 @@
       !!                ***  ROUTINE dta_dyn_wzv  ***
       !!                   
-      !! ** Purpose :   compute the after ssh (ssha) and the now vertical velocity
+      !! ** Purpose :   compute the after ssh (ssh(:,:,Kaa)) and the now vertical velocity
       !!
       !! ** Method  : Using the incompressibility hypothesis, 
@@ -608,5 +606,5 @@
       !!          The boundary conditions are w=0 at the bottom (no flux)
       !!
-      !! ** action  :   ssha / e3t_a / wn
+      !! ** action  :   ssh(:,:,Kaa) / e3t(:,:,:,Kaa) / ww
       !!
       !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling.
@@ -624,5 +622,5 @@
       !!----------------------------------------------------------------------
       !
-      z2dt = 2._wp * rdt
+      z2dt = 2._wp * rn_Dt
       !
       zhdiv(:,:) = 0._wp
@@ -631,5 +629,5 @@
       END DO
       !                                                ! Sea surface  elevation time-stepping
-      pssha(:,:) = ( psshb(:,:) - z2dt * ( r1_rau0 * pemp(:,:)  + zhdiv(:,:) ) ) * ssmask(:,:)
+      pssha(:,:) = ( psshb(:,:) - z2dt * ( r1_rho0 * pemp(:,:)  + zhdiv(:,:) ) ) * ssmask(:,:)
       !                                                 ! 
       !                                                 ! After acale factors at t-points ( z_star coordinate )
@@ -641,5 +639,5 @@
 
 
-   SUBROUTINE dta_dyn_hrnf
+   SUBROUTINE dta_dyn_hrnf( Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE sbc_rnf  ***
@@ -654,15 +652,15 @@
       !!----------------------------------------------------------------------
       !!
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      !!----------------------------------------------------------------------
-      !
-      DO jj = 1, jpj                   ! update the depth over which runoffs are distributed
-         DO ji = 1, jpi
-            h_rnf(ji,jj) = 0._wp
-            DO jk = 1, nk_rnf(ji,jj)                           ! recalculates h_rnf to be the depth in metres
-                h_rnf(ji,jj) = h_rnf(ji,jj) + e3t_n(ji,jj,jk)   ! to the bottom of the relevant grid box
-            END DO
-        END DO
-      END DO
+      INTEGER, INTENT(in) :: Kmm  ! ocean time level index
+      !
+      INTEGER  ::   ji, jj, jk    ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      DO_2D_11_11
+         h_rnf(ji,jj) = 0._wp
+         DO jk = 1, nk_rnf(ji,jj)                           ! recalculates h_rnf to be the depth in metres
+             h_rnf(ji,jj) = h_rnf(ji,jj) + e3t(ji,jj,jk,Kmm)   ! to the bottom of the relevant grid box
+         END DO
+      END_2D
       !
    END SUBROUTINE dta_dyn_hrnf
@@ -670,5 +668,5 @@
 
 
-   SUBROUTINE dta_dyn_slp( kt )
+   SUBROUTINE dta_dyn_slp( kt, Kbb, Kmm )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE dta_dyn_slp  ***
@@ -678,4 +676,5 @@
       !!---------------------------------------------------------------------
       INTEGER,  INTENT(in) :: kt       ! time step
+      INTEGER,  INTENT(in) :: Kbb, Kmm ! ocean time level indices
       !
       INTEGER  ::   ji, jj     ! dummy loop indices
@@ -693,5 +692,5 @@
             zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,1) * tmask(:,:,:)   ! salinity 
             avt(:,:,:)        = sf_dyn(jf_avt)%fdta(:,:,:,1) * tmask(:,:,:)   ! vertical diffusive coef.
-            CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj )
+            CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj, Kbb, Kmm )
             uslpdta (:,:,:,1) = zuslp (:,:,:) 
             vslpdta (:,:,:,1) = zvslp (:,:,:) 
@@ -702,5 +701,5 @@
             zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,2) * tmask(:,:,:)   ! salinity 
             avt(:,:,:)        = sf_dyn(jf_avt)%fdta(:,:,:,2) * tmask(:,:,:)   ! vertical diffusive coef.
-            CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj )
+            CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj, Kbb, Kmm )
             uslpdta (:,:,:,2) = zuslp (:,:,:) 
             vslpdta (:,:,:,2) = zvslp (:,:,:) 
@@ -721,5 +720,5 @@
               zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,2) * tmask(:,:,:)   ! salinity 
               avt(:,:,:)        = sf_dyn(jf_avt)%fdta(:,:,:,2) * tmask(:,:,:)   ! vertical diffusive coef.
-              CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj )
+              CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj, Kbb, Kmm )
               !
               uslpdta (:,:,:,2) = zuslp (:,:,:) 
@@ -745,5 +744,5 @@
          zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fnow(:,:,:) * tmask(:,:,:)   ! salinity 
          avt(:,:,:)        = sf_dyn(jf_avt)%fnow(:,:,:) * tmask(:,:,:)   ! vertical diffusive coef.
-         CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj )
+         CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj, Kbb, Kmm )
          !
          IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN    ! Computes slopes (here avt is used as workspace)
@@ -758,5 +757,5 @@
 
 
-   SUBROUTINE compute_slopes( kt, pts, puslp, pvslp, pwslpi, pwslpj )
+   SUBROUTINE compute_slopes( kt, pts, puslp, pvslp, pwslpi, pwslpj, Kbb, Kmm )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE dta_dyn_slp  ***
@@ -770,22 +769,23 @@
       REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(out) :: pwslpi   ! zonal diapycnal slopes
       REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(out) :: pwslpj   ! meridional diapycnal slopes
+      INTEGER ,                              INTENT(in ) :: Kbb, Kmm ! ocean time level indices
       !!---------------------------------------------------------------------
       !
       IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN    ! Computes slopes (here avt is used as workspace)
          CALL eos    ( pts, rhd, rhop, gdept_0(:,:,:) )
-         CALL eos_rab( pts, rab_n )       ! now local thermal/haline expension ratio at T-points
-         CALL bn2    ( pts, rab_n, rn2  ) ! now    Brunt-Vaisala
+         CALL eos_rab( pts, rab_n, Kmm )       ! now local thermal/haline expension ratio at T-points
+         CALL bn2    ( pts, rab_n, rn2, Kmm  ) ! now    Brunt-Vaisala
 
       ! Partial steps: before Horizontal DErivative
       IF( ln_zps  .AND. .NOT. ln_isfcav)                            &
-         &            CALL zps_hde    ( kt, jpts, pts, gtsu, gtsv,  &  ! Partial steps: before horizontal gradient
+         &            CALL zps_hde    ( kt, Kmm, jpts, pts, gtsu, gtsv,  &  ! Partial steps: before horizontal gradient
          &                                        rhd, gru , grv    )  ! of t, s, rd at the last ocean level
       IF( ln_zps .AND.        ln_isfcav)                            &
-         &            CALL zps_hde_isf( kt, jpts, pts, gtsu, gtsv, gtui, gtvi, &  ! Partial steps for top cell (ISF)
+         &            CALL zps_hde_isf( kt, Kmm, jpts, pts, gtsu, gtsv, gtui, gtvi, &  ! Partial steps for top cell (ISF)
          &                                        rhd, gru , grv , grui, grvi )  ! of t, s, rd at the first ocean level
 
-         rn2b(:,:,:) = rn2(:,:,:)         ! need for zdfmxl
-         CALL zdf_mxl( kt )            ! mixed layer depth
-         CALL ldf_slp( kt, rhd, rn2 )  ! slopes
+         rn2b(:,:,:) = rn2(:,:,:)                ! needed for zdfmxl
+         CALL zdf_mxl( kt, Kmm )                 ! mixed layer depth
+         CALL ldf_slp( kt, rhd, rn2, Kbb, Kmm )  ! slopes
          puslp (:,:,:) = uslp (:,:,:)
          pvslp (:,:,:) = vslp (:,:,:)
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OFF/nemogcm.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OFF/nemogcm.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OFF/nemogcm.F90	(revision 12928)
@@ -7,4 +7,5 @@
    !!            3.4  ! 2011-01  (C. Ethe, A. R. Porter, STFC Daresbury) dynamical allocation
    !!            4.0  ! 2016-10  (C. Ethe, G. Madec, S. Flavoni)  domain configuration / user defined interface
+   !!            4.1  ! 2019-08  (A. Coward, D. Storkey) rewrite in preparation for new timestepping scheme
    !!----------------------------------------------------------------------
 
@@ -27,4 +28,6 @@
    USE usrdef_nam     ! user defined configuration
    USE eosbn2         ! equation of state            (eos bn2 routine)
+   USE bdy_oce,  ONLY : ln_bdy
+   USE bdyini         ! open boundary cond. setting       (bdy_init routine)
    !              ! ocean physics
    USE ldftra         ! lateral diffusivity setting    (ldf_tra_init routine)
@@ -59,4 +62,5 @@
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
    USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges
+   USE step, ONLY : Nbb, Nnn, Naa, Nrhs   ! time level indices
 
    IMPLICIT NONE
@@ -111,10 +115,21 @@
                                 CALL iom_setkt  ( istp - nit000 + 1, cxios_context )   ! say to iom that we are at time step kstp
 #if defined key_sed_off
-                                CALL dta_dyn_sed( istp )         ! Interpolation of the dynamical fields
+                                CALL dta_dyn_sed( istp,      Nnn      )       ! Interpolation of the dynamical fields
 #else
-                                CALL dta_dyn    ( istp )         ! Interpolation of the dynamical fields
-         IF( .NOT.ln_linssh )   CALL dta_dyn_swp( istp )         ! swap of sea  surface height and vertical scale factors
-#endif
-                                CALL trc_stp    ( istp )         ! time-stepping
+                                CALL dta_dyn    ( istp, Nbb, Nnn, Naa )       ! Interpolation of the dynamical fields
+#endif
+                                CALL trc_stp    ( istp, Nbb, Nnn, Nrhs, Naa ) ! time-stepping
+#if ! defined key_sed_off
+         IF( .NOT.ln_linssh )   CALL dta_dyn_atf( istp, Nbb, Nnn, Naa )       ! time filter of sea  surface height and vertical scale factors
+#endif
+         ! Swap time levels
+         Nrhs = Nbb
+         Nbb = Nnn
+         Nnn = Naa
+         Naa = Nrhs
+         !
+#if ! defined key_sed_off
+         IF( .NOT.ln_linssh )   CALL dta_dyn_sf_interp( istp, Nnn )  ! calculate now grid parameters
+#endif
                                 CALL stp_ctl    ( istp, indic )  ! Time loop: control and print
          istp = istp + 1
@@ -162,5 +177,5 @@
       INTEGER ::   ios, ilocal_comm   ! local integers
       !!
-      NAMELIST/namctl/ ln_ctl   , sn_cfctl, nn_print, nn_ictls, nn_ictle,   &
+      NAMELIST/namctl/ sn_cfctl, nn_print, nn_ictls, nn_ictle,              &
          &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,             &
          &             ln_timing, ln_diacfl
@@ -192,22 +207,44 @@
       IF( lwm )   CALL ctl_opn(     numout,        'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
       ! open reference and configuration namelist files
-                  CALL ctl_opn( numnam_ref,        'namelist_ref',     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
-                  CALL ctl_opn( numnam_cfg,        'namelist_cfg',     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
+                  CALL load_nml( numnam_ref,        'namelist_ref',                                           -1, lwm )
+                  CALL load_nml( numnam_cfg,        'namelist_cfg',                                           -1, lwm )
       IF( lwm )   CALL ctl_opn(     numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
       ! open /dev/null file to be able to supress output write easily
+      IF( Agrif_Root() ) THEN
                   CALL ctl_opn(     numnul,           '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
+#ifdef key_agrif
+      ELSE
+                  numnul = Agrif_Parent(numnul)   
+#endif
+      ENDIF
       !
       !                             !--------------------!
-      !                             ! Open listing units !  -> need ln_ctl from namctl to define lwp
+      !                             ! Open listing units !  -> need sn_cfctl from namctl to define lwp
       !                             !--------------------!
       !
-      REWIND( numnam_ref )              ! Namelist namctl in reference namelist
       READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namctl in reference namelist' )
-      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist
       READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namctl in configuration namelist' )
       !
-      lwp = (narea == 1) .OR. ln_ctl    ! control of all listing output print
+      ! finalize the definition of namctl variables
+      IF( sn_cfctl%l_allon ) THEN
+         ! Turn on all options.
+         CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. )
+         ! Ensure all processors are active
+         sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1
+      ELSEIF( sn_cfctl%l_config ) THEN
+         ! Activate finer control of report outputs
+         ! optionally switch off output from selected areas (note this only
+         ! applies to output which does not involve global communications)
+         IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. &
+           & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    &
+           &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. )
+      ELSE
+         ! turn off all options.
+         CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. )
+      ENDIF
+      !
+      lwp = (narea == 1) .OR. sn_cfctl%l_oceout    ! control of all listing output print
       !
       IF(lwp) THEN                            ! open listing units
@@ -241,17 +278,4 @@
       ENDIF
       !
-      ! finalize the definition of namctl variables
-      IF( sn_cfctl%l_config ) THEN
-         ! Activate finer control of report outputs
-         ! optionally switch off output from selected areas (note this only
-         ! applies to output which does not involve global communications)
-         IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. &
-           & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    &
-           &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. )
-      ELSE
-         ! Use ln_ctl to turn on or off all options.
-         CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. )
-      ENDIF
-      !
       IF(lwm) WRITE( numond, namctl )
       !
@@ -260,8 +284,6 @@
       !                             !------------------------------------!
       !     
-      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist
       READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
 903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist' )
-      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist
       READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist' )   
@@ -285,4 +307,7 @@
       CALL nemo_alloc()
 
+      ! Initialise time level indices
+      Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa
+
       !                             !-------------------------------!
       !                             !  NEMO general initialization  !
@@ -298,10 +323,12 @@
                            CALL     eos_init        ! Equation of state
       IF( lk_c1d       )   CALL     c1d_init        ! 1D column configuration
-                           CALL     dom_init("OPA") ! Domain
-      IF( ln_ctl       )   CALL prt_ctl_init        ! Print control
-
-                           CALL  istate_init    ! ocean initial state (Dynamics and tracers)
-
-                           CALL     sbc_init    ! Forcings : surface module
+                           CALL     dom_init( Nbb, Nnn, Naa, "OPA") ! Domain
+      IF( sn_cfctl%l_prtctl )   &
+         &                 CALL prt_ctl_init        ! Print control
+
+                           CALL  istate_init( Nnn, Naa )    ! ocean initial state (Dynamics and tracers)
+
+                           CALL     sbc_init( Nbb, Nnn, Naa )    ! Forcings : surface module
+                           CALL     bdy_init    ! Open boundaries initialisation    
 
       !                                      ! Tracer physics
@@ -317,10 +344,10 @@
                            CALL trc_rst_cal( nit000, 'READ' )   ! calendar
 #if defined key_sed_off
-                           CALL dta_dyn_sed_init ! Initialization for the dynamics
+                           CALL dta_dyn_sed_init(  Nnn      )        ! Initialization for the dynamics
 #else
-                           CALL dta_dyn_init   ! Initialization for the dynamics
-#endif
-
-                           CALL     trc_init   ! Passive tracers initialization
+                           CALL dta_dyn_init( Nbb, Nnn, Naa )        ! Initialization for the dynamics
+#endif
+
+                           CALL     trc_init( Nbb, Nnn, Naa )        ! Passive tracers initialization
                            CALL dia_ptr_init   ! Poleward TRansports initialization
                            
@@ -338,5 +365,5 @@
       !! ** Purpose :   control print setting
       !!
-      !! ** Method  : - print namctl information and check some consistencies
+      !! ** Method  : - print namctl and namcfg information and check some consistencies
       !!----------------------------------------------------------------------
       !
@@ -346,5 +373,6 @@
          WRITE(numout,*) '~~~~~~~~'
          WRITE(numout,*) '   Namelist namctl'
-         WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl
+         WRITE(numout,*) '                              sn_cfctl%l_glochk  = ', sn_cfctl%l_glochk
+         WRITE(numout,*) '                              sn_cfctl%l_allon   = ', sn_cfctl%l_allon
          WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config
          WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat
@@ -352,6 +380,7 @@
          WRITE(numout,*) '                              sn_cfctl%l_oceout  = ', sn_cfctl%l_oceout
          WRITE(numout,*) '                              sn_cfctl%l_layout  = ', sn_cfctl%l_layout
-         WRITE(numout,*) '                              sn_cfctl%l_mppout  = ', sn_cfctl%l_mppout
-         WRITE(numout,*) '                              sn_cfctl%l_mpptop  = ', sn_cfctl%l_mpptop
+         WRITE(numout,*) '                              sn_cfctl%l_prtctl  = ', sn_cfctl%l_prtctl
+         WRITE(numout,*) '                              sn_cfctl%l_prttrc  = ', sn_cfctl%l_prttrc
+         WRITE(numout,*) '                              sn_cfctl%l_oasout  = ', sn_cfctl%l_oasout
          WRITE(numout,*) '                              sn_cfctl%procmin   = ', sn_cfctl%procmin  
          WRITE(numout,*) '                              sn_cfctl%procmax   = ', sn_cfctl%procmax  
@@ -391,5 +420,5 @@
       !                             ! Parameter control
       !
-      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints
+      IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN              ! sub-domain area indices for the control prints
          IF( lk_mpp .AND. jpnij > 1 ) THEN
             isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain
@@ -446,7 +475,4 @@
       !
       IF( numstp     /= -1 )   CLOSE( numstp     )   ! time-step file
-      IF( numnam_ref /= -1 )   CLOSE( numnam_ref )   ! oce reference namelist
-      IF( numnam_cfg /= -1 )   CLOSE( numnam_cfg )   ! oce configuration namelist
-      IF( numout     /=  6 )   CLOSE( numout     )   ! standard model output file
       IF( lwm.AND.numond  /= -1 )   CLOSE( numond          )   ! oce output namelist
       !
@@ -468,4 +494,5 @@
       USE zdf_oce,   ONLY : zdf_oce_alloc
       USE trc_oce,   ONLY : trc_oce_alloc
+      USE bdy_oce,   ONLY : bdy_oce_alloc
       !
       INTEGER :: ierr
@@ -477,4 +504,5 @@
       ierr = ierr + zdf_oce_alloc()          ! ocean vertical physics
       ierr = ierr + trc_oce_alloc()          ! shared TRC / TRA arrays
+      ierr = ierr + bdy_oce_alloc()    ! bdy masks (incl. initialization)      
       !
       CALL mpp_sum( 'nemogcm', ierr )
@@ -506,9 +534,10 @@
       sn_cfctl%l_oceout  = setto
       sn_cfctl%l_layout  = setto
-      sn_cfctl%l_mppout  = setto
-      sn_cfctl%l_mpptop  = setto
+      sn_cfctl%l_prtctl  = setto
+      sn_cfctl%l_prttrc  = setto
+      sn_cfctl%l_oasout  = setto
    END SUBROUTINE nemo_set_cfctl
 
-   SUBROUTINE istate_init
+   SUBROUTINE istate_init( Kmm, Kaa )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE istate_init  ***
@@ -516,11 +545,12 @@
       !! ** Purpose :   Initialization to zero of the dynamics and tracers.
       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   Kmm, Kaa  ! ocean time level indices
       !
       !     now fields         !     after fields      !
-      un   (:,:,:)   = 0._wp   ;   ua(:,:,:) = 0._wp   !
-      vn   (:,:,:)   = 0._wp   ;   va(:,:,:) = 0._wp   !
-      wn   (:,:,:)   = 0._wp   !                       !
-      hdivn(:,:,:)   = 0._wp   !                       !
-      tsn  (:,:,:,:) = 0._wp   !                       !
+      uu   (:,:,:,Kmm)   = 0._wp   ;   uu(:,:,:,Kaa) = 0._wp   !
+      vv   (:,:,:,Kmm)   = 0._wp   ;   vv(:,:,:,Kaa) = 0._wp   !
+      ww   (:,:,:)   = 0._wp   !                       !
+      hdiv (:,:,:)   = 0._wp   !                       !
+      ts  (:,:,:,:,Kmm) = 0._wp   !                       !
       !
       rhd  (:,:,:) = 0.e0
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/README.rst
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/README.rst	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/README.rst	(revision 12928)
@@ -0,0 +1,15 @@
+*******
+Sources
+*******
+
+.. todo::
+
+
+
+:file:`ICE`: |NEMO-ICE|
+
+:file:`NST`: AGRIF for embedded zooms
+
+:file:`OCE`: |NEMO-OCE|
+
+:file:`TOP`: |NEMO-MBG|
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/SAO/nemogcm.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/SAO/nemogcm.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/SAO/nemogcm.F90	(revision 12928)
@@ -29,4 +29,5 @@
    USE sao_intp
    !
+   USE in_out_manager ! I/O manager
    USE lib_mpp        ! distributed memory computing
    USE mppini         ! shared/distributed memory setting (mpp_init routine)
@@ -91,5 +92,5 @@
       INTEGER ::   ios, ilocal_comm   ! local integer
       !
-      NAMELIST/namctl/ ln_ctl   , sn_cfctl, nn_print, nn_ictls, nn_ictle,   &
+      NAMELIST/namctl/ sn_cfctl,  nn_print, nn_ictls, nn_ictle,             &
          &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,             &
          &             ln_timing, ln_diacfl
@@ -135,22 +136,44 @@
       IF( lwm )   CALL ctl_opn(     numout,        'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
       ! open reference and configuration namelist files
-                  CALL ctl_opn( numnam_ref,        'namelist_ref',     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
-                  CALL ctl_opn( numnam_cfg,        'namelist_cfg',     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
+                  CALL load_nml( numnam_ref,        'namelist_ref',                                           -1, lwm )
+                  CALL load_nml( numnam_cfg,        'namelist_cfg',                                           -1, lwm )
       IF( lwm )   CALL ctl_opn(     numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
       ! open /dev/null file to be able to supress output write easily
+      IF( Agrif_Root() ) THEN
                   CALL ctl_opn(     numnul,           '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
+#ifdef key_agrif
+      ELSE
+                  numnul = Agrif_Parent(numnul)   
+#endif
+      ENDIF
       !
       !                             !--------------------!
-      !                             ! Open listing units !  -> need ln_ctl from namctl to define lwp
+      !                             ! Open listing units !  -> need sn_cfctl from namctl to define lwp
       !                             !--------------------!
       !
-      REWIND( numnam_ref )              ! Namelist namctl in reference namelist
       READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namctl in reference namelist' )
-      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist
       READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namctl in configuration namelist' )
       !
-      lwp = (narea == 1) .OR. ln_ctl    ! control of all listing output print
+      ! finalize the definition of namctl variables
+      IF( sn_cfctl%l_allon ) THEN
+         ! Turn on all options.
+         CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. )
+         ! Ensure all processors are active
+         sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1
+      ELSEIF( sn_cfctl%l_config ) THEN
+         ! Activate finer control of report outputs
+         ! optionally switch off output from selected areas (note this only
+         ! applies to output which does not involve global communications)
+         IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. &
+           & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    &
+           &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. )
+      ELSE
+         ! turn off all options.
+         CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. )
+      ENDIF
+      !
+      lwp = (narea == 1) .OR. sn_cfctl%l_oceout    ! control of all listing output print
       !
       IF(lwp) THEN                      ! open listing units
@@ -184,17 +207,4 @@
       ENDIF
       !
-      ! finalize the definition of namctl variables
-      IF( sn_cfctl%l_config ) THEN
-         ! Activate finer control of report outputs
-         ! optionally switch off output from selected areas (note this only
-         ! applies to output which does not involve global communications)
-         IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. &
-           & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    &
-           &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. )
-      ELSE
-         ! Use ln_ctl to turn on or off all options.
-         CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. )
-      ENDIF
-      !
       IF(lwm) WRITE( numond, namctl )
       !
@@ -203,8 +213,6 @@
       !                             !------------------------------------!
       !
-      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist
       READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
 903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist' )
-      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist
       READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist' )   
@@ -238,10 +246,11 @@
                            CALL phy_cst            ! Physical constants
                            CALL eos_init           ! Equation of state
-                           CALL dom_init('SAO')    ! Domain
-
-
-      IF( ln_ctl       )   CALL prt_ctl_init    ! Print control
-
-                           CALL istate_init     ! ocean initial state (Dynamics and tracers)
+                           CALL dom_init( Nbb, Nnn, Naa, 'SAO')    ! Domain
+
+
+      IF( sn_cfctl%l_prtctl )   &
+         &                 CALL prt_ctl_init       ! Print control
+
+                           CALL istate_init        ! ocean initial state (Dynamics and tracers)
    END SUBROUTINE nemo_init
 
@@ -253,5 +262,5 @@
       !! ** Purpose :   control print setting
       !!
-      !! ** Method  : - print namctl information and check some consistencies
+      !! ** Method  : - print namctl and namcfg information and check some consistencies
       !!----------------------------------------------------------------------
       !
@@ -261,5 +270,6 @@
          WRITE(numout,*) '~~~~~~~~'
          WRITE(numout,*) '   Namelist namctl'
-         WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl
+         WRITE(numout,*) '                              sn_cfctl%l_glochk  = ', sn_cfctl%l_glochk
+         WRITE(numout,*) '                              sn_cfctl%l_allon   = ', sn_cfctl%l_allon
          WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config
          WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat
@@ -267,6 +277,7 @@
          WRITE(numout,*) '                              sn_cfctl%l_oceout  = ', sn_cfctl%l_oceout
          WRITE(numout,*) '                              sn_cfctl%l_layout  = ', sn_cfctl%l_layout
-         WRITE(numout,*) '                              sn_cfctl%l_mppout  = ', sn_cfctl%l_mppout
-         WRITE(numout,*) '                              sn_cfctl%l_mpptop  = ', sn_cfctl%l_mpptop
+         WRITE(numout,*) '                              sn_cfctl%l_prtctl  = ', sn_cfctl%l_prtctl
+         WRITE(numout,*) '                              sn_cfctl%l_prttrc  = ', sn_cfctl%l_prttrc
+         WRITE(numout,*) '                              sn_cfctl%l_oasout  = ', sn_cfctl%l_oasout
          WRITE(numout,*) '                              sn_cfctl%procmin   = ', sn_cfctl%procmin  
          WRITE(numout,*) '                              sn_cfctl%procmax   = ', sn_cfctl%procmax  
@@ -306,5 +317,5 @@
       !                             ! Parameter control
       !
-      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints
+      IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN              ! sub-domain area indices for the control prints
          IF( lk_mpp .AND. jpnij > 1 ) THEN
             isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain
@@ -363,9 +374,5 @@
       IF( numstp          /= -1 )   CLOSE( numstp          )   ! time-step file
       IF( numrun          /= -1 )   CLOSE( numrun          )   ! run statistics file
-      IF( numnam_ref      /= -1 )   CLOSE( numnam_ref      )   ! oce reference namelist
-      IF( numnam_cfg      /= -1 )   CLOSE( numnam_cfg      )   ! oce configuration namelist
       IF( lwm.AND.numond  /= -1 )   CLOSE( numond          )   ! oce output namelist
-      IF( numnam_ice_ref  /= -1 )   CLOSE( numnam_ice_ref  )   ! ice reference namelist
-      IF( numnam_ice_cfg  /= -1 )   CLOSE( numnam_ice_cfg  )   ! ice configuration namelist
       IF( lwm.AND.numoni  /= -1 )   CLOSE( numoni          )   ! ice output namelist
       IF( numevo_ice      /= -1 )   CLOSE( numevo_ice      )   ! ice variables (temp. evolution)
@@ -426,6 +433,7 @@
       sn_cfctl%l_oceout  = setto
       sn_cfctl%l_layout  = setto
-      sn_cfctl%l_mppout  = setto
-      sn_cfctl%l_mpptop  = setto
+      sn_cfctl%l_prtctl  = setto
+      sn_cfctl%l_prttrc  = setto
+      sn_cfctl%l_oasout  = setto
    END SUBROUTINE nemo_set_cfctl
 
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/SAO/sao_data.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/SAO/sao_data.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/SAO/sao_data.F90	(revision 12928)
@@ -52,8 +52,6 @@
 
       ! Standard offline obs_oper settings
-      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints & Benchmark
       READ  ( numnam_ref, namsao, IOSTAT = ios, ERR = 901 )
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsao in reference namelist' )
-      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist : Control prints & Benchmark
       READ  ( numnam_cfg, namsao, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsao in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/SAS/daymod.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/SAS/daymod.F90	(revision 12384)
+++ 	(revision )
@@ -1,419 +1,0 @@
-MODULE daymod
-   !!======================================================================
-   !!                       ***  MODULE  daymod  ***
-   !! Ocean :   management of the model calendar
-   !!=====================================================================
-   !! History :  OPA  ! 1994-09  (M. Pontaud M. Imbard)  Original code
-   !!                 ! 1997-03  (O. Marti)
-   !!                 ! 1997-05  (G. Madec)
-   !!                 ! 1997-08  (M. Imbard)
-   !!   NEMO     1.0  ! 2003-09  (G. Madec)  F90 + nyear, nmonth, nday
-   !!                 ! 2004-01  (A.M. Treguier) new calculation based on adatrj
-   !!                 ! 2006-08  (G. Madec)  surface module major update
-   !!                 ! 2015-11  (D. Lea) Allow non-zero initial time of day
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   day        : calendar
-   !!----------------------------------------------------------------------
-   !!                    ----------- WARNING -----------
-   !!                    -------------------------------
-   !!   sbcmod assume that the time step is dividing the number of second of 
-   !!   in a day, i.e. ===> MOD( rday, rdt ) == 0 
-   !!   except when user defined forcing is used (see sbcmod.F90)
-   !!----------------------------------------------------------------------
-   USE dom_oce        ! ocean space and time domain
-   USE phycst         ! physical constants
-   USE ioipsl  , ONLY :   ymds2ju      ! for calendar
-   USE trc_oce , ONLY :   l_offline   ! offline flag
-   !
-   USE in_out_manager ! I/O manager
-   USE prtctl         ! Print control
-   USE iom            ! I/O manager
-   USE timing         ! Timing
-   USE restart        ! restart
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   day        ! called by step.F90
-   PUBLIC   day_init   ! called by istate.F90
-   PUBLIC   day_mth    ! Needed by TAM
-
-   INTEGER, PUBLIC ::   nsecd, nsecd05, ndt, ndt05   !: (PUBLIC for TAM)
-
-   !!----------------------------------------------------------------------
-   !! NEMO/SAS 4.0 , NEMO Consortium (2018)
-   !! $Id$
-   !! Software governed by the CeCILL license (see ./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE day_init
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE day_init  ***
-      !!
-      !! ** Purpose :   Initialization of the calendar values to their values 1 time step before nit000
-      !!                because day will be called at the beginning of step
-      !!
-      !! ** 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
-      !!              - nsec_year    : current time step counted in second since 00h jan 1st of the current year
-      !!              - nsec_month   : current time step counted in second since 00h 1st day of the current month
-      !!              - nsec_day     : current time step counted in second since 00h of the current day
-      !!              - nsec1jan000  : second since Jan. 1st 00h of nit000 year and Jan. 1st 00h of the current year
-      !!              - nmonth_len, nyear_len, nmonth_half, nmonth_end through day_mth
-      !!----------------------------------------------------------------------
-      INTEGER  ::   inbday, idweek   ! local integers
-      REAL(wp) ::   zjul             ! local scalar
-      !!----------------------------------------------------------------------
-      !
-      ! max number of seconds between each restart
-      IF( REAL( nitend - nit000 + 1 ) * rdt > REAL( HUGE( nsec1jan000 ) ) ) THEN
-         CALL ctl_stop( 'The number of seconds between each restart exceeds the integer 4 max value: 2^31-1. ',   &
-            &           'You must do a restart at higher frequency (or remove this stop and recompile the code in I8)' )
-      ENDIF
-      nsecd   = NINT( rday       )
-      nsecd05 = NINT( 0.5 * rday )
-      ndt     = NINT(       rdt  )
-      ndt05   = NINT( 0.5 * rdt  )
-
-      IF( .NOT. l_offline )   CALL day_rst( nit000, 'READ' )
-
-      ! set the calandar from ndastp (read in restart file and namelist)
-      nyear   =   ndastp / 10000
-      nmonth  = ( ndastp - (nyear * 10000) ) / 100
-      nday    =   ndastp - (nyear * 10000) - ( nmonth * 100 )
-
-      nhour   =   nn_time0 / 100
-      nminute = ( nn_time0 - nhour * 100 )
-
-      CALL ymds2ju( nyear, nmonth, nday, nhour*3600._wp+nminute*60._wp, fjulday )  
-      IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < 0.1 / rday )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error
-      IF( nn_time0*3600 - ndt05 .lt. 0 ) fjulday = fjulday + 1.                    ! move back to the day at nit000 (and not at nit000 - 1)
-
-      nsec1jan000 = 0
-      CALL day_mth
-
-      IF ( nday == 0 ) THEN     !   for ex if ndastp = ndate0 - 1
-         nmonth = nmonth - 1
-         nday = nmonth_len(nmonth)
-      ENDIF
-      IF ( nmonth == 0 ) THEN   ! go at the end of previous year
-         nmonth = 12
-         nyear = nyear - 1
-         nsec1jan000 = nsec1jan000 - nsecd * nyear_len(0)
-         IF( nleapy == 1 )   CALL day_mth
-      ENDIF
-
-      ! day since january 1st
-      nday_year = nday + SUM( nmonth_len(1:nmonth - 1) )
-
-      !compute number of days between last monday and today
-      CALL ymds2ju( 1900, 01, 01, 0.0, zjul )  ! compute julian day value of 01.01.1900 (our reference that was a Monday)
-      inbday = FLOOR(fjulday - zjul)            ! compute nb day between  01.01.1900 and start of current day
-      idweek = MOD(inbday, 7)                  ! compute nb day between last monday and current day
-      IF (idweek .lt. 0) idweek=idweek+7       ! Avoid negative values for dates before 01.01.1900
-
-      ! number of seconds since the beginning of current year/month/week/day at the middle of the time-step
-      IF (nhour*3600+nminute*60-ndt05 .gt. 0) THEN
-         ! 1 timestep before current middle of first time step is still the same day
-         nsec_year  = (nday_year-1) * nsecd + nhour*3600+nminute*60 - ndt05 
-         nsec_month = (nday-1)      * nsecd + nhour*3600+nminute*60 - ndt05    
-      ELSE
-         ! 1 time step before the middle of the first time step is the previous day 
-         nsec_year  = nday_year * nsecd + nhour*3600+nminute*60 - ndt05 
-         nsec_month = nday      * nsecd + nhour*3600+nminute*60 - ndt05   
-      ENDIF
-      nsec_week  = idweek    * nsecd + nhour*3600+nminute*60 - ndt05
-      nsec_day   =             nhour*3600+nminute*60 - ndt05 
-      IF( nsec_day .lt. 0 ) nsec_day = nsec_day + nsecd
-      IF( nsec_week .lt. 0 ) nsec_week = nsec_week + nsecd*7
-
-      ! control print
-      IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i8,a,i8,a,i8,a,i8)')   &
-           &                   ' =======>> 1/2 time step before the start of the run DATE Y/M/D = ',   &
-           &                   nyear, '/', nmonth, '/', nday, '  nsec_day:', nsec_day, '  nsec_week:', nsec_week, '  &
-           &                   nsec_month:', nsec_month , '  nsec_year:' , nsec_year
-
-      ! Up to now, calendar parameters are related to the end of previous run (nit000-1)
-      ! call day to set the calendar parameters at the begining of the current simulaton. needed by iom_init
-      CALL day( nit000 )
-      IF( lwxios ) THEN
-        CALL iom_set_rstw_var_active('kt')
-        CALL iom_set_rstw_var_active('ndastp')
-        CALL iom_set_rstw_var_active('adatrj')
-        CALL iom_set_rstw_var_active('ntime')
-      ENDIF
-      !
-   END SUBROUTINE day_init
-
-
-   SUBROUTINE day_mth
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE day_init  ***
-      !!
-      !! ** Purpose :   calendar values related to the months
-      !!
-      !! ** Action  : - nmonth_len    : length in days of the months of the current year
-      !!              - nyear_len     : length in days of the previous/current year
-      !!              - nmonth_half   : second since the beginning of the year and the halft of the months
-      !!              - nmonth_end    : second since the beginning of the year and the end of the months
-      !!----------------------------------------------------------------------
-      INTEGER  ::   jm               ! dummy loop indice
-      !!----------------------------------------------------------------------
-
-      ! length of the month of the current year (from nleapy, read in namelist)
-      IF ( nleapy < 2 ) THEN
-         nmonth_len(:) = (/ 31, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31, 31 /)
-         nyear_len(:) = 365
-         IF ( nleapy == 1 ) THEN   ! we are using calandar with leap years
-            IF ( MOD(nyear-1, 4) == 0 .AND. ( MOD(nyear-1, 400) == 0 .OR. MOD(nyear-1, 100) /= 0 ) ) THEN
-               nyear_len(0)  = 366
-            ENDIF
-            IF ( MOD(nyear  , 4) == 0 .AND. ( MOD(nyear  , 400) == 0 .OR. MOD(nyear  , 100) /= 0 ) ) THEN
-               nmonth_len(2) = 29
-               nyear_len(1)  = 366
-            ENDIF
-            IF ( MOD(nyear+1, 4) == 0 .AND. ( MOD(nyear+1, 400) == 0 .OR. MOD(nyear+1, 100) /= 0 ) ) THEN
-               nyear_len(2)  = 366
-            ENDIF
-         ENDIF
-      ELSE
-         nmonth_len(:) = nleapy   ! all months with nleapy days per year
-         nyear_len(:) = 12 * nleapy
-      ENDIF
-
-      ! half month in second since the begining of the year:
-      ! time since Jan 1st   0     1     2    ...    11    12    13
-      !          ---------*--|--*--|--*--| ... |--*--|--*--|--*--|--------------------------------------
-      !                 <---> <---> <--->  ...  <---> <---> <--->
-      ! month number      0     1     2    ...    11    12    13
-      !
-      ! nmonth_half(jm) = rday * REAL( 0.5 * nmonth_len(jm) + SUM(nmonth_len(1:jm-1)) )
-      nmonth_half(0) = - nsecd05 * nmonth_len(0)
-      DO jm = 1, 13
-         nmonth_half(jm) = nmonth_half(jm-1) + nsecd05 * ( nmonth_len(jm-1) + nmonth_len(jm) )
-      END DO
-
-      nmonth_end(0) = 0
-      DO jm = 1, 13
-         nmonth_end(jm) = nmonth_end(jm-1) + nsecd * nmonth_len(jm)
-      END DO
-      !
-   END SUBROUTINE
-
-
-   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 run
-      !!              - nsec_year : current time of the year (in second since 00h, jan 1st)
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt        ! ocean time-step indices
-      !
-      CHARACTER (len=25) ::   charout
-      REAL(wp)           ::   zprec      ! fraction of day corresponding to 0.1 second
-      !!----------------------------------------------------------------------
-      !
-      IF( ln_timing )   CALL timing_start('day')
-      !
-      zprec = 0.1 / rday
-      !                                                 ! New time-step
-      nsec_year  = nsec_year  + ndt
-      nsec_month = nsec_month + ndt
-      nsec_week  = nsec_week  + ndt
-      nsec_day   = nsec_day   + ndt
-      adatrj  = adatrj  + rdt / rday
-      fjulday = fjulday + rdt / rday
-      IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < zprec )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error
-      IF( ABS(adatrj  - REAL(NINT(adatrj ),wp)) < zprec )   adatrj  = REAL(NINT(adatrj ),wp)   ! avoid truncation error
-
-      IF( nsec_day > nsecd ) THEN                       ! New day
-         !
-         nday      = nday + 1
-         nday_year = nday_year + 1
-         nsec_day  = ndt05
-         !
-         IF( nday == nmonth_len(nmonth) + 1 ) THEN      ! New month
-            nday   = 1
-            nmonth = nmonth + 1
-            nsec_month = ndt05
-            IF( nmonth == 13 ) THEN                     ! New year
-               nyear     = nyear + 1
-               nmonth    = 1
-               nday_year = 1
-               nsec_year = ndt05
-               nsec1jan000 = nsec1jan000 + nsecd * nyear_len(1)
-               IF( nleapy == 1 )   CALL day_mth
-            ENDIF
-         ENDIF
-         !
-         ndastp = nyear * 10000 + nmonth * 100 + nday   ! New date
-         !
-         !compute first day of the year in julian days
-         CALL ymds2ju( nyear, 01, 01, 0.0, fjulstartyear )
-         !
-         IF(lwp) WRITE(numout,'(a,i8,a,i4.4,a,i2.2,a,i2.2,a,i3.3)') '======>> time-step =', kt,   &
-              &   '      New day, DATE Y/M/D = ', nyear, '/', nmonth, '/', nday, '      nday_year = ', nday_year
-         IF(lwp) WRITE(numout,'(a,i8,a,i7,a,i5)') '         nsec_year = ', nsec_year,   &
-              &   '   nsec_month = ', nsec_month, '   nsec_day = ', nsec_day, '   nsec_week = ', nsec_week
-      ENDIF
-
-      IF( nsec_week > 7*nsecd )   nsec_week = ndt05     ! New week
-
-      IF(ln_ctl) THEN
-         WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear
-         CALL prt_ctl_info(charout)
-      ENDIF
-
-      IF( .NOT. l_offline ) CALL rst_opn( kt )               ! Open the restart file if needed and control lrst_oce
-      IF( lrst_oce         ) CALL day_rst( kt, 'WRITE' )      ! write day restart information
-      !
-      IF( ln_timing )   CALL timing_stop('day')
-      !
-   END SUBROUTINE day
-
-
-   SUBROUTINE day_rst( kt, cdrw )
-      !!---------------------------------------------------------------------
-      !!                   ***  ROUTINE ts_rst  ***
-      !!
-      !!  ** Purpose : Read or write calendar in restart file:
-      !!
-      !!  WRITE(READ) mode:
-      !!       kt        : number of time step since the begining of the experiment at the
-      !!                   end of the current(previous) run
-      !!       adatrj(0) : number of elapsed days since the begining of the experiment at the
-      !!                   end of the current(previous) run (REAL -> keep fractions of day)
-      !!       ndastp    : date at the end of the current(previous) run (coded as yyyymmdd integer)
-      !!
-      !!   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.
-      !!----------------------------------------------------------------------
-      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
-      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
-      !
-      REAL(wp) ::   zkt, zndastp, zdayfrac, ksecs, ktime
-      INTEGER  ::   ihour, iminute
-      !!----------------------------------------------------------------------
-
-      IF( TRIM(cdrw) == 'READ' ) THEN
-
-         IF( iom_varid( numror, 'kt', ldstop = .FALSE. ) > 0 ) THEN
-            ! Get Calendar informations
-            CALL iom_get( numror, 'kt', zkt, ldxios = lrxios )   ! last time-step of previous run
-            IF(lwp) THEN
-               WRITE(numout,*) ' *** Info read in restart : '
-               WRITE(numout,*) '   previous time-step                               : ', NINT( zkt )
-               WRITE(numout,*) ' *** restart option'
-               SELECT CASE ( nrstdt )
-               CASE ( 0 )   ;   WRITE(numout,*) ' nrstdt = 0 : no control of nit000'
-               CASE ( 1 )   ;   WRITE(numout,*) ' nrstdt = 1 : no control the date at nit000 (use ndate0 read in the namelist)'
-               CASE ( 2 )   ;   WRITE(numout,*) ' nrstdt = 2 : calendar parameters read in restart'
-               END SELECT
-               WRITE(numout,*)
-            ENDIF
-            ! Control of date
-            IF( nit000 - NINT( zkt ) /= 1 .AND. nrstdt /= 0 )                                         &
-                 &   CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart',                 &
-                 &                  ' verify the restart file or rerun with nrstdt = 0 (namelist)' )
-            ! define ndastp and adatrj
-            IF ( nrstdt == 2 ) THEN
-               ! read the parameters corresponding to nit000 - 1 (last time step of previous run)
-               CALL iom_get( numror, 'ndastp', zndastp, ldxios = lrxios )
-               ndastp = NINT( zndastp )
-               CALL iom_get( numror, 'adatrj', adatrj , ldxios = lrxios )
-	       CALL iom_get( numror, 'ntime' , ktime  , ldxios = lrxios )
-	       nn_time0=INT(ktime)
-               ! calculate start time in hours and minutes
-	       zdayfrac=adatrj-INT(adatrj)
-	       ksecs = NINT(zdayfrac*86400)	       ! Nearest second to catch rounding errors in adatrj	       
-	       ihour = INT(ksecs/3600)
-	       iminute = ksecs/60-ihour*60
- 	        
-               ! Add to nn_time0
-               nhour   =   nn_time0 / 100
-               nminute = ( nn_time0 - nhour * 100 )
-	       nminute=nminute+iminute
-	       
-	       IF( nminute >= 60 ) THEN
-	          nminute=nminute-60
-		  nhour=nhour+1
-	       ENDIF
-	       nhour=nhour+ihour
-	       IF( nhour >= 24 ) THEN
-		  nhour=nhour-24
-	          adatrj=adatrj+1
-	       ENDIF	       
-	       nn_time0 = nhour * 100 + nminute
-	       adatrj = INT(adatrj)                    ! adatrj set to integer as nn_time0 updated	       
-            ELSE
-               ! parameters corresponding to nit000 - 1 (as we start the step loop with a call to day)
-               ndastp = ndate0        ! ndate0 read in the namelist in dom_nam
-               nhour   =   nn_time0 / 100
-               nminute = ( nn_time0 - nhour * 100 )
-               IF( nhour*3600+nminute*60-ndt05 .lt. 0 )  ndastp=ndastp-1      ! Start hour is specified in the namelist (default 0)
-               adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday
-               ! note this is wrong if time step has changed during run
-            ENDIF
-         ELSE
-            ! parameters corresponding to nit000 - 1 (as we start the step loop with a call to day)
-            ndastp = ndate0           ! ndate0 read in the namelist in dom_nam
-            nhour   =   nn_time0 / 100
-	    nminute = ( nn_time0 - nhour * 100 )
-            IF( nhour*3600+nminute*60-ndt05 .lt. 0 )  ndastp=ndastp-1      ! Start hour is specified in the namelist (default 0)
-            adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday
-         ENDIF
-         IF( ABS(adatrj  - REAL(NINT(adatrj),wp)) < 0.1 / rday )   adatrj = REAL(NINT(adatrj),wp)   ! avoid truncation error
-         !
-         IF(lwp) THEN
-            WRITE(numout,*) ' *** Info used values : '
-            WRITE(numout,*) '   date ndastp                                      : ', ndastp
-            WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj
-	    WRITE(numout,*) '   nn_time0                                         : ',nn_time0
-            WRITE(numout,*)
-         ENDIF
-         !
-      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
-         !
-         IF( kt == nitrst ) THEN
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) 'rst_write : write oce restart file  kt =', kt
-            IF(lwp) WRITE(numout,*) '~~~~~~~'
-         ENDIF
-         ! calendar control
-         IF( lwxios ) CALL iom_swap(      cwxios_context          )
-         CALL iom_rstput( kt, nitrst, numrow, 'kt'     , REAL( kt    , wp)  , ldxios = lwxios )   ! time-step
-         CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp)  , ldxios = lwxios )   ! date
-         CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj             , ldxios = lwxios )   ! number of elapsed days since
-         !                                                                     ! the begining of the run [s]
-	 CALL iom_rstput( kt, nitrst, numrow, 'ntime'  , REAL( nn_time0, wp), ldxios = lwxios ) ! time
-         IF( lwxios ) CALL iom_swap(      cxios_context          )
-      ENDIF
-      !
-   END SUBROUTINE day_rst
-
-   !!======================================================================
-END MODULE daymod
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/SAS/diawri.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/SAS/diawri.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/SAS/diawri.F90	(revision 12928)
@@ -24,4 +24,5 @@
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers 
+   USE abl            ! abl variables in case ln_abl = .true.
    USE dom_oce         ! ocean space and time domain
    USE zdf_oce         ! ocean vertical physics
@@ -51,13 +52,16 @@
    PUBLIC   dia_wri_state
    PUBLIC   dia_wri_alloc           ! Called by nemogcm module
-
+#if ! defined key_iomput   
+   PUBLIC   dia_wri_alloc_abl       ! Called by sbcabl  module (if ln_abl = .true.)
+#endif
    INTEGER ::   nid_T, nz_T, nh_T, ndim_T, ndim_hT   ! grid_T file
    INTEGER ::   nid_U, nz_U, nh_U, ndim_U, ndim_hU   ! grid_U file
    INTEGER ::   nid_V, nz_V, nh_V, ndim_V, ndim_hV   ! grid_V file
+   INTEGER ::   ndim_A, ndim_hA                      ! ABL file   
+   INTEGER ::   nid_A, nz_A, nh_A                    ! grid_ABL file   
    INTEGER ::   ndex(1)                              ! ???
    INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hA, ndex_A ! ABL
+
    !!----------------------------------------------------------------------
    !! NEMO/SAS 4.0 , NEMO Consortium (2018)
@@ -78,5 +82,5 @@
 
    
-   SUBROUTINE dia_wri( kt )
+   SUBROUTINE dia_wri( kt, Kmm )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE dia_wri  ***
@@ -90,9 +94,10 @@
       !!
       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      INTEGER, INTENT( in ) ::   Kmm     ! ocean time levelindex
       !!----------------------------------------------------------------------
       ! 
       ! Output the initial state and forcings
       IF( ninist == 1 ) THEN
-         CALL dia_wri_state( 'output.init' )
+         CALL dia_wri_state( Kmm, 'output.init' )
          ninist = 0
       ENDIF
@@ -114,6 +119,12 @@
    END FUNCTION dia_wri_alloc
    
+   INTEGER FUNCTION dia_wri_alloc_abl()
+      !!----------------------------------------------------------------------
+	  ALLOCATE(   ndex_hA(jpi*jpj), ndex_A (jpi*jpj*jpkam1), STAT=dia_wri_alloc_abl)
+      CALL mpp_sum( 'diawri', dia_wri_alloc_abl )
+      !
+   END FUNCTION dia_wri_alloc_abl
   
-   SUBROUTINE dia_wri( kt )
+   SUBROUTINE dia_wri( kt, Kmm )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE dia_wri  ***
@@ -129,4 +140,5 @@
       !!
       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      INTEGER, INTENT( in ) ::   Kmm  ! ocean time level index
       !!
       LOGICAL ::   ll_print = .FALSE.                        ! =T print and flush numout
@@ -136,10 +148,12 @@
       INTEGER  ::   ierr                                     ! error code return from allocation
       INTEGER  ::   iimi, iima, ipk, it, itmod, ijmi, ijma   ! local integers
+      INTEGER  ::   ipka                                     ! ABL
       REAL(wp) ::   zsto, zout, zmax, zjulian                ! local scalars
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zw3d_abl   ! ABL 3D workspace
       !!----------------------------------------------------------------------
       !
       ! Output the initial state and forcings
       IF( ninist == 1 ) THEN                       
-         CALL dia_wri_state( 'output.init' )
+         CALL dia_wri_state( Kmm, 'output.init' )
          ninist = 0
       ENDIF
@@ -161,12 +175,12 @@
       ENDIF
 #if defined key_diainstant
-      zsto = nn_write * rdt
+      zsto = nn_write * rn_Dt
       clop = "inst("//TRIM(clop)//")"
 #else
-      zsto=rdt
+      zsto=rn_Dt
       clop = "ave("//TRIM(clop)//")"
 #endif
-      zout = nn_write * rdt
-      zmax = ( nitend - nit000 + 1 ) * rdt
+      zout = nn_write * rn_Dt
+      zmax = ( nitend - nit000 + 1 ) * rn_Dt
 
       ! Define indices of the horizontal output zoom and vertical limit storage
@@ -174,4 +188,5 @@
       ijmi = 1      ;      ijma = jpj
       ipk = jpk
+	  IF(ln_abl) ipka = jpkam1
 
       ! define time axis
@@ -188,5 +203,5 @@
 
          ! Compute julian date from starting date of the run
-         CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )
+         CALL ymds2ju( nyear, nmonth, nday, rn_Dt, zjulian )
          zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
          IF(lwp)WRITE(numout,*)
@@ -210,5 +225,5 @@
          CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit
             &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
-            &          nit000-1, zjulian, rdt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set )
+            &          nit000-1, zjulian, rn_Dt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set )
          CALL histvert( nid_T, "deptht", "Vertical T levels",      &  ! Vertical grid: gdept
             &           "m", ipk, gdept_1d, nz_T, "down" )
@@ -222,5 +237,5 @@
          CALL histbeg( clhstnam, jpi, glamu, jpj, gphiu,           &  ! Horizontal grid: glamu and gphiu
             &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
-            &          nit000-1, zjulian, rdt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set )
+            &          nit000-1, zjulian, rn_Dt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set )
          CALL histvert( nid_U, "depthu", "Vertical U levels",      &  ! Vertical grid: gdept
             &           "m", ipk, gdept_1d, nz_U, "down" )
@@ -234,5 +249,5 @@
          CALL histbeg( clhstnam, jpi, glamv, jpj, gphiv,           &  ! Horizontal grid: glamv and gphiv
             &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
-            &          nit000-1, zjulian, rdt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set )
+            &          nit000-1, zjulian, rn_Dt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set )
          CALL histvert( nid_V, "depthv", "Vertical V levels",      &  ! Vertical grid : gdept
             &          "m", ipk, gdept_1d, nz_V, "down" )
@@ -241,4 +256,20 @@
 
          ! No W grid FILE
+         IF( ln_abl ) THEN 
+         ! Define the ABL grid FILE ( nid_A )
+            CALL dia_nam( clhstnam, nn_write, 'grid_ABL' )
+            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,       &
+               &          nit000-1, zjulian, rn_Dt, nh_A, nid_A, domain_id=nidom, snc4chunks=snc4set )
+            CALL histvert( nid_A, "ght_abl", "Vertical T levels",      &  ! Vertical grid: gdept
+               &           "m", ipka, ght_abl(2:jpka), nz_A, "up" )
+            !                                                            ! Index of ocean points
+			ALLOCATE( zw3d_abl(jpi,jpj,ipka) ) 
+			zw3d_abl(:,:,:) = 1._wp 
+			CALL wheneq( jpi*jpj*ipka, zw3d_abl, 1, 1., ndex_A , ndim_A  )      ! volume
+            CALL wheneq( jpi*jpj     , zw3d_abl, 1, 1., ndex_hA, ndim_hA )      ! surface
+			DEALLOCATE(zw3d_abl)
+         ENDIF
 
          ! Declare all the output fields as NETCDF variables
@@ -261,4 +292,31 @@
          CALL histdef( nid_T, "sowindsp", "wind speed at 10m"                  , "m/s"    ,   &  ! wndm
             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+!
+         IF( ln_abl ) THEN
+         !                                                                                      !!! nid_A : 3D
+			CALL histdef( nid_A, "t_abl", "Potential Temperature"     , "K"        ,       &  ! t_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )
+            CALL histdef( nid_A, "q_abl", "Humidity"                  , "kg/kg"    ,       &  ! q_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
+            CALL histdef( nid_A, "u_abl", "Atmospheric U-wind   "     , "m/s"        ,     &  ! u_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )
+            CALL histdef( nid_A, "v_abl", "Atmospheric V-wind   "     , "m/s"    ,         &  ! v_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
+            CALL histdef( nid_A, "tke_abl", "Atmospheric TKE   "     , "m2/s2"    ,        &  ! tke_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
+            CALL histdef( nid_A, "avm_abl", "Atmospheric turbulent viscosity", "m2/s"   ,  &  ! avm_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
+            CALL histdef( nid_A, "avt_abl", "Atmospheric turbulent diffusivity", "m2/s2",  &  ! avt_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
+            CALL histdef( nid_A, "pblh", "Atmospheric boundary layer height "  , "m",      &  ! pblh
+               &          jpi, jpj, nh_A,  1  , 1, 1   , -99 , 32, clop, zsto, zout )		 			   
+#if defined key_si3
+            CALL histdef( nid_A, "oce_frac", "Fraction of open ocean"  , " ",      &  ! ato_i
+               &          jpi, jpj, nh_A,  1  , 1, 1   , -99 , 32, clop, zsto, zout )
+#endif
+		    CALL histend( nid_A, snc4chunks=snc4set )
+		 !
+		 ENDIF
+!
 
          CALL histend( nid_T, snc4chunks=snc4set )
@@ -310,4 +368,28 @@
       CALL histwrite( nid_T, "soicecov", it, fr_i          , ndim_hT, ndex_hT )   ! ice fraction   
       CALL histwrite( nid_T, "sowindsp", it, wndm          , ndim_hT, ndex_hT )   ! wind speed   
+!
+      IF( ln_abl ) THEN 
+	     ALLOCATE( zw3d_abl(jpi,jpj,jpka) )
+	     IF( ln_mskland )   THEN 
+		    DO jk=1,jpka
+		       zw3d_abl(:,:,jk) = tmask(:,:,1)
+            END DO
+		 ELSE
+            zw3d_abl(:,:,:) = 1._wp		 
+         ENDIF			
+		 CALL histwrite( nid_A,  "pblh"   , it, pblh(:,:)                  *zw3d_abl(:,:,1     ), ndim_hA, ndex_hA )   ! pblh 
+	     CALL histwrite( nid_A,  "u_abl"  , it, u_abl   (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! u_abl
+	     CALL histwrite( nid_A,  "v_abl"  , it, v_abl   (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! v_abl
+	     CALL histwrite( nid_A,  "t_abl"  , it, tq_abl  (:,:,2:jpka,nt_n,1)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! t_abl
+	     CALL histwrite( nid_A,  "q_abl"  , it, tq_abl  (:,:,2:jpka,nt_n,2)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! q_abl		 
+	     CALL histwrite( nid_A,  "tke_abl", it, tke_abl (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! tke_abl
+	     CALL histwrite( nid_A,  "avm_abl", it, avm_abl (:,:,2:jpka       )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! avm_abl
+	     CALL histwrite( nid_A,  "avt_abl", it, avt_abl (:,:,2:jpka       )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! avt_abl	
+#if defined key_si3
+         CALL histwrite( nid_A,  "oce_frac"   , it, ato_i(:,:)                                  , ndim_hA, ndex_hA )   ! ato_i
+#endif
+		 DEALLOCATE(zw3d_abl)
+	  ENDIF
+!
 
          ! Write fields on U grid
@@ -325,4 +407,5 @@
          CALL histclo( nid_U )
          CALL histclo( nid_V )
+         IF(ln_abl) CALL histclo( nid_A )
       ENDIF
       !
@@ -332,5 +415,5 @@
 #endif
 
-   SUBROUTINE dia_wri_state( cdfile_name )
+   SUBROUTINE dia_wri_state( Kmm, cdfile_name )
       !!---------------------------------------------------------------------
       !!                 ***  ROUTINE dia_wri_state  ***
@@ -345,4 +428,5 @@
       !!      File 'output.abort.nc' is created in case of abnormal job end
       !!----------------------------------------------------------------------
+      INTEGER           , INTENT( in ) ::   Kmm              ! ocean time levelindex
       CHARACTER (len=* ), INTENT( in ) ::   cdfile_name      ! name of the file created
       !!
@@ -354,32 +438,30 @@
       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   and forcing fields file created '
       IF(lwp) WRITE(numout,*) '                and named :', cdfile_name, '...nc'
-
-#if defined key_si3
-     CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl )
-#else
-     CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. )
-#endif
-
-      CALL iom_rstput( 0, 0, inum, 'votemper', tsn(:,:,:,jp_tem) )    ! now temperature
-      CALL iom_rstput( 0, 0, inum, 'vosaline', tsn(:,:,:,jp_sal) )    ! now salinity
-      CALL iom_rstput( 0, 0, inum, 'sossheig', sshn              )    ! sea surface height
-      CALL iom_rstput( 0, 0, inum, 'vozocrtx', un                )    ! now i-velocity
-      CALL iom_rstput( 0, 0, inum, 'vomecrty', vn                )    ! now j-velocity
-      CALL iom_rstput( 0, 0, inum, 'vovecrtz', wn                )    ! now k-velocity
-      CALL iom_rstput( 0, 0, inum, 'sowaflup', emp - rnf         )    ! freshwater budget
-      CALL iom_rstput( 0, 0, inum, 'sohefldo', qsr + qns         )    ! total heat flux
-      CALL iom_rstput( 0, 0, inum, 'soshfldo', qsr               )    ! solar heat flux
-      CALL iom_rstput( 0, 0, inum, 'soicecov', fr_i              )    ! ice fraction
-      CALL iom_rstput( 0, 0, inum, 'sozotaux', utau              )    ! i-wind stress
-      CALL iom_rstput( 0, 0, inum, 'sometauy', vtau              )    ! j-wind stress
- 
+      !
+      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. )
+      !
+      CALL iom_rstput( 0, 0, inum, 'votemper', ts (:,:,:,jp_tem,Kmm) )    ! now temperature
+      CALL iom_rstput( 0, 0, inum, 'vosaline', ts (:,:,:,jp_sal,Kmm) )    ! now salinity
+      CALL iom_rstput( 0, 0, inum, 'sossheig', ssh(:,:,         Kmm) )    ! sea surface height
+      CALL iom_rstput( 0, 0, inum, 'vozocrtx', uu (:,:,:,       Kmm) )    ! now i-velocity
+      CALL iom_rstput( 0, 0, inum, 'vomecrty', vv (:,:,:,       Kmm) )    ! now j-velocity
+      CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww                    )    ! now k-velocity
+      CALL iom_rstput( 0, 0, inum, 'sowaflup', emp - rnf             )    ! freshwater budget
+      CALL iom_rstput( 0, 0, inum, 'sohefldo', qsr + qns             )    ! total heat flux
+      CALL iom_rstput( 0, 0, inum, 'soshfldo', qsr                   )    ! solar heat flux
+      CALL iom_rstput( 0, 0, inum, 'soicecov', fr_i                  )    ! ice fraction
+      CALL iom_rstput( 0, 0, inum, 'sozotaux', utau                  )    ! i-wind stress
+      CALL iom_rstput( 0, 0, inum, 'sometauy', vtau                  )    ! j-wind stress
+      !
+      CALL iom_close( inum )
+      !
 #if defined key_si3
       IF( nn_ice == 2 ) THEN   ! condition needed in case agrif + ice-model but no-ice in child grid
+         CALL iom_open( TRIM(cdfile_name)//'_ice', inum, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' )
          CALL ice_wri_state( inum )
-      ENDIF
-#endif
-      !
-      CALL iom_close( inum )
-      !
+         CALL iom_close( inum )
+      ENDIF
+#endif
+
    END SUBROUTINE dia_wri_state
 
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/SAS/nemogcm.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/SAS/nemogcm.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/SAS/nemogcm.F90	(revision 12928)
@@ -32,5 +32,8 @@
    USE bdyini         ! open boundary cond. setting       (bdy_init routine). mandatory for sea-ice
    USE bdydta         ! open boundary cond. setting   (bdy_dta_init routine). mandatory for sea-ice
+   USE diu_layers     ! diurnal bulk SST and coolskin
+   USE step_diu       ! diurnal bulk SST timestepping (called from here if run offline)
    !
+   USE in_out_manager ! I/O manager
    USE lib_mpp        ! distributed memory computing
    USE mppini         ! shared/distributed memory setting (mpp_init routine)
@@ -52,4 +55,8 @@
    CHARACTER(lc) ::   cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing
 
+#if defined key_mpp_mpi
+   INCLUDE 'mpif.h'
+#endif
+
    !!----------------------------------------------------------------------
    !! NEMO/SAS 4.0 , NEMO Consortium (2018)
@@ -83,4 +90,5 @@
       !                            !-----------------------!
 #if defined key_agrif
+      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices
       CALL Agrif_Declare_Var_dom   ! AGRIF: set the meshes for DOM
       CALL Agrif_Declare_Var       !  "      "   "   "      "  DYN/TRA 
@@ -109,4 +117,5 @@
 #if defined key_si3
       ! Recursive update from highest nested level to lowest:
+      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices
       CALL Agrif_step_child_adj(Agrif_update_ice)
 #endif
@@ -128,4 +137,9 @@
          !
          DO WHILE( istp <= nitend .AND. nstop == 0 )
+#if defined key_mpp_mpi
+            ncom_stp = istp
+            IF ( istp == ( nit000 + 1 ) ) elapsed_time = MPI_Wtime()
+            IF ( istp ==         nitend ) elapsed_time = MPI_Wtime() - elapsed_time
+#endif
             CALL stp        ( istp ) 
             istp = istp + 1
@@ -185,5 +199,5 @@
       INTEGER ::   ios, ilocal_comm   ! local integers
       !!
-      NAMELIST/namctl/ ln_ctl   , sn_cfctl, nn_print, nn_ictls, nn_ictle,   &
+      NAMELIST/namctl/ sn_cfctl, nn_print, nn_ictls, nn_ictle,              &
          &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,             &
          &             ln_timing, ln_diacfl
@@ -230,31 +244,53 @@
       ! open ocean.output as soon as possible to get all output prints (including errors messages)
       IF( lk_oasis ) THEN
-         IF( lwm )   CALL ctl_opn(     numout,              'sas.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
+         IF( lwm )   CALL ctl_opn(     numout,               'sas.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
          ! open reference and configuration namelist files
-                     CALL ctl_opn( numnam_ref,        'namelist_sas_ref',     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
-                     CALL ctl_opn( numnam_cfg,        'namelist_sas_cfg',     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
-         IF( lwm )   CALL ctl_opn(     numond, 'output.namelist_sas.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
+                     CALL load_nml( numnam_ref,        'namelist_sas_ref',                                           -1, lwm )
+                     CALL load_nml( numnam_cfg,        'namelist_sas_cfg',                                           -1, lwm )
+         IF( lwm )   CALL ctl_opn(      numond, 'output.namelist_sas.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
       ELSE
-         IF( lwm )   CALL ctl_opn(     numout,            'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
+         IF( lwm )   CALL ctl_opn(      numout,            'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
          ! open reference and configuration namelist files
-                     CALL ctl_opn( numnam_ref,            'namelist_ref',     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
-                     CALL ctl_opn( numnam_cfg,            'namelist_cfg',     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
-         IF( lwm )   CALL ctl_opn(     numond,     'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
+                     CALL load_nml( numnam_ref,            'namelist_ref',                                           -1, lwm )
+                     CALL load_nml( numnam_cfg,            'namelist_cfg',                                           -1, lwm )
+         IF( lwm )   CALL ctl_opn(      numond,     'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
       ENDIF
       ! open /dev/null file to be able to supress output write easily
+      IF( Agrif_Root() ) THEN
                      CALL ctl_opn(     numnul,               '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
+#ifdef key_agrif
+      ELSE
+                  numnul = Agrif_Parent(numnul)   
+#endif
+      ENDIF
       !
       !                             !--------------------!
-      !                             ! Open listing units !  -> need ln_ctl from namctl to define lwp
+      !                             ! Open listing units !  -> need sn_cfctl from namctl to define lwp
       !                             !--------------------!
       !
-      REWIND( numnam_ref )              ! Namelist namctl in reference namelist
       READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namctl in reference namelist' )
-      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist
       READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namctl in configuration namelist' )
       !
-      lwp = (narea == 1) .OR. ln_ctl    ! control of all listing output print
+      ! finalize the definition of namctl variables
+      IF( sn_cfctl%l_allon ) THEN
+         ! Turn on all options.
+         CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. )
+         ! Ensure all processors are active
+         sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1
+      ELSEIF( sn_cfctl%l_config ) THEN
+         ! Activate finer control of report outputs
+         ! optionally switch off output from selected areas (note this only
+         ! applies to output which does not involve global communications)
+         IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. &
+           & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    &
+           &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. )
+      ELSE
+         ! turn off all options.
+         CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. )
+      ENDIF
+      !
+      lwp = (narea == 1) .OR. sn_cfctl%l_oceout    ! control of all listing output print
       !
       IF(lwp) THEN                      ! open listing units
@@ -291,17 +327,4 @@
          !
       ENDIF
-     !
-      ! finalize the definition of namctl variables
-      IF( sn_cfctl%l_config ) THEN
-         ! Activate finer control of report outputs
-         ! optionally switch off output from selected areas (note this only
-         ! applies to output which does not involve global communications)
-         IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. &
-           & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    &
-           &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. )
-      ELSE
-         ! Use ln_ctl to turn on or off all options.
-         CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. )
-      ENDIF
       !
       IF(lwm) WRITE( numond, namctl )
@@ -311,8 +334,6 @@
       !                             !------------------------------------!
       !
-      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist
       READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
 903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist' )
-      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist
       READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist' )   
@@ -334,4 +355,7 @@
       CALL nemo_alloc()
 
+      ! Initialise time level indices
+      Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa
+
       !                             !-------------------------------!
       !                             !  NEMO general initialization  !
@@ -346,6 +370,7 @@
                            CALL phy_cst         ! Physical constants
                            CALL eos_init        ! Equation of seawater
-                           CALL dom_init('SAS') ! Domain
-      IF( ln_ctl      )    CALL prt_ctl_init    ! Print control
+                           CALL dom_init( Nbb, Nnn, Naa, 'SAS') ! Domain
+      IF( sn_cfctl%l_prtctl )   &
+         &                 CALL prt_ctl_init        ! Print control
       
                            CALL day_init        ! model calendar (using both namelist and restart infos)
@@ -353,5 +378,5 @@
 
       !                                      ! external forcing 
-                           CALL sbc_init        ! Forcings : surface module 
+                           CALL sbc_init( Nbb, Nnn, Naa )  ! Forcings : surface module 
 
       ! ==> clem: open boundaries init. is mandatory for sea-ice because ice BDY is not decoupled from  
@@ -360,5 +385,5 @@
                            CALL bdy_init
       ! ==>
-                           CALL icb_init( rdt, nit000)   ! initialise icebergs instance
+                           CALL icb_init( rn_Dt, nit000)   ! initialise icebergs instance
       !
       IF(lwp) WRITE(numout,cform_aaa)           ! Flag AAAAAAA
@@ -375,5 +400,5 @@
       !! ** Purpose :   control print setting
       !!
-      !! ** Method  : - print namctl information and check some consistencies
+      !! ** Method  : - print namctl and namcfg information and check some consistencies
       !!----------------------------------------------------------------------
       !
@@ -383,5 +408,6 @@
          WRITE(numout,*) '~~~~~~~~'
          WRITE(numout,*) '   Namelist namctl'
-         WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl
+         WRITE(numout,*) '                              sn_cfctl%l_glochk  = ', sn_cfctl%l_glochk
+         WRITE(numout,*) '                              sn_cfctl%l_allon   = ', sn_cfctl%l_allon
          WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config
          WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat
@@ -389,6 +415,7 @@
          WRITE(numout,*) '                              sn_cfctl%l_oceout  = ', sn_cfctl%l_oceout
          WRITE(numout,*) '                              sn_cfctl%l_layout  = ', sn_cfctl%l_layout
-         WRITE(numout,*) '                              sn_cfctl%l_mppout  = ', sn_cfctl%l_mppout
-         WRITE(numout,*) '                              sn_cfctl%l_mpptop  = ', sn_cfctl%l_mpptop
+         WRITE(numout,*) '                              sn_cfctl%l_prtctl  = ', sn_cfctl%l_prtctl
+         WRITE(numout,*) '                              sn_cfctl%l_prttrc  = ', sn_cfctl%l_prttrc
+         WRITE(numout,*) '                              sn_cfctl%l_oasout  = ', sn_cfctl%l_oasout
          WRITE(numout,*) '                              sn_cfctl%procmin   = ', sn_cfctl%procmin  
          WRITE(numout,*) '                              sn_cfctl%procmax   = ', sn_cfctl%procmax  
@@ -428,5 +455,5 @@
       !                             ! Parameter control
       !
-      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints
+      IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN              ! sub-domain area indices for the control prints
          IF( lk_mpp .AND. jpnij > 1 ) THEN
             isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain
@@ -489,9 +516,5 @@
       IF( numstp          /= -1 )   CLOSE( numstp          )   ! time-step file      
       IF( numrun          /= -1 )   CLOSE( numrun          )   ! run statistics file
-      IF( numnam_ref      /= -1 )   CLOSE( numnam_ref      )   ! oce reference namelist
-      IF( numnam_cfg      /= -1 )   CLOSE( numnam_cfg      )   ! oce configuration namelist
       IF( lwm.AND.numond  /= -1 )   CLOSE( numond          )   ! oce output namelist
-      IF( numnam_ice_ref  /= -1 )   CLOSE( numnam_ice_ref  )   ! ice reference namelist
-      IF( numnam_ice_cfg  /= -1 )   CLOSE( numnam_ice_cfg  )   ! ice configuration namelist
       IF( lwm.AND.numoni  /= -1 )   CLOSE( numoni          )   ! ice output namelist
       IF( numevo_ice      /= -1 )   CLOSE( numevo_ice      )   ! ice variables (temp. evolution)
@@ -552,6 +575,7 @@
       sn_cfctl%l_oceout  = setto
       sn_cfctl%l_layout  = setto
-      sn_cfctl%l_mppout  = setto
-      sn_cfctl%l_mpptop  = setto
+      sn_cfctl%l_prtctl  = setto
+      sn_cfctl%l_prttrc  = setto
+      sn_cfctl%l_oasout  = setto
    END SUBROUTINE nemo_set_cfctl
 
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/SAS/sbcssm.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/SAS/sbcssm.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/SAS/sbcssm.F90	(revision 12928)
@@ -26,5 +26,5 @@
    USE lib_mpp        ! distributed memory computing library
    USE prtctl         ! print control
-   USE fldread        ! read input fields 
+   USE fldread        ! read input fields
    USE timing         ! Timing
 
@@ -38,5 +38,5 @@
    LOGICAL            ::   ln_3d_uve     ! specify whether input velocity data is 3D
    LOGICAL            ::   ln_read_frq   ! specify whether we must read frq or not
-   
+
    LOGICAL            ::   l_sasread     ! Ice intilisation: =T read a file ; =F anaytical initilaistion
    LOGICAL            ::   l_initdone = .false.
@@ -62,5 +62,5 @@
 CONTAINS
 
-   SUBROUTINE sbc_ssm( kt )
+   SUBROUTINE sbc_ssm( kt, Kbb, Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE sbc_ssm  ***
@@ -69,8 +69,10 @@
       !!               for an off-line simulation using surface processes only
       !!
-      !! ** Method : calculates the position of data 
+      !! ** Method : calculates the position of data
       !!             - interpolates data if needed
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices
+      ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90)
       !
       INTEGER  ::   ji, jj     ! dummy loop indices
@@ -80,25 +82,25 @@
       !
       IF( ln_timing )   CALL timing_start( 'sbc_ssm')
-     
+
       IF ( l_sasread ) THEN
          IF( nfld_3d > 0 ) CALL fld_read( kt, 1, sf_ssm_3d )      !==   read data at kt time step   ==!
          IF( nfld_2d > 0 ) CALL fld_read( kt, 1, sf_ssm_2d )      !==   read data at kt time step   ==!
-         ! 
+         !
          IF( ln_3d_uve ) THEN
             IF( .NOT. ln_linssh ) THEN
-               e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 
+               e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor
             ELSE
                e3t_m(:,:) = e3t_0(:,:,1)                                 ! vertical scale factor
             ENDIF
             ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity
-            ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity 
+            ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity
          ELSE
             IF( .NOT. ln_linssh ) THEN
-               e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 
+               e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor
             ELSE
                e3t_m(:,:) = e3t_0(:,:,1)                                 ! vertical scale factor
             ENDIF
             ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity
-            ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity 
+            ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity
          ENDIF
          !
@@ -119,17 +121,17 @@
          IF( .NOT. ln_linssh ) e3t_m(:,:) = e3t_0(:,:,1) !clem: necessary at least for sas2D
          frq_m(:,:) = 1._wp                              !              - -
-         sshn (:,:) = 0._wp                              !              - -
-      ENDIF
-      
+         ssh  (:,:,Kmm) = 0._wp                              !              - -
+      ENDIF
+
       IF ( nn_ice == 1 ) THEN
-         tsn(:,:,1,jp_tem) = sst_m(:,:)
-         tsn(:,:,1,jp_sal) = sss_m(:,:)
-         tsb(:,:,1,jp_tem) = sst_m(:,:)
-         tsb(:,:,1,jp_sal) = sss_m(:,:)
-      ENDIF
-      ub (:,:,1) = ssu_m(:,:)
-      vb (:,:,1) = ssv_m(:,:)
- 
-      IF(ln_ctl) THEN                  ! print control
+         ts(:,:,1,jp_tem,Kmm) = sst_m(:,:)
+         ts(:,:,1,jp_sal,Kmm) = sss_m(:,:)
+         ts(:,:,1,jp_tem,Kbb) = sst_m(:,:)
+         ts(:,:,1,jp_sal,Kbb) = sss_m(:,:)
+      ENDIF
+      uu (:,:,1,Kbb) = ssu_m(:,:)
+      vv (:,:,1,Kbb) = ssv_m(:,:)
+
+      IF(sn_cfctl%l_prtctl) THEN            ! print control
          CALL prt_ctl(tab2d_1=sst_m, clinfo1=' sst_m   - : ', mask1=tmask   )
          CALL prt_ctl(tab2d_1=sss_m, clinfo1=' sss_m   - : ', mask1=tmask   )
@@ -156,10 +158,12 @@
 
 
-   SUBROUTINE sbc_ssm_init
+   SUBROUTINE sbc_ssm_init( Kbb, Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE sbc_ssm_init  ***
       !!
-      !! ** Purpose :   Initialisation of sea surface mean data     
-      !!----------------------------------------------------------------------
+      !! ** Purpose :   Initialisation of sea surface mean data
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices
+      ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90)
       INTEGER  :: ierr, ierr0, ierr1, ierr2, ierr3   ! return error code
       INTEGER  :: ifpr                               ! dummy loop indice
@@ -186,15 +190,13 @@
       ENDIF
       !
-      REWIND( numnam_ref )              ! Namelist namsbc_sas in reference namelist : Input fields
       READ  ( numnam_ref, namsbc_sas, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_sas in reference namelist' )
-      REWIND( numnam_cfg )              ! Namelist namsbc_sas in configuration namelist : Input fields
       READ  ( numnam_cfg, namsbc_sas, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_sas in configuration namelist' )
       IF(lwm) WRITE ( numond, namsbc_sas )
-      !           
+      !
       IF(lwp) THEN                              ! Control print
          WRITE(numout,*) '   Namelist namsbc_sas'
-         WRITE(numout,*) '      Initialisation using an input file                                 l_sasread   = ', l_sasread 
+         WRITE(numout,*) '      Initialisation using an input file                                 l_sasread   = ', l_sasread
          WRITE(numout,*) '      Are we supplying a 3D u,v and e3 field                             ln_3d_uve   = ', ln_3d_uve
          WRITE(numout,*) '      Are we reading frq (fraction of qsr absorbed in the 1st T level)   ln_read_frq = ', ln_read_frq
@@ -224,8 +226,8 @@
          ln_closea = .false.
       ENDIF
-      
-      !                  
+
+      !
       IF( l_sasread ) THEN                       ! store namelist information in an array
-         ! 
+         !
          !! following code is a bit messy, but distinguishes between when u,v are 3d arrays and
          !! when we have other 3d arrays that we need to read in
@@ -273,5 +275,5 @@
          ENDIF
          !
-         ierr1 = 0    ! default definition if slf_?d(ifpr)%ln_tint = .false. 
+         ierr1 = 0    ! default definition if slf_?d(ifpr)%ln_tint = .false.
          IF( nfld_3d > 0 ) THEN
             ALLOCATE( sf_ssm_3d(nfld_3d), STAT=ierr )         ! set sf structure
@@ -280,5 +282,5 @@
             ENDIF
             DO ifpr = 1, nfld_3d
-                                            ALLOCATE( sf_ssm_3d(ifpr)%fnow(jpi,jpj,jpk)    , STAT=ierr0 )
+               ALLOCATE( sf_ssm_3d(ifpr)%fnow(jpi,jpj,jpk)    , STAT=ierr0 )
                IF( slf_3d(ifpr)%ln_tint )   ALLOCATE( sf_ssm_3d(ifpr)%fdta(jpi,jpj,jpk,2)  , STAT=ierr1 )
                IF( ierr0 + ierr1 > 0 ) THEN
@@ -296,5 +298,5 @@
             ENDIF
             DO ifpr = 1, nfld_2d
-                                            ALLOCATE( sf_ssm_2d(ifpr)%fnow(jpi,jpj,1)    , STAT=ierr0 )
+               ALLOCATE( sf_ssm_2d(ifpr)%fnow(jpi,jpj,1)    , STAT=ierr0 )
                IF( slf_2d(ifpr)%ln_tint )   ALLOCATE( sf_ssm_2d(ifpr)%fdta(jpi,jpj,1,2)  , STAT=ierr1 )
                IF( ierr0 + ierr1 > 0 ) THEN
@@ -311,5 +313,5 @@
       ENDIF
       !
-      CALL sbc_ssm( nit000 )   ! need to define ss?_m arrays used in iceistate
+      CALL sbc_ssm( nit000, Kbb, Kmm )   ! need to define ss?_m arrays used in iceistate
       l_initdone = .TRUE.
       !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/SAS/step.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/SAS/step.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/SAS/step.F90	(revision 12928)
@@ -49,4 +49,8 @@
 
    !!----------------------------------------------------------------------
+   !! time level indices
+   !!----------------------------------------------------------------------
+   INTEGER, PUBLIC :: Nbb, Nnn, Naa, Nrhs          !! used by nemo_init
+   !!----------------------------------------------------------------------
    !! NEMO/SAS 4.0 , NEMO Consortium (2018)
    !! $Id$
@@ -74,5 +78,7 @@
 
 #if defined key_agrif
+      IF( nstop > 0 ) return   ! avoid to go further if an error was detected during previous time step 
       kstp = nit000 + Agrif_Nb_Step()
+      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices
       IF ( lk_agrif_debug ) THEN
          IF ( Agrif_Root() .and. lwp) Write(*,*) '---'
@@ -96,21 +102,15 @@
       !           From SAS: ocean bdy data are wrong  (but we do not care) and ice bdy data are OK.  
       !           This is not clean and should be changed in the future. 
-      IF( ln_bdy     )       CALL bdy_dta ( kstp, kt_offset=+1 )   ! update dynamic & tracer data at open boundaries
       ! ==>
-                             CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice)
+      IF( ln_bdy     )       CALL bdy_dta( kstp,      Nnn )                   ! update dynamic & tracer data at open boundaries
+                             CALL sbc    ( kstp, Nbb, Nnn )                   ! Sea Boundary Condition (including sea-ice)
 
-                             CALL dia_wri( kstp )         ! ocean model: outputs
+                             CALL dia_wri( kstp,      Nnn )                   ! ocean model: outputs
 
 #if defined key_agrif
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! AGRIF
+      ! AGRIF recursive integration
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<      
                              CALL Agrif_Integrate_ChildGrids( stp )  
-
-      IF( Agrif_NbStepint() == 0 ) THEN               ! AGRIF Update from zoom N to zoom 1 then to Parent 
-#if defined key_si3
-                             CALL Agrif_Update_ice( )   ! update sea-ice
-#endif
-      ENDIF
 #endif
                              
@@ -121,12 +121,25 @@
       IF( indic < 0  )  THEN
                              CALL ctl_stop( 'step: indic < 0' )
-                             CALL dia_wri_state( 'output.abort' )
+                             CALL dia_wri_state( Nnn, 'output.abort' )
       ENDIF
-      IF( kstp == nit000   ) CALL iom_close( numror )     ! close input  ocean restart file
+#if defined key_agrif
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! AGRIF update
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<      
+      IF( Agrif_NbStepint() == 0 .AND. nstop == 0 ) THEN                       ! AGRIF Update from zoom N to zoom 1 then to Parent 
+#if defined key_si3
+                             CALL Agrif_Update_ice( )   ! update sea-ice
+#endif
+      ENDIF
+#endif
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! File manipulation at the end of the first time step
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<                         
+      IF( kstp == nit000   ) CALL iom_close( numror )                          ! close input  ocean restart file
       
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
       ! Coupled mode
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-      IF( lk_oasis    )  CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges if OASIS-coupled ice
+      IF( lk_oasis    )  CALL sbc_cpl_snd( kstp, Nbb, Nnn )     ! coupled mode : field exchanges if OASIS-coupled ice
 
 #if defined key_iomput
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/SAS/stpctl.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/SAS/stpctl.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/SAS/stpctl.F90	(revision 12928)
@@ -63,5 +63,5 @@
       !
       ll_wrtstp  = ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend )
-      ll_colruns = ll_wrtstp .AND. ( ln_ctl .OR. sn_cfctl%l_runstat )
+      ll_colruns = ll_wrtstp .AND. ( sn_cfctl%l_runstat )
       ll_wrtruns = ll_colruns .AND. lwm
       IF( kt == nit000 .AND. lwp ) THEN
@@ -73,5 +73,5 @@
          !                                ! open run.stat file(s) at start whatever
          !                                ! the value of sn_cfctl%ptimincr
-         IF( lwm .AND. ( ln_ctl .OR. sn_cfctl%l_runstat ) ) THEN
+         IF( lwm .AND. ( sn_cfctl%l_runstat ) ) THEN
             CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
             clname = 'run.stat.nc'
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/AGE/trcini_age.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/AGE/trcini_age.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/AGE/trcini_age.F90	(revision 12928)
@@ -25,5 +25,5 @@
 CONTAINS
 
-   SUBROUTINE trc_ini_age
+   SUBROUTINE trc_ini_age( Kmm )
       !!----------------------------------------------------------------------
       !!                     ***  trc_ini_age  ***  
@@ -32,4 +32,5 @@
       !!
       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   Kmm ! time level indices
       INTEGER    ::  jn
       CHARACTER(len = 20)  ::  cltra
@@ -57,5 +58,5 @@
 
       
-      IF( .NOT. ln_rsttr ) trn(:,:,:,jp_age) = 0.
+      IF( .NOT. ln_rsttr ) tr(:,:,:,jp_age,Kmm) = 0.
       !
    END SUBROUTINE trc_ini_age
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/AGE/trcnam_age.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/AGE/trcnam_age.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/AGE/trcnam_age.F90	(revision 12928)
@@ -54,8 +54,6 @@
       ln_trc_obc(jp_age) = .false.
       !
-      REWIND( numnat_ref )              ! Namelist namagedate in reference namelist : AGE parameters
       READ  ( numnat_ref, namage, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namage in reference namelist' )
-      REWIND( numnat_cfg )              ! Namelist namagedate in configuration namelist : AGE parameters
       READ  ( numnat_cfg, namage, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namage in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/AGE/trcsms_age.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/AGE/trcsms_age.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/AGE/trcsms_age.F90	(revision 12928)
@@ -37,5 +37,5 @@
 CONTAINS
 
-   SUBROUTINE trc_sms_age( kt )
+   SUBROUTINE trc_sms_age( kt, Kbb, Kmm, Krhs )
       !!----------------------------------------------------------------------
       !!                     ***  trc_sms_age  ***
@@ -45,5 +45,6 @@
       !! ** Method  : -
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER, INTENT(in) ::   kt              ! ocean time-step index
+      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! ocean time level
       INTEGER ::   jn, jk   ! dummy loop index
       !!----------------------------------------------------------------------
@@ -57,15 +58,15 @@
 
       DO jk = 1, nla_age
-         tra(:,:,jk,jp_age) = rn_age_kill_rate * trb(:,:,jk,jp_age)
+         tr(:,:,jk,jp_age,Krhs) = rn_age_kill_rate * tr(:,:,jk,jp_age,Kbb)
       END DO
       !
-      tra(:,:,nl_age,jp_age) = frac_kill_age * rn_age_kill_rate * trb(:,:,nl_age,jp_age)  &
+      tr(:,:,nl_age,jp_age,Krhs) = frac_kill_age * rn_age_kill_rate * tr(:,:,nl_age,jp_age,Kbb)  &
           &                   + frac_add_age  * rryear * tmask(:,:,nl_age)
       !
       DO jk = nlb_age, jpk
-         tra(:,:,jk,jp_age) = tmask(:,:,jk) * rryear
+         tr(:,:,jk,jp_age,Krhs) = tmask(:,:,jk) * rryear
       END DO
       !
-      IF( l_trdtrc ) CALL trd_trc( tra(:,:,:,jp_age), jn, jptra_sms, kt )   ! save trends
+      IF( l_trdtrc ) CALL trd_trc( tr(:,:,:,jp_age,Krhs), jn, jptra_sms, kt, Kmm )   ! save trends
       !
       IF( ln_timing )   CALL timing_stop('trc_sms_age')
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/AGE/trcwri_age.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/AGE/trcwri_age.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/AGE/trcwri_age.F90	(revision 12928)
@@ -21,5 +21,5 @@
 CONTAINS
 
-   SUBROUTINE trc_wri_age
+   SUBROUTINE trc_wri_age( Kmm )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE trc_wri_trc  ***
@@ -27,4 +27,5 @@
       !! ** Purpose :   output passive tracers fields 
       !!---------------------------------------------------------------------
+      INTEGER, INTENT(in)  :: Kmm  ! time level indices
       CHARACTER (len=20)   :: cltra
       INTEGER              :: jn
@@ -34,5 +35,5 @@
 
       cltra = TRIM( ctrcnm(jp_age) )                  ! short title for tracer
-      CALL iom_put( cltra, trn(:,:,:,jp_age) )
+      CALL iom_put( cltra, tr(:,:,:,jp_age,Kmm) )
 
       !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/C14/trcatm_c14.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/C14/trcatm_c14.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/C14/trcatm_c14.F90	(revision 12928)
@@ -21,4 +21,6 @@
    PUBLIC   trc_atm_c14_ini     ! called in trcini_c14.F90
    !
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -118,29 +120,27 @@
             IF( ierr3 /= 0 )   CALL ctl_stop( 'STOP', 'trc_atm_c14_ini: unable to allocate fareaz' )
       !
-            DO jj = 1 , jpj                       ! from C14b package
-              DO ji = 1 , jpi
-                 IF( gphit(ji,jj) >= yn40 ) THEN
-                    fareaz(ji,jj,1) = 0.
-                    fareaz(ji,jj,2) = 0.
-                    fareaz(ji,jj,3) = 1.
-                 ELSE IF( gphit(ji,jj ) <= ys40) THEN
-                    fareaz(ji,jj,1) = 1.
-                    fareaz(ji,jj,2) = 0.
-                    fareaz(ji,jj,3) = 0.
-                 ELSE IF( gphit(ji,jj) >= yn20 ) THEN
-                    fareaz(ji,jj,1) = 0.
-                    fareaz(ji,jj,2) = 2. * ( 1. - gphit(ji,jj) / yn40 )
-                    fareaz(ji,jj,3) = 2. * gphit(ji,jj) / yn40 - 1.
-                 ELSE IF( gphit(ji,jj) <= ys20 ) THEN
-                    fareaz(ji,jj,1) = 2. * gphit(ji,jj) / ys40 - 1.
-                    fareaz(ji,jj,2) = 2. * ( 1. - gphit(ji,jj) / ys40 )
-                    fareaz(ji,jj,3) = 0.
-                 ELSE
-                    fareaz(ji,jj,1) = 0.
-                    fareaz(ji,jj,2) = 1.
-                    fareaz(ji,jj,3) = 0.
-                 ENDIF
-              END DO
-           END DO
+            DO_2D_11_11
+              IF( gphit(ji,jj) >= yn40 ) THEN
+                 fareaz(ji,jj,1) = 0.
+                 fareaz(ji,jj,2) = 0.
+                 fareaz(ji,jj,3) = 1.
+              ELSE IF( gphit(ji,jj ) <= ys40) THEN
+                 fareaz(ji,jj,1) = 1.
+                 fareaz(ji,jj,2) = 0.
+                 fareaz(ji,jj,3) = 0.
+              ELSE IF( gphit(ji,jj) >= yn20 ) THEN
+                 fareaz(ji,jj,1) = 0.
+                 fareaz(ji,jj,2) = 2. * ( 1. - gphit(ji,jj) / yn40 )
+                 fareaz(ji,jj,3) = 2. * gphit(ji,jj) / yn40 - 1.
+              ELSE IF( gphit(ji,jj) <= ys20 ) THEN
+                 fareaz(ji,jj,1) = 2. * gphit(ji,jj) / ys40 - 1.
+                 fareaz(ji,jj,2) = 2. * ( 1. - gphit(ji,jj) / ys40 )
+                 fareaz(ji,jj,3) = 0.
+              ELSE
+                 fareaz(ji,jj,1) = 0.
+                 fareaz(ji,jj,2) = 1.
+                 fareaz(ji,jj,3) = 0.
+              ENDIF
+            END_2D
       !
          ENDIF
@@ -223,5 +223,5 @@
       IF(kc14typ >= 1) THEN  ! Transient C14 & CO2
       !
-         tyrc14_now = tyrc14_now + ( rdt / ( rday * nyear_len(1)) )    !  current time step in yr relative to tyrc14_beg
+         tyrc14_now = tyrc14_now + ( rn_Dt / ( rday * nyear_len(1)) )    !  current time step in yr relative to tyrc14_beg
       !
       ! CO2 --------------------------------------------------------
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/C14/trcini_c14.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/C14/trcini_c14.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/C14/trcini_c14.F90	(revision 12928)
@@ -31,5 +31,5 @@
 CONTAINS
 
-   SUBROUTINE trc_ini_c14
+   SUBROUTINE trc_ini_c14( Kmm )
       !!----------------------------------------------------------------------
       !!                     ***  trc_ini_c14  ***  
@@ -40,4 +40,5 @@
       !!----------------------------------------------------------------------
       !
+      INTEGER, INTENT(in)  ::  Kmm  ! time level indices
       REAL(wp) :: ztrai
       INTEGER  :: jn
@@ -57,5 +58,5 @@
          IF(lwp) WRITE(numout,*) '                      ==>    Ocean C14/C :', rc14init 
          !
-         trn(:,:,:,jp_c14) = rc14init * tmask(:,:,:)
+         tr(:,:,:,jp_c14,Kmm) = rc14init * tmask(:,:,:)
          !
          qtr_c14(:,:) = 0._wp           ! Init of air-sea BC
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/C14/trcnam_c14.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/C14/trcnam_c14.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/C14/trcnam_c14.F90	(revision 12928)
@@ -61,8 +61,6 @@
       ln_trc_obc(jp_c14) = .false.
       !
-      REWIND( numtrc_ref )              ! Namelist namc14_typ in reference namelist :
       READ  ( numtrc_ref, namc14_typ, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc14_typ in reference namelist' )
-      REWIND( numtrc_cfg )              ! Namelist namcfcdate in configuration namelist 
       READ  ( numtrc_cfg, namc14_typ, IOSTAT = ios, ERR = 902)
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namc14_typ in configuration namelist' )
@@ -78,8 +76,6 @@
       ENDIF
 
-      REWIND( numtrc_ref )              ! Namelist namc14_typ in reference namelist :
       READ  ( numtrc_ref, namc14_sbc, IOSTAT = ios, ERR = 903)
 903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc14_sbc in reference namelist' )
-      REWIND( numtrc_cfg )              ! Namelist namcfcdate in configuration namelist 
       READ  ( numtrc_cfg, namc14_sbc, IOSTAT = ios, ERR = 904)
 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namc14_sbc in configuration namelist' )
@@ -94,8 +90,6 @@
       ENDIF
 
-      REWIND( numtrc_ref )              ! Namelist namc14_typ in reference namelist :
       READ  ( numtrc_ref, namc14_fcg, IOSTAT = ios, ERR = 905)
 905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc14_fcg in reference namelist' )
-      REWIND( numtrc_cfg )              ! Namelist namcfcdate in configuration namelist 
       READ  ( numtrc_cfg, namc14_fcg, IOSTAT = ios, ERR = 906)
 906   IF( ios >  0 )   CALL ctl_nam ( ios , 'namc14_fcg in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/C14/trcsms_c14.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/C14/trcsms_c14.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/C14/trcsms_c14.F90	(revision 12928)
@@ -26,4 +26,6 @@
    PUBLIC   trc_sms_c14       ! called in trcsms.F90
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -33,5 +35,5 @@
 CONTAINS
 
-   SUBROUTINE trc_sms_c14( kt )
+   SUBROUTINE trc_sms_c14( kt, Kbb, Kmm, Krhs )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE trc_sms_c14  ***
@@ -46,11 +48,12 @@
       !            freshwater fluxes which should not impact the C14/C ratio
       !
-      !        =>   Delta-C14= ( trn(...jp_c14) -1)*1000.
+      !        =>   Delta-C14= ( tr(...jp_c14,Kmm) -1)*1000.
       !!
       !!----------------------------------------------------------------------
       !
-      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
+      INTEGER, INTENT(in) ::   kt               ! ocean time-step index
+      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs   ! ocean time level
       !
-      INTEGER  :: ji, jj, jk         ! dummy loop indices 
+      INTEGER  :: ji, jj, jk        ! dummy loop indices 
       REAL(wp) :: zt, ztp, zsk      ! dummy variables
       REAL(wp) :: zsol              ! solubility
@@ -77,40 +80,38 @@
       ! -------------------------------------------------------------------
 
-      DO jj = 1, jpj
-         DO ji = 1, jpi  
-            IF( tmask(ji,jj,1) >  0. ) THEN
-               !
-               zt   = MIN( 40. , tsn(ji,jj,1,jp_tem) )
-               !
-               !  Computation of solubility zsol in [mol/(L * atm)]
-               !   after Wanninkhof (2014) referencing Weiss (1974)
-               ztp  = ( zt + 273.16 ) * 0.01
-               zsk  = 0.027766 + ztp * ( -0.025888 + 0.0050578 * ztp )   ! [mol/(L * atm)]
-               zsol = EXP( -58.0931 + 90.5069 / ztp  + 22.2940 * LOG( ztp ) + zsk * tsn(ji,jj,1,jp_sal) )
-               ! convert solubilities [mol/(L * atm)] -> [mol/(m^3 * ppm)]
-               zsol = zsol * 1.e-03
+      DO_2D_11_11
+         IF( tmask(ji,jj,1) >  0. ) THEN
+            !
+            zt   = MIN( 40. , ts(ji,jj,1,jp_tem,Kmm) )
+            !
+            !  Computation of solubility zsol in [mol/(L * atm)]
+            !   after Wanninkhof (2014) referencing Weiss (1974)
+            ztp  = ( zt + 273.16 ) * 0.01
+            zsk  = 0.027766 + ztp * ( -0.025888 + 0.0050578 * ztp )   ! [mol/(L * atm)]
+            zsol = EXP( -58.0931 + 90.5069 / ztp  + 22.2940 * LOG( ztp ) + zsk * ts(ji,jj,1,jp_sal,Kmm) )
+            ! convert solubilities [mol/(L * atm)] -> [mol/(m^3 * ppm)]
+            zsol = zsol * 1.e-03
 
-               ! Computes the Schmidt number of CO2 in seawater
-               !               Wanninkhof-2014
-               zsch = 2116.8 + zt * ( -136.25 + zt * (4.7353 + zt * (-0.092307 + 0.0007555 * zt ) ) )
+            ! Computes the Schmidt number of CO2 in seawater
+            !               Wanninkhof-2014
+            zsch = 2116.8 + zt * ( -136.25 + zt * (4.7353 + zt * (-0.092307 + 0.0007555 * zt ) ) )
 
-               ! Wanninkhof Piston velocity: zpv in units [m/s]
-               zv2 = xkwind * (wndm(ji,jj) * wndm(ji,jj))              ! wind speed module at T points
-               ! chemical enhancement (Wanninkhof & Knox, 1996)
-               IF( ln_chemh ) zv2 = zv2 + 2.5 * ( 0.5246 + zt * (0.016256 + 0.00049946  * zt ) )
-               zv2 = zv2/360000._wp                                    ! conversion cm/h -> m/s
-               !
-               zpv  = ( zv2 * SQRT( 660./ zsch ) ) * ( 1. - fr_i(ji,jj) ) * tmask(ji,jj,1)
+            ! Wanninkhof Piston velocity: zpv in units [m/s]
+            zv2 = xkwind * (wndm(ji,jj) * wndm(ji,jj))              ! wind speed module at T points
+            ! chemical enhancement (Wanninkhof & Knox, 1996)
+            IF( ln_chemh ) zv2 = zv2 + 2.5 * ( 0.5246 + zt * (0.016256 + 0.00049946  * zt ) )
+            zv2 = zv2/360000._wp                                    ! conversion cm/h -> m/s
+            !
+            zpv  = ( zv2 * SQRT( 660./ zsch ) ) * ( 1. - fr_i(ji,jj) ) * tmask(ji,jj,1)
 
-               ! CO2 piston velocity (m/s)
-               exch_co2(ji,jj)= zpv
-               ! CO2 invasion rate (mol/ppm/m2/s) = 1st part of 14C/C exchange velocity
-               exch_c14(ji,jj)= zpv * zsol
-            ELSE
-               exch_co2(ji,jj) = 0._wp
-               exch_c14(ji,jj) = 0._wp
-            ENDIF
-         END DO
-      END DO
+            ! CO2 piston velocity (m/s)
+            exch_co2(ji,jj)= zpv
+            ! CO2 invasion rate (mol/ppm/m2/s) = 1st part of 14C/C exchange velocity
+            exch_c14(ji,jj)= zpv * zsol
+         ELSE
+            exch_co2(ji,jj) = 0._wp
+            exch_c14(ji,jj) = 0._wp
+         ENDIF
+      END_2D
 
       ! Exchange velocity for 14C/C ratio (m/s)
@@ -120,26 +121,20 @@
       ! Flux of C-14 from air-to-sea; units: (C14/C ratio) x m/s
       !                               already masked
-      qtr_c14(:,:) = exch_c14(:,:) * ( c14sbc(:,:) - trb(:,:,1,jp_c14) )
+      qtr_c14(:,:) = exch_c14(:,:) * ( c14sbc(:,:) - tr(:,:,1,jp_c14,Kbb) )
             
       ! cumulation of air-to-sea flux at each time step
-      qint_c14(:,:) = qint_c14(:,:) + qtr_c14(:,:) * rdttrc
+      qint_c14(:,:) = qint_c14(:,:) + qtr_c14(:,:) * rn_Dt
       !
       ! Add the surface flux to the trend of jp_c14
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            tra(ji,jj,1,jp_c14) = tra(ji,jj,1,jp_c14) + qtr_c14(ji,jj) / e3t_n(ji,jj,1) 
-         END DO
-      END DO
+      DO_2D_11_11
+         tr(ji,jj,1,jp_c14,Krhs) = tr(ji,jj,1,jp_c14,Krhs) + qtr_c14(ji,jj) / e3t(ji,jj,1,Kmm) 
+      END_2D
       !
       ! Computation of decay effects on jp_c14
-      DO jk = 1, jpk
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               !
-               tra(ji,jj,jk,jp_c14) = tra(ji,jj,jk,jp_c14) - rlam14 * trb(ji,jj,jk,jp_c14) * tmask(ji,jj,jk) 
-               !
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpk )
+         !
+         tr(ji,jj,jk,jp_c14,Krhs) = tr(ji,jj,jk,jp_c14,Krhs) - rlam14 * tr(ji,jj,jk,jp_c14,Kbb) * tmask(ji,jj,jk) 
+         !
+      END_3D
       !
       IF( lrst_trc ) THEN
@@ -157,5 +152,5 @@
       ENDIF
 
-      IF( l_trdtrc )  CALL trd_trc( tra(:,:,:,jp_c14), 1, jptra_sms, kt )   ! save trends
+      IF( l_trdtrc )  CALL trd_trc( tr(:,:,:,jp_c14,Krhs), 1, jptra_sms, kt, Kmm )   ! save trends
       !
       IF( ln_timing )   CALL timing_stop('trc_sms_c14')
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/C14/trcwri_c14.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/C14/trcwri_c14.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/C14/trcwri_c14.F90	(revision 12928)
@@ -23,9 +23,11 @@
    !   Standard ratio: 1.176E-12 ; Avogadro's nbr = 6.022E+23 at/mol ; bomb C14 traditionally reported as 1.E+26 atoms
    REAL(wp), PARAMETER  :: atomc14 = 1.176 * 6.022E-15   ! conversion factor 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
 
 
 CONTAINS
 
-   SUBROUTINE trc_wri_c14
+   SUBROUTINE trc_wri_c14( Kmm )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE trc_wri_c14  ***
@@ -33,4 +35,5 @@
       !! ** Purpose :   output additional C14 tracers fields 
       !!---------------------------------------------------------------------
+      INTEGER, INTENT(in)  :: Kmm           ! time level indices
       CHARACTER (len=20)   :: cltra         ! short title for tracer
       INTEGER              :: ji,jj,jk,jn   ! dummy loop indexes
@@ -43,5 +46,5 @@
       ! ---------------------------------------
       cltra = TRIM( ctrcnm(jp_c14) )                  ! short title for tracer
-      CALL iom_put( cltra, trn(:,:,:,jp_c14) )
+      CALL iom_put( cltra, tr(:,:,:,jp_c14,Kmm) )
 
       ! compute and write the tracer diagnostic in the file
@@ -57,14 +60,10 @@
          zz3d(:,:,:) = 0._wp
          !
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  IF( tmask(ji,jj,jk) > 0._wp) THEN
-                     z3d (ji,jj,jk) = trn(ji,jj,jk,jp_c14)
-                     zz3d(ji,jj,jk) = LOG( z3d(ji,jj,jk) )
-                  ENDIF
-               ENDDO
-            ENDDO
-         ENDDO
+         DO_3D_11_11( 1, jpkm1 )
+            IF( tmask(ji,jj,jk) > 0._wp) THEN
+               z3d (ji,jj,jk) = tr(ji,jj,jk,jp_c14,Kmm)
+               zz3d(ji,jj,jk) = LOG( z3d(ji,jj,jk) )
+            ENDIF
+         END_3D
          zres(:,:) = z3d(:,:,1)
 
@@ -72,10 +71,8 @@
          z2d(:,:) =0._wp
          jk = 1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ztemp = zres(ji,jj) / c14sbc(ji,jj)
-               IF( ztemp > 0._wp .AND. tmask(ji,jj,jk) > 0._wp ) z2d(ji,jj) = LOG( ztemp )
-            ENDDO
-         ENDDO
+         DO_2D_11_11
+            ztemp = zres(ji,jj) / c14sbc(ji,jj)
+            IF( ztemp > 0._wp .AND. tmask(ji,jj,jk) > 0._wp ) z2d(ji,jj) = LOG( ztemp )
+         END_2D
          !
          z3d(:,:,:) = 1.d03 * ( z3d(:,:,:) - 1._wp )
@@ -113,5 +110,5 @@
       ENDIF
       IF( iom_use("C14Inv") ) THEN
-         ztemp = glob_sum( 'trcwri_c14', trn(:,:,:,jp_c14) * cvol(:,:,:) )
+         ztemp = glob_sum( 'trcwri_c14', tr(:,:,:,jp_c14,Kmm) * cvol(:,:,:) )
          ztemp = atomc14 * xdicsur * ztemp
          CALL iom_put( "C14Inv", ztemp )  !  Radiocarbon ocean inventory [10^26 atoms]
@@ -130,4 +127,6 @@
 #endif
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/CFC/trcini_cfc.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/CFC/trcini_cfc.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/CFC/trcini_cfc.F90	(revision 12928)
@@ -24,4 +24,6 @@
    REAL(wp) ::   ylatn =  10.           ! 10 degrees north
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -31,5 +33,5 @@
 CONTAINS
 
-   SUBROUTINE trc_ini_cfc
+   SUBROUTINE trc_ini_cfc( Kmm )
       !!----------------------------------------------------------------------
       !!                     ***  trc_ini_cfc  ***  
@@ -39,6 +41,7 @@
       !! ** Method  : - Read the namcfc namelist and check the parameter values
       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in)  ::  Kmm  ! time level indices
       INTEGER  ::  ji, jj, jn, jl, jm, js, io, ierr
-      INTEGER  ::  iskip = 6   ! number of 1st descriptor lines
+      INTEGER  ::  iskip = 6        ! number of 1st descriptor lines
       REAL(wp) ::  zyy, zyd
       CHARACTER(len = 20)  ::  cltra
@@ -90,5 +93,5 @@
          DO jl = 1, jp_cfc
             jn = jp_cfc0 + jl - 1
-            trn(:,:,:,jn) = 0._wp
+            tr(:,:,:,jn,Kmm) = 0._wp
          END DO
       ENDIF
@@ -129,12 +132,10 @@
       !---------------------------------------------------------------------------------------
       zyd = ylatn - ylats      
-      DO jj = 1 , jpj
-         DO ji = 1 , jpi
-            IF(     gphit(ji,jj) >= ylatn ) THEN   ;   xphem(ji,jj) = 1.e0
-            ELSEIF( gphit(ji,jj) <= ylats ) THEN   ;   xphem(ji,jj) = 0.e0
-            ELSE                                   ;   xphem(ji,jj) = ( gphit(ji,jj) - ylats) / zyd
-            ENDIF
-         END DO
-      END DO
+      DO_2D_11_11
+         IF(     gphit(ji,jj) >= ylatn ) THEN   ;   xphem(ji,jj) = 1.e0
+         ELSEIF( gphit(ji,jj) <= ylats ) THEN   ;   xphem(ji,jj) = 0.e0
+         ELSE                                   ;   xphem(ji,jj) = ( gphit(ji,jj) - ylats) / zyd
+         ENDIF
+      END_2D
       !
       IF(lwp) WRITE(numout,*) 'Initialization of CFC tracers done'
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/CFC/trcnam_cfc.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/CFC/trcnam_cfc.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/CFC/trcnam_cfc.F90	(revision 12928)
@@ -51,8 +51,6 @@
       ENDIF
       !
-      REWIND( numtrc_ref )              ! Namelist namcfcdate in reference namelist : CFC parameters
       READ  ( numtrc_ref, namcfc, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfc in reference namelist' )
-      REWIND( numtrc_cfg )              ! Namelist namcfcdate in configuration namelist : CFC parameters
       READ  ( numtrc_cfg, namcfc, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfc in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/CFC/trcsms_cfc.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/CFC/trcsms_cfc.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/CFC/trcsms_cfc.F90	(revision 12928)
@@ -47,4 +47,6 @@
    REAL(wp) ::   xconv4 = 1.0e-12      ! conversion from mol/m3/atm to mol/m3/pptv 
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -54,5 +56,5 @@
 CONTAINS
 
-   SUBROUTINE trc_sms_cfc( kt )
+   SUBROUTINE trc_sms_cfc( kt, Kbb, Kmm, Krhs )
       !!----------------------------------------------------------------------
       !!                     ***  ROUTINE trc_sms_cfc  ***
@@ -70,5 +72,6 @@
       !!                CFC concentration in pico-mol/m3
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
+      INTEGER, INTENT(in) ::   kt               ! ocean time-step index
+      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs   ! ocean time level
       !
       INTEGER  ::   ji, jj, jn, jl, jm
@@ -105,4 +108,8 @@
          im2       =      nmonth - 7
       ENDIF
+      ! Avoid bad interpolation if starting date is =< 1900
+      IF( iyear_beg .LE. 0      )  iyear_beg = 1
+      IF( iyear_beg .GE. jpyear )  iyear_beg = jpyear - 1
+      !
       iyear_end = iyear_beg + 1
 
@@ -118,51 +125,48 @@
          
          !                                                         !------------!
-         DO jj = 1, jpj                                            !  i-j loop  !
-            DO ji = 1, jpi                                         !------------!
+         DO_2D_11_11
  
-               ! space interpolation
-               zpp_cfc  =       xphem(ji,jj)   * zpatm(1,jl)   &
-                  &     + ( 1.- xphem(ji,jj) ) * zpatm(2,jl)
-
-               ! Computation of concentration at equilibrium : in picomol/l
-               ! coefficient for solubility for CFC-11/12 in  mol/l/atm
-               IF( tmask(ji,jj,1) .GE. 0.5 ) THEN
-                  ztap  = ( tsn(ji,jj,1,jp_tem) + 273.16 ) * 0.01
-                  zdtap = sob(1,jl) + ztap * ( sob(2,jl) + ztap * sob(3,jl) ) 
-                  zsol  =  EXP( soa(1,jl) + soa(2,jl) / ztap + soa(3,jl) * LOG( ztap )   &
-                     &                    + soa(4,jl) * ztap * ztap + tsn(ji,jj,1,jp_sal) * zdtap ) 
-               ELSE
-                  zsol  = 0.e0
-               ENDIF
-               ! conversion from mol/l/atm to mol/m3/atm and from mol/m3/atm to mol/m3/pptv    
-               zsol = xconv4 * xconv3 * zsol * tmask(ji,jj,1)  
-               ! concentration at equilibrium
-               zca_cfc = xconv1 * zpp_cfc * zsol * tmask(ji,jj,1)             
-  
-               ! Computation of speed transfert
-               !    Schmidt number revised in Wanninkhof (2014)
-               zt1  = tsn(ji,jj,1,jp_tem)
-               zt2  = zt1 * zt1 
-               zt3  = zt1 * zt2
-               zt4  = zt2 * zt2
-               zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 + sca(5,jl) * zt4
-
-               !    speed transfert : formulae revised in Wanninkhof (2014)
-               zv2     = wndm(ji,jj) * wndm(ji,jj)
-               zsch    = zsch / 660.
-               zak_cfc = ( 0.251 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1)
-
-               ! Input function  : speed *( conc. at equil - concen at surface )
-               ! trn in pico-mol/l idem qtr; ak in en m/a
-               qtr_cfc(ji,jj,jl) = -zak_cfc * ( trb(ji,jj,1,jn) - zca_cfc )   &
-                  &                         * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) )
-               ! Add the surface flux to the trend
-               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + qtr_cfc(ji,jj,jl) / e3t_n(ji,jj,1) 
-
-               ! cumulation of surface flux at each time step
-               qint_cfc(ji,jj,jl) = qint_cfc(ji,jj,jl) + qtr_cfc(ji,jj,jl) * rdt
-               !                                               !----------------!
-            END DO                                             !  end i-j loop  !
-         END DO                                                !----------------!
+            ! space interpolation
+            zpp_cfc  =       xphem(ji,jj)   * zpatm(1,jl)   &
+               &     + ( 1.- xphem(ji,jj) ) * zpatm(2,jl)
+
+            ! Computation of concentration at equilibrium : in picomol/l
+            ! coefficient for solubility for CFC-11/12 in  mol/l/atm
+            IF( tmask(ji,jj,1) .GE. 0.5 ) THEN
+               ztap  = ( ts(ji,jj,1,jp_tem,Kmm) + 273.16 ) * 0.01
+               zdtap = sob(1,jl) + ztap * ( sob(2,jl) + ztap * sob(3,jl) ) 
+               zsol  =  EXP( soa(1,jl) + soa(2,jl) / ztap + soa(3,jl) * LOG( ztap )   &
+                  &                    + soa(4,jl) * ztap * ztap + ts(ji,jj,1,jp_sal,Kmm) * zdtap ) 
+            ELSE
+               zsol  = 0.e0
+            ENDIF
+            ! conversion from mol/l/atm to mol/m3/atm and from mol/m3/atm to mol/m3/pptv    
+            zsol = xconv4 * xconv3 * zsol * tmask(ji,jj,1)  
+            ! concentration at equilibrium
+            zca_cfc = xconv1 * zpp_cfc * zsol * tmask(ji,jj,1)             
+            ! Computation of speed transfert
+            !    Schmidt number revised in Wanninkhof (2014)
+            zt1  = ts(ji,jj,1,jp_tem,Kmm)
+            zt2  = zt1 * zt1 
+            zt3  = zt1 * zt2
+            zt4  = zt2 * zt2
+            zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 + sca(5,jl) * zt4
+
+            !    speed transfert : formulae revised in Wanninkhof (2014)
+            zv2     = wndm(ji,jj) * wndm(ji,jj)
+            zsch    = zsch / 660.
+            zak_cfc = ( 0.251 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1)
+
+            ! Input function  : speed *( conc. at equil - concen at surface )
+            ! tr(:,:,:,:,Kmm) in pico-mol/l idem qtr; ak in en m/a
+            qtr_cfc(ji,jj,jl) = -zak_cfc * ( tr(ji,jj,1,jn,Kbb) - zca_cfc )   &
+               &                         * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) )
+            ! Add the surface flux to the trend
+            tr(ji,jj,1,jn,Krhs) = tr(ji,jj,1,jn,Krhs) + qtr_cfc(ji,jj,jl) / e3t(ji,jj,1,Kmm) 
+
+            ! cumulation of surface flux at each time step
+            qint_cfc(ji,jj,jl) = qint_cfc(ji,jj,jl) + qtr_cfc(ji,jj,jl) * rn_Dt
+            !                                               !----------------!
+         END_2D
          !                                                  !----------------!
       END DO                                                !  end CFC loop  !
@@ -191,5 +195,5 @@
       IF( l_trdtrc ) THEN
           DO jn = jp_cfc0, jp_cfc1
-            CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt )   ! save trends
+            CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm )   ! save trends
           END DO
       END IF
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/CFC/trcwri_cfc.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/CFC/trcwri_cfc.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/CFC/trcwri_cfc.F90	(revision 12928)
@@ -20,5 +20,5 @@
 CONTAINS
 
-   SUBROUTINE trc_wri_cfc
+   SUBROUTINE trc_wri_cfc( Kmm )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE trc_wri_trc  ***
@@ -26,4 +26,5 @@
       !! ** Purpose :   output passive tracers fields 
       !!---------------------------------------------------------------------
+      INTEGER, INTENT(in)  :: Kmm   ! time level indices
       CHARACTER (len=20)   :: cltra
       INTEGER              :: jn
@@ -34,5 +35,5 @@
       DO jn = jp_cfc0, jp_cfc1
          cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer
-         CALL iom_put( cltra, trn(:,:,:,jn) )
+         CALL iom_put( cltra, tr(:,:,:,jn,Kmm) )
       END DO
       !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/MY_TRC/trcini_my_trc.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/MY_TRC/trcini_my_trc.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/MY_TRC/trcini_my_trc.F90	(revision 12928)
@@ -28,5 +28,5 @@
 CONTAINS
 
-   SUBROUTINE trc_ini_my_trc
+   SUBROUTINE trc_ini_my_trc( Kmm )
       !!----------------------------------------------------------------------
       !!                     ***  trc_ini_my_trc  ***  
@@ -36,4 +36,5 @@
       !! ** Method  : - Read the namcfc namelist and check the parameter values
       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   Kmm  ! time level indices
       !
       CALL trc_nam_my_trc
@@ -50,5 +51,5 @@
       IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
       
-      IF( .NOT. ln_rsttr ) trn(:,:,:,jp_myt0:jp_myt1) = 1.
+      IF( .NOT. ln_rsttr ) tr(:,:,:,jp_myt0:jp_myt1,Kmm) = 1.
       !
    END SUBROUTINE trc_ini_my_trc
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/MY_TRC/trcsms_my_trc.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/MY_TRC/trcsms_my_trc.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/MY_TRC/trcsms_my_trc.F90	(revision 12928)
@@ -15,5 +15,4 @@
    USE trd_oce
    USE trdtrc
-   USE trcbc, only : trc_bc
 
    IMPLICIT NONE
@@ -32,5 +31,5 @@
 CONTAINS
 
-   SUBROUTINE trc_sms_my_trc( kt )
+   SUBROUTINE trc_sms_my_trc( kt, Kbb, Kmm, Krhs )
       !!----------------------------------------------------------------------
       !!                     ***  trc_sms_my_trc  ***
@@ -42,4 +41,5 @@
       !
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level indices
       INTEGER ::   jn   ! dummy loop index
       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrmyt
@@ -54,6 +54,4 @@
       IF( l_trdtrc )  ALLOCATE( ztrmyt(jpi,jpj,jpk) )
 
-      CALL trc_bc ( kt )       ! tracers: surface and lateral Boundary Conditions
-
       ! add here the call to BGC model
 
@@ -61,6 +59,6 @@
       IF( l_trdtrc ) THEN
           DO jn = jp_myt0, jp_myt1
-            ztrmyt(:,:,:) = tra(:,:,:,jn)
-            CALL trd_trc( ztrmyt, jn, jptra_sms, kt )   ! save trends
+            ztrmyt(:,:,:) = tr(:,:,:,jn,Krhs)
+            CALL trd_trc( ztrmyt, jn, jptra_sms, kt, Kmm )   ! save trends
           END DO
           DEALLOCATE( ztrmyt )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/MY_TRC/trcwri_my_trc.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/MY_TRC/trcwri_my_trc.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/MY_TRC/trcwri_my_trc.F90	(revision 12928)
@@ -25,5 +25,5 @@
 CONTAINS
 
-   SUBROUTINE trc_wri_my_trc
+   SUBROUTINE trc_wri_my_trc( Kmm )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE trc_wri_trc  ***
@@ -31,4 +31,5 @@
       !! ** Purpose :   output passive tracers fields 
       !!---------------------------------------------------------------------
+      INTEGER, INTENT(in)  :: Kmm   ! time level indices
       CHARACTER (len=20)   :: cltra
       INTEGER              :: jn
@@ -39,5 +40,5 @@
       DO jn = jp_myt0, jp_myt1
          cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer
-         CALL iom_put( cltra, trn(:,:,:,jn) )
+         CALL iom_put( cltra, tr(:,:,:,jn,Kmm) )
       END DO
       !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P2Z/p2zbio.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P2Z/p2zbio.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P2Z/p2zbio.F90	(revision 12928)
@@ -57,5 +57,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -65,5 +65,5 @@
 CONTAINS
 
-   SUBROUTINE p2z_bio( kt )
+   SUBROUTINE p2z_bio( kt, Kmm, Krhs )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p2z_bio  ***
@@ -78,5 +78,5 @@
       !!              is added to the general trend.
       !!        
-      !!                      tra = tra + zf...tra - zftra...
+      !!                      tr(Krhs) = tr(Krhs) + zf...tr(Krhs) - zftra...
       !!                                     |         |
       !!                                     |         |
@@ -84,5 +84,6 @@
       !!        
       !!---------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
+      INTEGER, INTENT( in ) ::   kt             ! ocean time-step index      
+      INTEGER, INTENT( in ) ::   Kmm, Krhs      ! time level indices
       !
       INTEGER  ::   ji, jj, jk, jl
@@ -120,121 +121,119 @@
       DO jk = 1, jpkbm1                      !  Upper ocean (bio-layers)  !
          !                                   ! -------------------------- !
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1 
-               ! trophic variables( det, zoo, phy, no3, nh4, dom)
-               ! ------------------------------------------------
-
-               ! negative trophic variables DO not contribute to the fluxes
-               zdet = MAX( 0.e0, trn(ji,jj,jk,jpdet) )
-               zzoo = MAX( 0.e0, trn(ji,jj,jk,jpzoo) )
-               zphy = MAX( 0.e0, trn(ji,jj,jk,jpphy) )
-               zno3 = MAX( 0.e0, trn(ji,jj,jk,jpno3) )
-               znh4 = MAX( 0.e0, trn(ji,jj,jk,jpnh4) )
-               zdom = MAX( 0.e0, trn(ji,jj,jk,jpdom) )
-
-               ! Limitations
-               zlt   = 1.
-               zle   = 1. - EXP( -etot(ji,jj,jk) / aki / zlt )
-               ! psinut,akno3,aknh4 added by asklod AS Kremeur 2005-03
-               zlno3 = zno3 * EXP( -psinut * znh4 ) / ( akno3 + zno3 )
-               zlnh4 = znh4 / (znh4+aknh4)  
-
-               ! sinks and sources
-               !    phytoplankton production and exsudation
-               zno3phy = tmumax * zle * zlt * zlno3 * zphy
-               znh4phy = tmumax * zle * zlt * zlnh4 * zphy
-
-               !    fphylab added by asklod AS Kremeur 2005-03
-               zphydom = rgamma * (1 - fphylab) * (zno3phy + znh4phy)
-               zphynh4 = rgamma * fphylab * (zno3phy + znh4phy)
-               ! zooplankton production
-               !    preferences
-               zppz = rppz
-               zpdz = 1. - rppz
-               zpppz = ( zppz * zphy ) / ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 )
-               zppdz = ( zpdz * zdet ) / ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 )
-               zfood = zpppz * zphy + zppdz * zdet
-               !    filtration 
-               zfilpz = taus * zpppz / (aks + zfood)
-               zfildz = taus * zppdz / (aks + zfood)
-               !    grazing
-               zphyzoo = zfilpz * zphy * zzoo
-               zdetzoo = zfildz * zdet * zzoo
-
-               ! fecal pellets production
-               zzoodet = rpnaz * zphyzoo + rdnaz * zdetzoo
-
-               ! zooplankton liquide excretion
-               zzoonh4 = tauzn * fzoolab * zzoo  
-               zzoodom = tauzn * (1 - fzoolab) * zzoo
-
-               ! mortality
-               !    phytoplankton mortality
-               zphydet = tmminp * zphy
-
-               !    zooplankton mortality
-               !    closure : flux grazing is redistributed below level jpkbio
-               zzoobod = tmminz * zzoo * zzoo
-               xksi(ji,jj) = xksi(ji,jj) + (1-fdbod) * zzoobod * e3t_n(ji,jj,jk)
-               zboddet = fdbod * zzoobod
-
-               ! detritus and dom breakdown
-               zdetnh4 = taudn * fdetlab * zdet
-               zdetdom = taudn * (1 - fdetlab) * zdet
-
-               zdomnh4 = taudomn * zdom
-
-               ! flux added to express how the excess of nitrogen from 
-               ! PHY, ZOO and DET to DOM goes directly to NH4 (flux of ajustment)
-               zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom)
-
-               ! Nitrification 
-               znh4no3 = taunn * znh4
-
-               ! determination of trends
-               !    total trend for each biological tracer
-               zphya =   zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet
-               zzooa =   zphyzoo + zdetzoo - zzoodet - zzoodom - zzoonh4 - zzoobod
-               zno3a = - zno3phy + znh4no3
-               znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 + zdetnh4 + zdomaju
-               zdeta =   zphydet + zzoodet - zdetzoo - zdetnh4 - zdetdom + zboddet
-               zdoma =   zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju
-
-               ! tracer flux at totox-point added to the general trend
-               tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + zdeta
-               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zzooa
-               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zphya
-               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zno3a
-               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + znh4a
-               tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma
-
-                IF( lk_iomput ) THEN
-                  ! convert fluxes in per day
-                  ze3t = e3t_n(ji,jj,jk) * 86400._wp
-                  zw2d(ji,jj,1)  = zw2d(ji,jj,1)  + zno3phy * ze3t
-                  zw2d(ji,jj,2)  = zw2d(ji,jj,2)  + znh4phy * ze3t
-                  zw2d(ji,jj,3)  = zw2d(ji,jj,3)  + zphydom * ze3t
-                  zw2d(ji,jj,4)  = zw2d(ji,jj,4)  + zphynh4 * ze3t
-                  zw2d(ji,jj,5)  = zw2d(ji,jj,5)  + zphyzoo * ze3t
-                  zw2d(ji,jj,6)  = zw2d(ji,jj,6)  + zphydet * ze3t
-                  zw2d(ji,jj,7)  = zw2d(ji,jj,7)  + zdetzoo * ze3t
-                  zw2d(ji,jj,8)  = zw2d(ji,jj,8)  + zzoodet * ze3t
-                  zw2d(ji,jj,9)  = zw2d(ji,jj,9)  + zzoobod * ze3t
-                  zw2d(ji,jj,10) = zw2d(ji,jj,10) + zzoonh4 * ze3t
-                  zw2d(ji,jj,11) = zw2d(ji,jj,11) + zzoodom * ze3t
-                  zw2d(ji,jj,12) = zw2d(ji,jj,12) + znh4no3 * ze3t
-                  zw2d(ji,jj,13) = zw2d(ji,jj,13) + zdomnh4 * ze3t
-                  zw2d(ji,jj,14) = zw2d(ji,jj,14) + zdetnh4 * ze3t
-                  zw2d(ji,jj,15) = zw2d(ji,jj,15) + ( zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet ) * ze3t
-                  zw2d(ji,jj,16) = zw2d(ji,jj,16) + ( zphyzoo + zdetzoo - zzoodet - zzoobod - zzoonh4 - zzoodom ) * ze3t
-                  zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t
-                  !   
-                  zw3d(ji,jj,jk,1) = zno3phy * 86400
-                  zw3d(ji,jj,jk,2) = znh4phy * 86400     
-                  zw3d(ji,jj,jk,3) = znh4no3 * 86400   
-                   ! 
-                ENDIF
-            END DO
-         END DO
+         DO_2D_00_00
+            ! trophic variables( det, zoo, phy, no3, nh4, dom)
+            ! ------------------------------------------------
+
+            ! negative trophic variables DO not contribute to the fluxes
+            zdet = MAX( 0.e0, tr(ji,jj,jk,jpdet,Kmm) )
+            zzoo = MAX( 0.e0, tr(ji,jj,jk,jpzoo,Kmm) )
+            zphy = MAX( 0.e0, tr(ji,jj,jk,jpphy,Kmm) )
+            zno3 = MAX( 0.e0, tr(ji,jj,jk,jpno3,Kmm) )
+            znh4 = MAX( 0.e0, tr(ji,jj,jk,jpnh4,Kmm) )
+            zdom = MAX( 0.e0, tr(ji,jj,jk,jpdom,Kmm) )
+
+            ! Limitations
+            zlt   = 1.
+            zle   = 1. - EXP( -etot(ji,jj,jk) / aki / zlt )
+            ! psinut,akno3,aknh4 added by asklod AS Kremeur 2005-03
+            zlno3 = zno3 * EXP( -psinut * znh4 ) / ( akno3 + zno3 )
+            zlnh4 = znh4 / (znh4+aknh4)  
+
+            ! sinks and sources
+            !    phytoplankton production and exsudation
+            zno3phy = tmumax * zle * zlt * zlno3 * zphy
+            znh4phy = tmumax * zle * zlt * zlnh4 * zphy
+
+            !    fphylab added by asklod AS Kremeur 2005-03
+            zphydom = rgamma * (1 - fphylab) * (zno3phy + znh4phy)
+            zphynh4 = rgamma * fphylab * (zno3phy + znh4phy)
+            ! zooplankton production
+            !    preferences
+            zppz = rppz
+            zpdz = 1. - rppz
+            zpppz = ( zppz * zphy ) / ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 )
+            zppdz = ( zpdz * zdet ) / ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 )
+            zfood = zpppz * zphy + zppdz * zdet
+            !    filtration 
+            zfilpz = taus * zpppz / (aks + zfood)
+            zfildz = taus * zppdz / (aks + zfood)
+            !    grazing
+            zphyzoo = zfilpz * zphy * zzoo
+            zdetzoo = zfildz * zdet * zzoo
+
+            ! fecal pellets production
+            zzoodet = rpnaz * zphyzoo + rdnaz * zdetzoo
+
+            ! zooplankton liquide excretion
+            zzoonh4 = tauzn * fzoolab * zzoo  
+            zzoodom = tauzn * (1 - fzoolab) * zzoo
+
+            ! mortality
+            !    phytoplankton mortality
+            zphydet = tmminp * zphy
+
+            !    zooplankton mortality
+            !    closure : flux grazing is redistributed below level jpkbio
+            zzoobod = tmminz * zzoo * zzoo
+            xksi(ji,jj) = xksi(ji,jj) + (1-fdbod) * zzoobod * e3t(ji,jj,jk,Kmm)
+            zboddet = fdbod * zzoobod
+
+            ! detritus and dom breakdown
+            zdetnh4 = taudn * fdetlab * zdet
+            zdetdom = taudn * (1 - fdetlab) * zdet
+
+            zdomnh4 = taudomn * zdom
+
+            ! flux added to express how the excess of nitrogen from 
+            ! PHY, ZOO and DET to DOM goes directly to NH4 (flux of ajustment)
+            zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom)
+
+            ! Nitrification 
+            znh4no3 = taunn * znh4
+
+            ! determination of trends
+            !    total trend for each biological tracer
+            zphya =   zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet
+            zzooa =   zphyzoo + zdetzoo - zzoodet - zzoodom - zzoonh4 - zzoobod
+            zno3a = - zno3phy + znh4no3
+            znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 + zdetnh4 + zdomaju
+            zdeta =   zphydet + zzoodet - zdetzoo - zdetnh4 - zdetdom + zboddet
+            zdoma =   zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju
+
+            ! tracer flux at totox-point added to the general trend
+            tr(ji,jj,jk,jpdet,Krhs) = tr(ji,jj,jk,jpdet,Krhs) + zdeta
+            tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) + zzooa
+            tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zphya
+            tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + zno3a
+            tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + znh4a
+            tr(ji,jj,jk,jpdom,Krhs) = tr(ji,jj,jk,jpdom,Krhs) + zdoma
+
+             IF( lk_iomput ) THEN
+               ! convert fluxes in per day
+               ze3t = e3t(ji,jj,jk,Kmm) * 86400._wp
+               zw2d(ji,jj,1)  = zw2d(ji,jj,1)  + zno3phy * ze3t
+               zw2d(ji,jj,2)  = zw2d(ji,jj,2)  + znh4phy * ze3t
+               zw2d(ji,jj,3)  = zw2d(ji,jj,3)  + zphydom * ze3t
+               zw2d(ji,jj,4)  = zw2d(ji,jj,4)  + zphynh4 * ze3t
+               zw2d(ji,jj,5)  = zw2d(ji,jj,5)  + zphyzoo * ze3t
+               zw2d(ji,jj,6)  = zw2d(ji,jj,6)  + zphydet * ze3t
+               zw2d(ji,jj,7)  = zw2d(ji,jj,7)  + zdetzoo * ze3t
+               zw2d(ji,jj,8)  = zw2d(ji,jj,8)  + zzoodet * ze3t
+               zw2d(ji,jj,9)  = zw2d(ji,jj,9)  + zzoobod * ze3t
+               zw2d(ji,jj,10) = zw2d(ji,jj,10) + zzoonh4 * ze3t
+               zw2d(ji,jj,11) = zw2d(ji,jj,11) + zzoodom * ze3t
+               zw2d(ji,jj,12) = zw2d(ji,jj,12) + znh4no3 * ze3t
+               zw2d(ji,jj,13) = zw2d(ji,jj,13) + zdomnh4 * ze3t
+               zw2d(ji,jj,14) = zw2d(ji,jj,14) + zdetnh4 * ze3t
+               zw2d(ji,jj,15) = zw2d(ji,jj,15) + ( zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet ) * ze3t
+               zw2d(ji,jj,16) = zw2d(ji,jj,16) + ( zphyzoo + zdetzoo - zzoodet - zzoobod - zzoonh4 - zzoodom ) * ze3t
+               zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t
+               !   
+               zw3d(ji,jj,jk,1) = zno3phy * 86400
+               zw3d(ji,jj,jk,2) = znh4phy * 86400     
+               zw3d(ji,jj,jk,3) = znh4no3 * 86400   
+                ! 
+             ENDIF
+         END_2D
       END DO
 
@@ -242,100 +241,98 @@
       DO jk = jpkb, jpkm1                    !  Upper ocean (bio-layers)  !
          !                                   ! -------------------------- !
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1 
-               ! remineralisation of all quantities towards nitrate 
-
-               !    trophic variables( det, zoo, phy, no3, nh4, dom)
-               !       negative trophic variables DO not contribute to the fluxes
-               zdet = MAX( 0.e0, trn(ji,jj,jk,jpdet) )
-               zzoo = MAX( 0.e0, trn(ji,jj,jk,jpzoo) )
-               zphy = MAX( 0.e0, trn(ji,jj,jk,jpphy) )
-               zno3 = MAX( 0.e0, trn(ji,jj,jk,jpno3) )
-               znh4 = MAX( 0.e0, trn(ji,jj,jk,jpnh4) )
-               zdom = MAX( 0.e0, trn(ji,jj,jk,jpdom) )
-
-               !    Limitations
-               zlt   = 0.e0
-               zle   = 0.e0
-               zlno3 = 0.e0
-               zlnh4 = 0.e0
-
-               !    sinks and sources
-               !       phytoplankton production and exsudation
-               zno3phy = 0.e0
-               znh4phy = 0.e0
-               zphydom = 0.e0
-               zphynh4 = 0.e0
-
-               !    zooplankton production
-               zphyzoo = 0.e0      ! grazing
-               zdetzoo = 0.e0
-
-               zzoodet = 0.e0      ! fecal pellets production
-
-               zzoonh4 = tauzn * fzoolab * zzoo         ! zooplankton liquide excretion
-               zzoodom = tauzn * (1 - fzoolab) * zzoo
-
-               !    mortality
-               zphydet = tmminp * zphy      ! phytoplankton mortality
-
-               zzoobod = 0.e0               ! zooplankton mortality
-               zboddet = 0.e0               ! closure : flux fbod is redistributed below level jpkbio
-
-               !    detritus and dom breakdown
-               zdetnh4 = taudn * fdetlab * zdet
-               zdetdom = taudn * (1 - fdetlab) * zdet
-
-               zdomnh4 = taudomn * zdom
-               zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom)
-
-               !    Nitrification
-               znh4no3 = taunn * znh4
-
-
-               ! determination of trends
-               !     total trend for each biological tracer
-               zphya =   zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet
-               zzooa =   zphyzoo + zdetzoo - zzoodet - zzoodom - zzoonh4 - zzoobod
-               zno3a = - zno3phy + znh4no3 
-               znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 + zdetnh4 + zdomaju
-               zdeta = zphydet + zzoodet  - zdetzoo - zdetnh4 - zdetdom + zboddet
-               zdoma = zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju
-
-               ! tracer flux at totox-point added to the general trend
-               tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + zdeta
-               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zzooa
-               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zphya
-               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zno3a
-               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + znh4a
-               tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma
+         DO_2D_00_00
+            ! remineralisation of all quantities towards nitrate 
+
+            !    trophic variables( det, zoo, phy, no3, nh4, dom)
+            !       negative trophic variables DO not contribute to the fluxes
+            zdet = MAX( 0.e0, tr(ji,jj,jk,jpdet,Kmm) )
+            zzoo = MAX( 0.e0, tr(ji,jj,jk,jpzoo,Kmm) )
+            zphy = MAX( 0.e0, tr(ji,jj,jk,jpphy,Kmm) )
+            zno3 = MAX( 0.e0, tr(ji,jj,jk,jpno3,Kmm) )
+            znh4 = MAX( 0.e0, tr(ji,jj,jk,jpnh4,Kmm) )
+            zdom = MAX( 0.e0, tr(ji,jj,jk,jpdom,Kmm) )
+
+            !    Limitations
+            zlt   = 0.e0
+            zle   = 0.e0
+            zlno3 = 0.e0
+            zlnh4 = 0.e0
+
+            !    sinks and sources
+            !       phytoplankton production and exsudation
+            zno3phy = 0.e0
+            znh4phy = 0.e0
+            zphydom = 0.e0
+            zphynh4 = 0.e0
+
+            !    zooplankton production
+            zphyzoo = 0.e0      ! grazing
+            zdetzoo = 0.e0
+
+            zzoodet = 0.e0      ! fecal pellets production
+
+            zzoonh4 = tauzn * fzoolab * zzoo         ! zooplankton liquide excretion
+            zzoodom = tauzn * (1 - fzoolab) * zzoo
+
+            !    mortality
+            zphydet = tmminp * zphy      ! phytoplankton mortality
+
+            zzoobod = 0.e0               ! zooplankton mortality
+            zboddet = 0.e0               ! closure : flux fbod is redistributed below level jpkbio
+
+            !    detritus and dom breakdown
+            zdetnh4 = taudn * fdetlab * zdet
+            zdetdom = taudn * (1 - fdetlab) * zdet
+
+            zdomnh4 = taudomn * zdom
+            zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom)
+
+            !    Nitrification
+            znh4no3 = taunn * znh4
+
+
+            ! determination of trends
+            !     total trend for each biological tracer
+            zphya =   zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet
+            zzooa =   zphyzoo + zdetzoo - zzoodet - zzoodom - zzoonh4 - zzoobod
+            zno3a = - zno3phy + znh4no3 
+            znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 + zdetnh4 + zdomaju
+            zdeta = zphydet + zzoodet  - zdetzoo - zdetnh4 - zdetdom + zboddet
+            zdoma = zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju
+
+            ! tracer flux at totox-point added to the general trend
+            tr(ji,jj,jk,jpdet,Krhs) = tr(ji,jj,jk,jpdet,Krhs) + zdeta
+            tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) + zzooa
+            tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zphya
+            tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + zno3a
+            tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + znh4a
+            tr(ji,jj,jk,jpdom,Krhs) = tr(ji,jj,jk,jpdom,Krhs) + zdoma
+            !
+             IF( lk_iomput ) THEN                  ! convert fluxes in per day
+               ze3t = e3t(ji,jj,jk,Kmm) * 86400._wp
+               zw2d(ji,jj,1)  = zw2d(ji,jj,1)  + zno3phy * ze3t
+               zw2d(ji,jj,2)  = zw2d(ji,jj,2)  + znh4phy * ze3t
+               zw2d(ji,jj,3)  = zw2d(ji,jj,3)  + zphydom * ze3t
+               zw2d(ji,jj,4)  = zw2d(ji,jj,4)  + zphynh4 * ze3t
+               zw2d(ji,jj,5)  = zw2d(ji,jj,5)  + zphyzoo * ze3t
+               zw2d(ji,jj,6)  = zw2d(ji,jj,6)  + zphydet * ze3t
+               zw2d(ji,jj,7)  = zw2d(ji,jj,7)  + zdetzoo * ze3t
+               zw2d(ji,jj,8)  = zw2d(ji,jj,8)  + zzoodet * ze3t
+               zw2d(ji,jj,9)  = zw2d(ji,jj,9)  + zzoobod * ze3t
+               zw2d(ji,jj,10) = zw2d(ji,jj,10) + zzoonh4 * ze3t
+               zw2d(ji,jj,11) = zw2d(ji,jj,11) + zzoodom * ze3t
+               zw2d(ji,jj,12) = zw2d(ji,jj,12) + znh4no3 * ze3t
+               zw2d(ji,jj,13) = zw2d(ji,jj,13) + zdomnh4 * ze3t
+               zw2d(ji,jj,14) = zw2d(ji,jj,14) + zdetnh4 * ze3t
+               zw2d(ji,jj,15) = zw2d(ji,jj,15) + ( zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet ) * ze3t
+               zw2d(ji,jj,16) = zw2d(ji,jj,16) + ( zphyzoo + zdetzoo - zzoodet - zzoobod - zzoonh4 - zzoodom ) * ze3t
+               zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t
+               !   
+               zw3d(ji,jj,jk,1) = zno3phy * 86400._wp
+               zw3d(ji,jj,jk,2) = znh4phy * 86400._wp
+               zw3d(ji,jj,jk,3) = znh4no3 * 86400._wp
                !
-                IF( lk_iomput ) THEN                  ! convert fluxes in per day
-                  ze3t = e3t_n(ji,jj,jk) * 86400._wp
-                  zw2d(ji,jj,1)  = zw2d(ji,jj,1)  + zno3phy * ze3t
-                  zw2d(ji,jj,2)  = zw2d(ji,jj,2)  + znh4phy * ze3t
-                  zw2d(ji,jj,3)  = zw2d(ji,jj,3)  + zphydom * ze3t
-                  zw2d(ji,jj,4)  = zw2d(ji,jj,4)  + zphynh4 * ze3t
-                  zw2d(ji,jj,5)  = zw2d(ji,jj,5)  + zphyzoo * ze3t
-                  zw2d(ji,jj,6)  = zw2d(ji,jj,6)  + zphydet * ze3t
-                  zw2d(ji,jj,7)  = zw2d(ji,jj,7)  + zdetzoo * ze3t
-                  zw2d(ji,jj,8)  = zw2d(ji,jj,8)  + zzoodet * ze3t
-                  zw2d(ji,jj,9)  = zw2d(ji,jj,9)  + zzoobod * ze3t
-                  zw2d(ji,jj,10) = zw2d(ji,jj,10) + zzoonh4 * ze3t
-                  zw2d(ji,jj,11) = zw2d(ji,jj,11) + zzoodom * ze3t
-                  zw2d(ji,jj,12) = zw2d(ji,jj,12) + znh4no3 * ze3t
-                  zw2d(ji,jj,13) = zw2d(ji,jj,13) + zdomnh4 * ze3t
-                  zw2d(ji,jj,14) = zw2d(ji,jj,14) + zdetnh4 * ze3t
-                  zw2d(ji,jj,15) = zw2d(ji,jj,15) + ( zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet ) * ze3t
-                  zw2d(ji,jj,16) = zw2d(ji,jj,16) + ( zphyzoo + zdetzoo - zzoodet - zzoobod - zzoonh4 - zzoodom ) * ze3t
-                  zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t
-                  !   
-                  zw3d(ji,jj,jk,1) = zno3phy * 86400._wp
-                  zw3d(ji,jj,jk,2) = znh4phy * 86400._wp
-                  zw3d(ji,jj,jk,3) = znh4no3 * 86400._wp
-                  !
-               ENDIF
-            END DO
-         END DO
+            ENDIF
+         END_2D
       END DO
       !
@@ -367,8 +364,8 @@
       ENDIF
 
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
          WRITE(charout, FMT="('bio')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
       ENDIF
       !
@@ -402,8 +399,6 @@
       IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~'
       !
-      REWIND( numnatp_ref )              ! Namelist namlobphy in reference namelist : Lobster biological parameters
       READ  ( numnatp_ref, namlobphy, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlobphy in reference namelist' )
-      REWIND( numnatp_cfg )              ! Namelist namlobphy in configuration namelist : Lobster biological parameters
       READ  ( numnatp_cfg, namlobphy, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlobphy in configuration namelist' )
@@ -419,8 +414,6 @@
       ENDIF
 
-      REWIND( numnatp_ref )              ! Namelist namlobnut in reference namelist : Lobster nutriments parameters
       READ  ( numnatp_ref, namlobnut, IOSTAT = ios, ERR = 903)
 903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlobnut in reference namelist' )
-      REWIND( numnatp_cfg )              ! Namelist namlobnut in configuration namelist : Lobster nutriments parameters
       READ  ( numnatp_cfg, namlobnut, IOSTAT = ios, ERR = 904 )
 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlobnut in configuration namelist' )
@@ -436,8 +429,6 @@
       ENDIF
 
-      REWIND( numnatp_ref )              ! Namelist namlobzoo in reference namelist : Lobster zooplankton parameters
       READ  ( numnatp_ref, namlobzoo, IOSTAT = ios, ERR = 905)
 905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlobzoo in reference namelist' )
-      REWIND( numnatp_cfg )              ! Namelist namlobzoo in configuration namelist : Lobster zooplankton parameters
       READ  ( numnatp_cfg, namlobzoo, IOSTAT = ios, ERR = 906 )
 906   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlobzoo in configuration namelist' )
@@ -458,8 +449,6 @@
       ENDIF
 
-      REWIND( numnatp_ref )              ! Namelist namlobdet in reference namelist : Lobster detritus parameters
       READ  ( numnatp_ref, namlobdet, IOSTAT = ios, ERR = 907)
 907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlobdet in reference namelist' )
-      REWIND( numnatp_cfg )              ! Namelist namlobdet in configuration namelist : Lobster detritus parameters
       READ  ( numnatp_cfg, namlobdet, IOSTAT = ios, ERR = 908 )
 908   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlobdet in configuration namelist' )
@@ -473,8 +462,6 @@
       ENDIF
 
-      REWIND( numnatp_ref )              ! Namelist namlobdom in reference namelist : Lobster DOM breakdown rate
       READ  ( numnatp_ref, namlobdom, IOSTAT = ios, ERR = 909)
 909   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlobdom in reference namelist' )
-      REWIND( numnatp_cfg )              ! Namelist namlobdom in configuration namelist : Lobster DOM breakdown rate
       READ  ( numnatp_cfg, namlobdom, IOSTAT = ios, ERR = 910 )
 910   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlobdom in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P2Z/p2zexp.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P2Z/p2zexp.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P2Z/p2zexp.F90	(revision 12928)
@@ -38,5 +38,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -46,5 +46,5 @@
 CONTAINS
 
-   SUBROUTINE p2z_exp( kt )
+   SUBROUTINE p2z_exp( kt, Kmm, Krhs )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p2z_exp  ***
@@ -60,5 +60,6 @@
       !!---------------------------------------------------------------------
       !!
-      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
+      INTEGER, INTENT( in ) ::   kt             ! ocean time-step index      
+      INTEGER, INTENT( in ) ::   Kmm, Krhs      ! time level indices
       !!
       INTEGER  ::   ji, jj, jk, jl, ikt
@@ -70,5 +71,5 @@
       IF( ln_timing )   CALL timing_start('p2z_exp')
       !
-      IF( kt == nittrc000 )   CALL p2z_exp_init
+      IF( kt == nittrc000 )   CALL p2z_exp_init( Kmm )
 
       zsedpoca(:,:) = 0.
@@ -80,12 +81,8 @@
       ! LAYERS IS DETERMINED BY DMIN3 DEFINED IN sms_p2z.F90
       ! ----------------------------------------------------------------------
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               ze3t = 1. / e3t_n(ji,jj,jk)
-               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + ze3t * dmin3(ji,jj,jk) * xksi(ji,jj)
-            END DO
-         END DO
-      END DO
+      DO_3D_00_00( 1, jpkm1 )
+         ze3t = 1. / e3t(ji,jj,jk,Kmm)
+         tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + ze3t * dmin3(ji,jj,jk) * xksi(ji,jj)
+      END_3D
 
       ! Find the last level of the water column
@@ -95,21 +92,17 @@
       zgeolpoc = 0.e0         !     Initialization
       ! Release of nutrients from the "simple" sediment
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1
-            ikt = mbkt(ji,jj) 
-            tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) + sedlam * sedpocn(ji,jj) / e3t_n(ji,jj,ikt) 
-            ! Deposition of organic matter in the sediment
-            zwork = vsed * trn(ji,jj,ikt,jpdet)
-            zsedpoca(ji,jj) = ( zwork + dminl(ji,jj) * xksi(ji,jj)   &
-               &           - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * rdt
-            zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1e2t(ji,jj)
-         END DO
-      END DO
-
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1
-            tra(ji,jj,1,jpno3) = tra(ji,jj,1,jpno3) + zgeolpoc * cmask(ji,jj) / areacot / e3t_n(ji,jj,1)
-         END DO
-      END DO
+      DO_2D_00_00
+         ikt = mbkt(ji,jj) 
+         tr(ji,jj,ikt,jpno3,Krhs) = tr(ji,jj,ikt,jpno3,Krhs) + sedlam * sedpocn(ji,jj) / e3t(ji,jj,ikt,Kmm) 
+         ! Deposition of organic matter in the sediment
+         zwork = vsed * tr(ji,jj,ikt,jpdet,Kmm)
+         zsedpoca(ji,jj) = ( zwork + dminl(ji,jj) * xksi(ji,jj)   &
+            &           - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * rn_Dt
+         zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1e2t(ji,jj)
+      END_2D
+
+      DO_2D_00_00
+         tr(ji,jj,1,jpno3,Krhs) = tr(ji,jj,1,jpno3,Krhs) + zgeolpoc * cmask(ji,jj) / areacot / e3t(ji,jj,1,Kmm)
+      END_2D
 
       CALL lbc_lnk( 'p2zexp', sedpocn, 'T', 1. )
@@ -121,17 +114,15 @@
       ! Time filter and swap of arrays
       ! ------------------------------
-      IF( neuler == 0 .AND. kt == nittrc000 ) THEN        ! Euler time-stepping at first time-step
-        !                                             ! (only swap)
+      IF( l_1st_euler ) THEN        ! Euler time-stepping at first time-step
+        !                           ! (only swap)
         sedpocn(:,:) = zsedpoca(:,:)
         !                                              
       ELSE
         !
-        DO jj = 1, jpj
-           DO ji = 1, jpi
-              zsedpocd = zsedpoca(ji,jj) - 2. * sedpocn(ji,jj) + sedpocb(ji,jj)      ! time laplacian on tracers
-              sedpocb(ji,jj) = sedpocn(ji,jj) + atfp * zsedpocd                     ! sedpocb <-- filtered sedpocn
-              sedpocn(ji,jj) = zsedpoca(ji,jj)                                       ! sedpocn <-- sedpoca
-           END DO
-        END DO
+        DO_2D_11_11
+           zsedpocd = zsedpoca(ji,jj) - 2. * sedpocn(ji,jj) + sedpocb(ji,jj)      ! time laplacian on tracers
+           sedpocb(ji,jj) = sedpocn(ji,jj) + rn_atfp * zsedpocd                     ! sedpocb <-- filtered sedpocn
+           sedpocn(ji,jj) = zsedpoca(ji,jj)                                       ! sedpocn <-- sedpoca
+        END_2D
         ! 
       ENDIF
@@ -146,8 +137,8 @@
       ENDIF
       !
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
          WRITE(charout, FMT="('exp')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
       ENDIF
       !
@@ -157,9 +148,10 @@
 
 
-   SUBROUTINE p2z_exp_init
+   SUBROUTINE p2z_exp_init( Kmm )
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE p4z_exp_init  ***
       !! ** purpose :   specific initialisation for export
       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in)  ::  Kmm      ! time level index
       INTEGER  ::   ji, jj, jk
       REAL(wp) ::   zmaskt, zfluo, zfluu
@@ -181,16 +173,12 @@
       zdm0 = 0._wp
       zrro = 1._wp
-      DO jk = jpkb, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zfluo = ( gdepw_n(ji,jj,jk  ) / gdepw_n(ji,jj,jpkb) )**xhr
-               zfluu = ( gdepw_n(ji,jj,jk+1) / gdepw_n(ji,jj,jpkb) )**xhr
-               IF( zfluo.GT.1. )   zfluo = 1._wp
-               zdm0(ji,jj,jk) = zfluo - zfluu
-               IF( jk <= jpkb-1 )   zdm0(ji,jj,jk) = 0._wp
-               zrro(ji,jj) = zrro(ji,jj) - zdm0(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( jpkb, jpkm1 )
+         zfluo = ( gdepw(ji,jj,jk  ,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr
+         zfluu = ( gdepw(ji,jj,jk+1,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr
+         IF( zfluo.GT.1. )   zfluo = 1._wp
+         zdm0(ji,jj,jk) = zfluo - zfluu
+         IF( jk <= jpkb-1 )   zdm0(ji,jj,jk) = 0._wp
+         zrro(ji,jj) = zrro(ji,jj) - zdm0(ji,jj,jk)
+      END_3D
       !
       zdm0(:,:,jpk) = zrro(:,:)
@@ -202,31 +190,23 @@
       dminl(:,:)   = 0._wp
       dmin3(:,:,:) = zdm0
-      DO jk = 1, jpk
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( tmask(ji,jj,jk) == 0._wp ) THEN
-                  dminl(ji,jj) = dminl(ji,jj) + dmin3(ji,jj,jk)
-                  dmin3(ji,jj,jk) = 0._wp
-               ENDIF
-            END DO
-         END DO
-      END DO
-
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF( tmask(ji,jj,1) == 0 )   dmin3(ji,jj,1) = 0._wp
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpk )
+         IF( tmask(ji,jj,jk) == 0._wp ) THEN
+            dminl(ji,jj) = dminl(ji,jj) + dmin3(ji,jj,jk)
+            dmin3(ji,jj,jk) = 0._wp
+         ENDIF
+      END_3D
+
+      DO_2D_11_11
+         IF( tmask(ji,jj,1) == 0 )   dmin3(ji,jj,1) = 0._wp
+      END_2D
 
       ! Coastal mask 
       cmask(:,:) = 0._wp
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1
-            IF( tmask(ji,jj,1) /= 0. ) THEN
-               zmaskt = tmask(ji+1,jj,1) * tmask(ji-1,jj,1) * tmask(ji,jj+1,1) * tmask(ji,jj-1,1) 
-               IF( zmaskt == 0. )   cmask(ji,jj) = 1._wp
-            END IF
-         END DO
-      END DO
+      DO_2D_00_00
+         IF( tmask(ji,jj,1) /= 0. ) THEN
+            zmaskt = tmask(ji+1,jj,1) * tmask(ji-1,jj,1) * tmask(ji,jj+1,1) * tmask(ji,jj-1,1) 
+            IF( zmaskt == 0. )   cmask(ji,jj) = 1._wp
+         END IF
+      END_2D
       CALL lbc_lnk( 'p2zexp', cmask , 'T', 1. )      ! lateral boundary conditions on cmask   (sign unchanged)
       areacot = glob_sum( 'p2zexp', e1e2t(:,:) * cmask(:,:) )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P2Z/p2zopt.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P2Z/p2zopt.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P2Z/p2zopt.F90	(revision 12928)
@@ -38,4 +38,6 @@
    REAL(wp), PUBLIC ::  reddom    ! redfield ratio (C:N) for DOM
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -45,5 +47,5 @@
 CONTAINS
 
-   SUBROUTINE p2z_opt( kt )
+   SUBROUTINE p2z_opt( kt, Kmm )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p2z_opt  ***
@@ -61,4 +63,5 @@
       !!
       INTEGER, INTENT( in ) ::   kt   ! index of the time stepping
+      INTEGER, INTENT( in ) ::   Kmm  ! time level index
       !!
       INTEGER  ::   ji, jj, jk          ! dummy loop indices
@@ -91,50 +94,36 @@
       !                                          ! Photosynthetically Available Radiation (PAR)
       zcoef = 12 * redf / rcchl / rpig           ! --------------------------------------
-      DO jk = 2, jpk                                  ! local par at w-levels
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zpig = LOG(  MAX( TINY(0.), trn(ji,jj,jk-1,jpphy) ) * zcoef  )
-               zkr  = xkr0 + xkrp * EXP( xlr * zpig )
-               zkg  = xkg0 + xkgp * EXP( xlg * zpig )
-               zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * e3t_n(ji,jj,jk-1) )
-               zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * e3t_n(ji,jj,jk-1) )
-            END DO
-        END DO
-      END DO
-      DO jk = 1, jpkm1                                ! mean par at t-levels
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zpig = LOG(  MAX( TINY(0.), trn(ji,jj,jk,jpphy) ) * zcoef  )
-               zkr  = xkr0 + xkrp * EXP( xlr * zpig )
-               zkg  = xkg0 + xkgp * EXP( xlg * zpig )
-               zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * e3t_n(ji,jj,jk) ) * ( 1 - EXP( -zkr * e3t_n(ji,jj,jk) ) )
-               zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * e3t_n(ji,jj,jk) ) * ( 1 - EXP( -zkg * e3t_n(ji,jj,jk) ) )
-               etot (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 )
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 2, jpk )
+         zpig = LOG(  MAX( TINY(0.), tr(ji,jj,jk-1,jpphy,Kmm) ) * zcoef  )
+         zkr  = xkr0 + xkrp * EXP( xlr * zpig )
+         zkg  = xkg0 + xkgp * EXP( xlg * zpig )
+         zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * e3t(ji,jj,jk-1,Kmm) )
+         zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * e3t(ji,jj,jk-1,Kmm) )
+      END_3D
+      DO_3D_11_11( 1, jpkm1 )
+         zpig = LOG(  MAX( TINY(0.), tr(ji,jj,jk,jpphy,Kmm) ) * zcoef  )
+         zkr  = xkr0 + xkrp * EXP( xlr * zpig )
+         zkg  = xkg0 + xkgp * EXP( xlg * zpig )
+         zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * e3t(ji,jj,jk,Kmm) ) * ( 1 - EXP( -zkr * e3t(ji,jj,jk,Kmm) ) )
+         zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * e3t(ji,jj,jk,Kmm) ) * ( 1 - EXP( -zkg * e3t(ji,jj,jk,Kmm) ) )
+         etot (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 )
+      END_3D
 
       !                                          ! Euphotic layer
       !                                          ! --------------
       neln(:,:) = 1                                   ! euphotic layer level
-      DO jk = 1, jpkm1                                ! (i.e. 1rst T-level strictly below EL bottom)
-         DO jj = 1, jpj
-           DO ji = 1, jpi
-              IF( etot(ji,jj,jk) >= zpar100(ji,jj) )   neln(ji,jj) = jk + 1 
-           END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpkm1 )
+        IF( etot(ji,jj,jk) >= zpar100(ji,jj) )   neln(ji,jj) = jk + 1 
+      END_3D
       !                                               ! Euphotic layer depth
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            heup(ji,jj) = gdepw_n(ji,jj,neln(ji,jj))
-         END DO
-      END DO 
+      DO_2D_11_11
+         heup(ji,jj) = gdepw(ji,jj,neln(ji,jj),Kmm)
+      END_2D
 
 
-      IF(ln_ctl) THEN      ! print mean trends (used for debugging)
+      IF(sn_cfctl%l_prttrc) THEN      ! print mean trends (used for debugging)
          WRITE(charout, FMT="('opt')")
          CALL prt_ctl_trc_info( charout )
-         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )
+         CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm )
       ENDIF
       !
@@ -159,9 +148,7 @@
       !!----------------------------------------------------------------------
 
-      REWIND( numnatp_ref )              ! Namelist namlobopt in reference namelist : Lobster options
       READ  ( numnatp_ref, namlobopt, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobopt in reference namelist' )
 
-      REWIND( numnatp_cfg )              ! Namelist namlobopt in configuration namelist : Lobster options
       READ  ( numnatp_cfg, namlobopt, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namlobopt in configuration namelist' )
@@ -181,9 +168,7 @@
       ENDIF
       !
-      REWIND( numnatp_ref )              ! Namelist namlobrat in reference namelist : Lobster ratios
       READ  ( numnatp_ref, namlobrat, IOSTAT = ios, ERR = 903)
 903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobrat in reference namelist' )
 
-      REWIND( numnatp_cfg )              ! Namelist namlobrat in configuration namelist : Lobster ratios
       READ  ( numnatp_cfg, namlobrat, IOSTAT = ios, ERR = 904 )
 904   IF( ios >  0 ) CALL ctl_nam ( ios , 'namlobrat in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P2Z/p2zsed.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P2Z/p2zsed.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P2Z/p2zsed.F90	(revision 12928)
@@ -31,4 +31,6 @@
    REAL(wp), PUBLIC ::   xhr         !: coeff for martin''s remineralisation profile
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -38,5 +40,5 @@
 CONTAINS
 
-   SUBROUTINE p2z_sed( kt )
+   SUBROUTINE p2z_sed( kt, Kmm, Krhs )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p2z_sed  ***
@@ -49,12 +51,13 @@
       !!              using an upstream scheme
       !!              the now vertical advection of tracers is given by:
-      !!                      dz(trn wn) = 1/bt dk+1( e1t e2t vsed (trn) )
-      !!              add this trend now to the general trend of tracer (ta,sa,tra):
-      !!                             tra = tra + dz(trn wn)
+      !!                      dz(tr(:,:,:,:,Kmm) ww) = 1/bt dk+1( e1t e2t vsed (tr(:,:,:,:,Kmm)) )
+      !!              add this trend now to the general trend of tracer (ta,sa,tr(:,:,:,:,Krhs)):
+      !!                             tr(:,:,:,:,Krhs) = tr(:,:,:,:,Krhs) + dz(tr(:,:,:,:,Kmm) ww)
       !!        
       !!              IF 'key_diabio' is defined, the now vertical advection
       !!              trend of passive tracers is saved for futher diagnostics.
       !!---------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index      
+      INTEGER, INTENT( in ) ::   Kmm, Krhs  ! time level indices
       !
       INTEGER  ::   ji, jj, jk, jl, ierr
@@ -81,23 +84,19 @@
       ! tracer flux at w-point: we use -vsed (downward flux)  with simplification : no e1*e2
       DO jk = 2, jpkm1
-         zwork(:,:,jk) = -vsed * trn(:,:,jk-1,jpdet)
+         zwork(:,:,jk) = -vsed * tr(:,:,jk-1,jpdet,Kmm)
       END DO
 
       ! tracer flux divergence at t-point added to the general trend
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ztra(ji,jj,jk)  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / e3t_n(ji,jj,jk)
-               tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + ztra(ji,jj,jk) 
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpkm1 )
+         ztra(ji,jj,jk)  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm)
+         tr(ji,jj,jk,jpdet,Krhs) = tr(ji,jj,jk,jpdet,Krhs) + ztra(ji,jj,jk) 
+      END_3D
 
       IF( lk_iomput )  THEN
          IF( iom_use( "TDETSED" ) ) THEN
             ALLOCATE( zw2d(jpi,jpj) )
-            zw2d(:,:) =  ztra(:,:,1) * e3t_n(:,:,1) * 86400._wp
+            zw2d(:,:) =  ztra(:,:,1) * e3t(:,:,1,Kmm) * 86400._wp
             DO jk = 2, jpkm1
-               zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t_n(:,:,jk) * 86400._wp
+               zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t(:,:,jk,Kmm) * 86400._wp
             END DO
             CALL iom_put( "TDETSED", zw2d )
@@ -107,8 +106,8 @@
       !
 
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
          WRITE(charout, FMT="('sed')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
       ENDIF
       !
@@ -132,8 +131,6 @@
       !!----------------------------------------------------------------------
       !
-      REWIND( numnatp_ref )              ! Namelist namlobsed in reference namelist : Lobster sediments
       READ  ( numnatp_ref, namlobsed, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlosed in reference namelist' )
-      REWIND( numnatp_cfg )              ! Namelist namlobsed in configuration namelist : Lobster sediments
       READ  ( numnatp_cfg, namlobsed, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlobsed in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P2Z/p2zsms.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P2Z/p2zsms.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P2Z/p2zsms.F90	(revision 12928)
@@ -35,5 +35,5 @@
 CONTAINS
 
-   SUBROUTINE p2z_sms( kt )
+   SUBROUTINE p2z_sms( kt, Kmm, Krhs )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p2z_sms  ***
@@ -44,5 +44,6 @@
       !! ** Method  : - ???
       !! --------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
+      INTEGER, INTENT( in ) ::   kt            ! ocean time-step index      
+      INTEGER, INTENT( in ) ::   Kmm, Krhs     ! ocean time level index      
       !
       INTEGER ::   jn   ! dummy loop index
@@ -51,12 +52,12 @@
       IF( ln_timing )   CALL timing_start('p2z_sms')
       !
-      CALL p2z_opt( kt )      ! optical model
-      CALL p2z_bio( kt )      ! biological model
-      CALL p2z_sed( kt )      ! sedimentation model
-      CALL p2z_exp( kt )      ! export
+      CALL p2z_opt( kt, Kmm       )      ! optical model
+      CALL p2z_bio( kt, Kmm, Krhs )      ! biological model
+      CALL p2z_sed( kt, Kmm, Krhs )      ! sedimentation model
+      CALL p2z_exp( kt, Kmm, Krhs )      ! export
       !
       IF( l_trdtrc ) THEN
          DO jn = jp_pcs0, jp_pcs1
-           CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt )   ! save trends
+           CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm )   ! save trends
          END DO
       END IF
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zagg.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zagg.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zagg.F90	(revision 12928)
@@ -24,4 +24,6 @@
    PUBLIC   p4z_agg         ! called in p4zbio.F90
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -31,5 +33,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_agg ( kt, knt )
+   SUBROUTINE p4z_agg ( kt, knt, Kbb, Krhs )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_agg  ***
@@ -40,4 +42,5 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt, knt   !
+      INTEGER, INTENT(in) ::   Kbb, Krhs ! time level indices
       !
       INTEGER  ::   ji, jj, jk
@@ -57,124 +60,116 @@
       IF( ln_p4z ) THEN
          !
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  !
-                  zfact = xstep * xdiss(ji,jj,jk)
-                  !  Part I : Coagulation dependent on turbulence
-                  zagg1 = 25.9  * zfact * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jppoc)
-                  zagg2 = 4452. * zfact * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpgoc)
+         DO_3D_11_11( 1, jpkm1 )
+            !
+            zfact = xstep * xdiss(ji,jj,jk)
+            !  Part I : Coagulation dependent on turbulence
+            zagg1 = 25.9  * zfact * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jppoc,Kbb)
+            zagg2 = 4452. * zfact * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jpgoc,Kbb)
 
-                  ! Part II : Differential settling
+            ! Part II : Differential settling
 
-                  !  Aggregation of small into large particles
-                  zagg3 =  47.1 * xstep * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpgoc)
-                  zagg4 =  3.3  * xstep * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jppoc)
+            !  Aggregation of small into large particles
+            zagg3 =  47.1 * xstep * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jpgoc,Kbb)
+            zagg4 =  3.3  * xstep * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jppoc,Kbb)
 
-                  zagg   = zagg1 + zagg2 + zagg3 + zagg4
-                  zaggfe = zagg * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn )
+            zagg   = zagg1 + zagg2 + zagg3 + zagg4
+            zaggfe = zagg * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn )
 
-                  ! Aggregation of DOC to POC : 
-                  ! 1st term is shear aggregation of DOC-DOC
-                  ! 2nd term is shear aggregation of DOC-POC
-                  ! 3rd term is differential settling of DOC-POC
-                  zaggdoc  = ( ( 0.369 * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * zfact       &
-                  &            + 2.4 * xstep * trb(ji,jj,jk,jppoc) ) * 0.3 * trb(ji,jj,jk,jpdoc)
-                  ! transfer of DOC to GOC : 
-                  ! 1st term is shear aggregation
-                  ! 2nd term is differential settling 
-                  zaggdoc2 = ( 3.53E3 * zfact + 0.1 * xstep ) * trb(ji,jj,jk,jpgoc) * 0.3 * trb(ji,jj,jk,jpdoc)
-                  ! tranfer of DOC to POC due to brownian motion
-                  zaggdoc3 =  114. * 0.3 * trb(ji,jj,jk,jpdoc) *xstep * 0.3 * trb(ji,jj,jk,jpdoc)
+            ! Aggregation of DOC to POC : 
+            ! 1st term is shear aggregation of DOC-DOC
+            ! 2nd term is shear aggregation of DOC-POC
+            ! 3rd term is differential settling of DOC-POC
+            zaggdoc  = ( ( 0.369 * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4 * tr(ji,jj,jk,jppoc,Kbb) ) * zfact       &
+            &            + 2.4 * xstep * tr(ji,jj,jk,jppoc,Kbb) ) * 0.3 * tr(ji,jj,jk,jpdoc,Kbb)
+            ! transfer of DOC to GOC : 
+            ! 1st term is shear aggregation
+            ! 2nd term is differential settling 
+            zaggdoc2 = ( 3.53E3 * zfact + 0.1 * xstep ) * tr(ji,jj,jk,jpgoc,Kbb) * 0.3 * tr(ji,jj,jk,jpdoc,Kbb)
+            ! tranfer of DOC to POC due to brownian motion
+            zaggdoc3 =  114. * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) *xstep * 0.3 * tr(ji,jj,jk,jpdoc,Kbb)
 
-                  !  Update the trends
-                  tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zagg + zaggdoc + zaggdoc3
-                  tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zagg + zaggdoc2
-                  tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zaggfe
-                  tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zaggfe
-                  tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc2 - zaggdoc3
-                  !
-                  conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zagg + zaggdoc + zaggdoc3
-                  prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zagg + zaggdoc2
-                  !
-               END DO
-            END DO
-         END DO
+            !  Update the trends
+            tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zagg + zaggdoc + zaggdoc3
+            tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zagg + zaggdoc2
+            tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zaggfe
+            tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zaggfe
+            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zaggdoc - zaggdoc2 - zaggdoc3
+            !
+            conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zagg + zaggdoc + zaggdoc3
+            prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zagg + zaggdoc2
+            !
+         END_3D
       ELSE    ! ln_p5z
         !
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  !
-                  zfact = xstep * xdiss(ji,jj,jk)
-                  !  Part I : Coagulation dependent on turbulence
-                  zaggtmp = 25.9  * zfact * trb(ji,jj,jk,jppoc)
-                  zaggpoc1 = zaggtmp * trb(ji,jj,jk,jppoc)
-                  zaggtmp = 4452. * zfact * trb(ji,jj,jk,jpgoc)
-                  zaggpoc2 = zaggtmp * trb(ji,jj,jk,jppoc)
+         DO_3D_11_11( 1, jpkm1 )
+            !
+            zfact = xstep * xdiss(ji,jj,jk)
+            !  Part I : Coagulation dependent on turbulence
+            zaggtmp = 25.9  * zfact * tr(ji,jj,jk,jppoc,Kbb)
+            zaggpoc1 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb)
+            zaggtmp = 4452. * zfact * tr(ji,jj,jk,jpgoc,Kbb)
+            zaggpoc2 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb)
 
-                  ! Part II : Differential settling
-   
-                  !  Aggregation of small into large particles
-                  zaggtmp =  47.1 * xstep * trb(ji,jj,jk,jpgoc)
-                  zaggpoc3 = zaggtmp * trb(ji,jj,jk,jppoc)
-                  zaggtmp =  3.3  * xstep * trb(ji,jj,jk,jppoc)
-                  zaggpoc4 = zaggtmp * trb(ji,jj,jk,jppoc)
+            ! Part II : Differential settling
 
-                  zaggpoc   = zaggpoc1 + zaggpoc2 + zaggpoc3 + zaggpoc4
-                  zaggpon = zaggpoc * trb(ji,jj,jk,jppon) / ( trb(ji,jj,jk,jppoc) + rtrn)
-                  zaggpop = zaggpoc * trb(ji,jj,jk,jppop) / ( trb(ji,jj,jk,jppoc) + rtrn)
-                  zaggfe = zaggpoc * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc)  + rtrn )
+            !  Aggregation of small into large particles
+            zaggtmp =  47.1 * xstep * tr(ji,jj,jk,jpgoc,Kbb)
+            zaggpoc3 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb)
+            zaggtmp =  3.3  * xstep * tr(ji,jj,jk,jppoc,Kbb)
+            zaggpoc4 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb)
 
-                  ! Aggregation of DOC to POC : 
-                  ! 1st term is shear aggregation of DOC-DOC
-                  ! 2nd term is shear aggregation of DOC-POC
-                  ! 3rd term is differential settling of DOC-POC
-                  zaggtmp = ( ( 0.369 * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * zfact       &
-                  &            + 2.4 * xstep * trb(ji,jj,jk,jppoc) )
-                  zaggdoc  = zaggtmp * 0.3 * trb(ji,jj,jk,jpdoc)
-                  zaggdon  = zaggtmp * 0.3 * trb(ji,jj,jk,jpdon)
-                  zaggdop  = zaggtmp * 0.3 * trb(ji,jj,jk,jpdop)
+            zaggpoc   = zaggpoc1 + zaggpoc2 + zaggpoc3 + zaggpoc4
+            zaggpon = zaggpoc * tr(ji,jj,jk,jppon,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn)
+            zaggpop = zaggpoc * tr(ji,jj,jk,jppop,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn)
+            zaggfe = zaggpoc * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb)  + rtrn )
 
-                  ! transfer of DOC to GOC : 
-                  ! 1st term is shear aggregation
-                  ! 2nd term is differential settling 
-                  zaggtmp = ( 3.53E3 * zfact + 0.1 * xstep ) * trb(ji,jj,jk,jpgoc)
-                  zaggdoc2 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdoc)
-                  zaggdon2 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdon)
-                  zaggdop2 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdop)
+            ! Aggregation of DOC to POC : 
+            ! 1st term is shear aggregation of DOC-DOC
+            ! 2nd term is shear aggregation of DOC-POC
+            ! 3rd term is differential settling of DOC-POC
+            zaggtmp = ( ( 0.369 * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4 * tr(ji,jj,jk,jppoc,Kbb) ) * zfact       &
+            &            + 2.4 * xstep * tr(ji,jj,jk,jppoc,Kbb) )
+            zaggdoc  = zaggtmp * 0.3 * tr(ji,jj,jk,jpdoc,Kbb)
+            zaggdon  = zaggtmp * 0.3 * tr(ji,jj,jk,jpdon,Kbb)
+            zaggdop  = zaggtmp * 0.3 * tr(ji,jj,jk,jpdop,Kbb)
 
-                  ! tranfer of DOC to POC due to brownian motion
-                  zaggtmp = ( 114. * 0.3 * trb(ji,jj,jk,jpdoc) ) * xstep
-                  zaggdoc3 =  zaggtmp * 0.3 * trb(ji,jj,jk,jpdoc)
-                  zaggdon3 =  zaggtmp * 0.3 * trb(ji,jj,jk,jpdon)
-                  zaggdop3 =  zaggtmp * 0.3 * trb(ji,jj,jk,jpdop)
+            ! transfer of DOC to GOC : 
+            ! 1st term is shear aggregation
+            ! 2nd term is differential settling 
+            zaggtmp = ( 3.53E3 * zfact + 0.1 * xstep ) * tr(ji,jj,jk,jpgoc,Kbb)
+            zaggdoc2 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdoc,Kbb)
+            zaggdon2 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdon,Kbb)
+            zaggdop2 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdop,Kbb)
 
-                  !  Update the trends
-                  tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zaggpoc + zaggdoc + zaggdoc3
-                  tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) - zaggpon + zaggdon + zaggdon3
-                  tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) - zaggpop + zaggdop + zaggdop3
-                  tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zaggpoc + zaggdoc2
-                  tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) + zaggpon + zaggdon2
-                  tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) + zaggpop + zaggdop2
-                  tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zaggfe
-                  tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zaggfe
-                  tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc2 - zaggdoc3
-                  tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) - zaggdon - zaggdon2 - zaggdon3
-                  tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) - zaggdop - zaggdop2 - zaggdop3
-                  !
-                  conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zaggpoc + zaggdoc + zaggdoc3
-                  prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zaggpoc + zaggdoc2
-                  !
-               END DO
-            END DO
-         END DO
+            ! tranfer of DOC to POC due to brownian motion
+            zaggtmp = ( 114. * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) ) * xstep
+            zaggdoc3 =  zaggtmp * 0.3 * tr(ji,jj,jk,jpdoc,Kbb)
+            zaggdon3 =  zaggtmp * 0.3 * tr(ji,jj,jk,jpdon,Kbb)
+            zaggdop3 =  zaggtmp * 0.3 * tr(ji,jj,jk,jpdop,Kbb)
+
+            !  Update the trends
+            tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zaggpoc + zaggdoc + zaggdoc3
+            tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) - zaggpon + zaggdon + zaggdon3
+            tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) - zaggpop + zaggdop + zaggdop3
+            tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zaggpoc + zaggdoc2
+            tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) + zaggpon + zaggdon2
+            tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) + zaggpop + zaggdop2
+            tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zaggfe
+            tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zaggfe
+            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zaggdoc - zaggdoc2 - zaggdoc3
+            tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) - zaggdon - zaggdon2 - zaggdon3
+            tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) - zaggdop - zaggdop2 - zaggdop3
+            !
+            conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zaggpoc + zaggdoc + zaggdoc3
+            prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zaggpoc + zaggdoc2
+            !
+         END_3D
          !
       ENDIF
       !
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
          WRITE(charout, FMT="('agg')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
       ENDIF
       !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zbc.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zbc.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zbc.F90	(revision 12928)
@@ -0,0 +1,349 @@
+MODULE p4zbc
+   !!======================================================================
+   !!                         ***  MODULE p4sbc  ***
+   !! TOP :   PISCES surface boundary conditions of external inputs of nutrients
+   !!======================================================================
+   !! History :   3.5  !  2012-07 (O. Aumont, C. Ethe) Original code
+   !!----------------------------------------------------------------------
+   !!   p4z_bc        :  Read and interpolate time-varying nutrients fluxes
+   !!   p4z_bc_init   :  Initialization of p4z_bc
+   !!----------------------------------------------------------------------
+   USE oce_trc         !  shared variables between ocean and passive tracers
+   USE trc             !  passive tracers common variables 
+   USE sms_pisces      !  PISCES Source Minus Sink variables
+   USE iom             !  I/O manager
+   USE fldread         !  time interpolation
+   USE trcbc
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p4z_bc
+   PUBLIC   p4z_bc_init   
+
+   LOGICAL , PUBLIC ::   ln_ironsed   !: boolean for Fe input from sediments
+   LOGICAL , PUBLIC ::   ln_hydrofe   !: boolean for Fe input from hydrothermal vents
+   REAL(wp), PUBLIC ::   sedfeinput   !: Coastal release of Iron
+   REAL(wp), PUBLIC ::   icefeinput   !: Iron concentration in sea ice
+   REAL(wp), PUBLIC ::   wdust        !: Sinking speed of the dust 
+   REAL(wp), PUBLIC ::   mfrac        !: Mineral Content of the dust
+   REAL(wp)         ::   hratio       !: Fe:3He ratio assumed for vent iron supply
+   REAL(wp)         ::   distcoast    !: Distance off the coast for Iron from sediments
+   REAL(wp), PUBLIC ::   lgw_rath     !: Weak ligand ratio from hydro sources
+
+   LOGICAL , PUBLIC ::   ll_bc
+   LOGICAL , PUBLIC ::   ll_dust      !: boolean for dust input from the atmosphere
+   LOGICAL , PUBLIC ::   ll_river     !: boolean for river input of nutrients
+   LOGICAL , PUBLIC ::   ll_ndepo     !: boolean for atmospheric deposition of N
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_dust      ! structure of input dust
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_ironsed   ! structure of input iron from sediment
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_hydrofe   ! structure of input iron from sediment
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dust    !: dust fields
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ironsed          !: Coastal supply of iron
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hydrofe          !: Hydrothermal vent supply of iron
+
+   REAL(wp), PUBLIC :: sedsilfrac, sedcalfrac
+
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
+   !! $Id: p4zbc.F90 10869 2019-04-15 10:34:03Z cetlod $ 
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE p4z_bc( kt, Kbb, Kmm, Krhs )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine p4z_bc  ***
+      !!
+      !! ** purpose :   read and interpolate the external sources of nutrients
+      !!
+      !! ** method  :   read the files and interpolate the appropriate variables
+      !!
+      !! ** input   :   external netcdf files
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt              ! ocean time step
+      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level index
+      !
+      INTEGER  ::  ji, jj, jk, jl 
+      REAL(wp) ::  zcoef, zyyss
+      REAL(wp) ::  zdep, ztrfer, zwdust, zwflux, zrivdin
+      !
+      CHARACTER (len=25) :: charout
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zirondep
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:  ) :: zironice, zndep
+      !!---------------------------------------------------------------------
+      !
+      IF( ln_timing )   CALL timing_start('p4z_bc')
+      !
+      IF( ll_dust )  THEN
+         ALLOCATE(  zirondep(jpi,jpj,jpk) )
+         !
+         CALL fld_read( kt, 1, sf_dust )
+         dust(:,:) = MAX( rtrn, sf_dust(1)%fnow(:,:,1) )
+         !
+         jl = n_trc_indsbc(jpfer)
+         zirondep(:,:,1) = rf_trsfac(jl) * sf_trcsbc(jl)%fnow(:,:,1) / e3t(:,:,1,Kmm) / rn_sbc_time
+         !                                              ! Iron solubilization of particles in the water column
+         !                                              ! dust in kg/m2/s ---> 1/55.85 to put in mol/Fe ;  wdust in m/j
+         zwdust = 0.03 / ( wdust / rday ) / ( 270. * rday )
+         DO jk = 2, jpkm1
+            zirondep(:,:,jk) = ( mfrac * dust(:,:) * zwdust / mMass_Fe ) * rfact * EXP( -gdept(:,:,jk,Kmm) / 540. )
+            tr(:,:,jk,jpfer,Krhs) = tr(:,:,jk,jpfer,Krhs) + zirondep(:,:,jk)
+            tr(:,:,jk,jppo4,Krhs) = tr(:,:,jk,jppo4,Krhs) + zirondep(:,:,jk) * 0.023
+         ENDDO
+         !
+         IF( lk_iomput ) THEN
+             CALL iom_put( "Irondep", zirondep(:,:,1) * 1.e+3 * rfactr * e3t(:,:,1,Kmm) * tmask(:,:,1) ) ! surface downward dust depo of iron
+             CALL iom_put( "pdust"  , dust(:,:) / ( wdust * rday ) * tmask(:,:,1) ) ! dust concentration at surface
+         ENDIF
+         DEALLOCATE( zirondep )
+      ENDIF
+
+      ! N/P and Si releases due to coastal rivers
+      ! Compute river at nit000 or only if there is more than 1 time record in river file
+      ! -----------------------------------------
+            ! Add the external input of nutrients from river
+      ! ----------------------------------------------------------
+      IF( ll_river ) THEN
+          jl = n_trc_indcbc(jpno3)
+          DO_2D_11_11
+             DO jk = 1, nk_rnf(ji,jj)
+                zcoef = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_cbc_time ) * tmask(ji,jj,1)
+                zrivdin = rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zcoef
+                tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - rno3 * zrivdin * rfact
+            ENDDO
+          END_2D
+      ENDIF
+      
+      ! Add the external input of nutrients from nitrogen deposition
+      ! ----------------------------------------------------------
+      IF( ll_ndepo ) THEN
+         ALLOCATE( zndep(jpi,jpj) )
+         IF( ln_trc_sbc(jpno3) ) THEN
+            jl = n_trc_indsbc(jpno3)
+            zndep(:,:) = rf_trsfac(jl) * sf_trcsbc(jl)%fnow(:,:,1) / e3t(:,:,1,Kmm) / rn_sbc_time
+            tr(:,:,1,jptal,Krhs) = tr(:,:,1,jptal,Krhs) - rno3 * zndep(:,:) * rfact
+         ENDIF
+         IF( ln_trc_sbc(jpnh4) ) THEN
+            jl = n_trc_indsbc(jpnh4)
+            zndep(:,:) = rf_trsfac(jl) * sf_trcsbc(jl)%fnow(:,:,1) / e3t(:,:,1,Kmm) / rn_sbc_time
+            tr(:,:,1,jptal,Krhs) = tr(:,:,1,jptal,Krhs) - rno3 * zndep(:,:) * rfact
+         ENDIF
+         DEALLOCATE( zndep )
+      ENDIF
+      !
+      ! Iron input/uptake due to sea ice : Crude parameterization based on
+      ! Lancelot et al.
+      ! ----------------------------------------------------
+      IF( ln_ironice ) THEN
+         !
+         ALLOCATE( zironice(jpi,jpj) )
+         !
+         DO_2D_11_11
+            zdep    = rfact / e3t(ji,jj,1,Kmm)
+            zwflux  = fmmflx(ji,jj) / 1000._wp
+            zironice(ji,jj) =  MAX( -0.99 * tr(ji,jj,1,jpfer,Kbb), -zwflux * icefeinput * zdep )
+         END_2D
+         !
+         tr(:,:,1,jpfer,Krhs) = tr(:,:,1,jpfer,Krhs) + zironice(:,:)
+         !
+         IF( lk_iomput )  CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfactr * e3t(:,:,1,Kmm) * tmask(:,:,1) ) ! iron flux from ice
+         !
+         DEALLOCATE( zironice )
+         !
+      ENDIF
+
+      ! Add the external input of iron from sediment mobilization
+      ! ------------------------------------------------------
+      IF( ln_ironsed .AND. .NOT.lk_sed ) THEN
+          tr(:,:,:,jpfer,Krhs) = tr(:,:,:,jpfer,Krhs) + ironsed(:,:,:) * rfact
+          !
+          IF( lk_iomput )  CALL iom_put( "Ironsed", ironsed(:,:,:) * 1.e+3 * tmask(:,:,:) ) 
+      ENDIF
+
+      ! Add the external input of iron from hydrothermal vents
+      ! ------------------------------------------------------
+      IF( ln_hydrofe ) THEN
+         CALL fld_read( kt, 1, sf_hydrofe )
+         DO jk = 1, jpk
+            hydrofe(:,:,jk) = ( MAX( rtrn, sf_hydrofe(1)%fnow(:,:,jk) ) * hratio ) &
+              &              / ( e1e2t(:,:) * e3t(:,:,jk,Kmm) * ryyss + rtrn ) / 1000._wp &
+              &              * tmask(:,:,jk)
+         ENDDO
+                         tr(:,:,:,jpfer,Krhs) = tr(:,:,:,jpfer,Krhs) + hydrofe(:,:,:) * rfact
+         IF( ln_ligand ) tr(:,:,:,jplgw,Krhs) = tr(:,:,:,jplgw,Krhs) + ( hydrofe(:,:,:) * lgw_rath ) * rfact
+         !
+         IF( lk_iomput ) CALL iom_put( "HYDR", hydrofe(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! hydrothermal iron input
+      ENDIF
+      IF( ln_timing )  CALL timing_stop('p4z_bc')
+      !
+   END SUBROUTINE p4z_bc
+
+
+   SUBROUTINE p4z_bc_init( Kmm ) 
+      !!----------------------------------------------------------------------
+      !!                  ***  routine p4z_bc_init  ***
+      !!
+      !! ** purpose :   initialization of the external sources of nutrients
+      !!
+      !! ** method  :   read the files and compute the budget
+      !!                called at the first timestep (nittrc000)
+      !!
+      !! ** input   :   external netcdf files
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   Kmm  ! time level index
+      INTEGER  :: ji, jj, jk, jm
+      INTEGER  :: ii0, ii1, ij0, ij1
+      INTEGER  :: numiron
+      INTEGER  :: ierr, ierr1, ierr2, ierr3
+      INTEGER  :: ios                 ! Local integer output status for namelist read
+      INTEGER  :: ik50                !  last level where depth less than 50 m
+      REAL(wp) :: zexpide, zdenitide, zmaskt, zsurfc, zsurfp,ze3t, ze3t2, zcslp
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zriver, zcmask
+      !
+      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files
+      TYPE(FLD_N) ::   sn_dust, sn_ironsed, sn_hydrofe   ! informations about the fields to be read
+      !!
+      NAMELIST/nampisbc/cn_dir, sn_dust, sn_ironsed, sn_hydrofe, &
+        &                ln_ironsed, ln_ironice, ln_hydrofe,    &
+        &                sedfeinput, distcoast, icefeinput, wdust, mfrac,  &
+        &                hratio, lgw_rath
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'p4z_bc_init : initialization of the external sources of nutrients '
+         WRITE(numout,*) '~~~~~~~~~~~~ '
+      ENDIF
+      !                            !* set file information
+      READ  ( numnatp_ref, nampisbc, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisbc in reference namelist' )
+      READ  ( numnatp_cfg, nampisbc, IOSTAT = ios, ERR = 902 )
+902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisbc in configuration namelist' )
+      IF(lwm) WRITE ( numonp, nampisbc )
+
+
+      IF(lwp) THEN
+         WRITE(numout,*) '   Namelist : nampissbc '
+         WRITE(numout,*) '      Fe input from sediments                  ln_ironsed  = ', ln_ironsed
+         WRITE(numout,*) '      Fe input from seaice                     ln_ironice  = ', ln_ironice
+         WRITE(numout,*) '      fe input from hydrothermal vents         ln_hydrofe  = ', ln_hydrofe
+         IF( ln_ironsed ) THEN
+            WRITE(numout,*) '      coastal release of iron                  sedfeinput  = ', sedfeinput
+            WRITE(numout,*) '      distance off the coast                   distcoast   = ', distcoast
+         ENDIF
+         IF( ln_ligand ) THEN
+            WRITE(numout,*) '      Weak ligand ratio from sed hydro sources  lgw_rath   = ', lgw_rath
+         ENDIF
+         IF( ln_ironice ) THEN
+            WRITE(numout,*) '      Iron concentration in sea ice            icefeinput  = ', icefeinput
+         ENDIF
+         IF( ln_trc_sbc(jpfer) ) THEN
+            WRITE(numout,*) '      Mineral Fe content of the dust           mfrac       = ', mfrac
+            WRITE(numout,*) '      sinking speed of the dust                wdust       = ', wdust
+         ENDIF
+         IF( ln_hydrofe ) THEN
+            WRITE(numout,*) '      Fe to 3He ratio assumed for vent iron supply hratio  = ', hratio
+         ENDIF
+      END IF
+
+      ll_bc    = ( ln_trcbc .AND. lltrcbc )  .OR. ln_hydrofe .OR. ln_ironsed .OR. ln_ironice
+      ll_dust  =  ln_trc_sbc(jpfer)   
+      ll_ndepo =  ln_trc_sbc(jpno3) .OR. ln_trc_sbc(jpnh4)   
+      ll_river =  ln_trc_cbc(jpno3)  
+
+      ! dust input from the atmosphere
+      ! ------------------------------
+      IF( ll_dust ) THEN
+         !
+         IF(lwp) WRITE(numout,*) '    initialize dust input from atmosphere '
+         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
+         !
+         ALLOCATE( dust(jpi,jpj) ) 
+         !
+         ALLOCATE( sf_dust(1), STAT=ierr )           !* allocate and fill sf_sst (forcing structure) with sn_sst
+         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_dust structure' )
+         !
+         CALL fld_fill( sf_dust, (/ sn_dust /), cn_dir, 'p4z_sed_init', 'Atmospheric dust deposition', 'nampissed' )
+                                   ALLOCATE( sf_dust(1)%fnow(jpi,jpj,1)   )
+         IF( sn_dust%ln_tint )     ALLOCATE( sf_dust(1)%fdta(jpi,jpj,1,2) )
+         !
+      END IF
+
+      ! coastal and island masks
+      ! ------------------------
+      IF( ln_ironsed ) THEN     
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '   ==>>>   ln_ironsed=T , computation of an island mask to enhance coastal supply of iron'
+         !
+         ALLOCATE( ironsed(jpi,jpj,jpk) )    ! allocation
+         !
+         CALL iom_open ( TRIM( sn_ironsed%clname ), numiron )
+         ALLOCATE( zcmask(jpi,jpj,jpk) )
+         CALL iom_get  ( numiron, jpdom_data, TRIM( sn_ironsed%clvar ), zcmask(:,:,:), 1 )
+         CALL iom_close( numiron )
+         !
+         ik50 = 5        !  last level where depth less than 50 m
+         DO jk = jpkm1, 1, -1
+            IF( gdept_1d(jk) > 50. )   ik50 = jk - 1
+         END DO
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' Level corresponding to 50m depth ',  ik50,' ', gdept_1d(ik50+1)
+         DO_3D_00_00( 1, ik50 )
+            ze3t   = e3t_0(ji,jj,jk)
+            zsurfc =  e1u(ji,jj) * ( 1. - umask(ji  ,jj  ,jk) )   &
+                    + e1u(ji,jj) * ( 1. - umask(ji-1,jj  ,jk) )   &
+                    + e2v(ji,jj) * ( 1. - vmask(ji  ,jj  ,jk) )   &
+                    + e2v(ji,jj) * ( 1. - vmask(ji  ,jj-1,jk) )
+            zsurfp = zsurfc * ze3t / e1e2t(ji,jj)
+            ! estimation of the coastal slope : 5 km off the coast
+            ze3t2 = ze3t * ze3t
+            zcslp = SQRT( ( distcoast*distcoast + ze3t2 ) / ze3t2 )
+            !
+            zcmask(ji,jj,jk) = zcmask(ji,jj,jk) + zcslp * zsurfp
+         END_3D
+         !
+         CALL lbc_lnk( 'p4zbc', zcmask , 'T', 1. )      ! lateral boundary conditions on cmask   (sign unchanged)
+         !
+         DO_3D_11_11( 1, jpk )
+            zexpide   = MIN( 8.,( gdept(ji,jj,jk,Kmm) / 500. )**(-1.5) )
+            zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2
+            zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 )
+         END_3D
+         ! Coastal supply of iron
+         ! -------------------------
+         ironsed(:,:,jpk) = 0._wp
+         DO jk = 1, jpkm1
+            ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( e3t_0(:,:,jk) * rday )
+         END DO
+         DEALLOCATE( zcmask)
+      ENDIF
+      !
+      ! Iron from Hydrothermal vents
+      ! ------------------------
+      IF( ln_hydrofe ) THEN
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '   ==>>>   ln_hydrofe=T , Input of iron from hydrothermal vents'
+         !
+         ALLOCATE( hydrofe(jpi,jpj,jpk) )    ! allocation
+         !
+         ALLOCATE( sf_hydrofe(1), STAT=ierr )           !* allocate and fill sf_sst (forcing structure) with sn_sst
+         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_hydro structure' )
+         !
+         CALL fld_fill( sf_hydrofe, (/ sn_hydrofe /), cn_dir, 'p4z_sed_init', 'Input of iron from hydrothermal vents', 'nampisbc' )
+                                   ALLOCATE( sf_hydrofe(1)%fnow(jpi,jpj,jpk)   )
+         IF( sn_hydrofe%ln_tint )    ALLOCATE( sf_hydrofe(1)%fdta(jpi,jpj,jpk,2) )
+         !
+      ENDIF
+      !
+   END SUBROUTINE p4z_bc_init
+
+   !!======================================================================
+END MODULE p4zbc
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zbio.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zbio.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zbio.F90	(revision 12928)
@@ -38,4 +38,6 @@
    PUBLIC  p4z_bio    
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -45,5 +47,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_bio ( kt, knt )
+   SUBROUTINE p4z_bio ( kt, knt, Kbb, Kmm, Krhs )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_bio  ***
@@ -56,4 +58,5 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) :: kt, knt
+      INTEGER, INTENT(in) :: Kbb, Kmm, Krhs  ! time level indices
       !
       INTEGER             :: ji, jj, jk, jn
@@ -68,46 +71,42 @@
       xdiss(:,:,:) = 1.
 !!gm the use of nmld should be better here?
-      DO jk = 2, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
+      DO_3D_11_11( 2, jpkm1 )
 !!gm  :  use nmln  and test on jk ...  less memory acces
-               IF( gdepw_n(ji,jj,jk+1) > hmld(ji,jj) )   xdiss(ji,jj,jk) = 0.01
-            END DO 
-         END DO
-      END DO
+         IF( gdepw(ji,jj,jk+1,Kmm) > hmld(ji,jj) )   xdiss(ji,jj,jk) = 0.01
+      END_3D
 
-      CALL p4z_opt     ( kt, knt )     ! Optic: PAR in the water column
-      CALL p4z_sink    ( kt, knt )     ! vertical flux of particulate organic matter
-      CALL p4z_fechem  ( kt, knt )     ! Iron chemistry/scavenging
+      CALL p4z_opt     ( kt, knt, Kbb, Kmm       )     ! Optic: PAR in the water column
+      CALL p4z_sink    ( kt, knt, Kbb, Kmm, Krhs )     ! vertical flux of particulate organic matter
+      CALL p4z_fechem  ( kt, knt, Kbb, Kmm, Krhs )     ! Iron chemistry/scavenging
       !
       IF( ln_p4z ) THEN
-         CALL p4z_lim  ( kt, knt )     ! co-limitations by the various nutrients
-         CALL p4z_prod ( kt, knt )     ! phytoplankton growth rate over the global ocean. 
-         !                             ! (for each element : C, Si, Fe, Chl )
-         CALL p4z_mort ( kt      )     ! phytoplankton mortality
-         !                             ! zooplankton sources/sinks routines 
-         CALL p4z_micro( kt, knt )           ! microzooplankton
-         CALL p4z_meso ( kt, knt )           ! mesozooplankton
+         CALL p4z_lim  ( kt, knt, Kbb, Kmm       )     ! co-limitations by the various nutrients
+         CALL p4z_prod ( kt, knt, Kbb, Kmm, Krhs )     ! phytoplankton growth rate over the global ocean. 
+         !                                          ! (for each element : C, Si, Fe, Chl )
+         CALL p4z_mort ( kt,      Kbb,      Krhs )     ! phytoplankton mortality
+         !                                          ! zooplankton sources/sinks routines 
+         CALL p4z_micro( kt, knt, Kbb,      Krhs )     ! microzooplankton
+         CALL p4z_meso ( kt, knt, Kbb,      Krhs )     ! mesozooplankton
       ELSE
-         CALL p5z_lim  ( kt, knt )     ! co-limitations by the various nutrients
-         CALL p5z_prod ( kt, knt )     ! phytoplankton growth rate over the global ocean. 
-         !                             ! (for each element : C, Si, Fe, Chl )
-         CALL p5z_mort ( kt      )     ! phytoplankton mortality
-         !                             ! zooplankton sources/sinks routines 
-         CALL p5z_micro( kt, knt )           ! microzooplankton
-         CALL p5z_meso ( kt, knt )           ! mesozooplankton
+         CALL p5z_lim  ( kt, knt, Kbb, Kmm       )     ! co-limitations by the various nutrients
+         CALL p5z_prod ( kt, knt, Kbb, Kmm, Krhs )     ! phytoplankton growth rate over the global ocean. 
+         !                                          ! (for each element : C, Si, Fe, Chl )
+         CALL p5z_mort ( kt,      Kbb,      Krhs      )     ! phytoplankton mortality
+         !                                          ! zooplankton sources/sinks routines 
+         CALL p5z_micro( kt, knt, Kbb,      Krhs )           ! microzooplankton
+         CALL p5z_meso ( kt, knt, Kbb,      Krhs )           ! mesozooplankton
       ENDIF
       !
-      CALL p4z_agg     ( kt, knt )     ! Aggregation of particles
-      CALL p4z_rem     ( kt, knt )     ! remineralization terms of organic matter+scavenging of Fe
-      CALL p4z_poc     ( kt, knt )     ! Remineralization of organic particles
+      CALL p4z_agg     ( kt, knt, Kbb,      Krhs )     ! Aggregation of particles
+      CALL p4z_rem     ( kt, knt, Kbb, Kmm, Krhs )     ! remineralization terms of organic matter+scavenging of Fe
+      CALL p4z_poc     ( kt, knt, Kbb, Kmm, Krhs )     ! Remineralization of organic particles
       !
       IF( ln_ligand )  &
-      & CALL p4z_ligand( kt, knt )
+      & CALL p4z_ligand( kt, knt, Kbb,      Krhs )
       !                                                             !
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
          WRITE(charout, FMT="('bio ')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
       ENDIF
       !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zche.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zche.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zche.F90	(revision 12928)
@@ -130,4 +130,6 @@
    INTEGER :: niter_atgen    = jp_maxniter_atgen
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -137,5 +139,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_che
+   SUBROUTINE p4z_che( Kbb, Kmm )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_che  ***
@@ -145,4 +147,5 @@
       !! ** Method  : - ...
       !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   Kbb, Kmm  ! time level indices
       INTEGER  ::   ji, jj, jk
       REAL(wp) ::   ztkel, ztkel1, zt , zsal  , zsal2 , zbuf1 , zbuf2
@@ -164,7 +167,7 @@
       ! -------------------------------------------------------------
       IF (neos == -1) THEN
-         salinprac(:,:,:) = tsn(:,:,:,jp_sal) * 35.0 / 35.16504
+         salinprac(:,:,:) = ts(:,:,:,jp_sal,Kmm) * 35.0 / 35.16504
       ELSE
-         salinprac(:,:,:) = tsn(:,:,:,jp_sal)
+         salinprac(:,:,:) = ts(:,:,:,jp_sal,Kmm)
       ENDIF
 
@@ -175,14 +178,10 @@
       ! 0.04°C relative to an exact computation
       ! ---------------------------------------------------------------------
-      DO jk = 1, jpk
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zpres = gdept_n(ji,jj,jk) / 1000.
-               za1 = 0.04 * ( 1.0 + 0.185 * tsn(ji,jj,jk,jp_tem) + 0.035 * (salinprac(ji,jj,jk) - 35.0) )
-               za2 = 0.0075 * ( 1.0 - tsn(ji,jj,jk,jp_tem) / 30.0 )
-               tempis(ji,jj,jk) = tsn(ji,jj,jk,jp_tem) - za1 * zpres + za2 * zpres**2
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpk )
+         zpres = gdept(ji,jj,jk,Kmm) / 1000.
+         za1 = 0.04 * ( 1.0 + 0.185 * ts(ji,jj,jk,jp_tem,Kmm) + 0.035 * (salinprac(ji,jj,jk) - 35.0) )
+         za2 = 0.0075 * ( 1.0 - ts(ji,jj,jk,jp_tem,Kmm) / 30.0 )
+         tempis(ji,jj,jk) = ts(ji,jj,jk,jp_tem,Kmm) - za1 * zpres + za2 * zpres**2
+      END_3D
       !
       ! CHEMICAL CONSTANTS - SURFACE LAYER
@@ -245,5 +244,5 @@
                zplat   = SIN ( ABS(gphit(ji,jj)*3.141592654/180.) )
                zc1 = 5.92E-3 + zplat**2 * 5.25E-3
-               zpres = ((1-zc1)-SQRT(((1-zc1)**2)-(8.84E-6*gdept_n(ji,jj,jk)))) / 4.42E-6
+               zpres = ((1-zc1)-SQRT(((1-zc1)**2)-(8.84E-6*gdept(ji,jj,jk,Kmm)))) / 4.42E-6
                zpres = zpres / 10.0
 
@@ -448,5 +447,5 @@
    END SUBROUTINE p4z_che
 
-   SUBROUTINE ahini_for_at(p_hini)
+   SUBROUTINE ahini_for_at(p_hini, Kbb )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE ahini_for_at  ***
@@ -462,4 +461,5 @@
       !!---------------------------------------------------------------------
       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT)  ::  p_hini
+      INTEGER,                          INTENT(in)   ::  Kbb      ! time level indices
       INTEGER  ::   ji, jj, jk
       REAL(wp)  ::  zca1, zba1
@@ -471,42 +471,38 @@
       IF( ln_timing )  CALL timing_start('ahini_for_at')
       !
-      DO jk = 1, jpk
-        DO jj = 1, jpj
-          DO ji = 1, jpi
-            p_alkcb  = trb(ji,jj,jk,jptal) * 1000. / (rhop(ji,jj,jk) + rtrn)
-            p_dictot = trb(ji,jj,jk,jpdic) * 1000. / (rhop(ji,jj,jk) + rtrn)
-            p_bortot = borat(ji,jj,jk)
-            IF (p_alkcb <= 0.) THEN
-                p_hini(ji,jj,jk) = 1.e-3
-            ELSEIF (p_alkcb >= (2.*p_dictot + p_bortot)) THEN
-                p_hini(ji,jj,jk) = 1.e-10_wp
+      DO_3D_11_11( 1, jpk )
+      p_alkcb  = tr(ji,jj,jk,jptal,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn)
+      p_dictot = tr(ji,jj,jk,jpdic,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn)
+      p_bortot = borat(ji,jj,jk)
+      IF (p_alkcb <= 0.) THEN
+          p_hini(ji,jj,jk) = 1.e-3
+      ELSEIF (p_alkcb >= (2.*p_dictot + p_bortot)) THEN
+          p_hini(ji,jj,jk) = 1.e-10_wp
+      ELSE
+          zca1 = p_dictot/( p_alkcb + rtrn )
+          zba1 = p_bortot/ (p_alkcb + rtrn )
+     ! Coefficients of the cubic polynomial
+          za2 = aKb3(ji,jj,jk)*(1. - zba1) + ak13(ji,jj,jk)*(1.-zca1)
+          za1 = ak13(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - zca1)    &
+          &     + ak13(ji,jj,jk)*ak23(ji,jj,jk)*(1. - (zca1+zca1))
+          za0 = ak13(ji,jj,jk)*ak23(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - (zca1+zca1))
+                                  ! Taylor expansion around the minimum
+          zd = za2*za2 - 3.*za1   ! Discriminant of the quadratic equation
+                                  ! for the minimum close to the root
+
+          IF(zd > 0.) THEN        ! If the discriminant is positive
+            zsqrtd = SQRT(zd)
+            IF(za2 < 0) THEN
+              zhmin = (-za2 + zsqrtd)/3.
             ELSE
-                zca1 = p_dictot/( p_alkcb + rtrn )
-                zba1 = p_bortot/ (p_alkcb + rtrn )
-           ! Coefficients of the cubic polynomial
-                za2 = aKb3(ji,jj,jk)*(1. - zba1) + ak13(ji,jj,jk)*(1.-zca1)
-                za1 = ak13(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - zca1)    &
-                &     + ak13(ji,jj,jk)*ak23(ji,jj,jk)*(1. - (zca1+zca1))
-                za0 = ak13(ji,jj,jk)*ak23(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - (zca1+zca1))
-                                        ! Taylor expansion around the minimum
-                zd = za2*za2 - 3.*za1   ! Discriminant of the quadratic equation
-                                        ! for the minimum close to the root
-
-                IF(zd > 0.) THEN        ! If the discriminant is positive
-                  zsqrtd = SQRT(zd)
-                  IF(za2 < 0) THEN
-                    zhmin = (-za2 + zsqrtd)/3.
-                  ELSE
-                    zhmin = -za1/(za2 + zsqrtd)
-                  ENDIF
-                  p_hini(ji,jj,jk) = zhmin + SQRT(-(za0 + zhmin*(za1 + zhmin*(za2 + zhmin)))/zsqrtd)
-                ELSE
-                  p_hini(ji,jj,jk) = 1.e-7
-                ENDIF
-             !
-             ENDIF
-          END DO
-        END DO
-      END DO
+              zhmin = -za1/(za2 + zsqrtd)
+            ENDIF
+            p_hini(ji,jj,jk) = zhmin + SQRT(-(za0 + zhmin*(za1 + zhmin*(za2 + zhmin)))/zsqrtd)
+          ELSE
+            p_hini(ji,jj,jk) = 1.e-7
+          ENDIF
+       !
+       ENDIF
+      END_3D
       !
       IF( ln_timing )  CALL timing_stop('ahini_for_at')
@@ -516,5 +512,5 @@
    !===============================================================================
 
-   SUBROUTINE anw_infsup( p_alknw_inf, p_alknw_sup )
+   SUBROUTINE anw_infsup( p_alknw_inf, p_alknw_sup, Kbb )
 
    ! Subroutine returns the lower and upper bounds of "non-water-selfionization"
@@ -525,8 +521,9 @@
    REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_inf
    REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_sup
-
-   p_alknw_inf(:,:,:) =  -trb(:,:,:,jppo4) * 1000. / (rhop(:,:,:) + rtrn) - sulfat(:,:,:)  &
+   INTEGER,                          INTENT(in)  ::  Kbb      ! time level indices
+
+   p_alknw_inf(:,:,:) =  -tr(:,:,:,jppo4,Kbb) * 1000. / (rhop(:,:,:) + rtrn) - sulfat(:,:,:)  &
    &              - fluorid(:,:,:)
-   p_alknw_sup(:,:,:) =   (2. * trb(:,:,:,jpdic) + 2. * trb(:,:,:,jppo4) + trb(:,:,:,jpsil) )    &
+   p_alknw_sup(:,:,:) =   (2. * tr(:,:,:,jpdic,Kbb) + 2. * tr(:,:,:,jppo4,Kbb) + tr(:,:,:,jpsil,Kbb) )    &
    &               * 1000. / (rhop(:,:,:) + rtrn) + borat(:,:,:) 
 
@@ -534,5 +531,5 @@
 
 
-   SUBROUTINE solve_at_general( p_hini, zhi )
+   SUBROUTINE solve_at_general( p_hini, zhi, Kbb )
 
    ! Universal pH solver that converges from any given initial value,
@@ -543,4 +540,5 @@
    REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN)   :: p_hini
    REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT)  :: zhi
+   INTEGER,                          INTENT(in)   :: Kbb  ! time level indices
 
    ! Local variables
@@ -565,5 +563,5 @@
    IF( ln_timing )  CALL timing_start('solve_at_general')
 
-   CALL anw_infsup( zalknw_inf, zalknw_sup )
+   CALL anw_infsup( zalknw_inf, zalknw_sup, Kbb )
 
    rmask(:,:,:) = tmask(:,:,:)
@@ -571,224 +569,216 @@
 
    ! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree
-   DO jk = 1, jpk
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF (rmask(ji,jj,jk) == 1.) THEN
-               p_alktot = trb(ji,jj,jk,jptal) * 1000. / (rhop(ji,jj,jk) + rtrn)
-               aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk)
-               zh_ini = p_hini(ji,jj,jk)
-
-               zdelta = (p_alktot-zalknw_inf(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale
-
-               IF(p_alktot >= zalknw_inf(ji,jj,jk)) THEN
-                 zh_min(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_inf(ji,jj,jk) + SQRT(zdelta) )
-               ELSE
-                 zh_min(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_inf(ji,jj,jk)) + SQRT(zdelta) ) / 2.
-               ENDIF
-
-               zdelta = (p_alktot-zalknw_sup(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale
-
-               IF(p_alktot <= zalknw_sup(ji,jj,jk)) THEN
-                 zh_max(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_sup(ji,jj,jk)) + SQRT(zdelta) ) / 2.
-               ELSE
-                 zh_max(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_sup(ji,jj,jk) + SQRT(zdelta) )
-               ENDIF
-
-               zhi(ji,jj,jk) = MAX(MIN(zh_max(ji,jj,jk), zh_ini), zh_min(ji,jj,jk))
+   DO_3D_11_11( 1, jpk )
+      IF (rmask(ji,jj,jk) == 1.) THEN
+         p_alktot = tr(ji,jj,jk,jptal,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn)
+         aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk)
+         zh_ini = p_hini(ji,jj,jk)
+
+         zdelta = (p_alktot-zalknw_inf(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale
+
+         IF(p_alktot >= zalknw_inf(ji,jj,jk)) THEN
+           zh_min(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_inf(ji,jj,jk) + SQRT(zdelta) )
+         ELSE
+           zh_min(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_inf(ji,jj,jk)) + SQRT(zdelta) ) / 2.
+         ENDIF
+
+         zdelta = (p_alktot-zalknw_sup(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale
+
+         IF(p_alktot <= zalknw_sup(ji,jj,jk)) THEN
+           zh_max(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_sup(ji,jj,jk)) + SQRT(zdelta) ) / 2.
+         ELSE
+           zh_max(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_sup(ji,jj,jk) + SQRT(zdelta) )
+         ENDIF
+
+         zhi(ji,jj,jk) = MAX(MIN(zh_max(ji,jj,jk), zh_ini), zh_min(ji,jj,jk))
+      ENDIF
+   END_3D
+
+   zeqn_absmin(:,:,:) = HUGE(1._wp)
+
+   DO jn = 1, jp_maxniter_atgen 
+   DO_3D_11_11( 1, jpk )
+      IF (rmask(ji,jj,jk) == 1.) THEN
+         zfact = rhop(ji,jj,jk) / 1000. + rtrn
+         p_alktot = tr(ji,jj,jk,jptal,Kbb) / zfact
+         zdic  = tr(ji,jj,jk,jpdic,Kbb) / zfact
+         zbot  = borat(ji,jj,jk)
+         zpt = tr(ji,jj,jk,jppo4,Kbb) / zfact * po4r
+         zsit = tr(ji,jj,jk,jpsil,Kbb) / zfact
+         zst = sulfat (ji,jj,jk)
+         zft = fluorid(ji,jj,jk)
+         aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk)
+         zh = zhi(ji,jj,jk)
+         zh_prev = zh
+
+         ! H2CO3 - HCO3 - CO3 : n=2, m=0
+         znumer_dic = 2.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk)
+         zdenom_dic = ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*(ak13(ji,jj,jk) + zh)
+         zalk_dic   = zdic * (znumer_dic/zdenom_dic)
+         zdnumer_dic = ak13(ji,jj,jk)*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh     &
+                       *(4.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk))
+         zdalk_dic   = -zdic*(zdnumer_dic/zdenom_dic**2)
+
+
+         ! B(OH)3 - B(OH)4 : n=1, m=0
+         znumer_bor = akb3(ji,jj,jk)
+         zdenom_bor = akb3(ji,jj,jk) + zh
+         zalk_bor   = zbot * (znumer_bor/zdenom_bor)
+         zdnumer_bor = akb3(ji,jj,jk)
+         zdalk_bor   = -zbot*(zdnumer_bor/zdenom_bor**2)
+
+
+         ! H3PO4 - H2PO4 - HPO4 - PO4 : n=3, m=1
+         znumer_po4 = 3.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)  &
+         &            + zh*(2.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh* ak1p3(ji,jj,jk))
+         zdenom_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)     &
+         &            + zh*( ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh*(ak1p3(ji,jj,jk) + zh))
+         zalk_po4   = zpt * (znumer_po4/zdenom_po4 - 1.) ! Zero level of H3PO4 = 1
+         zdnumer_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)  &
+         &             + zh*(4.*ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)         &
+         &             + zh*(9.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)                         &
+         &             + ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)                                &
+         &             + zh*(4.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh * ak1p3(ji,jj,jk) ) ) )
+         zdalk_po4   = -zpt * (zdnumer_po4/zdenom_po4**2)
+
+         ! H4SiO4 - H3SiO4 : n=1, m=0
+         znumer_sil = aksi3(ji,jj,jk)
+         zdenom_sil = aksi3(ji,jj,jk) + zh
+         zalk_sil   = zsit * (znumer_sil/zdenom_sil)
+         zdnumer_sil = aksi3(ji,jj,jk)
+         zdalk_sil   = -zsit * (zdnumer_sil/zdenom_sil**2)
+
+         ! HSO4 - SO4 : n=1, m=1
+         aphscale = 1.0 + zst/aks3(ji,jj,jk)
+         znumer_so4 = aks3(ji,jj,jk) * aphscale
+         zdenom_so4 = aks3(ji,jj,jk) * aphscale + zh
+         zalk_so4   = zst * (znumer_so4/zdenom_so4 - 1.)
+         zdnumer_so4 = aks3(ji,jj,jk)
+         zdalk_so4   = -zst * (zdnumer_so4/zdenom_so4**2)
+
+         ! HF - F : n=1, m=1
+         znumer_flu =  akf3(ji,jj,jk)
+         zdenom_flu =  akf3(ji,jj,jk) + zh
+         zalk_flu   =  zft * (znumer_flu/zdenom_flu - 1.)
+         zdnumer_flu = akf3(ji,jj,jk)
+         zdalk_flu   = -zft * (zdnumer_flu/zdenom_flu**2)
+
+         ! H2O - OH
+         aphscale = 1.0 + zst/aks3(ji,jj,jk)
+         zalk_wat   = akw3(ji,jj,jk)/zh - zh/aphscale
+         zdalk_wat  = -akw3(ji,jj,jk)/zh**2 - 1./aphscale
+
+         ! CALCULATE [ALK]([CO3--], [HCO3-])
+         zeqn = zalk_dic + zalk_bor + zalk_po4 + zalk_sil   &
+         &      + zalk_so4 + zalk_flu                       &
+         &      + zalk_wat - p_alktot
+
+         zalka = p_alktot - (zalk_bor + zalk_po4 + zalk_sil   &
+         &       + zalk_so4 + zalk_flu + zalk_wat)
+
+         zdeqndh = zdalk_dic + zdalk_bor + zdalk_po4 + zdalk_sil &
+         &         + zdalk_so4 + zdalk_flu + zdalk_wat
+
+         ! Adapt bracketing interval
+         IF(zeqn > 0._wp) THEN
+           zh_min(ji,jj,jk) = zh_prev
+         ELSEIF(zeqn < 0._wp) THEN
+           zh_max(ji,jj,jk) = zh_prev
+         ENDIF
+
+         IF(ABS(zeqn) >= 0.5_wp*zeqn_absmin(ji,jj,jk)) THEN
+         ! if the function evaluation at the current point is
+         ! not decreasing faster than with a bisection step (at least linearly)
+         ! in absolute value take one bisection step on [ph_min, ph_max]
+         ! ph_new = (ph_min + ph_max)/2d0
+         !
+         ! In terms of [H]_new:
+         ! [H]_new = 10**(-ph_new)
+         !         = 10**(-(ph_min + ph_max)/2d0)
+         !         = SQRT(10**(-(ph_min + phmax)))
+         !         = SQRT(zh_max * zh_min)
+            zh = SQRT(zh_max(ji,jj,jk) * zh_min(ji,jj,jk))
+            zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below
+         ELSE
+         ! dzeqn/dpH = dzeqn/d[H] * d[H]/dpH
+         !           = -zdeqndh * LOG(10) * [H]
+         ! \Delta pH = -zeqn/(zdeqndh*d[H]/dpH) = zeqn/(zdeqndh*[H]*LOG(10))
+         !
+         ! pH_new = pH_old + \deltapH
+         !
+         ! [H]_new = 10**(-pH_new)
+         !         = 10**(-pH_old - \Delta pH)
+         !         = [H]_old * 10**(-zeqn/(zdeqndh*[H]_old*LOG(10)))
+         !         = [H]_old * EXP(-LOG(10)*zeqn/(zdeqndh*[H]_old*LOG(10)))
+         !         = [H]_old * EXP(-zeqn/(zdeqndh*[H]_old))
+
+            zh_lnfactor = -zeqn/(zdeqndh*zh_prev)
+
+            IF(ABS(zh_lnfactor) > pz_exp_threshold) THEN
+               zh          = zh_prev*EXP(zh_lnfactor)
+            ELSE
+               zh_delta    = zh_lnfactor*zh_prev
+               zh          = zh_prev + zh_delta
             ENDIF
-         END DO
-      END DO
-   END DO
-
-   zeqn_absmin(:,:,:) = HUGE(1._wp)
-
-   DO jn = 1, jp_maxniter_atgen 
-   DO jk = 1, jpk
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF (rmask(ji,jj,jk) == 1.) THEN
-               zfact = rhop(ji,jj,jk) / 1000. + rtrn
-               p_alktot = trb(ji,jj,jk,jptal) / zfact
-               zdic  = trb(ji,jj,jk,jpdic) / zfact
-               zbot  = borat(ji,jj,jk)
-               zpt = trb(ji,jj,jk,jppo4) / zfact * po4r
-               zsit = trb(ji,jj,jk,jpsil) / zfact
-               zst = sulfat (ji,jj,jk)
-               zft = fluorid(ji,jj,jk)
-               aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk)
-               zh = zhi(ji,jj,jk)
-               zh_prev = zh
-
-               ! H2CO3 - HCO3 - CO3 : n=2, m=0
-               znumer_dic = 2.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk)
-               zdenom_dic = ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*(ak13(ji,jj,jk) + zh)
-               zalk_dic   = zdic * (znumer_dic/zdenom_dic)
-               zdnumer_dic = ak13(ji,jj,jk)*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh     &
-                             *(4.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk))
-               zdalk_dic   = -zdic*(zdnumer_dic/zdenom_dic**2)
-
-
-               ! B(OH)3 - B(OH)4 : n=1, m=0
-               znumer_bor = akb3(ji,jj,jk)
-               zdenom_bor = akb3(ji,jj,jk) + zh
-               zalk_bor   = zbot * (znumer_bor/zdenom_bor)
-               zdnumer_bor = akb3(ji,jj,jk)
-               zdalk_bor   = -zbot*(zdnumer_bor/zdenom_bor**2)
-
-
-               ! H3PO4 - H2PO4 - HPO4 - PO4 : n=3, m=1
-               znumer_po4 = 3.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)  &
-               &            + zh*(2.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh* ak1p3(ji,jj,jk))
-               zdenom_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)     &
-               &            + zh*( ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh*(ak1p3(ji,jj,jk) + zh))
-               zalk_po4   = zpt * (znumer_po4/zdenom_po4 - 1.) ! Zero level of H3PO4 = 1
-               zdnumer_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)  &
-               &             + zh*(4.*ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)         &
-               &             + zh*(9.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)                         &
-               &             + ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)                                &
-               &             + zh*(4.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh * ak1p3(ji,jj,jk) ) ) )
-               zdalk_po4   = -zpt * (zdnumer_po4/zdenom_po4**2)
-
-               ! H4SiO4 - H3SiO4 : n=1, m=0
-               znumer_sil = aksi3(ji,jj,jk)
-               zdenom_sil = aksi3(ji,jj,jk) + zh
-               zalk_sil   = zsit * (znumer_sil/zdenom_sil)
-               zdnumer_sil = aksi3(ji,jj,jk)
-               zdalk_sil   = -zsit * (zdnumer_sil/zdenom_sil**2)
-
-               ! HSO4 - SO4 : n=1, m=1
-               aphscale = 1.0 + zst/aks3(ji,jj,jk)
-               znumer_so4 = aks3(ji,jj,jk) * aphscale
-               zdenom_so4 = aks3(ji,jj,jk) * aphscale + zh
-               zalk_so4   = zst * (znumer_so4/zdenom_so4 - 1.)
-               zdnumer_so4 = aks3(ji,jj,jk)
-               zdalk_so4   = -zst * (zdnumer_so4/zdenom_so4**2)
-
-               ! HF - F : n=1, m=1
-               znumer_flu =  akf3(ji,jj,jk)
-               zdenom_flu =  akf3(ji,jj,jk) + zh
-               zalk_flu   =  zft * (znumer_flu/zdenom_flu - 1.)
-               zdnumer_flu = akf3(ji,jj,jk)
-               zdalk_flu   = -zft * (zdnumer_flu/zdenom_flu**2)
-
-               ! H2O - OH
-               aphscale = 1.0 + zst/aks3(ji,jj,jk)
-               zalk_wat   = akw3(ji,jj,jk)/zh - zh/aphscale
-               zdalk_wat  = -akw3(ji,jj,jk)/zh**2 - 1./aphscale
-
-               ! CALCULATE [ALK]([CO3--], [HCO3-])
-               zeqn = zalk_dic + zalk_bor + zalk_po4 + zalk_sil   &
-               &      + zalk_so4 + zalk_flu                       &
-               &      + zalk_wat - p_alktot
-
-               zalka = p_alktot - (zalk_bor + zalk_po4 + zalk_sil   &
-               &       + zalk_so4 + zalk_flu + zalk_wat)
-
-               zdeqndh = zdalk_dic + zdalk_bor + zdalk_po4 + zdalk_sil &
-               &         + zdalk_so4 + zdalk_flu + zdalk_wat
-
-               ! Adapt bracketing interval
-               IF(zeqn > 0._wp) THEN
-                 zh_min(ji,jj,jk) = zh_prev
-               ELSEIF(zeqn < 0._wp) THEN
-                 zh_max(ji,jj,jk) = zh_prev
-               ENDIF
-
-               IF(ABS(zeqn) >= 0.5_wp*zeqn_absmin(ji,jj,jk)) THEN
-               ! if the function evaluation at the current point is
-               ! not decreasing faster than with a bisection step (at least linearly)
-               ! in absolute value take one bisection step on [ph_min, ph_max]
-               ! ph_new = (ph_min + ph_max)/2d0
-               !
+
+            IF( zh < zh_min(ji,jj,jk) ) THEN
+               ! if [H]_new < [H]_min
+               ! i.e., if ph_new > ph_max then
+               ! take one bisection step on [ph_prev, ph_max]
+               ! ph_new = (ph_prev + ph_max)/2d0
                ! In terms of [H]_new:
                ! [H]_new = 10**(-ph_new)
-               !         = 10**(-(ph_min + ph_max)/2d0)
-               !         = SQRT(10**(-(ph_min + phmax)))
-               !         = SQRT(zh_max * zh_min)
-                  zh = SQRT(zh_max(ji,jj,jk) * zh_min(ji,jj,jk))
-                  zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below
-               ELSE
-               ! dzeqn/dpH = dzeqn/d[H] * d[H]/dpH
-               !           = -zdeqndh * LOG(10) * [H]
-               ! \Delta pH = -zeqn/(zdeqndh*d[H]/dpH) = zeqn/(zdeqndh*[H]*LOG(10))
-               !
-               ! pH_new = pH_old + \deltapH
-               !
-               ! [H]_new = 10**(-pH_new)
-               !         = 10**(-pH_old - \Delta pH)
-               !         = [H]_old * 10**(-zeqn/(zdeqndh*[H]_old*LOG(10)))
-               !         = [H]_old * EXP(-LOG(10)*zeqn/(zdeqndh*[H]_old*LOG(10)))
-               !         = [H]_old * EXP(-zeqn/(zdeqndh*[H]_old))
-
-                  zh_lnfactor = -zeqn/(zdeqndh*zh_prev)
-
-                  IF(ABS(zh_lnfactor) > pz_exp_threshold) THEN
-                     zh          = zh_prev*EXP(zh_lnfactor)
-                  ELSE
-                     zh_delta    = zh_lnfactor*zh_prev
-                     zh          = zh_prev + zh_delta
-                  ENDIF
-
-                  IF( zh < zh_min(ji,jj,jk) ) THEN
-                     ! if [H]_new < [H]_min
-                     ! i.e., if ph_new > ph_max then
-                     ! take one bisection step on [ph_prev, ph_max]
-                     ! ph_new = (ph_prev + ph_max)/2d0
-                     ! In terms of [H]_new:
-                     ! [H]_new = 10**(-ph_new)
-                     !         = 10**(-(ph_prev + ph_max)/2d0)
-                     !         = SQRT(10**(-(ph_prev + phmax)))
-                     !         = SQRT([H]_old*10**(-ph_max))
-                     !         = SQRT([H]_old * zh_min)
-                     zh                = SQRT(zh_prev * zh_min(ji,jj,jk))
-                     zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below
-                  ENDIF
-
-                  IF( zh > zh_max(ji,jj,jk) ) THEN
-                     ! if [H]_new > [H]_max
-                     ! i.e., if ph_new < ph_min, then
-                     ! take one bisection step on [ph_min, ph_prev]
-                     ! ph_new = (ph_prev + ph_min)/2d0
-                     ! In terms of [H]_new:
-                     ! [H]_new = 10**(-ph_new)
-                     !         = 10**(-(ph_prev + ph_min)/2d0)
-                     !         = SQRT(10**(-(ph_prev + ph_min)))
-                     !         = SQRT([H]_old*10**(-ph_min))
-                     !         = SQRT([H]_old * zhmax)
-                     zh                = SQRT(zh_prev * zh_max(ji,jj,jk))
-                     zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below
-                  ENDIF
-               ENDIF
-
-               zeqn_absmin(ji,jj,jk) = MIN( ABS(zeqn), zeqn_absmin(ji,jj,jk))
-
-               ! Stop iterations once |\delta{[H]}/[H]| < rdel
-               ! <=> |(zh - zh_prev)/zh_prev| = |EXP(-zeqn/(zdeqndh*zh_prev)) -1| < rdel
-               ! |EXP(-zeqn/(zdeqndh*zh_prev)) -1| ~ |zeqn/(zdeqndh*zh_prev)|
-
-               ! Alternatively:
-               ! |\Delta pH| = |zeqn/(zdeqndh*zh_prev*LOG(10))|
-               !             ~ 1/LOG(10) * |\Delta [H]|/[H]
-               !             < 1/LOG(10) * rdel
-
-               ! Hence |zeqn/(zdeqndh*zh)| < rdel
-
-               ! rdel <-- pp_rdel_ah_target
-               l_exitnow = (ABS(zh_lnfactor) < pp_rdel_ah_target)
-
-               IF(l_exitnow) THEN 
-                  rmask(ji,jj,jk) = 0.
-               ENDIF
-
-               zhi(ji,jj,jk) =  zh
-
-               IF(jn >= jp_maxniter_atgen) THEN
-                  zhi(ji,jj,jk) = -1._wp
-               ENDIF
-
+               !         = 10**(-(ph_prev + ph_max)/2d0)
+               !         = SQRT(10**(-(ph_prev + phmax)))
+               !         = SQRT([H]_old*10**(-ph_max))
+               !         = SQRT([H]_old * zh_min)
+               zh                = SQRT(zh_prev * zh_min(ji,jj,jk))
+               zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below
             ENDIF
-         END DO
-      END DO
-   END DO
+
+            IF( zh > zh_max(ji,jj,jk) ) THEN
+               ! if [H]_new > [H]_max
+               ! i.e., if ph_new < ph_min, then
+               ! take one bisection step on [ph_min, ph_prev]
+               ! ph_new = (ph_prev + ph_min)/2d0
+               ! In terms of [H]_new:
+               ! [H]_new = 10**(-ph_new)
+               !         = 10**(-(ph_prev + ph_min)/2d0)
+               !         = SQRT(10**(-(ph_prev + ph_min)))
+               !         = SQRT([H]_old*10**(-ph_min))
+               !         = SQRT([H]_old * zhmax)
+               zh                = SQRT(zh_prev * zh_max(ji,jj,jk))
+               zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below
+            ENDIF
+         ENDIF
+
+         zeqn_absmin(ji,jj,jk) = MIN( ABS(zeqn), zeqn_absmin(ji,jj,jk))
+
+         ! Stop iterations once |\delta{[H]}/[H]| < rdel
+         ! <=> |(zh - zh_prev)/zh_prev| = |EXP(-zeqn/(zdeqndh*zh_prev)) -1| < rdel
+         ! |EXP(-zeqn/(zdeqndh*zh_prev)) -1| ~ |zeqn/(zdeqndh*zh_prev)|
+
+         ! Alternatively:
+         ! |\Delta pH| = |zeqn/(zdeqndh*zh_prev*LOG(10))|
+         !             ~ 1/LOG(10) * |\Delta [H]|/[H]
+         !             < 1/LOG(10) * rdel
+
+         ! Hence |zeqn/(zdeqndh*zh)| < rdel
+
+         ! rdel <-- pp_rdel_ah_target
+         l_exitnow = (ABS(zh_lnfactor) < pp_rdel_ah_target)
+
+         IF(l_exitnow) THEN 
+            rmask(ji,jj,jk) = 0.
+         ENDIF
+
+         zhi(ji,jj,jk) =  zh
+
+         IF(jn >= jp_maxniter_atgen) THEN
+            zhi(ji,jj,jk) = -1._wp
+         ENDIF
+
+      ENDIF
+   END_3D
    END DO
    !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zfechem.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zfechem.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zfechem.F90	(revision 12928)
@@ -15,5 +15,5 @@
    USE sms_pisces      ! PISCES Source Minus Sink variables
    USE p4zche          ! chemical model
-   USE p4zsbc          ! Boundary conditions from sediments
+   USE p4zbc           ! Boundary conditions from sediments
    USE prtctl_trc      ! print control for debugging
    USE iom             ! I/O manager
@@ -31,4 +31,6 @@
    REAL(wp), PUBLIC ::   kfep         !: rate constant for nanoparticle formation
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -38,5 +40,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_fechem( kt, knt )
+   SUBROUTINE p4z_fechem( kt, knt, Kbb, Kmm, Krhs )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_fechem  ***
@@ -48,4 +50,5 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt, knt   ! ocean time step
+      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level indices
       !
       INTEGER  ::   ji, jj, jk, jic, jn
@@ -71,16 +74,12 @@
       IF( ln_timing )   CALL timing_start('p4z_fechem')
       !
-      zFe3 (:,:,:) = 0.
-      zFeL1(:,:,:) = 0.
-      zTL1 (:,:,:) = 0.
-
       ! Total ligand concentration : Ligands can be chosen to be constant or variable
       ! Parameterization from Tagliabue and Voelker (2011)
       ! -------------------------------------------------
       IF( ln_ligvar ) THEN
-         ztotlig(:,:,:) =  0.09 * trb(:,:,:,jpdoc) * 1E6 + ligand * 1E9
+         ztotlig(:,:,:) =  0.09 * tr(:,:,:,jpdoc,Kbb) * 1E6 + ligand * 1E9
          ztotlig(:,:,:) =  MIN( ztotlig(:,:,:), 10. )
       ELSE
-        IF( ln_ligand ) THEN  ;   ztotlig(:,:,:) = trb(:,:,:,jplgw) * 1E9
+        IF( ln_ligand ) THEN  ;   ztotlig(:,:,:) = tr(:,:,:,jplgw,Kbb) * 1E9
         ELSE                  ;   ztotlig(:,:,:) = ligand * 1E9
         ENDIF
@@ -92,114 +91,102 @@
       ! Chemistry is supposed to be fast enough to be at equilibrium
       ! ------------------------------------------------------------
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zTL1(ji,jj,jk)  = ztotlig(ji,jj,jk)
-               zkeq            = fekeq(ji,jj,jk)
-               zfesatur        = zTL1(ji,jj,jk) * 1E-9
-               ztfe            = trb(ji,jj,jk,jpfer) 
-               ! Fe' is the root of a 2nd order polynom
-               zFe3 (ji,jj,jk) = ( -( 1. + zfesatur * zkeq - zkeq * ztfe )               &
-                  &              + SQRT( ( 1. + zfesatur * zkeq - zkeq * ztfe )**2       &
-                  &              + 4. * ztfe * zkeq) ) / ( 2. * zkeq )
-               zFe3 (ji,jj,jk) = zFe3(ji,jj,jk) * 1E9
-               zFeL1(ji,jj,jk) = MAX( 0., trb(ji,jj,jk,jpfer) * 1E9 - zFe3(ji,jj,jk) )
-           END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpkm1 )
+         zTL1(ji,jj,jk)  = ztotlig(ji,jj,jk)
+         zkeq            = fekeq(ji,jj,jk)
+         zfesatur        = zTL1(ji,jj,jk) * 1E-9
+         ztfe            = tr(ji,jj,jk,jpfer,Kbb) 
+         ! Fe' is the root of a 2nd order polynom
+         zFe3 (ji,jj,jk) = ( -( 1. + zfesatur * zkeq - zkeq * ztfe )               &
+            &              + SQRT( ( 1. + zfesatur * zkeq - zkeq * ztfe )**2       &
+            &              + 4. * ztfe * zkeq) ) / ( 2. * zkeq )
+         zFe3 (ji,jj,jk) = zFe3(ji,jj,jk) * 1E9
+         zFeL1(ji,jj,jk) = MAX( 0., tr(ji,jj,jk,jpfer,Kbb) * 1E9 - zFe3(ji,jj,jk) )
+      END_3D
          !
 
       zdust = 0.         ! if no dust available
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ! Scavenging rate of iron. This scavenging rate depends on the load of particles of sea water. 
-               ! This parameterization assumes a simple second order kinetics (k[Particles][Fe]).
-               ! Scavenging onto dust is also included as evidenced from the DUNE experiments.
-               ! --------------------------------------------------------------------------------------
-               zhplus  = max( rtrn, hi(ji,jj,jk) )
-               fe3sol  = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2  &
-               &         + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4)     &
-               &         + fesol(ji,jj,jk,5) / zhplus )
-               !
-               zfeequi = zFe3(ji,jj,jk) * 1E-9
-               zhplus  = max( rtrn, hi(ji,jj,jk) )
-               fe3sol  = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2  &
-                  &         + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4)     &
-                  &         + fesol(ji,jj,jk,5) / zhplus )
-               zfecoll = 0.5 * zFeL1(ji,jj,jk) * 1E-9
-               ! precipitation of Fe3+, creation of nanoparticles
-               precip(ji,jj,jk) = MAX( 0., ( zFe3(ji,jj,jk) * 1E-9 - fe3sol ) ) * kfep * xstep
-               !
-               ztrc   = ( trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + trb(ji,jj,jk,jpcal) + trb(ji,jj,jk,jpgsi) ) * 1.e6 
-               IF( ln_dust )  zdust  = dust(ji,jj) / ( wdust / rday ) * tmask(ji,jj,jk) &
-               &  * EXP( -gdept_n(ji,jj,jk) / 540. )
-               IF (ln_ligand) THEN
-                  zxlam  = xlam1 * MAX( 1.E-3, EXP(-2 * etot(ji,jj,jk) / 10. ) * (1. - EXP(-2 * trb(ji,jj,jk,jpoxy) / 100.E-6 ) ))
-               ELSE
-                  zxlam  = xlam1 * 1.0
-               ENDIF
-               zlam1b = 3.e-5 + xlamdust * zdust + zxlam * ztrc
-               zscave = zfeequi * zlam1b * xstep
-
-               ! Compute the different ratios for scavenging of iron
-               ! to later allocate scavenged iron to the different organic pools
-               ! ---------------------------------------------------------
-               zdenom1 = zxlam * trb(ji,jj,jk,jppoc) / zlam1b
-               zdenom2 = zxlam * trb(ji,jj,jk,jpgoc) / zlam1b
-
-               !  Increased scavenging for very high iron concentrations found near the coasts 
-               !  due to increased lithogenic particles and let say it is unknown processes (precipitation, ...)
-               !  -----------------------------------------------------------
-               zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. )
-               zlamfac = MIN( 1.  , zlamfac )
-               zdep    = MIN( 1., 1000. / gdept_n(ji,jj,jk) )
-               zcoag   = 1E-4 * ( 1. - zlamfac ) * zdep * xstep * trb(ji,jj,jk,jpfer)
-
-               !  Compute the coagulation of colloidal iron. This parameterization 
-               !  could be thought as an equivalent of colloidal pumping.
-               !  It requires certainly some more work as it is very poorly constrained.
-               !  ----------------------------------------------------------------
-               zlam1a   = ( 0.369  * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4  * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    &
-                   &      + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) )
-               zaggdfea = zlam1a * xstep * zfecoll
-               !
-               zlam1b   = 3.53E3 * trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk)
-               zaggdfeb = zlam1b * xstep * zfecoll
-               !
-               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfea - zaggdfeb &
-               &                     - zcoag - precip(ji,jj,jk)
-               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 + zaggdfea
-               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zscave * zdenom2 + zaggdfeb
-               zscav3d(ji,jj,jk)   = zscave
-               zcoll3d(ji,jj,jk)   = zaggdfea + zaggdfeb
-               !
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpkm1 )
+         ! Scavenging rate of iron. This scavenging rate depends on the load of particles of sea water. 
+         ! This parameterization assumes a simple second order kinetics (k[Particles][Fe]).
+         ! Scavenging onto dust is also included as evidenced from the DUNE experiments.
+         ! --------------------------------------------------------------------------------------
+         zhplus  = max( rtrn, hi(ji,jj,jk) )
+         fe3sol  = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2  &
+         &         + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4)     &
+         &         + fesol(ji,jj,jk,5) / zhplus )
+         !
+         zfeequi = zFe3(ji,jj,jk) * 1E-9
+         zhplus  = max( rtrn, hi(ji,jj,jk) )
+         fe3sol  = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2  &
+            &         + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4)     &
+            &         + fesol(ji,jj,jk,5) / zhplus )
+         zfecoll = 0.5 * zFeL1(ji,jj,jk) * 1E-9
+         ! precipitation of Fe3+, creation of nanoparticles
+         precip(ji,jj,jk) = MAX( 0., ( zFe3(ji,jj,jk) * 1E-9 - fe3sol ) ) * kfep * xstep
+         !
+         ztrc   = ( tr(ji,jj,jk,jppoc,Kbb) + tr(ji,jj,jk,jpgoc,Kbb) + tr(ji,jj,jk,jpcal,Kbb) + tr(ji,jj,jk,jpgsi,Kbb) ) * 1.e6 
+         IF( ll_dust )  zdust  = dust(ji,jj) / ( wdust / rday ) * tmask(ji,jj,jk) &
+         &  * EXP( -gdept(ji,jj,jk,Kmm) / 540. )
+         IF (ln_ligand) THEN
+            zxlam  = xlam1 * MAX( 1.E-3, EXP(-2 * etot(ji,jj,jk) / 10. ) * (1. - EXP(-2 * tr(ji,jj,jk,jpoxy,Kbb) / 100.E-6 ) ))
+         ELSE
+            zxlam  = xlam1 * 1.0
+         ENDIF
+         zlam1b = 3.e-5 + xlamdust * zdust + zxlam * ztrc
+         zscave = zfeequi * zlam1b * xstep
+
+         ! Compute the different ratios for scavenging of iron
+         ! to later allocate scavenged iron to the different organic pools
+         ! ---------------------------------------------------------
+         zdenom1 = zxlam * tr(ji,jj,jk,jppoc,Kbb) / zlam1b
+         zdenom2 = zxlam * tr(ji,jj,jk,jpgoc,Kbb) / zlam1b
+
+         !  Increased scavenging for very high iron concentrations found near the coasts 
+         !  due to increased lithogenic particles and let say it is unknown processes (precipitation, ...)
+         !  -----------------------------------------------------------
+         zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. )
+         zlamfac = MIN( 1.  , zlamfac )
+         zdep    = MIN( 1., 1000. / gdept(ji,jj,jk,Kmm) )
+         zcoag   = 1E-4 * ( 1. - zlamfac ) * zdep * xstep * tr(ji,jj,jk,jpfer,Kbb)
+
+         !  Compute the coagulation of colloidal iron. This parameterization 
+         !  could be thought as an equivalent of colloidal pumping.
+         !  It requires certainly some more work as it is very poorly constrained.
+         !  ----------------------------------------------------------------
+         zlam1a   = ( 0.369  * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4  * tr(ji,jj,jk,jppoc,Kbb) ) * xdiss(ji,jj,jk)    &
+             &      + ( 114.   * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) )
+         zaggdfea = zlam1a * xstep * zfecoll
+         !
+         zlam1b   = 3.53E3 * tr(ji,jj,jk,jpgoc,Kbb) * xdiss(ji,jj,jk)
+         zaggdfeb = zlam1b * xstep * zfecoll
+         !
+         tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zscave - zaggdfea - zaggdfeb &
+         &                     - zcoag - precip(ji,jj,jk)
+         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zscave * zdenom1 + zaggdfea
+         tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zscave * zdenom2 + zaggdfeb
+         zscav3d(ji,jj,jk)   = zscave
+         zcoll3d(ji,jj,jk)   = zaggdfea + zaggdfeb
+         !
+      END_3D
       !
       !  Define the bioavailable fraction of iron
       !  ----------------------------------------
-      biron(:,:,:) = trb(:,:,:,jpfer) 
+      biron(:,:,:) = tr(:,:,:,jpfer,Kbb) 
       !
       IF( ln_ligand ) THEN
          !
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zlam1a   = ( 0.369  * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4  * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    &
-                      &    + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) )
-                  !
-                  zlam1b   = 3.53E3 *   trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk)
-                  zligco   = 0.5 * trn(ji,jj,jk,jplgw)
-                  zaggliga = zlam1a * xstep * zligco
-                  zaggligb = zlam1b * xstep * zligco
-                  tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) - zaggliga - zaggligb
-                  zlcoll3d(ji,jj,jk)  = zaggliga + zaggligb
-               END DO
-            END DO
-         END DO
-         !
-         plig(:,:,:) =  MAX( 0., ( ( zFeL1(:,:,:) * 1E-9 ) / ( trb(:,:,:,jpfer) +rtrn ) ) )
+         DO_3D_11_11( 1, jpkm1 )
+            zlam1a   = ( 0.369  * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4  * tr(ji,jj,jk,jppoc,Kbb) ) * xdiss(ji,jj,jk)    &
+                &    + ( 114.   * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) )
+            !
+            zlam1b   = 3.53E3 *   tr(ji,jj,jk,jpgoc,Kbb) * xdiss(ji,jj,jk)
+            zligco   = 0.5 * tr(ji,jj,jk,jplgw,Kmm)
+            zaggliga = zlam1a * xstep * zligco
+            zaggligb = zlam1b * xstep * zligco
+            tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) - zaggliga - zaggligb
+            zlcoll3d(ji,jj,jk)  = zaggliga + zaggligb
+         END_3D
+         !
+         plig(:,:,:) =  MAX( 0., ( ( zFeL1(:,:,:) * 1E-9 ) / ( tr(:,:,:,jpfer,Kbb) +rtrn ) ) )
          !
       ENDIF
@@ -209,19 +196,31 @@
          IF( knt == nrdttrc ) THEN
             zrfact2 = 1.e3 * rfact2r  ! conversion from mol/L/timestep into mol/m3/s
-            IF( iom_use("Fe3")    )  CALL iom_put("Fe3"    , zFe3   (:,:,:)       * tmask(:,:,:) )   ! Fe3+
-            IF( iom_use("FeL1")   )  CALL iom_put("FeL1"   , zFeL1  (:,:,:)       * tmask(:,:,:) )   ! FeL1
-            IF( iom_use("TL1")    )  CALL iom_put("TL1"    , zTL1   (:,:,:)       * tmask(:,:,:) )   ! TL1
+            IF( iom_use("Fe3")  )  THEN
+               zFe3(:,:,jpk) = 0.  ;  CALL iom_put("Fe3" , zFe3(:,:,:) * tmask(:,:,:) )   ! Fe3+
+            ENDIF
+            IF( iom_use("FeL1") )  THEN
+              zFeL1(:,:,jpk) = 0.  ;  CALL iom_put("FeL1", zFeL1(:,:,:) * tmask(:,:,:) )   ! FeL1
+            ENDIF
+            IF( iom_use("TL1")  )  THEN
+              zTL1(:,:,jpk) = 0.   ;  CALL iom_put("TL1" , zTL1(:,:,:) * tmask(:,:,:) )   ! TL1
+            ENDIF
             IF( iom_use("Totlig") )  CALL iom_put("Totlig" , ztotlig(:,:,:)       * tmask(:,:,:) )   ! TL
             IF( iom_use("Biron")  )  CALL iom_put("Biron"  , biron  (:,:,:)  * 1e9 * tmask(:,:,:) )   ! biron
-            IF( iom_use("FESCAV") )  CALL iom_put("FESCAV" , zscav3d(:,:,:)  * 1e9 * tmask(:,:,:) * zrfact2 )
-            IF( iom_use("FECOLL") )  CALL iom_put("FECOLL" , zcoll3d(:,:,:)  * 1e9 * tmask(:,:,:) * zrfact2 )
-            IF( iom_use("LGWCOLL"))  CALL iom_put("LGWCOLL", zlcoll3d(:,:,:) * 1e9 * tmask(:,:,:) * zrfact2 )
-         ENDIF
-      ENDIF
-
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+            IF( iom_use("FESCAV") )  THEN
+               zscav3d (:,:,jpk) = 0.  ;  CALL iom_put("FESCAV" , zscav3d(:,:,:)  * 1e9 * tmask(:,:,:) * zrfact2 )
+            ENDIF
+            IF( iom_use("FECOLL") ) THEN
+               zcoll3d (:,:,jpk) = 0.  ;   CALL iom_put("FECOLL" , zcoll3d(:,:,:)  * 1e9 * tmask(:,:,:) * zrfact2 )
+            ENDIF
+            IF( iom_use("LGWCOLL")) THEN
+               zlcoll3d(:,:,jpk) = 0.  ;  CALL iom_put("LGWCOLL", zlcoll3d(:,:,:) * 1e9 * tmask(:,:,:) * zrfact2 )
+            ENDIF
+          ENDIF
+      ENDIF
+
+      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
          WRITE(charout, FMT="('fechem')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
       ENDIF
       !
@@ -254,8 +253,6 @@
       ENDIF
       !
-      REWIND( numnatp_ref )            ! Namelist nampisfer in reference namelist : Pisces iron chemistry
       READ  ( numnatp_ref, nampisfer, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisfer in reference namelist' )
-      REWIND( numnatp_cfg )            ! Namelist nampisfer in configuration namelist : Pisces iron chemistry
       READ  ( numnatp_cfg, nampisfer, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisfer in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zflx.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zflx.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zflx.F90	(revision 12928)
@@ -52,4 +52,6 @@
    REAL(wp) ::   xconv  = 0.01_wp / 3600._wp   !: coefficients for conversion 
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -59,5 +61,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_flx ( kt, knt )
+   SUBROUTINE p4z_flx ( kt, knt, Kbb, Kmm, Krhs )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_flx  ***
@@ -71,4 +73,5 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt, knt   !
+      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs      ! time level indices
       !
       INTEGER  ::   ji, jj, jm, iind, iindm1
@@ -80,5 +83,4 @@
       CHARACTER (len=25) ::   charout
       REAL(wp), DIMENSION(jpi,jpj) ::   zkgco2, zkgo2, zh2co3, zoflx,  zpco2atm  
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zw2d
       !!---------------------------------------------------------------------
       !
@@ -107,14 +109,12 @@
       IF( l_co2cpl )   satmco2(:,:) = atm_co2(:,:)
 
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            ! DUMMY VARIABLES FOR DIC, H+, AND BORATE
-            zfact = rhop(ji,jj,1) / 1000. + rtrn
-            zdic  = trb(ji,jj,1,jpdic)
-            zph   = MAX( hi(ji,jj,1), 1.e-10 ) / zfact
-            ! CALCULATE [H2CO3]
-            zh2co3(ji,jj) = zdic/(1. + ak13(ji,jj,1)/zph + ak13(ji,jj,1)*ak23(ji,jj,1)/zph**2)
-         END DO
-      END DO
+      DO_2D_11_11
+         ! DUMMY VARIABLES FOR DIC, H+, AND BORATE
+         zfact = rhop(ji,jj,1) / 1000. + rtrn
+         zdic  = tr(ji,jj,1,jpdic,Kbb)
+         zph   = MAX( hi(ji,jj,1), 1.e-10 ) / zfact
+         ! CALCULATE [H2CO3]
+         zh2co3(ji,jj) = zdic/(1. + ak13(ji,jj,1)/zph + ak13(ji,jj,1)*ak23(ji,jj,1)/zph**2)
+      END_2D
 
       ! --------------
@@ -125,90 +125,70 @@
       ! -------------------------------------------
 
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            ztc  = MIN( 35., tsn(ji,jj,1,jp_tem) )
-            ztc2 = ztc * ztc
-            ztc3 = ztc * ztc2 
-            ztc4 = ztc2 * ztc2 
-            ! Compute the schmidt Number both O2 and CO2
-            zsch_co2 = 2116.8 - 136.25 * ztc + 4.7353 * ztc2 - 0.092307 * ztc3 + 0.0007555 * ztc4
-            zsch_o2  = 1920.4 - 135.6  * ztc + 5.2122 * ztc2 - 0.109390 * ztc3 + 0.0009377 * ztc4
-            !  wind speed 
-            zws  = wndm(ji,jj) * wndm(ji,jj)
-            ! Compute the piston velocity for O2 and CO2
-            zkgwan = 0.251 * zws
-            zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1)
-            ! compute gas exchange for CO2 and O2
-            zkgco2(ji,jj) = zkgwan * SQRT( 660./ zsch_co2 )
-            zkgo2 (ji,jj) = zkgwan * SQRT( 660./ zsch_o2 )
-         END DO
-      END DO
-
-
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            ztkel = tempis(ji,jj,1) + 273.15
-            zsal  = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35.
-            zvapsw    = EXP(24.4543 - 67.4509*(100.0/ztkel) - 4.8489*LOG(ztkel/100) - 0.000544*zsal)
-            zpco2atm(ji,jj) = satmco2(ji,jj) * ( patm(ji,jj) - zvapsw )
-            zxc2      = ( 1.0 - zpco2atm(ji,jj) * 1E-6 )**2
-            zfugcoeff = EXP( patm(ji,jj) * (chemc(ji,jj,2) + 2.0 * zxc2 * chemc(ji,jj,3) )   &
-            &           / ( 82.05736 * ztkel ))
-            zfco2 = zpco2atm(ji,jj) * zfugcoeff
-
-            ! Compute CO2 flux for the sea and air
-            zfld = zfco2 * chemc(ji,jj,1) * zkgco2(ji,jj)  ! (mol/L) * (m/s)
-            zflu = zh2co3(ji,jj) * zkgco2(ji,jj)                                   ! (mol/L) (m/s) ?
-            oce_co2(ji,jj) = ( zfld - zflu ) * rfact2 * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000.
-            ! compute the trend
-            tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) * rfact2 / e3t_n(ji,jj,1) * tmask(ji,jj,1)
-
-            ! Compute O2 flux 
-            zfld16 = patm(ji,jj) * chemo2(ji,jj,1) * zkgo2(ji,jj)          ! (mol/L) * (m/s)
-            zflu16 = trb(ji,jj,1,jpoxy) * zkgo2(ji,jj)
-            zoflx(ji,jj) = ( zfld16 - zflu16 ) * tmask(ji,jj,1)
-            tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) * rfact2 / e3t_n(ji,jj,1)
-         END DO
-      END DO
+      DO_2D_11_11
+         ztc  = MIN( 35., ts(ji,jj,1,jp_tem,Kmm) )
+         ztc2 = ztc * ztc
+         ztc3 = ztc * ztc2 
+         ztc4 = ztc2 * ztc2 
+         ! Compute the schmidt Number both O2 and CO2
+         zsch_co2 = 2116.8 - 136.25 * ztc + 4.7353 * ztc2 - 0.092307 * ztc3 + 0.0007555 * ztc4
+         zsch_o2  = 1920.4 - 135.6  * ztc + 5.2122 * ztc2 - 0.109390 * ztc3 + 0.0009377 * ztc4
+         !  wind speed 
+         zws  = wndm(ji,jj) * wndm(ji,jj)
+         ! Compute the piston velocity for O2 and CO2
+         zkgwan = 0.251 * zws
+         zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1)
+         ! compute gas exchange for CO2 and O2
+         zkgco2(ji,jj) = zkgwan * SQRT( 660./ zsch_co2 )
+         zkgo2 (ji,jj) = zkgwan * SQRT( 660./ zsch_o2 )
+      END_2D
+
+
+      DO_2D_11_11
+         ztkel = tempis(ji,jj,1) + 273.15
+         zsal  = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35.
+         zvapsw    = EXP(24.4543 - 67.4509*(100.0/ztkel) - 4.8489*LOG(ztkel/100) - 0.000544*zsal)
+         zpco2atm(ji,jj) = satmco2(ji,jj) * ( patm(ji,jj) - zvapsw )
+         zxc2      = ( 1.0 - zpco2atm(ji,jj) * 1E-6 )**2
+         zfugcoeff = EXP( patm(ji,jj) * (chemc(ji,jj,2) + 2.0 * zxc2 * chemc(ji,jj,3) )   &
+         &           / ( 82.05736 * ztkel ))
+         zfco2 = zpco2atm(ji,jj) * zfugcoeff
+
+         ! Compute CO2 flux for the sea and air
+         zfld = zfco2 * chemc(ji,jj,1) * zkgco2(ji,jj)  ! (mol/L) * (m/s)
+         zflu = zh2co3(ji,jj) * zkgco2(ji,jj)                                   ! (mol/L) (m/s) ?
+         oce_co2(ji,jj) = ( zfld - zflu ) * tmask(ji,jj,1) 
+         ! compute the trend
+         tr(ji,jj,1,jpdic,Krhs) = tr(ji,jj,1,jpdic,Krhs) + oce_co2(ji,jj) * rfact2 / e3t(ji,jj,1,Kmm)
+
+         ! Compute O2 flux 
+         zfld16 = patm(ji,jj) * chemo2(ji,jj,1) * zkgo2(ji,jj)          ! (mol/L) * (m/s)
+         zflu16 = tr(ji,jj,1,jpoxy,Kbb) * zkgo2(ji,jj)
+         zoflx(ji,jj) = ( zfld16 - zflu16 ) * tmask(ji,jj,1)
+         tr(ji,jj,1,jpoxy,Krhs) = tr(ji,jj,1,jpoxy,Krhs) + zoflx(ji,jj) * rfact2 / e3t(ji,jj,1,Kmm)
+      END_2D
 
       IF( iom_use("tcflx") .OR. iom_use("tcflxcum") .OR. kt == nitrst   &
          &                 .OR. (ln_check_mass .AND. kt == nitend) )    &
-         t_oce_co2_flx  = glob_sum( 'p4zflx', oce_co2(:,:) )                    !  Total Flux of Carbon
+         t_oce_co2_flx  = glob_sum( 'p4zflx', oce_co2(:,:) * e1e2t(:,:) * 1000. )                    !  Total Flux of Carbon
       t_oce_co2_flx_cum = t_oce_co2_flx_cum + t_oce_co2_flx       !  Cumulative Total Flux of Carbon
 !      t_atm_co2_flx     = glob_sum( 'p4zflx', satmco2(:,:) * e1e2t(:,:) )       ! Total atmospheric pCO2
       t_atm_co2_flx     =  atcco2      ! Total atmospheric pCO2
  
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
          WRITE(charout, FMT="('flx ')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
       ENDIF
 
       IF( lk_iomput .AND. knt == nrdttrc ) THEN
-         ALLOCATE( zw2d(jpi,jpj) )  
-         IF( iom_use( "Cflx"  ) )  THEN
-            zw2d(:,:) = oce_co2(:,:) / e1e2t(:,:) * rfact2r
-            CALL iom_put( "Cflx"     , zw2d ) 
-         ENDIF
-         IF( iom_use( "Oflx"  ) )  THEN
-            zw2d(:,:) =  zoflx(:,:) * 1000 * tmask(:,:,1)
-            CALL iom_put( "Oflx" , zw2d )
-         ENDIF
-         IF( iom_use( "Kg"    ) )  THEN
-            zw2d(:,:) =  zkgco2(:,:) * tmask(:,:,1)
-            CALL iom_put( "Kg"   , zw2d )
-         ENDIF
-         IF( iom_use( "Dpco2" ) ) THEN
-           zw2d(:,:) = ( zpco2atm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1)
-           CALL iom_put( "Dpco2" ,  zw2d )
-         ENDIF
-         IF( iom_use( "Dpo2" ) )  THEN
-           zw2d(:,:) = ( atcox * patm(:,:) - atcox * trb(:,:,1,jpoxy) / ( chemo2(:,:,1) + rtrn ) ) * tmask(:,:,1)
-           CALL iom_put( "Dpo2"  , zw2d )
-         ENDIF
-         CALL iom_put( "tcflx"    , t_oce_co2_flx * rfact2r )   ! molC/s
-         CALL iom_put( "tcflxcum" , t_oce_co2_flx_cum       )   ! molC
-         !
-         DEALLOCATE( zw2d )
+         CALL iom_put( "AtmCo2"  , satmco2(:,:) * tmask(:,:,1) )   ! Atmospheric CO2 concentration
+         CALL iom_put( "Cflx"    , oce_co2(:,:) * 1000. ) 
+         CALL iom_put( "Oflx"    , zoflx(:,:) * 1000.  )
+         CALL iom_put( "Kg"      , zkgco2(:,:) * tmask(:,:,1)  )
+         CALL iom_put( "Dpco2"   , ( zpco2atm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1) )
+         CALL iom_put( "pCO2sea" , ( zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1) )
+         CALL iom_put( "Dpo2"    , ( atcox * patm(:,:) - atcox * tr(:,:,1,jpoxy,Kbb) / ( chemo2(:,:,1) + rtrn ) ) * tmask(:,:,1) )
+         CALL iom_put( "tcflx"   , t_oce_co2_flx     )   ! molC/s
+         CALL iom_put( "tcflxcum", t_oce_co2_flx_cum )   ! molC
       ENDIF
       !
@@ -239,8 +219,6 @@
       ENDIF
       !
-      REWIND( numnatp_ref )              ! Namelist nampisext in reference namelist : Pisces atm. conditions
       READ  ( numnatp_ref, nampisext, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisext in reference namelist' )
-      REWIND( numnatp_cfg )              ! Namelist nampisext in configuration namelist : Pisces atm. conditions
       READ  ( numnatp_cfg, nampisext, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisext in configuration namelist' )
@@ -320,8 +298,6 @@
          ENDIF
          !
-         REWIND( numnatp_ref )              ! Namelist nampisatm in reference namelist : Pisces atm. sea level pressure file
          READ  ( numnatp_ref, nampisatm, IOSTAT = ios, ERR = 901)
 901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisatm in reference namelist' )
-         REWIND( numnatp_cfg )              ! Namelist nampisatm in configuration namelist : Pisces atm. sea level pressure file 
          READ  ( numnatp_cfg, nampisatm, IOSTAT = ios, ERR = 902 )
 902      IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisatm in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zint.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zint.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zint.F90	(revision 12928)
@@ -26,5 +26,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_int( kt )
+   SUBROUTINE p4z_int( kt, Kbb, Kmm )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_int  ***
@@ -33,5 +33,6 @@
       !!
       !!---------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index
+      INTEGER, INTENT( in ) ::   Kbb, Kmm ! time level indices
       !
       INTEGER  :: ji, jj                 ! dummy loop indices
@@ -43,6 +44,6 @@
       ! Computation of phyto and zoo metabolic rate
       ! -------------------------------------------
-      tgfunc (:,:,:) = EXP( 0.063913 * tsn(:,:,:,jp_tem) )
-      tgfunc2(:,:,:) = EXP( 0.07608  * tsn(:,:,:,jp_tem) )
+      tgfunc (:,:,:) = EXP( 0.063913 * ts(:,:,:,jp_tem,Kmm) )
+      tgfunc2(:,:,:) = EXP( 0.07608  * ts(:,:,:,jp_tem,Kmm) )
 
       ! Computation of the silicon dependant half saturation  constant for silica uptake
@@ -50,5 +51,5 @@
       DO ji = 1, jpi
          DO jj = 1, jpj
-            zvar = trb(ji,jj,1,jpsil) * trb(ji,jj,1,jpsil)
+            zvar = tr(ji,jj,1,jpsil,Kbb) * tr(ji,jj,1,jpsil,Kbb)
             xksimax(ji,jj) = MAX( xksimax(ji,jj), ( 1.+ 7.* zvar / ( xksilim * xksilim + zvar ) ) * 1e-6 )
          END DO
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zligand.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zligand.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zligand.F90	(revision 12928)
@@ -26,4 +26,6 @@
    REAL(wp), PUBLIC ::  prlgw    !: Photochemical of weak ligand
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -33,5 +35,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_ligand( kt, knt )
+   SUBROUTINE p4z_ligand( kt, knt, Kbb, Krhs )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_ligand  ***
@@ -39,10 +41,10 @@
       !! ** Purpose :   Compute remineralization/scavenging of organic ligands
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt, knt ! ocean time step
+      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step
+      INTEGER, INTENT(in)  ::  Kbb, Krhs ! time level indices
       !
       INTEGER  ::   ji, jj, jk
       REAL(wp) ::   zlgwp, zlgwpr, zlgwr, zlablgw
-      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zligrem, zligpr, zrligprod
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zw3d
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zligrem, zligpr, zligprod
       CHARACTER (len=25) ::   charout
       !!---------------------------------------------------------------------
@@ -50,52 +52,43 @@
       IF( ln_timing )   CALL timing_start('p4z_ligand')
       !
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               !
-               ! ------------------------------------------------------------------
-               ! Remineralization of iron ligands
-               ! ------------------------------------------------------------------
-               ! production from remineralisation of organic matter
-               zlgwp = orem(ji,jj,jk) * rlig
-               ! decay of weak ligand
-               ! This is based on the idea that as LGW is lower
-               ! there is a larger fraction of refractory OM
-               zlgwr = max( rlgs , rlgw * exp( -2 * (trb(ji,jj,jk,jplgw)*1e9) ) ) ! years
-               zlgwr = 1. / zlgwr * tgfunc(ji,jj,jk) * ( xstep / nyear_len(1) ) * blim(ji,jj,jk) * trb(ji,jj,jk,jplgw)
-               ! photochem loss of weak ligand
-               zlgwpr = prlgw * xstep * etot(ji,jj,jk) * trb(ji,jj,jk,jplgw) * (1. - fr_i(ji,jj))
-               tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zlgwp - zlgwr - zlgwpr
-               zligrem(ji,jj,jk)   = zlgwr
-               zligpr(ji,jj,jk)    = zlgwpr
-               zrligprod(ji,jj,jk) = zlgwp
-               !
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpkm1 )
+         !
+         ! ------------------------------------------------------------------
+         ! Remineralization of iron ligands
+         ! ------------------------------------------------------------------
+         ! production from remineralisation of organic matter
+         zlgwp = orem(ji,jj,jk) * rlig
+         ! decay of weak ligand
+         ! This is based on the idea that as LGW is lower
+         ! there is a larger fraction of refractory OM
+         zlgwr = max( rlgs , rlgw * exp( -2 * (tr(ji,jj,jk,jplgw,Kbb)*1e9) ) ) ! years
+         zlgwr = 1. / zlgwr * tgfunc(ji,jj,jk) * ( xstep / nyear_len(1) ) * blim(ji,jj,jk) * tr(ji,jj,jk,jplgw,Kbb)
+         ! photochem loss of weak ligand
+         zlgwpr = prlgw * xstep * etot(ji,jj,jk) * tr(ji,jj,jk,jplgw,Kbb) * (1. - fr_i(ji,jj))
+         tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zlgwp - zlgwr - zlgwpr
+         zligrem(ji,jj,jk)   = zlgwr
+         zligpr(ji,jj,jk)    = zlgwpr
+         zligprod(ji,jj,jk) = zlgwp
+         !
+      END_3D
       !
       !  Output of some diagnostics variables
       !     ---------------------------------
       IF( lk_iomput .AND. knt == nrdttrc ) THEN
-         ALLOCATE( zw3d(jpi,jpj,jpk) )
          IF( iom_use( "LIGREM" ) ) THEN
-            zw3d(:,:,:) = zligrem(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:)
-            CALL iom_put( "LIGREM", zw3d )
+           zligrem(:,:,jpk) = 0.  ; CALL iom_put( "LIGREM", zligrem(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) )
          ENDIF
          IF( iom_use( "LIGPR" ) ) THEN
-            zw3d(:,:,:) = zligpr(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) 
-            CALL iom_put( "LIGPR", zw3d )
+           zligpr(:,:,jpk) = 0.   ; CALL iom_put( "LIGPR" , zligpr(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) )
          ENDIF
          IF( iom_use( "LPRODR" ) ) THEN
-            zw3d(:,:,:) = zrligprod(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) 
-            CALL iom_put( "LPRODR", zw3d )
+           zligprod(:,:,jpk) = 0. ; CALL iom_put( "LPRODR", zligprod(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) )
          ENDIF
-         DEALLOCATE( zw3d )
       ENDIF
       !
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
          WRITE(charout, FMT="('ligand1')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
       ENDIF
       !
@@ -125,8 +118,6 @@
          WRITE(numout,*) '~~~~~~~~~~~~~~~'
       ENDIF
-      REWIND( numnatp_ref )              ! Namelist nampislig in reference namelist : Pisces remineralization
       READ  ( numnatp_ref, nampislig, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampislig in reference namelist' )
-      REWIND( numnatp_cfg )              ! Namelist nampislig in configuration namelist : Pisces remineralization
       READ  ( numnatp_cfg, nampislig, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampislig in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zlim.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zlim.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zlim.F90	(revision 12928)
@@ -67,4 +67,6 @@
    REAL(wp) ::  xcoef3   = 1.15E-4 * 14. / 55.85 / 7.625 * 0.5 
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -74,5 +76,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_lim( kt, knt )
+   SUBROUTINE p4z_lim( kt, knt, Kbb, Kmm )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_lim  ***
@@ -84,4 +86,5 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in)  :: kt, knt
+      INTEGER, INTENT(in)  :: Kbb, Kmm      ! time level indices
       !
       INTEGER  ::   ji, jj, jk
@@ -95,129 +98,117 @@
       IF( ln_timing )   CALL timing_start('p4z_lim')
       !
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               
-               ! Tuning of the iron concentration to a minimum level that is set to the detection limit
-               !-------------------------------------
-               zno3    = trb(ji,jj,jk,jpno3) / 40.e-6
-               zferlim = MAX( 3e-11 * zno3 * zno3, 5e-12 )
-               zferlim = MIN( zferlim, 7e-11 )
-               trb(ji,jj,jk,jpfer) = MAX( trb(ji,jj,jk,jpfer), zferlim )
-
-               ! Computation of a variable Ks for iron on diatoms taking into account
-               ! that increasing biomass is made of generally bigger cells
-               !------------------------------------------------
-               zconcd   = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia )
-               zconcd2  = trb(ji,jj,jk,jpdia) - zconcd
-               zconcn   = MAX( 0.e0 , trb(ji,jj,jk,jpphy) - xsizephy )
-               zconcn2  = trb(ji,jj,jk,jpphy) - zconcn
-               z1_trbphy   = 1. / ( trb(ji,jj,jk,jpphy) + rtrn )
-               z1_trbdia   = 1. / ( trb(ji,jj,jk,jpdia) + rtrn )
-
-               concdfe(ji,jj,jk) = MAX( concdfer, ( zconcd2 * concdfer + concdfer * xsizerd * zconcd ) * z1_trbdia )
-               zconc1d           = MAX( concdno3, ( zconcd2 * concdno3 + concdno3 * xsizerd * zconcd ) * z1_trbdia )
-               zconc1dnh4        = MAX( concdnh4, ( zconcd2 * concdnh4 + concdnh4 * xsizerd * zconcd ) * z1_trbdia )
-
-               concnfe(ji,jj,jk) = MAX( concnfer, ( zconcn2 * concnfer + concnfer * xsizern * zconcn ) * z1_trbphy )
-               zconc0n           = MAX( concnno3, ( zconcn2 * concnno3 + concnno3 * xsizern * zconcn ) * z1_trbphy )
-               zconc0nnh4        = MAX( concnnh4, ( zconcn2 * concnnh4 + concnnh4 * xsizern * zconcn ) * z1_trbphy )
-
-               ! Michaelis-Menten Limitation term for nutrients Small bacteria
-               ! -------------------------------------------------------------
-               zdenom = 1. /  ( concbno3 * concbnh4 + concbnh4 * trb(ji,jj,jk,jpno3) + concbno3 * trb(ji,jj,jk,jpnh4) )
-               xnanono3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * concbnh4 * zdenom
-               xnanonh4(ji,jj,jk) = trb(ji,jj,jk,jpnh4) * concbno3 * zdenom
-               !
-               zlim1    = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk)
-               zlim2    = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concbnh4 )
-               zlim3    = trb(ji,jj,jk,jpfer) / ( concbfe + trb(ji,jj,jk,jpfer) )
-               zlim4    = trb(ji,jj,jk,jpdoc) / ( xkdoc   + trb(ji,jj,jk,jpdoc) )
-               xlimbacl(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 )
-               xlimbac (ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) * zlim4
-
-               ! Michaelis-Menten Limitation term for nutrients Small flagellates
-               ! -----------------------------------------------
-               zdenom = 1. /  ( zconc0n * zconc0nnh4 + zconc0nnh4 * trb(ji,jj,jk,jpno3) + zconc0n * trb(ji,jj,jk,jpnh4) )
-               xnanono3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * zconc0nnh4 * zdenom
-               xnanonh4(ji,jj,jk) = trb(ji,jj,jk,jpnh4) * zconc0n    * zdenom
-               !
-               zlim1    = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk)
-               zlim2    = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zconc0nnh4 )
-               zratio   = trb(ji,jj,jk,jpnfe) * z1_trbphy 
-               zironmin = xcoef1 * trb(ji,jj,jk,jpnch) * z1_trbphy + xcoef2 * zlim1 + xcoef3 * xnanono3(ji,jj,jk)
-               zlim3    = MAX( 0.,( zratio - zironmin ) / qnfelim )
-               xnanopo4(ji,jj,jk) = zlim2
-               xlimnfe (ji,jj,jk) = MIN( 1., zlim3 )
-               xlimphy (ji,jj,jk) = MIN( zlim1, zlim2, zlim3 )
-               !
-               !   Michaelis-Menten Limitation term for nutrients Diatoms
-               !   ----------------------------------------------
-               zdenom   = 1. / ( zconc1d * zconc1dnh4 + zconc1dnh4 * trb(ji,jj,jk,jpno3) + zconc1d * trb(ji,jj,jk,jpnh4) )
-               xdiatno3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * zconc1dnh4 * zdenom
-               xdiatnh4(ji,jj,jk) = trb(ji,jj,jk,jpnh4) * zconc1d    * zdenom
-               !
-               zlim1    = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk)
-               zlim2    = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zconc1dnh4  )
-               zlim3    = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi(ji,jj) )
-               zratio   = trb(ji,jj,jk,jpdfe) * z1_trbdia
-               zironmin = xcoef1 * trb(ji,jj,jk,jpdch) * z1_trbdia + xcoef2 * zlim1 + xcoef3 * xdiatno3(ji,jj,jk)
-               zlim4    = MAX( 0., ( zratio - zironmin ) / qdfelim )
-               xdiatpo4(ji,jj,jk) = zlim2
-               xlimdfe (ji,jj,jk) = MIN( 1., zlim4 )
-               xlimdia (ji,jj,jk) = MIN( zlim1, zlim2, zlim3, zlim4 )
-               xlimsi  (ji,jj,jk) = MIN( zlim1, zlim2, zlim4 )
-           END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpkm1 )
+         
+         ! Tuning of the iron concentration to a minimum level that is set to the detection limit
+         !-------------------------------------
+         zno3    = tr(ji,jj,jk,jpno3,Kbb) / 40.e-6
+         zferlim = MAX( 3e-11 * zno3 * zno3, 5e-12 )
+         zferlim = MIN( zferlim, 7e-11 )
+         tr(ji,jj,jk,jpfer,Kbb) = MAX( tr(ji,jj,jk,jpfer,Kbb), zferlim )
+
+         ! Computation of a variable Ks for iron on diatoms taking into account
+         ! that increasing biomass is made of generally bigger cells
+         !------------------------------------------------
+         zconcd   = MAX( 0.e0 , tr(ji,jj,jk,jpdia,Kbb) - xsizedia )
+         zconcd2  = tr(ji,jj,jk,jpdia,Kbb) - zconcd
+         zconcn   = MAX( 0.e0 , tr(ji,jj,jk,jpphy,Kbb) - xsizephy )
+         zconcn2  = tr(ji,jj,jk,jpphy,Kbb) - zconcn
+         z1_trbphy   = 1. / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn )
+         z1_trbdia   = 1. / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
+
+         concdfe(ji,jj,jk) = MAX( concdfer, ( zconcd2 * concdfer + concdfer * xsizerd * zconcd ) * z1_trbdia )
+         zconc1d           = MAX( concdno3, ( zconcd2 * concdno3 + concdno3 * xsizerd * zconcd ) * z1_trbdia )
+         zconc1dnh4        = MAX( concdnh4, ( zconcd2 * concdnh4 + concdnh4 * xsizerd * zconcd ) * z1_trbdia )
+
+         concnfe(ji,jj,jk) = MAX( concnfer, ( zconcn2 * concnfer + concnfer * xsizern * zconcn ) * z1_trbphy )
+         zconc0n           = MAX( concnno3, ( zconcn2 * concnno3 + concnno3 * xsizern * zconcn ) * z1_trbphy )
+         zconc0nnh4        = MAX( concnnh4, ( zconcn2 * concnnh4 + concnnh4 * xsizern * zconcn ) * z1_trbphy )
+
+         ! Michaelis-Menten Limitation term for nutrients Small bacteria
+         ! -------------------------------------------------------------
+         zdenom = 1. /  ( concbno3 * concbnh4 + concbnh4 * tr(ji,jj,jk,jpno3,Kbb) + concbno3 * tr(ji,jj,jk,jpnh4,Kbb) )
+         xnanono3(ji,jj,jk) = tr(ji,jj,jk,jpno3,Kbb) * concbnh4 * zdenom
+         xnanonh4(ji,jj,jk) = tr(ji,jj,jk,jpnh4,Kbb) * concbno3 * zdenom
+         !
+         zlim1    = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk)
+         zlim2    = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + concbnh4 )
+         zlim3    = tr(ji,jj,jk,jpfer,Kbb) / ( concbfe + tr(ji,jj,jk,jpfer,Kbb) )
+         zlim4    = tr(ji,jj,jk,jpdoc,Kbb) / ( xkdoc   + tr(ji,jj,jk,jpdoc,Kbb) )
+         xlimbacl(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 )
+         xlimbac (ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) * zlim4
+
+         ! Michaelis-Menten Limitation term for nutrients Small flagellates
+         ! -----------------------------------------------
+         zdenom = 1. /  ( zconc0n * zconc0nnh4 + zconc0nnh4 * tr(ji,jj,jk,jpno3,Kbb) + zconc0n * tr(ji,jj,jk,jpnh4,Kbb) )
+         xnanono3(ji,jj,jk) = tr(ji,jj,jk,jpno3,Kbb) * zconc0nnh4 * zdenom
+         xnanonh4(ji,jj,jk) = tr(ji,jj,jk,jpnh4,Kbb) * zconc0n    * zdenom
+         !
+         zlim1    = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk)
+         zlim2    = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zconc0nnh4 )
+         zratio   = tr(ji,jj,jk,jpnfe,Kbb) * z1_trbphy 
+         zironmin = xcoef1 * tr(ji,jj,jk,jpnch,Kbb) * z1_trbphy + xcoef2 * zlim1 + xcoef3 * xnanono3(ji,jj,jk)
+         zlim3    = MAX( 0.,( zratio - zironmin ) / qnfelim )
+         xnanopo4(ji,jj,jk) = zlim2
+         xlimnfe (ji,jj,jk) = MIN( 1., zlim3 )
+         xlimphy (ji,jj,jk) = MIN( zlim1, zlim2, zlim3 )
+         !
+         !   Michaelis-Menten Limitation term for nutrients Diatoms
+         !   ----------------------------------------------
+         zdenom   = 1. / ( zconc1d * zconc1dnh4 + zconc1dnh4 * tr(ji,jj,jk,jpno3,Kbb) + zconc1d * tr(ji,jj,jk,jpnh4,Kbb) )
+         xdiatno3(ji,jj,jk) = tr(ji,jj,jk,jpno3,Kbb) * zconc1dnh4 * zdenom
+         xdiatnh4(ji,jj,jk) = tr(ji,jj,jk,jpnh4,Kbb) * zconc1d    * zdenom
+         !
+         zlim1    = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk)
+         zlim2    = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zconc1dnh4  )
+         zlim3    = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi(ji,jj) )
+         zratio   = tr(ji,jj,jk,jpdfe,Kbb) * z1_trbdia
+         zironmin = xcoef1 * tr(ji,jj,jk,jpdch,Kbb) * z1_trbdia + xcoef2 * zlim1 + xcoef3 * xdiatno3(ji,jj,jk)
+         zlim4    = MAX( 0., ( zratio - zironmin ) / qdfelim )
+         xdiatpo4(ji,jj,jk) = zlim2
+         xlimdfe (ji,jj,jk) = MIN( 1., zlim4 )
+         xlimdia (ji,jj,jk) = MIN( zlim1, zlim2, zlim3, zlim4 )
+         xlimsi  (ji,jj,jk) = MIN( zlim1, zlim2, zlim4 )
+      END_3D
 
       ! Compute the fraction of nanophytoplankton that is made of calcifiers
       ! --------------------------------------------------------------------
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zlim1 =  ( trb(ji,jj,jk,jpno3) * concnnh4 + trb(ji,jj,jk,jpnh4) * concnno3 )    &
-                  &   / ( concnno3 * concnnh4 + concnnh4 * trb(ji,jj,jk,jpno3) + concnno3 * trb(ji,jj,jk,jpnh4) ) 
-               zlim2  = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concnnh4 )
-               zlim3  = trb(ji,jj,jk,jpfer) / ( trb(ji,jj,jk,jpfer) +  5.E-11   )
-               ztem1  = MAX( 0., tsn(ji,jj,jk,jp_tem) )
-               ztem2  = tsn(ji,jj,jk,jp_tem) - 10.
-               zetot1 = MAX( 0., etot_ndcy(ji,jj,jk) - 1.) / ( 4. + etot_ndcy(ji,jj,jk) ) 
-               zetot2 = 30. / ( 30. + etot_ndcy(ji,jj,jk) ) 
-
-               xfracal(ji,jj,jk) = caco3r * MIN( zlim1, zlim2, zlim3 )                  &
-                  &                       * ztem1 / ( 0.1 + ztem1 )                     &
-                  &                       * MAX( 1., trb(ji,jj,jk,jpphy) * 1.e6 / 2. )  &
-                  &                       * zetot1 * zetot2               &
-                  &                       * ( 1. + EXP(-ztem2 * ztem2 / 25. ) )         &
-                  &                       * MIN( 1., 50. / ( hmld(ji,jj) + rtrn ) )
-               xfracal(ji,jj,jk) = MIN( 0.8 , xfracal(ji,jj,jk) )
-               xfracal(ji,jj,jk) = MAX( 0.02, xfracal(ji,jj,jk) )
-            END DO
-         END DO
-      END DO
-      !
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ! denitrification factor computed from O2 levels
-               nitrfac(ji,jj,jk) = MAX(  0.e0, 0.4 * ( 6.e-6  - trb(ji,jj,jk,jpoxy) )    &
-                  &                                / ( oxymin + trb(ji,jj,jk,jpoxy) )  )
-               nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) )
-               !
-               ! denitrification factor computed from NO3 levels
-               nitrfac2(ji,jj,jk) = MAX( 0.e0,       ( 1.E-6 - trb(ji,jj,jk,jpno3) )  &
-                  &                                / ( 1.E-6 + trb(ji,jj,jk,jpno3) ) )
-               nitrfac2(ji,jj,jk) = MIN( 1., nitrfac2(ji,jj,jk) )
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpkm1 )
+         zlim1 =  ( tr(ji,jj,jk,jpno3,Kbb) * concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) * concnno3 )    &
+            &   / ( concnno3 * concnnh4 + concnnh4 * tr(ji,jj,jk,jpno3,Kbb) + concnno3 * tr(ji,jj,jk,jpnh4,Kbb) ) 
+         zlim2  = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + concnnh4 )
+         zlim3  = tr(ji,jj,jk,jpfer,Kbb) / ( tr(ji,jj,jk,jpfer,Kbb) +  5.E-11   )
+         ztem1  = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) )
+         ztem2  = ts(ji,jj,jk,jp_tem,Kmm) - 10.
+         zetot1 = MAX( 0., etot_ndcy(ji,jj,jk) - 1.) / ( 4. + etot_ndcy(ji,jj,jk) ) 
+         zetot2 = 30. / ( 30. + etot_ndcy(ji,jj,jk) ) 
+
+         xfracal(ji,jj,jk) = caco3r * MIN( zlim1, zlim2, zlim3 )                  &
+            &                       * ztem1 / ( 0.1 + ztem1 )                     &
+            &                       * MAX( 1., tr(ji,jj,jk,jpphy,Kbb) * 1.e6 / 2. )  &
+            &                       * zetot1 * zetot2               &
+            &                       * ( 1. + EXP(-ztem2 * ztem2 / 25. ) )         &
+            &                       * MIN( 1., 50. / ( hmld(ji,jj) + rtrn ) )
+         xfracal(ji,jj,jk) = MIN( 0.8 , xfracal(ji,jj,jk) )
+         xfracal(ji,jj,jk) = MAX( 0.02, xfracal(ji,jj,jk) )
+      END_3D
+      !
+      DO_3D_11_11( 1, jpkm1 )
+         ! denitrification factor computed from O2 levels
+         nitrfac(ji,jj,jk) = MAX(  0.e0, 0.4 * ( 6.e-6  - tr(ji,jj,jk,jpoxy,Kbb) )    &
+            &                                / ( oxymin + tr(ji,jj,jk,jpoxy,Kbb) )  )
+         nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) )
+         !
+         ! denitrification factor computed from NO3 levels
+         nitrfac2(ji,jj,jk) = MAX( 0.e0,       ( 1.E-6 - tr(ji,jj,jk,jpno3,Kbb) )  &
+            &                                / ( 1.E-6 + tr(ji,jj,jk,jpno3,Kbb) ) )
+         nitrfac2(ji,jj,jk) = MIN( 1., nitrfac2(ji,jj,jk) )
+      END_3D
       !
       IF( lk_iomput .AND. knt == nrdttrc ) THEN        ! save output diagnostics
-        IF( iom_use( "xfracal" ) )   CALL iom_put( "xfracal", xfracal(:,:,:) * tmask(:,:,:) )  ! euphotic layer deptht
-        IF( iom_use( "LNnut"   ) )   CALL iom_put( "LNnut"  , xlimphy(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term
-        IF( iom_use( "LDnut"   ) )   CALL iom_put( "LDnut"  , xlimdia(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term
-        IF( iom_use( "LNFe"    ) )   CALL iom_put( "LNFe"   , xlimnfe(:,:,:) * tmask(:,:,:) )  ! Iron limitation term
-        IF( iom_use( "LDFe"    ) )   CALL iom_put( "LDFe"   , xlimdfe(:,:,:) * tmask(:,:,:) )  ! Iron limitation term
+        CALL iom_put( "xfracal", xfracal(:,:,:) * tmask(:,:,:) )  ! euphotic layer deptht
+        CALL iom_put( "LNnut"  , xlimphy(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term
+        CALL iom_put( "LDnut"  , xlimdia(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term
+        CALL iom_put( "LNFe"   , xlimnfe(:,:,:) * tmask(:,:,:) )  ! Iron limitation term
+        CALL iom_put( "LDFe"   , xlimdfe(:,:,:) * tmask(:,:,:) )  ! Iron limitation term
       ENDIF
       !
@@ -252,8 +243,6 @@
       ENDIF
       !
-      REWIND( numnatp_ref )              ! Namelist nampislim in reference namelist : Pisces nutrient limitation parameters
       READ  ( numnatp_ref, namp4zlim, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namp4zlim in reference namelist' )
-      REWIND( numnatp_cfg )              ! Namelist nampislim in configuration namelist : Pisces nutrient limitation parameters 
       READ  ( numnatp_cfg, namp4zlim, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namp4zlim in configuration namelist' )
@@ -284,5 +273,11 @@
       ENDIF
       !
-      nitrfac (:,:,:) = 0._wp
+      nitrfac (:,:,jpk) = 0._wp
+      nitrfac2(:,:,jpk) = 0._wp
+      xfracal (:,:,jpk) = 0._wp
+      xlimphy (:,:,jpk) = 0._wp
+      xlimdia (:,:,jpk) = 0._wp
+      xlimnfe (:,:,jpk) = 0._wp
+      xlimdfe (:,:,jpk) = 0._wp
       !
    END SUBROUTINE p4z_lim_init
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zlys.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zlys.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zlys.F90	(revision 12928)
@@ -35,4 +35,6 @@
    REAL(wp) ::   calcon = 1.03E-2   ! mean calcite concentration [Ca2+] in sea water [mole/kg solution]
  
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -43,5 +45,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_lys( kt, knt )
+   SUBROUTINE p4z_lys( kt, knt, Kbb, Krhs )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_lys  ***
@@ -54,4 +56,5 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt, knt   ! ocean time step and ???
+      INTEGER, INTENT(in)  ::  Kbb, Krhs ! time level indices
       !
       INTEGER  ::   ji, jj, jk, jn
@@ -64,6 +67,4 @@
       IF( ln_timing )  CALL timing_start('p4z_lys')
       !
-      zco3    (:,:,:) = 0.
-      zcaldiss(:,:,:) = 0.
       zhinit  (:,:,:) = hi(:,:,:) * 1000. / ( rhop(:,:,:) + rtrn )
       !
@@ -72,15 +73,11 @@
       !     -------------------------------------------
 
-      CALL solve_at_general( zhinit, zhi )
+      CALL solve_at_general( zhinit, zhi, Kbb )
 
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zco3(ji,jj,jk) = trb(ji,jj,jk,jpdic) * ak13(ji,jj,jk) * ak23(ji,jj,jk) / (zhi(ji,jj,jk)**2   &
-                  &             + ak13(ji,jj,jk) * zhi(ji,jj,jk) + ak13(ji,jj,jk) * ak23(ji,jj,jk) + rtrn )
-               hi  (ji,jj,jk) = zhi(ji,jj,jk) * rhop(ji,jj,jk) / 1000.
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpkm1 )
+         zco3(ji,jj,jk) = tr(ji,jj,jk,jpdic,Kbb) * ak13(ji,jj,jk) * ak23(ji,jj,jk) / (zhi(ji,jj,jk)**2   &
+            &             + ak13(ji,jj,jk) * zhi(ji,jj,jk) + ak13(ji,jj,jk) * ak23(ji,jj,jk) + rtrn )
+         hi  (ji,jj,jk) = zhi(ji,jj,jk) * rhop(ji,jj,jk) / 1000.
+      END_3D
 
       !     ---------------------------------------------------------
@@ -90,47 +87,49 @@
       !     ---------------------------------------------------------
 
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
+      DO_3D_11_11( 1, jpkm1 )
 
-               ! DEVIATION OF [CO3--] FROM SATURATION VALUE
-               ! Salinity dependance in zomegaca and divide by rhop/1000 to have good units
-               zcalcon  = calcon * ( salinprac(ji,jj,jk) / 35._wp )
-               zfact    = rhop(ji,jj,jk) / 1000._wp
-               zomegaca = ( zcalcon * zco3(ji,jj,jk) ) / ( aksp(ji,jj,jk) * zfact + rtrn )
-               zco3sat(ji,jj,jk) = aksp(ji,jj,jk) * zfact / ( zcalcon + rtrn )
+         ! DEVIATION OF [CO3--] FROM SATURATION VALUE
+         ! Salinity dependance in zomegaca and divide by rhop/1000 to have good units
+         zcalcon  = calcon * ( salinprac(ji,jj,jk) / 35._wp )
+         zfact    = rhop(ji,jj,jk) / 1000._wp
+         zomegaca = ( zcalcon * zco3(ji,jj,jk) ) / ( aksp(ji,jj,jk) * zfact + rtrn )
+         zco3sat(ji,jj,jk) = aksp(ji,jj,jk) * zfact / ( zcalcon + rtrn )
 
-               ! SET DEGREE OF UNDER-/SUPERSATURATION
-               excess(ji,jj,jk) = 1._wp - zomegaca
-               zexcess0 = MAX( 0., excess(ji,jj,jk) )
-               zexcess  = zexcess0**nca
+         ! SET DEGREE OF UNDER-/SUPERSATURATION
+         excess(ji,jj,jk) = 1._wp - zomegaca
+         zexcess0 = MAX( 0., excess(ji,jj,jk) )
+         zexcess  = zexcess0**nca
 
-               ! AMOUNT CACO3 (12C) THAT RE-ENTERS SOLUTION
-               !       (ACCORDING TO THIS FORMULATION ALSO SOME PARTICULATE
-               !       CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION)
-               zdispot = kdca * zexcess * trb(ji,jj,jk,jpcal)
-              !  CHANGE OF [CO3--] , [ALK], PARTICULATE [CACO3],
-              !       AND [SUM(CO2)] DUE TO CACO3 DISSOLUTION/PRECIPITATION
-              zcaldiss(ji,jj,jk)  = zdispot * rfact2 / rmtss ! calcite dissolution
-              !
-              tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * zcaldiss(ji,jj,jk)
-              tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) -      zcaldiss(ji,jj,jk)
-              tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) +      zcaldiss(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+         ! AMOUNT CACO3 (12C) THAT RE-ENTERS SOLUTION
+         !       (ACCORDING TO THIS FORMULATION ALSO SOME PARTICULATE
+         !       CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION)
+         zdispot = kdca * zexcess * tr(ji,jj,jk,jpcal,Kbb)
+        !  CHANGE OF [CO3--] , [ALK], PARTICULATE [CACO3],
+        !       AND [SUM(CO2)] DUE TO CACO3 DISSOLUTION/PRECIPITATION
+        zcaldiss(ji,jj,jk)  = zdispot * rfact2 / rmtss ! calcite dissolution
+        !
+        tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + 2. * zcaldiss(ji,jj,jk)
+        tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) -      zcaldiss(ji,jj,jk)
+        tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) +      zcaldiss(ji,jj,jk)
+      END_3D
       !
 
       IF( lk_iomput .AND. knt == nrdttrc ) THEN
-         IF( iom_use( "PH"     ) ) CALL iom_put( "PH"    , -1. * LOG10( MAX( hi(:,:,:), rtrn ) ) * tmask(:,:,:) )
-         IF( iom_use( "CO3"    ) ) CALL iom_put( "CO3"   , zco3(:,:,:)     * 1.e+3               * tmask(:,:,:) )
-         IF( iom_use( "CO3sat" ) ) CALL iom_put( "CO3sat", zco3sat(:,:,:)  * 1.e+3               * tmask(:,:,:) )
-         IF( iom_use( "DCAL"   ) ) CALL iom_put( "DCAL"  , zcaldiss(:,:,:) * 1.e+3 * rfact2r     * tmask(:,:,:) )
+         CALL iom_put( "PH" , -1. * LOG10( MAX( hi(:,:,:), rtrn ) ) * tmask(:,:,:) )
+         IF( iom_use( "CO3" ) ) THEN
+            zco3(:,:,jpk) = 0.    ; CALL iom_put( "CO3"   , zco3(:,:,:)     * 1.e+3           * tmask(:,:,:) )
+         ENDIF
+         IF( iom_use( "CO3sat" ) ) THEN
+           zco3sat(:,:,jpk) = 0.  ; CALL iom_put( "CO3sat", zco3sat(:,:,:)  * 1.e+3           * tmask(:,:,:) )
+         ENDIF
+         IF( iom_use( "DCAL" ) ) THEN
+           zcaldiss(:,:,jpk) = 0. ; CALL iom_put( "DCAL"  , zcaldiss(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) )
+         ENDIF              
       ENDIF
       !
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
         WRITE(charout, FMT="('lys ')")
         CALL prt_ctl_trc_info(charout)
-        CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+        CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
       ENDIF
       !
@@ -162,8 +161,6 @@
       ENDIF
       !
-      REWIND( numnatp_ref )              ! Namelist nampiscal in reference namelist : Pisces CaCO3 dissolution
       READ  ( numnatp_ref, nampiscal, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampiscal in reference namelist' )
-      REWIND( numnatp_cfg )              ! Namelist nampiscal in configuration namelist : Pisces CaCO3 dissolution
       READ  ( numnatp_cfg, nampiscal, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampiscal in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zmeso.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zmeso.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zmeso.F90	(revision 12928)
@@ -44,4 +44,6 @@
    REAL(wp), PUBLIC ::  grazflux     !: mesozoo flux feeding rate
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -51,5 +53,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_meso( kt, knt )
+   SUBROUTINE p4z_meso( kt, knt, Kbb, Krhs )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_meso  ***
@@ -60,4 +62,5 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt, knt   ! ocean time step and ???
+      INTEGER, INTENT(in)  ::  Kbb, Krhs ! time level indices
       !
       INTEGER  :: ji, jj, jk
@@ -66,197 +69,183 @@
       REAL(wp) :: zfact   , zfood, zfoodlim, zproport, zbeta
       REAL(wp) :: zmortzgoc, zfrac, zfracfe, zratio, zratio2, zfracal, zgrazcal
-      REAL(wp) :: zepsherf, zepshert, zepsherv, zgrarsig, zgraztotc, zgraztotn, zgraztotf
+      REAL(wp) :: zepsherf, zepshert, zepsherv, zepsherq 
+      REAL(wp) :: zgrarsig, zgraztotc, zgraztotn, zgraztotf
       REAL(wp) :: zgrarem2, zgrafer2, zgrapoc2, zprcaca, zmortz, zgrasrat, zgrasratn
       REAL(wp) :: zrespz, ztortz, zgrazd, zgrazz, zgrazpof
       REAL(wp) :: zgrazn, zgrazpoc, zgraznf, zgrazf
       REAL(wp) :: zgrazfffp, zgrazfffg, zgrazffep, zgrazffeg
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing2, zfezoo2, zz2ligprod
       CHARACTER (len=25) :: charout
-      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zfezoo2
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zw3d, zz2ligprod
       !!---------------------------------------------------------------------
       !
       IF( ln_timing )   CALL timing_start('p4z_meso')
       !
-      zgrazing(:,:,:) = 0._wp
-      zfezoo2 (:,:,:) = 0._wp
-      !
-      IF (ln_ligand) THEN
-         ALLOCATE( zz2ligprod(jpi,jpj,jpk) )
-         zz2ligprod(:,:,:) = 0._wp
+      DO_3D_11_11( 1, jpkm1 )
+         zcompam   = MAX( ( tr(ji,jj,jk,jpmes,Kbb) - 1.e-9 ), 0.e0 )
+         zfact     = xstep * tgfunc2(ji,jj,jk) * zcompam
+
+         !  Respiration rates of both zooplankton
+         !  -------------------------------------
+         zrespz    = resrat2 * zfact * ( tr(ji,jj,jk,jpmes,Kbb) / ( xkmort + tr(ji,jj,jk,jpmes,Kbb) )  &
+         &           + 3. * nitrfac(ji,jj,jk) )
+
+         !  Zooplankton mortality. A square function has been selected with
+         !  no real reason except that it seems to be more stable and may mimic predation
+         !  ---------------------------------------------------------------
+         ztortz    = mzrat2 * 1.e6 * zfact * tr(ji,jj,jk,jpmes,Kbb)  * (1. - nitrfac(ji,jj,jk) )
+         !
+         zcompadi  = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - xthresh2dia ), 0.e0 )
+         zcompaz   = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - xthresh2zoo ), 0.e0 )
+         zcompapoc = MAX( ( tr(ji,jj,jk,jppoc,Kbb) - xthresh2poc ), 0.e0 )
+         ! Size effect of nanophytoplankton on grazing : the smaller it is, the less prone
+         ! it is to predation by mesozooplankton
+         ! -------------------------------------------------------------------------------
+         zcompaph  = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - xthresh2phy ), 0.e0 ) &
+            &      * MIN(1., MAX( 0., ( quotan(ji,jj,jk) - 0.2) / 0.3 ) )
+
+         !   Mesozooplankton grazing
+         !   ------------------------
+         zfood     = xpref2d * zcompadi + xpref2z * zcompaz + xpref2n * zcompaph + xpref2c * zcompapoc 
+         zfoodlim  = MAX( 0., zfood - MIN( 0.5 * zfood, xthresh2 ) )
+         zdenom    = zfoodlim / ( xkgraz2 + zfoodlim )
+         zdenom2   = zdenom / ( zfood + rtrn )
+         zgraze2   = grazrat2 * xstep * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpmes,Kbb) * (1. - nitrfac(ji,jj,jk)) 
+
+         zgrazd    = zgraze2  * xpref2d  * zcompadi  * zdenom2 
+         zgrazz    = zgraze2  * xpref2z  * zcompaz   * zdenom2 
+         zgrazn    = zgraze2  * xpref2n  * zcompaph  * zdenom2 
+         zgrazpoc  = zgraze2  * xpref2c  * zcompapoc * zdenom2 
+
+         zgraznf   = zgrazn   * tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn)
+         zgrazf    = zgrazd   * tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn)
+         zgrazpof  = zgrazpoc * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn)
+
+         !  Mesozooplankton flux feeding on GOC
+         !  ----------------------------------
+         zgrazffeg = grazflux  * xstep * wsbio4(ji,jj,jk)      &
+         &           * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpgoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb) &
+         &           * (1. - nitrfac(ji,jj,jk))
+         zgrazfffg = zgrazffeg * tr(ji,jj,jk,jpbfe,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn)
+         zgrazffep = grazflux  * xstep *  wsbio3(ji,jj,jk)     &
+         &           * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb) &
+         &           * (1. - nitrfac(ji,jj,jk))
+         zgrazfffp = zgrazffep * tr(ji,jj,jk,jpsfe,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn)
+         !
+         zgraztotc = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep + zgrazffeg
+         ! Compute the proportion of filter feeders
+         zproport  = (zgrazffep + zgrazffeg)/(rtrn + zgraztotc)
+         ! Compute fractionation of aggregates. It is assumed that 
+         ! diatoms based aggregates are more prone to fractionation
+         ! since they are more porous (marine snow instead of fecal pellets)
+         zratio    = tr(ji,jj,jk,jpgsi,Kbb) / ( tr(ji,jj,jk,jpgoc,Kbb) + rtrn )
+         zratio2   = zratio * zratio
+         zfrac     = zproport * grazflux  * xstep * wsbio4(ji,jj,jk)      &
+         &          * tr(ji,jj,jk,jpgoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb)          &
+         &          * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) )
+         zfracfe   = zfrac * tr(ji,jj,jk,jpbfe,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn)
+
+         zgrazffep = zproport * zgrazffep
+         zgrazffeg = zproport * zgrazffeg
+         zgrazfffp = zproport * zgrazfffp
+         zgrazfffg = zproport * zgrazfffg
+         zgraztotc = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep + zgrazffeg
+         zgraztotn = zgrazd * quotad(ji,jj,jk) + zgrazz + zgrazn * quotan(ji,jj,jk)   &
+         &   + zgrazpoc + zgrazffep + zgrazffeg
+         zgraztotf = zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfffp + zgrazfffg
+
+         ! Total grazing ( grazing by microzoo is already computed in p4zmicro )
+         zgrazing2(ji,jj,jk) = zgraztotc
+
+         ! Mesozooplankton efficiency. 
+         ! We adopt a formulation proposed by Mitra et al. (2007)
+         ! The gross growth efficiency is controled by the most limiting nutrient.
+         ! Growth is also further decreased when the food quality is poor. This is currently
+         ! hard coded : it can be decreased by up to 50% (zepsherq)
+         ! GGE can also be decreased when food quantity is high, zepsherf (Montagnes and 
+         ! Fulton, 2012)
+         ! -----------------------------------------------------------------------------------
+         zgrasrat  =  ( zgraztotf + rtrn )/ ( zgraztotc + rtrn )
+         zgrasratn =  ( zgraztotn + rtrn )/ ( zgraztotc + rtrn )
+         zepshert  = MIN( 1., zgrasratn, zgrasrat / ferat3)
+         zbeta     = MAX(0., (epsher2 - epsher2min) )
+         zepsherf  = epsher2min + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) 
+         zepsherq  = 0.5 + (1.0 - 0.5) * zepshert * ( 1.0 + 1.0 ) / ( zepshert + 1.0 )
+         zepsherv  = zepsherf * zepshert * zepsherq 
+
+         zgrarem2  = zgraztotc * ( 1. - zepsherv - unass2 ) &
+         &         + ( 1. - epsher2 - unass2 ) / ( 1. - epsher2 ) * ztortz
+         zgrafer2  = zgraztotc * MAX( 0. , ( 1. - unass2 ) * zgrasrat - ferat3 * zepsherv )    &
+         &         + ferat3 * ( ( 1. - epsher2 - unass2 ) /( 1. - epsher2 ) * ztortz )
+         zgrapoc2  = zgraztotc * unass2
+
+
+         !   Update the arrays TRA which contain the biological sources and sinks
+         zgrarsig  = zgrarem2 * sigma2
+         tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarsig
+         tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgrarsig
+         tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgrarem2 - zgrarsig
+         !
+         IF( ln_ligand ) THEN 
+            tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + (zgrarem2 - zgrarsig) * ldocz
+            zz2ligprod(ji,jj,jk) = (zgrarem2 - zgrarsig) * ldocz
+         ENDIF
+         !
+         tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarsig
+         tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgrafer2
+         zfezoo2(ji,jj,jk)   = zgrafer2
+         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrarsig
+         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zgrarsig              
+
+         zmortz = ztortz + zrespz
+         zmortzgoc = unass2 / ( 1. - epsher2 ) * ztortz + zrespz
+         tr(ji,jj,jk,jpmes,Krhs) = tr(ji,jj,jk,jpmes,Krhs) - zmortz + zepsherv * zgraztotc 
+         tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zgrazd
+         tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) - zgrazz
+         tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zgrazn
+         tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zgrazn * tr(ji,jj,jk,jpnch,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn )
+         tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zgrazd * tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
+         tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zgrazd * tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
+         tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zgrazd * tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
+         tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zgraznf
+         tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zgrazf
+
+         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zgrazpoc - zgrazffep + zfrac
+         prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfrac
+         conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep
+         tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zmortzgoc - zgrazffeg + zgrapoc2 - zfrac
+         prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zmortzgoc + zgrapoc2
+         consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfrac
+         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zgrazpof - zgrazfffp + zfracfe
+         tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + ferat3 * zmortzgoc - zgrazfffg     &
+           &                + zgraztotf * unass2 - zfracfe
+         zfracal = tr(ji,jj,jk,jpcal,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + tr(ji,jj,jk,jpgoc,Kbb) + rtrn )
+         zgrazcal = (zgrazffeg + zgrazpoc) * (1. - part2) * zfracal
+         ! calcite production
+         zprcaca = xfracal(ji,jj,jk) * zgrazn
+         prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo)
+         !
+         zprcaca = part2 * zprcaca
+         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrazcal - zprcaca
+         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * ( zgrazcal + zprcaca )
+         tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) - zgrazcal + zprcaca
+      END_3D
+      !
+      IF( lk_iomput .AND. knt == nrdttrc ) THEN
+        CALL iom_put( "PCAL"  , prodcal(:,:,:) * 1.e+3  * rfact2r * tmask(:,:,:) )  !  Calcite production 
+        IF( iom_use("GRAZ2") ) THEN  !   Total grazing of phyto by zooplankton
+           zgrazing2(:,:,jpk) = 0._wp ;  CALL iom_put( "GRAZ2" , zgrazing2(:,:,:) * 1.e+3  * rfact2r * tmask(:,:,:) ) 
+         ENDIF
+         IF( iom_use("FEZOO2") ) THEN  
+           zfezoo2 (:,:,jpk) = 0._wp ; CALL iom_put( "FEZOO2", zfezoo2(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) )
+         ENDIF
+         IF( ln_ligand ) THEN
+            zz2ligprod(:,:,jpk) = 0._wp ; CALL iom_put( "LPRODZ2", zz2ligprod(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:)  )
+         ENDIF
       ENDIF
       !
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zcompam   = MAX( ( trb(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 )
-               zfact     = xstep * tgfunc2(ji,jj,jk) * zcompam
-
-               !  Respiration rates of both zooplankton
-               !  -------------------------------------
-               zrespz    = resrat2 * zfact * ( trb(ji,jj,jk,jpmes) / ( xkmort + trb(ji,jj,jk,jpmes) )  &
-               &           + 3. * nitrfac(ji,jj,jk) )
-
-               !  Zooplankton mortality. A square function has been selected with
-               !  no real reason except that it seems to be more stable and may mimic predation
-               !  ---------------------------------------------------------------
-               ztortz    = mzrat2 * 1.e6 * zfact * trb(ji,jj,jk,jpmes)  * (1. - nitrfac(ji,jj,jk) )
-               !
-               zcompadi  = MAX( ( trb(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 )
-               zcompaz   = MAX( ( trb(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 )
-               zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthresh2poc ), 0.e0 )
-               ! Size effect of nanophytoplankton on grazing : the smaller it is, the less prone
-               ! it is to predation by mesozooplankton
-               ! -------------------------------------------------------------------------------
-               zcompaph  = MAX( ( trb(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 ) &
-                  &      * MIN(1., MAX( 0., ( quotan(ji,jj,jk) - 0.2) / 0.3 ) )
-
-               !   Mesozooplankton grazing
-               !   ------------------------
-               zfood     = xpref2d * zcompadi + xpref2z * zcompaz + xpref2n * zcompaph + xpref2c * zcompapoc 
-               zfoodlim  = MAX( 0., zfood - MIN( 0.5 * zfood, xthresh2 ) )
-               zdenom    = zfoodlim / ( xkgraz2 + zfoodlim )
-               zdenom2   = zdenom / ( zfood + rtrn )
-               zgraze2   = grazrat2 * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpmes) * (1. - nitrfac(ji,jj,jk)) 
-
-               zgrazd    = zgraze2  * xpref2d  * zcompadi  * zdenom2 
-               zgrazz    = zgraze2  * xpref2z  * zcompaz   * zdenom2 
-               zgrazn    = zgraze2  * xpref2n  * zcompaph  * zdenom2 
-               zgrazpoc  = zgraze2  * xpref2c  * zcompapoc * zdenom2 
-
-               zgraznf   = zgrazn   * trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn)
-               zgrazf    = zgrazd   * trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn)
-               zgrazpof  = zgrazpoc * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn)
-
-               !  Mesozooplankton flux feeding on GOC
-               !  ----------------------------------
-               zgrazffeg = grazflux  * xstep * wsbio4(ji,jj,jk)      &
-               &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes) &
-               &           * (1. - nitrfac(ji,jj,jk))
-               zgrazfffg = zgrazffeg * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn)
-               zgrazffep = grazflux  * xstep *  wsbio3(ji,jj,jk)     &
-               &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpmes) &
-               &           * (1. - nitrfac(ji,jj,jk))
-               zgrazfffp = zgrazffep * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn)
-               !
-               zgraztotc = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep + zgrazffeg
-               ! Compute the proportion of filter feeders
-               zproport  = (zgrazffep + zgrazffeg)/(rtrn + zgraztotc)
-               ! Compute fractionation of aggregates. It is assumed that 
-               ! diatoms based aggregates are more prone to fractionation
-               ! since they are more porous (marine snow instead of fecal pellets)
-               zratio    = trb(ji,jj,jk,jpgsi) / ( trb(ji,jj,jk,jpgoc) + rtrn )
-               zratio2   = zratio * zratio
-               zfrac     = zproport * grazflux  * xstep * wsbio4(ji,jj,jk)      &
-               &          * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes)          &
-               &          * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) )
-               zfracfe   = zfrac * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn)
-
-               zgrazffep = zproport * zgrazffep
-               zgrazffeg = zproport * zgrazffeg
-               zgrazfffp = zproport * zgrazfffp
-               zgrazfffg = zproport * zgrazfffg
-               zgraztotc = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep + zgrazffeg
-               zgraztotn = zgrazd * quotad(ji,jj,jk) + zgrazz + zgrazn * quotan(ji,jj,jk)   &
-               &   + zgrazpoc + zgrazffep + zgrazffeg
-               zgraztotf = zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfffp + zgrazfffg
-
-               ! Total grazing ( grazing by microzoo is already computed in p4zmicro )
-               zgrazing(ji,jj,jk) = zgraztotc
-
-               !    Mesozooplankton efficiency
-               !    --------------------------
-               zgrasrat  =  ( zgraztotf + rtrn )/ ( zgraztotc + rtrn )
-               zgrasratn =  ( zgraztotn + rtrn )/ ( zgraztotc + rtrn )
-               zepshert  = MIN( 1., zgrasratn, zgrasrat / ferat3)
-               zbeta     = MAX(0., (epsher2 - epsher2min) )
-               zepsherf  = epsher2min + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) 
-               zepsherv  = zepsherf * zepshert 
-
-               zgrarem2  = zgraztotc * ( 1. - zepsherv - unass2 ) &
-               &         + ( 1. - epsher2 - unass2 ) / ( 1. - epsher2 ) * ztortz
-               zgrafer2  = zgraztotc * MAX( 0. , ( 1. - unass2 ) * zgrasrat - ferat3 * zepsherv )    &
-               &         + ferat3 * ( ( 1. - epsher2 - unass2 ) /( 1. - epsher2 ) * ztortz )
-               zgrapoc2  = zgraztotc * unass2
-
-               !   Update the arrays TRA which contain the biological sources and sinks
-               zgrarsig  = zgrarem2 * sigma2
-               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarsig
-               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig
-               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem2 - zgrarsig
-               !
-               IF( ln_ligand ) THEN 
-                  tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + (zgrarem2 - zgrarsig) * ldocz
-                  zz2ligprod(ji,jj,jk) = (zgrarem2 - zgrarsig) * ldocz
-               ENDIF
-               !
-               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig
-               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer2
-               zfezoo2(ji,jj,jk)   = zgrafer2
-               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarsig
-               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgrarsig              
-
-               zmortz = ztortz + zrespz
-               zmortzgoc = unass2 / ( 1. - epsher2 ) * ztortz + zrespz
-               tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) - zmortz + zepsherv * zgraztotc 
-               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazd
-               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz
-               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazn
-               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazn * trb(ji,jj,jk,jpnch) / ( trb(ji,jj,jk,jpphy) + rtrn )
-               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazd * trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn )
-               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazd * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn )
-               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazd * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn )
-               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf
-               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazf
-
-               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc - zgrazffep + zfrac
-               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfrac
-               conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep
-               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zmortzgoc - zgrazffeg + zgrapoc2 - zfrac
-               prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zmortzgoc + zgrapoc2
-               consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfrac
-               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof - zgrazfffp + zfracfe
-               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ferat3 * zmortzgoc - zgrazfffg     &
-                 &                + zgraztotf * unass2 - zfracfe
-               zfracal = trb(ji,jj,jk,jpcal) / (trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + rtrn )
-               zgrazcal = (zgrazffeg + zgrazpoc) * (1. - part2) * zfracal
-               ! calcite production
-               zprcaca = xfracal(ji,jj,jk) * zgrazn
-               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo)
-               !
-               zprcaca = part2 * zprcaca
-               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrazcal - zprcaca
-               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * ( zgrazcal + zprcaca )
-               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) - zgrazcal + zprcaca
-            END DO
-         END DO
-      END DO
-      !
-      IF( lk_iomput .AND. knt == nrdttrc ) THEN
-         ALLOCATE( zw3d(jpi,jpj,jpk) )
-         IF( iom_use( "GRAZ2" ) ) THEN
-            zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:)  !   Total grazing of phyto by zooplankton
-            CALL iom_put( "GRAZ2", zw3d )
-         ENDIF
-         IF( iom_use( "PCAL" ) ) THEN
-            zw3d(:,:,:) = prodcal(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:)   !  Calcite production
-            CALL iom_put( "PCAL", zw3d )  
-         ENDIF
-         IF( iom_use( "FEZOO2" ) ) THEN
-            zw3d(:,:,:) = zfezoo2(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:)   !
-            CALL iom_put( "FEZOO2", zw3d )
-         ENDIF
-         IF( iom_use( "LPRODZ2" ) .AND. ln_ligand )  THEN
-            zw3d(:,:,:) = zz2ligprod(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:)
-            CALL iom_put( "LPRODZ2"  , zw3d )
-         ENDIF
-         DEALLOCATE( zw3d )
-      ENDIF
-      !
-      IF (ln_ligand)  DEALLOCATE( zz2ligprod )
-      !
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
         WRITE(charout, FMT="('meso')")
         CALL prt_ctl_trc_info(charout)
-        CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+        CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
       ENDIF
       !
@@ -290,8 +279,6 @@
       ENDIF
       !
-      REWIND( numnatp_ref )              ! Namelist nampismes in reference namelist : Pisces mesozooplankton
       READ  ( numnatp_ref, namp4zmes, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namp4zmes in reference namelist' )
-      REWIND( numnatp_cfg )              ! Namelist nampismes in configuration namelist : Pisces mesozooplankton
       READ  ( numnatp_cfg, namp4zmes, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namp4zmes in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zmicro.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zmicro.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zmicro.F90	(revision 12928)
@@ -42,4 +42,6 @@
    REAL(wp), PUBLIC ::   epshermin   !: minimum growth efficiency for grazing 1
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -49,5 +51,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_micro( kt, knt )
+   SUBROUTINE p4z_micro( kt, knt, Kbb, Krhs )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_micro  ***
@@ -59,4 +61,5 @@
       INTEGER, INTENT(in) ::   kt    ! ocean time step
       INTEGER, INTENT(in) ::   knt   ! ??? 
+      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices
       !
       INTEGER  :: ji, jj, jk
@@ -64,11 +67,11 @@
       REAL(wp) :: zgraze  , zdenom, zdenom2
       REAL(wp) :: zfact   , zfood, zfoodlim, zbeta
-      REAL(wp) :: zepsherf, zepshert, zepsherv, zgrarsig, zgraztotc, zgraztotn, zgraztotf
+      REAL(wp) :: zepsherf, zepshert, zepsherv, zepsherq
+      REAL(wp) :: zgrarsig, zgraztotc, zgraztotn, zgraztotf
       REAL(wp) :: zgrarem, zgrafer, zgrapoc, zprcaca, zmortz
       REAL(wp) :: zrespz, ztortz, zgrasrat, zgrasratn
       REAL(wp) :: zgrazp, zgrazm, zgrazsd
       REAL(wp) :: zgrazmf, zgrazsf, zgrazpf
-      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zfezoo
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zw3d, zzligprod
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zfezoo, zzligprod
       CHARACTER (len=25) :: charout
       !!---------------------------------------------------------------------
@@ -76,139 +79,129 @@
       IF( ln_timing )   CALL timing_start('p4z_micro')
       !
-      IF (ln_ligand) THEN
-         ALLOCATE( zzligprod(jpi,jpj,jpk) )
-         zzligprod(:,:,:) = 0._wp
-      ENDIF
-      !
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zcompaz = MAX( ( trb(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 )
-               zfact   = xstep * tgfunc2(ji,jj,jk) * zcompaz
-
-               !  Respiration rates of both zooplankton
-               !  -------------------------------------
-               zrespz = resrat * zfact * trb(ji,jj,jk,jpzoo) / ( xkmort + trb(ji,jj,jk,jpzoo) )  &
-                  &   + resrat * zfact * 3. * nitrfac(ji,jj,jk)
-
-               !  Zooplankton mortality. A square function has been selected with
-               !  no real reason except that it seems to be more stable and may mimic predation.
-               !  ---------------------------------------------------------------
-               ztortz = mzrat * 1.e6 * zfact * trb(ji,jj,jk,jpzoo) * (1. - nitrfac(ji,jj,jk))
-
-               zcompadi  = MIN( MAX( ( trb(ji,jj,jk,jpdia) - xthreshdia ), 0.e0 ), xsizedia )
-               zcompaph  = MAX( ( trb(ji,jj,jk,jpphy) - xthreshphy ), 0.e0 )
-               zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthreshpoc ), 0.e0 )
-               
-               !     Microzooplankton grazing
-               !     ------------------------
-               zfood     = xprefn * zcompaph + xprefc * zcompapoc + xprefd * zcompadi
-               zfoodlim  = MAX( 0. , zfood - min(xthresh,0.5*zfood) )
-               zdenom    = zfoodlim / ( xkgraz + zfoodlim )
-               zdenom2   = zdenom / ( zfood + rtrn )
-               zgraze    = grazrat * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpzoo) * (1. - nitrfac(ji,jj,jk))
-
-               zgrazp    = zgraze  * xprefn * zcompaph  * zdenom2 
-               zgrazm    = zgraze  * xprefc * zcompapoc * zdenom2 
-               zgrazsd   = zgraze  * xprefd * zcompadi  * zdenom2 
-
-               zgrazpf   = zgrazp  * trb(ji,jj,jk,jpnfe) / (trb(ji,jj,jk,jpphy) + rtrn)
-               zgrazmf   = zgrazm  * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn)
-               zgrazsf   = zgrazsd * trb(ji,jj,jk,jpdfe) / (trb(ji,jj,jk,jpdia) + rtrn)
-               !
-               zgraztotc = zgrazp  + zgrazm  + zgrazsd 
-               zgraztotf = zgrazpf + zgrazsf + zgrazmf 
-               zgraztotn = zgrazp * quotan(ji,jj,jk) + zgrazm + zgrazsd * quotad(ji,jj,jk)
-
-               ! Grazing by microzooplankton
-               zgrazing(ji,jj,jk) = zgraztotc
-
-               !    Various remineralization and excretion terms
-               !    --------------------------------------------
-               zgrasrat  = ( zgraztotf + rtrn ) / ( zgraztotc + rtrn )
-               zgrasratn = ( zgraztotn + rtrn ) / ( zgraztotc + rtrn )
-               zepshert  =  MIN( 1., zgrasratn, zgrasrat / ferat3)
-               zbeta     = MAX(0., (epsher - epshermin) )
-               zepsherf  = epshermin + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta )
-               zepsherv  = zepsherf * zepshert 
-
-               zgrafer   = zgraztotc * MAX( 0. , ( 1. - unass ) * zgrasrat - ferat3 * zepsherv ) 
-               zgrarem   = zgraztotc * ( 1. - zepsherv - unass )
-               zgrapoc   = zgraztotc * unass
-
-               !  Update of the TRA arrays
-               !  ------------------------
-               zgrarsig  = zgrarem * sigma1
-               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarsig
-               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig
-               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem - zgrarsig
-               !
-               IF( ln_ligand ) THEN
-                  tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + (zgrarem - zgrarsig) * ldocz
-                  zzligprod(ji,jj,jk) = (zgrarem - zgrarsig) * ldocz
-               ENDIF
-               !
-               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig
-               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer
-               zfezoo(ji,jj,jk)    = zgrafer
-               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc
-               prodpoc(ji,jj,jk)   = prodpoc(ji,jj,jk) + zgrapoc
-               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zgraztotf * unass
-               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarsig
-               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgrarsig
-               !   Update the arrays TRA which contain the biological sources and sinks
-               !   --------------------------------------------------------------------
-               zmortz = ztortz + zrespz
-               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zmortz + zepsherv * zgraztotc 
-               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazp
-               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazsd
-               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazp  * trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn)
-               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazsd * trb(ji,jj,jk,jpdch)/(trb(ji,jj,jk,jpdia)+rtrn)
-               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazsd * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn)
-               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazsd * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn)
-               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgrazpf
-               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf
-               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz - zgrazm
-               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortz
-               conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazm
-               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz - zgrazmf
-               !
-               ! calcite production
-               zprcaca = xfracal(ji,jj,jk) * zgrazp
-               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo)
-               !
-               zprcaca = part * zprcaca
-               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca
-               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca
-               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca
-            END DO
-         END DO
-      END DO
-      !
-      IF( lk_iomput ) THEN
-         IF( knt == nrdttrc ) THEN
-           ALLOCATE( zw3d(jpi,jpj,jpk) )
-           IF( iom_use( "GRAZ1" ) ) THEN
-              zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:)  !  Total grazing of phyto by zooplankton
-              CALL iom_put( "GRAZ1", zw3d )
-           ENDIF
-           IF( iom_use( "FEZOO" ) ) THEN
-              zw3d(:,:,:) = zfezoo(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:)   !
-              CALL iom_put( "FEZOO", zw3d )
-           ENDIF
-           IF( iom_use( "LPRODZ" ) .AND. ln_ligand )  THEN
-              zw3d(:,:,:) = zzligprod(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:)
-              CALL iom_put( "LPRODZ"  , zw3d )
-           ENDIF
-           DEALLOCATE( zw3d )
-         ENDIF
-      ENDIF
-      !
-      IF (ln_ligand)  DEALLOCATE( zzligprod )
-      !
-      IF(ln_ctl) THEN      ! print mean trends (used for debugging)
+      DO_3D_11_11( 1, jpkm1 )
+         zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - 1.e-9 ), 0.e0 )
+         zfact   = xstep * tgfunc2(ji,jj,jk) * zcompaz
+
+         !  Respiration rates of both zooplankton
+         !  -------------------------------------
+         zrespz = resrat * zfact * tr(ji,jj,jk,jpzoo,Kbb) / ( xkmort + tr(ji,jj,jk,jpzoo,Kbb) )  &
+            &   + resrat * zfact * 3. * nitrfac(ji,jj,jk)
+
+         !  Zooplankton mortality. A square function has been selected with
+         !  no real reason except that it seems to be more stable and may mimic predation.
+         !  ---------------------------------------------------------------
+         ztortz = mzrat * 1.e6 * zfact * tr(ji,jj,jk,jpzoo,Kbb) * (1. - nitrfac(ji,jj,jk))
+
+         zcompadi  = MIN( MAX( ( tr(ji,jj,jk,jpdia,Kbb) - xthreshdia ), 0.e0 ), xsizedia )
+         zcompaph  = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - xthreshphy ), 0.e0 )
+         zcompapoc = MAX( ( tr(ji,jj,jk,jppoc,Kbb) - xthreshpoc ), 0.e0 )
+         
+         !     Microzooplankton grazing
+         !     ------------------------
+         zfood     = xprefn * zcompaph + xprefc * zcompapoc + xprefd * zcompadi
+         zfoodlim  = MAX( 0. , zfood - min(xthresh,0.5*zfood) )
+         zdenom    = zfoodlim / ( xkgraz + zfoodlim )
+         zdenom2   = zdenom / ( zfood + rtrn )
+         zgraze    = grazrat * xstep * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpzoo,Kbb) * (1. - nitrfac(ji,jj,jk))
+
+         zgrazp    = zgraze  * xprefn * zcompaph  * zdenom2 
+         zgrazm    = zgraze  * xprefc * zcompapoc * zdenom2 
+         zgrazsd   = zgraze  * xprefd * zcompadi  * zdenom2 
+
+         zgrazpf   = zgrazp  * tr(ji,jj,jk,jpnfe,Kbb) / (tr(ji,jj,jk,jpphy,Kbb) + rtrn)
+         zgrazmf   = zgrazm  * tr(ji,jj,jk,jpsfe,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn)
+         zgrazsf   = zgrazsd * tr(ji,jj,jk,jpdfe,Kbb) / (tr(ji,jj,jk,jpdia,Kbb) + rtrn)
+         !
+         zgraztotc = zgrazp  + zgrazm  + zgrazsd 
+         zgraztotf = zgrazpf + zgrazsf + zgrazmf 
+         zgraztotn = zgrazp * quotan(ji,jj,jk) + zgrazm + zgrazsd * quotad(ji,jj,jk)
+
+         ! Grazing by microzooplankton
+         zgrazing(ji,jj,jk) = zgraztotc
+
+
+         ! Microzooplankton efficiency. 
+         ! We adopt a formulation proposed by Mitra et al. (2007)
+         ! The gross growth efficiency is controled by the most limiting nutrient.
+         ! Growth is also further decreased when the food quality is poor. This is currently
+         ! hard coded : it can be decreased by up to 50% (zepsherq)
+         ! GGE can also be decreased when food quantity is high, zepsherf (Montagnes and 
+         ! Fulton, 2012)
+         ! -----------------------------------------------------------------------------
+         zgrasrat  = ( zgraztotf + rtrn ) / ( zgraztotc + rtrn )
+         zgrasratn = ( zgraztotn + rtrn ) / ( zgraztotc + rtrn )
+         zepshert  =  MIN( 1., zgrasratn, zgrasrat / ferat3)
+         zbeta     = MAX(0., (epsher - epshermin) )
+         zepsherf  = epshermin + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta )
+         zepsherq  = 0.5 + (1.0 - 0.5) * zepshert * ( 1.0 + 1.0 ) / ( zepshert + 1.0 )
+         zepsherv  = zepsherf * zepshert * zepsherq 
+
+         zgrafer   = zgraztotc * MAX( 0. , ( 1. - unass ) * zgrasrat - ferat3 * zepsherv ) 
+         zgrarem   = zgraztotc * ( 1. - zepsherv - unass )
+         zgrapoc   = zgraztotc * unass
+
+         !  Update of the TRA arrays
+         !  ------------------------
+         zgrarsig  = zgrarem * sigma1
+         tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarsig
+         tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgrarsig
+         tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgrarem - zgrarsig
+         !
+         IF( ln_ligand ) THEN
+            tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + (zgrarem - zgrarsig) * ldocz
+            zzligprod(ji,jj,jk) = (zgrarem - zgrarsig) * ldocz
+         ENDIF
+         !
+         tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarsig
+         tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgrafer
+         zfezoo(ji,jj,jk)    = zgrafer
+         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zgrapoc
+         prodpoc(ji,jj,jk)   = prodpoc(ji,jj,jk) + zgrapoc
+         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zgraztotf * unass
+         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrarsig
+         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zgrarsig
+         !   Update the arrays TRA which contain the biological sources and sinks
+         !   --------------------------------------------------------------------
+         zmortz = ztortz + zrespz
+         tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) - zmortz + zepsherv * zgraztotc 
+         tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zgrazp
+         tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zgrazsd
+         tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zgrazp  * tr(ji,jj,jk,jpnch,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn)
+         tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zgrazsd * tr(ji,jj,jk,jpdch,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn)
+         tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zgrazsd * tr(ji,jj,jk,jpdsi,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn)
+         tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zgrazsd * tr(ji,jj,jk,jpdsi,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn)
+         tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zgrazpf
+         tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zgrazsf
+         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zmortz - zgrazm
+         prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortz
+         conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazm
+         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ferat3 * zmortz - zgrazmf
+         !
+         ! calcite production
+         zprcaca = xfracal(ji,jj,jk) * zgrazp
+         prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo)
+         !
+         zprcaca = part * zprcaca
+         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprcaca
+         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * zprcaca
+         tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) + zprcaca
+      END_3D
+      !
+      IF( lk_iomput .AND. knt == nrdttrc ) THEN
+        IF( iom_use("GRAZ1") ) THEN  !   Total grazing of phyto by zooplankton
+           zgrazing(:,:,jpk) = 0._wp   ; CALL iom_put( "GRAZ1" , zgrazing(:,:,:) * 1.e+3  * rfact2r * tmask(:,:,:) ) 
+         ENDIF
+         IF( iom_use("FEZOO") ) THEN  
+           zfezoo (:,:,jpk) = 0._wp    ; CALL iom_put( "FEZOO", zfezoo(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) )
+         ENDIF
+         IF( ln_ligand ) THEN
+            zzligprod(:,:,jpk) = 0._wp ; CALL iom_put( "LPRODZ", zzligprod(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:))
+         ENDIF
+      ENDIF
+      !
+      IF(sn_cfctl%l_prttrc) THEN      ! print mean trends (used for debugging)
          WRITE(charout, FMT="('micro')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
       ENDIF
       !
@@ -243,8 +236,6 @@
       ENDIF
       !
-      REWIND( numnatp_ref )              ! Namelist nampiszoo in reference namelist : Pisces microzooplankton
       READ  ( numnatp_ref, namp4zzoo, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namp4zzoo in reference namelist' )
-      REWIND( numnatp_cfg )              ! Namelist nampiszoo in configuration namelist : Pisces microzooplankton
       READ  ( numnatp_cfg, namp4zzoo, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namp4zzoo in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zmort.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zmort.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zmort.F90	(revision 12928)
@@ -29,4 +29,6 @@
    REAL(wp), PUBLIC ::   mprat2   !:
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -36,5 +38,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_mort( kt )
+   SUBROUTINE p4z_mort( kt, Kbb, Krhs )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_mort  ***
@@ -46,14 +48,15 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt ! ocean time step
-      !!---------------------------------------------------------------------
-      !
-      CALL p4z_nano            ! nanophytoplankton
-      !
-      CALL p4z_diat            ! diatoms
+      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices
+      !!---------------------------------------------------------------------
+      !
+      CALL p4z_nano( Kbb, Krhs )            ! nanophytoplankton
+      !
+      CALL p4z_diat( Kbb, Krhs )            ! diatoms
       !
    END SUBROUTINE p4z_mort
 
 
-   SUBROUTINE p4z_nano
+   SUBROUTINE p4z_nano( Kbb, Krhs )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_nano  ***
@@ -63,4 +66,5 @@
       !! ** Method  : - ???
       !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices
       INTEGER  ::   ji, jj, jk
       REAL(wp) ::   zsizerat, zcompaph
@@ -73,53 +77,49 @@
       !
       prodcal(:,:,:) = 0._wp   ! calcite production variable set to zero
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zcompaph = MAX( ( trb(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 )
-               !     When highly limited by macronutrients, very small cells 
-               !     dominate the community. As a consequence, aggregation
-               !     due to turbulence is negligible. Mortality is also set
-               !     to 0
-               zsizerat = MIN(1., MAX( 0., (quotan(ji,jj,jk) - 0.2) / 0.3) ) * trb(ji,jj,jk,jpphy)
-               !     Squared mortality of Phyto similar to a sedimentation term during
-               !     blooms (Doney et al. 1996)
-               zrespp = wchl * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * zsizerat 
-
-               !     Phytoplankton mortality. This mortality loss is slightly
-               !     increased when nutrients are limiting phytoplankton growth
-               !     as observed for instance in case of iron limitation.
-               ztortp = mprat * xstep * zcompaph / ( xkmort + trb(ji,jj,jk,jpphy) ) * zsizerat
-
-               zmortp = zrespp + ztortp
-
-               !   Update the arrays TRA which contains the biological sources and sinks
-
-               zfactfe = trb(ji,jj,jk,jpnfe)/(trb(ji,jj,jk,jpphy)+rtrn)
-               zfactch = trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn)
-               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zmortp
-               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zmortp * zfactch
-               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zmortp * zfactfe
-               zprcaca = xfracal(ji,jj,jk) * zmortp
-               !
-               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo)
-               !
-               zfracal = 0.5 * xfracal(ji,jj,jk)
-               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca
-               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca
-               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca
-               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zfracal * zmortp
-               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + ( 1. - zfracal ) * zmortp
-               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ( 1. - zfracal ) * zmortp
-               prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zfracal * zmortp
-               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ( 1. - zfracal ) * zmortp * zfactfe
-               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zfracal * zmortp * zfactfe
-            END DO
-         END DO
-      END DO
-      !
-       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+      DO_3D_11_11( 1, jpkm1 )
+         zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - 1e-8 ), 0.e0 )
+         !     When highly limited by macronutrients, very small cells 
+         !     dominate the community. As a consequence, aggregation
+         !     due to turbulence is negligible. Mortality is also set
+         !     to 0
+         zsizerat = MIN(1., MAX( 0., (quotan(ji,jj,jk) - 0.2) / 0.3) ) * tr(ji,jj,jk,jpphy,Kbb)
+         !     Squared mortality of Phyto similar to a sedimentation term during
+         !     blooms (Doney et al. 1996)
+         zrespp = wchl * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * zsizerat 
+
+         !     Phytoplankton mortality. This mortality loss is slightly
+         !     increased when nutrients are limiting phytoplankton growth
+         !     as observed for instance in case of iron limitation.
+         ztortp = mprat * xstep * zcompaph / ( xkmort + tr(ji,jj,jk,jpphy,Kbb) ) * zsizerat
+
+         zmortp = zrespp + ztortp
+
+         !   Update the arrays TRA which contains the biological sources and sinks
+
+         zfactfe = tr(ji,jj,jk,jpnfe,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn)
+         zfactch = tr(ji,jj,jk,jpnch,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn)
+         tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zmortp
+         tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zmortp * zfactch
+         tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zmortp * zfactfe
+         zprcaca = xfracal(ji,jj,jk) * zmortp
+         !
+         prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo)
+         !
+         zfracal = 0.5 * xfracal(ji,jj,jk)
+         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprcaca
+         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * zprcaca
+         tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) + zprcaca
+         tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zfracal * zmortp
+         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + ( 1. - zfracal ) * zmortp
+         prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ( 1. - zfracal ) * zmortp
+         prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zfracal * zmortp
+         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ( 1. - zfracal ) * zmortp * zfactfe
+         tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zfracal * zmortp * zfactfe
+      END_3D
+      !
+       IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
          WRITE(charout, FMT="('nano')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
        ENDIF
       !
@@ -129,5 +129,5 @@
 
 
-   SUBROUTINE p4z_diat
+   SUBROUTINE p4z_diat( Kbb, Krhs )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_diat  ***
@@ -137,4 +137,5 @@
       !! ** Method  : - ???
       !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices
       INTEGER  ::   ji, jj, jk
       REAL(wp) ::   zfactfe,zfactsi,zfactch, zcompadi
@@ -151,50 +152,46 @@
       !     ------------------------------------------------------------
 
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-
-               zcompadi = MAX( ( trb(ji,jj,jk,jpdia) - 1e-9), 0. )
-
-               !    Aggregation term for diatoms is increased in case of nutrient
-               !    stress as observed in reality. The stressed cells become more
-               !    sticky and coagulate to sink quickly out of the euphotic zone
-               !     ------------------------------------------------------------
-               !  Phytoplankton respiration 
-               !     ------------------------
-               zlim2   = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk)
-               zlim1   = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 ) 
-               zrespp2 = 1.e6 * xstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trb(ji,jj,jk,jpdia)
-
-               !     Phytoplankton mortality. 
-               !     ------------------------
-               ztortp2 = mprat2 * xstep * trb(ji,jj,jk,jpdia)  / ( xkmort + trb(ji,jj,jk,jpdia) ) * zcompadi 
-
-               zmortp2 = zrespp2 + ztortp2
-
-               !   Update the arrays tra which contains the biological sources and sinks
-               !   ---------------------------------------------------------------------
-               zfactch = trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn )
-               zfactfe = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn )
-               zfactsi = trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn )
-               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zmortp2 
-               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zmortp2 * zfactch
-               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zmortp2 * zfactfe
-               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zmortp2 * zfactsi
-               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zmortp2 * zfactsi
-               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zrespp2 + 0.5 * ztortp2
-               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + 0.5 * ztortp2
-               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + 0.5 * ztortp2
-               prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zrespp2 + 0.5 * ztortp2
-               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 0.5 * ztortp2 * zfactfe
-               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ( zrespp2 + 0.5 * ztortp2 ) * zfactfe
-            END DO
-         END DO
-      END DO
-      !
-      IF(ln_ctl) THEN      ! print mean trends (used for debugging)
+      DO_3D_11_11( 1, jpkm1 )
+
+         zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1e-9), 0. )
+
+         !    Aggregation term for diatoms is increased in case of nutrient
+         !    stress as observed in reality. The stressed cells become more
+         !    sticky and coagulate to sink quickly out of the euphotic zone
+         !     ------------------------------------------------------------
+         !  Phytoplankton respiration 
+         !     ------------------------
+         zlim2   = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk)
+         zlim1   = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 ) 
+         zrespp2 = 1.e6 * xstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * tr(ji,jj,jk,jpdia,Kbb)
+
+         !     Phytoplankton mortality. 
+         !     ------------------------
+         ztortp2 = mprat2 * xstep * tr(ji,jj,jk,jpdia,Kbb)  / ( xkmort + tr(ji,jj,jk,jpdia,Kbb) ) * zcompadi 
+
+         zmortp2 = zrespp2 + ztortp2
+
+         !   Update the arrays tr(:,:,:,:,Krhs) which contains the biological sources and sinks
+         !   ---------------------------------------------------------------------
+         zfactch = tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
+         zfactfe = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
+         zfactsi = tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
+         tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zmortp2 
+         tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zmortp2 * zfactch
+         tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zmortp2 * zfactfe
+         tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zmortp2 * zfactsi
+         tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zmortp2 * zfactsi
+         tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zrespp2 + 0.5 * ztortp2
+         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + 0.5 * ztortp2
+         prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + 0.5 * ztortp2
+         prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zrespp2 + 0.5 * ztortp2
+         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + 0.5 * ztortp2 * zfactfe
+         tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + ( zrespp2 + 0.5 * ztortp2 ) * zfactfe
+      END_3D
+      !
+      IF(sn_cfctl%l_prttrc) THEN      ! print mean trends (used for debugging)
          WRITE(charout, FMT="('diat')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
       ENDIF
       !
@@ -227,8 +224,6 @@
       ENDIF
       !
-      REWIND( numnatp_ref )              ! Namelist nampismort in reference namelist : Pisces phytoplankton
       READ  ( numnatp_ref, namp4zmort, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namp4zmort in reference namelist' )
-      REWIND( numnatp_cfg )              ! Namelist nampismort in configuration namelist : Pisces phytoplankton
       READ  ( numnatp_cfg, namp4zmort, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namp4zmort in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zopt.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zopt.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zopt.F90	(revision 12928)
@@ -42,4 +42,6 @@
    REAL(wp), DIMENSION(3,61) ::   xkrgb   ! tabulated attenuation coefficients for RGB absorption
    
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -49,5 +51,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_opt( kt, knt )
+   SUBROUTINE p4z_opt( kt, knt, Kbb, Kmm )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_opt  ***
@@ -59,4 +61,5 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt, knt   ! ocean time step
+      INTEGER, INTENT(in) ::   Kbb, Kmm  ! time level indices
       !
       INTEGER  ::   ji, jj, jk
@@ -71,5 +74,4 @@
       !
       IF( ln_timing )   CALL timing_start('p4z_opt')
-      IF( ln_p5z    )   ALLOCATE( zetmp5(jpi,jpj) )
 
       IF( knt == 1 .AND. ln_varpar )   CALL p4z_opt_sbc( kt )
@@ -83,20 +85,16 @@
       !                                        !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue)
       !                                        !  --------------------------------------------------------
-                     zchl3d(:,:,:) = trb(:,:,:,jpnch) + trb(:,:,:,jpdch)
-      IF( ln_p5z )   zchl3d(:,:,:) = zchl3d(:,:,:)    + trb(:,:,:,jppch)
-      !
-      DO jk = 1, jpkm1   
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zchl = ( zchl3d(ji,jj,jk) + rtrn ) * 1.e6
-               zchl = MIN(  10. , MAX( 0.05, zchl )  )
-               irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn )
-               !                                                         
-               ekb(ji,jj,jk) = xkrgb(1,irgb) * e3t_n(ji,jj,jk)
-               ekg(ji,jj,jk) = xkrgb(2,irgb) * e3t_n(ji,jj,jk)
-               ekr(ji,jj,jk) = xkrgb(3,irgb) * e3t_n(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+                     zchl3d(:,:,:) = tr(:,:,:,jpnch,Kbb) + tr(:,:,:,jpdch,Kbb)
+      IF( ln_p5z )   zchl3d(:,:,:) = zchl3d(:,:,:)    + tr(:,:,:,jppch,Kbb)
+      !
+      DO_3D_11_11( 1, jpkm1 )
+         zchl = ( zchl3d(ji,jj,jk) + rtrn ) * 1.e6
+         zchl = MIN(  10. , MAX( 0.05, zchl )  )
+         irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn )
+         !                                                         
+         ekb(ji,jj,jk) = xkrgb(1,irgb) * e3t(ji,jj,jk,Kmm)
+         ekg(ji,jj,jk) = xkrgb(2,irgb) * e3t(ji,jj,jk,Kmm)
+         ekr(ji,jj,jk) = xkrgb(3,irgb) * e3t(ji,jj,jk,Kmm)
+      END_3D
       !                                        !* Photosynthetically Available Radiation (PAR)
       !                                        !  --------------------------------------
@@ -105,5 +103,5 @@
          zqsr_corr(:,:) = qsr_mean(:,:) / ( 1.-fr_i(:,:) + rtrn )
          !
-         CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 ) 
+         CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 ) 
          !
          DO jk = 1, nksrp      
@@ -120,5 +118,5 @@
          zqsr_corr(:,:) = qsr(:,:) / ( 1.-fr_i(:,:) + rtrn )
          !
-         CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3 ) 
+         CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3 ) 
          !
          DO jk = 1, nksrp      
@@ -130,5 +128,5 @@
          zqsr_corr(:,:) = qsr(:,:) / ( 1.-fr_i(:,:) + rtrn )
          !
-         CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100  ) 
+         CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100  ) 
          !
          DO jk = 1, nksrp      
@@ -148,5 +146,5 @@
       IF( ln_qsr_bio ) THEN                    !* heat flux accros w-level (used in the dynamics)
          !                                     !  ------------------------
-         CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3, pe0=ze0 )
+         CALL p4z_opt_par( kt, Kmm, qsr, ze1, ze2, ze3, pe0=ze0 )
          !
          etot3(:,:,1) =  qsr(:,:) * tmask(:,:,1)
@@ -158,21 +156,17 @@
       !                                        !* Euphotic depth and level
       neln   (:,:) = 1                            !  ------------------------
-      heup   (:,:) = gdepw_n(:,:,2)
-      heup_01(:,:) = gdepw_n(:,:,2)
-
-      DO jk = 2, nksrp
-         DO jj = 1, jpj
-           DO ji = 1, jpi
-              IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >=  zqsr100(ji,jj) )  THEN
-                 neln(ji,jj) = jk+1                    ! Euphotic level : 1rst T-level strictly below Euphotic layer
-                 !                                     ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint
-                 heup(ji,jj) = gdepw_n(ji,jj,jk+1)     ! Euphotic layer depth
-              ENDIF
-              IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.50 )  THEN
-                 heup_01(ji,jj) = gdepw_n(ji,jj,jk+1)  ! Euphotic layer depth (light level definition)
-              ENDIF
-           END DO
-        END DO
-      END DO
+      heup   (:,:) = gdepw(:,:,2,Kmm)
+      heup_01(:,:) = gdepw(:,:,2,Kmm)
+
+      DO_3D_11_11( 2, nksrp )
+        IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >=  zqsr100(ji,jj) )  THEN
+           neln(ji,jj) = jk+1                    ! Euphotic level : 1rst T-level strictly below Euphotic layer
+           !                                     ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint
+           heup(ji,jj) = gdepw(ji,jj,jk+1,Kmm)     ! Euphotic layer depth
+        ENDIF
+        IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.50 )  THEN
+           heup_01(ji,jj) = gdepw(ji,jj,jk+1,Kmm)  ! Euphotic layer depth (light level definition)
+        ENDIF
+      END_3D
       !
       heup   (:,:) = MIN( 300., heup   (:,:) )
@@ -183,30 +177,22 @@
       zetmp2 (:,:)   = 0.e0
 
-      DO jk = 1, nksrp
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
-                  zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot     (ji,jj,jk) * e3t_n(ji,jj,jk) ! remineralisation
-                  zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * e3t_n(ji,jj,jk) ! production
-                  zdepmoy(ji,jj) = zdepmoy(ji,jj) +                       e3t_n(ji,jj,jk)
-               ENDIF
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, nksrp )
+         IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN
+            zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot     (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! remineralisation
+            zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production
+            zdepmoy(ji,jj) = zdepmoy(ji,jj) +                       e3t(ji,jj,jk,Kmm)
+         ENDIF
+      END_3D
       !
       emoy(:,:,:) = etot(:,:,:)       ! remineralisation
       zpar(:,:,:) = etot_ndcy(:,:,:)  ! diagnostic : PAR with no diurnal cycle 
       !
-      DO jk = 1, nksrp
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
-                  z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn )
-                  emoy (ji,jj,jk) = zetmp1(ji,jj) * z1_dep
-                  zpar (ji,jj,jk) = zetmp2(ji,jj) * z1_dep
-               ENDIF
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, nksrp )
+         IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN
+            z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn )
+            emoy (ji,jj,jk) = zetmp1(ji,jj) * z1_dep
+            zpar (ji,jj,jk) = zetmp2(ji,jj) * z1_dep
+         ENDIF
+      END_3D
       !
       zdepmoy(:,:)   = 0.e0
@@ -214,64 +200,47 @@
       zetmp4 (:,:)   = 0.e0
       !
-      DO jk = 1, nksrp
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( gdepw_n(ji,jj,jk+1) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN
-                  zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano    (ji,jj,jk) * e3t_n(ji,jj,jk) ! production
-                  zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat    (ji,jj,jk) * e3t_n(ji,jj,jk) ! production
-                  zdepmoy(ji,jj) = zdepmoy(ji,jj) +                       e3t_n(ji,jj,jk)
-               ENDIF
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, nksrp )
+         IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN
+            zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano    (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production
+            zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat    (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production
+            zdepmoy(ji,jj) = zdepmoy(ji,jj) +                       e3t(ji,jj,jk,Kmm)
+         ENDIF
+      END_3D
       enanom(:,:,:) = enano(:,:,:)
       ediatm(:,:,:) = ediat(:,:,:)
       !
-      DO jk = 1, nksrp
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
-                  z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn )
-                  enanom(ji,jj,jk) = zetmp3(ji,jj) * z1_dep
-                  ediatm(ji,jj,jk) = zetmp4(ji,jj) * z1_dep
-               ENDIF
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, nksrp )
+         IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN
+            z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn )
+            enanom(ji,jj,jk) = zetmp3(ji,jj) * z1_dep
+            ediatm(ji,jj,jk) = zetmp4(ji,jj) * z1_dep
+         ENDIF
+      END_3D
       !
       IF( ln_p5z ) THEN
-         zetmp5 (:,:) = 0.e0
-         DO jk = 1, nksrp
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  IF( gdepw_n(ji,jj,jk+1) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN
-                     zetmp5(ji,jj)  = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t_n(ji,jj,jk) ! production
-                  ENDIF
-               END DO
-            END DO
-         END DO
+         ALLOCATE( zetmp5(jpi,jpj) )  ;   zetmp5 (:,:) = 0.e0
+         DO_3D_11_11( 1, nksrp )
+            IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN
+               zetmp5(ji,jj)  = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production
+            ENDIF
+         END_3D
          !
          epicom(:,:,:) = epico(:,:,:)
          !
-         DO jk = 1, nksrp
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
-                     z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn )
-                     epicom(ji,jj,jk) = zetmp5(ji,jj) * z1_dep
-                  ENDIF
-               END DO
-            END DO
-         END DO
-      ENDIF
-      IF( lk_iomput ) THEN
-        IF( knt == nrdttrc ) THEN
-           IF( iom_use( "Heup"  ) ) CALL iom_put( "Heup" , heup(:,:  ) * tmask(:,:,1) )  ! euphotic layer deptht
-           IF( iom_use( "PARDM" ) ) CALL iom_put( "PARDM", zpar(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation
-           IF( iom_use( "PAR"   ) ) CALL iom_put( "PAR"  , emoy(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation
-        ENDIF
-      ENDIF
-      !
-      IF( ln_p5z    )   DEALLOCATE( zetmp5 )
+         DO_3D_11_11( 1, nksrp )
+            IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN
+               z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn )
+               epicom(ji,jj,jk) = zetmp5(ji,jj) * z1_dep
+            ENDIF
+         END_3D
+         DEALLOCATE( zetmp5 )
+      ENDIF
+      !
+      IF( lk_iomput .AND.  knt == nrdttrc ) THEN
+         CALL iom_put( "Heup" , heup(:,:  ) * tmask(:,:,1) )  ! euphotic layer deptht
+         CALL iom_put( "PARDM", zpar(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation
+         CALL iom_put( "PAR"  , emoy(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation
+      ENDIF
+      !
       IF( ln_timing )   CALL timing_stop('p4z_opt')
       !
@@ -279,5 +248,5 @@
 
 
-   SUBROUTINE p4z_opt_par( kt, pqsr, pe1, pe2, pe3, pe0, pqsr100 ) 
+   SUBROUTINE p4z_opt_par( kt, Kmm, pqsr, pe1, pe2, pe3, pe0, pqsr100 ) 
       !!----------------------------------------------------------------------
       !!                  ***  routine p4z_opt_par  ***
@@ -288,4 +257,5 @@
       !!----------------------------------------------------------------------
       INTEGER                         , INTENT(in)              ::   kt                ! ocean time-step
+      INTEGER                         , INTENT(in)              ::   Kmm               ! ocean time-index
       REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in   )           ::   pqsr              ! shortwave
       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pe1 , pe2 , pe3   ! PAR ( R-G-B)
@@ -315,5 +285,5 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t_n(ji,jj,jk-1) * xsi0r )
+                  pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t(ji,jj,jk-1,Kmm) * xsi0r )
                   pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb  (ji,jj,jk-1 )        )
                   pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg  (ji,jj,jk-1 )        )
@@ -331,13 +301,9 @@
         pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) )
         !
-        DO jk = 2, nksrp      
-           DO jj = 1, jpj
-              DO ji = 1, jpi
-                 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) )
-                 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) )
-                 pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -0.5 * ( ekr(ji,jj,jk-1) + ekr(ji,jj,jk) ) )
-              END DO
-           END DO
-        END DO    
+        DO_3D_11_11( 2, nksrp )
+           pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) )
+           pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) )
+           pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -0.5 * ( ekr(ji,jj,jk-1) + ekr(ji,jj,jk) ) )
+        END_3D
         !
       ENDIF
@@ -400,8 +366,6 @@
          WRITE(numout,*) '~~~~~~~~~~~~ '
       ENDIF
-      REWIND( numnatp_ref )              ! Namelist nampisopt in reference namelist : Pisces attenuation coef. and PAR
       READ  ( numnatp_ref, nampisopt, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisopt in reference namelist' )
-      REWIND( numnatp_cfg )              ! Namelist nampisopt in configuration namelist : Pisces attenuation coef. and PAR
       READ  ( numnatp_cfg, nampisopt, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisopt in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zpoc.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zpoc.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zpoc.F90	(revision 12928)
@@ -37,4 +37,6 @@
 
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -44,5 +46,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_poc( kt, knt )
+   SUBROUTINE p4z_poc( kt, knt, Kbb, Kmm, Krhs )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_poc  ***
@@ -52,5 +54,6 @@
       !! ** Method  : - ???
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step and ???
+      INTEGER, INTENT(in) ::   kt, knt         ! ocean time step and ???
+      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level indices
       !
       INTEGER  ::   ji, jj, jk, jn
@@ -103,87 +106,83 @@
      ! -----------------------------------------------------------------------
      ztremint(:,:,:) = zremigoc(:,:,:)
-     DO jk = 2, jpkm1
-        DO jj = 1, jpj
-           DO ji = 1, jpi
-              IF (tmask(ji,jj,jk) == 1.) THEN
-                zdep = hmld(ji,jj)
-                !
-                ! In the case of GOC, lability is constant in the mixed layer 
-                ! It is computed only below the mixed layer depth
-                ! ------------------------------------------------------------
-                !
-                IF( gdept_n(ji,jj,jk) > zdep ) THEN
-                  alphat = 0.
-                  remint = 0.
-                  !
-                  zsizek1  = e3t_n(ji,jj,jk-1) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1)
-                  zsizek = e3t_n(ji,jj,jk) / 2. / (wsbio4(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk)
-                  !
-                  IF ( gdept_n(ji,jj,jk-1) <= zdep ) THEN
-                    ! 
-                    ! The first level just below the mixed layer needs a 
-                    ! specific treatment because lability is supposed constant
-                    ! everywhere within the mixed layer. This means that 
-                    ! change in lability in the bottom part of the previous cell
-                    ! should not be computed
-                    ! ----------------------------------------------------------
-                    !
-                    ! POC concentration is computed using the lagrangian 
-                    ! framework. It is only used for the lability param
-                    zpoc = trb(ji,jj,jk-1,jpgoc) + consgoc(ji,jj,jk) * rday / rfact2               &
-                    &   * e3t_n(ji,jj,jk) / 2. / (wsbio4(ji,jj,jk) + rtrn)
-                    zpoc = MAX(0., zpoc)
-                    !
-                    DO jn = 1, jcpoc
-                       !
-                       ! Lagrangian based algorithm. The fraction of each 
-                       ! lability class is computed starting from the previous
-                       ! level
-                       ! -----------------------------------------------------
-                       !
-                       ! the concentration of each lability class is calculated
-                       ! as the sum of the different sources and sinks
-                       ! Please note that production of new GOC experiences
-                       ! degradation 
-                       alphag(ji,jj,jk,jn) = alphag(ji,jj,jk-1,jn) * exp( -reminp(jn) * zsizek ) * zpoc &
-                       &   + prodgoc(ji,jj,jk) * alphan(jn) / tgfunc(ji,jj,jk) / reminp(jn)             &
-                       &   * ( 1. - exp( -reminp(jn) * zsizek ) ) * rday / rfact2 
-                       alphat = alphat + alphag(ji,jj,jk,jn)
-                       remint = remint + alphag(ji,jj,jk,jn) * reminp(jn)
-                    END DO
-                  ELSE
-                    !
-                    ! standard algorithm in the rest of the water column
-                    ! See the comments in the previous block.
-                    ! ---------------------------------------------------
-                    !
-                    zpoc = trb(ji,jj,jk-1,jpgoc) + consgoc(ji,jj,jk-1) * rday / rfact2               &
-                    &   * e3t_n(ji,jj,jk-1) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) + consgoc(ji,jj,jk)   &
-                    &   * rday / rfact2 * e3t_n(ji,jj,jk) / 2. / (wsbio4(ji,jj,jk) + rtrn)
-                    zpoc = max(0., zpoc)
-                    !
-                    DO jn = 1, jcpoc
-                       alphag(ji,jj,jk,jn) = alphag(ji,jj,jk-1,jn) * exp( -reminp(jn) * ( zsizek              &
-                       &   + zsizek1 ) ) * zpoc + ( prodgoc(ji,jj,jk-1) / tgfunc(ji,jj,jk-1) * ( 1.           &
-                       &   - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn) * zsizek ) + prodgoc(ji,jj,jk) &
-                       &   / tgfunc(ji,jj,jk) * ( 1. - exp( -reminp(jn) * zsizek ) ) ) * rday / rfact2 / reminp(jn) * alphan(jn) 
-                       alphat = alphat + alphag(ji,jj,jk,jn)
-                       remint = remint + alphag(ji,jj,jk,jn) * reminp(jn)
-                    END DO
-                  ENDIF
-                  !
-                  DO jn = 1, jcpoc
-                     ! The contribution of each lability class at the current
-                     ! level is computed
-                     alphag(ji,jj,jk,jn) = alphag(ji,jj,jk,jn) / ( alphat + rtrn)
-                  END DO
-                  ! Computation of the mean remineralisation rate
-                  ztremint(ji,jj,jk) =  MAX(0., remint / ( alphat + rtrn) )
-                  !
-                ENDIF
-              ENDIF
+     DO_3D_11_11( 2, jpkm1 )
+        IF (tmask(ji,jj,jk) == 1.) THEN
+          zdep = hmld(ji,jj)
+          !
+          ! In the case of GOC, lability is constant in the mixed layer 
+          ! It is computed only below the mixed layer depth
+          ! ------------------------------------------------------------
+          !
+          IF( gdept(ji,jj,jk,Kmm) > zdep ) THEN
+            alphat = 0.
+            remint = 0.
+            !
+            zsizek1  = e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1)
+            zsizek = e3t(ji,jj,jk,Kmm) / 2. / (wsbio4(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk)
+            !
+            IF ( gdept(ji,jj,jk-1,Kmm) <= zdep ) THEN
+              ! 
+              ! The first level just below the mixed layer needs a 
+              ! specific treatment because lability is supposed constant
+              ! everywhere within the mixed layer. This means that 
+              ! change in lability in the bottom part of the previous cell
+              ! should not be computed
+              ! ----------------------------------------------------------
+              !
+              ! POC concentration is computed using the lagrangian 
+              ! framework. It is only used for the lability param
+              zpoc = tr(ji,jj,jk-1,jpgoc,Kbb) + consgoc(ji,jj,jk) * rday / rfact2               &
+              &   * e3t(ji,jj,jk,Kmm) / 2. / (wsbio4(ji,jj,jk) + rtrn)
+              zpoc = MAX(0., zpoc)
+              !
+              DO jn = 1, jcpoc
+                 !
+                 ! Lagrangian based algorithm. The fraction of each 
+                 ! lability class is computed starting from the previous
+                 ! level
+                 ! -----------------------------------------------------
+                 !
+                 ! the concentration of each lability class is calculated
+                 ! as the sum of the different sources and sinks
+                 ! Please note that production of new GOC experiences
+                 ! degradation 
+                 alphag(ji,jj,jk,jn) = alphag(ji,jj,jk-1,jn) * exp( -reminp(jn) * zsizek ) * zpoc &
+                 &   + prodgoc(ji,jj,jk) * alphan(jn) / tgfunc(ji,jj,jk) / reminp(jn)             &
+                 &   * ( 1. - exp( -reminp(jn) * zsizek ) ) * rday / rfact2 
+                 alphat = alphat + alphag(ji,jj,jk,jn)
+                 remint = remint + alphag(ji,jj,jk,jn) * reminp(jn)
+              END DO
+            ELSE
+              !
+              ! standard algorithm in the rest of the water column
+              ! See the comments in the previous block.
+              ! ---------------------------------------------------
+              !
+              zpoc = tr(ji,jj,jk-1,jpgoc,Kbb) + consgoc(ji,jj,jk-1) * rday / rfact2               &
+              &   * e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) + consgoc(ji,jj,jk)   &
+              &   * rday / rfact2 * e3t(ji,jj,jk,Kmm) / 2. / (wsbio4(ji,jj,jk) + rtrn)
+              zpoc = max(0., zpoc)
+              !
+              DO jn = 1, jcpoc
+                 alphag(ji,jj,jk,jn) = alphag(ji,jj,jk-1,jn) * exp( -reminp(jn) * ( zsizek              &
+                 &   + zsizek1 ) ) * zpoc + ( prodgoc(ji,jj,jk-1) / tgfunc(ji,jj,jk-1) * ( 1.           &
+                 &   - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn) * zsizek ) + prodgoc(ji,jj,jk) &
+                 &   / tgfunc(ji,jj,jk) * ( 1. - exp( -reminp(jn) * zsizek ) ) ) * rday / rfact2 / reminp(jn) * alphan(jn) 
+                 alphat = alphat + alphag(ji,jj,jk,jn)
+                 remint = remint + alphag(ji,jj,jk,jn) * reminp(jn)
+              END DO
+            ENDIF
+            !
+            DO jn = 1, jcpoc
+               ! The contribution of each lability class at the current
+               ! level is computed
+               alphag(ji,jj,jk,jn) = alphag(ji,jj,jk,jn) / ( alphat + rtrn)
             END DO
-         END DO
-      END DO
+            ! Computation of the mean remineralisation rate
+            ztremint(ji,jj,jk) =  MAX(0., remint / ( alphat + rtrn) )
+            !
+          ENDIF
+        ENDIF
+     END_3D
 
       IF( ln_p4z ) THEN   ;   zremigoc(:,:,:) = MIN( xremip , ztremint(:,:,:) )
@@ -192,64 +191,56 @@
 
       IF( ln_p4z ) THEN
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  ! POC disaggregation by turbulence and bacterial activity. 
-                  ! --------------------------------------------------------
-                  zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk)
-                  zorem2  = zremig * trb(ji,jj,jk,jpgoc)
-                  orem(ji,jj,jk)      = zorem2
-                  zorem3(ji,jj,jk) = zremig * solgoc * trb(ji,jj,jk,jpgoc)
-                  zofer2 = zremig * trb(ji,jj,jk,jpbfe)
-                  zofer3 = zremig * solgoc * trb(ji,jj,jk,jpbfe)
-
-                  ! -------------------------------------
-                  tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zorem3(ji,jj,jk)
-                  tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zorem2 - zorem3(ji,jj,jk)
-                  tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zofer3
-                  tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zofer2 - zofer3
-                  tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zorem2
-                  tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer2
-                  zfolimi(ji,jj,jk)   = zofer2
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, jpkm1 )
+            ! POC disaggregation by turbulence and bacterial activity. 
+            ! --------------------------------------------------------
+            zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk)
+            zorem2  = zremig * tr(ji,jj,jk,jpgoc,Kbb)
+            orem(ji,jj,jk)      = zorem2
+            zorem3(ji,jj,jk) = zremig * solgoc * tr(ji,jj,jk,jpgoc,Kbb)
+            zofer2 = zremig * tr(ji,jj,jk,jpbfe,Kbb)
+            zofer3 = zremig * solgoc * tr(ji,jj,jk,jpbfe,Kbb)
+
+            ! -------------------------------------
+            tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zorem3(ji,jj,jk)
+            tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) - zorem2 - zorem3(ji,jj,jk)
+            tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zofer3
+            tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) - zofer2 - zofer3
+            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zorem2
+            tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer2
+            zfolimi(ji,jj,jk)   = zofer2
+         END_3D
       ELSE
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                   ! POC disaggregation by turbulence and bacterial activity. 
-                  ! --------------------------------------------------------
-                  zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk)
-                  zopoc2 = zremig  * trb(ji,jj,jk,jpgoc)
-                  orem(ji,jj,jk) = zopoc2
-                  zorem3(ji,jj,jk) = zremig * solgoc * trb(ji,jj,jk,jpgoc)
-                  zopon2 = xremipn / xremipc * zremig * trb(ji,jj,jk,jpgon)
-                  zopop2 = xremipp / xremipc * zremig * trb(ji,jj,jk,jpgop)
-                  zofer2 = xremipn / xremipc * zremig * trb(ji,jj,jk,jpbfe)
-
-                  ! -------------------------------------
-                  tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zorem3(ji,jj,jk)
-                  tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + solgoc * zopon2 
-                  tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + solgoc * zopop2
-                  tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + solgoc * zofer2
-                  tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zopoc2
-                  tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zopon2
-                  tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zopop2
-                  tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer2
-                  tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zopoc2 - zorem3(ji,jj,jk)
-                  tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) - zopon2 * (1. + solgoc)
-                  tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) - zopop2 * (1. + solgoc)
-                  tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zofer2 * (1. + solgoc)
-                  zfolimi(ji,jj,jk)   = zofer2
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, jpkm1 )
+             ! POC disaggregation by turbulence and bacterial activity. 
+            ! --------------------------------------------------------
+            zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk)
+            zopoc2 = zremig  * tr(ji,jj,jk,jpgoc,Kbb)
+            orem(ji,jj,jk) = zopoc2
+            zorem3(ji,jj,jk) = zremig * solgoc * tr(ji,jj,jk,jpgoc,Kbb)
+            zopon2 = xremipn / xremipc * zremig * tr(ji,jj,jk,jpgon,Kbb)
+            zopop2 = xremipp / xremipc * zremig * tr(ji,jj,jk,jpgop,Kbb)
+            zofer2 = xremipn / xremipc * zremig * tr(ji,jj,jk,jpbfe,Kbb)
+
+            ! -------------------------------------
+            tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zorem3(ji,jj,jk)
+            tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + solgoc * zopon2 
+            tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + solgoc * zopop2
+            tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + solgoc * zofer2
+            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zopoc2
+            tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zopon2
+            tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zopop2
+            tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer2
+            tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) - zopoc2 - zorem3(ji,jj,jk)
+            tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) - zopon2 * (1. + solgoc)
+            tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) - zopop2 * (1. + solgoc)
+            tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) - zofer2 * (1. + solgoc)
+            zfolimi(ji,jj,jk)   = zofer2
+         END_3D
       ENDIF
 
-     IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+     IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
         WRITE(charout, FMT="('poc1')")
         CALL prt_ctl_trc_info(charout)
-        CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+        CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
      ENDIF
 
@@ -268,18 +259,14 @@
      ! ----------------------------------------------------------------
      ! 
-     DO jk = 1, jpkm1
-        DO jj = 1, jpj
-           DO ji = 1, jpi
-              zdep = hmld(ji,jj)
-              IF (tmask(ji,jj,jk) == 1. .AND. gdept_n(ji,jj,jk) <= zdep ) THEN
-                totprod(ji,jj) = totprod(ji,jj) + prodpoc(ji,jj,jk) * e3t_n(ji,jj,jk) * rday/ rfact2
-                ! The temperature effect is included here
-                totthick(ji,jj) = totthick(ji,jj) + e3t_n(ji,jj,jk)* tgfunc(ji,jj,jk)
-                totcons(ji,jj) = totcons(ji,jj) - conspoc(ji,jj,jk) * e3t_n(ji,jj,jk) * rday/ rfact2    &
-                &                / ( trb(ji,jj,jk,jppoc) + rtrn )
-              ENDIF
-           END DO
-        END DO
-     END DO
+     DO_3D_11_11( 1, jpkm1 )
+        zdep = hmld(ji,jj)
+        IF (tmask(ji,jj,jk) == 1. .AND. gdept(ji,jj,jk,Kmm) <= zdep ) THEN
+          totprod(ji,jj) = totprod(ji,jj) + prodpoc(ji,jj,jk) * e3t(ji,jj,jk,Kmm) * rday/ rfact2
+          ! The temperature effect is included here
+          totthick(ji,jj) = totthick(ji,jj) + e3t(ji,jj,jk,Kmm)* tgfunc(ji,jj,jk)
+          totcons(ji,jj) = totcons(ji,jj) - conspoc(ji,jj,jk) * e3t(ji,jj,jk,Kmm) * rday/ rfact2    &
+          &                / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn )
+        ENDIF
+     END_3D
 
      ! Computation of the lability spectrum in the mixed layer. In the mixed 
@@ -287,30 +274,26 @@
      ! ---------------------------------------------------------------------
      ztremint(:,:,:) = zremipoc(:,:,:)
-     DO jk = 1, jpkm1
-        DO jj = 1, jpj
-           DO ji = 1, jpi
-              IF (tmask(ji,jj,jk) == 1.) THEN
-                zdep = hmld(ji,jj)
-                alphat = 0.0
-                remint = 0.0
-                IF( gdept_n(ji,jj,jk) <= zdep ) THEN
-                   DO jn = 1, jcpoc
-                      ! For each lability class, the system is supposed to be 
-                      ! at equilibrium: Prod - Sink - w alphap = 0.
-                      alphap(ji,jj,jk,jn) = totprod(ji,jj) * alphan(jn) / ( reminp(jn)    &
-                      &                     * totthick(ji,jj) + totcons(ji,jj) + wsbio + rtrn )
-                      alphat = alphat + alphap(ji,jj,jk,jn)
-                   END DO
-                   DO jn = 1, jcpoc
-                      alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn)
-                      remint = remint + alphap(ji,jj,jk,jn) * reminp(jn)
-                   END DO
-                   ! Mean remineralization rate in the mixed layer
-                   ztremint(ji,jj,jk) =  MAX( 0., remint )
-                ENDIF
-              ENDIF
-           END DO
-        END DO
-     END DO
+     DO_3D_11_11( 1, jpkm1 )
+        IF (tmask(ji,jj,jk) == 1.) THEN
+          zdep = hmld(ji,jj)
+          alphat = 0.0
+          remint = 0.0
+          IF( gdept(ji,jj,jk,Kmm) <= zdep ) THEN
+             DO jn = 1, jcpoc
+                ! For each lability class, the system is supposed to be 
+                ! at equilibrium: Prod - Sink - w alphap = 0.
+                alphap(ji,jj,jk,jn) = totprod(ji,jj) * alphan(jn) / ( reminp(jn)    &
+                &                     * totthick(ji,jj) + totcons(ji,jj) + wsbio + rtrn )
+                alphat = alphat + alphap(ji,jj,jk,jn)
+             END DO
+             DO jn = 1, jcpoc
+                alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn)
+                remint = remint + alphap(ji,jj,jk,jn) * reminp(jn)
+             END DO
+             ! Mean remineralization rate in the mixed layer
+             ztremint(ji,jj,jk) =  MAX( 0., remint )
+          ENDIF
+        ENDIF
+     END_3D
      !
      IF( ln_p4z ) THEN   ;  zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) )
@@ -326,76 +309,72 @@
      ! -----------------------------------------------------------------------
      !
-     DO jk = 2, jpkm1
-        DO jj = 1, jpj
-           DO ji = 1, jpi
-              IF (tmask(ji,jj,jk) == 1.) THEN
-                zdep = hmld(ji,jj)
-                IF( gdept_n(ji,jj,jk) > zdep ) THEN
-                  alphat = 0.
-                  remint = 0.
-                  !
-                  ! the scale factors are corrected with temperature
-                  zsizek1  = e3t_n(ji,jj,jk-1) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1)
-                  zsizek = e3t_n(ji,jj,jk) / 2. / (wsbio3(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk)
-                  !
-                  ! Special treatment of the level just below the MXL
-                  ! See the comments in the GOC section
-                  ! ---------------------------------------------------
-                  !
-                  IF ( gdept_n(ji,jj,jk-1) <= zdep ) THEN
-                    !
-                    ! Computation of the POC concentration using the 
-                    ! lagrangian algorithm
-                    zpoc = trb(ji,jj,jk-1,jppoc) + conspoc(ji,jj,jk) * rday / rfact2               &
-                    &   * e3t_n(ji,jj,jk) / 2. / (wsbio3(ji,jj,jk) + rtrn)
-                    zpoc = max(0., zpoc)
-                    ! 
-                    DO jn = 1, jcpoc
-                       ! computation of the lability spectrum applying the 
-                       ! different sources and sinks
-                       alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn) * zsizek ) * zpoc  &
-                       &   + ( prodpoc(ji,jj,jk) * alphan(jn) + zorem3(ji,jj,jk) * alphag(ji,jj,jk,jn) ) &
-                       &   / tgfunc(ji,jj,jk) / reminp(jn) * rday / rfact2 * ( 1. - exp( -reminp(jn)     &
-                       &   * zsizek ) )
-                       alphap(ji,jj,jk,jn) = MAX( 0., alphap(ji,jj,jk,jn) )
-                       alphat = alphat + alphap(ji,jj,jk,jn)
-                    END DO
-                  ELSE
-                    !
-                    ! Lability parameterization for the interior of the ocean
-                    ! This is very similar to what is done in the previous 
-                    ! block
-                    ! --------------------------------------------------------
-                    !
-                    zpoc = trb(ji,jj,jk-1,jppoc) + conspoc(ji,jj,jk-1) * rday / rfact2               &
-                    &   * e3t_n(ji,jj,jk-1) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) + conspoc(ji,jj,jk)   &
-                    &   * rday / rfact2 * e3t_n(ji,jj,jk) / 2. / (wsbio3(ji,jj,jk) + rtrn)
-                    zpoc = max(0., zpoc)
-                    !
-                    DO jn = 1, jcpoc
-                       alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn)                       &
-                       &   * ( zsizek + zsizek1 ) ) * zpoc + ( prodpoc(ji,jj,jk-1) * alphan(jn)             & 
-                       &   + zorem3(ji,jj,jk-1) * alphag(ji,jj,jk-1,jn) ) * rday / rfact2 / reminp(jn)      &
-                       &   / tgfunc(ji,jj,jk-1) * ( 1. - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn)  &
-                       &   * zsizek ) + ( prodpoc(ji,jj,jk) * alphan(jn) + zorem3(ji,jj,jk)                 &
-                       &   * alphag(ji,jj,jk,jn) ) * rday / rfact2 / reminp(jn) / tgfunc(ji,jj,jk) * ( 1.   &
-                       &   - exp( -reminp(jn) * zsizek ) )
-                       alphap(ji,jj,jk,jn) = max(0., alphap(ji,jj,jk,jn) )
-                       alphat = alphat + alphap(ji,jj,jk,jn)
-                    END DO
-                  ENDIF
-                  ! Normalization of the lability spectrum so that the 
-                  ! integral is equal to 1
-                  DO jn = 1, jcpoc
-                     alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn)
-                     remint = remint + alphap(ji,jj,jk,jn) * reminp(jn)
-                  END DO
-                  ! Mean remineralization rate in the water column
-                  ztremint(ji,jj,jk) =  MAX( 0., remint )
-                ENDIF
-              ENDIF
+     DO_3D_11_11( 2, jpkm1 )
+        IF (tmask(ji,jj,jk) == 1.) THEN
+          zdep = hmld(ji,jj)
+          IF( gdept(ji,jj,jk,Kmm) > zdep ) THEN
+            alphat = 0.
+            remint = 0.
+            !
+            ! the scale factors are corrected with temperature
+            zsizek1  = e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1)
+            zsizek = e3t(ji,jj,jk,Kmm) / 2. / (wsbio3(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk)
+            !
+            ! Special treatment of the level just below the MXL
+            ! See the comments in the GOC section
+            ! ---------------------------------------------------
+            !
+            IF ( gdept(ji,jj,jk-1,Kmm) <= zdep ) THEN
+              !
+              ! Computation of the POC concentration using the 
+              ! lagrangian algorithm
+              zpoc = tr(ji,jj,jk-1,jppoc,Kbb) + conspoc(ji,jj,jk) * rday / rfact2               &
+              &   * e3t(ji,jj,jk,Kmm) / 2. / (wsbio3(ji,jj,jk) + rtrn)
+              zpoc = max(0., zpoc)
+              ! 
+              DO jn = 1, jcpoc
+                 ! computation of the lability spectrum applying the 
+                 ! different sources and sinks
+                 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn) * zsizek ) * zpoc  &
+                 &   + ( prodpoc(ji,jj,jk) * alphan(jn) + zorem3(ji,jj,jk) * alphag(ji,jj,jk,jn) ) &
+                 &   / tgfunc(ji,jj,jk) / reminp(jn) * rday / rfact2 * ( 1. - exp( -reminp(jn)     &
+                 &   * zsizek ) )
+                 alphap(ji,jj,jk,jn) = MAX( 0., alphap(ji,jj,jk,jn) )
+                 alphat = alphat + alphap(ji,jj,jk,jn)
+              END DO
+            ELSE
+              !
+              ! Lability parameterization for the interior of the ocean
+              ! This is very similar to what is done in the previous 
+              ! block
+              ! --------------------------------------------------------
+              !
+              zpoc = tr(ji,jj,jk-1,jppoc,Kbb) + conspoc(ji,jj,jk-1) * rday / rfact2               &
+              &   * e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) + conspoc(ji,jj,jk)   &
+              &   * rday / rfact2 * e3t(ji,jj,jk,Kmm) / 2. / (wsbio3(ji,jj,jk) + rtrn)
+              zpoc = max(0., zpoc)
+              !
+              DO jn = 1, jcpoc
+                 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn)                       &
+                 &   * ( zsizek + zsizek1 ) ) * zpoc + ( prodpoc(ji,jj,jk-1) * alphan(jn)             & 
+                 &   + zorem3(ji,jj,jk-1) * alphag(ji,jj,jk-1,jn) ) * rday / rfact2 / reminp(jn)      &
+                 &   / tgfunc(ji,jj,jk-1) * ( 1. - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn)  &
+                 &   * zsizek ) + ( prodpoc(ji,jj,jk) * alphan(jn) + zorem3(ji,jj,jk)                 &
+                 &   * alphag(ji,jj,jk,jn) ) * rday / rfact2 / reminp(jn) / tgfunc(ji,jj,jk) * ( 1.   &
+                 &   - exp( -reminp(jn) * zsizek ) )
+                 alphap(ji,jj,jk,jn) = max(0., alphap(ji,jj,jk,jn) )
+                 alphat = alphat + alphap(ji,jj,jk,jn)
+              END DO
+            ENDIF
+            ! Normalization of the lability spectrum so that the 
+            ! integral is equal to 1
+            DO jn = 1, jcpoc
+               alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn)
+               remint = remint + alphap(ji,jj,jk,jn) * reminp(jn)
             END DO
-         END DO
-      END DO
+            ! Mean remineralization rate in the water column
+            ztremint(ji,jj,jk) =  MAX( 0., remint )
+          ENDIF
+        ENDIF
+     END_3D
 
      IF( ln_p4z ) THEN   ;   zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) )
@@ -404,49 +383,41 @@
 
      IF( ln_p4z ) THEN
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  IF (tmask(ji,jj,jk) == 1.) THEN
-                    ! POC disaggregation by turbulence and bacterial activity. 
-                    ! --------------------------------------------------------
-                    zremip          = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk)
-                    zorem           = zremip * trb(ji,jj,jk,jppoc)
-                    zofer           = zremip * trb(ji,jj,jk,jpsfe)
-
-                    tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zorem
-                    orem(ji,jj,jk)      = orem(ji,jj,jk) + zorem
-                    tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer
-                    tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zorem
-                    tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zofer
-                    zfolimi(ji,jj,jk)   = zfolimi(ji,jj,jk) + zofer
-                  ENDIF
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, jpkm1 )
+            IF (tmask(ji,jj,jk) == 1.) THEN
+              ! POC disaggregation by turbulence and bacterial activity. 
+              ! --------------------------------------------------------
+              zremip          = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk)
+              zorem           = zremip * tr(ji,jj,jk,jppoc,Kbb)
+              zofer           = zremip * tr(ji,jj,jk,jpsfe,Kbb)
+
+              tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zorem
+              orem(ji,jj,jk)      = orem(ji,jj,jk) + zorem
+              tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer
+              tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zorem
+              tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zofer
+              zfolimi(ji,jj,jk)   = zfolimi(ji,jj,jk) + zofer
+            ENDIF
+         END_3D
      ELSE
-       DO jk = 1, jpkm1
-          DO jj = 1, jpj
-             DO ji = 1, jpi
-                ! POC disaggregation by turbulence and bacterial activity. 
-                ! --------------------------------------------------------
-                zremip = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk)
-                zopoc  = zremip * trb(ji,jj,jk,jppoc)
-                orem(ji,jj,jk)  = orem(ji,jj,jk) + zopoc
-                zopon  = xremipn / xremipc * zremip * trb(ji,jj,jk,jppon)
-                zopop  = xremipp / xremipc * zremip * trb(ji,jj,jk,jppop)
-                zofer  = xremipn / xremipc * zremip * trb(ji,jj,jk,jpsfe)
-
-                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zopoc
-                tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) - zopon
-                tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) - zopop
-                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zofer
-                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zopoc
-                tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zopon 
-                tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zopop 
-                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer 
-                zfolimi(ji,jj,jk)   = zfolimi(ji,jj,jk) + zofer
-             END DO
-           END DO
-        END DO
+       DO_3D_11_11( 1, jpkm1 )
+          ! POC disaggregation by turbulence and bacterial activity. 
+          ! --------------------------------------------------------
+          zremip = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk)
+          zopoc  = zremip * tr(ji,jj,jk,jppoc,Kbb)
+          orem(ji,jj,jk)  = orem(ji,jj,jk) + zopoc
+          zopon  = xremipn / xremipc * zremip * tr(ji,jj,jk,jppon,Kbb)
+          zopop  = xremipp / xremipc * zremip * tr(ji,jj,jk,jppop,Kbb)
+          zofer  = xremipn / xremipc * zremip * tr(ji,jj,jk,jpsfe,Kbb)
+
+          tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zopoc
+          tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) - zopon
+          tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) - zopop
+          tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zofer
+          tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zopoc
+          tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zopon 
+          tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zopop 
+          tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer 
+          zfolimi(ji,jj,jk)   = zfolimi(ji,jj,jk) + zofer
+       END_3D
      ENDIF
 
@@ -460,8 +431,8 @@
      ENDIF
 
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
          WRITE(charout, FMT="('poc2')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
       ENDIF
       !
@@ -497,8 +468,6 @@
       ENDIF
       !
-      REWIND( numnatp_ref )              ! Namelist nampisrem in reference namelist : Pisces remineralization
       READ  ( numnatp_ref, nampispoc, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampispoc in reference namelist' )
-      REWIND( numnatp_cfg )              ! Namelist nampisrem in configuration namelist : Pisces remineralization
       READ  ( numnatp_cfg, nampispoc, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampispoc in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zprod.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zprod.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zprod.F90	(revision 12928)
@@ -46,4 +46,6 @@
    REAL(wp) ::   texcretd   ! 1 - excretd        
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -53,5 +55,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_prod( kt , knt )
+   SUBROUTINE p4z_prod( kt , knt, Kbb, Kmm, Krhs )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_prod  ***
@@ -63,4 +65,5 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt, knt   !
+      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level indices
       !
       INTEGER  ::   ji, jj, jk
@@ -89,9 +92,10 @@
       !  Allocate temporary workspace
       !
-      zprorcan(:,:,:) = 0._wp ; zprorcad(:,:,:) = 0._wp ; zprofed (:,:,:) = 0._wp
-      zprofen (:,:,:) = 0._wp ; zysopt  (:,:,:) = 0._wp
-      zpronewn(:,:,:) = 0._wp ; zpronewd(:,:,:) = 0._wp ; zprdia  (:,:,:) = 0._wp
-      zprbio  (:,:,:) = 0._wp ; zprdch  (:,:,:) = 0._wp ; zprnch  (:,:,:) = 0._wp 
-      zmxl_fac(:,:,:) = 0._wp ; zmxl_chl(:,:,:) = 0._wp 
+      zprorcan  (:,:,:) = 0._wp ; zprorcad  (:,:,:) = 0._wp ; zprofed (:,:,:) = 0._wp
+      zprofen   (:,:,:) = 0._wp ; zysopt    (:,:,:) = 0._wp
+      zpronewn  (:,:,:) = 0._wp ; zpronewd  (:,:,:) = 0._wp ; zprdia  (:,:,:) = 0._wp
+      zprbio    (:,:,:) = 0._wp ; zprdch    (:,:,:) = 0._wp ; zprnch  (:,:,:) = 0._wp 
+      zmxl_fac  (:,:,:) = 0._wp ; zmxl_chl  (:,:,:) = 0._wp 
+      zpligprod1(:,:,:) = 0._wp ; zpligprod2(:,:,:) = 0._wp 
 
       ! Computation of the optimal production
@@ -105,27 +109,21 @@
       ! day length in hours
       zstrn(:,:) = 0.
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad )
-            zargu = MAX( -1., MIN(  1., zargu ) )
-            zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. )
-         END DO
-      END DO
+      DO_2D_11_11
+         zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad )
+         zargu = MAX( -1., MIN(  1., zargu ) )
+         zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. )
+      END_2D
 
       ! Impact of the day duration and light intermittency on phytoplankton growth
-      DO jk = 1, jpkm1
-         DO jj = 1 ,jpj
-            DO ji = 1, jpi
-               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
-                  zval = MAX( 1., zstrn(ji,jj) )
-                  IF( gdept_n(ji,jj,jk) <= hmld(ji,jj) ) THEN
-                     zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn ))
-                  ENDIF
-                  zmxl_chl(ji,jj,jk) = zval / 24.
-                  zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval )
-               ENDIF
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpkm1 )
+         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+            zval = MAX( 1., zstrn(ji,jj) )
+            IF( gdept(ji,jj,jk,Kmm) <= hmld(ji,jj) ) THEN
+               zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn ))
+            ENDIF
+            zmxl_chl(ji,jj,jk) = zval / 24.
+            zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval )
+         ENDIF
+      END_3D
 
       zprbio(:,:,:) = zprmaxn(:,:,:) * zmxl_fac(:,:,:)
@@ -136,202 +134,166 @@
 
       ! Computation of the P-I slope for nanos and diatoms
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
-                  ztn         = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. )
-                  zadap       = xadap * ztn / ( 2.+ ztn )
-                  zconctemp   = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia )
-                  zconctemp2  = trb(ji,jj,jk,jpdia) - zconctemp
-                  !
-                  zpislopeadn(ji,jj,jk) = pislopen * ( 1.+ zadap  * EXP( -0.25 * enano(ji,jj,jk) ) )  &
-                  &                   * trb(ji,jj,jk,jpnch) /( trb(ji,jj,jk,jpphy) * 12. + rtrn)
-                  !
-                  zpislopeadd(ji,jj,jk) = (pislopen * zconctemp2 + pisloped * zconctemp) / ( trb(ji,jj,jk,jpdia) + rtrn )   &
-                  &                   * trb(ji,jj,jk,jpdch) /( trb(ji,jj,jk,jpdia) * 12. + rtrn)
-               ENDIF
-            END DO
-         END DO
-      END DO
-
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
-                   ! Computation of production function for Carbon
-                   !  ---------------------------------------------
-                   zpislopen = zpislopeadn(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) &
-                   &            * zmxl_fac(ji,jj,jk) * rday + rtrn)
-                   zpisloped = zpislopeadd(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) &
-                   &            * zmxl_fac(ji,jj,jk) * rday + rtrn)
-                   zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) )  )
-                   zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) )  )
-                   !  Computation of production function for Chlorophyll
-                   !--------------------------------------------------
-                   zpislopen = zpislopeadn(ji,jj,jk) / ( zprmaxn(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn )
-                   zpisloped = zpislopeadd(ji,jj,jk) / ( zprmaxd(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn )
-                   zprnch(ji,jj,jk) = zprmaxn(ji,jj,jk) * ( 1.- EXP( -zpislopen * enanom(ji,jj,jk) ) )
-                   zprdch(ji,jj,jk) = zprmaxd(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediatm(ji,jj,jk) ) )
-               ENDIF
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpkm1 )
+         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+            ztn         = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) - 15. )
+            zadap       = xadap * ztn / ( 2.+ ztn )
+            zconctemp   = MAX( 0.e0 , tr(ji,jj,jk,jpdia,Kbb) - xsizedia )
+            zconctemp2  = tr(ji,jj,jk,jpdia,Kbb) - zconctemp
+            !
+            zpislopeadn(ji,jj,jk) = pislopen * ( 1.+ zadap  * EXP( -0.25 * enano(ji,jj,jk) ) )  &
+            &                   * tr(ji,jj,jk,jpnch,Kbb) /( tr(ji,jj,jk,jpphy,Kbb) * 12. + rtrn)
+            !
+            zpislopeadd(ji,jj,jk) = (pislopen * zconctemp2 + pisloped * zconctemp) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )   &
+            &                   * tr(ji,jj,jk,jpdch,Kbb) /( tr(ji,jj,jk,jpdia,Kbb) * 12. + rtrn)
+         ENDIF
+      END_3D
+
+      DO_3D_11_11( 1, jpkm1 )
+         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+             ! Computation of production function for Carbon
+             !  ---------------------------------------------
+             zpislopen = zpislopeadn(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) &
+             &            * zmxl_fac(ji,jj,jk) * rday + rtrn)
+             zpisloped = zpislopeadd(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) &
+             &            * zmxl_fac(ji,jj,jk) * rday + rtrn)
+             zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) )  )
+             zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) )  )
+             !  Computation of production function for Chlorophyll
+             !--------------------------------------------------
+             zpislopen = zpislopeadn(ji,jj,jk) / ( zprmaxn(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn )
+             zpisloped = zpislopeadd(ji,jj,jk) / ( zprmaxd(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn )
+             zprnch(ji,jj,jk) = zprmaxn(ji,jj,jk) * ( 1.- EXP( -zpislopen * enanom(ji,jj,jk) ) )
+             zprdch(ji,jj,jk) = zprmaxd(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediatm(ji,jj,jk) ) )
+         ENDIF
+      END_3D
 
       !  Computation of a proxy of the N/C ratio
       !  ---------------------------------------
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-                zval = MIN( xnanopo4(ji,jj,jk), ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) )   &
-                &      * zprmaxn(ji,jj,jk) / ( zprbio(ji,jj,jk) + rtrn )
-                quotan(ji,jj,jk) = MIN( 1., 0.2 + 0.8 * zval )
-                zval = MIN( xdiatpo4(ji,jj,jk), ( xdiatnh4(ji,jj,jk) + xdiatno3(ji,jj,jk) ) )   &
-                &      * zprmaxd(ji,jj,jk) / ( zprdia(ji,jj,jk) + rtrn )
-                quotad(ji,jj,jk) = MIN( 1., 0.2 + 0.8 * zval )
-            END DO
-         END DO
-      END DO
-
-
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-
-                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
-                   !    Si/C of diatoms
-                   !    ------------------------
-                   !    Si/C increases with iron stress and silicate availability
-                   !    Si/C is arbitrariliy increased for very high Si concentrations
-                   !    to mimic the very high ratios observed in the Southern Ocean (silpot2)
-                  zlim  = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi1 )
-                  zsilim = MIN( zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) )
-                  zsilfac = 4.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) )  ) + 1.e0
-                  zsiborn = trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil)
-                  IF (gphit(ji,jj) < -30 ) THEN
-                    zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 )
-                  ELSE
-                    zsilfac2 = 1. +      zsiborn / ( zsiborn + xksi2**3 )
-                  ENDIF
-                  zysopt(ji,jj,jk) = grosip * zlim * zsilfac * zsilfac2
-              ENDIF
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpkm1 )
+          zval = MIN( xnanopo4(ji,jj,jk), ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) )   &
+          &      * zprmaxn(ji,jj,jk) / ( zprbio(ji,jj,jk) + rtrn )
+          quotan(ji,jj,jk) = MIN( 1., 0.2 + 0.8 * zval )
+          zval = MIN( xdiatpo4(ji,jj,jk), ( xdiatnh4(ji,jj,jk) + xdiatno3(ji,jj,jk) ) )   &
+          &      * zprmaxd(ji,jj,jk) / ( zprdia(ji,jj,jk) + rtrn )
+          quotad(ji,jj,jk) = MIN( 1., 0.2 + 0.8 * zval )
+      END_3D
+
+
+      DO_3D_11_11( 1, jpkm1 )
+
+          IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+             !    Si/C of diatoms
+             !    ------------------------
+             !    Si/C increases with iron stress and silicate availability
+             !    Si/C is arbitrariliy increased for very high Si concentrations
+             !    to mimic the very high ratios observed in the Southern Ocean (silpot2)
+            zlim  = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi1 )
+            zsilim = MIN( zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) )
+            zsilfac = 4.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) )  ) + 1.e0
+            zsiborn = tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb)
+            IF (gphit(ji,jj) < -30 ) THEN
+              zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 )
+            ELSE
+              zsilfac2 = 1. +      zsiborn / ( zsiborn + xksi2**3 )
+            ENDIF
+            zysopt(ji,jj,jk) = grosip * zlim * zsilfac * zsilfac2
+        ENDIF
+      END_3D
 
       !  Mixed-layer effect on production 
       !  Sea-ice effect on production
 
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
-               zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpkm1 )
+         zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
+         zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
+      END_3D
 
       ! Computation of the various production terms 
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
-                  !  production terms for nanophyto. (C)
-                  zprorcan(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * trb(ji,jj,jk,jpphy) * rfact2
-                  zpronewn(ji,jj,jk)  = zprorcan(ji,jj,jk)* xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn )
-                  !
-                  zratio = trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) * fecnm + rtrn )
-                  zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 
-                  zprofen(ji,jj,jk) = fecnm * zprmaxn(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) )  &
-                  &             * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) )    &
-                  &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concnfe(ji,jj,jk) )  &
-                  &             * zmax * trb(ji,jj,jk,jpphy) * rfact2
-                  !  production terms for diatoms (C)
-                  zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trb(ji,jj,jk,jpdia) * rfact2
-                  zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn )
-                  !
-                  zratio = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) * fecdm + rtrn )
-                  zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 
-                  zprofed(ji,jj,jk) = fecdm * zprmaxd(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) )  &
-                  &             * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) )    &
-                  &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concdfe(ji,jj,jk) )  &
-                  &             * zmax * trb(ji,jj,jk,jpdia) * rfact2
-               ENDIF
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpkm1 )
+         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+            !  production terms for nanophyto. (C)
+            zprorcan(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * tr(ji,jj,jk,jpphy,Kbb) * rfact2
+            zpronewn(ji,jj,jk)  = zprorcan(ji,jj,jk)* xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn )
+            !
+            zratio = tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) * fecnm + rtrn )
+            zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 
+            zprofen(ji,jj,jk) = fecnm * zprmaxn(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) )  &
+            &             * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) )    &
+            &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concnfe(ji,jj,jk) )  &
+            &             * zmax * tr(ji,jj,jk,jpphy,Kbb) * rfact2
+            !  production terms for diatoms (C)
+            zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * tr(ji,jj,jk,jpdia,Kbb) * rfact2
+            zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn )
+            !
+            zratio = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) * fecdm + rtrn )
+            zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 
+            zprofed(ji,jj,jk) = fecdm * zprmaxd(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) )  &
+            &             * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) )    &
+            &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concdfe(ji,jj,jk) )  &
+            &             * zmax * tr(ji,jj,jk,jpdia,Kbb) * rfact2
+         ENDIF
+      END_3D
 
       ! Computation of the chlorophyll production terms
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
-                  !  production terms for nanophyto. ( chlorophyll )
-                  znanotot = enanom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
-                  zprod    = rday * zprorcan(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk)
-                  zprochln = chlcmin * 12. * zprorcan (ji,jj,jk)
-                  chlcnm_n   = MIN ( chlcnm, ( chlcnm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem))) * (1. - 1.14 / 43.4 * 20.))
-                  zprochln = zprochln + (chlcnm_n-chlcmin) * 12. * zprod / &
-                                        & (  zpislopeadn(ji,jj,jk) * znanotot +rtrn)
-                  !  production terms for diatoms ( chlorophyll )
-                  zdiattot = ediatm(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
-                  zprod    = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk)
-                  zprochld = chlcmin * 12. * zprorcad(ji,jj,jk)
-                  chlcdm_n   = MIN ( chlcdm, ( chlcdm / (1. - 1.14 / 43.4 * tsn(ji,jj,jk,jp_tem))) * (1. - 1.14 / 43.4 * 20.))
-                  zprochld = zprochld + (chlcdm_n-chlcmin) * 12. * zprod / &
-                                        & ( zpislopeadd(ji,jj,jk) * zdiattot +rtrn )
-                  !   Update the arrays TRA which contain the Chla sources and sinks
-                  tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln * texcretn
-                  tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld * texcretd
-               ENDIF
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpkm1 )
+         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+            !  production terms for nanophyto. ( chlorophyll )
+            znanotot = enanom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
+            zprod    = rday * zprorcan(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk)
+            zprochln = chlcmin * 12. * zprorcan (ji,jj,jk)
+            chlcnm_n   = MIN ( chlcnm, ( chlcnm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm))) * (1. - 1.14 / 43.4 * 20.))
+            zprochln = zprochln + (chlcnm_n-chlcmin) * 12. * zprod / &
+                                  & (  zpislopeadn(ji,jj,jk) * znanotot +rtrn)
+            !  production terms for diatoms ( chlorophyll )
+            zdiattot = ediatm(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
+            zprod    = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk)
+            zprochld = chlcmin * 12. * zprorcad(ji,jj,jk)
+            chlcdm_n   = MIN ( chlcdm, ( chlcdm / (1. - 1.14 / 43.4 * ts(ji,jj,jk,jp_tem,Kmm))) * (1. - 1.14 / 43.4 * 20.))
+            zprochld = zprochld + (chlcdm_n-chlcmin) * 12. * zprod / &
+                                  & ( zpislopeadd(ji,jj,jk) * zdiattot +rtrn )
+            !   Update the arrays TRA which contain the Chla sources and sinks
+            tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) + zprochln * texcretn
+            tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) + zprochld * texcretd
+         ENDIF
+      END_3D
 
       !   Update the arrays TRA which contain the biological sources and sinks
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-           DO ji =1 ,jpi
-              IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
-                 zproreg  = zprorcan(ji,jj,jk) - zpronewn(ji,jj,jk)
-                 zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk)
-                 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)
-                 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk)
-                 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk)
-                 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproreg - zproreg2
-                 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorcan(ji,jj,jk) * texcretn
-                 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcretn
-                 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcretd
-                 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcretd
-                 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd
-                 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zdocprod
-                 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproreg + zproreg2) &
-                 &                   + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) )
-                 !
-                 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk)
-                 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zfeup
-                 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk)
-                 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk)
-                 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) &
-                 &                                         - rno3 * ( zproreg + zproreg2 )
-              ENDIF
-           END DO
-        END DO
-     END DO
+      DO_3D_11_11( 1, jpkm1 )
+        IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+           zproreg  = zprorcan(ji,jj,jk) - zpronewn(ji,jj,jk)
+           zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk)
+           zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)
+           tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk)
+           tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk)
+           tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zproreg - zproreg2
+           tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zprorcan(ji,jj,jk) * texcretn
+           tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) + zprofen(ji,jj,jk) * texcretn
+           tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) + zprorcad(ji,jj,jk) * texcretd
+           tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) + zprofed(ji,jj,jk) * texcretd
+           tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd
+           tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zdocprod
+           tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + o2ut * ( zproreg + zproreg2) &
+           &                   + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) )
+           !
+           zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk)
+           tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zfeup
+           tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk)
+           tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk)
+           tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) &
+           &                                         - rno3 * ( zproreg + zproreg2 )
+        ENDIF
+      END_3D
      !
      IF( ln_ligand ) THEN
          zpligprod1(:,:,:) = 0._wp    ;    zpligprod2(:,:,:) = 0._wp
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-              DO ji =1 ,jpi
-                 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
-                    zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)
-                    zfeup    = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk)
-                    tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet
-                    zpligprod1(ji,jj,jk) = zdocprod * ldocp
-                    zpligprod2(ji,jj,jk) = zfeup * plig(ji,jj,jk) * lthet
-                 ENDIF
-              END DO
-           END DO
-        END DO
+         DO_3D_11_11( 1, jpkm1 )
+           IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+              zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)
+              zfeup    = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk)
+              tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet
+              zpligprod1(ji,jj,jk) = zdocprod * ldocp
+              zpligprod2(ji,jj,jk) = zfeup * plig(ji,jj,jk) * lthet
+           ENDIF
+         END_3D
      ENDIF
 
@@ -341,123 +303,33 @@
          & tpp = glob_sum( 'p4zprod', ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) )
 
-    IF( lk_iomput ) THEN
-       IF( knt == nrdttrc ) THEN
-          ALLOCATE( zw2d(jpi,jpj), zw3d(jpi,jpj,jpk) )
-          zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s
-          !
-          IF( iom_use( "PPPHYN" ) .OR. iom_use( "PPPHYD" ) )  THEN
-              zw3d(:,:,:) = zprorcan(:,:,:) * zfact * tmask(:,:,:)  ! primary production by nanophyto
-              CALL iom_put( "PPPHYN"  , zw3d )
-              !
-              zw3d(:,:,:) = zprorcad(:,:,:) * zfact * tmask(:,:,:)  ! primary production by diatomes
-              CALL iom_put( "PPPHYD"  , zw3d )
-          ENDIF
-          IF( iom_use( "PPNEWN" ) .OR. iom_use( "PPNEWD" ) )  THEN
-              zw3d(:,:,:) = zpronewn(:,:,:) * zfact * tmask(:,:,:)  ! new primary production by nanophyto
-              CALL iom_put( "PPNEWN"  , zw3d )
-              !
-              zw3d(:,:,:) = zpronewd(:,:,:) * zfact * tmask(:,:,:)  ! new primary production by diatomes
-              CALL iom_put( "PPNEWD"  , zw3d )
-          ENDIF
-          IF( iom_use( "PBSi" ) )  THEN
-              zw3d(:,:,:) = zprorcad(:,:,:) * zfact * tmask(:,:,:) * zysopt(:,:,:) ! biogenic silica production
-              CALL iom_put( "PBSi"  , zw3d )
-          ENDIF
-          IF( iom_use( "PFeN" ) .OR. iom_use( "PFeD" ) )  THEN
-              zw3d(:,:,:) = zprofen(:,:,:) * zfact * tmask(:,:,:)  ! biogenic iron production by nanophyto
-              CALL iom_put( "PFeN"  , zw3d )
-              !
-              zw3d(:,:,:) = zprofed(:,:,:) * zfact * tmask(:,:,:)  ! biogenic iron production by  diatomes
-              CALL iom_put( "PFeD"  , zw3d )
-          ENDIF
-          IF( iom_use( "LPRODP" ) )  THEN
-              zw3d(:,:,:) = zpligprod1(:,:,:) * 1e9 * zfact * tmask(:,:,:)
-              CALL iom_put( "LPRODP"  , zw3d )
-          ENDIF
-          IF( iom_use( "LDETP" ) )  THEN
-              zw3d(:,:,:) = zpligprod2(:,:,:) * 1e9 * zfact * tmask(:,:,:)
-              CALL iom_put( "LDETP"  , zw3d )
-          ENDIF
-          IF( iom_use( "Mumax" ) )  THEN
-              zw3d(:,:,:) = zprmaxn(:,:,:) * tmask(:,:,:)   ! Maximum growth rate
-              CALL iom_put( "Mumax"  , zw3d )
-          ENDIF
-          IF( iom_use( "MuN" ) .OR. iom_use( "MuD" ) )  THEN
-              zw3d(:,:,:) = zprbio(:,:,:) * xlimphy(:,:,:) * tmask(:,:,:)  ! Realized growth rate for nanophyto
-              CALL iom_put( "MuN"  , zw3d )
-              !
-              zw3d(:,:,:) =  zprdia(:,:,:) * xlimdia(:,:,:) * tmask(:,:,:)  ! Realized growth rate for diatoms
-              CALL iom_put( "MuD"  , zw3d )
-          ENDIF
-          IF( iom_use( "LNlight" ) .OR. iom_use( "LDlight" ) )  THEN
-              zw3d(:,:,:) = zprbio (:,:,:) / (zprmaxn(:,:,:) + rtrn) * tmask(:,:,:) ! light limitation term
-              CALL iom_put( "LNlight"  , zw3d )
-              !
-              zw3d(:,:,:) = zprdia (:,:,:) / (zprmaxd(:,:,:) + rtrn) * tmask(:,:,:)  ! light limitation term
-              CALL iom_put( "LDlight"  , zw3d )
-          ENDIF
-          IF( iom_use( "TPP" ) )  THEN
-              zw3d(:,:,:) = ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:)  ! total primary production
-              CALL iom_put( "TPP"  , zw3d )
-          ENDIF
-          IF( iom_use( "TPNEW" ) )  THEN
-              zw3d(:,:,:) = ( zpronewn(:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:)  ! total new production
-              CALL iom_put( "TPNEW"  , zw3d )
-          ENDIF
-          IF( iom_use( "TPBFE" ) )  THEN
-              zw3d(:,:,:) = ( zprofen(:,:,:) + zprofed(:,:,:) ) * zfact * tmask(:,:,:)  ! total biogenic iron production
-              CALL iom_put( "TPBFE"  , zw3d )
-          ENDIF
-          IF( iom_use( "INTPPPHYN" ) .OR. iom_use( "INTPPPHYD" ) ) THEN  
-             zw2d(:,:) = 0.
-             DO jk = 1, jpkm1
-               zw2d(:,:) = zw2d(:,:) + zprorcan(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated  primary produc. by nano
-             ENDDO
-             CALL iom_put( "INTPPPHYN" , zw2d )
-             !
-             zw2d(:,:) = 0.
-             DO jk = 1, jpkm1
-                zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated  primary produc. by diatom
-             ENDDO
-             CALL iom_put( "INTPPPHYD" , zw2d )
-          ENDIF
-          IF( iom_use( "INTPP" ) ) THEN   
-             zw2d(:,:) = 0.
-             DO jk = 1, jpkm1
-                zw2d(:,:) = zw2d(:,:) + ( zprorcan(:,:,jk) + zprorcad(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp
-             ENDDO
-             CALL iom_put( "INTPP" , zw2d )
-          ENDIF
-          IF( iom_use( "INTPNEW" ) ) THEN    
-             zw2d(:,:) = 0.
-             DO jk = 1, jpkm1
-                zw2d(:,:) = zw2d(:,:) + ( zpronewn(:,:,jk) + zpronewd(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated new prod
-             ENDDO
-             CALL iom_put( "INTPNEW" , zw2d )
-          ENDIF
-          IF( iom_use( "INTPBFE" ) ) THEN           !   total biogenic iron production  ( vertically integrated )
-             zw2d(:,:) = 0.
-             DO jk = 1, jpkm1
-                zw2d(:,:) = zw2d(:,:) + ( zprofen(:,:,jk) + zprofed(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert integr. bfe prod
-             ENDDO
-            CALL iom_put( "INTPBFE" , zw2d )
-          ENDIF
-          IF( iom_use( "INTPBSI" ) ) THEN           !   total biogenic silica production  ( vertically integrated )
-             zw2d(:,:) = 0.
-             DO jk = 1, jpkm1
-                zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * zysopt(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert integr. bsi prod
-             ENDDO
-             CALL iom_put( "INTPBSI" , zw2d )
-          ENDIF
-          IF( iom_use( "tintpp" ) )  CALL iom_put( "tintpp" , tpp * zfact )  !  global total integrated primary production molC/s
-          !
-          DEALLOCATE( zw2d, zw3d )
+    IF( lk_iomput .AND.  knt == nrdttrc ) THEN
+       zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s
+       !
+       CALL iom_put( "PPPHYN"  , zprorcan(:,:,:) * zfact * tmask(:,:,:) )  ! primary production by nanophyto
+       CALL iom_put( "PPPHYD"  , zprorcad(:,:,:) * zfact * tmask(:,:,:)   ) ! primary production by diatomes
+       CALL iom_put( "PPNEWN"  , zpronewn(:,:,:) * zfact * tmask(:,:,:)    ) ! new primary production by nanophyto
+       CALL iom_put( "PPNEWD"  , zpronewd(:,:,:) * zfact * tmask(:,:,:)   ) ! new primary production by diatomes
+       CALL iom_put( "PBSi"    , zprorcad(:,:,:) * zfact * tmask(:,:,:) * zysopt(:,:,:)  ) ! biogenic silica production
+       CALL iom_put( "PFeN"    , zprofen(:,:,:) * zfact * tmask(:,:,:)  ) ! biogenic iron production by nanophyto
+       CALL iom_put( "PFeD"    , zprofed(:,:,:) * zfact * tmask(:,:,:)  ) ! biogenic iron production by  diatomes
+       IF( ln_ligand ) THEN
+         CALL iom_put( "LPRODP"  , zpligprod1(:,:,:) * 1e9 * zfact * tmask(:,:,:) )
+         CALL iom_put( "LDETP"   , zpligprod2(:,:,:) * 1e9 * zfact * tmask(:,:,:) )
        ENDIF
+       CALL iom_put( "Mumax"   , zprmaxn(:,:,:) * tmask(:,:,:)  ) ! Maximum growth rate
+       CALL iom_put( "MuN"     , zprbio(:,:,:) * xlimphy(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for nanophyto
+       CALL iom_put( "MuD"     , zprdia(:,:,:) * xlimdia(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for diatoms
+       CALL iom_put( "LNlight" , zprbio (:,:,:) / (zprmaxn(:,:,:) + rtrn) * tmask(:,:,:)  )  ! light limitation term
+       CALL iom_put( "LDlight" , zprdia (:,:,:) / (zprmaxd(:,:,:) + rtrn) * tmask(:,:,:)   )
+       CALL iom_put( "TPP"     , ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:)  )  ! total primary production
+       CALL iom_put( "TPNEW"   , ( zpronewn(:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:)  ) ! total new production
+       CALL iom_put( "TPBFE"   , ( zprofen(:,:,:) + zprofed(:,:,:) ) * zfact * tmask(:,:,:)  )  ! total biogenic iron production
+       CALL iom_put( "tintpp"  , tpp * zfact )  !  global total integrated primary production molC/s
      ENDIF
 
-     IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+     IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
          WRITE(charout, FMT="('prod')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
      ENDIF
       !
@@ -490,8 +362,6 @@
       ENDIF
       !
-      REWIND( numnatp_ref )              ! Namelist nampisprod in reference namelist : Pisces phytoplankton production
       READ  ( numnatp_ref, namp4zprod, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namp4zprod in reference namelist' )
-      REWIND( numnatp_cfg )              ! Namelist nampisprod in configuration namelist : Pisces phytoplankton production
       READ  ( numnatp_cfg, namp4zprod, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namp4zprod in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zrem.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zrem.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zrem.F90	(revision 12928)
@@ -42,4 +42,6 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   denitr   !: denitrification array
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -49,5 +51,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_rem( kt, knt )
+   SUBROUTINE p4z_rem( kt, knt, Kbb, Kmm, Krhs )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_rem  ***
@@ -57,5 +59,6 @@
       !! ** Method  : - ???
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt, knt ! ocean time step
+      INTEGER, INTENT(in) ::   kt, knt         ! ocean time step
+      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level indices
       !
       INTEGER  ::   ji, jj, jk
@@ -68,5 +71,4 @@
       REAL(wp), DIMENSION(jpi,jpj    ) :: ztempbac
       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdepbac, zolimi, zdepprod, zfacsi, zfacsib, zdepeff, zfebact
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d
       !!---------------------------------------------------------------------
       !
@@ -86,155 +88,135 @@
       ! that was modeling explicitely bacteria
       ! -------------------------------------------------------
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zdep = MAX( hmld(ji,jj), heup(ji,jj) )
-               IF( gdept_n(ji,jj,jk) < zdep ) THEN
-                  zdepbac(ji,jj,jk) = MIN( 0.7 * ( trb(ji,jj,jk,jpzoo) + 2.* trb(ji,jj,jk,jpmes) ), 4.e-6 )
-                  ztempbac(ji,jj)   = zdepbac(ji,jj,jk)
-               ELSE
-                  zdepmin = MIN( 1., zdep / gdept_n(ji,jj,jk) )
-                  zdepbac (ji,jj,jk) = zdepmin**0.683 * ztempbac(ji,jj)
-                  zdepprod(ji,jj,jk) = zdepmin**0.273
-                  zdepeff (ji,jj,jk) = zdepeff(ji,jj,jk) * zdepmin**0.3
-               ENDIF
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpkm1 )
+         zdep = MAX( hmld(ji,jj), heup(ji,jj) )
+         IF( gdept(ji,jj,jk,Kmm) < zdep ) THEN
+            zdepbac(ji,jj,jk) = MIN( 0.7 * ( tr(ji,jj,jk,jpzoo,Kbb) + 2.* tr(ji,jj,jk,jpmes,Kbb) ), 4.e-6 )
+            ztempbac(ji,jj)   = zdepbac(ji,jj,jk)
+         ELSE
+            zdepmin = MIN( 1., zdep / gdept(ji,jj,jk,Kmm) )
+            zdepbac (ji,jj,jk) = zdepmin**0.683 * ztempbac(ji,jj)
+            zdepprod(ji,jj,jk) = zdepmin**0.273
+            zdepeff (ji,jj,jk) = zdepeff(ji,jj,jk) * zdepmin**0.3
+         ENDIF
+      END_3D
 
       IF( ln_p4z ) THEN
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  ! DOC ammonification. Depends on depth, phytoplankton biomass
-                  ! and a limitation term which is supposed to be a parameterization of the bacterial activity. 
-                  zremik = xremik * xstep / 1.e-6 * xlimbac(ji,jj,jk) * zdepbac(ji,jj,jk) 
-                  zremik = MAX( zremik, 2.74e-4 * xstep )
-                  ! Ammonification in oxic waters with oxygen consumption
-                  ! -----------------------------------------------------
-                  zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * trb(ji,jj,jk,jpdoc) 
-                  zolimi(ji,jj,jk) = MIN( ( trb(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit ) 
-                  ! Ammonification in suboxic waters with denitrification
-                  ! -------------------------------------------------------
-                  zammonic = zremik * nitrfac(ji,jj,jk) * trb(ji,jj,jk,jpdoc)
-                  denitr(ji,jj,jk)  = zammonic * ( 1. - nitrfac2(ji,jj,jk) )
-                  denitr(ji,jj,jk)  = MIN( ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenit, denitr(ji,jj,jk) )
-                  zoxyremc          = zammonic - denitr(ji,jj,jk)
-                  !
-                  zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) )
-                  denitr (ji,jj,jk) = MAX( 0.e0, denitr (ji,jj,jk) )
-                  zoxyremc          = MAX( 0.e0, zoxyremc )
-
-                  !
-                  tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc
-                  tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc
-                  tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - denitr (ji,jj,jk) * rdenit
-                  tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zolimi (ji,jj,jk) - denitr(ji,jj,jk) - zoxyremc
-                  tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - zolimi (ji,jj,jk) * o2ut
-                  tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc
-                  tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zolimi(ji,jj,jk) + zoxyremc    &
-                  &                     + ( rdenit + 1.) * denitr(ji,jj,jk) )
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, jpkm1 )
+            ! DOC ammonification. Depends on depth, phytoplankton biomass
+            ! and a limitation term which is supposed to be a parameterization of the bacterial activity. 
+            zremik = xremik * xstep / 1.e-6 * xlimbac(ji,jj,jk) * zdepbac(ji,jj,jk) 
+            zremik = MAX( zremik, 2.74e-4 * xstep )
+            ! Ammonification in oxic waters with oxygen consumption
+            ! -----------------------------------------------------
+            zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * tr(ji,jj,jk,jpdoc,Kbb) 
+            zolimi(ji,jj,jk) = MIN( ( tr(ji,jj,jk,jpoxy,Kbb) - rtrn ) / o2ut, zolimit ) 
+            ! Ammonification in suboxic waters with denitrification
+            ! -------------------------------------------------------
+            zammonic = zremik * nitrfac(ji,jj,jk) * tr(ji,jj,jk,jpdoc,Kbb)
+            denitr(ji,jj,jk)  = zammonic * ( 1. - nitrfac2(ji,jj,jk) )
+            denitr(ji,jj,jk)  = MIN( ( tr(ji,jj,jk,jpno3,Kbb) - rtrn ) / rdenit, denitr(ji,jj,jk) )
+            zoxyremc          = zammonic - denitr(ji,jj,jk)
+            !
+            zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) )
+            denitr (ji,jj,jk) = MAX( 0.e0, denitr (ji,jj,jk) )
+            zoxyremc          = MAX( 0.e0, zoxyremc )
+
+            !
+            tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc
+            tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc
+            tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - denitr (ji,jj,jk) * rdenit
+            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zolimi (ji,jj,jk) - denitr(ji,jj,jk) - zoxyremc
+            tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - zolimi (ji,jj,jk) * o2ut
+            tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc
+            tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zolimi(ji,jj,jk) + zoxyremc    &
+            &                     + ( rdenit + 1.) * denitr(ji,jj,jk) )
+         END_3D
       ELSE
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  ! DOC ammonification. Depends on depth, phytoplankton biomass
-                  ! and a limitation term which is supposed to be a parameterization of the bacterial activity. 
-                  ! -----------------------------------------------------------------
-                  zremik = xstep / 1.e-6 * MAX(0.01, xlimbac(ji,jj,jk)) * zdepbac(ji,jj,jk) 
-                  zremik = MAX( zremik, 2.74e-4 * xstep / xremikc )
-
-                  zremikc = xremikc * zremik
-                  zremikn = xremikn / xremikc
-                  zremikp = xremikp / xremikc
-
-                  ! Ammonification in oxic waters with oxygen consumption
-                  ! -----------------------------------------------------
-                  zolimit = zremikc * ( 1.- nitrfac(ji,jj,jk) ) * trb(ji,jj,jk,jpdoc) 
-                  zolimic = MAX( 0.e0, MIN( ( trb(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit ) ) 
-                  zolimi(ji,jj,jk) = zolimic
-                  zolimin = zremikn * zolimic * trb(ji,jj,jk,jpdon) / ( trb(ji,jj,jk,jpdoc) + rtrn )
-                  zolimip = zremikp * zolimic * trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdoc) + rtrn ) 
-
-                  ! Ammonification in suboxic waters with denitrification
-                  ! -------------------------------------------------------
-                  zammonic = zremikc * nitrfac(ji,jj,jk) * trb(ji,jj,jk,jpdoc)
-                  denitr(ji,jj,jk)  = zammonic * ( 1. - nitrfac2(ji,jj,jk) )
-                  denitr(ji,jj,jk)  = MAX(0., MIN(  ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenit, denitr(ji,jj,jk) ) )
-                  zoxyremc          = MAX(0., zammonic - denitr(ji,jj,jk))
-                  zdenitrn  = zremikn * denitr(ji,jj,jk) * trb(ji,jj,jk,jpdon) / ( trb(ji,jj,jk,jpdoc) + rtrn )
-                  zdenitrp  = zremikp * denitr(ji,jj,jk) * trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdoc) + rtrn )
-                  zoxyremn  = zremikn * zoxyremc * trb(ji,jj,jk,jpdon) / ( trb(ji,jj,jk,jpdoc) + rtrn )
-                  zoxyremp  = zremikp * zoxyremc * trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdoc) + rtrn )
-
-                  tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zolimip + zdenitrp + zoxyremp
-                  tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zolimin + zdenitrn + zoxyremn
-                  tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - denitr(ji,jj,jk) * rdenit
-                  tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zolimic - denitr(ji,jj,jk) - zoxyremc
-                  tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) - zolimin - zdenitrn - zoxyremn
-                  tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) - zolimip - zdenitrp - zoxyremp
-                  tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - zolimic * o2ut
-                  tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zolimic + denitr(ji,jj,jk) + zoxyremc
-                  tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zolimin + zoxyremn + ( rdenit + 1.) * zdenitrn )
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, jpkm1 )
+            ! DOC ammonification. Depends on depth, phytoplankton biomass
+            ! and a limitation term which is supposed to be a parameterization of the bacterial activity. 
+            ! -----------------------------------------------------------------
+            zremik = xstep / 1.e-6 * MAX(0.01, xlimbac(ji,jj,jk)) * zdepbac(ji,jj,jk) 
+            zremik = MAX( zremik, 2.74e-4 * xstep / xremikc )
+
+            zremikc = xremikc * zremik
+            zremikn = xremikn / xremikc
+            zremikp = xremikp / xremikc
+
+            ! Ammonification in oxic waters with oxygen consumption
+            ! -----------------------------------------------------
+            zolimit = zremikc * ( 1.- nitrfac(ji,jj,jk) ) * tr(ji,jj,jk,jpdoc,Kbb) 
+            zolimic = MAX( 0.e0, MIN( ( tr(ji,jj,jk,jpoxy,Kbb) - rtrn ) / o2ut, zolimit ) ) 
+            zolimi(ji,jj,jk) = zolimic
+            zolimin = zremikn * zolimic * tr(ji,jj,jk,jpdon,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn )
+            zolimip = zremikp * zolimic * tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 
+
+            ! Ammonification in suboxic waters with denitrification
+            ! -------------------------------------------------------
+            zammonic = zremikc * nitrfac(ji,jj,jk) * tr(ji,jj,jk,jpdoc,Kbb)
+            denitr(ji,jj,jk)  = zammonic * ( 1. - nitrfac2(ji,jj,jk) )
+            denitr(ji,jj,jk)  = MAX(0., MIN(  ( tr(ji,jj,jk,jpno3,Kbb) - rtrn ) / rdenit, denitr(ji,jj,jk) ) )
+            zoxyremc          = MAX(0., zammonic - denitr(ji,jj,jk))
+            zdenitrn  = zremikn * denitr(ji,jj,jk) * tr(ji,jj,jk,jpdon,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn )
+            zdenitrp  = zremikp * denitr(ji,jj,jk) * tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn )
+            zoxyremn  = zremikn * zoxyremc * tr(ji,jj,jk,jpdon,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn )
+            zoxyremp  = zremikp * zoxyremc * tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn )
+
+            tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zolimip + zdenitrp + zoxyremp
+            tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zolimin + zdenitrn + zoxyremn
+            tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - denitr(ji,jj,jk) * rdenit
+            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zolimic - denitr(ji,jj,jk) - zoxyremc
+            tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) - zolimin - zdenitrn - zoxyremn
+            tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) - zolimip - zdenitrp - zoxyremp
+            tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - zolimic * o2ut
+            tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zolimic + denitr(ji,jj,jk) + zoxyremc
+            tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zolimin + zoxyremn + ( rdenit + 1.) * zdenitrn )
+         END_3D
          !
       ENDIF
 
 
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ! NH4 nitrification to NO3. Ceased for oxygen concentrations
-               ! below 2 umol/L. Inhibited at strong light 
-               ! ----------------------------------------------------------
-               zonitr  = nitrif * xstep * trb(ji,jj,jk,jpnh4) * ( 1.- nitrfac(ji,jj,jk) )  &
-               &         / ( 1.+ emoy(ji,jj,jk) ) * ( 1. + fr_i(ji,jj) * emoy(ji,jj,jk) ) 
-               zdenitnh4 = nitrif * xstep * trb(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk)
-               zdenitnh4 = MIN(  ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenita, zdenitnh4 ) 
-               ! Update of the tracers trends
-               ! ----------------------------
-               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr - zdenitnh4
-               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr - rdenita * zdenitnh4
-               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2nit * zonitr
-               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2 * rno3 * zonitr + rno3 * ( rdenita - 1. ) * zdenitnh4
-            END DO
-         END DO
-      END DO
-
-       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+      DO_3D_11_11( 1, jpkm1 )
+         ! NH4 nitrification to NO3. Ceased for oxygen concentrations
+         ! below 2 umol/L. Inhibited at strong light 
+         ! ----------------------------------------------------------
+         zonitr  = nitrif * xstep * tr(ji,jj,jk,jpnh4,Kbb) * ( 1.- nitrfac(ji,jj,jk) )  &
+         &         / ( 1.+ emoy(ji,jj,jk) ) * ( 1. + fr_i(ji,jj) * emoy(ji,jj,jk) ) 
+         zdenitnh4 = nitrif * xstep * tr(ji,jj,jk,jpnh4,Kbb) * nitrfac(ji,jj,jk)
+         zdenitnh4 = MIN(  ( tr(ji,jj,jk,jpno3,Kbb) - rtrn ) / rdenita, zdenitnh4 ) 
+         ! Update of the tracers trends
+         ! ----------------------------
+         tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zonitr - zdenitnh4
+         tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + zonitr - rdenita * zdenitnh4
+         tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2nit * zonitr
+         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2 * rno3 * zonitr + rno3 * ( rdenita - 1. ) * zdenitnh4
+      END_3D
+
+       IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
          WRITE(charout, FMT="('rem1')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
        ENDIF
 
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-
-               ! Bacterial uptake of iron. No iron is available in DOC. So
-               ! Bacteries are obliged to take up iron from the water. Some
-               ! studies (especially at Papa) have shown this uptake to be significant
-               ! ----------------------------------------------------------
-               zbactfer = feratb *  rfact2 * 0.6_wp / rday * tgfunc(ji,jj,jk) * xlimbacl(ji,jj,jk)     &
-                  &              * trb(ji,jj,jk,jpfer) / ( xkferb + trb(ji,jj,jk,jpfer) )    &
-                  &              * zdepprod(ji,jj,jk) * zdepeff(ji,jj,jk) * zdepbac(ji,jj,jk)
-               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zbactfer*0.33
-               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zbactfer*0.25
-               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zbactfer*0.08
-               zfebact(ji,jj,jk)   = zbactfer * 0.33
-               blim(ji,jj,jk)      = xlimbacl(ji,jj,jk)  * zdepbac(ji,jj,jk) / 1.e-6 * zdepprod(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+      DO_3D_11_11( 1, jpkm1 )
+
+         ! Bacterial uptake of iron. No iron is available in DOC. So
+         ! Bacteries are obliged to take up iron from the water. Some
+         ! studies (especially at Papa) have shown this uptake to be significant
+         ! ----------------------------------------------------------
+         zbactfer = feratb *  rfact2 * 0.6_wp / rday * tgfunc(ji,jj,jk) * xlimbacl(ji,jj,jk)     &
+            &              * tr(ji,jj,jk,jpfer,Kbb) / ( xkferb + tr(ji,jj,jk,jpfer,Kbb) )    &
+            &              * zdepprod(ji,jj,jk) * zdepeff(ji,jj,jk) * zdepbac(ji,jj,jk)
+         tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zbactfer*0.33
+         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zbactfer*0.25
+         tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zbactfer*0.08
+         zfebact(ji,jj,jk)   = zbactfer * 0.33
+         blim(ji,jj,jk)      = xlimbacl(ji,jj,jk)  * zdepbac(ji,jj,jk) / 1.e-6 * zdepprod(ji,jj,jk)
+      END_3D
+
+       IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
          WRITE(charout, FMT="('rem2')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
        ENDIF
 
@@ -243,58 +225,42 @@
       ! ---------------------------------------------------------------
 
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zdep     = MAX( hmld(ji,jj), heup_01(ji,jj) )
-               zsatur   = MAX( rtrn, ( sio3eq(ji,jj,jk) - trb(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) )
-               zsatur2  = ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**37
-               znusil   = 0.225  * ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) * zsatur + 0.775 * zsatur2 * zsatur**9.25
-               ! Remineralization rate of BSi depedant on T and saturation
-               ! ---------------------------------------------------------
-               IF ( gdept_n(ji,jj,jk) > zdep ) THEN
-                  zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk-1) * EXP( -0.5 * ( xsiremlab - xsirem )  &
-                  &                   * znusil * e3t_n(ji,jj,jk) / wsbio4(ji,jj,jk) )
-                  zfacsi(ji,jj,jk)  = zfacsib(ji,jj,jk) / ( 1.0 + zfacsib(ji,jj,jk) )
-                  zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk) * EXP( -0.5 * ( xsiremlab - xsirem )    &
-                  &                   * znusil * e3t_n(ji,jj,jk) / wsbio4(ji,jj,jk) )
-               ENDIF
-               zsiremin = ( xsiremlab * zfacsi(ji,jj,jk) + xsirem * ( 1. - zfacsi(ji,jj,jk) ) ) * xstep * znusil
-               zosil    = zsiremin * trb(ji,jj,jk,jpgsi)
-               !
-               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) - zosil
-               tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + zosil
-            END DO
-         END DO
-      END DO
-
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+      DO_3D_11_11( 1, jpkm1 )
+         zdep     = MAX( hmld(ji,jj), heup_01(ji,jj) )
+         zsatur   = MAX( rtrn, ( sio3eq(ji,jj,jk) - tr(ji,jj,jk,jpsil,Kbb) ) / ( sio3eq(ji,jj,jk) + rtrn ) )
+         zsatur2  = ( 1. + ts(ji,jj,jk,jp_tem,Kmm) / 400.)**37
+         znusil   = 0.225  * ( 1. + ts(ji,jj,jk,jp_tem,Kmm) / 15.) * zsatur + 0.775 * zsatur2 * zsatur**9.25
+         ! Remineralization rate of BSi depedant on T and saturation
+         ! ---------------------------------------------------------
+         IF ( gdept(ji,jj,jk,Kmm) > zdep ) THEN
+            zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk-1) * EXP( -0.5 * ( xsiremlab - xsirem )  &
+            &                   * znusil * e3t(ji,jj,jk,Kmm) / wsbio4(ji,jj,jk) )
+            zfacsi(ji,jj,jk)  = zfacsib(ji,jj,jk) / ( 1.0 + zfacsib(ji,jj,jk) )
+            zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk) * EXP( -0.5 * ( xsiremlab - xsirem )    &
+            &                   * znusil * e3t(ji,jj,jk,Kmm) / wsbio4(ji,jj,jk) )
+         ENDIF
+         zsiremin = ( xsiremlab * zfacsi(ji,jj,jk) + xsirem * ( 1. - zfacsi(ji,jj,jk) ) ) * xstep * znusil
+         zosil    = zsiremin * tr(ji,jj,jk,jpgsi,Kbb)
+         !
+         tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) - zosil
+         tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) + zosil
+      END_3D
+
+      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
          WRITE(charout, FMT="('rem3')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
        ENDIF
 
       IF( knt == nrdttrc ) THEN
-          zrfact2 = 1.e3 * rfact2r
-          ALLOCATE( zw3d(jpi,jpj,jpk) )
-          zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s
+          zrfact2 = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s
           !
-          IF( iom_use( "REMIN" ) )  THEN
-              zw3d(:,:,:) = zolimi(:,:,:) * tmask(:,:,:) * zfact !  Remineralisation rate
-              CALL iom_put( "REMIN"  , zw3d )
+          IF( iom_use( "REMIN" ) )  THEN !  Remineralisation rate
+             zolimi(:,:,jpk) = 0. ; CALL iom_put( "REMIN"  , zolimi(:,:,:) * tmask(:,:,:) * zrfact2  )
           ENDIF
-          IF( iom_use( "DENIT" ) )  THEN
-              zw3d(:,:,:) = denitr(:,:,:) * rdenit * rno3 * tmask(:,:,:) * zfact ! Denitrification
-              CALL iom_put( "DENIT"  , zw3d )
+          CALL iom_put( "DENIT"  , denitr(:,:,:) * rdenit * rno3 * tmask(:,:,:) * zrfact2 ) ! Denitrification 
+          IF( iom_use( "BACT" ) )  THEN ! Bacterial biomass
+             zdepbac(:,:,jpk) = 0.  ;   CALL iom_put( "BACT", zdepbac(:,:,:) * 1.E6 * tmask(:,:,:) )
           ENDIF
-          IF( iom_use( "BACT" ) )  THEN
-               zw3d(:,:,:) = zdepbac(:,:,:) * 1.E6 * tmask(:,:,:)  ! Bacterial biomass
-               CALL iom_put( "BACT", zw3d )
-          ENDIF
-          IF( iom_use( "FEBACT" ) )  THEN
-               zw3d(:,:,:) = zfebact(:,:,:) * 1E9 * tmask(:,:,:) * zrfact2   ! Bacterial iron consumption
-               CALL iom_put( "FEBACT" , zw3d )
-          ENDIF
-          !
-          DEALLOCATE( zw3d )
+          CALL iom_put( "FEBACT" , zfebact(:,:,:) * 1E9 * tmask(:,:,:) * zrfact2  )
        ENDIF
       !
@@ -327,8 +293,6 @@
       ENDIF
       !
-      REWIND( numnatp_ref )              ! Namelist nampisrem in reference namelist : Pisces remineralization
       READ  ( numnatp_ref, nampisrem, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisrem in reference namelist' )
-      REWIND( numnatp_cfg )              ! Namelist nampisrem in configuration namelist : Pisces remineralization
       READ  ( numnatp_cfg, nampisrem, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisrem in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zsbc.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zsbc.F90	(revision 12384)
+++ 	(revision )
@@ -1,497 +1,0 @@
-MODULE p4zsbc
-   !!======================================================================
-   !!                         ***  MODULE p4sbc  ***
-   !! TOP :   PISCES surface boundary conditions of external inputs of nutrients
-   !!======================================================================
-   !! History :   3.5  !  2012-07 (O. Aumont, C. Ethe) Original code
-   !!----------------------------------------------------------------------
-   !!   p4z_sbc        :  Read and interpolate time-varying nutrients fluxes
-   !!   p4z_sbc_init   :  Initialization of p4z_sbc
-   !!----------------------------------------------------------------------
-   USE oce_trc         !  shared variables between ocean and passive tracers
-   USE trc             !  passive tracers common variables 
-   USE sms_pisces      !  PISCES Source Minus Sink variables
-   USE iom             !  I/O manager
-   USE fldread         !  time interpolation
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   p4z_sbc
-   PUBLIC   p4z_sbc_init   
-
-   LOGICAL , PUBLIC ::   ln_dust      !: boolean for dust input from the atmosphere
-   LOGICAL , PUBLIC ::   ln_solub     !: boolean for variable solubility of atmospheric iron
-   LOGICAL , PUBLIC ::   ln_river     !: boolean for river input of nutrients
-   LOGICAL , PUBLIC ::   ln_ndepo     !: boolean for atmospheric deposition of N
-   LOGICAL , PUBLIC ::   ln_ironsed   !: boolean for Fe input from sediments
-   LOGICAL , PUBLIC ::   ln_hydrofe   !: boolean for Fe input from hydrothermal vents
-   REAL(wp), PUBLIC ::   sedfeinput   !: Coastal release of Iron
-   REAL(wp), PUBLIC ::   dustsolub    !: Solubility of the dust
-   REAL(wp), PUBLIC ::   mfrac        !: Mineral Content of the dust
-   REAL(wp), PUBLIC ::   icefeinput   !: Iron concentration in sea ice
-   REAL(wp), PUBLIC ::   wdust        !: Sinking speed of the dust 
-   REAL(wp), PUBLIC ::   nitrfix      !: Nitrogen fixation rate   
-   REAL(wp), PUBLIC ::   diazolight   !: Nitrogen fixation sensitivty to light 
-   REAL(wp), PUBLIC ::   concfediaz   !: Fe half-saturation Cste for diazotrophs 
-   REAL(wp)         ::   hratio       !: Fe:3He ratio assumed for vent iron supply
-   REAL(wp)         ::   distcoast    !: Distance off the coast for Iron from sediments
-   REAL(wp), PUBLIC ::   lgw_rath     !: Weak ligand ratio from hydro sources
-
-   LOGICAL , PUBLIC ::   ll_sbc
-   LOGICAL          ::   ll_solub
-
-   INTEGER , PARAMETER  :: jpriv  = 7   !: Maximum number of river input fields
-   INTEGER , PARAMETER  :: jr_dic = 1   !: index of dissolved inorganic carbon
-   INTEGER , PARAMETER  :: jr_doc = 2   !: index of dissolved organic carbon
-   INTEGER , PARAMETER  :: jr_din = 3   !: index of dissolved inorganic nitrogen
-   INTEGER , PARAMETER  :: jr_don = 4   !: index of dissolved organic nitrogen
-   INTEGER , PARAMETER  :: jr_dip = 5   !: index of dissolved inorganic phosporus
-   INTEGER , PARAMETER  :: jr_dop = 6   !: index of dissolved organic phosphorus
-   INTEGER , PARAMETER  :: jr_dsi = 7   !: index of dissolved silicate
-
-   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_dust      ! structure of input dust
-   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_solub     ! structure of input dust
-   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_river     ! structure of input riverdic
-   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_ndepo     ! structure of input nitrogen deposition
-   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_ironsed   ! structure of input iron from sediment
-   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_hydrofe   ! structure of input iron from hydrothermal vents
-
-   INTEGER , PARAMETER ::   nbtimes = 365                          ! maximum number of times record in a file
-   INTEGER             ::   ntimes_dust, ntimes_riv, ntimes_ndep   ! number of time steps in a file
-   INTEGER             ::   ntimes_solub, ntimes_hydro             ! number of time steps in a file
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dust  , solub    !: dust fields
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rivdic, rivalk   !: river input fields
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rivdin, rivdip   !: river input fields
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rivdon, rivdop   !: river input fields
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rivdoc           !: river input fields
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rivdsi           !: river input fields
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   nitdep           !: atmospheric N deposition 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ironsed          !: Coastal supply of iron
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hydrofe          !: Hydrothermal vent supply of iron
-
-   REAL(wp), PUBLIC :: sedsilfrac, sedcalfrac
-   REAL(wp), PUBLIC :: rivalkinput, rivdicinput
-   REAL(wp), PUBLIC :: rivdininput, rivdipinput, rivdsiinput
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
-   !! $Id$ 
-   !! Software governed by the CeCILL license (see ./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE p4z_sbc( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine p4z_sbc  ***
-      !!
-      !! ** purpose :   read and interpolate the external sources of nutrients
-      !!
-      !! ** method  :   read the files and interpolate the appropriate variables
-      !!
-      !! ** input   :   external netcdf files
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time step
-      !
-      INTEGER  ::   ji, jj 
-      REAL(wp) ::   zcoef, zyyss
-      !!---------------------------------------------------------------------
-      !
-      IF( ln_timing )   CALL timing_start('p4z_sbc')
-      !
-      ! Compute dust at nit000 or only if there is more than 1 time record in dust file
-      IF( ln_dust ) THEN
-         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_dust > 1 ) ) THEN
-            CALL fld_read( kt, 1, sf_dust )
-            dust(:,:) = MAX( rtrn, sf_dust(1)%fnow(:,:,1) ) * ( 1.0 - fr_i(:,:) )
-         ENDIF
-      ENDIF
-      !
-      IF( ll_solub ) THEN
-         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_solub > 1 ) ) THEN
-            CALL fld_read( kt, 1, sf_solub )
-            solub(:,:) = sf_solub(1)%fnow(:,:,1)
-         ENDIF
-      ENDIF
-
-      ! N/P and Si releases due to coastal rivers
-      ! Compute river at nit000 or only if there is more than 1 time record in river file
-      ! -----------------------------------------
-      IF( ln_river ) THEN
-         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_riv > 1 ) ) THEN
-            CALL fld_read( kt, 1, sf_river )
-            IF( ln_p4z ) THEN
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj) 
-                     rivalk(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)  &
-                        &              * 1.E3        / ( 12. * zcoef + rtrn )
-                     rivdic(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)  &
-                        &              * 1.E3         / ( 12. * zcoef + rtrn )
-                     rivdin(ji,jj) =   sf_river(jr_din)%fnow(ji,jj,1)  &
-                        &              * 1.E3 / rno3 / ( 14. * zcoef + rtrn )
-                     rivdip(ji,jj) =   sf_river(jr_dip)%fnow(ji,jj,1)  &
-                        &              * 1.E3 / po4r / ( 31. * zcoef + rtrn )
-                     rivdsi(ji,jj) =   sf_river(jr_dsi)%fnow(ji,jj,1)  &
-                        &              * 1.E3        / ( 28.1 * zcoef + rtrn )
-                     rivdoc(ji,jj) =   sf_river(jr_doc)%fnow(ji,jj,1)  &
-                        &              * 1.E3        / ( 12. * zcoef + rtrn ) 
-                  END DO
-               END DO
-            ELSE    !  ln_p5z
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj) 
-                     rivalk(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)                                    &
-                        &              * 1.E3        / ( 12. * zcoef + rtrn )
-                     rivdic(ji,jj) = ( sf_river(jr_dic)%fnow(ji,jj,1) ) &
-                        &              * 1.E3 / ( 12. * zcoef + rtrn ) * tmask(ji,jj,1)
-                     rivdin(ji,jj) = ( sf_river(jr_din)%fnow(ji,jj,1) ) &
-                        &              * 1.E3 / rno3 / ( 14. * zcoef + rtrn ) * tmask(ji,jj,1)
-                     rivdip(ji,jj) = ( sf_river(jr_dip)%fnow(ji,jj,1) ) &
-                        &              * 1.E3 / po4r / ( 31. * zcoef + rtrn ) * tmask(ji,jj,1)
-                     rivdon(ji,jj) = ( sf_river(jr_don)%fnow(ji,jj,1) ) &
-                        &              * 1.E3 / rno3 / ( 14. * zcoef + rtrn ) * tmask(ji,jj,1)
-                     rivdop(ji,jj) = ( sf_river(jr_dop)%fnow(ji,jj,1) ) &
-                        &              * 1.E3 / po4r / ( 31. * zcoef + rtrn ) * tmask(ji,jj,1)
-                     rivdsi(ji,jj) =   sf_river(jr_dsi)%fnow(ji,jj,1)  &
-                        &              * 1.E3        / ( 28.1 * zcoef + rtrn )
-                     rivdoc(ji,jj) =   sf_river(jr_doc)%fnow(ji,jj,1)  &
-                        &              * 1.E3        / ( 12. * zcoef + rtrn )
-                  END DO
-               END DO
-            ENDIF
-         ENDIF
-      ENDIF
-
-      ! Compute N deposition at nit000 or only if there is more than 1 time record in N deposition file
-      IF( ln_ndepo ) THEN
-         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_ndep > 1 ) ) THEN
-             zcoef = 14. * rno3
-             CALL fld_read( kt, 1, sf_ndepo )
-             nitdep(:,:) = MAX( rtrn, sf_ndepo(1)%fnow(:,:,1) / zcoef / e3t_n(:,:,1) )
-         ENDIF
-         IF( .NOT.ln_linssh ) THEN
-            zcoef = 14. * rno3
-            nitdep(:,:) = MAX( rtrn, sf_ndepo(1)%fnow(:,:,1) / zcoef / e3t_n(:,:,1) )
-         ENDIF
-      ENDIF
-      !
-      IF( ln_timing )  CALL timing_stop('p4z_sbc')
-      !
-   END SUBROUTINE p4z_sbc
-
-
-   SUBROUTINE p4z_sbc_init
-      !!----------------------------------------------------------------------
-      !!                  ***  routine p4z_sbc_init  ***
-      !!
-      !! ** purpose :   initialization of the external sources of nutrients
-      !!
-      !! ** method  :   read the files and compute the budget
-      !!                called at the first timestep (nittrc000)
-      !!
-      !! ** input   :   external netcdf files
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER  :: ji, jj, jk, jm, ifpr
-      INTEGER  :: ii0, ii1, ij0, ij1
-      INTEGER  :: numdust, numsolub, numriv, numiron, numdepo, numhydro
-      INTEGER  :: ierr, ierr1, ierr2, ierr3
-      INTEGER  :: ios                 ! Local integer output status for namelist read
-      INTEGER  :: ik50                !  last level where depth less than 50 m
-      INTEGER  :: isrow             ! index for ORCA1 starting row
-      REAL(wp) :: zexpide, zdenitide, zmaskt, zsurfc, zsurfp,ze3t, ze3t2, zcslp
-      REAL(wp) :: ztimes_dust, ztimes_riv, ztimes_ndep 
-      REAL(wp), DIMENSION(:), ALLOCATABLE :: rivinput
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zriver, zcmask
-      !
-      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files
-      TYPE(FLD_N), DIMENSION(jpriv) ::  slf_river    ! array of namelist informations on the fields to read
-      TYPE(FLD_N) ::   sn_dust, sn_solub, sn_ndepo, sn_ironsed, sn_hydrofe   ! informations about the fields to be read
-      TYPE(FLD_N) ::   sn_riverdoc, sn_riverdic, sn_riverdsi   ! informations about the fields to be read
-      TYPE(FLD_N) ::   sn_riverdin, sn_riverdon, sn_riverdip, sn_riverdop
-      !!
-      NAMELIST/nampissbc/cn_dir, sn_dust, sn_solub, sn_riverdic, sn_riverdoc, sn_riverdin, sn_riverdon,     &
-        &                sn_riverdip, sn_riverdop, sn_riverdsi, sn_ndepo, sn_ironsed, sn_hydrofe, &
-        &                ln_dust, ln_solub, ln_river, ln_ndepo, ln_ironsed, ln_ironice, ln_hydrofe,    &
-        &                sedfeinput, distcoast, dustsolub, icefeinput, wdust, mfrac, nitrfix, diazolight, concfediaz, &
-        &                hratio, lgw_rath
-      !!----------------------------------------------------------------------
-      !
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'p4z_sbc_init : initialization of the external sources of nutrients '
-         WRITE(numout,*) '~~~~~~~~~~~~ '
-      ENDIF
-      !                            !* set file information
-      REWIND( numnatp_ref )              ! Namelist nampissbc in reference namelist : Pisces external sources of nutrients
-      READ  ( numnatp_ref, nampissbc, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampissbc in reference namelist' )
-      REWIND( numnatp_cfg )              ! Namelist nampissbc in configuration namelist : Pisces external sources of nutrients
-      READ  ( numnatp_cfg, nampissbc, IOSTAT = ios, ERR = 902 )
-902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampissbc in configuration namelist' )
-      IF(lwm) WRITE ( numonp, nampissbc )
-
-      IF(lwp) THEN
-         WRITE(numout,*) '   Namelist : nampissbc '
-         WRITE(numout,*) '      dust input from the atmosphere           ln_dust     = ', ln_dust
-         WRITE(numout,*) '      Variable solubility of iron input        ln_solub    = ', ln_solub
-         WRITE(numout,*) '      river input of nutrients                 ln_river    = ', ln_river
-         WRITE(numout,*) '      atmospheric deposition of n              ln_ndepo    = ', ln_ndepo
-         WRITE(numout,*) '      Fe input from sediments                  ln_ironsed  = ', ln_ironsed
-         WRITE(numout,*) '      Fe input from seaice                     ln_ironice  = ', ln_ironice
-         WRITE(numout,*) '      fe input from hydrothermal vents         ln_hydrofe  = ', ln_hydrofe
-         WRITE(numout,*) '      coastal release of iron                  sedfeinput  = ', sedfeinput
-         WRITE(numout,*) '      distance off the coast                   distcoast   = ', distcoast
-         WRITE(numout,*) '      solubility of the dust                   dustsolub   = ', dustsolub
-         WRITE(numout,*) '      Mineral Fe content of the dust           mfrac       = ', mfrac
-         WRITE(numout,*) '      Iron concentration in sea ice            icefeinput  = ', icefeinput
-         WRITE(numout,*) '      sinking speed of the dust                wdust       = ', wdust
-         WRITE(numout,*) '      nitrogen fixation rate                   nitrfix     = ', nitrfix
-         WRITE(numout,*) '      nitrogen fixation sensitivty to light    diazolight  = ', diazolight
-         WRITE(numout,*) '      Fe half-saturation cste for diazotrophs  concfediaz  = ', concfediaz
-         WRITE(numout,*) '      Fe to 3He ratio assumed for vent iron supply hratio  = ', hratio
-         IF( ln_ligand ) THEN
-            WRITE(numout,*) '      Weak ligand ratio from sed hydro sources  lgw_rath   = ', lgw_rath
-         ENDIF
-      END IF
-
-      IF( ln_dust .OR. ln_river .OR. ln_ndepo ) THEN   ;   ll_sbc = .TRUE.
-      ELSE                                             ;   ll_sbc = .FALSE.
-      ENDIF
-
-      IF( ln_dust .AND. ln_solub ) THEN                ;   ll_solub = .TRUE.
-      ELSE                                             ;   ll_solub = .FALSE.
-      ENDIF
-
-      ! set the number of level over which river runoffs are applied 
-      ! online configuration : computed in sbcrnf
-      IF( l_offline ) THEN
-        nk_rnf(:,:) = 1
-        h_rnf (:,:) = gdept_n(:,:,1)
-      ENDIF
-
-      ! dust input from the atmosphere
-      ! ------------------------------
-      IF( ln_dust ) THEN 
-         !
-         IF(lwp) WRITE(numout,*) '    initialize dust input from atmosphere '
-         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
-         !
-         ALLOCATE( dust(jpi,jpj) )    ! allocation
-         !
-         ALLOCATE( sf_dust(1), STAT=ierr )           !* allocate and fill sf_sst (forcing structure) with sn_sst
-         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_dust structure' )
-         !
-         CALL fld_fill( sf_dust, (/ sn_dust /), cn_dir, 'p4z_sed_init', 'Atmospheric dust deposition', 'nampissed' )
-                                   ALLOCATE( sf_dust(1)%fnow(jpi,jpj,1)   )
-         IF( sn_dust%ln_tint )     ALLOCATE( sf_dust(1)%fdta(jpi,jpj,1,2) )
-         !
-         IF( Agrif_Root() ) THEN   !  Only on the master grid
-            ! Get total input dust ; need to compute total atmospheric supply of Si in a year
-            CALL iom_open (  TRIM( sn_dust%clname ) , numdust )
-            ntimes_dust = iom_getszuld( numdust )   ! get number of record in file
-         END IF
-      END IF
-
-      ! Solubility of dust deposition of iron
-      ! Only if ln_dust and ln_solubility set to true (ll_solub = .true.)
-      ! -----------------------------------------------------------------
-      IF( ll_solub ) THEN
-         !
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '   ==>>>   ll_solub=T , initialize variable solubility of Fe '
-         !
-         ALLOCATE( solub(jpi,jpj) )    ! allocation
-         !
-         ALLOCATE( sf_solub(1), STAT=ierr )           !* allocate and fill sf_sst (forcing structure) with sn_sst
-         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_solub structure' )
-         !
-         CALL fld_fill( sf_solub, (/ sn_solub /), cn_dir, 'p4z_sed_init', 'Solubility of atm. iron ', 'nampissed' )
-                                   ALLOCATE( sf_solub(1)%fnow(jpi,jpj,1)   )
-         IF( sn_solub%ln_tint )    ALLOCATE( sf_solub(1)%fdta(jpi,jpj,1,2) )
-         ! get number of record in file
-         CALL iom_open (  TRIM( sn_solub%clname ) , numsolub )
-         ntimes_solub = iom_getszuld( numsolub )   ! get number of record in file
-         CALL iom_close( numsolub )
-      ENDIF
-
-      ! nutrient input from rivers
-      ! --------------------------
-      IF( ln_river ) THEN
-         !
-         slf_river(jr_dic) = sn_riverdic   ;   slf_river(jr_doc) = sn_riverdoc   ;   slf_river(jr_din) = sn_riverdin 
-         slf_river(jr_don) = sn_riverdon   ;   slf_river(jr_dip) = sn_riverdip   ;   slf_river(jr_dop) = sn_riverdop
-         slf_river(jr_dsi) = sn_riverdsi  
-         !
-         ALLOCATE( rivdic(jpi,jpj), rivalk(jpi,jpj), rivdin(jpi,jpj), rivdip(jpi,jpj), rivdsi(jpi,jpj), rivdoc(jpi,jpj) ) 
-         IF( ln_p5z )  ALLOCATE( rivdon(jpi,jpj), rivdop(jpi,jpj) )
-         !
-         ALLOCATE( sf_river(jpriv), rivinput(jpriv), STAT=ierr1 )    !* allocate and fill sf_river (forcing structure) with sn_river_
-         rivinput(:) = 0._wp
-
-         IF( ierr1 > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_irver structure' )
-         !
-         CALL fld_fill( sf_river, slf_river, cn_dir, 'p4z_sed_init', 'Input from river ', 'nampissed' )
-         DO ifpr = 1, jpriv
-                                          ALLOCATE( sf_river(ifpr)%fnow(jpi,jpj,1  ) )
-            IF( slf_river(ifpr)%ln_tint ) ALLOCATE( sf_river(ifpr)%fdta(jpi,jpj,1,2) )
-         END DO
-         IF( Agrif_Root() ) THEN   !  Only on the master grid
-            ! Get total input rivers ; need to compute total river supply in a year
-            DO ifpr = 1, jpriv
-               CALL iom_open ( TRIM( slf_river(ifpr)%clname ), numriv )
-               ntimes_riv = iom_getszuld( numriv )
-               ALLOCATE( zriver(jpi,jpj,ntimes_riv) )
-               DO jm = 1, ntimes_riv
-                  CALL iom_get( numriv, jpdom_data, TRIM( slf_river(ifpr)%clvar ), zriver(:,:,jm), jm )
-               END DO
-               CALL iom_close( numriv )
-               ztimes_riv = 1._wp / REAL(ntimes_riv, wp) 
-               DO jm = 1, ntimes_riv
-                  rivinput(ifpr) = rivinput(ifpr) + glob_sum( 'p4zsbc', zriver(:,:,jm) * tmask(:,:,1) * ztimes_riv ) 
-               END DO
-               DEALLOCATE( zriver)
-            END DO
-            ! N/P and Si releases due to coastal rivers
-            ! -----------------------------------------
-            rivdicinput = (rivinput(jr_dic) + rivinput(jr_doc) ) * 1E3 / 12._wp
-            rivdininput = (rivinput(jr_din) + rivinput(jr_don) ) * 1E3 / rno3 / 14._wp
-            rivdipinput = (rivinput(jr_dip) + rivinput(jr_dop) ) * 1E3 / po4r / 31._wp
-            rivdsiinput = rivinput(jr_dsi) * 1E3 / 28.1_wp
-            rivalkinput = rivinput(jr_dic) * 1E3 / 12._wp
-            !
-         ENDIF
-      ELSE
-         rivdicinput = 0._wp
-         rivdininput = 0._wp
-         rivdipinput = 0._wp
-         rivdsiinput = 0._wp
-         rivalkinput = 0._wp
-      END IF 
-      ! nutrient input from dust
-      ! ------------------------
-      IF( ln_ndepo ) THEN
-         !
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '   ==>>>   ln_ndepo=T , initialize the nutrient input by dust from NetCDF file'
-         !
-         ALLOCATE( nitdep(jpi,jpj) )    ! allocation
-         !
-         ALLOCATE( sf_ndepo(1), STAT=ierr3 )           !* allocate and fill sf_sst (forcing structure) with sn_sst
-         IF( ierr3 > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_ndepo structure' )
-         !
-         CALL fld_fill( sf_ndepo, (/ sn_ndepo /), cn_dir, 'p4z_sed_init', 'Nutrient atmospheric depositon ', 'nampissed' )
-                                   ALLOCATE( sf_ndepo(1)%fnow(jpi,jpj,1)   )
-         IF( sn_ndepo%ln_tint )    ALLOCATE( sf_ndepo(1)%fdta(jpi,jpj,1,2) )
-         !
-         IF( Agrif_Root() ) THEN   !  Only on the master grid
-            ! Get total input dust ; need to compute total atmospheric supply of N in a year
-            CALL iom_open ( TRIM( sn_ndepo%clname ), numdepo )
-            ntimes_ndep = iom_getszuld( numdepo )
-         ENDIF
-      ENDIF
-
-      ! coastal and island masks
-      ! ------------------------
-      IF( ln_ironsed ) THEN     
-         !
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '   ==>>>   ln_ironsed=T , computation of an island mask to enhance coastal supply of iron'
-         !
-         ALLOCATE( ironsed(jpi,jpj,jpk) )    ! allocation
-         !
-         CALL iom_open ( TRIM( sn_ironsed%clname ), numiron )
-         ALLOCATE( zcmask(jpi,jpj,jpk) )
-         CALL iom_get  ( numiron, jpdom_data, TRIM( sn_ironsed%clvar ), zcmask(:,:,:), 1 )
-         CALL iom_close( numiron )
-         !
-         ik50 = 5        !  last level where depth less than 50 m
-         DO jk = jpkm1, 1, -1
-            IF( gdept_1d(jk) > 50. )   ik50 = jk - 1
-         END DO
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) ' Level corresponding to 50m depth ',  ik50,' ', gdept_1d(ik50+1)
-         DO jk = 1, ik50
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  ze3t   = e3t_0(ji,jj,jk)
-                  zsurfc =  e1u(ji,jj) * ( 1. - umask(ji  ,jj  ,jk) )   &
-                          + e1u(ji,jj) * ( 1. - umask(ji-1,jj  ,jk) )   &
-                          + e2v(ji,jj) * ( 1. - vmask(ji  ,jj  ,jk) )   &
-                          + e2v(ji,jj) * ( 1. - vmask(ji  ,jj-1,jk) )
-                  zsurfp = zsurfc * ze3t / e1e2t(ji,jj)
-                  ! estimation of the coastal slope : 5 km off the coast
-                  ze3t2 = ze3t * ze3t
-                  zcslp = SQRT( ( distcoast*distcoast + ze3t2 ) / ze3t2 )
-                  !
-                  zcmask(ji,jj,jk) = zcmask(ji,jj,jk) + zcslp * zsurfp
-               END DO
-            END DO
-         END DO
-         !
-         CALL lbc_lnk( 'p4zsbc', zcmask , 'T', 1. )      ! lateral boundary conditions on cmask   (sign unchanged)
-         !
-         DO jk = 1, jpk
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zexpide   = MIN( 8.,( gdept_n(ji,jj,jk) / 500. )**(-1.5) )
-                  zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2
-                  zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 )
-               END DO
-            END DO
-         END DO
-         ! Coastal supply of iron
-         ! -------------------------
-         ironsed(:,:,jpk) = 0._wp
-         DO jk = 1, jpkm1
-            ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( e3t_0(:,:,jk) * rday )
-         END DO
-         DEALLOCATE( zcmask)
-      ENDIF
-      !
-      ! Iron from Hydrothermal vents
-      ! ------------------------
-      IF( ln_hydrofe ) THEN
-         !
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '   ==>>>   ln_hydrofe=T , Input of iron from hydrothermal vents'
-         !
-         ALLOCATE( hydrofe(jpi,jpj,jpk) )    ! allocation
-         !
-         CALL iom_open ( TRIM( sn_hydrofe%clname ), numhydro )
-         CALL iom_get  ( numhydro, jpdom_data, TRIM( sn_hydrofe%clvar ), hydrofe(:,:,:), 1 )
-         CALL iom_close( numhydro )
-         !
-         DO jk = 1, jpk
-            hydrofe(:,:,jk) = ( hydrofe(:,:,jk) * hratio ) / ( e1e2t(:,:) * e3t_0(:,:,jk) * ryyss + rtrn ) / 1000._wp
-         ENDDO
-         !
-      ENDIF
-      ! 
-      IF( ll_sbc ) CALL p4z_sbc( nit000 ) 
-      !
-      IF(lwp) THEN 
-         WRITE(numout,*)
-         WRITE(numout,*) '    Total input of elements from river supply'
-         WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
-         WRITE(numout,*) '    N Supply   : ', rivdininput*rno3*1E3/1E12*14.,' TgN/yr'
-         WRITE(numout,*) '    Si Supply  : ', rivdsiinput*1E3/1E12*28.1    ,' TgSi/yr'
-         WRITE(numout,*) '    P Supply   : ', rivdipinput*1E3*po4r/1E12*31.,' TgP/yr'
-         WRITE(numout,*) '    Alk Supply : ', rivalkinput*1E3/1E12         ,' Teq/yr'
-         WRITE(numout,*) '    DIC Supply : ', rivdicinput*1E3*12./1E12     ,' TgC/yr'
-         WRITE(numout,*) 
-      ENDIF
-      !
-      sedsilfrac = 0.03     ! percentage of silica loss in the sediments
-      sedcalfrac = 0.6      ! percentage of calcite loss in the sediments
-      !
-   END SUBROUTINE p4z_sbc_init
-
-   !!======================================================================
-END MODULE p4zsbc
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zsed.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zsed.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zsed.F90	(revision 12928)
@@ -15,5 +15,4 @@
    USE sms_pisces      !  PISCES Source Minus Sink variables
    USE p4zlim          !  Co-limitations of differents nutrients
-   USE p4zsbc          !  External source of nutrients 
    USE p4zint          !  interpolation and computation of various fields
    USE sed             !  Sediment module
@@ -25,11 +24,19 @@
 
    PUBLIC   p4z_sed  
+   PUBLIC   p4z_sed_init
    PUBLIC   p4z_sed_alloc
  
+   REAL(wp), PUBLIC ::   nitrfix      !: Nitrogen fixation rate
+   REAL(wp), PUBLIC ::   diazolight   !: Nitrogen fixation sensitivty to light
+   REAL(wp), PUBLIC ::   concfediaz   !: Fe half-saturation Cste for diazotrophs
+
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nitrpot    !: Nitrogen fixation 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:  ) :: sdenit     !: Nitrate reduction in the sediments
-   REAL(wp) :: r1_rday                  !: inverse of rday
-   LOGICAL, SAVE :: lk_sed
-
+   !
+   REAL(wp), SAVE :: r1_rday          
+   REAL(wp), SAVE :: sedsilfrac, sedcalfrac
+
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -39,5 +46,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_sed( kt, knt )
+   SUBROUTINE p4z_sed( kt, knt, Kbb, Kmm, Krhs )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_sed  ***
@@ -51,7 +58,8 @@
       !
       INTEGER, INTENT(in) ::   kt, knt ! ocean time step
+      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level indices
       INTEGER  ::  ji, jj, jk, ikt
       REAL(wp) ::  zrivalk, zrivsil, zrivno3
-      REAL(wp) ::  zwflux, zlim, zfact, zfactcal
+      REAL(wp) ::  zlim, zfact, zfactcal
       REAL(wp) ::  zo2, zno3, zflx, zpdenit, z1pdenit, zolimit
       REAL(wp) ::  zsiloss, zcaloss, zws3, zws4, zwsc, zdep
@@ -66,20 +74,9 @@
       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zsoufer, zlight
       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrpo4, ztrdop, zirondep, zpdep
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:  ) :: zsidep, zironice
       !!---------------------------------------------------------------------
       !
       IF( ln_timing )  CALL timing_start('p4z_sed')
       !
-      IF( kt == nittrc000 .AND. knt == 1 )   THEN
-          r1_rday  = 1. / rday
-          IF (ln_sediment .AND. ln_sed_2way) THEN
-             lk_sed = .TRUE.
-          ELSE
-             lk_sed = .FALSE.
-          ENDIF
-      ENDIF
-      !
-      IF( kt == nittrc000 .AND. knt == 1 )   r1_rday  = 1. / rday
-      !
+
       ! Allocate temporary workspace
       ALLOCATE( ztrpo4(jpi,jpj,jpk) )
@@ -93,167 +90,35 @@
       zsedc   (:,:) = 0.e0
 
-      ! Iron input/uptake due to sea ice : Crude parameterization based on Lancelot et al.
-      ! ----------------------------------------------------
-      IF( ln_ironice ) THEN  
-         !                                              
-         ALLOCATE( zironice(jpi,jpj) )
-         !                                              
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zdep    = rfact2 / e3t_n(ji,jj,1)
-               zwflux  = fmmflx(ji,jj) / 1000._wp
-               zironice(ji,jj) =  MAX( -0.99 * trb(ji,jj,1,jpfer), -zwflux * icefeinput * zdep )
-            END DO
-         END DO
-         !
-         tra(:,:,1,jpfer) = tra(:,:,1,jpfer) + zironice(:,:) 
-         ! 
-         IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironice" ) )   &
-            &   CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) ) ! iron flux from ice
-         !
-         DEALLOCATE( zironice )
-         !                                              
-      ENDIF
-
-      ! Add the external input of nutrients from dust deposition
-      ! ----------------------------------------------------------
-      IF( ln_dust ) THEN
-         !                                              
-         ALLOCATE( zsidep(jpi,jpj), zpdep(jpi,jpj,jpk), zirondep(jpi,jpj,jpk) )
-         !                                              ! Iron and Si deposition at the surface
-         IF( ln_solub ) THEN
-            zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss 
-         ELSE
-            zirondep(:,:,1) = dustsolub  * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss 
-         ENDIF
-         zsidep(:,:)   = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 28.1 
-         zpdep (:,:,1) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 31. / po4r 
-         !                                              ! Iron solubilization of particles in the water column
-         !                                              ! dust in kg/m2/s ---> 1/55.85 to put in mol/Fe ;  wdust in m/j
-         zwdust = 0.03 * rday / ( wdust * 55.85 ) / ( 270. * rday )
-         DO jk = 2, jpkm1
-            zirondep(:,:,jk) = dust(:,:) * mfrac * zwdust * rfact2 * EXP( -gdept_n(:,:,jk) / 540. )
-            zpdep   (:,:,jk) = zirondep(:,:,jk) * 0.023
-         END DO
-         !                                              ! Iron solubilization of particles in the water column
-         tra(:,:,1,jpsil) = tra(:,:,1,jpsil) + zsidep  (:,:)
-         DO jk = 1, jpkm1
-            tra(:,:,jk,jppo4) = tra(:,:,jk,jppo4) + zpdep   (:,:,jk)
-            tra(:,:,jk,jpfer) = tra(:,:,jk,jpfer) + zirondep(:,:,jk) 
-         ENDDO
-         ! 
-         IF( lk_iomput ) THEN
-            IF( knt == nrdttrc ) THEN
-                IF( iom_use( "Irondep" ) )   &
-                &  CALL iom_put( "Irondep", zirondep(:,:,1) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) ) ! surface downward dust depo of iron
-                IF( iom_use( "pdust" ) )   &
-                &  CALL iom_put( "pdust"  , dust(:,:) / ( wdust * rday )  * tmask(:,:,1) ) ! dust concentration at surface
-            ENDIF
-         ENDIF
-         DEALLOCATE( zsidep, zpdep, zirondep )
-         !                                              
-      ENDIF
-     
-      ! Add the external input of nutrients from river
-      ! ----------------------------------------------------------
-      IF( ln_river ) THEN
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               DO jk = 1, nk_rnf(ji,jj)
-                  tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) +  rivdip(ji,jj) * rfact2
-                  tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) +  rivdin(ji,jj) * rfact2
-                  tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) +  rivdic(ji,jj) * 5.e-5 * rfact2
-                  tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) +  rivdsi(ji,jj) * rfact2
-                  tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) +  rivdic(ji,jj) * rfact2
-                  tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) +  ( rivalk(ji,jj) - rno3 * rivdin(ji,jj) ) * rfact2
-                  tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) +  rivdoc(ji,jj) * rfact2
-               ENDDO
-            ENDDO
-         ENDDO
-         IF (ln_ligand) THEN
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  DO jk = 1, nk_rnf(ji,jj)
-                     tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) +  rivdic(ji,jj) * 5.e-5 * rfact2
-                  ENDDO
-               ENDDO
-            ENDDO
-         ENDIF
-         IF( ln_p5z ) THEN
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  DO jk = 1, nk_rnf(ji,jj)
-                     tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + rivdop(ji,jj) * rfact2
-                     tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + rivdon(ji,jj) * rfact2
-                  ENDDO
-               ENDDO
-            ENDDO
-         ENDIF
-      ENDIF
-      
-      ! Add the external input of nutrients from nitrogen deposition
-      ! ----------------------------------------------------------
-      IF( ln_ndepo ) THEN
-         tra(:,:,1,jpno3) = tra(:,:,1,jpno3) + nitdep(:,:) * rfact2
-         tra(:,:,1,jptal) = tra(:,:,1,jptal) - rno3 * nitdep(:,:) * rfact2
-      ENDIF
-
-      ! Add the external input of iron from hydrothermal vents
-      ! ------------------------------------------------------
-      IF( ln_hydrofe ) THEN
-            tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2
-         IF( ln_ligand ) THEN
-            tra(:,:,:,jplgw) = tra(:,:,:,jplgw) + ( hydrofe(:,:,:) * lgw_rath ) * rfact2
-         ENDIF
-         !
-         IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "HYDR" ) )   &
-            &   CALL iom_put( "HYDR", hydrofe(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! hydrothermal iron input
-      ENDIF
-
-      ! OA: Warning, the following part is necessary to avoid CFL problems above the sediments
-      ! --------------------------------------------------------------------
-      DO jj = 1, jpj
-         DO ji = 1, jpi
+      IF( .NOT.lk_sed ) THEN
+         ! OA: Warning, the following part is necessary to avoid CFL problems above the sediments
+         ! --------------------------------------------------------------------
+         DO_2D_11_11
             ikt  = mbkt(ji,jj)
-            zdep = e3t_n(ji,jj,ikt) / xstep
+            zdep = e3t(ji,jj,ikt,Kmm) / xstep
             zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) )
             zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) )
-         END DO
-      END DO
-      !
-      IF( .NOT.lk_sed ) THEN
-!
-         ! Add the external input of iron from sediment mobilization
-         ! ------------------------------------------------------
-         IF( ln_ironsed ) THEN
-                            tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2
-            !
-            IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironsed" ) )   &
-               &   CALL iom_put( "Ironsed", ironsed(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! iron inputs from sediments
-         ENDIF
+         END_2D
 
          ! Computation of the sediment denitrification proportion: The metamodel from midlleburg (2006) is being used
          ! Computation of the fraction of organic matter that is permanently buried from Dunne's model
          ! -------------------------------------------------------
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-              IF( tmask(ji,jj,1) == 1 ) THEN
-                 ikt = mbkt(ji,jj)
-                 zflx = (  trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   &
-                   &     + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) )  * 1E3 * 1E6 / 1E4
-                 zflx  = LOG10( MAX( 1E-3, zflx ) )
-                 zo2   = LOG10( MAX( 10. , trb(ji,jj,ikt,jpoxy) * 1E6 ) )
-                 zno3  = LOG10( MAX( 1.  , trb(ji,jj,ikt,jpno3) * 1E6 * rno3 ) )
-                 zdep  = LOG10( gdepw_n(ji,jj,ikt+1) )
-                 zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3    &
-                   &                + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2
-                 zdenit2d(ji,jj) = 10.0**( zdenit2d(ji,jj) )
-                   !
-                 zflx = (  trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   &
-                   &     + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E6
-                 zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2
-              ENDIF
-            END DO
-         END DO 
+         DO_2D_11_11
+           IF( tmask(ji,jj,1) == 1 ) THEN
+              ikt = mbkt(ji,jj)
+              zflx = (  tr(ji,jj,ikt,jpgoc,Kbb) * zwsbio4(ji,jj)   &
+                &     + tr(ji,jj,ikt,jppoc,Kbb) * zwsbio3(ji,jj) )  * 1E3 * 1E6 / 1E4
+              zflx  = LOG10( MAX( 1E-3, zflx ) )
+              zo2   = LOG10( MAX( 10. , tr(ji,jj,ikt,jpoxy,Kbb) * 1E6 ) )
+              zno3  = LOG10( MAX( 1.  , tr(ji,jj,ikt,jpno3,Kbb) * 1E6 * rno3 ) )
+              zdep  = LOG10( gdepw(ji,jj,ikt+1,Kmm) )
+              zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3    &
+                &                + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2
+              zdenit2d(ji,jj) = 10.0**( zdenit2d(ji,jj) )
+                !
+              zflx = (  tr(ji,jj,ikt,jpgoc,Kbb) * zwsbio4(ji,jj)   &
+                &     + tr(ji,jj,ikt,jppoc,Kbb) * zwsbio3(ji,jj) ) * 1E6
+              zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2
+           ENDIF
+         END_2D
          !
       ENDIF
@@ -264,64 +129,56 @@
       IF( .NOT.lk_sed )  zrivsil = 1._wp - sedsilfrac
 
-      DO jj = 1, jpj
-         DO ji = 1, jpi
+      DO_2D_11_11
+         ikt  = mbkt(ji,jj)
+         zdep = xstep / e3t(ji,jj,ikt,Kmm) 
+         zwsc = zwsbio4(ji,jj) * zdep
+         zsiloss = tr(ji,jj,ikt,jpgsi,Kbb) * zwsc
+         zcaloss = tr(ji,jj,ikt,jpcal,Kbb) * zwsc
+         !
+         tr(ji,jj,ikt,jpgsi,Krhs) = tr(ji,jj,ikt,jpgsi,Krhs) - zsiloss
+         tr(ji,jj,ikt,jpcal,Krhs) = tr(ji,jj,ikt,jpcal,Krhs) - zcaloss
+      END_2D
+      !
+      IF( .NOT.lk_sed ) THEN
+         DO_2D_11_11
             ikt  = mbkt(ji,jj)
-            zdep = xstep / e3t_n(ji,jj,ikt) 
+            zdep = xstep / e3t(ji,jj,ikt,Kmm) 
             zwsc = zwsbio4(ji,jj) * zdep
-            zsiloss = trb(ji,jj,ikt,jpgsi) * zwsc
-            zcaloss = trb(ji,jj,ikt,jpcal) * zwsc
+            zsiloss = tr(ji,jj,ikt,jpgsi,Kbb) * zwsc
+            zcaloss = tr(ji,jj,ikt,jpcal,Kbb) * zwsc
+            tr(ji,jj,ikt,jpsil,Krhs) = tr(ji,jj,ikt,jpsil,Krhs) + zsiloss * zrivsil 
             !
-            tra(ji,jj,ikt,jpgsi) = tra(ji,jj,ikt,jpgsi) - zsiloss
-            tra(ji,jj,ikt,jpcal) = tra(ji,jj,ikt,jpcal) - zcaloss
-         END DO
-      END DO
-      !
-      IF( .NOT.lk_sed ) THEN
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ikt  = mbkt(ji,jj)
-               zdep = xstep / e3t_n(ji,jj,ikt) 
-               zwsc = zwsbio4(ji,jj) * zdep
-               zsiloss = trb(ji,jj,ikt,jpgsi) * zwsc
-               zcaloss = trb(ji,jj,ikt,jpcal) * zwsc
-               tra(ji,jj,ikt,jpsil) = tra(ji,jj,ikt,jpsil) + zsiloss * zrivsil 
-               !
-               zfactcal = MIN( excess(ji,jj,ikt), 0.2 )
-               zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) )
-               zrivalk  = sedcalfrac * zfactcal
-               tra(ji,jj,ikt,jptal) =  tra(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0
-               tra(ji,jj,ikt,jpdic) =  tra(ji,jj,ikt,jpdic) + zcaloss * zrivalk
-               zsedcal(ji,jj) = (1.0 - zrivalk) * zcaloss * e3t_n(ji,jj,ikt) 
-               zsedsi (ji,jj) = (1.0 - zrivsil) * zsiloss * e3t_n(ji,jj,ikt) 
-            END DO
-         END DO
-      ENDIF
-      !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
+            zfactcal = MIN( excess(ji,jj,ikt), 0.2 )
+            zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) )
+            zrivalk  = sedcalfrac * zfactcal
+            tr(ji,jj,ikt,jptal,Krhs) =  tr(ji,jj,ikt,jptal,Krhs) + zcaloss * zrivalk * 2.0
+            tr(ji,jj,ikt,jpdic,Krhs) =  tr(ji,jj,ikt,jpdic,Krhs) + zcaloss * zrivalk
+            zsedcal(ji,jj) = (1.0 - zrivalk) * zcaloss * e3t(ji,jj,ikt,Kmm) 
+            zsedsi (ji,jj) = (1.0 - zrivsil) * zsiloss * e3t(ji,jj,ikt,Kmm) 
+         END_2D
+      ENDIF
+      !
+      DO_2D_11_11
+         ikt  = mbkt(ji,jj)
+         zdep = xstep / e3t(ji,jj,ikt,Kmm) 
+         zws4 = zwsbio4(ji,jj) * zdep
+         zws3 = zwsbio3(ji,jj) * zdep
+         tr(ji,jj,ikt,jpgoc,Krhs) = tr(ji,jj,ikt,jpgoc,Krhs) - tr(ji,jj,ikt,jpgoc,Kbb) * zws4 
+         tr(ji,jj,ikt,jppoc,Krhs) = tr(ji,jj,ikt,jppoc,Krhs) - tr(ji,jj,ikt,jppoc,Kbb) * zws3
+         tr(ji,jj,ikt,jpbfe,Krhs) = tr(ji,jj,ikt,jpbfe,Krhs) - tr(ji,jj,ikt,jpbfe,Kbb) * zws4
+         tr(ji,jj,ikt,jpsfe,Krhs) = tr(ji,jj,ikt,jpsfe,Krhs) - tr(ji,jj,ikt,jpsfe,Kbb) * zws3
+      END_2D
+      !
+      IF( ln_p5z ) THEN
+         DO_2D_11_11
             ikt  = mbkt(ji,jj)
-            zdep = xstep / e3t_n(ji,jj,ikt) 
+            zdep = xstep / e3t(ji,jj,ikt,Kmm) 
             zws4 = zwsbio4(ji,jj) * zdep
             zws3 = zwsbio3(ji,jj) * zdep
-            tra(ji,jj,ikt,jpgoc) = tra(ji,jj,ikt,jpgoc) - trb(ji,jj,ikt,jpgoc) * zws4 
-            tra(ji,jj,ikt,jppoc) = tra(ji,jj,ikt,jppoc) - trb(ji,jj,ikt,jppoc) * zws3
-            tra(ji,jj,ikt,jpbfe) = tra(ji,jj,ikt,jpbfe) - trb(ji,jj,ikt,jpbfe) * zws4
-            tra(ji,jj,ikt,jpsfe) = tra(ji,jj,ikt,jpsfe) - trb(ji,jj,ikt,jpsfe) * zws3
-         END DO
-      END DO
-      !
-      IF( ln_p5z ) THEN
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ikt  = mbkt(ji,jj)
-               zdep = xstep / e3t_n(ji,jj,ikt) 
-               zws4 = zwsbio4(ji,jj) * zdep
-               zws3 = zwsbio3(ji,jj) * zdep
-               tra(ji,jj,ikt,jpgon) = tra(ji,jj,ikt,jpgon) - trb(ji,jj,ikt,jpgon) * zws4
-               tra(ji,jj,ikt,jppon) = tra(ji,jj,ikt,jppon) - trb(ji,jj,ikt,jppon) * zws3
-               tra(ji,jj,ikt,jpgop) = tra(ji,jj,ikt,jpgop) - trb(ji,jj,ikt,jpgop) * zws4
-               tra(ji,jj,ikt,jppop) = tra(ji,jj,ikt,jppop) - trb(ji,jj,ikt,jppop) * zws3
-            END DO
-         END DO
+            tr(ji,jj,ikt,jpgon,Krhs) = tr(ji,jj,ikt,jpgon,Krhs) - tr(ji,jj,ikt,jpgon,Kbb) * zws4
+            tr(ji,jj,ikt,jppon,Krhs) = tr(ji,jj,ikt,jppon,Krhs) - tr(ji,jj,ikt,jppon,Kbb) * zws3
+            tr(ji,jj,ikt,jpgop,Krhs) = tr(ji,jj,ikt,jpgop,Krhs) - tr(ji,jj,ikt,jpgop,Kbb) * zws4
+            tr(ji,jj,ikt,jppop,Krhs) = tr(ji,jj,ikt,jppop,Krhs) - tr(ji,jj,ikt,jppop,Kbb) * zws3
+         END_2D
       ENDIF
 
@@ -329,32 +186,30 @@
          ! The 0.5 factor in zpdenit is to avoid negative NO3 concentration after
          ! denitrification in the sediments. Not very clever, but simpliest option.
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ikt  = mbkt(ji,jj)
-               zdep = xstep / e3t_n(ji,jj,ikt) 
-               zws4 = zwsbio4(ji,jj) * zdep
-               zws3 = zwsbio3(ji,jj) * zdep
-               zrivno3 = 1. - zbureff(ji,jj)
-               zwstpoc = trb(ji,jj,ikt,jpgoc) * zws4 + trb(ji,jj,ikt,jppoc) * zws3
-               zpdenit  = MIN( 0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 )
-               z1pdenit = zwstpoc * zrivno3 - zpdenit
-               zolimit = MIN( ( trb(ji,jj,ikt,jpoxy) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) )
-               tra(ji,jj,ikt,jpdoc) = tra(ji,jj,ikt,jpdoc) + z1pdenit - zolimit
-               tra(ji,jj,ikt,jppo4) = tra(ji,jj,ikt,jppo4) + zpdenit + zolimit
-               tra(ji,jj,ikt,jpnh4) = tra(ji,jj,ikt,jpnh4) + zpdenit + zolimit
-               tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) - rdenit * zpdenit
-               tra(ji,jj,ikt,jpoxy) = tra(ji,jj,ikt,jpoxy) - zolimit * o2ut
-               tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * zpdenit )
-               tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zpdenit + zolimit 
-               sdenit(ji,jj) = rdenit * zpdenit * e3t_n(ji,jj,ikt)
-               zsedc(ji,jj)   = (1. - zrivno3) * zwstpoc * e3t_n(ji,jj,ikt)
-               IF( ln_p5z ) THEN
-                  zwstpop              = trb(ji,jj,ikt,jpgop) * zws4 + trb(ji,jj,ikt,jppop) * zws3
-                  zwstpon              = trb(ji,jj,ikt,jpgon) * zws4 + trb(ji,jj,ikt,jppon) * zws3
-                  tra(ji,jj,ikt,jpdon) = tra(ji,jj,ikt,jpdon) + ( z1pdenit - zolimit ) * zwstpon / (zwstpoc + rtrn)
-                  tra(ji,jj,ikt,jpdop) = tra(ji,jj,ikt,jpdop) + ( z1pdenit - zolimit ) * zwstpop / (zwstpoc + rtrn)
-               ENDIF
-            END DO
-         END DO
+         DO_2D_11_11
+            ikt  = mbkt(ji,jj)
+            zdep = xstep / e3t(ji,jj,ikt,Kmm) 
+            zws4 = zwsbio4(ji,jj) * zdep
+            zws3 = zwsbio3(ji,jj) * zdep
+            zrivno3 = 1. - zbureff(ji,jj)
+            zwstpoc = tr(ji,jj,ikt,jpgoc,Kbb) * zws4 + tr(ji,jj,ikt,jppoc,Kbb) * zws3
+            zpdenit  = MIN( 0.5 * ( tr(ji,jj,ikt,jpno3,Kbb) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 )
+            z1pdenit = zwstpoc * zrivno3 - zpdenit
+            zolimit = MIN( ( tr(ji,jj,ikt,jpoxy,Kbb) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) )
+            tr(ji,jj,ikt,jpdoc,Krhs) = tr(ji,jj,ikt,jpdoc,Krhs) + z1pdenit - zolimit
+            tr(ji,jj,ikt,jppo4,Krhs) = tr(ji,jj,ikt,jppo4,Krhs) + zpdenit + zolimit
+            tr(ji,jj,ikt,jpnh4,Krhs) = tr(ji,jj,ikt,jpnh4,Krhs) + zpdenit + zolimit
+            tr(ji,jj,ikt,jpno3,Krhs) = tr(ji,jj,ikt,jpno3,Krhs) - rdenit * zpdenit
+            tr(ji,jj,ikt,jpoxy,Krhs) = tr(ji,jj,ikt,jpoxy,Krhs) - zolimit * o2ut
+            tr(ji,jj,ikt,jptal,Krhs) = tr(ji,jj,ikt,jptal,Krhs) + rno3 * (zolimit + (1.+rdenit) * zpdenit )
+            tr(ji,jj,ikt,jpdic,Krhs) = tr(ji,jj,ikt,jpdic,Krhs) + zpdenit + zolimit 
+            sdenit(ji,jj) = rdenit * zpdenit * e3t(ji,jj,ikt,Kmm)
+            zsedc(ji,jj)   = (1. - zrivno3) * zwstpoc * e3t(ji,jj,ikt,Kmm)
+            IF( ln_p5z ) THEN
+               zwstpop              = tr(ji,jj,ikt,jpgop,Kbb) * zws4 + tr(ji,jj,ikt,jppop,Kbb) * zws3
+               zwstpon              = tr(ji,jj,ikt,jpgon,Kbb) * zws4 + tr(ji,jj,ikt,jppon,Kbb) * zws3
+               tr(ji,jj,ikt,jpdon,Krhs) = tr(ji,jj,ikt,jpdon,Krhs) + ( z1pdenit - zolimit ) * zwstpon / (zwstpoc + rtrn)
+               tr(ji,jj,ikt,jpdop,Krhs) = tr(ji,jj,ikt,jpdop,Krhs) + ( z1pdenit - zolimit ) * zwstpop / (zwstpoc + rtrn)
+            ENDIF
+         END_2D
        ENDIF
 
@@ -368,44 +223,36 @@
       ENDDO
       IF( ln_p4z ) THEN
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  !                      ! Potential nitrogen fixation dependant on temperature and iron
-                  ztemp = tsn(ji,jj,jk,jp_tem)
-                  zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625
-                  !       Potential nitrogen fixation dependant on temperature and iron
-                  xdianh4 = trb(ji,jj,jk,jpnh4) / ( concnnh4 + trb(ji,jj,jk,jpnh4) )
-                  xdiano3 = trb(ji,jj,jk,jpno3) / ( concnno3 + trb(ji,jj,jk,jpno3) ) * (1. - xdianh4)
-                  zlim = ( 1.- xdiano3 - xdianh4 )
-                  IF( zlim <= 0.1 )   zlim = 0.01
-                  zfact = zlim * rfact2
-                  ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) )
-                  ztrpo4(ji,jj,jk) = trb(ji,jj,jk,jppo4) / ( 1E-6 + trb(ji,jj,jk,jppo4) )
-                  ztrdp = ztrpo4(ji,jj,jk)
-                  nitrpot(ji,jj,jk) =  zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, jpkm1 )
+            !                      ! Potential nitrogen fixation dependant on temperature and iron
+            ztemp = ts(ji,jj,jk,jp_tem,Kmm)
+            zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625
+            !       Potential nitrogen fixation dependant on temperature and iron
+            xdianh4 = tr(ji,jj,jk,jpnh4,Kbb) / ( concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) )
+            xdiano3 = tr(ji,jj,jk,jpno3,Kbb) / ( concnno3 + tr(ji,jj,jk,jpno3,Kbb) ) * (1. - xdianh4)
+            zlim = ( 1.- xdiano3 - xdianh4 )
+            IF( zlim <= 0.1 )   zlim = 0.01
+            zfact = zlim * rfact2
+            ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) )
+            ztrpo4(ji,jj,jk) = tr(ji,jj,jk,jppo4,Kbb) / ( 1E-6 + tr(ji,jj,jk,jppo4,Kbb) )
+            ztrdp = ztrpo4(ji,jj,jk)
+            nitrpot(ji,jj,jk) =  zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk)
+         END_3D
       ELSE       ! p5z
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  !                      ! Potential nitrogen fixation dependant on temperature and iron
-                  ztemp = tsn(ji,jj,jk,jp_tem)
-                  zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625
-                  !       Potential nitrogen fixation dependant on temperature and iron
-                  xdianh4 = trb(ji,jj,jk,jpnh4) / ( concnnh4 + trb(ji,jj,jk,jpnh4) )
-                  xdiano3 = trb(ji,jj,jk,jpno3) / ( concnno3 + trb(ji,jj,jk,jpno3) ) * (1. - xdianh4)
-                  zlim = ( 1.- xdiano3 - xdianh4 )
-                  IF( zlim <= 0.1 )   zlim = 0.01
-                  zfact = zlim * rfact2
-                  ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) )
-                  ztrpo4(ji,jj,jk) = trb(ji,jj,jk,jppo4) / ( 1E-6 + trb(ji,jj,jk,jppo4) )
-                  ztrdop(ji,jj,jk) = trb(ji,jj,jk,jpdop) / ( 1E-6 + trb(ji,jj,jk,jpdop) ) * (1. - ztrpo4(ji,jj,jk))
-                  ztrdp = ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk)
-                  nitrpot(ji,jj,jk) =  zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, jpkm1 )
+            !                      ! Potential nitrogen fixation dependant on temperature and iron
+            ztemp = ts(ji,jj,jk,jp_tem,Kmm)
+            zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625
+            !       Potential nitrogen fixation dependant on temperature and iron
+            xdianh4 = tr(ji,jj,jk,jpnh4,Kbb) / ( concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) )
+            xdiano3 = tr(ji,jj,jk,jpno3,Kbb) / ( concnno3 + tr(ji,jj,jk,jpno3,Kbb) ) * (1. - xdianh4)
+            zlim = ( 1.- xdiano3 - xdianh4 )
+            IF( zlim <= 0.1 )   zlim = 0.01
+            zfact = zlim * rfact2
+            ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) )
+            ztrpo4(ji,jj,jk) = tr(ji,jj,jk,jppo4,Kbb) / ( 1E-6 + tr(ji,jj,jk,jppo4,Kbb) )
+            ztrdop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( 1E-6 + tr(ji,jj,jk,jpdop,Kbb) ) * (1. - ztrpo4(ji,jj,jk))
+            ztrdp = ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk)
+            nitrpot(ji,jj,jk) =  zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk)
+         END_3D
       ENDIF
 
@@ -413,77 +260,60 @@
       ! ----------------------------------------
       IF( ln_p4z ) THEN
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zfact = nitrpot(ji,jj,jk) * nitrfix
-                  tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zfact / 3.0
-                  tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zfact / 3.0
-                  tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zfact * 2.0 / 3.0
-                  tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zfact * 1.0 / 3.0
-                  tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zfact * 1.0 / 3.0 * 2.0 / 3.0
-                  tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zfact * 1.0 / 3.0 * 1.0 / 3.0
-                  tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0
-                  tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - 30E-6 * zfact * 1.0 / 3.0
-                  tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0
-                  tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0
-                  tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday
-                  tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + concdnh4 / ( concdnh4 + trb(ji,jj,jk,jppo4) ) &
-                  &                     * 0.001 * trb(ji,jj,jk,jpdoc) * xstep
-              END DO
-            END DO 
-         END DO
+         DO_3D_11_11( 1, jpkm1 )
+            zfact = nitrpot(ji,jj,jk) * nitrfix
+            tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zfact / 3.0
+            tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zfact / 3.0
+            tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zfact * 2.0 / 3.0
+            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zfact * 1.0 / 3.0
+            tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zfact * 1.0 / 3.0 * 2.0 / 3.0
+            tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zfact * 1.0 / 3.0 * 1.0 / 3.0
+            tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0
+            tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - 30E-6 * zfact * 1.0 / 3.0
+            tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0
+            tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0
+            tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday
+            tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + concdnh4 / ( concdnh4 + tr(ji,jj,jk,jppo4,Kbb) ) &
+            &                     * 0.001 * tr(ji,jj,jk,jpdoc,Kbb) * xstep
+         END_3D
       ELSE    ! p5z
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zfact = nitrpot(ji,jj,jk) * nitrfix
-                  tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zfact / 3.0
-                  tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zfact / 3.0
-                  tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - 16.0 / 46.0 * zfact * ( 1.0 - 1.0 / 3.0 ) &
-                  &                     * ztrpo4(ji,jj,jk) / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn)
-                  tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zfact * 1.0 / 3.0
-                  tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zfact * 1.0 / 3.0
-                  tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + 16.0 / 46.0 * zfact / 3.0  &
-                  &                     - 16.0 / 46.0 * zfact * ztrdop(ji,jj,jk)   &
-                  &                     / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn)
-                  tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zfact * 1.0 / 3.0 * 2.0 / 3.0
-                  tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + zfact * 1.0 / 3.0 * 2.0 /3.0
-                  tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 2.0 /3.0
-                  tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zfact * 1.0 / 3.0 * 1.0 / 3.0
-                  tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) + zfact * 1.0 / 3.0 * 1.0 /3.0
-                  tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 1.0 /3.0
-                  tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0
-                  tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - 30E-6 * zfact * 1.0 / 3.0 
-                  tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0
-                  tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0
-                  tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday
-              END DO
-            END DO 
-         END DO
+         DO_3D_11_11( 1, jpkm1 )
+            zfact = nitrpot(ji,jj,jk) * nitrfix
+            tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zfact / 3.0
+            tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zfact / 3.0
+            tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - 16.0 / 46.0 * zfact * ( 1.0 - 1.0 / 3.0 ) &
+            &                     * ztrpo4(ji,jj,jk) / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn)
+            tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zfact * 1.0 / 3.0
+            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zfact * 1.0 / 3.0
+            tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + 16.0 / 46.0 * zfact / 3.0  &
+            &                     - 16.0 / 46.0 * zfact * ztrdop(ji,jj,jk)   &
+            &                     / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn)
+            tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zfact * 1.0 / 3.0 * 2.0 / 3.0
+            tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + zfact * 1.0 / 3.0 * 2.0 /3.0
+            tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 2.0 /3.0
+            tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zfact * 1.0 / 3.0 * 1.0 / 3.0
+            tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) + zfact * 1.0 / 3.0 * 1.0 /3.0
+            tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 1.0 /3.0
+            tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0
+            tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - 30E-6 * zfact * 1.0 / 3.0 
+            tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0
+            tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0
+            tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday
+         END_3D
          !
       ENDIF
 
-      IF( lk_iomput ) THEN
-         IF( knt == nrdttrc ) THEN
-            zfact = 1.e+3 * rfact2r !  conversion from molC/l/kt  to molN/m3/s
-            IF( iom_use("Nfix"   ) ) CALL iom_put( "Nfix", nitrpot(:,:,:) * nitrfix * rno3 * zfact * tmask(:,:,:) )  ! nitrogen fixation 
-            IF( iom_use("INTNFIX") ) THEN   ! nitrogen fixation rate in ocean ( vertically integrated )
-               zwork(:,:) = 0.
-               DO jk = 1, jpkm1
-                 zwork(:,:) = zwork(:,:) + nitrpot(:,:,jk) * nitrfix * rno3 * zfact * e3t_n(:,:,jk) * tmask(:,:,jk)
-               ENDDO
-               CALL iom_put( "INTNFIX" , zwork ) 
-            ENDIF
-            IF( iom_use("SedCal" ) ) CALL iom_put( "SedCal", zsedcal(:,:) * zfact )
-            IF( iom_use("SedSi" ) )  CALL iom_put( "SedSi",  zsedsi (:,:) * zfact )
-            IF( iom_use("SedC" ) )   CALL iom_put( "SedC",   zsedc  (:,:) * zfact )
-            IF( iom_use("Sdenit" ) ) CALL iom_put( "Sdenit", sdenit (:,:) * zfact * rno3 )
-         ENDIF
-      ENDIF
-      !
-      IF(ln_ctl) THEN  ! print mean trends (USEd for debugging)
+      IF( lk_iomput .AND. knt == nrdttrc ) THEN
+         zfact = 1.e+3 * rfact2r !  conversion from molC/l/kt  to molN/m3/s
+         CALL iom_put( "Nfix", nitrpot(:,:,:) * nitrfix * rno3 * zfact * tmask(:,:,:) )  ! nitrogen fixation 
+         CALL iom_put( "SedCal", zsedcal(:,:) * zfact )
+         CALL iom_put( "SedSi" , zsedsi (:,:) * zfact )
+         CALL iom_put( "SedC"  , zsedc  (:,:) * zfact )
+         CALL iom_put( "Sdenit", sdenit (:,:) * zfact * rno3 )
+      ENDIF
+      !
+      IF(sn_cfctl%l_prttrc) THEN  ! print mean trends (USEd for debugging)
          WRITE(charout, fmt="('sed ')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
       ENDIF
       !
@@ -494,4 +324,46 @@
    END SUBROUTINE p4z_sed
 
+   SUBROUTINE p4z_sed_init
+      !!----------------------------------------------------------------------
+      !!                  ***  routine p4z_sed_init  ***
+      !!
+      !! ** purpose :   initialization of some parameters
+      !!
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      INTEGER  :: ji, jj, jk, jm
+      INTEGER  :: ios                 ! Local integer output status for namelist read
+      !
+      !!
+      NAMELIST/nampissed/ nitrfix, diazolight, concfediaz
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'p4z_sed_init : initialization of sediment mobilisation '
+         WRITE(numout,*) '~~~~~~~~~~~~ '
+      ENDIF
+      !                            !* set file information
+      READ  ( numnatp_ref, nampissed, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampissed in reference namelist' )
+      READ  ( numnatp_cfg, nampissed, IOSTAT = ios, ERR = 902 )
+902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampissed in configuration namelist' )
+      IF(lwm) WRITE ( numonp, nampissed )
+
+      IF(lwp) THEN
+         WRITE(numout,*) '   Namelist : nampissed '
+         WRITE(numout,*) '      nitrogen fixation rate                       nitrfix = ', nitrfix
+         WRITE(numout,*) '      nitrogen fixation sensitivty to light    diazolight  = ', diazolight
+         WRITE(numout,*) '      Fe half-saturation cste for diazotrophs  concfediaz  = ', concfediaz
+      ENDIF
+      !
+      r1_rday  = 1. / rday
+      !
+      sedsilfrac = 0.03     ! percentage of silica loss in the sediments
+      sedcalfrac = 0.6      ! percentage of calcite loss in the sediments
+      !
+      lk_sed = ln_sediment .AND. ln_sed_2way 
+      !
+   END SUBROUTINE p4z_sed_init
 
    INTEGER FUNCTION p4z_sed_alloc()
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zsink.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zsink.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zsink.F90	(revision 12928)
@@ -38,4 +38,6 @@
    INTEGER  :: ik100
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -49,5 +51,5 @@
    !!----------------------------------------------------------------------
 
-   SUBROUTINE p4z_sink ( kt, knt )
+   SUBROUTINE p4z_sink ( kt, knt, Kbb, Kmm, Krhs )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_sink  ***
@@ -59,9 +61,8 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) :: kt, knt
+      INTEGER, INTENT(in) :: Kbb, Kmm, Krhs  ! time level indices
       INTEGER  ::   ji, jj, jk
       CHARACTER (len=25) :: charout
       REAL(wp) :: zmax, zfact
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:  ) :: zw2d
       !!---------------------------------------------------------------------
       !
@@ -79,13 +80,9 @@
       !    by data and from the coagulation theory
       !    -----------------------------------------------------------
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1,jpi
-               zmax  = MAX( heup_01(ji,jj), hmld(ji,jj) )
-               zfact = MAX( 0., gdepw_n(ji,jj,jk+1) - zmax ) / wsbio2scale
-               wsbio4(ji,jj,jk) = wsbio2 + MAX(0., ( wsbio2max - wsbio2 )) * zfact
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpkm1 )
+         zmax  = MAX( heup_01(ji,jj), hmld(ji,jj) )
+         zfact = MAX( 0., gdepw(ji,jj,jk+1,Kmm) - zmax ) / wsbio2scale
+         wsbio4(ji,jj,jk) = wsbio2 + MAX(0., ( wsbio2max - wsbio2 )) * zfact
+      END_3D
 
       ! limit the values of the sinking speeds to avoid numerical instabilities  
@@ -104,10 +101,10 @@
       !   Compute the sedimentation term using p4zsink2 for all the sinking particles
       !   -----------------------------------------------------
-      CALL trc_sink( kt, wsbio3, sinking , jppoc, rfact2 )
-      CALL trc_sink( kt, wsbio3, sinkfer , jpsfe, rfact2 )
-      CALL trc_sink( kt, wsbio4, sinking2, jpgoc, rfact2 )
-      CALL trc_sink( kt, wsbio4, sinkfer2, jpbfe, rfact2 )
-      CALL trc_sink( kt, wsbio4, sinksil , jpgsi, rfact2 )
-      CALL trc_sink( kt, wsbio4, sinkcal , jpcal, rfact2 )
+      CALL trc_sink( kt, Kbb, Kmm, wsbio3, sinking , jppoc, rfact2 )
+      CALL trc_sink( kt, Kbb, Kmm, wsbio3, sinkfer , jpsfe, rfact2 )
+      CALL trc_sink( kt, Kbb, Kmm, wsbio4, sinking2, jpgoc, rfact2 )
+      CALL trc_sink( kt, Kbb, Kmm, wsbio4, sinkfer2, jpbfe, rfact2 )
+      CALL trc_sink( kt, Kbb, Kmm, wsbio4, sinksil , jpgsi, rfact2 )
+      CALL trc_sink( kt, Kbb, Kmm, wsbio4, sinkcal , jpcal, rfact2 )
 
       IF( ln_p5z ) THEN
@@ -119,8 +116,8 @@
          !   Compute the sedimentation term using p4zsink2 for all the sinking particles
          !   -----------------------------------------------------
-         CALL trc_sink( kt, wsbio3, sinkingn , jppon, rfact2 )
-         CALL trc_sink( kt, wsbio3, sinkingp , jppop, rfact2 )
-         CALL trc_sink( kt, wsbio4, sinking2n, jpgon, rfact2 )
-         CALL trc_sink( kt, wsbio4, sinking2p, jpgop, rfact2 )
+         CALL trc_sink( kt, Kbb, Kmm, wsbio3, sinkingn , jppon, rfact2 )
+         CALL trc_sink( kt, Kbb, Kmm, wsbio3, sinkingp , jppop, rfact2 )
+         CALL trc_sink( kt, Kbb, Kmm, wsbio4, sinking2n, jpgon, rfact2 )
+         CALL trc_sink( kt, Kbb, Kmm, wsbio4, sinking2p, jpgop, rfact2 )
       ENDIF
 
@@ -129,51 +126,23 @@
         &   t_oce_co2_exp = glob_sum( 'p4zsink', ( sinking(:,:,ik100) + sinking2(:,:,ik100) ) * e1e2t(:,:) * tmask(:,:,1) )
      !
-     IF( lk_iomput ) THEN
-       IF( knt == nrdttrc ) THEN
-          ALLOCATE( zw2d(jpi,jpj), zw3d(jpi,jpj,jpk) )
-          zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s
-          !
-          IF( iom_use( "EPC100" ) )  THEN
-              zw2d(:,:) = ( sinking(:,:,ik100) + sinking2(:,:,ik100) ) * zfact * tmask(:,:,1) ! Export of carbon at 100m
-              CALL iom_put( "EPC100"  , zw2d )
-          ENDIF
-          IF( iom_use( "EPFE100" ) )  THEN
-              zw2d(:,:) = ( sinkfer(:,:,ik100) + sinkfer2(:,:,ik100) ) * zfact * tmask(:,:,1) ! Export of iron at 100m
-              CALL iom_put( "EPFE100"  , zw2d )
-          ENDIF
-          IF( iom_use( "EPCAL100" ) )  THEN
-              zw2d(:,:) = sinkcal(:,:,ik100) * zfact * tmask(:,:,1) ! Export of calcite at 100m
-              CALL iom_put( "EPCAL100"  , zw2d )
-          ENDIF
-          IF( iom_use( "EPSI100" ) )  THEN
-              zw2d(:,:) =  sinksil(:,:,ik100) * zfact * tmask(:,:,1) ! Export of bigenic silica at 100m
-              CALL iom_put( "EPSI100"  , zw2d )
-          ENDIF
-          IF( iom_use( "EXPC" ) )  THEN
-              zw3d(:,:,:) = ( sinking(:,:,:) + sinking2(:,:,:) ) * zfact * tmask(:,:,:) ! Export of carbon in the water column
-              CALL iom_put( "EXPC"  , zw3d )
-          ENDIF
-          IF( iom_use( "EXPFE" ) )  THEN
-              zw3d(:,:,:) = ( sinkfer(:,:,:) + sinkfer2(:,:,:) ) * zfact * tmask(:,:,:) ! Export of iron 
-              CALL iom_put( "EXPFE"  , zw3d )
-          ENDIF
-          IF( iom_use( "EXPCAL" ) )  THEN
-              zw3d(:,:,:) = sinkcal(:,:,:) * zfact * tmask(:,:,:) ! Export of calcite 
-              CALL iom_put( "EXPCAL"  , zw3d )
-          ENDIF
-          IF( iom_use( "EXPSI" ) )  THEN
-              zw3d(:,:,:) = sinksil(:,:,:) * zfact * tmask(:,:,:) ! Export of bigenic silica
-              CALL iom_put( "EXPSI"  , zw3d )
-          ENDIF
-          IF( iom_use( "tcexp" ) )  CALL iom_put( "tcexp" , t_oce_co2_exp * zfact )   ! molC/s
-          ! 
-          DEALLOCATE( zw2d, zw3d )
-        ENDIF
+     IF( lk_iomput .AND.  knt == nrdttrc ) THEN
+       zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s
+       !
+       CALL iom_put( "EPC100"  , ( sinking(:,:,ik100) + sinking2(:,:,ik100) ) * zfact * tmask(:,:,1) ) ! Export of carbon at 100m 
+       CALL iom_put( "EPFE100" , ( sinkfer(:,:,ik100) + sinkfer2(:,:,ik100) ) * zfact * tmask(:,:,1) ) ! Export of iron at 100m 
+       CALL iom_put( "EPCAL100", sinkcal(:,:,ik100) * zfact * tmask(:,:,1) )      ! Export of calcite at 100m 
+       CALL iom_put( "EPSI100" , sinksil(:,:,ik100) * zfact * tmask(:,:,1) )          ! Export of bigenic silica at 100m 
+       CALL iom_put( "EXPC"    , ( sinking(:,:,:) + sinking2(:,:,:) ) * zfact * tmask(:,:,:) ) ! Export of carbon in the water column 
+       CALL iom_put( "EXPFE"   , ( sinkfer(:,:,:) + sinkfer2(:,:,:) ) * zfact * tmask(:,:,:) ) ! Export of iron  
+       CALL iom_put( "EXPCAL"  , sinkcal(:,:,:) * zfact * tmask(:,:,:) )      ! Export of calcite 
+       CALL iom_put( "EXPSI"   , sinksil(:,:,:) * zfact * tmask(:,:,:) )      ! Export of bigenic silica
+       CALL iom_put( "tcexp"   , t_oce_co2_exp * zfact )   ! molC/s
+       ! 
       ENDIF
       !
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
          WRITE(charout, FMT="('sink')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
       ENDIF
       !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zsms.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zsms.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p4zsms.F90	(revision 12928)
@@ -17,5 +17,5 @@
    USE p4zlys          ! Calcite saturation
    USE p4zflx          ! Gas exchange
-   USE p4zsbc          ! External source of nutrients
+   USE p4zbc           ! External source of nutrients
    USE p4zsed          ! Sedimentation
    USE p4zint          ! time interpolation
@@ -35,8 +35,10 @@
    INTEGER ::    numco2, numnut, numnit      ! logical unit for co2 budget
    REAL(wp) ::   alkbudget, no3budget, silbudget, ferbudget, po4budget
-   REAL(wp) ::   xfact1, xfact2, xfact3
+   REAL(wp) ::   xfact, xfact1, xfact2, xfact3
 
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xnegtr     ! Array used to indicate negative tracer values
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -46,5 +48,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_sms( kt )
+   SUBROUTINE p4z_sms( kt, Kbb, Kmm, Krhs )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_sms  ***
@@ -58,9 +60,14 @@
       !!---------------------------------------------------------------------
       !
-      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
+      INTEGER, INTENT( in ) ::   kt              ! ocean time-step index      
+      INTEGER, INTENT( in ) ::   Kbb, Kmm, Krhs  ! time level index
       !!
       INTEGER ::   ji, jj, jk, jnt, jn, jl
       REAL(wp) ::  ztra
       CHARACTER (len=25) :: charout
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:    ) :: zw2d
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:  ) :: zw3d
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   ztrdt   ! 4D workspace
+
       !!---------------------------------------------------------------------
       !
@@ -72,82 +79,135 @@
         !
         IF( .NOT. ln_rsttr ) THEN
-            CALL p4z_che                              ! initialize the chemical constants
-            CALL ahini_for_at(hi)   !  set PH at kt=nit000
+            CALL p4z_che( Kbb, Kmm )                  ! initialize the chemical constants
+            CALL ahini_for_at( hi, Kbb )              !  set PH at kt=nit000
             t_oce_co2_flx_cum = 0._wp
         ELSE
-            CALL p4z_rst( nittrc000, 'READ' )  !* read or initialize all required fields
+            CALL p4z_rst( nittrc000, Kbb, Kmm,  'READ' )  !* read or initialize all required fields
         ENDIF
         !
       ENDIF
       !
-      IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 )   CALL p4z_dmp( kt )      ! Relaxation of some tracers
-      !
-      rfact = r2dttrc
-      !
-      IF( ( ln_top_euler .AND. kt == nittrc000 )  .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + nn_dttrc ) ) THEN
+      IF( ln_pisdmp .AND. MOD( kt - 1, nn_pisdmp ) == 0 )   CALL p4z_dmp( kt, Kbb, Kmm )      ! Relaxation of some tracers
+      !
+      rfact = rDt_trc
+      !
+      ! trends computation initialisation
+      IF( l_trdtrc )  THEN
+         ALLOCATE( ztrdt(jpi,jpj,jpk,jp_pisces) )  !* store now fields before applying the Asselin filter
+         ztrdt(:,:,:,:)  = tr(:,:,:,:,Kmm)
+      ENDIF
+      !
+
+      IF( ( ln_top_euler .AND. kt == nittrc000 )  .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + 1 ) ) THEN
          rfactr  = 1. / rfact
          rfact2  = rfact / REAL( nrdttrc, wp )
          rfact2r = 1. / rfact2
          xstep = rfact2 / rday         ! Time step duration for biology
+         xfact = 1.e+3 * rfact2r
          IF(lwp) WRITE(numout,*) 
-         IF(lwp) WRITE(numout,*) '    Passive Tracer  time step    rfact  = ', rfact, ' rdt = ', rdt
+         IF(lwp) WRITE(numout,*) '    Passive Tracer  time step    rfact  = ', rfact, ' rn_Dt = ', rn_Dt
          IF(lwp) write(numout,*) '    PISCES  Biology time step    rfact2 = ', rfact2
          IF(lwp) WRITE(numout,*)
       ENDIF
 
-      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN
+      IF( l_1st_euler .OR. ln_top_euler ) THEN
          DO jn = jp_pcs0, jp_pcs1              !   SMS on tracer without Asselin time-filter
-            trb(:,:,:,jn) = trn(:,:,:,jn)
+            tr(:,:,:,jn,Kbb) = tr(:,:,:,jn,Kmm)
          END DO
       ENDIF
       !
-      IF( ll_sbc ) CALL p4z_sbc( kt )   ! external sources of nutrients 
+      IF( ll_bc )    CALL p4z_bc( kt, Kbb, Kmm, Krhs )   ! external sources of nutrients 
       !
 #if ! defined key_sed_off
-      CALL p4z_che              ! computation of chemical constants
-      CALL p4z_int( kt )        ! computation of various rates for biogeochemistry
+      CALL p4z_che(     Kbb, Kmm       ) ! computation of chemical constants
+      CALL p4z_int( kt, Kbb, Kmm       ) ! computation of various rates for biogeochemistry
       !
       DO jnt = 1, nrdttrc          ! Potential time splitting if requested
          !
-         CALL p4z_bio( kt, jnt )   ! Biology
-         CALL p4z_lys( kt, jnt )   ! Compute CaCO3 saturation
-         CALL p4z_sed( kt, jnt )   ! Surface and Bottom boundary conditions
-         CALL p4z_flx( kt, jnt )   ! Compute surface fluxes
+         CALL p4z_bio( kt, jnt, Kbb, Kmm, Krhs )   ! Biology
+         CALL p4z_lys( kt, jnt, Kbb,      Krhs )   ! Compute CaCO3 saturation
+         CALL p4z_sed( kt, jnt, Kbb, Kmm, Krhs )   ! Surface and Bottom boundary conditions
+         CALL p4z_flx( kt, jnt, Kbb, Kmm, Krhs )   ! Compute surface fluxes
          !
          xnegtr(:,:,:) = 1.e0
          DO jn = jp_pcs0, jp_pcs1
-            DO jk = 1, jpk
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     IF( ( trb(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) THEN
-                        ztra             = ABS( trb(ji,jj,jk,jn) ) / ( ABS( tra(ji,jj,jk,jn) ) + rtrn )
-                        xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk),  ztra )
-                     ENDIF
-                 END DO
-               END DO
-            END DO
+            DO_3D_11_11( 1, jpk )
+               IF( ( tr(ji,jj,jk,jn,Kbb) + tr(ji,jj,jk,jn,Krhs) ) < 0.e0 ) THEN
+                  ztra             = ABS( tr(ji,jj,jk,jn,Kbb) ) / ( ABS( tr(ji,jj,jk,jn,Krhs) ) + rtrn )
+                  xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk),  ztra )
+               ENDIF
+            END_3D
          END DO
          !                                ! where at least 1 tracer concentration becomes negative
          !                                ! 
          DO jn = jp_pcs0, jp_pcs1
-           trb(:,:,:,jn) = trb(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn)
+           tr(:,:,:,jn,Kbb) = tr(:,:,:,jn,Kbb) + xnegtr(:,:,:) * tr(:,:,:,jn,Krhs)
          END DO
         !
+        IF(  iom_use( 'INTdtAlk' ) .OR. iom_use( 'INTdtDIC' ) .OR. iom_use( 'INTdtFer' ) .OR.  &
+          &  iom_use( 'INTdtDIN' ) .OR. iom_use( 'INTdtDIP' ) .OR. iom_use( 'INTdtSil' ) )  THEN
+          !
+          ALLOCATE( zw3d(jpi,jpj,jpk), zw2d(jpi,jpj) )
+          zw3d(:,:,jpk) = 0.
+          DO jk = 1, jpkm1
+              zw3d(:,:,jk) = xnegtr(:,:,jk) * xfact * e3t(:,:,jk,Kmm) * tmask(:,:,jk)
+          ENDDO
+          !
+          zw2d(:,:) = 0.
+          DO jk = 1, jpkm1
+             zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jptal,Krhs)
+          ENDDO
+          CALL iom_put( 'INTdtAlk', zw2d )
+          !
+          zw2d(:,:) = 0.
+          DO jk = 1, jpkm1
+             zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jpdic,Krhs)
+          ENDDO
+          CALL iom_put( 'INTdtDIC', zw2d )
+          !
+          zw2d(:,:) = 0.
+          DO jk = 1, jpkm1
+             zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * rno3 * ( tr(:,:,jk,jpno3,Krhs) + tr(:,:,jk,jpnh4,Krhs) )
+          ENDDO
+          CALL iom_put( 'INTdtDIN', zw2d )
+          !
+          zw2d(:,:) = 0.
+          DO jk = 1, jpkm1
+             zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * po4r * tr(:,:,jk,jppo4,Krhs)
+          ENDDO
+          CALL iom_put( 'INTdtDIP', zw2d )
+          !
+          zw2d(:,:) = 0.
+          DO jk = 1, jpkm1
+             zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jpfer,Krhs)
+          ENDDO
+          CALL iom_put( 'INTdtFer', zw2d )
+          !
+          zw2d(:,:) = 0.
+          DO jk = 1, jpkm1
+             zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jpsil,Krhs)
+          ENDDO
+          CALL iom_put( 'INTdtSil', zw2d )
+          !
+          DEALLOCATE( zw3d, zw2d )
+        ENDIF
+        !
          DO jn = jp_pcs0, jp_pcs1
-            tra(:,:,:,jn) = 0._wp
+            tr(:,:,:,jn,Krhs) = 0._wp
          END DO
          !
          IF( ln_top_euler ) THEN
             DO jn = jp_pcs0, jp_pcs1
-               trn(:,:,:,jn) = trb(:,:,:,jn)
+               tr(:,:,:,jn,Kmm) = tr(:,:,:,jn,Kbb)
             END DO
          ENDIF
       END DO
-
       !
       IF( l_trdtrc ) THEN
          DO jn = jp_pcs0, jp_pcs1
-           CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt )   ! save trends
+           ztrdt(:,:,:,jn) = ( tr(:,:,:,jn,Kbb) - ztrdt(:,:,:,jn) ) * rfact2r 
+           CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm )   ! save trends
          END DO
+         DEALLOCATE( ztrdt ) 
       END IF
 #endif
@@ -155,9 +215,9 @@
       IF( ln_sediment ) THEN 
          !
-         CALL sed_model( kt )     !  Main program of Sediment model
+         CALL sed_model( kt, Kbb, Kmm, Krhs )     !  Main program of Sediment model
          !
          IF( ln_top_euler ) THEN
             DO jn = jp_pcs0, jp_pcs1
-               trn(:,:,:,jn) = trb(:,:,:,jn)
+               tr(:,:,:,jn,Kmm) = tr(:,:,:,jn,Kbb)
             END DO
          ENDIF
@@ -165,10 +225,10 @@
       ENDIF
       !
-      IF( lrst_trc )  CALL p4z_rst( kt, 'WRITE' )  !* Write PISCES informations in restart file 
-      !
-
-      IF( lk_iomput .OR. ln_check_mass )  CALL p4z_chk_mass( kt )    ! Mass conservation checking
-
-      IF( lwm .AND. kt == nittrc000    )  CALL FLUSH( numonp )       ! flush output namelist PISCES
+      IF( lrst_trc )  CALL p4z_rst( kt, Kbb, Kmm,  'WRITE' )           !* Write PISCES informations in restart file 
+      !
+
+      IF( lk_iomput .OR. ln_check_mass )  CALL p4z_chk_mass( kt, Kmm ) ! Mass conservation checking
+
+      IF( lwm .AND. kt == nittrc000    )  CALL FLUSH( numonp )         ! flush output namelist PISCES
       !
       IF( ln_timing )  CALL timing_stop('p4z_sms')
@@ -201,8 +261,6 @@
       ENDIF
 
-      REWIND( numnatp_ref )              ! Namelist nampisbio in reference namelist : Pisces variables
       READ  ( numnatp_ref, nampisbio, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisbio in reference namelist' )
-      REWIND( numnatp_cfg )              ! Namelist nampisbio in configuration namelist : Pisces variables
       READ  ( numnatp_cfg, nampisbio, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisbio in configuration namelist' )
@@ -232,8 +290,6 @@
 
 
-      REWIND( numnatp_ref )              ! Namelist nampisdmp in reference namelist : Pisces damping
       READ  ( numnatp_ref, nampisdmp, IOSTAT = ios, ERR = 905)
 905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisdmp in reference namelist' )
-      REWIND( numnatp_cfg )              ! Namelist nampisdmp in configuration namelist : Pisces damping
       READ  ( numnatp_cfg, nampisdmp, IOSTAT = ios, ERR = 906 )
 906   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisdmp in configuration namelist' )
@@ -247,8 +303,6 @@
       ENDIF
 
-      REWIND( numnatp_ref )              ! Namelist nampismass in reference namelist : Pisces mass conservation check
       READ  ( numnatp_ref, nampismass, IOSTAT = ios, ERR = 907)
 907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampismass in reference namelist' )
-      REWIND( numnatp_cfg )              ! Namelist nampismass in configuration namelist : Pisces mass conservation check 
       READ  ( numnatp_cfg, nampismass, IOSTAT = ios, ERR = 908 )
 908   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampismass in configuration namelist' )
@@ -264,5 +318,5 @@
 
 
-   SUBROUTINE p4z_rst( kt, cdrw )
+   SUBROUTINE p4z_rst( kt, Kbb, Kmm, cdrw )
       !!---------------------------------------------------------------------
       !!                   ***  ROUTINE p4z_rst  ***
@@ -275,4 +329,5 @@
       !!---------------------------------------------------------------------
       INTEGER         , INTENT(in) ::   kt         ! ocean time-step
+      INTEGER         , INTENT(in) ::   Kbb, Kmm   ! time level indices
       CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
       !!---------------------------------------------------------------------
@@ -287,6 +342,6 @@
             CALL iom_get( numrtr, jpdom_autoglo, 'PH' , hi(:,:,:)  )
          ELSE
-            CALL p4z_che                              ! initialize the chemical constants
-            CALL ahini_for_at(hi)
+            CALL p4z_che( Kbb, Kmm )                  ! initialize the chemical constants
+            CALL ahini_for_at( hi, Kbb )
          ENDIF
          CALL iom_get( numrtr, jpdom_autoglo, 'Silicalim', xksi(:,:) )
@@ -335,5 +390,5 @@
 
 
-   SUBROUTINE p4z_dmp( kt )
+   SUBROUTINE p4z_dmp( kt, Kbb, Kmm )
       !!----------------------------------------------------------------------
       !!                    ***  p4z_dmp  ***
@@ -342,5 +397,6 @@
       !!----------------------------------------------------------------------
       !
-      INTEGER, INTENT( in )  ::     kt ! time step
+      INTEGER, INTENT( in )  ::     kt            ! time step
+      INTEGER, INTENT( in )  ::     Kbb, Kmm      ! time level indices
       !
       REAL(wp) ::  alkmean = 2426.     ! mean value of alkalinity ( Glodap ; for Goyet 2391. )
@@ -363,40 +419,40 @@
             zarea          = 1._wp / glob_sum( 'p4zsms', cvol(:,:,:) ) * 1e6              
 
-            zalksumn = glob_sum( 'p4zsms', trn(:,:,:,jptal) * cvol(:,:,:)  ) * zarea
-            zpo4sumn = glob_sum( 'p4zsms', trn(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea * po4r
-            zno3sumn = glob_sum( 'p4zsms', trn(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea * rno3
-            zsilsumn = glob_sum( 'p4zsms', trn(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea
+            zalksumn = glob_sum( 'p4zsms', tr(:,:,:,jptal,Kmm) * cvol(:,:,:)  ) * zarea
+            zpo4sumn = glob_sum( 'p4zsms', tr(:,:,:,jppo4,Kmm) * cvol(:,:,:)  ) * zarea * po4r
+            zno3sumn = glob_sum( 'p4zsms', tr(:,:,:,jpno3,Kmm) * cvol(:,:,:)  ) * zarea * rno3
+            zsilsumn = glob_sum( 'p4zsms', tr(:,:,:,jpsil,Kmm) * cvol(:,:,:)  ) * zarea
  
             IF(lwp) WRITE(numout,*) '       TALKN mean : ', zalksumn
-            trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksumn
+            tr(:,:,:,jptal,Kmm) = tr(:,:,:,jptal,Kmm) * alkmean / zalksumn
 
             IF(lwp) WRITE(numout,*) '       PO4N  mean : ', zpo4sumn
-            trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sumn
+            tr(:,:,:,jppo4,Kmm) = tr(:,:,:,jppo4,Kmm) * po4mean / zpo4sumn
 
             IF(lwp) WRITE(numout,*) '       NO3N  mean : ', zno3sumn
-            trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sumn
+            tr(:,:,:,jpno3,Kmm) = tr(:,:,:,jpno3,Kmm) * no3mean / zno3sumn
 
             IF(lwp) WRITE(numout,*) '       SiO3N mean : ', zsilsumn
-            trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsumn )
+            tr(:,:,:,jpsil,Kmm) = MIN( 400.e-6,tr(:,:,:,jpsil,Kmm) * silmean / zsilsumn )
             !
             !
             IF( .NOT. ln_top_euler ) THEN
-               zalksumb = glob_sum( 'p4zsms', trb(:,:,:,jptal) * cvol(:,:,:)  ) * zarea
-               zpo4sumb = glob_sum( 'p4zsms', trb(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea * po4r
-               zno3sumb = glob_sum( 'p4zsms', trb(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea * rno3
-               zsilsumb = glob_sum( 'p4zsms', trb(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea
+               zalksumb = glob_sum( 'p4zsms', tr(:,:,:,jptal,Kbb) * cvol(:,:,:)  ) * zarea
+               zpo4sumb = glob_sum( 'p4zsms', tr(:,:,:,jppo4,Kbb) * cvol(:,:,:)  ) * zarea * po4r
+               zno3sumb = glob_sum( 'p4zsms', tr(:,:,:,jpno3,Kbb) * cvol(:,:,:)  ) * zarea * rno3
+               zsilsumb = glob_sum( 'p4zsms', tr(:,:,:,jpsil,Kbb) * cvol(:,:,:)  ) * zarea
  
                IF(lwp) WRITE(numout,*) ' '
                IF(lwp) WRITE(numout,*) '       TALKB mean : ', zalksumb
-               trb(:,:,:,jptal) = trb(:,:,:,jptal) * alkmean / zalksumb
+               tr(:,:,:,jptal,Kbb) = tr(:,:,:,jptal,Kbb) * alkmean / zalksumb
 
                IF(lwp) WRITE(numout,*) '       PO4B  mean : ', zpo4sumb
-               trb(:,:,:,jppo4) = trb(:,:,:,jppo4) * po4mean / zpo4sumb
+               tr(:,:,:,jppo4,Kbb) = tr(:,:,:,jppo4,Kbb) * po4mean / zpo4sumb
 
                IF(lwp) WRITE(numout,*) '       NO3B  mean : ', zno3sumb
-               trb(:,:,:,jpno3) = trb(:,:,:,jpno3) * no3mean / zno3sumb
+               tr(:,:,:,jpno3,Kbb) = tr(:,:,:,jpno3,Kbb) * no3mean / zno3sumb
 
                IF(lwp) WRITE(numout,*) '       SiO3B mean : ', zsilsumb
-               trb(:,:,:,jpsil) = MIN( 400.e-6,trb(:,:,:,jpsil) * silmean / zsilsumb )
+               tr(:,:,:,jpsil,Kbb) = MIN( 400.e-6,tr(:,:,:,jpsil,Kbb) * silmean / zsilsumb )
            ENDIF
         ENDIF
@@ -407,5 +463,5 @@
 
 
-   SUBROUTINE p4z_chk_mass( kt )
+   SUBROUTINE p4z_chk_mass( kt, Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE p4z_chk_mass  ***
@@ -415,4 +471,5 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
+      INTEGER, INTENT( in ) ::   Kmm     ! time level indices
       REAL(wp)             ::  zrdenittot, zsdenittot, znitrpottot
       CHARACTER(LEN=100)   ::   cltxt
@@ -438,13 +495,13 @@
          !   Compute the budget of NO3, ALK, Si, Fer
          IF( ln_p4z ) THEN
-            zwork(:,:,:) =    trn(:,:,:,jpno3) + trn(:,:,:,jpnh4)                      &
-               &          +   trn(:,:,:,jpphy) + trn(:,:,:,jpdia)                      &
-               &          +   trn(:,:,:,jppoc) + trn(:,:,:,jpgoc)  + trn(:,:,:,jpdoc)  &        
-               &          +   trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) 
+            zwork(:,:,:) =    tr(:,:,:,jpno3,Kmm) + tr(:,:,:,jpnh4,Kmm)                      &
+               &          +   tr(:,:,:,jpphy,Kmm) + tr(:,:,:,jpdia,Kmm)                      &
+               &          +   tr(:,:,:,jppoc,Kmm) + tr(:,:,:,jpgoc,Kmm)  + tr(:,:,:,jpdoc,Kmm)  &        
+               &          +   tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) 
         ELSE
-            zwork(:,:,:) =    trn(:,:,:,jpno3) + trn(:,:,:,jpnh4) + trn(:,:,:,jpnph)   &
-               &          +   trn(:,:,:,jpndi) + trn(:,:,:,jpnpi)                      & 
-               &          +   trn(:,:,:,jppon) + trn(:,:,:,jpgon) + trn(:,:,:,jpdon)   &
-               &          + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * no3rat3 
+            zwork(:,:,:) =    tr(:,:,:,jpno3,Kmm) + tr(:,:,:,jpnh4,Kmm) + tr(:,:,:,jpnph,Kmm)   &
+               &          +   tr(:,:,:,jpndi,Kmm) + tr(:,:,:,jpnpi,Kmm)                      & 
+               &          +   tr(:,:,:,jppon,Kmm) + tr(:,:,:,jpgon,Kmm) + tr(:,:,:,jpdon,Kmm)   &
+               &          + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) ) * no3rat3 
         ENDIF
         !
@@ -456,13 +513,13 @@
       IF( iom_use( "ppo4tot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN
          IF( ln_p4z ) THEN
-            zwork(:,:,:) =    trn(:,:,:,jppo4)                                         &
-               &          +   trn(:,:,:,jpphy) + trn(:,:,:,jpdia)                      &
-               &          +   trn(:,:,:,jppoc) + trn(:,:,:,jpgoc)  + trn(:,:,:,jpdoc)  &        
-               &          +   trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) 
+            zwork(:,:,:) =    tr(:,:,:,jppo4,Kmm)                                         &
+               &          +   tr(:,:,:,jpphy,Kmm) + tr(:,:,:,jpdia,Kmm)                      &
+               &          +   tr(:,:,:,jppoc,Kmm) + tr(:,:,:,jpgoc,Kmm)  + tr(:,:,:,jpdoc,Kmm)  &        
+               &          +   tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) 
         ELSE
-            zwork(:,:,:) =    trn(:,:,:,jppo4) + trn(:,:,:,jppph)                      &
-               &          +   trn(:,:,:,jppdi) + trn(:,:,:,jpppi)                      & 
-               &          +   trn(:,:,:,jppop) + trn(:,:,:,jpgop) + trn(:,:,:,jpdop)   &
-               &          + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * po4rat3 
+            zwork(:,:,:) =    tr(:,:,:,jppo4,Kmm) + tr(:,:,:,jppph,Kmm)                      &
+               &          +   tr(:,:,:,jppdi,Kmm) + tr(:,:,:,jpppi,Kmm)                      & 
+               &          +   tr(:,:,:,jppop,Kmm) + tr(:,:,:,jpgop,Kmm) + tr(:,:,:,jpdop,Kmm)   &
+               &          + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) ) * po4rat3 
         ENDIF
         !
@@ -473,5 +530,5 @@
       !
       IF( iom_use( "psiltot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN
-         zwork(:,:,:) =  trn(:,:,:,jpsil) + trn(:,:,:,jpgsi) + trn(:,:,:,jpdsi) 
+         zwork(:,:,:) =  tr(:,:,:,jpsil,Kmm) + tr(:,:,:,jpgsi,Kmm) + tr(:,:,:,jpdsi,Kmm) 
          !
          silbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:)  )  
@@ -481,5 +538,5 @@
       !
       IF( iom_use( "palktot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN
-         zwork(:,:,:) =  trn(:,:,:,jpno3) * rno3 + trn(:,:,:,jptal) + trn(:,:,:,jpcal) * 2.              
+         zwork(:,:,:) =  tr(:,:,:,jpno3,Kmm) * rno3 + tr(:,:,:,jptal,Kmm) + tr(:,:,:,jpcal,Kmm) * 2.              
          !
          alkbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:)  )         !
@@ -489,7 +546,7 @@
       !
       IF( iom_use( "pfertot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN
-         zwork(:,:,:) =   trn(:,:,:,jpfer) + trn(:,:,:,jpnfe) + trn(:,:,:,jpdfe)   &
-            &         +   trn(:,:,:,jpbfe) + trn(:,:,:,jpsfe)                      &
-            &         + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) )  * ferat3    
+         zwork(:,:,:) =   tr(:,:,:,jpfer,Kmm) + tr(:,:,:,jpnfe,Kmm) + tr(:,:,:,jpdfe,Kmm)   &
+            &         +   tr(:,:,:,jpbfe,Kmm) + tr(:,:,:,jpsfe,Kmm)                      &
+            &         + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) )  * ferat3    
          !
          ferbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:)  )  
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p5zlim.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p5zlim.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p5zlim.F90	(revision 12928)
@@ -91,4 +91,6 @@
    REAL(wp) ::  xcoef2   = 1.21E-5 * 14. / 55.85 / 7.625 * 0.5 * 1.5
    REAL(wp) ::  xcoef3   = 1.15E-4 * 14. / 55.85 / 7.625 * 0.5 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -99,5 +101,5 @@
 CONTAINS
 
-   SUBROUTINE p5z_lim( kt, knt )
+   SUBROUTINE p5z_lim( kt, knt, Kbb, Kmm )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p5z_lim  ***
@@ -110,4 +112,5 @@
       !
       INTEGER, INTENT(in)  :: kt, knt
+      INTEGER, INTENT(in)  :: Kbb, Kmm  ! time level indices
       !
       INTEGER  ::   ji, jj, jk
@@ -128,189 +131,185 @@
       zratchl = 6.0
       !
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ! 
-               ! Tuning of the iron concentration to a minimum level that is set to the detection limit
-               !-------------------------------------
-               zno3    = trb(ji,jj,jk,jpno3) / 40.e-6
-               zferlim = MAX( 3e-11 * zno3 * zno3, 5e-12 )
-               zferlim = MIN( zferlim, 7e-11 )
-               trb(ji,jj,jk,jpfer) = MAX( trb(ji,jj,jk,jpfer), zferlim )
-
-               ! Computation of the mean relative size of each community
-               ! -------------------------------------------------------
-               z1_trnphy   = 1. / ( trb(ji,jj,jk,jpphy) + rtrn )
-               z1_trnpic   = 1. / ( trb(ji,jj,jk,jppic) + rtrn )
-               z1_trndia   = 1. / ( trb(ji,jj,jk,jpdia) + rtrn )
-               znanochl = trb(ji,jj,jk,jpnch) * z1_trnphy
-               zpicochl = trb(ji,jj,jk,jppch) * z1_trnpic
-               zdiatchl = trb(ji,jj,jk,jpdch) * z1_trndia
-
-               ! Computation of a variable Ks for iron on diatoms taking into account
-               ! that increasing biomass is made of generally bigger cells
-               !------------------------------------------------
-               zsized            = sized(ji,jj,jk)**0.81
-               zconcdfe          = concdfer * zsized
-               zconc1d           = concdno3 * zsized
-               zconc1dnh4        = concdnh4 * zsized
-               zconc0dpo4        = concdpo4 * zsized
-
-               zsizep            = 1.
-               zconcpfe          = concpfer * zsizep
-               zconc0p           = concpno3 * zsizep
-               zconc0pnh4        = concpnh4 * zsizep
-               zconc0ppo4        = concppo4 * zsizep
-
-               zsizen            = 1.
-               zconcnfe          = concnfer * zsizen
-               zconc0n           = concnno3 * zsizen
-               zconc0nnh4        = concnnh4 * zsizen
-               zconc0npo4        = concnpo4 * zsizen
-
-               ! Allometric variations of the minimum and maximum quotas
-               ! From Talmy et al. (2014) and Maranon et al. (2013)
-               ! -------------------------------------------------------
-               xqnnmin(ji,jj,jk) = qnnmin
-               xqnnmax(ji,jj,jk) = qnnmax
-               xqndmin(ji,jj,jk) = qndmin * sized(ji,jj,jk)**(-0.27) 
-               xqndmax(ji,jj,jk) = qndmax
-               xqnpmin(ji,jj,jk) = qnpmin
-               xqnpmax(ji,jj,jk) = qnpmax
-
-               ! Computation of the optimal allocation parameters
-               ! Based on the different papers by Pahlow et al., and Smith et al.
-               ! -----------------------------------------------------------------
-               znutlim = MAX( trb(ji,jj,jk,jpnh4) / zconc0nnh4,    &
-                 &         trb(ji,jj,jk,jpno3) / zconc0n)
-               fanano = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) )
-               znutlim = trb(ji,jj,jk,jppo4) / zconc0npo4
-               fananop = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) )
-               znutlim = biron(ji,jj,jk) / zconcnfe
-               fananof = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) )
-               znutlim = MAX( trb(ji,jj,jk,jpnh4) / zconc0pnh4,    &
-                 &         trb(ji,jj,jk,jpno3) / zconc0p)
-               fapico = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) )
-               znutlim = trb(ji,jj,jk,jppo4) / zconc0ppo4
-               fapicop = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) )
-               znutlim = biron(ji,jj,jk) / zconcpfe
-               fapicof = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) )
-               znutlim = MAX( trb(ji,jj,jk,jpnh4) / zconc1dnh4,    &
-                 &         trb(ji,jj,jk,jpno3) / zconc1d )
-               fadiat = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) )
-               znutlim = trb(ji,jj,jk,jppo4) / zconc0dpo4
-               fadiatp = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) )
-               znutlim = biron(ji,jj,jk) / zconcdfe
-               fadiatf = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) )
-               !
-               ! Michaelis-Menten Limitation term for nutrients Small bacteria
-               ! -------------------------------------------------------------
-               zbactnh4 = trb(ji,jj,jk,jpnh4) / ( concbnh4 + trb(ji,jj,jk,jpnh4) )
-               zbactno3 = trb(ji,jj,jk,jpno3) / ( concbno3 + trb(ji,jj,jk,jpno3) ) * (1. - zbactnh4)
-               !
-               zlim1    = zbactno3 + zbactnh4
-               zlim2    = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concbpo4)
-               zlim3    = biron(ji,jj,jk) / ( concbfe + biron(ji,jj,jk) )
-               zlim4    = trb(ji,jj,jk,jpdoc) / ( xkdoc   + trb(ji,jj,jk,jpdoc) )
-               xlimbacl(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 )
-               xlimbac (ji,jj,jk) = xlimbacl(ji,jj,jk) * zlim4
-               !
-               ! Michaelis-Menten Limitation term for nutrients Small flagellates
-               ! -----------------------------------------------
-               zfalim = (1.-fanano) / fanano
-               xnanonh4(ji,jj,jk) = (1. - fanano) * trb(ji,jj,jk,jpnh4) / ( zfalim * zconc0nnh4 + trb(ji,jj,jk,jpnh4) )
-               xnanono3(ji,jj,jk) = (1. - fanano) * trb(ji,jj,jk,jpno3) / ( zfalim * zconc0n + trb(ji,jj,jk,jpno3) )  &
-               &                    * (1. - xnanonh4(ji,jj,jk))
-               !
-               zfalim = (1.-fananop) / fananop
-               xnanopo4(ji,jj,jk) = (1. - fananop) * trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zfalim * zconc0npo4 )
-               xnanodop(ji,jj,jk) = trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdop) + xkdoc )   &
-               &                    * ( 1.0 - xnanopo4(ji,jj,jk) )
-               xnanodop(ji,jj,jk) = 0.
-               !
-               zfalim = (1.-fananof) / fananof
-               xnanofer(ji,jj,jk) = (1. - fananof) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcnfe )
-               !
-               zratiof   = trb(ji,jj,jk,jpnfe) * z1_trnphy
-               zqfemn = xcoef1 * znanochl + xcoef2 + xcoef3 * xnanono3(ji,jj,jk)
-               !
-               zration = trb(ji,jj,jk,jpnph) * z1_trnphy
-               zration = MIN(xqnnmax(ji,jj,jk), MAX( 2. * xqnnmin(ji,jj,jk), zration ))
-               fvnuptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqnnmin(ji,jj,jk) / (zration + rtrn)  &
-               &                   * MAX(0., (1. - zratchl * znanochl / 12. ) )
-               !
-               zlim1    = max(0., (zration - 2. * xqnnmin(ji,jj,jk) )  &
-               &          / (xqnnmax(ji,jj,jk) - 2. * xqnnmin(ji,jj,jk) ) ) * xqnnmax(ji,jj,jk)  &
-               &          / (zration + rtrn)
-               zlim3    = MAX( 0.,( zratiof - zqfemn ) / qfnopt ) 
-               xlimnfe(ji,jj,jk) = MIN( 1., zlim3 )
-               xlimphy(ji,jj,jk) = MIN( 1., zlim1, zlim3 )
-               !
-               ! Michaelis-Menten Limitation term for nutrients picophytoplankton
-               ! ----------------------------------------------------------------
-               zfalim = (1.-fapico) / fapico 
-               xpiconh4(ji,jj,jk) = (1. - fapico) * trb(ji,jj,jk,jpnh4) / ( zfalim * zconc0pnh4 + trb(ji,jj,jk,jpnh4) )
-               xpicono3(ji,jj,jk) = (1. - fapico) * trb(ji,jj,jk,jpno3) / ( zfalim * zconc0p + trb(ji,jj,jk,jpno3) )  &
-               &                    * (1. - xpiconh4(ji,jj,jk))
-               !
-               zfalim = (1.-fapicop) / fapicop 
-               xpicopo4(ji,jj,jk) = (1. - fapicop) * trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zfalim * zconc0ppo4 )
-               xpicodop(ji,jj,jk) = trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdop) + xkdoc )   &
-               &                    * ( 1.0 - xpicopo4(ji,jj,jk) )
-               xpicodop(ji,jj,jk) = 0.
-               !
-               zfalim = (1.-fapicof) / fapicof
-               xpicofer(ji,jj,jk) = (1. - fapicof) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcpfe )
-               !
-               zratiof   = trb(ji,jj,jk,jppfe) * z1_trnpic
-               zqfemp = xcoef1 * zpicochl + xcoef2 + xcoef3 * xpicono3(ji,jj,jk)
-               !
-               zration   = trb(ji,jj,jk,jpnpi) * z1_trnpic
-               zration = MIN(xqnpmax(ji,jj,jk), MAX( 2. * xqnpmin(ji,jj,jk), zration ))
-               fvpuptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqnpmin(ji,jj,jk) / (zration + rtrn)  &
-               &                   * MAX(0., (1. - zratchl * zpicochl / 12. ) ) 
-               !
-               zlim1    = max(0., (zration - 2. * xqnpmin(ji,jj,jk) )  &
-               &          / (xqnpmax(ji,jj,jk) - 2. * xqnpmin(ji,jj,jk) ) ) * xqnpmax(ji,jj,jk)  &
-               &          / (zration + rtrn)
-               zlim3    = MAX( 0.,( zratiof - zqfemp ) / qfpopt )
-               xlimpfe(ji,jj,jk) = MIN( 1., zlim3 )
-               xlimpic(ji,jj,jk) = MIN( 1., zlim1, zlim3 )
-               !
-               !   Michaelis-Menten Limitation term for nutrients Diatoms
-               !   ------------------------------------------------------
-               zfalim = (1.-fadiat) / fadiat 
-               xdiatnh4(ji,jj,jk) = (1. - fadiat) * trb(ji,jj,jk,jpnh4) / ( zfalim * zconc1dnh4 + trb(ji,jj,jk,jpnh4) )
-               xdiatno3(ji,jj,jk) = (1. - fadiat) * trb(ji,jj,jk,jpno3) / ( zfalim * zconc1d + trb(ji,jj,jk,jpno3) )  &
-               &                    * (1. - xdiatnh4(ji,jj,jk))
-               !
-               zfalim = (1.-fadiatp) / fadiatp
-               xdiatpo4(ji,jj,jk) = (1. - fadiatp) * trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zfalim * zconc0dpo4 )
-               xdiatdop(ji,jj,jk) = trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdop) + xkdoc )  &
-               &                    * ( 1.0 - xdiatpo4(ji,jj,jk) )
-               xdiatdop(ji,jj,jk) = 0.
-               !
-               zfalim = (1.-fadiatf) / fadiatf
-               xdiatfer(ji,jj,jk) = (1. - fadiatf) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcdfe )
-               !
-               zratiof   = trb(ji,jj,jk,jpdfe) * z1_trndia
-               zqfemd = xcoef1 * zdiatchl + xcoef2 + xcoef3 * xdiatno3(ji,jj,jk)
-               !
-               zration   = trb(ji,jj,jk,jpndi) * z1_trndia
-               zration = MIN(xqndmax(ji,jj,jk), MAX( 2. * xqndmin(ji,jj,jk), zration ))
-               fvduptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqndmin(ji,jj,jk) / (zration + rtrn)   &
-               &                   * MAX(0., (1. - zratchl * zdiatchl / 12. ) ) 
-               !
-               zlim1    = max(0., (zration - 2. * xqndmin(ji,jj,jk) )    &
-               &          / (xqndmax(ji,jj,jk) - 2. * xqndmin(ji,jj,jk) ) )   &
-               &          * xqndmax(ji,jj,jk) / (zration + rtrn)
-               zlim3    = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi(ji,jj) )
-               zlim4    = MAX( 0., ( zratiof - zqfemd ) / qfdopt )
-               xlimdfe(ji,jj,jk) = MIN( 1., zlim4 )
-               xlimdia(ji,jj,jk) = MIN( 1., zlim1, zlim3, zlim4 )
-               xlimsi(ji,jj,jk)  = MIN( zlim1, zlim4 )
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpkm1 )
+         ! 
+         ! Tuning of the iron concentration to a minimum level that is set to the detection limit
+         !-------------------------------------
+         zno3    = tr(ji,jj,jk,jpno3,Kbb) / 40.e-6
+         zferlim = MAX( 3e-11 * zno3 * zno3, 5e-12 )
+         zferlim = MIN( zferlim, 7e-11 )
+         tr(ji,jj,jk,jpfer,Kbb) = MAX( tr(ji,jj,jk,jpfer,Kbb), zferlim )
+
+         ! Computation of the mean relative size of each community
+         ! -------------------------------------------------------
+         z1_trnphy   = 1. / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn )
+         z1_trnpic   = 1. / ( tr(ji,jj,jk,jppic,Kbb) + rtrn )
+         z1_trndia   = 1. / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
+         znanochl = tr(ji,jj,jk,jpnch,Kbb) * z1_trnphy
+         zpicochl = tr(ji,jj,jk,jppch,Kbb) * z1_trnpic
+         zdiatchl = tr(ji,jj,jk,jpdch,Kbb) * z1_trndia
+
+         ! Computation of a variable Ks for iron on diatoms taking into account
+         ! that increasing biomass is made of generally bigger cells
+         !------------------------------------------------
+         zsized            = sized(ji,jj,jk)**0.81
+         zconcdfe          = concdfer * zsized
+         zconc1d           = concdno3 * zsized
+         zconc1dnh4        = concdnh4 * zsized
+         zconc0dpo4        = concdpo4 * zsized
+
+         zsizep            = 1.
+         zconcpfe          = concpfer * zsizep
+         zconc0p           = concpno3 * zsizep
+         zconc0pnh4        = concpnh4 * zsizep
+         zconc0ppo4        = concppo4 * zsizep
+
+         zsizen            = 1.
+         zconcnfe          = concnfer * zsizen
+         zconc0n           = concnno3 * zsizen
+         zconc0nnh4        = concnnh4 * zsizen
+         zconc0npo4        = concnpo4 * zsizen
+
+         ! Allometric variations of the minimum and maximum quotas
+         ! From Talmy et al. (2014) and Maranon et al. (2013)
+         ! -------------------------------------------------------
+         xqnnmin(ji,jj,jk) = qnnmin
+         xqnnmax(ji,jj,jk) = qnnmax
+         xqndmin(ji,jj,jk) = qndmin * sized(ji,jj,jk)**(-0.27) 
+         xqndmax(ji,jj,jk) = qndmax
+         xqnpmin(ji,jj,jk) = qnpmin
+         xqnpmax(ji,jj,jk) = qnpmax
+
+         ! Computation of the optimal allocation parameters
+         ! Based on the different papers by Pahlow et al., and Smith et al.
+         ! -----------------------------------------------------------------
+         znutlim = MAX( tr(ji,jj,jk,jpnh4,Kbb) / zconc0nnh4,    &
+           &         tr(ji,jj,jk,jpno3,Kbb) / zconc0n)
+         fanano = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) )
+         znutlim = tr(ji,jj,jk,jppo4,Kbb) / zconc0npo4
+         fananop = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) )
+         znutlim = biron(ji,jj,jk) / zconcnfe
+         fananof = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) )
+         znutlim = MAX( tr(ji,jj,jk,jpnh4,Kbb) / zconc0pnh4,    &
+           &         tr(ji,jj,jk,jpno3,Kbb) / zconc0p)
+         fapico = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) )
+         znutlim = tr(ji,jj,jk,jppo4,Kbb) / zconc0ppo4
+         fapicop = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) )
+         znutlim = biron(ji,jj,jk) / zconcpfe
+         fapicof = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) )
+         znutlim = MAX( tr(ji,jj,jk,jpnh4,Kbb) / zconc1dnh4,    &
+           &         tr(ji,jj,jk,jpno3,Kbb) / zconc1d )
+         fadiat = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) )
+         znutlim = tr(ji,jj,jk,jppo4,Kbb) / zconc0dpo4
+         fadiatp = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) )
+         znutlim = biron(ji,jj,jk) / zconcdfe
+         fadiatf = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) )
+         !
+         ! Michaelis-Menten Limitation term for nutrients Small bacteria
+         ! -------------------------------------------------------------
+         zbactnh4 = tr(ji,jj,jk,jpnh4,Kbb) / ( concbnh4 + tr(ji,jj,jk,jpnh4,Kbb) )
+         zbactno3 = tr(ji,jj,jk,jpno3,Kbb) / ( concbno3 + tr(ji,jj,jk,jpno3,Kbb) ) * (1. - zbactnh4)
+         !
+         zlim1    = zbactno3 + zbactnh4
+         zlim2    = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + concbpo4)
+         zlim3    = biron(ji,jj,jk) / ( concbfe + biron(ji,jj,jk) )
+         zlim4    = tr(ji,jj,jk,jpdoc,Kbb) / ( xkdoc   + tr(ji,jj,jk,jpdoc,Kbb) )
+         xlimbacl(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 )
+         xlimbac (ji,jj,jk) = xlimbacl(ji,jj,jk) * zlim4
+         !
+         ! Michaelis-Menten Limitation term for nutrients Small flagellates
+         ! -----------------------------------------------
+         zfalim = (1.-fanano) / fanano
+         xnanonh4(ji,jj,jk) = (1. - fanano) * tr(ji,jj,jk,jpnh4,Kbb) / ( zfalim * zconc0nnh4 + tr(ji,jj,jk,jpnh4,Kbb) )
+         xnanono3(ji,jj,jk) = (1. - fanano) * tr(ji,jj,jk,jpno3,Kbb) / ( zfalim * zconc0n + tr(ji,jj,jk,jpno3,Kbb) )  &
+         &                    * (1. - xnanonh4(ji,jj,jk))
+         !
+         zfalim = (1.-fananop) / fananop
+         xnanopo4(ji,jj,jk) = (1. - fananop) * tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zfalim * zconc0npo4 )
+         xnanodop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdop,Kbb) + xkdoc )   &
+         &                    * ( 1.0 - xnanopo4(ji,jj,jk) )
+         xnanodop(ji,jj,jk) = 0.
+         !
+         zfalim = (1.-fananof) / fananof
+         xnanofer(ji,jj,jk) = (1. - fananof) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcnfe )
+         !
+         zratiof   = tr(ji,jj,jk,jpnfe,Kbb) * z1_trnphy
+         zqfemn = xcoef1 * znanochl + xcoef2 + xcoef3 * xnanono3(ji,jj,jk)
+         !
+         zration = tr(ji,jj,jk,jpnph,Kbb) * z1_trnphy
+         zration = MIN(xqnnmax(ji,jj,jk), MAX( 2. * xqnnmin(ji,jj,jk), zration ))
+         fvnuptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqnnmin(ji,jj,jk) / (zration + rtrn)  &
+         &                   * MAX(0., (1. - zratchl * znanochl / 12. ) )
+         !
+         zlim1    = max(0., (zration - 2. * xqnnmin(ji,jj,jk) )  &
+         &          / (xqnnmax(ji,jj,jk) - 2. * xqnnmin(ji,jj,jk) ) ) * xqnnmax(ji,jj,jk)  &
+         &          / (zration + rtrn)
+         zlim3    = MAX( 0.,( zratiof - zqfemn ) / qfnopt ) 
+         xlimnfe(ji,jj,jk) = MIN( 1., zlim3 )
+         xlimphy(ji,jj,jk) = MIN( 1., zlim1, zlim3 )
+         !
+         ! Michaelis-Menten Limitation term for nutrients picophytoplankton
+         ! ----------------------------------------------------------------
+         zfalim = (1.-fapico) / fapico 
+         xpiconh4(ji,jj,jk) = (1. - fapico) * tr(ji,jj,jk,jpnh4,Kbb) / ( zfalim * zconc0pnh4 + tr(ji,jj,jk,jpnh4,Kbb) )
+         xpicono3(ji,jj,jk) = (1. - fapico) * tr(ji,jj,jk,jpno3,Kbb) / ( zfalim * zconc0p + tr(ji,jj,jk,jpno3,Kbb) )  &
+         &                    * (1. - xpiconh4(ji,jj,jk))
+         !
+         zfalim = (1.-fapicop) / fapicop 
+         xpicopo4(ji,jj,jk) = (1. - fapicop) * tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zfalim * zconc0ppo4 )
+         xpicodop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdop,Kbb) + xkdoc )   &
+         &                    * ( 1.0 - xpicopo4(ji,jj,jk) )
+         xpicodop(ji,jj,jk) = 0.
+         !
+         zfalim = (1.-fapicof) / fapicof
+         xpicofer(ji,jj,jk) = (1. - fapicof) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcpfe )
+         !
+         zratiof   = tr(ji,jj,jk,jppfe,Kbb) * z1_trnpic
+         zqfemp = xcoef1 * zpicochl + xcoef2 + xcoef3 * xpicono3(ji,jj,jk)
+         !
+         zration   = tr(ji,jj,jk,jpnpi,Kbb) * z1_trnpic
+         zration = MIN(xqnpmax(ji,jj,jk), MAX( 2. * xqnpmin(ji,jj,jk), zration ))
+         fvpuptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqnpmin(ji,jj,jk) / (zration + rtrn)  &
+         &                   * MAX(0., (1. - zratchl * zpicochl / 12. ) ) 
+         !
+         zlim1    = max(0., (zration - 2. * xqnpmin(ji,jj,jk) )  &
+         &          / (xqnpmax(ji,jj,jk) - 2. * xqnpmin(ji,jj,jk) ) ) * xqnpmax(ji,jj,jk)  &
+         &          / (zration + rtrn)
+         zlim3    = MAX( 0.,( zratiof - zqfemp ) / qfpopt )
+         xlimpfe(ji,jj,jk) = MIN( 1., zlim3 )
+         xlimpic(ji,jj,jk) = MIN( 1., zlim1, zlim3 )
+         !
+         !   Michaelis-Menten Limitation term for nutrients Diatoms
+         !   ------------------------------------------------------
+         zfalim = (1.-fadiat) / fadiat 
+         xdiatnh4(ji,jj,jk) = (1. - fadiat) * tr(ji,jj,jk,jpnh4,Kbb) / ( zfalim * zconc1dnh4 + tr(ji,jj,jk,jpnh4,Kbb) )
+         xdiatno3(ji,jj,jk) = (1. - fadiat) * tr(ji,jj,jk,jpno3,Kbb) / ( zfalim * zconc1d + tr(ji,jj,jk,jpno3,Kbb) )  &
+         &                    * (1. - xdiatnh4(ji,jj,jk))
+         !
+         zfalim = (1.-fadiatp) / fadiatp
+         xdiatpo4(ji,jj,jk) = (1. - fadiatp) * tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zfalim * zconc0dpo4 )
+         xdiatdop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdop,Kbb) + xkdoc )  &
+         &                    * ( 1.0 - xdiatpo4(ji,jj,jk) )
+         xdiatdop(ji,jj,jk) = 0.
+         !
+         zfalim = (1.-fadiatf) / fadiatf
+         xdiatfer(ji,jj,jk) = (1. - fadiatf) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcdfe )
+         !
+         zratiof   = tr(ji,jj,jk,jpdfe,Kbb) * z1_trndia
+         zqfemd = xcoef1 * zdiatchl + xcoef2 + xcoef3 * xdiatno3(ji,jj,jk)
+         !
+         zration   = tr(ji,jj,jk,jpndi,Kbb) * z1_trndia
+         zration = MIN(xqndmax(ji,jj,jk), MAX( 2. * xqndmin(ji,jj,jk), zration ))
+         fvduptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqndmin(ji,jj,jk) / (zration + rtrn)   &
+         &                   * MAX(0., (1. - zratchl * zdiatchl / 12. ) ) 
+         !
+         zlim1    = max(0., (zration - 2. * xqndmin(ji,jj,jk) )    &
+         &          / (xqndmax(ji,jj,jk) - 2. * xqndmin(ji,jj,jk) ) )   &
+         &          * xqndmax(ji,jj,jk) / (zration + rtrn)
+         zlim3    = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi(ji,jj) )
+         zlim4    = MAX( 0., ( zratiof - zqfemd ) / qfdopt )
+         xlimdfe(ji,jj,jk) = MIN( 1., zlim4 )
+         xlimdia(ji,jj,jk) = MIN( 1., zlim1, zlim3, zlim4 )
+         xlimsi(ji,jj,jk)  = MIN( zlim1, zlim4 )
+      END_3D
       !
       ! Compute the phosphorus quota values. It is based on Litchmann et al., 2004 and Daines et al, 2013.
@@ -319,101 +318,89 @@
       ! phytoplankton (see Daines et al., 2013). 
       ! --------------------------------------------------------------------------------------------------
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ! Size estimation of nanophytoplankton
-               ! ------------------------------------
-               zfvn = 2. * fvnuptk(ji,jj,jk)
-               sizen(ji,jj,jk) = MAX(1., MIN(xsizern, 1.0 / ( MAX(rtrn, zfvn) ) ) )
-
-               ! N/P ratio of nanophytoplankton
-               ! ------------------------------
-               zfuptk = 0.23 * zfvn
-               zrpho = 2.24 * trb(ji,jj,jk,jpnch) / ( trb(ji,jj,jk,jpnph) * rno3 * 15. + rtrn )
-               zrass = 1. - 0.2 - zrpho - zfuptk
-               xqpnmax(ji,jj,jk) = ( zfuptk + zrpho ) * 0.0128 * 16. + zrass * 1./ 7.2 * 16.
-               xqpnmax(ji,jj,jk) = xqpnmax(ji,jj,jk) * trb(ji,jj,jk,jpnph) / ( trb(ji,jj,jk,jpphy) + rtrn ) + 0.13
-               xqpnmin(ji,jj,jk) = 0.13 + 0.23 * 0.0128 * 16.
-
-               ! Size estimation of picophytoplankton
-               ! ------------------------------------
-               zfvn = 2. * fvpuptk(ji,jj,jk)
-               sizep(ji,jj,jk) = MAX(1., MIN(xsizerp, 1.0 / ( MAX(rtrn, zfvn) ) ) )
-
-               ! N/P ratio of picophytoplankton
-               ! ------------------------------
-               zfuptk = 0.35 * zfvn
-               zrpho = 2.24 * trb(ji,jj,jk,jppch) / ( trb(ji,jj,jk,jpnpi) * rno3 * 15. + rtrn )
-               zrass = 1. - 0.4 - zrpho - zfuptk
-               xqppmax(ji,jj,jk) =  (zrpho + zfuptk) * 0.0128 * 16. + zrass * 1./ 9. * 16.
-               xqppmax(ji,jj,jk) = xqppmax(ji,jj,jk) * trb(ji,jj,jk,jpnpi) / ( trb(ji,jj,jk,jppic) + rtrn ) + 0.13
-               xqppmin(ji,jj,jk) = 0.13
-
-               ! Size estimation of diatoms
-               ! --------------------------
-               zfvn = 2. * fvduptk(ji,jj,jk)
-               sized(ji,jj,jk) = MAX(1., MIN(xsizerd, 1.0 / ( MAX(rtrn, zfvn) ) ) )
-               zcoef = trb(ji,jj,jk,jpdia) - MIN(xsizedia, trb(ji,jj,jk,jpdia) )
-               sized(ji,jj,jk) = 1. + xsizerd * zcoef *1E6 / ( 1. + zcoef * 1E6 )
-
-               ! N/P ratio of diatoms
-               ! --------------------
-               zfuptk = 0.2 * zfvn
-               zrpho = 2.24 * trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpndi) * rno3 * 15. + rtrn )
-               zrass = 1. - 0.2 - zrpho - zfuptk
-               xqpdmax(ji,jj,jk) = ( zfuptk + zrpho ) * 0.0128 * 16. + zrass * 1./ 7.2 * 16.
-               xqpdmax(ji,jj,jk) = xqpdmax(ji,jj,jk) * trb(ji,jj,jk,jpndi) / ( trb(ji,jj,jk,jpdia) + rtrn ) + 0.13
-               xqpdmin(ji,jj,jk) = 0.13 + 0.2 * 0.0128 * 16.
-
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpkm1 )
+         ! Size estimation of nanophytoplankton
+         ! ------------------------------------
+         zfvn = 2. * fvnuptk(ji,jj,jk)
+         sizen(ji,jj,jk) = MAX(1., MIN(xsizern, 1.0 / ( MAX(rtrn, zfvn) ) ) )
+
+         ! N/P ratio of nanophytoplankton
+         ! ------------------------------
+         zfuptk = 0.23 * zfvn
+         zrpho = 2.24 * tr(ji,jj,jk,jpnch,Kbb) / ( tr(ji,jj,jk,jpnph,Kbb) * rno3 * 15. + rtrn )
+         zrass = 1. - 0.2 - zrpho - zfuptk
+         xqpnmax(ji,jj,jk) = ( zfuptk + zrpho ) * 0.0128 * 16. + zrass * 1./ 7.2 * 16.
+         xqpnmax(ji,jj,jk) = xqpnmax(ji,jj,jk) * tr(ji,jj,jk,jpnph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) + 0.13
+         xqpnmin(ji,jj,jk) = 0.13 + 0.23 * 0.0128 * 16.
+
+         ! Size estimation of picophytoplankton
+         ! ------------------------------------
+         zfvn = 2. * fvpuptk(ji,jj,jk)
+         sizep(ji,jj,jk) = MAX(1., MIN(xsizerp, 1.0 / ( MAX(rtrn, zfvn) ) ) )
+
+         ! N/P ratio of picophytoplankton
+         ! ------------------------------
+         zfuptk = 0.35 * zfvn
+         zrpho = 2.24 * tr(ji,jj,jk,jppch,Kbb) / ( tr(ji,jj,jk,jpnpi,Kbb) * rno3 * 15. + rtrn )
+         zrass = 1. - 0.4 - zrpho - zfuptk
+         xqppmax(ji,jj,jk) =  (zrpho + zfuptk) * 0.0128 * 16. + zrass * 1./ 9. * 16.
+         xqppmax(ji,jj,jk) = xqppmax(ji,jj,jk) * tr(ji,jj,jk,jpnpi,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) + 0.13
+         xqppmin(ji,jj,jk) = 0.13
+
+         ! Size estimation of diatoms
+         ! --------------------------
+         zfvn = 2. * fvduptk(ji,jj,jk)
+         sized(ji,jj,jk) = MAX(1., MIN(xsizerd, 1.0 / ( MAX(rtrn, zfvn) ) ) )
+         zcoef = tr(ji,jj,jk,jpdia,Kbb) - MIN(xsizedia, tr(ji,jj,jk,jpdia,Kbb) )
+         sized(ji,jj,jk) = 1. + xsizerd * zcoef *1E6 / ( 1. + zcoef * 1E6 )
+
+         ! N/P ratio of diatoms
+         ! --------------------
+         zfuptk = 0.2 * zfvn
+         zrpho = 2.24 * tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpndi,Kbb) * rno3 * 15. + rtrn )
+         zrass = 1. - 0.2 - zrpho - zfuptk
+         xqpdmax(ji,jj,jk) = ( zfuptk + zrpho ) * 0.0128 * 16. + zrass * 1./ 7.2 * 16.
+         xqpdmax(ji,jj,jk) = xqpdmax(ji,jj,jk) * tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) + 0.13
+         xqpdmin(ji,jj,jk) = 0.13 + 0.2 * 0.0128 * 16.
+
+      END_3D
 
       ! Compute the fraction of nanophytoplankton that is made of calcifiers
       ! --------------------------------------------------------------------
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zlim1 =  trb(ji,jj,jk,jpnh4) / ( trb(ji,jj,jk,jpnh4) + concnnh4 ) + trb(ji,jj,jk,jpno3)    &
-               &        / ( trb(ji,jj,jk,jpno3) + concnno3 ) * ( 1.0 - trb(ji,jj,jk,jpnh4)   &
-               &        / ( trb(ji,jj,jk,jpnh4) + concnnh4 ) )
-               zlim2  = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concnpo4 )
-               zlim3  = trb(ji,jj,jk,jpfer) / ( trb(ji,jj,jk,jpfer) +  5.E-11 ) 
-               ztem1  = MAX( 0., tsn(ji,jj,jk,jp_tem) )
-               ztem2  = tsn(ji,jj,jk,jp_tem) - 10.
-               zetot1 = MAX( 0., etot(ji,jj,jk) - 1.) / ( 4. + etot(ji,jj,jk) ) * 20. / ( 20. + etot(ji,jj,jk) ) 
+      DO_3D_11_11( 1, jpkm1 )
+         zlim1 =  tr(ji,jj,jk,jpnh4,Kbb) / ( tr(ji,jj,jk,jpnh4,Kbb) + concnnh4 ) + tr(ji,jj,jk,jpno3,Kbb)    &
+         &        / ( tr(ji,jj,jk,jpno3,Kbb) + concnno3 ) * ( 1.0 - tr(ji,jj,jk,jpnh4,Kbb)   &
+         &        / ( tr(ji,jj,jk,jpnh4,Kbb) + concnnh4 ) )
+         zlim2  = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + concnpo4 )
+         zlim3  = tr(ji,jj,jk,jpfer,Kbb) / ( tr(ji,jj,jk,jpfer,Kbb) +  5.E-11 ) 
+         ztem1  = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) )
+         ztem2  = ts(ji,jj,jk,jp_tem,Kmm) - 10.
+         zetot1 = MAX( 0., etot(ji,jj,jk) - 1.) / ( 4. + etot(ji,jj,jk) ) * 20. / ( 20. + etot(ji,jj,jk) ) 
 
 !               xfracal(ji,jj,jk) = caco3r * MIN( zlim1, zlim2, zlim3 )                  &
-               xfracal(ji,jj,jk) = caco3r                 &
-               &                   * ztem1 / ( 1. + ztem1 ) * MAX( 1., trb(ji,jj,jk,jpphy)*1E6 )   &
-                  &                * ( 1. + EXP(-ztem2 * ztem2 / 25. ) )         &
-                  &                * zetot1 * MIN( 1., 50. / ( hmld(ji,jj) + rtrn ) )
-               xfracal(ji,jj,jk) = MAX( 0.02, MIN( 0.8 , xfracal(ji,jj,jk) ) )
-            END DO
-         END DO
-      END DO
-      !
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ! denitrification factor computed from O2 levels
-               nitrfac(ji,jj,jk) = MAX(  0.e0, 0.4 * ( 6.e-6  - trb(ji,jj,jk,jpoxy) )    &
-                  &                                / ( oxymin + trb(ji,jj,jk,jpoxy) )  )
-               nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) )
-            END DO
-         END DO
-      END DO
+         xfracal(ji,jj,jk) = caco3r                 &
+         &                   * ztem1 / ( 1. + ztem1 ) * MAX( 1., tr(ji,jj,jk,jpphy,Kbb)*1E6 )   &
+            &                * ( 1. + EXP(-ztem2 * ztem2 / 25. ) )         &
+            &                * zetot1 * MIN( 1., 50. / ( hmld(ji,jj) + rtrn ) )
+         xfracal(ji,jj,jk) = MAX( 0.02, MIN( 0.8 , xfracal(ji,jj,jk) ) )
+      END_3D
+      !
+      DO_3D_11_11( 1, jpkm1 )
+         ! denitrification factor computed from O2 levels
+         nitrfac(ji,jj,jk) = MAX(  0.e0, 0.4 * ( 6.e-6  - tr(ji,jj,jk,jpoxy,Kbb) )    &
+            &                                / ( oxymin + tr(ji,jj,jk,jpoxy,Kbb) )  )
+         nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) )
+      END_3D
       !
       IF( lk_iomput .AND. knt == nrdttrc ) THEN        ! save output diagnostics
-        IF( iom_use( "xfracal" ) ) CALL iom_put( "xfracal", xfracal(:,:,:) * tmask(:,:,:) )  ! euphotic layer deptht
-        IF( iom_use( "LNnut"   ) ) CALL iom_put( "LNnut"  , xlimphy(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term
-        IF( iom_use( "LPnut"   ) ) CALL iom_put( "LPnut"  , xlimpic(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term
-        IF( iom_use( "LDnut"   ) ) CALL iom_put( "LDnut"  , xlimdia(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term
-        IF( iom_use( "LNFe"    ) ) CALL iom_put( "LNFe"   , xlimnfe(:,:,:) * tmask(:,:,:) )  ! Iron limitation term
-        IF( iom_use( "LPFe"    ) ) CALL iom_put( "LPFe"   , xlimpfe(:,:,:) * tmask(:,:,:) )  ! Iron limitation term
-        IF( iom_use( "LDFe"    ) ) CALL iom_put( "LDFe"   , xlimdfe(:,:,:) * tmask(:,:,:) )  ! Iron limitation term
-        IF( iom_use( "SIZEN"   ) ) CALL iom_put( "SIZEN"  , sizen(:,:,:) * tmask(:,:,:) )  ! Iron limitation term
-        IF( iom_use( "SIZEP"   ) ) CALL iom_put( "SIZEP"  , sizep(:,:,:) * tmask(:,:,:) )  ! Iron limitation term
-        IF( iom_use( "SIZED"   ) ) CALL iom_put( "SIZED"  , sized(:,:,:) * tmask(:,:,:) )  ! Iron limitation term
+        CALL iom_put( "xfracal", xfracal(:,:,:) * tmask(:,:,:) )  ! euphotic layer deptht
+        CALL iom_put( "LNnut"  , xlimphy(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term
+        CALL iom_put( "LPnut"  , xlimpic(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term
+        CALL iom_put( "LDnut"  , xlimdia(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term
+        CALL iom_put( "LNFe"   , xlimnfe(:,:,:) * tmask(:,:,:) )  ! Iron limitation term
+        CALL iom_put( "LPFe"   , xlimpfe(:,:,:) * tmask(:,:,:) )  ! Iron limitation term
+        CALL iom_put( "LDFe"   , xlimdfe(:,:,:) * tmask(:,:,:) )  ! Iron limitation term
+        CALL iom_put( "SIZEN"  , sizen  (:,:,:) * tmask(:,:,:) )  ! Iron limitation term
+        CALL iom_put( "SIZEP"  , sizep  (:,:,:) * tmask(:,:,:) )  ! Iron limitation term
+        CALL iom_put( "SIZED"  , sized  (:,:,:) * tmask(:,:,:) )  ! Iron limitation term
       ENDIF
       !
@@ -448,9 +435,7 @@
       !!----------------------------------------------------------------------
       !
-      REWIND( numnatp_ref )              ! Namelist nampislim in reference namelist : Pisces nutrient limitation parameters
       READ  ( numnatp_ref, namp5zlim, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampislim in reference namelist' )
       !
-      REWIND( numnatp_cfg )              ! Namelist nampislim in configuration namelist : Pisces nutrient limitation parameters 
       READ  ( numnatp_cfg, namp5zlim, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'nampislim in configuration namelist' )
@@ -489,9 +474,7 @@
       ENDIF
 
-      REWIND( numnatp_ref )              ! Namelist nampislim in reference namelist : Pisces nutrient limitation parameters
       READ  ( numnatp_ref, namp5zquota, IOSTAT = ios, ERR = 903)
 903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisquota in reference namelist' )
       !
-      REWIND( numnatp_cfg )              ! Namelist nampislim in configuration namelist : Pisces nutrient limitation parameters 
       READ  ( numnatp_cfg, namp5zquota, IOSTAT = ios, ERR = 904 )
 904   IF( ios >  0 ) CALL ctl_nam ( ios , 'nampisquota in configuration namelist' )
@@ -526,5 +509,15 @@
       zpsiuptk = 2.3 * rno3
       !
-      nitrfac (:,:,:) = 0._wp
+      nitrfac(:,:,jpk) = 0._wp
+      xfracal(:,:,jpk) = 0._wp
+      xlimphy(:,:,jpk) = 0._wp
+      xlimpic(:,:,jpk) = 0._wp
+      xlimdia(:,:,jpk) = 0._wp
+      xlimnfe(:,:,jpk) = 0._wp
+      xlimpfe(:,:,jpk) = 0._wp
+      xlimdfe(:,:,jpk) = 0._wp
+      sizen  (:,:,jpk) = 0._wp
+      sizep  (:,:,jpk) = 0._wp
+      sized  (:,:,jpk) = 0._wp
       !
    END SUBROUTINE p5z_lim_init
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p5zmeso.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p5zmeso.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p5zmeso.F90	(revision 12928)
@@ -51,4 +51,6 @@
    LOGICAL,  PUBLIC ::  bmetexc2     !: Use of excess carbon for respiration
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -59,5 +61,5 @@
 CONTAINS
 
-   SUBROUTINE p5z_meso( kt, knt )
+   SUBROUTINE p5z_meso( kt, knt, Kbb, Krhs )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p5z_meso  ***
@@ -67,5 +69,6 @@
       !! ** Method  : - ???
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt, knt ! ocean time step
+      INTEGER, INTENT(in) ::   kt, knt    ! ocean time step
+      INTEGER, INTENT(in)  ::  Kbb, Krhs  ! time level indices
       INTEGER  :: ji, jj, jk
       REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz, zcompam, zcompames
@@ -86,6 +89,5 @@
       CHARACTER (len=25) :: charout
       REAL(wp) :: zrfact2, zmetexcess
-      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zfezoo2
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d, zz2ligprod
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zfezoo2,  zz2ligprod
 
       !!---------------------------------------------------------------------
@@ -93,291 +95,270 @@
       IF( ln_timing )   CALL timing_start('p5z_meso')
       !
-
-      zgrazing(:,:,:) = 0._wp
-      zfezoo2 (:,:,:) = 0._wp
-      !
-      IF (ln_ligand) THEN
-         ALLOCATE( zz2ligprod(jpi,jpj,jpk) )
-         zz2ligprod(:,:,:) = 0._wp
-      ENDIF
-
       zmetexcess = 0.0
       IF ( bmetexc2 ) zmetexcess = 1.0
 
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zcompam   = MAX( ( trb(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 )
-               zfact     = xstep * tgfunc2(ji,jj,jk) * zcompam
-
-               !   Michaelis-Menten mortality rates of mesozooplankton
-               !   ---------------------------------------------------
-               zrespz   = resrat2 * zfact * ( trb(ji,jj,jk,jpmes) / ( xkmort + trb(ji,jj,jk,jpmes) )  &
-               &          + 3. * nitrfac(ji,jj,jk) )
-
-               !   Zooplankton mortality. A square function has been selected with
-               !   no real reason except that it seems to be more stable and may mimic predation
-               !   ---------------------------------------------------------------
-               ztortz   = mzrat2 * 1.e6 * zfact * trb(ji,jj,jk,jpmes) * (1. - nitrfac(ji,jj,jk))
-
-               !   Computation of the abundance of the preys
-               !   A threshold can be specified in the namelist
-               !   --------------------------------------------
-               zcompadi  = MAX( ( trb(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 )
-               zcompaz   = MAX( ( trb(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 )
-               zcompaph  = MAX( ( trb(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 )
-               zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthresh2poc ), 0.e0 )
-               zcompames = MAX( ( trb(ji,jj,jk,jpmes) - xthresh2mes ), 0.e0 )
-
-               !   Mesozooplankton grazing
-               !   ------------------------
-               zfood     = xpref2d * zcompadi + xpref2z * zcompaz + xpref2n * zcompaph + xpref2c * zcompapoc   &
-               &           + xpref2m * zcompames 
-               zfoodlim  = MAX( 0., zfood - MIN( 0.5 * zfood, xthresh2 ) )
-               zdenom    = zfoodlim / ( xkgraz2 + zfoodlim )
-               zgraze2   = grazrat2 * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpmes) * (1. - nitrfac(ji,jj,jk)) 
-
-               !   An active switching parameterization is used here.
-               !   We don't use the KTW parameterization proposed by 
-               !   Vallina et al. because it tends to produce to steady biomass
-               !   composition and the variance of Chl is too low as it grazes
-               !   too strongly on winning organisms. Thus, instead of a square
-               !   a 1.5 power value is used which decreases the pressure on the
-               !   most abundant species
-               !   ------------------------------------------------------------  
-               ztmp1 = xpref2n * zcompaph**1.5
-               ztmp2 = xpref2m * zcompames**1.5
-               ztmp3 = xpref2c * zcompapoc**1.5
-               ztmp4 = xpref2d * zcompadi**1.5
-               ztmp5 = xpref2z * zcompaz**1.5
-               ztmptot = ztmp1 + ztmp2 + ztmp3 + ztmp4 + ztmp5 + rtrn
-               ztmp1 = ztmp1 / ztmptot
-               ztmp2 = ztmp2 / ztmptot
-               ztmp3 = ztmp3 / ztmptot
-               ztmp4 = ztmp4 / ztmptot
-               ztmp5 = ztmp5 / ztmptot
-
-               !   Mesozooplankton regular grazing on the different preys
-               !   ------------------------------------------------------
-               zgrazdc   = zgraze2 * ztmp4 * zdenom
-               zgrazdn   = zgrazdc * trb(ji,jj,jk,jpndi) / ( trb(ji,jj,jk,jpdia) + rtrn)
-               zgrazdp   = zgrazdc * trb(ji,jj,jk,jppdi) / ( trb(ji,jj,jk,jpdia) + rtrn)
-               zgrazdf   = zgrazdc * trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn)
-               zgrazz    = zgraze2 * ztmp5 * zdenom
-               zgrazm    = zgraze2 * ztmp2 * zdenom
-               zgraznc   = zgraze2 * ztmp1 * zdenom
-               zgraznn   = zgraznc * trb(ji,jj,jk,jpnph) / ( trb(ji,jj,jk,jpphy) + rtrn)
-               zgraznp   = zgraznc * trb(ji,jj,jk,jppph) / ( trb(ji,jj,jk,jpphy) + rtrn)
-               zgraznf   = zgraznc * trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn)
-               zgrazpoc  = zgraze2 * ztmp3 * zdenom
-               zgrazpon  = zgrazpoc * trb(ji,jj,jk,jppon) / ( trb(ji,jj,jk,jppoc) + rtrn)
-               zgrazpop  = zgrazpoc * trb(ji,jj,jk,jppop) / ( trb(ji,jj,jk,jppoc) + rtrn)
-               zgrazpof  = zgrazpoc * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn)
-
-               !   Mesozooplankton flux feeding on GOC
-               !   ----------------------------------
-               zgrazffeg = grazflux  * xstep * wsbio4(ji,jj,jk)      &
-               &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes)  &
-               &           * (1. - nitrfac(ji,jj,jk))
-               zgrazfffg = zgrazffeg * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn)
-               zgrazffng = zgrazffeg * trb(ji,jj,jk,jpgon) / (trb(ji,jj,jk,jpgoc) + rtrn)
-               zgrazffpg = zgrazffeg * trb(ji,jj,jk,jpgop) / (trb(ji,jj,jk,jpgoc) + rtrn)
-               zgrazffep = grazflux  * xstep *  wsbio3(ji,jj,jk)     &
-               &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpmes)   &
-               &           * (1. - nitrfac(ji,jj,jk))
-               zgrazfffp = zgrazffep * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn)
-               zgrazffnp = zgrazffep * trb(ji,jj,jk,jppon) / (trb(ji,jj,jk,jppoc) + rtrn)
-               zgrazffpp = zgrazffep * trb(ji,jj,jk,jppop) / (trb(ji,jj,jk,jppoc) + rtrn)
-               !
-               zgraztotc  = zgrazdc + zgrazz + zgraznc + zgrazm + zgrazpoc + zgrazffep + zgrazffeg
-
-               !   Compute the proportion of filter feeders
-               !   ----------------------------------------  
-               zproport  = (zgrazffep + zgrazffeg)/(rtrn + zgraztotc)
-
-               !   Compute fractionation of aggregates. It is assumed that 
-               !   diatoms based aggregates are more prone to fractionation
-               !   since they are more porous (marine snow instead of fecal pellets)
-               !   ----------------------------------------------------------------
-               zratio    = trb(ji,jj,jk,jpgsi) / ( trb(ji,jj,jk,jpgoc) + rtrn )
-               zratio2   = zratio * zratio
-               zfracc    = zproport * grazflux  * xstep * wsbio4(ji,jj,jk)      &
-               &          * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes)          &
-               &          * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) )
-               zfracfe   = zfracc * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn)
-               zfracn    = zfracc * trb(ji,jj,jk,jpgon) / (trb(ji,jj,jk,jpgoc) + rtrn)
-               zfracp    = zfracc * trb(ji,jj,jk,jpgop) / (trb(ji,jj,jk,jpgoc) + rtrn)
-
-               zgrazffep = zproport * zgrazffep   ;   zgrazffeg = zproport * zgrazffeg
-               zgrazfffp = zproport * zgrazfffp   ;   zgrazfffg = zproport * zgrazfffg
-               zgrazffnp = zproport * zgrazffnp   ;   zgrazffng = zproport * zgrazffng
-               zgrazffpp = zproport * zgrazffpp   ;   zgrazffpg = zproport * zgrazffpg
-
-               zgraztotc  = zgrazdc + zgrazz + zgraznc + zgrazm + zgrazpoc + zgrazffep + zgrazffeg
-               zgraztotf  = zgrazdf + zgraznf + ( zgrazz + zgrazm ) * ferat3 + zgrazpof &
-               &            + zgrazfffp + zgrazfffg
-               zgraztotn  = zgrazdn + (zgrazm + zgrazz) * no3rat3 + zgraznn + zgrazpon  &
-               &            + zgrazffnp + zgrazffng
-               zgraztotp  = zgrazdp + (zgrazz + zgrazm) * po4rat3 + zgraznp + zgrazpop  &
-               &            + zgrazffpp + zgrazffpg
-
-
-               ! Total grazing ( grazing by microzoo is already computed in p5zmicro )
-               zgrazing(ji,jj,jk) = zgraztotc
-
-               !   Stoichiometruc ratios of the food ingested by zooplanton 
-               !   --------------------------------------------------------
-               zgrasratf  =  (zgraztotf + rtrn) / ( zgraztotc + rtrn )
-               zgrasratn  =  (zgraztotn + rtrn) / ( zgraztotc + rtrn )
-               zgrasratp  =  (zgraztotp + rtrn) / ( zgraztotc + rtrn )
-
-               !   Growth efficiency is made a function of the quality 
-               !   and the quantity of the preys
-               !   ---------------------------------------------------
-               zepshert  = MIN( 1., zgrasratn/ no3rat3, zgrasratp/ po4rat3, zgrasratf / ferat3)
-               zbeta     = MAX(0., (epsher2 - epsher2min) )
-               zepsherf  = epsher2min + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta )
-               zepsherv  = zepsherf * zepshert
-
-               !   Respiration of mesozooplankton
-               !   Excess carbon in the food is used preferentially
-               !   ----------------  ------------------------------
-               zexcess  = zgraztotc * zepsherf * (1.0 - zepshert) * zmetexcess 
-               zbasresb = MAX(0., zrespz - zexcess)
-               zbasresi = zexcess + MIN(0., zrespz - zexcess)
-               zrespirc = srespir2 * zepsherv * zgraztotc + zbasresb
-
-               !   When excess carbon is used, the other elements in excess
-               !   are also used proportionally to their abundance
-               !   --------------------------------------------------------
-               zexcess  = ( zgrasratn/ no3rat3 - zepshert ) / ( 1.0 - zepshert + rtrn)
-               zbasresn = zbasresi * zexcess * zgrasratn
-               zexcess  = ( zgrasratp/ po4rat3 - zepshert ) / ( 1.0 - zepshert + rtrn)
-               zbasresp = zbasresi * zexcess * zgrasratp
-               zexcess  = ( zgrasratf/ ferat3 - zepshert ) / ( 1.0 - zepshert + rtrn)
-               zbasresf = zbasresi * zexcess * zgrasratf
-
-               !   Voiding of the excessive elements as organic matter
-               !   --------------------------------------------------------
-               zgradoct = (1. - unass2c - zepsherv) * zgraztotc - zbasresi
-               zgradont = (1. - unass2n) * zgraztotn - zepsherv * no3rat3 * zgraztotc - zbasresn
-               zgradopt = (1. - unass2p) * zgraztotp - zepsherv * po4rat3 * zgraztotc - zbasresp
-               zgrareft = (1. - unass2c) * zgraztotf - zepsherv * ferat3 * zgraztotc - zbasresf
-               ztmp1   = ( 1. - epsher2 - unass2c ) /( 1. - 0.8 * epsher2 ) * ztortz
-               zgradoc = (zgradoct + ztmp1) * ssigma2
-               zgradon = (zgradont + no3rat3 * ztmp1) * ssigma2
-               zgradop = (zgradopt + po4rat3 * ztmp1) * ssigma2
-               zgratmp = 0.2 * epsher2 /( 1. - 0.8 * epsher2 ) * ztortz
-
-               !  Since only semilabile DOM is represented in PISCES
-               !  part of DOM is in fact labile and is then released
-               !  as dissolved inorganic compounds (ssigma2)
-               !  --------------------------------------------------
-               zgrarem = zgratmp + ( zgradoct + ztmp1 ) * (1.0 - ssigma2)
-               zgraren = no3rat3 * zgratmp + ( zgradont + no3rat3 * ztmp1 ) * (1.0 - ssigma2)
-               zgrarep = po4rat3 * zgratmp + ( zgradopt + po4rat3 * ztmp1 ) * (1.0 - ssigma2)
-               zgraref = zgrareft + ferat3 * ( ztmp1 + zgratmp )
-
-               !   Defecation as a result of non assimilated products
-               !   --------------------------------------------------
-               zgrapoc  = zgraztotc * unass2c + unass2c / ( 1. - 0.8 * epsher2 ) * ztortz
-               zgrapon  = zgraztotn * unass2n + no3rat3 * unass2n / ( 1. - 0.8 * epsher2 ) * ztortz
-               zgrapop  = zgraztotp * unass2p + po4rat3 * unass2p / ( 1. - 0.8 * epsher2 ) * ztortz
-               zgrapof  = zgraztotf * unass2c + ferat3  * unass2c / ( 1. - 0.8 * epsher2 ) * ztortz
-
-               !  Addition of respiration to the release of inorganic nutrients
-               !  -------------------------------------------------------------
-               zgrarem = zgrarem + zbasresi + zrespirc
-               zgraren = zgraren + zbasresn + zrespirc * no3rat3
-               zgrarep = zgrarep + zbasresp + zrespirc * po4rat3
-               zgraref = zgraref + zbasresf + zrespirc * ferat3
-
-               !   Update the arrays TRA which contain the biological sources and
-               !   sinks
-               !   --------------------------------------------------------------
-               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarep 
-               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgraren
-               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgradoc
-               !
-               IF( ln_ligand ) THEN
-                  tra(ji,jj,jk,jplgw)  = tra(ji,jj,jk,jplgw) + zgradoc * ldocz
-                  zz2ligprod(ji,jj,jk) = zgradoc * ldocz
-               ENDIF
-               !
-               tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zgradon
-               tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zgradop
-               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem
-               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgraref
-               zfezoo2(ji,jj,jk)   = zgraref
-               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem
-               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgraren
-               tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) + zepsherv * zgraztotc - zrespirc   &
-               &                     - ztortz - zgrazm
-               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazdc
-               tra(ji,jj,jk,jpndi) = tra(ji,jj,jk,jpndi) - zgrazdn
-               tra(ji,jj,jk,jppdi) = tra(ji,jj,jk,jppdi) - zgrazdp
-               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazdf
-               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz
-               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgraznc
-               tra(ji,jj,jk,jpnph) = tra(ji,jj,jk,jpnph) - zgraznn
-               tra(ji,jj,jk,jppph) = tra(ji,jj,jk,jppph) - zgraznp
-               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf
-               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgraznc * trb(ji,jj,jk,jpnch) / ( trb(ji,jj,jk,jpphy) + rtrn )
-               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazdc * trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn )
-               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazdc * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn )
-               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazdc * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn )
-
-               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc - zgrazffep + zfracc
-               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfracc
-               conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep
-               tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) - zgrazpon - zgrazffnp + zfracn
-               tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) - zgrazpop - zgrazffpp + zfracp
-               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zgrazffeg + zgrapoc - zfracc
-               prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zgrapoc
-               consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfracc
-               tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) - zgrazffng + zgrapon - zfracn
-               tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) - zgrazffpg + zgrapop - zfracp
-               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof - zgrazfffp + zfracfe
-               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zgrazfffg + zgrapof - zfracfe
-               zfracal = trb(ji,jj,jk,jpcal) / ( trb(ji,jj,jk,jpgoc) + rtrn )
-               zgrazcal = zgrazffeg * (1. - part2) * zfracal
-
-               !  calcite production
-               !  ------------------
-               zprcaca = xfracal(ji,jj,jk) * zgraznc
-               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo)
-               zprcaca = part2 * zprcaca
-               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrazcal - zprcaca
-               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * ( zgrazcal - zprcaca )
-               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) - zgrazcal + zprcaca
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpkm1 )
+         zcompam   = MAX( ( tr(ji,jj,jk,jpmes,Kbb) - 1.e-9 ), 0.e0 )
+         zfact     = xstep * tgfunc2(ji,jj,jk) * zcompam
+
+         !   Michaelis-Menten mortality rates of mesozooplankton
+         !   ---------------------------------------------------
+         zrespz   = resrat2 * zfact * ( tr(ji,jj,jk,jpmes,Kbb) / ( xkmort + tr(ji,jj,jk,jpmes,Kbb) )  &
+         &          + 3. * nitrfac(ji,jj,jk) )
+
+         !   Zooplankton mortality. A square function has been selected with
+         !   no real reason except that it seems to be more stable and may mimic predation
+         !   ---------------------------------------------------------------
+         ztortz   = mzrat2 * 1.e6 * zfact * tr(ji,jj,jk,jpmes,Kbb) * (1. - nitrfac(ji,jj,jk))
+
+         !   Computation of the abundance of the preys
+         !   A threshold can be specified in the namelist
+         !   --------------------------------------------
+         zcompadi  = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - xthresh2dia ), 0.e0 )
+         zcompaz   = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - xthresh2zoo ), 0.e0 )
+         zcompaph  = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - xthresh2phy ), 0.e0 )
+         zcompapoc = MAX( ( tr(ji,jj,jk,jppoc,Kbb) - xthresh2poc ), 0.e0 )
+         zcompames = MAX( ( tr(ji,jj,jk,jpmes,Kbb) - xthresh2mes ), 0.e0 )
+
+         !   Mesozooplankton grazing
+         !   ------------------------
+         zfood     = xpref2d * zcompadi + xpref2z * zcompaz + xpref2n * zcompaph + xpref2c * zcompapoc   &
+         &           + xpref2m * zcompames 
+         zfoodlim  = MAX( 0., zfood - MIN( 0.5 * zfood, xthresh2 ) )
+         zdenom    = zfoodlim / ( xkgraz2 + zfoodlim )
+         zgraze2   = grazrat2 * xstep * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpmes,Kbb) * (1. - nitrfac(ji,jj,jk)) 
+
+         !   An active switching parameterization is used here.
+         !   We don't use the KTW parameterization proposed by 
+         !   Vallina et al. because it tends to produce to steady biomass
+         !   composition and the variance of Chl is too low as it grazes
+         !   too strongly on winning organisms. Thus, instead of a square
+         !   a 1.5 power value is used which decreases the pressure on the
+         !   most abundant species
+         !   ------------------------------------------------------------  
+         ztmp1 = xpref2n * zcompaph**1.5
+         ztmp2 = xpref2m * zcompames**1.5
+         ztmp3 = xpref2c * zcompapoc**1.5
+         ztmp4 = xpref2d * zcompadi**1.5
+         ztmp5 = xpref2z * zcompaz**1.5
+         ztmptot = ztmp1 + ztmp2 + ztmp3 + ztmp4 + ztmp5 + rtrn
+         ztmp1 = ztmp1 / ztmptot
+         ztmp2 = ztmp2 / ztmptot
+         ztmp3 = ztmp3 / ztmptot
+         ztmp4 = ztmp4 / ztmptot
+         ztmp5 = ztmp5 / ztmptot
+
+         !   Mesozooplankton regular grazing on the different preys
+         !   ------------------------------------------------------
+         zgrazdc   = zgraze2 * ztmp4 * zdenom
+         zgrazdn   = zgrazdc * tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn)
+         zgrazdp   = zgrazdc * tr(ji,jj,jk,jppdi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn)
+         zgrazdf   = zgrazdc * tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn)
+         zgrazz    = zgraze2 * ztmp5 * zdenom
+         zgrazm    = zgraze2 * ztmp2 * zdenom
+         zgraznc   = zgraze2 * ztmp1 * zdenom
+         zgraznn   = zgraznc * tr(ji,jj,jk,jpnph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn)
+         zgraznp   = zgraznc * tr(ji,jj,jk,jppph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn)
+         zgraznf   = zgraznc * tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn)
+         zgrazpoc  = zgraze2 * ztmp3 * zdenom
+         zgrazpon  = zgrazpoc * tr(ji,jj,jk,jppon,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn)
+         zgrazpop  = zgrazpoc * tr(ji,jj,jk,jppop,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn)
+         zgrazpof  = zgrazpoc * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn)
+
+         !   Mesozooplankton flux feeding on GOC
+         !   ----------------------------------
+         zgrazffeg = grazflux  * xstep * wsbio4(ji,jj,jk)      &
+         &           * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpgoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb)  &
+         &           * (1. - nitrfac(ji,jj,jk))
+         zgrazfffg = zgrazffeg * tr(ji,jj,jk,jpbfe,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn)
+         zgrazffng = zgrazffeg * tr(ji,jj,jk,jpgon,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn)
+         zgrazffpg = zgrazffeg * tr(ji,jj,jk,jpgop,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn)
+         zgrazffep = grazflux  * xstep *  wsbio3(ji,jj,jk)     &
+         &           * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb)   &
+         &           * (1. - nitrfac(ji,jj,jk))
+         zgrazfffp = zgrazffep * tr(ji,jj,jk,jpsfe,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn)
+         zgrazffnp = zgrazffep * tr(ji,jj,jk,jppon,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn)
+         zgrazffpp = zgrazffep * tr(ji,jj,jk,jppop,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn)
+         !
+         zgraztotc  = zgrazdc + zgrazz + zgraznc + zgrazm + zgrazpoc + zgrazffep + zgrazffeg
+
+         !   Compute the proportion of filter feeders
+         !   ----------------------------------------  
+         zproport  = (zgrazffep + zgrazffeg)/(rtrn + zgraztotc)
+
+         !   Compute fractionation of aggregates. It is assumed that 
+         !   diatoms based aggregates are more prone to fractionation
+         !   since they are more porous (marine snow instead of fecal pellets)
+         !   ----------------------------------------------------------------
+         zratio    = tr(ji,jj,jk,jpgsi,Kbb) / ( tr(ji,jj,jk,jpgoc,Kbb) + rtrn )
+         zratio2   = zratio * zratio
+         zfracc    = zproport * grazflux  * xstep * wsbio4(ji,jj,jk)      &
+         &          * tr(ji,jj,jk,jpgoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb)          &
+         &          * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) )
+         zfracfe   = zfracc * tr(ji,jj,jk,jpbfe,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn)
+         zfracn    = zfracc * tr(ji,jj,jk,jpgon,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn)
+         zfracp    = zfracc * tr(ji,jj,jk,jpgop,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn)
+
+         zgrazffep = zproport * zgrazffep   ;   zgrazffeg = zproport * zgrazffeg
+         zgrazfffp = zproport * zgrazfffp   ;   zgrazfffg = zproport * zgrazfffg
+         zgrazffnp = zproport * zgrazffnp   ;   zgrazffng = zproport * zgrazffng
+         zgrazffpp = zproport * zgrazffpp   ;   zgrazffpg = zproport * zgrazffpg
+
+         zgraztotc  = zgrazdc + zgrazz + zgraznc + zgrazm + zgrazpoc + zgrazffep + zgrazffeg
+         zgraztotf  = zgrazdf + zgraznf + ( zgrazz + zgrazm ) * ferat3 + zgrazpof &
+         &            + zgrazfffp + zgrazfffg
+         zgraztotn  = zgrazdn + (zgrazm + zgrazz) * no3rat3 + zgraznn + zgrazpon  &
+         &            + zgrazffnp + zgrazffng
+         zgraztotp  = zgrazdp + (zgrazz + zgrazm) * po4rat3 + zgraznp + zgrazpop  &
+         &            + zgrazffpp + zgrazffpg
+
+
+         ! Total grazing ( grazing by microzoo is already computed in p5zmicro )
+         zgrazing(ji,jj,jk) = zgraztotc
+
+         !   Stoichiometruc ratios of the food ingested by zooplanton 
+         !   --------------------------------------------------------
+         zgrasratf  =  (zgraztotf + rtrn) / ( zgraztotc + rtrn )
+         zgrasratn  =  (zgraztotn + rtrn) / ( zgraztotc + rtrn )
+         zgrasratp  =  (zgraztotp + rtrn) / ( zgraztotc + rtrn )
+
+         !   Growth efficiency is made a function of the quality 
+         !   and the quantity of the preys
+         !   ---------------------------------------------------
+         zepshert  = MIN( 1., zgrasratn/ no3rat3, zgrasratp/ po4rat3, zgrasratf / ferat3)
+         zbeta     = MAX(0., (epsher2 - epsher2min) )
+         zepsherf  = epsher2min + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta )
+         zepsherv  = zepsherf * zepshert
+
+         !   Respiration of mesozooplankton
+         !   Excess carbon in the food is used preferentially
+         !   ----------------  ------------------------------
+         zexcess  = zgraztotc * zepsherf * (1.0 - zepshert) * zmetexcess 
+         zbasresb = MAX(0., zrespz - zexcess)
+         zbasresi = zexcess + MIN(0., zrespz - zexcess)
+         zrespirc = srespir2 * zepsherv * zgraztotc + zbasresb
+
+         !   When excess carbon is used, the other elements in excess
+         !   are also used proportionally to their abundance
+         !   --------------------------------------------------------
+         zexcess  = ( zgrasratn/ no3rat3 - zepshert ) / ( 1.0 - zepshert + rtrn)
+         zbasresn = zbasresi * zexcess * zgrasratn
+         zexcess  = ( zgrasratp/ po4rat3 - zepshert ) / ( 1.0 - zepshert + rtrn)
+         zbasresp = zbasresi * zexcess * zgrasratp
+         zexcess  = ( zgrasratf/ ferat3 - zepshert ) / ( 1.0 - zepshert + rtrn)
+         zbasresf = zbasresi * zexcess * zgrasratf
+
+         !   Voiding of the excessive elements as organic matter
+         !   --------------------------------------------------------
+         zgradoct = (1. - unass2c - zepsherv) * zgraztotc - zbasresi
+         zgradont = (1. - unass2n) * zgraztotn - zepsherv * no3rat3 * zgraztotc - zbasresn
+         zgradopt = (1. - unass2p) * zgraztotp - zepsherv * po4rat3 * zgraztotc - zbasresp
+         zgrareft = (1. - unass2c) * zgraztotf - zepsherv * ferat3 * zgraztotc - zbasresf
+         ztmp1   = ( 1. - epsher2 - unass2c ) /( 1. - 0.8 * epsher2 ) * ztortz
+         zgradoc = (zgradoct + ztmp1) * ssigma2
+         zgradon = (zgradont + no3rat3 * ztmp1) * ssigma2
+         zgradop = (zgradopt + po4rat3 * ztmp1) * ssigma2
+         zgratmp = 0.2 * epsher2 /( 1. - 0.8 * epsher2 ) * ztortz
+
+         !  Since only semilabile DOM is represented in PISCES
+         !  part of DOM is in fact labile and is then released
+         !  as dissolved inorganic compounds (ssigma2)
+         !  --------------------------------------------------
+         zgrarem = zgratmp + ( zgradoct + ztmp1 ) * (1.0 - ssigma2)
+         zgraren = no3rat3 * zgratmp + ( zgradont + no3rat3 * ztmp1 ) * (1.0 - ssigma2)
+         zgrarep = po4rat3 * zgratmp + ( zgradopt + po4rat3 * ztmp1 ) * (1.0 - ssigma2)
+         zgraref = zgrareft + ferat3 * ( ztmp1 + zgratmp )
+
+         !   Defecation as a result of non assimilated products
+         !   --------------------------------------------------
+         zgrapoc  = zgraztotc * unass2c + unass2c / ( 1. - 0.8 * epsher2 ) * ztortz
+         zgrapon  = zgraztotn * unass2n + no3rat3 * unass2n / ( 1. - 0.8 * epsher2 ) * ztortz
+         zgrapop  = zgraztotp * unass2p + po4rat3 * unass2p / ( 1. - 0.8 * epsher2 ) * ztortz
+         zgrapof  = zgraztotf * unass2c + ferat3  * unass2c / ( 1. - 0.8 * epsher2 ) * ztortz
+
+         !  Addition of respiration to the release of inorganic nutrients
+         !  -------------------------------------------------------------
+         zgrarem = zgrarem + zbasresi + zrespirc
+         zgraren = zgraren + zbasresn + zrespirc * no3rat3
+         zgrarep = zgrarep + zbasresp + zrespirc * po4rat3
+         zgraref = zgraref + zbasresf + zrespirc * ferat3
+
+         !   Update the arrays TRA which contain the biological sources and
+         !   sinks
+         !   --------------------------------------------------------------
+         tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarep 
+         tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgraren
+         tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgradoc
+         !
+         IF( ln_ligand ) THEN
+            tr(ji,jj,jk,jplgw,Krhs)  = tr(ji,jj,jk,jplgw,Krhs) + zgradoc * ldocz
+            zz2ligprod(ji,jj,jk) = zgradoc * ldocz
+         ENDIF
+         !
+         tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zgradon
+         tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zgradop
+         tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarem
+         tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgraref
+         zfezoo2(ji,jj,jk)   = zgraref
+         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrarem
+         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zgraren
+         tr(ji,jj,jk,jpmes,Krhs) = tr(ji,jj,jk,jpmes,Krhs) + zepsherv * zgraztotc - zrespirc   &
+         &                     - ztortz - zgrazm
+         tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zgrazdc
+         tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) - zgrazdn
+         tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) - zgrazdp
+         tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zgrazdf
+         tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) - zgrazz
+         tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zgraznc
+         tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) - zgraznn
+         tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) - zgraznp
+         tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zgraznf
+         tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zgraznc * tr(ji,jj,jk,jpnch,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn )
+         tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zgrazdc * tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
+         tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zgrazdc * tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
+         tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zgrazdc * tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
+
+         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zgrazpoc - zgrazffep + zfracc
+         prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfracc
+         conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep
+         tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) - zgrazpon - zgrazffnp + zfracn
+         tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) - zgrazpop - zgrazffpp + zfracp
+         tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) - zgrazffeg + zgrapoc - zfracc
+         prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zgrapoc
+         consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfracc
+         tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) - zgrazffng + zgrapon - zfracn
+         tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) - zgrazffpg + zgrapop - zfracp
+         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zgrazpof - zgrazfffp + zfracfe
+         tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) - zgrazfffg + zgrapof - zfracfe
+         zfracal = tr(ji,jj,jk,jpcal,Kbb) / ( tr(ji,jj,jk,jpgoc,Kbb) + rtrn )
+         zgrazcal = zgrazffeg * (1. - part2) * zfracal
+
+         !  calcite production
+         !  ------------------
+         zprcaca = xfracal(ji,jj,jk) * zgraznc
+         prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo)
+         zprcaca = part2 * zprcaca
+         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrazcal - zprcaca
+         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + 2. * ( zgrazcal - zprcaca )
+         tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) - zgrazcal + zprcaca
+      END_3D
       !
       IF( lk_iomput .AND. knt == nrdttrc ) THEN
-         ALLOCATE( zw3d(jpi,jpj,jpk) )
-         IF( iom_use( "GRAZ2" ) ) THEN
-            zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:)  !   Total grazing of phyto by zooplankton
-            CALL iom_put( "GRAZ2", zw3d )
+        CALL iom_put( "PCAL"  , prodcal(:,:,:) * 1.e+3  * rfact2r * tmask(:,:,:) )  !  Calcite production 
+        IF( iom_use("GRAZ2") ) THEN  !   Total grazing of phyto by zooplankton
+           zgrazing(:,:,jpk) = 0._wp ;  CALL iom_put( "GRAZ2" , zgrazing(:,:,:) * 1.e+3  * rfact2r * tmask(:,:,:) ) 
          ENDIF
-         IF( iom_use( "PCAL" ) ) THEN
-            zw3d(:,:,:) = prodcal(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:)   !  Calcite production
-            CALL iom_put( "PCAL", zw3d )
+         IF( iom_use("FEZOO2") ) THEN  
+           zfezoo2 (:,:,jpk) = 0._wp ; CALL iom_put( "FEZOO2", zfezoo2(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) )
          ENDIF
-         IF( iom_use( "FEZOO2" ) ) THEN
-            zw3d(:,:,:) = zfezoo2(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:)   !
-            CALL iom_put( "FEZOO2", zw3d )
+         IF( ln_ligand ) THEN
+            zz2ligprod(:,:,jpk) = 0._wp ; CALL iom_put( "LPRODZ2", zz2ligprod(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:)  )
          ENDIF
-         IF( iom_use( "LPRODZ2" ) .AND. ln_ligand )  THEN
-            zw3d(:,:,:) = zz2ligprod(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:)
-            CALL iom_put( "LPRODZ2"  , zw3d )
-         ENDIF
-         DEALLOCATE( zw3d )
       ENDIF
       !
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
         WRITE(charout, FMT="('meso')")
         CALL prt_ctl_trc_info(charout)
-        CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+        CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
       ENDIF
       !
@@ -407,9 +388,7 @@
       !!----------------------------------------------------------------------
       !
-      REWIND( numnatp_ref )              ! Namelist nampismes in reference namelist : Pisces mesozooplankton
       READ  ( numnatp_ref, namp5zmes, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismes in reference namelist' )
       !
-      REWIND( numnatp_cfg )              ! Namelist nampismes in configuration namelist : Pisces mesozooplankton
       READ  ( numnatp_cfg, namp5zmes, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'nampismes in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p5zmicro.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p5zmicro.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p5zmicro.F90	(revision 12928)
@@ -52,4 +52,6 @@
    LOGICAL,  PUBLIC ::  bmetexc     !: Use of excess carbon for respiration
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -60,5 +62,5 @@
 CONTAINS
 
-   SUBROUTINE p5z_micro( kt, knt )
+   SUBROUTINE p5z_micro( kt, knt, Kbb, Krhs )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p5z_micro  ***
@@ -70,4 +72,5 @@
       INTEGER, INTENT(in) ::  kt  ! ocean time step
       INTEGER, INTENT(in) ::  knt 
+      INTEGER, INTENT(in) ::  Kbb, Krhs      ! time level indices
       !
       INTEGER  :: ji, jj, jk
@@ -84,6 +87,5 @@
       REAL(wp) :: zgrazdc, zgrazdn, zgrazdp, zgrazdf, zgraznf, zgrazz
       REAL(wp) :: zgrazpc, zgrazpn, zgrazpp, zgrazpf, zbeta, zrfact2, zmetexcess
-      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zfezoo
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d, zzligprod
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zfezoo, zzligprod
       CHARACTER (len=25) :: charout
       !!---------------------------------------------------------------------
@@ -91,235 +93,219 @@
       IF( ln_timing )   CALL timing_start('p5z_micro')
       !
-      IF (ln_ligand) THEN
-         ALLOCATE( zzligprod(jpi,jpj,jpk) )
-         zzligprod(:,:,:) = 0._wp
-      ENDIF
-      !
       zmetexcess = 0.0
       IF ( bmetexc ) zmetexcess = 1.0
       !
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zcompaz = MAX( ( trb(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 )
-               zfact   = xstep * tgfunc2(ji,jj,jk) * zcompaz
-
-               !   Michaelis-Menten mortality rates of microzooplankton
-               !   -----------------------------------------------------
-               zrespz = resrat * zfact * ( trb(ji,jj,jk,jpzoo) / ( xkmort + trb(ji,jj,jk,jpzoo) )  &
-               &        + 3. * nitrfac(ji,jj,jk) )
-
-               !   Zooplankton mortality. A square function has been selected with
-               !   no real reason except that it seems to be more stable and may mimic predation.
-               !   ------------------------------------------------------------------------------
-               ztortz = mzrat * 1.e6 * zfact * trb(ji,jj,jk,jpzoo) * (1. - nitrfac(ji,jj,jk))
-
-               !   Computation of the abundance of the preys
-               !   A threshold can be specified in the namelist
-               !   --------------------------------------------
-               zcompadi  = MIN( MAX( ( trb(ji,jj,jk,jpdia) - xthreshdia ), 0.e0 ), xsizedia )
-               zcompaph  = MAX( ( trb(ji,jj,jk,jpphy) - xthreshphy ), 0.e0 )
-               zcompaz   = MAX( ( trb(ji,jj,jk,jpzoo) - xthreshzoo ), 0.e0 )
-               zcompapi  = MAX( ( trb(ji,jj,jk,jppic) - xthreshpic ), 0.e0 )
-               zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthreshpoc ), 0.e0 )
-               
-               !   Microzooplankton grazing
-               !   ------------------------
-               zfood     = xprefn * zcompaph + xprefc * zcompapoc + xprefd * zcompadi   &
-               &           + xprefz * zcompaz + xprefp * zcompapi
-               zfoodlim  = MAX( 0. , zfood - min(xthresh,0.5*zfood) )
-               zdenom    = zfoodlim / ( xkgraz + zfoodlim )
-               zgraze    = grazrat * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpzoo) * (1. - nitrfac(ji,jj,jk)) 
-
-               !   An active switching parameterization is used here.
-               !   We don't use the KTW parameterization proposed by 
-               !   Vallina et al. because it tends to produce to steady biomass
-               !   composition and the variance of Chl is too low as it grazes
-               !   too strongly on winning organisms. Thus, instead of a square
-               !   a 1.5 power value is used which decreases the pressure on the
-               !   most abundant species
-               !   ------------------------------------------------------------  
-               ztmp1 = xprefn * zcompaph**1.5
-               ztmp2 = xprefp * zcompapi**1.5
-               ztmp3 = xprefc * zcompapoc**1.5
-               ztmp4 = xprefd * zcompadi**1.5
-               ztmp5 = xprefz * zcompaz**1.5
-               ztmptot = ztmp1 + ztmp2 + ztmp3 + ztmp4 + ztmp5 + rtrn
-               ztmp1 = ztmp1 / ztmptot
-               ztmp2 = ztmp2 / ztmptot
-               ztmp3 = ztmp3 / ztmptot
-               ztmp4 = ztmp4 / ztmptot
-               ztmp5 = ztmp5 / ztmptot
-
-               !   Microzooplankton regular grazing on the different preys
-               !   -------------------------------------------------------
-               zgraznc   = zgraze  * ztmp1  * zdenom
-               zgraznn   = zgraznc * trb(ji,jj,jk,jpnph) / (trb(ji,jj,jk,jpphy) + rtrn)
-               zgraznp   = zgraznc * trb(ji,jj,jk,jppph) / (trb(ji,jj,jk,jpphy) + rtrn)
-               zgraznf   = zgraznc * trb(ji,jj,jk,jpnfe) / (trb(ji,jj,jk,jpphy) + rtrn)
-               zgrazpc   = zgraze  * ztmp2  * zdenom
-               zgrazpn   = zgrazpc * trb(ji,jj,jk,jpnpi) / (trb(ji,jj,jk,jppic) + rtrn)
-               zgrazpp   = zgrazpc * trb(ji,jj,jk,jpppi) / (trb(ji,jj,jk,jppic) + rtrn)
-               zgrazpf   = zgrazpc * trb(ji,jj,jk,jppfe) / (trb(ji,jj,jk,jppic) + rtrn)
-               zgrazz    = zgraze  * ztmp5   * zdenom
-               zgrazpoc  = zgraze  * ztmp3   * zdenom
-               zgrazpon  = zgrazpoc * trb(ji,jj,jk,jppon) / ( trb(ji,jj,jk,jppoc) + rtrn )
-               zgrazpop  = zgrazpoc * trb(ji,jj,jk,jppop) / ( trb(ji,jj,jk,jppoc) + rtrn )
-               zgrazpof  = zgrazpoc* trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn)
-               zgrazdc   = zgraze  * ztmp4  * zdenom
-               zgrazdn   = zgrazdc * trb(ji,jj,jk,jpndi) / (trb(ji,jj,jk,jpdia) + rtrn)
-               zgrazdp   = zgrazdc * trb(ji,jj,jk,jppdi) / (trb(ji,jj,jk,jpdia) + rtrn)
-               zgrazdf   = zgrazdc * trb(ji,jj,jk,jpdfe) / (trb(ji,jj,jk,jpdia) + rtrn)
-               !
-               zgraztotc = zgraznc + zgrazpoc + zgrazdc + zgrazz + zgrazpc
-               zgraztotn = zgraznn + zgrazpn + zgrazpon + zgrazdn + zgrazz * no3rat3
-               zgraztotp = zgraznp + zgrazpp + zgrazpop + zgrazdp + zgrazz * po4rat3
-               zgraztotf = zgraznf + zgrazpf + zgrazpof + zgrazdf + zgrazz * ferat3
-               !
-               ! Grazing by microzooplankton
-               zgrazing(ji,jj,jk) = zgraztotc
-
-               !   Stoichiometruc ratios of the food ingested by zooplanton 
-               !   --------------------------------------------------------
-               zgrasratf =  (zgraztotf + rtrn) / ( zgraztotc + rtrn )
-               zgrasratn =  (zgraztotn + rtrn) / ( zgraztotc + rtrn )
-               zgrasratp =  (zgraztotp + rtrn) / ( zgraztotc + rtrn )
-
-               !   Growth efficiency is made a function of the quality 
-               !   and the quantity of the preys
-               !   ---------------------------------------------------
-               zepshert  = MIN( 1., zgrasratn/ no3rat3, zgrasratp/ po4rat3, zgrasratf / ferat3)
-               zbeta     = MAX( 0., (epsher - epshermin) )
-               zepsherf  = epshermin + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta )
-               zepsherv  = zepsherf * zepshert
-
-               !   Respiration of microzooplankton
-               !   Excess carbon in the food is used preferentially
-               !   ------------------------------------------------
-               zexcess  = zgraztotc * zepsherf * (1.0 - zepshert) * zmetexcess
-               zbasresb = MAX(0., zrespz - zexcess)
-               zbasresi = zexcess + MIN(0., zrespz - zexcess)  
-               zrespirc = srespir * zepsherv * zgraztotc + zbasresb
-               
-               !   When excess carbon is used, the other elements in excess
-               !   are also used proportionally to their abundance
-               !   --------------------------------------------------------
-               zexcess  = ( zgrasratn/ no3rat3 - zepshert ) / ( 1.0 - zepshert + rtrn)
-               zbasresn = zbasresi * zexcess * zgrasratn 
-               zexcess  = ( zgrasratp/ po4rat3 - zepshert ) / ( 1.0 - zepshert + rtrn)
-               zbasresp = zbasresi * zexcess * zgrasratp
-               zexcess  = ( zgrasratf/ ferat3 - zepshert ) / ( 1.0 - zepshert + rtrn)
-               zbasresf = zbasresi * zexcess * zgrasratf
-
-               !   Voiding of the excessive elements as DOM
-               !   ----------------------------------------
-               zgradoct   = (1. - unassc - zepsherv) * zgraztotc - zbasresi  
-               zgradont   = (1. - unassn) * zgraztotn - zepsherv * no3rat3 * zgraztotc - zbasresn
-               zgradopt   = (1. - unassp) * zgraztotp - zepsherv * po4rat3 * zgraztotc - zbasresp
-               zgrareft   = (1. - unassc) * zgraztotf - zepsherv * ferat3 * zgraztotc - zbasresf
-
-               !  Since only semilabile DOM is represented in PISCES
-               !  part of DOM is in fact labile and is then released
-               !  as dissolved inorganic compounds (ssigma)
-               !  --------------------------------------------------
-               zgradoc =  zgradoct * ssigma
-               zgradon =  zgradont * ssigma
-               zgradop =  zgradopt * ssigma
-               zgrarem = (1.0 - ssigma) * zgradoct
-               zgraren = (1.0 - ssigma) * zgradont
-               zgrarep = (1.0 - ssigma) * zgradopt
-               zgraref = zgrareft
-
-               !   Defecation as a result of non assimilated products
-               !   --------------------------------------------------
-               zgrapoc   = zgraztotc * unassc
-               zgrapon   = zgraztotn * unassn
-               zgrapop   = zgraztotp * unassp
-               zgrapof   = zgraztotf * unassc
-
-               !  Addition of respiration to the release of inorganic nutrients
-               !  -------------------------------------------------------------
-               zgrarem = zgrarem + zbasresi + zrespirc
-               zgraren = zgraren + zbasresn + zrespirc * no3rat3
-               zgrarep = zgrarep + zbasresp + zrespirc * po4rat3
-               zgraref = zgraref + zbasresf + zrespirc * ferat3
-
-               !   Update of the TRA arrays
-               !   ------------------------
-               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarep
-               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgraren
-               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgradoc
-               !
-               IF( ln_ligand ) THEN 
-                  tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zgradoc * ldocz
-                  zzligprod(ji,jj,jk) = zgradoc * ldocz
-               ENDIF
-               !
-               tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zgradon
-               tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zgradop
-               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem 
-               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgraref
-               zfezoo(ji,jj,jk)    = zgraref
-               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zepsherv * zgraztotc - zrespirc - ztortz - zgrazz
-               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgraznc
-               tra(ji,jj,jk,jpnph) = tra(ji,jj,jk,jpnph) - zgraznn
-               tra(ji,jj,jk,jppph) = tra(ji,jj,jk,jppph) - zgraznp
-               tra(ji,jj,jk,jppic) = tra(ji,jj,jk,jppic) - zgrazpc
-               tra(ji,jj,jk,jpnpi) = tra(ji,jj,jk,jpnpi) - zgrazpn
-               tra(ji,jj,jk,jpppi) = tra(ji,jj,jk,jpppi) - zgrazpp
-               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazdc
-               tra(ji,jj,jk,jpndi) = tra(ji,jj,jk,jpndi) - zgrazdn
-               tra(ji,jj,jk,jppdi) = tra(ji,jj,jk,jppdi) - zgrazdp
-               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgraznc * trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn)
-               tra(ji,jj,jk,jppch) = tra(ji,jj,jk,jppch) - zgrazpc * trb(ji,jj,jk,jppch)/(trb(ji,jj,jk,jppic)+rtrn)
-               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazdc * trb(ji,jj,jk,jpdch)/(trb(ji,jj,jk,jpdia)+rtrn)
-               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazdc * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn)
-               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazdc * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn)
-               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf
-               tra(ji,jj,jk,jppfe) = tra(ji,jj,jk,jppfe) - zgrazpf
-               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazdf
-               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + ztortz + zgrapoc - zgrazpoc 
-               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ztortz + zgrapoc
-               conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc
-               tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + no3rat3 * ztortz + zgrapon - zgrazpon
-               tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + po4rat3 * ztortz + zgrapop - zgrazpop
-               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * ztortz  + zgrapof - zgrazpof
-               !
-               ! calcite production
-               zprcaca = xfracal(ji,jj,jk) * zgraznc
-               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo)
-               !
-               zprcaca = part * zprcaca
-               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem - zprcaca
-               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca     &
-               &                     + rno3 * zgraren
-               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca
-            END DO
-         END DO
-      END DO
-      !
-      IF( lk_iomput ) THEN
-         IF( knt == nrdttrc ) THEN
-            ALLOCATE( zw3d(jpi,jpj,jpk) )
-            IF( iom_use( "GRAZ1" ) ) THEN
-               zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:)  !  Total grazing of phyto by zooplankton
-               CALL iom_put( "GRAZ1", zw3d )
-            ENDIF
-            IF( iom_use( "FEZOO" ) ) THEN
-               zw3d(:,:,:) = zfezoo(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:)   !
-               CALL iom_put( "FEZOO", zw3d )
-            ENDIF
-            IF( iom_use( "LPRODZ" ) .AND. ln_ligand )  THEN
-               zw3d(:,:,:) = zzligprod(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:)
-               CALL iom_put( "LPRODZ"  , zw3d )
-            ENDIF
-            DEALLOCATE( zw3d )
+      DO_3D_11_11( 1, jpkm1 )
+         zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - 1.e-9 ), 0.e0 )
+         zfact   = xstep * tgfunc2(ji,jj,jk) * zcompaz
+
+         !   Michaelis-Menten mortality rates of microzooplankton
+         !   -----------------------------------------------------
+         zrespz = resrat * zfact * ( tr(ji,jj,jk,jpzoo,Kbb) / ( xkmort + tr(ji,jj,jk,jpzoo,Kbb) )  &
+         &        + 3. * nitrfac(ji,jj,jk) )
+
+         !   Zooplankton mortality. A square function has been selected with
+         !   no real reason except that it seems to be more stable and may mimic predation.
+         !   ------------------------------------------------------------------------------
+         ztortz = mzrat * 1.e6 * zfact * tr(ji,jj,jk,jpzoo,Kbb) * (1. - nitrfac(ji,jj,jk))
+
+         !   Computation of the abundance of the preys
+         !   A threshold can be specified in the namelist
+         !   --------------------------------------------
+         zcompadi  = MIN( MAX( ( tr(ji,jj,jk,jpdia,Kbb) - xthreshdia ), 0.e0 ), xsizedia )
+         zcompaph  = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - xthreshphy ), 0.e0 )
+         zcompaz   = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - xthreshzoo ), 0.e0 )
+         zcompapi  = MAX( ( tr(ji,jj,jk,jppic,Kbb) - xthreshpic ), 0.e0 )
+         zcompapoc = MAX( ( tr(ji,jj,jk,jppoc,Kbb) - xthreshpoc ), 0.e0 )
+         
+         !   Microzooplankton grazing
+         !   ------------------------
+         zfood     = xprefn * zcompaph + xprefc * zcompapoc + xprefd * zcompadi   &
+         &           + xprefz * zcompaz + xprefp * zcompapi
+         zfoodlim  = MAX( 0. , zfood - min(xthresh,0.5*zfood) )
+         zdenom    = zfoodlim / ( xkgraz + zfoodlim )
+         zgraze    = grazrat * xstep * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpzoo,Kbb) * (1. - nitrfac(ji,jj,jk)) 
+
+         !   An active switching parameterization is used here.
+         !   We don't use the KTW parameterization proposed by 
+         !   Vallina et al. because it tends to produce to steady biomass
+         !   composition and the variance of Chl is too low as it grazes
+         !   too strongly on winning organisms. Thus, instead of a square
+         !   a 1.5 power value is used which decreases the pressure on the
+         !   most abundant species
+         !   ------------------------------------------------------------  
+         ztmp1 = xprefn * zcompaph**1.5
+         ztmp2 = xprefp * zcompapi**1.5
+         ztmp3 = xprefc * zcompapoc**1.5
+         ztmp4 = xprefd * zcompadi**1.5
+         ztmp5 = xprefz * zcompaz**1.5
+         ztmptot = ztmp1 + ztmp2 + ztmp3 + ztmp4 + ztmp5 + rtrn
+         ztmp1 = ztmp1 / ztmptot
+         ztmp2 = ztmp2 / ztmptot
+         ztmp3 = ztmp3 / ztmptot
+         ztmp4 = ztmp4 / ztmptot
+         ztmp5 = ztmp5 / ztmptot
+
+         !   Microzooplankton regular grazing on the different preys
+         !   -------------------------------------------------------
+         zgraznc   = zgraze  * ztmp1  * zdenom
+         zgraznn   = zgraznc * tr(ji,jj,jk,jpnph,Kbb) / (tr(ji,jj,jk,jpphy,Kbb) + rtrn)
+         zgraznp   = zgraznc * tr(ji,jj,jk,jppph,Kbb) / (tr(ji,jj,jk,jpphy,Kbb) + rtrn)
+         zgraznf   = zgraznc * tr(ji,jj,jk,jpnfe,Kbb) / (tr(ji,jj,jk,jpphy,Kbb) + rtrn)
+         zgrazpc   = zgraze  * ztmp2  * zdenom
+         zgrazpn   = zgrazpc * tr(ji,jj,jk,jpnpi,Kbb) / (tr(ji,jj,jk,jppic,Kbb) + rtrn)
+         zgrazpp   = zgrazpc * tr(ji,jj,jk,jpppi,Kbb) / (tr(ji,jj,jk,jppic,Kbb) + rtrn)
+         zgrazpf   = zgrazpc * tr(ji,jj,jk,jppfe,Kbb) / (tr(ji,jj,jk,jppic,Kbb) + rtrn)
+         zgrazz    = zgraze  * ztmp5   * zdenom
+         zgrazpoc  = zgraze  * ztmp3   * zdenom
+         zgrazpon  = zgrazpoc * tr(ji,jj,jk,jppon,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn )
+         zgrazpop  = zgrazpoc * tr(ji,jj,jk,jppop,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn )
+         zgrazpof  = zgrazpoc* tr(ji,jj,jk,jpsfe,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn)
+         zgrazdc   = zgraze  * ztmp4  * zdenom
+         zgrazdn   = zgrazdc * tr(ji,jj,jk,jpndi,Kbb) / (tr(ji,jj,jk,jpdia,Kbb) + rtrn)
+         zgrazdp   = zgrazdc * tr(ji,jj,jk,jppdi,Kbb) / (tr(ji,jj,jk,jpdia,Kbb) + rtrn)
+         zgrazdf   = zgrazdc * tr(ji,jj,jk,jpdfe,Kbb) / (tr(ji,jj,jk,jpdia,Kbb) + rtrn)
+         !
+         zgraztotc = zgraznc + zgrazpoc + zgrazdc + zgrazz + zgrazpc
+         zgraztotn = zgraznn + zgrazpn + zgrazpon + zgrazdn + zgrazz * no3rat3
+         zgraztotp = zgraznp + zgrazpp + zgrazpop + zgrazdp + zgrazz * po4rat3
+         zgraztotf = zgraznf + zgrazpf + zgrazpof + zgrazdf + zgrazz * ferat3
+         !
+         ! Grazing by microzooplankton
+         zgrazing(ji,jj,jk) = zgraztotc
+
+         !   Stoichiometruc ratios of the food ingested by zooplanton 
+         !   --------------------------------------------------------
+         zgrasratf =  (zgraztotf + rtrn) / ( zgraztotc + rtrn )
+         zgrasratn =  (zgraztotn + rtrn) / ( zgraztotc + rtrn )
+         zgrasratp =  (zgraztotp + rtrn) / ( zgraztotc + rtrn )
+
+         !   Growth efficiency is made a function of the quality 
+         !   and the quantity of the preys
+         !   ---------------------------------------------------
+         zepshert  = MIN( 1., zgrasratn/ no3rat3, zgrasratp/ po4rat3, zgrasratf / ferat3)
+         zbeta     = MAX( 0., (epsher - epshermin) )
+         zepsherf  = epshermin + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta )
+         zepsherv  = zepsherf * zepshert
+
+         !   Respiration of microzooplankton
+         !   Excess carbon in the food is used preferentially
+         !   ------------------------------------------------
+         zexcess  = zgraztotc * zepsherf * (1.0 - zepshert) * zmetexcess
+         zbasresb = MAX(0., zrespz - zexcess)
+         zbasresi = zexcess + MIN(0., zrespz - zexcess)  
+         zrespirc = srespir * zepsherv * zgraztotc + zbasresb
+         
+         !   When excess carbon is used, the other elements in excess
+         !   are also used proportionally to their abundance
+         !   --------------------------------------------------------
+         zexcess  = ( zgrasratn/ no3rat3 - zepshert ) / ( 1.0 - zepshert + rtrn)
+         zbasresn = zbasresi * zexcess * zgrasratn 
+         zexcess  = ( zgrasratp/ po4rat3 - zepshert ) / ( 1.0 - zepshert + rtrn)
+         zbasresp = zbasresi * zexcess * zgrasratp
+         zexcess  = ( zgrasratf/ ferat3 - zepshert ) / ( 1.0 - zepshert + rtrn)
+         zbasresf = zbasresi * zexcess * zgrasratf
+
+         !   Voiding of the excessive elements as DOM
+         !   ----------------------------------------
+         zgradoct   = (1. - unassc - zepsherv) * zgraztotc - zbasresi  
+         zgradont   = (1. - unassn) * zgraztotn - zepsherv * no3rat3 * zgraztotc - zbasresn
+         zgradopt   = (1. - unassp) * zgraztotp - zepsherv * po4rat3 * zgraztotc - zbasresp
+         zgrareft   = (1. - unassc) * zgraztotf - zepsherv * ferat3 * zgraztotc - zbasresf
+
+         !  Since only semilabile DOM is represented in PISCES
+         !  part of DOM is in fact labile and is then released
+         !  as dissolved inorganic compounds (ssigma)
+         !  --------------------------------------------------
+         zgradoc =  zgradoct * ssigma
+         zgradon =  zgradont * ssigma
+         zgradop =  zgradopt * ssigma
+         zgrarem = (1.0 - ssigma) * zgradoct
+         zgraren = (1.0 - ssigma) * zgradont
+         zgrarep = (1.0 - ssigma) * zgradopt
+         zgraref = zgrareft
+
+         !   Defecation as a result of non assimilated products
+         !   --------------------------------------------------
+         zgrapoc   = zgraztotc * unassc
+         zgrapon   = zgraztotn * unassn
+         zgrapop   = zgraztotp * unassp
+         zgrapof   = zgraztotf * unassc
+
+         !  Addition of respiration to the release of inorganic nutrients
+         !  -------------------------------------------------------------
+         zgrarem = zgrarem + zbasresi + zrespirc
+         zgraren = zgraren + zbasresn + zrespirc * no3rat3
+         zgrarep = zgrarep + zbasresp + zrespirc * po4rat3
+         zgraref = zgraref + zbasresf + zrespirc * ferat3
+
+         !   Update of the TRA arrays
+         !   ------------------------
+         tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarep
+         tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgraren
+         tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgradoc
+         !
+         IF( ln_ligand ) THEN 
+            tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zgradoc * ldocz
+            zzligprod(ji,jj,jk) = zgradoc * ldocz
+         ENDIF
+         !
+         tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zgradon
+         tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zgradop
+         tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarem 
+         tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgraref
+         zfezoo(ji,jj,jk)    = zgraref
+         tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) + zepsherv * zgraztotc - zrespirc - ztortz - zgrazz
+         tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zgraznc
+         tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) - zgraznn
+         tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) - zgraznp
+         tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) - zgrazpc
+         tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) - zgrazpn
+         tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) - zgrazpp
+         tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zgrazdc
+         tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) - zgrazdn
+         tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) - zgrazdp
+         tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zgraznc * tr(ji,jj,jk,jpnch,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn)
+         tr(ji,jj,jk,jppch,Krhs) = tr(ji,jj,jk,jppch,Krhs) - zgrazpc * tr(ji,jj,jk,jppch,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn)
+         tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zgrazdc * tr(ji,jj,jk,jpdch,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn)
+         tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zgrazdc * tr(ji,jj,jk,jpdsi,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn)
+         tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zgrazdc * tr(ji,jj,jk,jpdsi,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn)
+         tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zgraznf
+         tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) - zgrazpf
+         tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zgrazdf
+         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + ztortz + zgrapoc - zgrazpoc 
+         prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ztortz + zgrapoc
+         conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc
+         tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + no3rat3 * ztortz + zgrapon - zgrazpon
+         tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + po4rat3 * ztortz + zgrapop - zgrazpop
+         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ferat3 * ztortz  + zgrapof - zgrazpof
+         !
+         ! calcite production
+         zprcaca = xfracal(ji,jj,jk) * zgraznc
+         prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo)
+         !
+         zprcaca = part * zprcaca
+         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrarem - zprcaca
+         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * zprcaca     &
+         &                     + rno3 * zgraren
+         tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) + zprcaca
+      END_3D
+      !
+      IF( lk_iomput .AND. knt == nrdttrc ) THEN
+       IF( iom_use("GRAZ1") ) THEN  !   Total grazing of phyto by zooplankton
+           zgrazing(:,:,jpk) = 0._wp   ; CALL iom_put( "GRAZ1" , zgrazing(:,:,:) * 1.e+3  * rfact2r * tmask(:,:,:) ) 
+         ENDIF
+         IF( iom_use("FEZOO") ) THEN  
+           zfezoo (:,:,jpk) = 0._wp    ; CALL iom_put( "FEZOO" , zfezoo(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) )
+         ENDIF
+         IF( ln_ligand ) THEN
+            zzligprod(:,:,jpk) = 0._wp ; CALL iom_put( "LPRODZ", zzligprod(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:))
          ENDIF
       ENDIF
       !
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
          WRITE(charout, FMT="('micro')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
       ENDIF
       !
@@ -349,9 +335,7 @@
       !!----------------------------------------------------------------------
       !
-      REWIND( numnatp_ref )              ! Namelist nampiszoo in reference namelist : Pisces microzooplankton
       READ  ( numnatp_ref, namp5zzoo, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp5zzoo in reference namelist' )
       !
-      REWIND( numnatp_cfg )              ! Namelist nampiszoo in configuration namelist : Pisces microzooplankton
       READ  ( numnatp_cfg, namp5zzoo, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namp5zzoo in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p5zmort.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p5zmort.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p5zmort.F90	(revision 12928)
@@ -33,4 +33,6 @@
    REAL(wp), PUBLIC :: mpratd  !:
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -41,5 +43,5 @@
 CONTAINS
 
-   SUBROUTINE p5z_mort( kt )
+   SUBROUTINE p5z_mort( kt, Kbb, Krhs )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p5z_mort  ***
@@ -51,14 +53,15 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt ! ocean time step
-      !!---------------------------------------------------------------------
-
-      CALL p5z_nano            ! nanophytoplankton
-      CALL p5z_pico            ! picophytoplankton
-      CALL p5z_diat            ! diatoms
+      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices
+      !!---------------------------------------------------------------------
+
+      CALL p5z_nano( Kbb, Krhs )            ! nanophytoplankton
+      CALL p5z_pico( Kbb, Krhs )            ! picophytoplankton
+      CALL p5z_diat( Kbb, Krhs )            ! diatoms
 
    END SUBROUTINE p5z_mort
 
 
-   SUBROUTINE p5z_nano
+   SUBROUTINE p5z_nano( Kbb, Krhs )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p5z_nano  ***
@@ -68,4 +71,5 @@
       !! ** Method  : - ???
       !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices
       INTEGER  :: ji, jj, jk
       REAL(wp) :: zcompaph
@@ -78,49 +82,45 @@
       !
       prodcal(:,:,:) = 0.  !: calcite production variable set to zero
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zcompaph = MAX( ( trb(ji,jj,jk,jpphy) - 1e-9 ), 0.e0 )
-               !   Squared mortality of Phyto similar to a sedimentation term during
-               !   blooms (Doney et al. 1996)
-               !   -----------------------------------------------------------------
-               zrespp = wchln * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * trb(ji,jj,jk,jpphy)
-
-               !   Phytoplankton linear mortality
-               !   ------------------------------
-               ztortp = mpratn * xstep  * zcompaph
-               zmortp = zrespp + ztortp
-
-               !   Update the arrays TRA which contains the biological sources and sinks
-
-               zfactn  = trb(ji,jj,jk,jpnph)/(trb(ji,jj,jk,jpphy)+rtrn)
-               zfactp  = trb(ji,jj,jk,jppph)/(trb(ji,jj,jk,jpphy)+rtrn)
-               zfactfe = trb(ji,jj,jk,jpnfe)/(trb(ji,jj,jk,jpphy)+rtrn)
-               zfactch = trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn)
-               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zmortp
-               tra(ji,jj,jk,jpnph) = tra(ji,jj,jk,jpnph) - zmortp * zfactn
-               tra(ji,jj,jk,jppph) = tra(ji,jj,jk,jppph) - zmortp * zfactp
-               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zmortp * zfactch
-               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zmortp * zfactfe
-               zprcaca = xfracal(ji,jj,jk) * zmortp
-               !
-               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo)
-               !
-               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca
-               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca
-               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca
-               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp
-               tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + zmortp * zfactn
-               tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + zmortp * zfactp
-               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortp
-               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp * zfactfe
-            END DO
-         END DO
-      END DO
-      !
-       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+      DO_3D_11_11( 1, jpkm1 )
+         zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - 1e-9 ), 0.e0 )
+         !   Squared mortality of Phyto similar to a sedimentation term during
+         !   blooms (Doney et al. 1996)
+         !   -----------------------------------------------------------------
+         zrespp = wchln * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * tr(ji,jj,jk,jpphy,Kbb)
+
+         !   Phytoplankton linear mortality
+         !   ------------------------------
+         ztortp = mpratn * xstep  * zcompaph
+         zmortp = zrespp + ztortp
+
+         !   Update the arrays TRA which contains the biological sources and sinks
+
+         zfactn  = tr(ji,jj,jk,jpnph,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn)
+         zfactp  = tr(ji,jj,jk,jppph,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn)
+         zfactfe = tr(ji,jj,jk,jpnfe,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn)
+         zfactch = tr(ji,jj,jk,jpnch,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn)
+         tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zmortp
+         tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) - zmortp * zfactn
+         tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) - zmortp * zfactp
+         tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zmortp * zfactch
+         tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zmortp * zfactfe
+         zprcaca = xfracal(ji,jj,jk) * zmortp
+         !
+         prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo)
+         !
+         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprcaca
+         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * zprcaca
+         tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) + zprcaca
+         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zmortp
+         tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + zmortp * zfactn
+         tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + zmortp * zfactp
+         prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortp
+         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zmortp * zfactfe
+      END_3D
+      !
+       IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
          WRITE(charout, FMT="('nano')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
        ENDIF
       !
@@ -130,5 +130,5 @@
 
 
-   SUBROUTINE p5z_pico
+   SUBROUTINE p5z_pico( Kbb, Krhs )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p5z_pico  ***
@@ -138,4 +138,5 @@
       !! ** Method  : - ???
       !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices
       INTEGER  :: ji, jj, jk
       REAL(wp) :: zcompaph
@@ -147,41 +148,37 @@
       IF( ln_timing )   CALL timing_start('p5z_pico')
       !
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zcompaph = MAX( ( trb(ji,jj,jk,jppic) - 1e-9 ), 0.e0 )
-               !  Squared mortality of Phyto similar to a sedimentation term during
-               !  blooms (Doney et al. 1996)
-               !  -----------------------------------------------------------------
-               zrespp = wchlp * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * trb(ji,jj,jk,jppic)
-
-               !     Phytoplankton mortality 
-               ztortp = mpratp * xstep  * zcompaph
-               zmortp = zrespp + ztortp
-
-               !   Update the arrays TRA which contains the biological sources and sinks
-
-               zfactn = trb(ji,jj,jk,jpnpi)/(trb(ji,jj,jk,jppic)+rtrn)
-               zfactp = trb(ji,jj,jk,jpppi)/(trb(ji,jj,jk,jppic)+rtrn)
-               zfactfe = trb(ji,jj,jk,jppfe)/(trb(ji,jj,jk,jppic)+rtrn)
-               zfactch = trb(ji,jj,jk,jppch)/(trb(ji,jj,jk,jppic)+rtrn)
-               tra(ji,jj,jk,jppic) = tra(ji,jj,jk,jppic) - zmortp
-               tra(ji,jj,jk,jpnpi) = tra(ji,jj,jk,jpnpi) - zmortp * zfactn
-               tra(ji,jj,jk,jpppi) = tra(ji,jj,jk,jpppi) - zmortp * zfactp
-               tra(ji,jj,jk,jppch) = tra(ji,jj,jk,jppch) - zmortp * zfactch
-               tra(ji,jj,jk,jppfe) = tra(ji,jj,jk,jppfe) - zmortp * zfactfe
-               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp
-               tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + zmortp * zfactn
-               tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + zmortp * zfactp
-               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp * zfactfe
-               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortp
-            END DO
-         END DO
-      END DO
-      !
-       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+      DO_3D_11_11( 1, jpkm1 )
+         zcompaph = MAX( ( tr(ji,jj,jk,jppic,Kbb) - 1e-9 ), 0.e0 )
+         !  Squared mortality of Phyto similar to a sedimentation term during
+         !  blooms (Doney et al. 1996)
+         !  -----------------------------------------------------------------
+         zrespp = wchlp * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * tr(ji,jj,jk,jppic,Kbb)
+
+         !     Phytoplankton mortality 
+         ztortp = mpratp * xstep  * zcompaph
+         zmortp = zrespp + ztortp
+
+         !   Update the arrays TRA which contains the biological sources and sinks
+
+         zfactn = tr(ji,jj,jk,jpnpi,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn)
+         zfactp = tr(ji,jj,jk,jpppi,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn)
+         zfactfe = tr(ji,jj,jk,jppfe,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn)
+         zfactch = tr(ji,jj,jk,jppch,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn)
+         tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) - zmortp
+         tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) - zmortp * zfactn
+         tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) - zmortp * zfactp
+         tr(ji,jj,jk,jppch,Krhs) = tr(ji,jj,jk,jppch,Krhs) - zmortp * zfactch
+         tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) - zmortp * zfactfe
+         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zmortp
+         tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + zmortp * zfactn
+         tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + zmortp * zfactp
+         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zmortp * zfactfe
+         prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortp
+      END_3D
+      !
+       IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
          WRITE(charout, FMT="('pico')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
        ENDIF
       !
@@ -191,5 +188,5 @@
 
 
-   SUBROUTINE p5z_diat
+   SUBROUTINE p5z_diat( Kbb, Krhs )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p5z_diat  ***
@@ -199,4 +196,5 @@
       !! ** Method  : - ???
       !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices
       INTEGER  ::  ji, jj, jk
       REAL(wp) ::  zfactfe,zfactsi,zfactch, zfactn, zfactp, zcompadi
@@ -209,57 +207,53 @@
       !
 
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-
-               zcompadi = MAX( ( trb(ji,jj,jk,jpdia) - 1E-9), 0. )
-
-               !   Aggregation term for diatoms is increased in case of nutrient
-               !   stress as observed in reality. The stressed cells become more
-               !   sticky and coagulate to sink quickly out of the euphotic zone
-               !   -------------------------------------------------------------
-               !  Phytoplankton squared mortality
-               !  -------------------------------
-               zlim2   = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk)
-               zlim1   = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 ) 
-               zrespp2 = 1.e6 * xstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trb(ji,jj,jk,jpdia)
-
-               !  Phytoplankton linear mortality 
-               !  ------------------------------
-               ztortp2 = mpratd * xstep  * zcompadi
-               zmortp2 = zrespp2 + ztortp2
-
-               !   Update the arrays tra which contains the biological sources and sinks
-               !   ---------------------------------------------------------------------
-               zfactn  = trb(ji,jj,jk,jpndi) / ( trb(ji,jj,jk,jpdia) + rtrn )
-               zfactp  = trb(ji,jj,jk,jppdi) / ( trb(ji,jj,jk,jpdia) + rtrn )
-               zfactch = trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn )
-               zfactfe = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn )
-               zfactsi = trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn )
-               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zmortp2 
-               tra(ji,jj,jk,jpndi) = tra(ji,jj,jk,jpndi) - zmortp2 * zfactn
-               tra(ji,jj,jk,jppdi) = tra(ji,jj,jk,jppdi) - zmortp2 * zfactp
-               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zmortp2 * zfactch
-               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zmortp2 * zfactfe
-               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zmortp2 * zfactsi
-               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zmortp2 * zfactsi
-               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zrespp2 
-               tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) + zrespp2 * zfactn
-               tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) + zrespp2 * zfactp
-               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zrespp2 * zfactfe
-               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + ztortp2
-               tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + ztortp2 * zfactn
-               tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + ztortp2 * zfactp
-               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ztortp2 * zfactfe
-               prodpoc(ji,jj,jk)   = prodpoc(ji,jj,jk) + ztortp2
-               prodgoc(ji,jj,jk)   = prodgoc(ji,jj,jk) + zrespp2
-            END DO
-         END DO
-      END DO
-      !
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+      DO_3D_11_11( 1, jpkm1 )
+
+         zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1E-9), 0. )
+
+         !   Aggregation term for diatoms is increased in case of nutrient
+         !   stress as observed in reality. The stressed cells become more
+         !   sticky and coagulate to sink quickly out of the euphotic zone
+         !   -------------------------------------------------------------
+         !  Phytoplankton squared mortality
+         !  -------------------------------
+         zlim2   = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk)
+         zlim1   = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 ) 
+         zrespp2 = 1.e6 * xstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * tr(ji,jj,jk,jpdia,Kbb)
+
+         !  Phytoplankton linear mortality 
+         !  ------------------------------
+         ztortp2 = mpratd * xstep  * zcompadi
+         zmortp2 = zrespp2 + ztortp2
+
+         !   Update the arrays tr(:,:,:,:,Krhs) which contains the biological sources and sinks
+         !   ---------------------------------------------------------------------
+         zfactn  = tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
+         zfactp  = tr(ji,jj,jk,jppdi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
+         zfactch = tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
+         zfactfe = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
+         zfactsi = tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
+         tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zmortp2 
+         tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) - zmortp2 * zfactn
+         tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) - zmortp2 * zfactp
+         tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zmortp2 * zfactch
+         tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zmortp2 * zfactfe
+         tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zmortp2 * zfactsi
+         tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zmortp2 * zfactsi
+         tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zrespp2 
+         tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) + zrespp2 * zfactn
+         tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) + zrespp2 * zfactp
+         tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zrespp2 * zfactfe
+         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + ztortp2
+         tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + ztortp2 * zfactn
+         tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + ztortp2 * zfactp
+         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ztortp2 * zfactfe
+         prodpoc(ji,jj,jk)   = prodpoc(ji,jj,jk) + ztortp2
+         prodgoc(ji,jj,jk)   = prodgoc(ji,jj,jk) + zrespp2
+      END_3D
+      !
+      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
          WRITE(charout, FMT="('diat')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
       ENDIF
       !
@@ -286,9 +280,7 @@
       !!----------------------------------------------------------------------
 
-      REWIND( numnatp_ref )              ! Namelist nampismort in reference namelist : Pisces phytoplankton
       READ  ( numnatp_ref, namp5zmort, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp5zmort in reference namelist' )
 
-      REWIND( numnatp_cfg )              ! Namelist nampismort in configuration namelist : Pisces phytoplankton
       READ  ( numnatp_cfg, namp5zmort, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namp5zmort in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p5zprod.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p5zprod.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P4Z/p5zprod.F90	(revision 12928)
@@ -50,4 +50,6 @@
    REAL(wp) :: texcretd               !: 1 - excret2        
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -57,5 +59,5 @@
 CONTAINS
 
-   SUBROUTINE p5z_prod( kt , knt )
+   SUBROUTINE p5z_prod( kt , knt, Kbb, Kmm, Krhs )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p5z_prod  ***
@@ -68,4 +70,5 @@
       !
       INTEGER, INTENT(in) :: kt, knt
+      INTEGER, INTENT(in) :: Kbb, Kmm, Krhs      ! time level indices
       !
       INTEGER  ::   ji, jj, jk
@@ -94,6 +97,4 @@
       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmxl_fac, zmxl_chl
       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpligprod1, zpligprod2
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:  ) :: zw2d
       !!---------------------------------------------------------------------
       !
@@ -101,4 +102,5 @@
       !
       zprorcan(:,:,:) = 0._wp ; zprorcap(:,:,:) = 0._wp ; zprorcad(:,:,:) = 0._wp
+      zcroissn(:,:,:) = 0._wp ; zcroissp(:,:,:) = 0._wp ; zcroissd(:,:,:) = 0._wp
       zprofed (:,:,:) = 0._wp ; zprofep (:,:,:) = 0._wp ; zprofen (:,:,:) = 0._wp
       zpronewn(:,:,:) = 0._wp ; zpronewp(:,:,:) = 0._wp ; zpronewd(:,:,:) = 0._wp
@@ -107,5 +109,5 @@
       zprdia  (:,:,:) = 0._wp ; zprpic  (:,:,:) = 0._wp ; zprbio  (:,:,:) = 0._wp
       zprodopn(:,:,:) = 0._wp ; zprodopp(:,:,:) = 0._wp ; zprodopd(:,:,:) = 0._wp
-      zysopt  (:,:,:) = 0._wp
+      zysopt  (:,:,:) = 0._wp 
       zrespn  (:,:,:) = 0._wp ; zrespp  (:,:,:) = 0._wp ; zrespd  (:,:,:) = 0._wp 
 
@@ -122,27 +124,21 @@
       ! day length in hours
       zstrn(:,:) = 0.
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad )
-            zargu = MAX( -1., MIN(  1., zargu ) )
-            zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. )
-         END DO
-      END DO
+      DO_2D_11_11
+         zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad )
+         zargu = MAX( -1., MIN(  1., zargu ) )
+         zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. )
+      END_2D
 
          ! Impact of the day duration on phytoplankton growth
-      DO jk = 1, jpkm1
-         DO jj = 1 ,jpj
-            DO ji = 1, jpi
-               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
-                  zval = MAX( 1., zstrn(ji,jj) )
-                  IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
-                     zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn ))
-                  ENDIF
-                  zmxl_chl(ji,jj,jk) = zval / 24.
-                  zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval )
-               ENDIF
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpkm1 )
+         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+            zval = MAX( 1., zstrn(ji,jj) )
+            IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN
+               zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn ))
+            ENDIF
+            zmxl_chl(ji,jj,jk) = zval / 24.
+            zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval )
+         ENDIF
+      END_3D
 
       zprbio(:,:,:) = zprmaxn(:,:,:) * zmxl_fac(:,:,:)
@@ -155,305 +151,269 @@
       WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24.
 
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
-                  ! Computation of the P-I slope for nanos and diatoms
-                  ztn         = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. )
-                  zadap       = xadap * ztn / ( 2.+ ztn )
-                  !
-                  zpislopeadn(ji,jj,jk) = pislopen * trb(ji,jj,jk,jpnch)    &
-                  &                       /( trb(ji,jj,jk,jpphy) * 12. + rtrn)
-                  zpislopeadp(ji,jj,jk) = pislopep * ( 1. + zadap * EXP( -0.25 * epico(ji,jj,jk) ) )   &
-                  &                       * trb(ji,jj,jk,jppch) /( trb(ji,jj,jk,jppic) * 12. + rtrn)
-                  zpislopeadd(ji,jj,jk) = pisloped * trb(ji,jj,jk,jpdch)    &
-                     &                    /( trb(ji,jj,jk,jpdia) * 12. + rtrn)
-                  !
-                  zpislopen = zpislopeadn(ji,jj,jk) / ( zprbio(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn )
-                  zpislopep = zpislopeadp(ji,jj,jk) / ( zprpic(ji,jj,jk) * rday * xlimpic(ji,jj,jk) + rtrn )
-                  zpisloped = zpislopeadd(ji,jj,jk) / ( zprdia(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn )
-
-                  ! Computation of production function for Carbon
-                  !  ---------------------------------------------
-                  zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) )  )
-                  zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1.- EXP( -zpislopep * epico(ji,jj,jk) )  )
-                  zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) )  )
-
-                  ! Computation of production function for Chlorophyll
-                  !  -------------------------------------------------
-                  zpislopen = zpislopen * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
-                  zpisloped = zpisloped * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
-                  zpislopep = zpislopep * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
-                  zprchln(ji,jj,jk) = zprmaxn(ji,jj,jk) * ( 1.- EXP( -zpislopen * enanom(ji,jj,jk) )  )
-                  zprchlp(ji,jj,jk) = zprmaxp(ji,jj,jk) * ( 1.- EXP( -zpislopep * epicom(ji,jj,jk) )  )
-                  zprchld(ji,jj,jk) = zprmaxd(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediatm(ji,jj,jk) )  )
-               ENDIF
-            END DO
-         END DO
-      END DO
-
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-
-                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
-                  !    Si/C of diatoms
-                  !    ------------------------
-                  !    Si/C increases with iron stress and silicate availability
-                  !    Si/C is arbitrariliy increased for very high Si concentrations
-                  !    to mimic the very high ratios observed in the Southern Ocean (silpot2)
-                  zlim  = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi1 )
-                  zsilim = MIN( zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) )
-                  zsilfac = 3.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) )  ) + 1.e0
-                  zsiborn = trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil)
-                  IF (gphit(ji,jj) < -30 ) THEN
-                    zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 )
-                  ELSE
-                    zsilfac2 = 1. +      zsiborn / ( zsiborn + xksi2**3 )
-                  ENDIF
-                  zysopt(ji,jj,jk) = grosip * zlim * zsilfac * zsilfac2
-              ENDIF
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpkm1 )
+         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+            ! Computation of the P-I slope for nanos and diatoms
+            ztn         = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) - 15. )
+            zadap       = xadap * ztn / ( 2.+ ztn )
+            !
+            zpislopeadn(ji,jj,jk) = pislopen * tr(ji,jj,jk,jpnch,Kbb)    &
+            &                       /( tr(ji,jj,jk,jpphy,Kbb) * 12. + rtrn)
+            zpislopeadp(ji,jj,jk) = pislopep * ( 1. + zadap * EXP( -0.25 * epico(ji,jj,jk) ) )   &
+            &                       * tr(ji,jj,jk,jppch,Kbb) /( tr(ji,jj,jk,jppic,Kbb) * 12. + rtrn)
+            zpislopeadd(ji,jj,jk) = pisloped * tr(ji,jj,jk,jpdch,Kbb)    &
+               &                    /( tr(ji,jj,jk,jpdia,Kbb) * 12. + rtrn)
+            !
+            zpislopen = zpislopeadn(ji,jj,jk) / ( zprbio(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn )
+            zpislopep = zpislopeadp(ji,jj,jk) / ( zprpic(ji,jj,jk) * rday * xlimpic(ji,jj,jk) + rtrn )
+            zpisloped = zpislopeadd(ji,jj,jk) / ( zprdia(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn )
+
+            ! Computation of production function for Carbon
+            !  ---------------------------------------------
+            zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) )  )
+            zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1.- EXP( -zpislopep * epico(ji,jj,jk) )  )
+            zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) )  )
+
+            ! Computation of production function for Chlorophyll
+            !  -------------------------------------------------
+            zpislopen = zpislopen * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
+            zpisloped = zpisloped * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
+            zpislopep = zpislopep * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
+            zprchln(ji,jj,jk) = zprmaxn(ji,jj,jk) * ( 1.- EXP( -zpislopen * enanom(ji,jj,jk) )  )
+            zprchlp(ji,jj,jk) = zprmaxp(ji,jj,jk) * ( 1.- EXP( -zpislopep * epicom(ji,jj,jk) )  )
+            zprchld(ji,jj,jk) = zprmaxd(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediatm(ji,jj,jk) )  )
+         ENDIF
+      END_3D
+
+      DO_3D_11_11( 1, jpkm1 )
+
+          IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+            !    Si/C of diatoms
+            !    ------------------------
+            !    Si/C increases with iron stress and silicate availability
+            !    Si/C is arbitrariliy increased for very high Si concentrations
+            !    to mimic the very high ratios observed in the Southern Ocean (silpot2)
+            zlim  = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi1 )
+            zsilim = MIN( zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) )
+            zsilfac = 3.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) )  ) + 1.e0
+            zsiborn = tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb)
+            IF (gphit(ji,jj) < -30 ) THEN
+              zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 )
+            ELSE
+              zsilfac2 = 1. +      zsiborn / ( zsiborn + xksi2**3 )
+            ENDIF
+            zysopt(ji,jj,jk) = grosip * zlim * zsilfac * zsilfac2
+        ENDIF
+      END_3D
 
       !  Sea-ice effect on production                                                                               
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zprbio(ji,jj,jk)  = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
-               zprpic(ji,jj,jk)  = zprpic(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
-               zprdia(ji,jj,jk)  = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
-               zprnut(ji,jj,jk)  = zprnut(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpkm1 )
+         zprbio(ji,jj,jk)  = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
+         zprpic(ji,jj,jk)  = zprpic(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
+         zprdia(ji,jj,jk)  = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
+         zprnut(ji,jj,jk)  = zprnut(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
+      END_3D
 
       ! Computation of the various production terms of nanophytoplankton 
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
-                  !  production terms for nanophyto.
-                  zprorcan(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * trb(ji,jj,jk,jpphy) * rfact2
-                  !
-                  zration = trb(ji,jj,jk,jpnph) / ( trb(ji,jj,jk,jpphy) + rtrn )
-                  zratiop = trb(ji,jj,jk,jppph) / ( trb(ji,jj,jk,jpphy) + rtrn )
-                  zratiof = trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn )
-                  zprnutmax = zprnut(ji,jj,jk) * fvnuptk(ji,jj,jk) / rno3 * trb(ji,jj,jk,jpphy) * rfact2
-                  ! Uptake of nitrogen
-                  zrat = MIN( 1., zration / (xqnnmax(ji,jj,jk) + rtrn) ) 
-                  zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
-                  zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpnmin(ji,jj,jk) )   &
-                  &          / ( xqpnmax(ji,jj,jk) - xqpnmin(ji,jj,jk) + rtrn ), xlimnfe(ji,jj,jk) ) )
-                  zpronewn(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xnanono3(ji,jj,jk)
-                  zproregn(ji,jj,jk) = zpronmax * xnanonh4(ji,jj,jk)
-                  ! Uptake of phosphorus
-                  zrat = MIN( 1., zratiop / (xqpnmax(ji,jj,jk) + rtrn) )
-                  zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
-                  zpropmax = zprnutmax * zmax * xlimnfe(ji,jj,jk)
-                  zpropo4n(ji,jj,jk) = zpropmax * xnanopo4(ji,jj,jk)
-                  zprodopn(ji,jj,jk) = zpropmax * xnanodop(ji,jj,jk)
-                  ! Uptake of iron
-                  zrat = MIN( 1., zratiof / qfnmax )
-                  zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
-                  zprofmax = zprnutmax * qfnmax * zmax
-                  zprofen(ji,jj,jk) = zprofmax * xnanofer(ji,jj,jk) * ( 3. - 2.4 * xlimnfe(ji,jj,jk)    &
-                  &          / ( xlimnfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xnanono3(ji,jj,jk) / ( rtrn  &
-                  &          + xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) ) * (1. - xnanofer(ji,jj,jk) ) )
-               ENDIF
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpkm1 )
+         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+            !  production terms for nanophyto.
+            zprorcan(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * tr(ji,jj,jk,jpphy,Kbb) * rfact2
+            !
+            zration = tr(ji,jj,jk,jpnph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn )
+            zratiop = tr(ji,jj,jk,jppph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn )
+            zratiof = tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn )
+            zprnutmax = zprnut(ji,jj,jk) * fvnuptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jpphy,Kbb) * rfact2
+            ! Uptake of nitrogen
+            zrat = MIN( 1., zration / (xqnnmax(ji,jj,jk) + rtrn) ) 
+            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
+            zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpnmin(ji,jj,jk) )   &
+            &          / ( xqpnmax(ji,jj,jk) - xqpnmin(ji,jj,jk) + rtrn ), xlimnfe(ji,jj,jk) ) )
+            zpronewn(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xnanono3(ji,jj,jk)
+            zproregn(ji,jj,jk) = zpronmax * xnanonh4(ji,jj,jk)
+            ! Uptake of phosphorus
+            zrat = MIN( 1., zratiop / (xqpnmax(ji,jj,jk) + rtrn) )
+            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
+            zpropmax = zprnutmax * zmax * xlimnfe(ji,jj,jk)
+            zpropo4n(ji,jj,jk) = zpropmax * xnanopo4(ji,jj,jk)
+            zprodopn(ji,jj,jk) = zpropmax * xnanodop(ji,jj,jk)
+            ! Uptake of iron
+            zrat = MIN( 1., zratiof / qfnmax )
+            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
+            zprofmax = zprnutmax * qfnmax * zmax
+            zprofen(ji,jj,jk) = zprofmax * xnanofer(ji,jj,jk) * ( 3. - 2.4 * xlimnfe(ji,jj,jk)    &
+            &          / ( xlimnfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xnanono3(ji,jj,jk) / ( rtrn  &
+            &          + xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) ) * (1. - xnanofer(ji,jj,jk) ) )
+         ENDIF
+      END_3D
 
       ! Computation of the various production terms of picophytoplankton 
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
-                  !  production terms for picophyto.
-                  zprorcap(ji,jj,jk) = zprpic(ji,jj,jk)  * xlimpic(ji,jj,jk) * trb(ji,jj,jk,jppic) * rfact2
-                  !
-                  zration = trb(ji,jj,jk,jpnpi) / ( trb(ji,jj,jk,jppic) + rtrn )
-                  zratiop = trb(ji,jj,jk,jpppi) / ( trb(ji,jj,jk,jppic) + rtrn )
-                  zratiof = trb(ji,jj,jk,jppfe) / ( trb(ji,jj,jk,jppic) + rtrn )
-                  zprnutmax = zprnut(ji,jj,jk) * fvpuptk(ji,jj,jk) / rno3 * trb(ji,jj,jk,jppic) * rfact2
-                  ! Uptake of nitrogen
-                  zrat = MIN( 1., zration / (xqnpmax(ji,jj,jk) + rtrn) )
-                  zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
-                  zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqppmin(ji,jj,jk) )   &
-                  &          / ( xqppmax(ji,jj,jk) - xqppmin(ji,jj,jk) + rtrn ), xlimpfe(ji,jj,jk) ) )
-                  zpronewp(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xpicono3(ji,jj,jk) 
-                  zproregp(ji,jj,jk) = zpronmax * xpiconh4(ji,jj,jk)
-                  ! Uptake of phosphorus
-                  zrat = MIN( 1., zratiop / (xqppmax(ji,jj,jk) + rtrn) )
-                  zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
-                  zpropmax = zprnutmax * zmax * xlimpfe(ji,jj,jk)
-                  zpropo4p(ji,jj,jk) = zpropmax * xpicopo4(ji,jj,jk)
-                  zprodopp(ji,jj,jk) = zpropmax * xpicodop(ji,jj,jk)
-                  ! Uptake of iron
-                  zrat = MIN( 1., zratiof / qfpmax )
-                  zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
-                  zprofmax = zprnutmax * qfpmax * zmax
-                  zprofep(ji,jj,jk) = zprofmax * xpicofer(ji,jj,jk) * ( 3. - 2.4 * xlimpfe(ji,jj,jk)   &
-                  &          / ( xlimpfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xpicono3(ji,jj,jk) / ( rtrn   &
-                  &          + xpicono3(ji,jj,jk) + xpiconh4(ji,jj,jk) ) * (1. - xpicofer(ji,jj,jk) ) )
-               ENDIF
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpkm1 )
+         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+            !  production terms for picophyto.
+            zprorcap(ji,jj,jk) = zprpic(ji,jj,jk)  * xlimpic(ji,jj,jk) * tr(ji,jj,jk,jppic,Kbb) * rfact2
+            !
+            zration = tr(ji,jj,jk,jpnpi,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn )
+            zratiop = tr(ji,jj,jk,jpppi,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn )
+            zratiof = tr(ji,jj,jk,jppfe,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn )
+            zprnutmax = zprnut(ji,jj,jk) * fvpuptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jppic,Kbb) * rfact2
+            ! Uptake of nitrogen
+            zrat = MIN( 1., zration / (xqnpmax(ji,jj,jk) + rtrn) )
+            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
+            zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqppmin(ji,jj,jk) )   &
+            &          / ( xqppmax(ji,jj,jk) - xqppmin(ji,jj,jk) + rtrn ), xlimpfe(ji,jj,jk) ) )
+            zpronewp(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xpicono3(ji,jj,jk) 
+            zproregp(ji,jj,jk) = zpronmax * xpiconh4(ji,jj,jk)
+            ! Uptake of phosphorus
+            zrat = MIN( 1., zratiop / (xqppmax(ji,jj,jk) + rtrn) )
+            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
+            zpropmax = zprnutmax * zmax * xlimpfe(ji,jj,jk)
+            zpropo4p(ji,jj,jk) = zpropmax * xpicopo4(ji,jj,jk)
+            zprodopp(ji,jj,jk) = zpropmax * xpicodop(ji,jj,jk)
+            ! Uptake of iron
+            zrat = MIN( 1., zratiof / qfpmax )
+            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
+            zprofmax = zprnutmax * qfpmax * zmax
+            zprofep(ji,jj,jk) = zprofmax * xpicofer(ji,jj,jk) * ( 3. - 2.4 * xlimpfe(ji,jj,jk)   &
+            &          / ( xlimpfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xpicono3(ji,jj,jk) / ( rtrn   &
+            &          + xpicono3(ji,jj,jk) + xpiconh4(ji,jj,jk) ) * (1. - xpicofer(ji,jj,jk) ) )
+         ENDIF
+      END_3D
 
       ! Computation of the various production terms of diatoms
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
-                  !  production terms for diatomees
-                  zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trb(ji,jj,jk,jpdia) * rfact2
-                  ! Computation of the respiration term according to pahlow 
-                  ! & oschlies (2013)
-                  !
-                  zration = trb(ji,jj,jk,jpndi) / ( trb(ji,jj,jk,jpdia) + rtrn )
-                  zratiop = trb(ji,jj,jk,jppdi) / ( trb(ji,jj,jk,jpdia) + rtrn )
-                  zratiof = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn )
-                  zprnutmax = zprnut(ji,jj,jk) * fvduptk(ji,jj,jk) / rno3 * trb(ji,jj,jk,jpdia) * rfact2
-                  ! Uptake of nitrogen
-                  zrat = MIN( 1., zration / (xqndmax(ji,jj,jk) + rtrn) )
-                  zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
-                  zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpdmin(ji,jj,jk) )   &
-                  &          / ( xqpdmax(ji,jj,jk) - xqpdmin(ji,jj,jk) + rtrn ), xlimdfe(ji,jj,jk) ) )
-                  zpronewd(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xdiatno3(ji,jj,jk)
-                  zproregd(ji,jj,jk) = zpronmax * xdiatnh4(ji,jj,jk)
-                  ! Uptake of phosphorus
-                  zrat = MIN( 1., zratiop / (xqpdmax(ji,jj,jk) + rtrn) )
-                  zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
-                  zpropmax = zprnutmax * zmax * xlimdfe(ji,jj,jk)
-                  zpropo4d(ji,jj,jk) = zpropmax * xdiatpo4(ji,jj,jk)
-                  zprodopd(ji,jj,jk) = zpropmax * xdiatdop(ji,jj,jk)
-                  ! Uptake of iron
-                  zrat = MIN( 1., zratiof / qfdmax )
-                  zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
-                  zprofmax = zprnutmax * qfdmax * zmax
-                  zprofed(ji,jj,jk) = zprofmax * xdiatfer(ji,jj,jk) * ( 3. - 2.4 * xlimdfe(ji,jj,jk)     &
-                  &          / ( xlimdfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xdiatno3(ji,jj,jk) / ( rtrn   &
-                  &          + xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) ) * (1. - xdiatfer(ji,jj,jk) ) )
-               ENDIF
-            END DO
-         END DO
-      END DO
-
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
-                     !  production terms for nanophyto. ( chlorophyll )
-                  znanotot = enanom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
-                  zprod = rday * (zpronewn(ji,jj,jk) + zproregn(ji,jj,jk)) * zprchln(ji,jj,jk) * xlimphy(ji,jj,jk)
-                  thetannm_n   = MIN ( thetannm, ( thetannm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem)))   &
-                  &               * (1. - 1.14 / 43.4 * 20.))
-                  zprochln = thetannm_n * zprod / ( zpislopeadn(ji,jj,jk) * znanotot + rtrn )
-                  zprochln = MAX(zprochln, chlcmin * 12. * zprorcan (ji,jj,jk) )
-                     !  production terms for picophyto. ( chlorophyll )
-                  zpicotot = epicom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
-                  zprod = rday * (zpronewp(ji,jj,jk) + zproregp(ji,jj,jk)) * zprchlp(ji,jj,jk) * xlimpic(ji,jj,jk)
-                  thetanpm_n   = MIN ( thetanpm, ( thetanpm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem)))   &
-                  &               * (1. - 1.14 / 43.4 * 20.))
-                  zprochlp = thetanpm_n * zprod / ( zpislopeadp(ji,jj,jk) * zpicotot + rtrn )
-                  zprochlp = MAX(zprochlp, chlcmin * 12. * zprorcap(ji,jj,jk) )
-                  !  production terms for diatomees ( chlorophyll )
-                  zdiattot = ediatm(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
-                  zprod = rday * (zpronewd(ji,jj,jk) + zproregd(ji,jj,jk)) * zprchld(ji,jj,jk) * xlimdia(ji,jj,jk)
-                  thetandm_n   = MIN ( thetandm, ( thetandm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem)))   &
-                  &               * (1. - 1.14 / 43.4 * 20.))
-                  zprochld = thetandm_n * zprod / ( zpislopeadd(ji,jj,jk) * zdiattot + rtrn )
-                  zprochld = MAX(zprochld, chlcmin * 12. * zprorcad(ji,jj,jk) )
-                  !   Update the arrays TRA which contain the Chla sources and sinks
-                  tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln * texcretn
-                  tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld * texcretd
-                  tra(ji,jj,jk,jppch) = tra(ji,jj,jk,jppch) + zprochlp * texcretp
-               ENDIF
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpkm1 )
+         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+            !  production terms for diatomees
+            zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * tr(ji,jj,jk,jpdia,Kbb) * rfact2
+            ! Computation of the respiration term according to pahlow 
+            ! & oschlies (2013)
+            !
+            zration = tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
+            zratiop = tr(ji,jj,jk,jppdi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
+            zratiof = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
+            zprnutmax = zprnut(ji,jj,jk) * fvduptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jpdia,Kbb) * rfact2
+            ! Uptake of nitrogen
+            zrat = MIN( 1., zration / (xqndmax(ji,jj,jk) + rtrn) )
+            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
+            zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpdmin(ji,jj,jk) )   &
+            &          / ( xqpdmax(ji,jj,jk) - xqpdmin(ji,jj,jk) + rtrn ), xlimdfe(ji,jj,jk) ) )
+            zpronewd(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xdiatno3(ji,jj,jk)
+            zproregd(ji,jj,jk) = zpronmax * xdiatnh4(ji,jj,jk)
+            ! Uptake of phosphorus
+            zrat = MIN( 1., zratiop / (xqpdmax(ji,jj,jk) + rtrn) )
+            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
+            zpropmax = zprnutmax * zmax * xlimdfe(ji,jj,jk)
+            zpropo4d(ji,jj,jk) = zpropmax * xdiatpo4(ji,jj,jk)
+            zprodopd(ji,jj,jk) = zpropmax * xdiatdop(ji,jj,jk)
+            ! Uptake of iron
+            zrat = MIN( 1., zratiof / qfdmax )
+            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
+            zprofmax = zprnutmax * qfdmax * zmax
+            zprofed(ji,jj,jk) = zprofmax * xdiatfer(ji,jj,jk) * ( 3. - 2.4 * xlimdfe(ji,jj,jk)     &
+            &          / ( xlimdfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xdiatno3(ji,jj,jk) / ( rtrn   &
+            &          + xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) ) * (1. - xdiatfer(ji,jj,jk) ) )
+         ENDIF
+      END_3D
+
+      DO_3D_11_11( 1, jpkm1 )
+         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+               !  production terms for nanophyto. ( chlorophyll )
+            znanotot = enanom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
+            zprod = rday * (zpronewn(ji,jj,jk) + zproregn(ji,jj,jk)) * zprchln(ji,jj,jk) * xlimphy(ji,jj,jk)
+            thetannm_n   = MIN ( thetannm, ( thetannm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm)))   &
+            &               * (1. - 1.14 / 43.4 * 20.))
+            zprochln = thetannm_n * zprod / ( zpislopeadn(ji,jj,jk) * znanotot + rtrn )
+            zprochln = MAX(zprochln, chlcmin * 12. * zprorcan (ji,jj,jk) )
+               !  production terms for picophyto. ( chlorophyll )
+            zpicotot = epicom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
+            zprod = rday * (zpronewp(ji,jj,jk) + zproregp(ji,jj,jk)) * zprchlp(ji,jj,jk) * xlimpic(ji,jj,jk)
+            thetanpm_n   = MIN ( thetanpm, ( thetanpm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm)))   &
+            &               * (1. - 1.14 / 43.4 * 20.))
+            zprochlp = thetanpm_n * zprod / ( zpislopeadp(ji,jj,jk) * zpicotot + rtrn )
+            zprochlp = MAX(zprochlp, chlcmin * 12. * zprorcap(ji,jj,jk) )
+            !  production terms for diatomees ( chlorophyll )
+            zdiattot = ediatm(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
+            zprod = rday * (zpronewd(ji,jj,jk) + zproregd(ji,jj,jk)) * zprchld(ji,jj,jk) * xlimdia(ji,jj,jk)
+            thetandm_n   = MIN ( thetandm, ( thetandm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm)))   &
+            &               * (1. - 1.14 / 43.4 * 20.))
+            zprochld = thetandm_n * zprod / ( zpislopeadd(ji,jj,jk) * zdiattot + rtrn )
+            zprochld = MAX(zprochld, chlcmin * 12. * zprorcad(ji,jj,jk) )
+            !   Update the arrays TRA which contain the Chla sources and sinks
+            tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) + zprochln * texcretn
+            tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) + zprochld * texcretd
+            tr(ji,jj,jk,jppch,Krhs) = tr(ji,jj,jk,jppch,Krhs) + zprochlp * texcretp
+         ENDIF
+      END_3D
 
       !   Update the arrays TRA which contain the biological sources and sinks
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-           DO ji =1 ,jpi
-              zprontot = zpronewn(ji,jj,jk) + zproregn(ji,jj,jk)
-              zproptot = zpronewp(ji,jj,jk) + zproregp(ji,jj,jk)
-              zprodtot = zpronewd(ji,jj,jk) + zproregd(ji,jj,jk)
-              zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)  &
-              &          + excretp * zprorcap(ji,jj,jk)
-              tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zpropo4n(ji,jj,jk) - zpropo4d(ji,jj,jk)  &
-              &                     - zpropo4p(ji,jj,jk)
-              tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk)  &
-              &                     - zpronewp(ji,jj,jk)
-              tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproregn(ji,jj,jk) - zproregd(ji,jj,jk)  &
-              &                     - zproregp(ji,jj,jk)
-              tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorcan(ji,jj,jk) * texcretn    &
-                 &                  - zpsino3 * zpronewn(ji,jj,jk) - zpsinh4 * zproregn(ji,jj,jk)   &
-                 &                  - zrespn(ji,jj,jk) 
-              zcroissn(ji,jj,jk) = tra(ji,jj,jk,jpphy) / rfact2/ (trb(ji,jj,jk,jpphy) + rtrn)
-              tra(ji,jj,jk,jpnph) = tra(ji,jj,jk,jpnph) + zprontot * texcretn
-              tra(ji,jj,jk,jppph) = tra(ji,jj,jk,jppph) + zpropo4n(ji,jj,jk) * texcretn   &
-              &                     + zprodopn(ji,jj,jk) * texcretn
-              tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcretn
-              tra(ji,jj,jk,jppic) = tra(ji,jj,jk,jppic) + zprorcap(ji,jj,jk) * texcretp     &
-                 &                  - zpsino3 * zpronewp(ji,jj,jk) - zpsinh4 * zproregp(ji,jj,jk)   &
-                 &                  - zrespp(ji,jj,jk) 
-              zcroissp(ji,jj,jk) = tra(ji,jj,jk,jppic) / rfact2/ (trb(ji,jj,jk,jppic) + rtrn)
-              tra(ji,jj,jk,jpnpi) = tra(ji,jj,jk,jpnpi) + zproptot * texcretp
-              tra(ji,jj,jk,jpppi) = tra(ji,jj,jk,jpppi) + zpropo4p(ji,jj,jk) * texcretp   &
-              &                     + zprodopp(ji,jj,jk) * texcretp
-              tra(ji,jj,jk,jppfe) = tra(ji,jj,jk,jppfe) + zprofep(ji,jj,jk) * texcretp
-              tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcretd   &
-                 &                  - zpsino3 * zpronewd(ji,jj,jk) - zpsinh4 * zproregd(ji,jj,jk)   &
-                 &                  - zrespd(ji,jj,jk) 
-              zcroissd(ji,jj,jk) = tra(ji,jj,jk,jpdia) / rfact2 / (trb(ji,jj,jk,jpdia) + rtrn)
-              tra(ji,jj,jk,jpndi) = tra(ji,jj,jk,jpndi) + zprodtot * texcretd
-              tra(ji,jj,jk,jppdi) = tra(ji,jj,jk,jppdi) + zpropo4d(ji,jj,jk) * texcretd   &
-              &                     + zprodopd(ji,jj,jk) * texcretd
-              tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcretd
-              tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd
-              tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)  &
-              &                     + excretp * zprorcap(ji,jj,jk)
-              tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + excretd * zprodtot + excretn * zprontot   &
-              &                     + excretp * zproptot
-              tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + excretd * zpropo4d(ji,jj,jk) + excretn * zpropo4n(ji,jj,jk)   &
-              &    - texcretn * zprodopn(ji,jj,jk) - texcretd * zprodopd(ji,jj,jk) + excretp * zpropo4p(ji,jj,jk)     &
-              &    - texcretp * zprodopp(ji,jj,jk)
-              tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk)   &
-                 &                + zproregp(ji,jj,jk) ) + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk)           &
-                 &                + zpronewd(ji,jj,jk) + zpronewp(ji,jj,jk) )   &
-                 &                - o2ut * ( zrespn(ji,jj,jk) + zrespp(ji,jj,jk) + zrespd(ji,jj,jk) )
-              zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk)
-              tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zfeup
-              tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk)
-              tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) - zprorcap(ji,jj,jk)  &
-              &                     + zpsino3 * zpronewn(ji,jj,jk) + zpsinh4 * zproregn(ji,jj,jk)   &
-              &                     + zpsino3 * zpronewp(ji,jj,jk) + zpsinh4 * zproregp(ji,jj,jk)   &
-              &                     + zpsino3 * zpronewd(ji,jj,jk) + zpsinh4 * zproregd(ji,jj,jk)  &
-              &                     + zrespn(ji,jj,jk) + zrespd(ji,jj,jk) + zrespp(ji,jj,jk) 
-              tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk)  &
-              &                     + zpronewp(ji,jj,jk) ) - rno3 * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk)     &
-              &                     + zproregp(ji,jj,jk) ) 
-          END DO
-        END DO
-     END DO
+      DO_3D_11_11( 1, jpkm1 )
+        zprontot = zpronewn(ji,jj,jk) + zproregn(ji,jj,jk)
+        zproptot = zpronewp(ji,jj,jk) + zproregp(ji,jj,jk)
+        zprodtot = zpronewd(ji,jj,jk) + zproregd(ji,jj,jk)
+        zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)  &
+        &          + excretp * zprorcap(ji,jj,jk)
+        tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zpropo4n(ji,jj,jk) - zpropo4d(ji,jj,jk)  &
+        &                     - zpropo4p(ji,jj,jk)
+        tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk)  &
+        &                     - zpronewp(ji,jj,jk)
+        tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zproregn(ji,jj,jk) - zproregd(ji,jj,jk)  &
+        &                     - zproregp(ji,jj,jk)
+        tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zprorcan(ji,jj,jk) * texcretn    &
+           &                  - zpsino3 * zpronewn(ji,jj,jk) - zpsinh4 * zproregn(ji,jj,jk)   &
+           &                  - zrespn(ji,jj,jk) 
+        zcroissn(ji,jj,jk) = tr(ji,jj,jk,jpphy,Krhs) / rfact2/ (tr(ji,jj,jk,jpphy,Kbb) + rtrn)
+        tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) + zprontot * texcretn
+        tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) + zpropo4n(ji,jj,jk) * texcretn   &
+        &                     + zprodopn(ji,jj,jk) * texcretn
+        tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) + zprofen(ji,jj,jk) * texcretn
+        tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) + zprorcap(ji,jj,jk) * texcretp     &
+           &                  - zpsino3 * zpronewp(ji,jj,jk) - zpsinh4 * zproregp(ji,jj,jk)   &
+           &                  - zrespp(ji,jj,jk) 
+        zcroissp(ji,jj,jk) = tr(ji,jj,jk,jppic,Krhs) / rfact2/ (tr(ji,jj,jk,jppic,Kbb) + rtrn)
+        tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) + zproptot * texcretp
+        tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) + zpropo4p(ji,jj,jk) * texcretp   &
+        &                     + zprodopp(ji,jj,jk) * texcretp
+        tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) + zprofep(ji,jj,jk) * texcretp
+        tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) + zprorcad(ji,jj,jk) * texcretd   &
+           &                  - zpsino3 * zpronewd(ji,jj,jk) - zpsinh4 * zproregd(ji,jj,jk)   &
+           &                  - zrespd(ji,jj,jk) 
+        zcroissd(ji,jj,jk) = tr(ji,jj,jk,jpdia,Krhs) / rfact2 / (tr(ji,jj,jk,jpdia,Kbb) + rtrn)
+        tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) + zprodtot * texcretd
+        tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) + zpropo4d(ji,jj,jk) * texcretd   &
+        &                     + zprodopd(ji,jj,jk) * texcretd
+        tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) + zprofed(ji,jj,jk) * texcretd
+        tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd
+        tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)  &
+        &                     + excretp * zprorcap(ji,jj,jk)
+        tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + excretd * zprodtot + excretn * zprontot   &
+        &                     + excretp * zproptot
+        tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + excretd * zpropo4d(ji,jj,jk) + excretn * zpropo4n(ji,jj,jk)   &
+        &    - texcretn * zprodopn(ji,jj,jk) - texcretd * zprodopd(ji,jj,jk) + excretp * zpropo4p(ji,jj,jk)     &
+        &    - texcretp * zprodopp(ji,jj,jk)
+        tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + o2ut * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk)   &
+           &                + zproregp(ji,jj,jk) ) + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk)           &
+           &                + zpronewd(ji,jj,jk) + zpronewp(ji,jj,jk) )   &
+           &                - o2ut * ( zrespn(ji,jj,jk) + zrespp(ji,jj,jk) + zrespd(ji,jj,jk) )
+        zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk)
+        tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zfeup
+        tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk)
+        tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) - zprorcap(ji,jj,jk)  &
+        &                     + zpsino3 * zpronewn(ji,jj,jk) + zpsinh4 * zproregn(ji,jj,jk)   &
+        &                     + zpsino3 * zpronewp(ji,jj,jk) + zpsinh4 * zproregp(ji,jj,jk)   &
+        &                     + zpsino3 * zpronewd(ji,jj,jk) + zpsinh4 * zproregd(ji,jj,jk)  &
+        &                     + zrespn(ji,jj,jk) + zrespd(ji,jj,jk) + zrespp(ji,jj,jk) 
+        tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk)  &
+        &                     + zpronewp(ji,jj,jk) ) - rno3 * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk)     &
+        &                     + zproregp(ji,jj,jk) ) 
+      END_3D
      !
      IF( ln_ligand ) THEN
-         zpligprod1(:,:,:) = 0._wp    ;    zpligprod2(:,:,:) = 0._wp
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-              DO ji =1 ,jpi
-                 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) + excretp * zprorcap(ji,jj,jk)
-                 zfeup    = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk)
-                 tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet
-                 zpligprod1(ji,jj,jk) = zdocprod * ldocp
-                 zpligprod2(ji,jj,jk) = zfeup * plig(ji,jj,jk) * lthet
-              END DO
-           END DO
-        END DO
+         zpligprod1(:,:,:) = 0._wp    ;    zpligprod2(:,:,:) = 0._wp             
+         DO_3D_11_11( 1, jpkm1 )
+           zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) + excretp * zprorcap(ji,jj,jk)
+           zfeup    = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk)
+           tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet
+           zpligprod1(ji,jj,jk) = zdocprod * ldocp
+           zpligprod2(ji,jj,jk) = zfeup * plig(ji,jj,jk) * lthet
+         END_3D
      ENDIF
 
@@ -465,97 +425,41 @@
       & tpp = glob_sum( 'p5zprod', ( zprorcan(:,:,:) + zprorcad(:,:,:) + zprorcap(:,:,:) ) * cvol(:,:,:) )
 
-    IF( lk_iomput ) THEN
-       IF( knt == nrdttrc ) THEN
-          ALLOCATE( zw2d(jpi,jpj), zw3d(jpi,jpj,jpk) )
-          zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s
-          !
-          IF( iom_use( "PPPHYN" ) .OR. iom_use( "PPPHYD" ) .OR. iom_use( "PPPHYP" ) )  THEN
-              zw3d(:,:,:) = zprorcan(:,:,:) * zfact * tmask(:,:,:)  ! primary production by nanophyto
-              CALL iom_put( "PPPHYN"  , zw3d )
-              !
-              zw3d(:,:,:) = zprorcap(:,:,:) * zfact * tmask(:,:,:)  ! primary production by picophyto
-              CALL iom_put( "PPPHYP"  , zw3d )
-              !
-              zw3d(:,:,:) = zprorcad(:,:,:) * zfact * tmask(:,:,:)  ! primary production by diatomes
-              CALL iom_put( "PPPHYD"  , zw3d )
-          ENDIF
-          IF( iom_use( "PPNEWN" ) .OR. iom_use( "PPNEWD" ) .OR. iom_use( "PPNEWP" ) )  THEN
-              zw3d(:,:,:) = zpronewn(:,:,:) * zfact * tmask(:,:,:)  ! new primary production by nanophyto
-              CALL iom_put( "PPNEWN"  , zw3d )
-              !
-              zw3d(:,:,:) = zpronewp(:,:,:) * zfact * tmask(:,:,:)  ! new primary production by picophyto
-              CALL iom_put( "PPNEWP"  , zw3d )
-              !
-              zw3d(:,:,:) = zpronewd(:,:,:) * zfact * tmask(:,:,:)  ! new primary production by diatomes
-              CALL iom_put( "PPNEWD"  , zw3d )
-          ENDIF
-          IF( iom_use( "PBSi" ) )  THEN
-              zw3d(:,:,:) = zprorcad(:,:,:) * zfact * tmask(:,:,:) * zysopt(:,:,:) ! biogenic silica production
-              CALL iom_put( "PBSi"  , zw3d )
-          ENDIF
-          IF( iom_use( "PFeN" ) .OR. iom_use( "PFeD" ) .OR. iom_use( "PFeP" ) )  THEN
-              zw3d(:,:,:) = zprofen(:,:,:) * zfact * tmask(:,:,:)  ! biogenic iron production by nanophyto
-              CALL iom_put( "PFeN"  , zw3d )
-              !
-              zw3d(:,:,:) = zprofep(:,:,:) * zfact * tmask(:,:,:)  ! biogenic iron production by picophyto
-              CALL iom_put( "PFeP"  , zw3d )
-              !
-              zw3d(:,:,:) = zprofed(:,:,:) * zfact * tmask(:,:,:)  ! biogenic iron production by  diatomes
-              CALL iom_put( "PFeD"  , zw3d )
-          ENDIF
-          IF( iom_use( "LPRODP" ) )  THEN
-              zw3d(:,:,:) = zpligprod1(:,:,:) * 1e9 * zfact * tmask(:,:,:)
-              CALL iom_put( "LPRODP"  , zw3d )
-          ENDIF
-          IF( iom_use( "LDETP" ) )  THEN
-              zw3d(:,:,:) = zpligprod2(:,:,:) * 1e9 * zfact * tmask(:,:,:)
-              CALL iom_put( "LDETP"  , zw3d )
-          ENDIF
-          IF( iom_use( "Mumax" ) )  THEN
-              zw3d(:,:,:) = zprmaxn(:,:,:) * tmask(:,:,:)   ! Maximum growth rate
-              CALL iom_put( "Mumax"  , zw3d )
-          ENDIF
-          IF( iom_use( "MuN" ) .OR. iom_use( "MuD" ) .OR. iom_use( "MuP" ) )  THEN
-              zw3d(:,:,:) = zprbio(:,:,:) * xlimphy(:,:,:) * tmask(:,:,:)  ! Realized growth rate for nanophyto
-              CALL iom_put( "MuN"  , zw3d )
-              !
-              zw3d(:,:,:) = zprpic(:,:,:) * xlimpic(:,:,:) * tmask(:,:,:)  ! Realized growth rate for picophyto
-              CALL iom_put( "MuP"  , zw3d )
-              !
-              zw3d(:,:,:) =  zprdia(:,:,:) * xlimdia(:,:,:) * tmask(:,:,:)  ! Realized growth rate for diatoms
-              CALL iom_put( "MuD"  , zw3d )
-          ENDIF
-          IF( iom_use( "LNlight" ) .OR. iom_use( "LDlight" ) .OR. iom_use( "LPlight" ) )  THEN
-              zw3d(:,:,:) = zprbio (:,:,:) / (zprmaxn(:,:,:) + rtrn) * tmask(:,:,:) ! light limitation term
-              CALL iom_put( "LNlight"  , zw3d )
-              !
-              zw3d(:,:,:) = zprpic (:,:,:) / (zprmaxp(:,:,:) + rtrn) * tmask(:,:,:) ! light limitation term
-              CALL iom_put( "LPlight"  , zw3d )
-              !
-              zw3d(:,:,:) =  zprdia (:,:,:) / (zprmaxd(:,:,:) + rtrn) * tmask(:,:,:)  ! light limitation term
-              CALL iom_put( "LDlight"  , zw3d )
-          ENDIF
-          IF( iom_use( "MunetN" ) .OR. iom_use( "MunetD" ) .OR. iom_use( "MunetP" ) )  THEN
-              zw3d(:,:,:) = zcroissn(:,:,:) * tmask(:,:,:) ! ! Realized growth rate for nanophyto
-              CALL iom_put( "MunetN"  , zw3d )
-              !
-              zw3d(:,:,:) = zcroissp(:,:,:) * tmask(:,:,:) ! ! Realized growth rate for picophyto
-              CALL iom_put( "MunetP"  , zw3d )
-              !
-              zw3d(:,:,:) = zcroissd(:,:,:) * tmask(:,:,:) ! ! Realized growth rate for diatomes
-              CALL iom_put( "MunetD"  , zw3d )
-              !
-          ENDIF
-
-          IF( iom_use( "tintpp" ) )  CALL iom_put( "tintpp" , tpp * zfact )  !  global total integrated primary production molC/s
-          !
-          DEALLOCATE( zw2d, zw3d )
+    IF( lk_iomput .AND.  knt == nrdttrc ) THEN
+       zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s
+       !
+       CALL iom_put( "PPPHYP"  , zprorcap(:,:,:) * zfact * tmask(:,:,:)   ) ! primary production by picophyto
+       CALL iom_put( "PPPHYN"  , zprorcan(:,:,:) * zfact * tmask(:,:,:) )  ! primary production by nanophyto
+       CALL iom_put( "PPPHYD"  , zprorcad(:,:,:) * zfact * tmask(:,:,:)   ) ! primary production by diatomes
+       CALL iom_put( "PPNEWN"  , zpronewp(:,:,:) * zfact * tmask(:,:,:)    ) ! new primary production by picophyto
+       CALL iom_put( "PPNEWN"  , zpronewn(:,:,:) * zfact * tmask(:,:,:)    ) ! new primary production by nanophyto
+       CALL iom_put( "PPNEWD"  , zpronewd(:,:,:) * zfact * tmask(:,:,:)   ) ! new primary production by diatomes
+       CALL iom_put( "PBSi"    , zprorcad(:,:,:) * zfact * tmask(:,:,:) * zysopt(:,:,:)  ) ! biogenic silica production
+       CALL iom_put( "PFeP"    , zprofep(:,:,:) * zfact * tmask(:,:,:)  ) ! biogenic iron production by picophyto
+       CALL iom_put( "PFeN"    , zprofen(:,:,:) * zfact * tmask(:,:,:)  ) ! biogenic iron production by nanophyto
+       CALL iom_put( "PFeD"    , zprofed(:,:,:) * zfact * tmask(:,:,:)  ) ! biogenic iron production by  diatomes
+       IF( ln_ligand ) THEN
+         CALL iom_put( "LPRODP"  , zpligprod1(:,:,:) * 1e9 * zfact * tmask(:,:,:) )
+         CALL iom_put( "LDETP"   , zpligprod2(:,:,:) * 1e9 * zfact * tmask(:,:,:) )
        ENDIF
+       CALL iom_put( "Mumax"   , zprmaxn(:,:,:) * tmask(:,:,:)  ) ! Maximum growth rate
+       CALL iom_put( "MuP"     , zprpic(:,:,:) * xlimpic(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for picophyto
+       CALL iom_put( "MuN"     , zprbio(:,:,:) * xlimphy(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for nanophyto
+       CALL iom_put( "MuD"     , zprdia(:,:,:) * xlimdia(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for diatoms
+       CALL iom_put( "LPlight" , zprpic(:,:,:) / (zprmaxp(:,:,:) + rtrn) * tmask(:,:,:)  )  ! light limitation term
+       CALL iom_put( "LNlight" , zprbio(:,:,:) / (zprmaxn(:,:,:) + rtrn) * tmask(:,:,:)  )  ! light limitation term
+       CALL iom_put( "LDlight" , zprdia(:,:,:) / (zprmaxd(:,:,:) + rtrn) * tmask(:,:,:)   )
+       CALL iom_put( "MunetP"  , zcroissp(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for picophyto
+       CALL iom_put( "MunetN"  , zcroissn(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for nanophyto
+       CALL iom_put( "MunetD"  , zcroissd(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for diatoms
+       CALL iom_put( "TPP"     , ( zprorcap(:,:,:) + zprorcan(:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:)  )  ! total primary production
+       CALL iom_put( "TPNEW"   , ( zpronewp(:,:,:) + zpronewn(:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:)  ) ! total new production
+       CALL iom_put( "TPBFE"   , ( zprofep (:,:,:) + zprofen (:,:,:) + zprofed (:,:,:) ) * zfact * tmask(:,:,:)  )  ! total biogenic iron production
+       CALL iom_put( "tintpp"  , tpp * zfact )  !  global total integrated primary production molC/s
      ENDIF
 
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
          WRITE(charout, FMT="('prod')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
       ENDIF
       !
@@ -582,9 +486,7 @@
       !!----------------------------------------------------------------------
 
-      REWIND( numnatp_ref )              ! Namelist nampisprod in reference namelist : Pisces phytoplankton production
       READ  ( numnatp_ref, namp5zprod, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp5zprod in reference namelist' )
 
-      REWIND( numnatp_cfg )              ! Namelist nampisprod in configuration namelist : Pisces phytoplankton production
       READ  ( numnatp_cfg, namp5zprod, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namp5zprod in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/oce_sed.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/oce_sed.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/oce_sed.F90	(revision 12928)
@@ -13,10 +13,10 @@
    USE dom_oce , ONLY :   glamt     =>   glamt          !: longitude of t-point (degre)
    USE dom_oce , ONLY :   gphit     =>   gphit          !: latitude  of t-point (degre)
-   USE dom_oce , ONLY :   e3t_n     =>   e3t_n          !: latitude  of t-point (degre)
+   USE dom_oce , ONLY :   e3t       =>   e3t            !: latitude  of t-point (degre)
    USE dom_oce , ONLY :   e3t_1d    =>   e3t_1d         !: reference depth of t-points (m)
    USE dom_oce , ONLY :   gdepw_0   =>   gdepw_0        !: reference depth of t-points (m)
    USE dom_oce , ONLY :   mbkt      =>   mbkt           !: vertical index of the bottom last T- ocean level
    USE dom_oce , ONLY :   tmask     =>   tmask          !: land/ocean mask at t-points
-   USE dom_oce , ONLY :   rdt       =>   rdt            !: time step for the dynamics
+   USE dom_oce , ONLY :   rn_Dt     =>   rn_Dt          !: time step for the dynamics
    USE dom_oce , ONLY :   nyear     =>   nyear          !: Current year
    USE dom_oce , ONLY :   ndastp    =>   ndastp         !: time step date in year/month/day aammjj
@@ -26,10 +26,10 @@
    !                                !: that may have been run with different time steps.
 
-   USE oce     , ONLY :  tsn        =>   tsn             !: pot. temperature (celsius) and salinity (psu)
-   USE trc     , ONLY :  trb        =>   trb             !: pot. temperature (celsius) and salinity (psu)
+   USE oce     , ONLY :   ts        =>   ts              !: pot. temperature (celsius) and salinity (psu)
+   USE trc     , ONLY :   tr        =>   tr              !: pot. temperature (celsius) and salinity (psu)
 
    USE sms_pisces, ONLY : wsbio4    =>   wsbio4          !: sinking flux for POC
    USE sms_pisces, ONLY : wsbio3    =>   wsbio3          !: sinking flux for GOC
-   USE sms_pisces, ONLY : wsbio2    =>   wsbio2           !: sinking flux for calcite
+   USE sms_pisces, ONLY : wsbio2    =>   wsbio2          !: sinking flux for calcite
    USE sms_pisces, ONLY : wsbio     =>   wsbio           !: sinking flux for calcite
    USE sms_pisces, ONLY : ln_p5z    =>   ln_p5z          !: PISCES-QUOTA flag
@@ -49,6 +49,6 @@
    USE p4zche, ONLY     : sulfat    =>   sulfat          !: Chemical constants  
    USE p4zche, ONLY     : sio3eq    =>   sio3eq          !: Chemical constants  
-   USE p4zsbc, ONLY     : dust      =>   dust
-   USE trc       , ONLY : r2dttrc   =>   r2dttrc
+   USE p4zbc, ONLY     : dust      =>   dust
+   USE trc  , ONLY : rDt_trc   =>   rDt_trc
 
 END MODULE oce_sed
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/sedchem.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/sedchem.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/sedchem.F90	(revision 12928)
@@ -23,4 +23,6 @@
    REAL(wp), PARAMETER :: pp_rdel_ah_target = 1.E-4_wp
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !! * Module variables
    REAL(wp) :: &
@@ -136,26 +138,24 @@
          CALL sed_chem_cst
       ELSE
-         DO jj = 1,jpj
-            DO ji = 1, jpi
-               ikt = mbkt(ji,jj) 
-               IF ( tmask(ji,jj,ikt) == 1 ) THEN
-                  zchem_data(ji,jj,1) = ak13  (ji,jj,ikt)
-                  zchem_data(ji,jj,2) = ak23  (ji,jj,ikt)
-                  zchem_data(ji,jj,3) = akb3  (ji,jj,ikt)
-                  zchem_data(ji,jj,4) = akw3  (ji,jj,ikt)
-                  zchem_data(ji,jj,5) = aksp  (ji,jj,ikt)
-                  zchem_data(ji,jj,6) = borat (ji,jj,ikt)
-                  zchem_data(ji,jj,7) = ak1p3 (ji,jj,ikt)
-                  zchem_data(ji,jj,8) = ak2p3 (ji,jj,ikt)
-                  zchem_data(ji,jj,9) = ak3p3 (ji,jj,ikt)
-                  zchem_data(ji,jj,10)= aksi3 (ji,jj,ikt)
-                  zchem_data(ji,jj,11)= sio3eq(ji,jj,ikt)
-                  zchem_data(ji,jj,12)= aks3  (ji,jj,ikt)
-                  zchem_data(ji,jj,13)= akf3  (ji,jj,ikt)
-                  zchem_data(ji,jj,14)= sulfat(ji,jj,ikt)
-                  zchem_data(ji,jj,15)= fluorid(ji,jj,ikt)
-               ENDIF
-            ENDDO
-         ENDDO
+         DO_2D_11_11
+            ikt = mbkt(ji,jj) 
+            IF ( tmask(ji,jj,ikt) == 1 ) THEN
+               zchem_data(ji,jj,1) = ak13  (ji,jj,ikt)
+               zchem_data(ji,jj,2) = ak23  (ji,jj,ikt)
+               zchem_data(ji,jj,3) = akb3  (ji,jj,ikt)
+               zchem_data(ji,jj,4) = akw3  (ji,jj,ikt)
+               zchem_data(ji,jj,5) = aksp  (ji,jj,ikt)
+               zchem_data(ji,jj,6) = borat (ji,jj,ikt)
+               zchem_data(ji,jj,7) = ak1p3 (ji,jj,ikt)
+               zchem_data(ji,jj,8) = ak2p3 (ji,jj,ikt)
+               zchem_data(ji,jj,9) = ak3p3 (ji,jj,ikt)
+               zchem_data(ji,jj,10)= aksi3 (ji,jj,ikt)
+               zchem_data(ji,jj,11)= sio3eq(ji,jj,ikt)
+               zchem_data(ji,jj,12)= aks3  (ji,jj,ikt)
+               zchem_data(ji,jj,13)= akf3  (ji,jj,ikt)
+               zchem_data(ji,jj,14)= sulfat(ji,jj,ikt)
+               zchem_data(ji,jj,15)= fluorid(ji,jj,ikt)
+            ENDIF
+         END_2D
 
          CALL pack_arr ( jpoce, ak1s  (1:jpoce), zchem_data(1:jpi,1:jpj,1) , iarroce(1:jpoce) )
@@ -577,5 +577,5 @@
          saltprac(:) = salt(:) * 35.0 / 35.16504
       ELSE
-         saltprac(:) = temp(:)
+         saltprac(:) = salt(:)
       ENDIF
 
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/seddta.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/seddta.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/seddta.F90	(revision 12928)
@@ -22,4 +22,6 @@
    REAL(wp) ::  conv2    ! [kg/m2/month]-->[g/cm2/s] ( 1 month has 30 days )
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !! $Id$
 CONTAINS
@@ -29,5 +31,5 @@
    !!---------------------------------------------------------------------------
 
-   SUBROUTINE sed_dta( kt )
+   SUBROUTINE sed_dta( kt, Kbb, Kmm )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE sed_dta  ***
@@ -43,5 +45,6 @@
 
       !! Arguments
-      INTEGER, INTENT(in) ::  kt    ! time-step
+      INTEGER, INTENT(in) ::  kt         ! time-step
+      INTEGER, INTENT(in) ::  Kbb, Kmm   ! time level indices
 
       !! * Local declarations
@@ -72,5 +75,5 @@
       IF( kt == nitsed000 ) THEN
          IF (lwp) WRITE(numsed,*) ' sed_dta : Sediment fields'
-         dtsed = r2dttrc
+         dtsed = rDt_trc
          rsecday = 60.* 60. * 24.
 !         conv2   = 1.0e+3 / ( 1.0e+4 * rsecday * 30. )
@@ -92,49 +95,43 @@
       !    -----------------------------------------------------------
       IF (ln_sediment_offline) THEN
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ikt = mbkt(ji,jj)
-               zwsbio4(ji,jj) = wsbio2 / rday
-               zwsbio3(ji,jj) = wsbio  / rday
-            END DO
-         END DO
+         DO_2D_11_11
+            ikt = mbkt(ji,jj)
+            zwsbio4(ji,jj) = wsbio2 / rday
+            zwsbio3(ji,jj) = wsbio  / rday
+         END_2D
       ELSE
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ikt = mbkt(ji,jj)
-               zdep = e3t_n(ji,jj,ikt) / r2dttrc
-               zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) / rday )
-               zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) / rday )
-            END DO
-         END DO
+         DO_2D_11_11
+            ikt = mbkt(ji,jj)
+            zdep = e3t(ji,jj,ikt,Kmm) / rDt_trc
+            zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) / rday )
+            zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) / rday )
+         END_2D
       ENDIF
 
       trc_data(:,:,:) = 0.
-      DO jj = 1,jpj
-         DO ji = 1, jpi
-            ikt = mbkt(ji,jj)
-            IF ( tmask(ji,jj,ikt) == 1 ) THEN
-               trc_data(ji,jj,1)   = trb(ji,jj,ikt,jpsil)
-               trc_data(ji,jj,2)   = trb(ji,jj,ikt,jpoxy)
-               trc_data(ji,jj,3)   = trb(ji,jj,ikt,jpdic)
-               trc_data(ji,jj,4)   = trb(ji,jj,ikt,jpno3) / 7.625
-               trc_data(ji,jj,5)   = trb(ji,jj,ikt,jppo4) / 122.
-               trc_data(ji,jj,6)   = trb(ji,jj,ikt,jptal)
-               trc_data(ji,jj,7)   = trb(ji,jj,ikt,jpnh4) / 7.625
-               trc_data(ji,jj,8)   = 0.0
-               trc_data(ji,jj,9)   = 28.0E-3
-               trc_data(ji,jj,10)  = trb(ji,jj,ikt,jpfer)
-               trc_data(ji,jj,11 ) = MIN(trb(ji,jj,ikt,jpgsi), 1E-4) * zwsbio4(ji,jj) * 1E3
-               trc_data(ji,jj,12 ) = MIN(trb(ji,jj,ikt,jppoc), 1E-4) * zwsbio3(ji,jj) * 1E3
-               trc_data(ji,jj,13 ) = MIN(trb(ji,jj,ikt,jpgoc), 1E-4) * zwsbio4(ji,jj) * 1E3
-               trc_data(ji,jj,14)  = MIN(trb(ji,jj,ikt,jpcal), 1E-4) * zwsbio4(ji,jj) * 1E3
-               trc_data(ji,jj,15)  = tsn(ji,jj,ikt,jp_tem)
-               trc_data(ji,jj,16)  = tsn(ji,jj,ikt,jp_sal)
-               trc_data(ji,jj,17 ) = ( trb(ji,jj,ikt,jpsfe) * zwsbio3(ji,jj) + trb(ji,jj,ikt,jpbfe)  &
-               &                     * zwsbio4(ji,jj)  ) * 1E3 / ( trc_data(ji,jj,12 ) + trc_data(ji,jj,13 ) + rtrn )
-               trc_data(ji,jj,17 ) = MIN(1E-3, trc_data(ji,jj,17 ) )
-            ENDIF
-         ENDDO
-      ENDDO
+      DO_2D_11_11
+         ikt = mbkt(ji,jj)
+         IF ( tmask(ji,jj,ikt) == 1 ) THEN
+            trc_data(ji,jj,1)   = tr(ji,jj,ikt,jpsil,Kbb)
+            trc_data(ji,jj,2)   = tr(ji,jj,ikt,jpoxy,Kbb)
+            trc_data(ji,jj,3)   = tr(ji,jj,ikt,jpdic,Kbb)
+            trc_data(ji,jj,4)   = tr(ji,jj,ikt,jpno3,Kbb) / 7.625
+            trc_data(ji,jj,5)   = tr(ji,jj,ikt,jppo4,Kbb) / 122.
+            trc_data(ji,jj,6)   = tr(ji,jj,ikt,jptal,Kbb)
+            trc_data(ji,jj,7)   = tr(ji,jj,ikt,jpnh4,Kbb) / 7.625
+            trc_data(ji,jj,8)   = 0.0
+            trc_data(ji,jj,9)   = 28.0E-3
+            trc_data(ji,jj,10)  = tr(ji,jj,ikt,jpfer,Kbb)
+            trc_data(ji,jj,11 ) = MIN(tr(ji,jj,ikt,jpgsi,Kbb), 1E-4) * zwsbio4(ji,jj) * 1E3
+            trc_data(ji,jj,12 ) = MIN(tr(ji,jj,ikt,jppoc,Kbb), 1E-4) * zwsbio3(ji,jj) * 1E3
+            trc_data(ji,jj,13 ) = MIN(tr(ji,jj,ikt,jpgoc,Kbb), 1E-4) * zwsbio4(ji,jj) * 1E3
+            trc_data(ji,jj,14)  = MIN(tr(ji,jj,ikt,jpcal,Kbb), 1E-4) * zwsbio4(ji,jj) * 1E3
+            trc_data(ji,jj,15)  = ts(ji,jj,ikt,jp_tem,Kmm)
+            trc_data(ji,jj,16)  = ts(ji,jj,ikt,jp_sal,Kmm)
+            trc_data(ji,jj,17 ) = ( tr(ji,jj,ikt,jpsfe,Kbb) * zwsbio3(ji,jj) + tr(ji,jj,ikt,jpbfe,Kbb)  &
+            &                     * zwsbio4(ji,jj)  ) * 1E3 / ( trc_data(ji,jj,12 ) + trc_data(ji,jj,13 ) + rtrn )
+            trc_data(ji,jj,17 ) = MIN(1E-3, trc_data(ji,jj,17 ) )
+         ENDIF
+      END_2D
 
       ! Pore water initial concentration [mol/l] in  k=1
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/sedini.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/sedini.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/sedini.F90	(revision 12928)
@@ -13,5 +13,4 @@
    USE sedarr
    USE sedadv
-   USE trc_oce, ONLY : nn_dttrc
    USE trcdmp_sed
    USE trcdta
@@ -23,4 +22,6 @@
    PRIVATE
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !! Module variables
    REAL(wp)    ::  &
@@ -134,11 +135,9 @@
       ! Determination of sediments number of points and allocate global variables
       epkbot(:,:) = 0.
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            ikt = mbkt(ji,jj) 
-            IF( tmask(ji,jj,ikt) == 1 ) epkbot(ji,jj) = e3t_1d(ikt)
-            gdepbot(ji,jj) = gdepw_0(ji,jj,ikt)
-         ENDDO
-      ENDDO
+      DO_2D_11_11
+         ikt = mbkt(ji,jj) 
+         IF( tmask(ji,jj,ikt) == 1 ) epkbot(ji,jj) = e3t_1d(ikt)
+         gdepbot(ji,jj) = gdepw_0(ji,jj,ikt)
+      END_2D
 
       ! computation of total number of ocean points
@@ -248,12 +247,10 @@
       ! Computation of 1D array of sediments points
       indoce = 0
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF (  epkbot(ji,jj) > 0. ) THEN
-               indoce          = indoce + 1
-               iarroce(indoce) = (jj - 1) * jpi + ji
-            ENDIF
-         END DO
-      END DO
+      DO_2D_11_11
+         IF (  epkbot(ji,jj) > 0. ) THEN
+            indoce          = indoce + 1
+            iarroce(indoce) = (jj - 1) * jpi + ji
+         ENDIF
+      END_2D
 
       IF ( indoce .EQ. 0 ) THEN
@@ -406,6 +403,6 @@
       !!----------------------------------------------------------------------
 
-      INTEGER ::   numnamsed_ref = -1           !! Logical units for namelist sediment
-      INTEGER ::   numnamsed_cfg = -1           !! Logical units for namelist sediment
+      CHARACTER(:), ALLOCATABLE ::   numnamsed_ref           !! Character buffer for reference namelist sediment
+      CHARACTER(:), ALLOCATABLE ::   numnamsed_cfg           !! Character buffer for configuration namelist sediment
       INTEGER :: ios                 ! Local integer output status for namelist read
       CHARACTER(LEN=20)   ::   clname
@@ -452,15 +449,13 @@
       IF(lwp) WRITE(numsed,*) ' sed_init_nam : read SEDIMENT namelist'
       IF(lwp) WRITE(numsed,*) ' ~~~~~~~~~~~~~~'
-      CALL ctl_opn( numnamsed_ref, TRIM( clname )//'_ref', 'OLD'    , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
-      CALL ctl_opn( numnamsed_cfg, TRIM( clname )//'_cfg', 'OLD'    , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+      CALL load_nml( numnamsed_ref, TRIM( clname )//'_ref', numout, lwm )
+      CALL load_nml( numnamsed_cfg, TRIM( clname )//'_cfg', numout, lwm )
 
       nitsed000 = nittrc000
       nitsedend = nitend
       ! Namelist nam_run
-      REWIND( numnamsed_ref )              ! Namelist nam_run in reference namelist : Pisces variables
       READ  ( numnamsed_ref, nam_run, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_run in reference namelist' )
 
-      REWIND( numnamsed_cfg )              ! Namelist nam_run in reference namelist : Pisces variables
       READ  ( numnamsed_cfg, nam_run, IOSTAT = ios, ERR = 902)
 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_run in configuration namelist' )
@@ -474,9 +469,7 @@
       IF ( ln_p5z .AND. ln_sed_2way ) CALL ctl_stop( '2 ways coupling with sediment cannot be activated with PISCES-QUOTA' )
 
-      REWIND( numnamsed_ref )              ! Namelist nam_geom in reference namelist : Pisces variables
       READ  ( numnamsed_ref, nam_geom, IOSTAT = ios, ERR = 903)
 903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_geom in reference namelist' )
 
-      REWIND( numnamsed_cfg )              ! Namelist nam_geom in reference namelist : Pisces variables
       READ  ( numnamsed_cfg, nam_geom, IOSTAT = ios, ERR = 904)
 904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_geom in configuration namelist' )
@@ -495,11 +488,9 @@
 
       jpksedm1  = jpksed - 1
-      dtsed = r2dttrc
-
-      REWIND( numnamsed_ref )              ! Namelist nam_trased in reference namelist : Pisces variables
+      dtsed = rDt_trc
+
       READ  ( numnamsed_ref, nam_trased, IOSTAT = ios, ERR = 905)
 905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_trased in reference namelist' )
 
-      REWIND( numnamsed_cfg )              ! Namelist nam_trased in reference namelist : Pisces variables
       READ  ( numnamsed_cfg, nam_trased, IOSTAT = ios, ERR = 906)
 906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_trased in configuration namelist' )
@@ -530,9 +521,7 @@
       ENDIF
 
-      REWIND( numnamsed_ref )              ! Namelist nam_diased in reference namelist : Pisces variables
       READ  ( numnamsed_ref, nam_diased, IOSTAT = ios, ERR = 907)
 907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diased in reference namelist' )
 
-      REWIND( numnamsed_cfg )              ! Namelist nam_diased in reference namelist : Pisces variables
       READ  ( numnamsed_cfg, nam_diased, IOSTAT = ios, ERR = 908)
 908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diased in configuration namelist' )
@@ -572,9 +561,7 @@
       ! Inorganic chemistry parameters
       !----------------------------------
-      REWIND( numnamsed_ref )              ! Namelist nam_inorg in reference namelist : Pisces variables
       READ  ( numnamsed_ref, nam_inorg, IOSTAT = ios, ERR = 909)
 909   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_inorg in reference namelist' )
 
-      REWIND( numnamsed_cfg )              ! Namelist nam_inorg in reference namelist : Pisces variables
       READ  ( numnamsed_cfg, nam_inorg, IOSTAT = ios, ERR = 910)
 910   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_inorg in configuration namelist' )
@@ -598,9 +585,7 @@
       ! Additional parameter linked to POC/O2/No3/Po4
       !----------------------------------------------
-      REWIND( numnamsed_ref )              ! Namelist nam_poc in reference namelist : Pisces variables
       READ  ( numnamsed_ref, nam_poc, IOSTAT = ios, ERR = 911)
 911   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_poc in reference namelist' )
 
-      REWIND( numnamsed_cfg )              ! Namelist nam_poc in reference namelist : Pisces variables
       READ  ( numnamsed_cfg, nam_poc, IOSTAT = ios, ERR = 912)
 912   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_poc in configuration namelist' )
@@ -650,9 +635,7 @@
       ! Bioturbation parameter
       !------------------------
-      REWIND( numnamsed_ref )              ! Namelist nam_btb in reference namelist : Pisces variables
       READ  ( numnamsed_ref, nam_btb, IOSTAT = ios, ERR = 913)
 913   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_btb in reference namelist' )
 
-      REWIND( numnamsed_cfg )              ! Namelist nam_btb in reference namelist : Pisces variables
       READ  ( numnamsed_cfg, nam_btb, IOSTAT = ios, ERR = 914)
 914   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_btb in configuration namelist' )
@@ -671,9 +654,7 @@
       ! Initial value (t=0) for sediment pore water and solid components
       !----------------------------------------------------------------
-      REWIND( numnamsed_ref )              ! Namelist nam_rst in reference namelist : Pisces variables
       READ  ( numnamsed_ref, nam_rst, IOSTAT = ios, ERR = 915)
 915   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_rst in reference namelist' )
 
-      REWIND( numnamsed_cfg )              ! Namelist nam_rst in reference namelist : Pisces variables
       READ  ( numnamsed_cfg, nam_rst, IOSTAT = ios, ERR = 916)
 916   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_rst in configuration namelist' )
@@ -684,8 +665,6 @@
          WRITE(numsed,*) ' '
       ENDIF
-      nn_dtsed = nn_dttrc
-
-      CLOSE( numnamsed_cfg )
-      CLOSE( numnamsed_ref )
+      nn_dtsed = 1
+
 
    END SUBROUTINE sed_init_nam
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/sedinitrc.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/sedinitrc.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/sedinitrc.F90	(revision 12928)
@@ -33,5 +33,5 @@
 
 
-   SUBROUTINE sed_initrc
+   SUBROUTINE sed_initrc( Kbb, Kmm )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE sed_init  ***
@@ -50,4 +50,5 @@
       !!        !  06-07  (C. Ethe)  Re-organization
       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in)  ::  Kbb, Kmm      ! time level indices
       INTEGER :: ji, jj, ikt
       !!----------------------------------------------------------------------
@@ -65,5 +66,5 @@
       ! ( only clay or reading restart file )
       !---------------------------------------
-      CALL sed_init_data
+      CALL sed_init_data( Kbb, Kmm )
 
 
@@ -74,5 +75,5 @@
 
 
-   SUBROUTINE sed_init_data
+   SUBROUTINE sed_init_data( Kbb, Kmm )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE sed_init_data  ***
@@ -85,4 +86,5 @@
       !!        !  06-07  (C. Ethe)  original
       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in)  ::  Kbb, Kmm      ! time level indices
  
       ! local variables
@@ -128,5 +130,5 @@
 
       ! Load initial Pisces Data for bot. wat. Chem and fluxes
-      CALL sed_dta ( nitsed000 ) 
+      CALL sed_dta ( nitsed000, Kbb, Kmm ) 
 
       ! Initialization of chemical constants
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/sedinorg.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/sedinorg.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/sedinorg.F90	(revision 12928)
@@ -89,4 +89,5 @@
             zsolcpcl = zsolcpcl + solcp(ji,jk,jsclay) * dz(jk)
          END DO
+         zsolcpsi = MAX( zsolcpsi, rtrn )
          zsieq(ji) = sieqs(ji) * MAX(0.25, 1.0 - (0.045 * zsolcpcl / zsolcpsi )**0.58 )
          zsieq(ji) = MAX( rtrn, sieqs(ji) )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/sedmodel.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/sedmodel.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/sedmodel.F90	(revision 12928)
@@ -16,5 +16,5 @@
 CONTAINS
 
-   SUBROUTINE sed_model ( kt )
+   SUBROUTINE sed_model ( kt, Kbb, Kmm, Krhs )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE sed_model  ***
@@ -29,11 +29,12 @@
       !!        !  07-02 (C. Ethe)  Original
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt       ! number of iteration
+      INTEGER, INTENT(in) ::   kt               ! number of iteration
+      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs   ! time level indices
 
 
       IF( ln_timing )  CALL timing_start('sed_model')
 
-      IF( kt == nittrc000 ) CALL sed_initrc       ! Initialization of sediment model
-                            CALL sed_stp( kt )  ! Time stepping of Sediment model
+      IF( kt == nittrc000 ) CALL sed_initrc( Kbb, Kmm )         ! Initialization of sediment model
+                            CALL sed_stp( kt, Kbb, Kmm, Krhs )  ! Time stepping of Sediment model
 
       IF( ln_timing )  CALL timing_stop('sed_model')
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/sedrst.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/sedrst.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/sedrst.F90	(revision 12928)
@@ -10,5 +10,5 @@
    USE sed
    USE sedarr
-   USE trc_oce, ONLY : l_offline, nn_dttrc
+   USE trc_oce, ONLY : l_offline
    USE phycst , ONLY : rday
    USE iom
@@ -66,6 +66,6 @@
 
       ! to get better performances with NetCDF format:
-      ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*nn_dttrc + 1)
-      ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 2*nn_dttrc + 1
+      ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 1)
+      ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 1
       IF( kt == nitrst - 2*nn_dtsed .OR. nn_stock == nn_dtsed .OR. ( kt == nitend - nn_dtsed .AND. .NOT. lrst_sed ) ) THEN
          ! beware of the format used to write kt (default is i8.8, that should be large enough)
@@ -80,5 +80,5 @@
          IF(lwp) WRITE(numsed,*) &
              '             open sed restart.output NetCDF file: ',TRIM(clpath)//clname
-         CALL iom_open( TRIM(clpath)//TRIM(clname), numrsw, ldwrt = .TRUE., kdlev = jpksed )
+         CALL iom_open( TRIM(clpath)//TRIM(clname), numrsw, ldwrt = .TRUE., kdlev = jpksed, cdcomp = 'SED' )
          lrst_sed = .TRUE.
       ENDIF
@@ -330,5 +330,5 @@
       !!       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 (nittrc000-1)*rdt.
+      !!       is not stored in the restart and is assumed to be (nittrc000-1)*rn_Dt.
       !!       This is valid is the time step has remained constant.
       !!
@@ -381,5 +381,5 @@
              ELSE
                ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam
-               adatrj = ( REAL( nittrc000-1, wp ) * rdt ) / rday
+               adatrj = ( REAL( nittrc000-1, wp ) * rn_Dt ) / rday
                ! note this is wrong if time step has changed during run
             ENDIF
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/sedsfc.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/sedsfc.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/sedsfc.F90	(revision 12928)
@@ -11,8 +11,10 @@
    PUBLIC sed_sfc
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !! $Id$
 CONTAINS
 
-   SUBROUTINE sed_sfc( kt )
+   SUBROUTINE sed_sfc( kt, Kbb )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE sed_sfc ***
@@ -26,4 +28,5 @@
       !!* Arguments
       INTEGER, INTENT(in) ::  kt              ! time step
+      INTEGER, INTENT(in) ::  Kbb             ! time index
 
       ! * local variables
@@ -45,19 +48,17 @@
 
 
-      DO jj = 1,jpj
-         DO ji = 1, jpi
-            ikt = mbkt(ji,jj)
-            IF ( tmask(ji,jj,ikt) == 1 ) THEN
-               trb(ji,jj,ikt,jptal) = trc_data(ji,jj,1)
-               trb(ji,jj,ikt,jpdic) = trc_data(ji,jj,2)
-               trb(ji,jj,ikt,jpno3) = trc_data(ji,jj,3) * 7.625
-               trb(ji,jj,ikt,jppo4) = trc_data(ji,jj,4) * 122.
-               trb(ji,jj,ikt,jpoxy) = trc_data(ji,jj,5)
-               trb(ji,jj,ikt,jpsil) = trc_data(ji,jj,6)
-               trb(ji,jj,ikt,jpnh4) = trc_data(ji,jj,7) * 7.625
-               trb(ji,jj,ikt,jpfer) = trc_data(ji,jj,8)
-            ENDIF
-         ENDDO
-      ENDDO
+      DO_2D_11_11
+         ikt = mbkt(ji,jj)
+         IF ( tmask(ji,jj,ikt) == 1 ) THEN
+            tr(ji,jj,ikt,jptal,Kbb) = trc_data(ji,jj,1)
+            tr(ji,jj,ikt,jpdic,Kbb) = trc_data(ji,jj,2)
+            tr(ji,jj,ikt,jpno3,Kbb) = trc_data(ji,jj,3) * 7.625
+            tr(ji,jj,ikt,jppo4,Kbb) = trc_data(ji,jj,4) * 122.
+            tr(ji,jj,ikt,jpoxy,Kbb) = trc_data(ji,jj,5)
+            tr(ji,jj,ikt,jpsil,Kbb) = trc_data(ji,jj,6)
+            tr(ji,jj,ikt,jpnh4,Kbb) = trc_data(ji,jj,7) * 7.625
+            tr(ji,jj,ikt,jpfer,Kbb) = trc_data(ji,jj,8)
+         ENDIF
+      END_2D
 
       IF( ln_timing )  CALL timing_stop('sed_sfc')
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/sedstp.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/sedstp.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/sedstp.F90	(revision 12928)
@@ -29,5 +29,5 @@
 CONTAINS
 
-   SUBROUTINE sed_stp ( kt )
+   SUBROUTINE sed_stp ( kt, Kbb, Kmm, Krhs )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE sed_stp  ***
@@ -44,5 +44,6 @@
       !!        !  06-04 (C. Ethe)  Re-organization
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt       ! number of iteration
+      INTEGER, INTENT(in) ::   kt                ! number of iteration
+      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs    ! time level indices
       INTEGER :: ji,jk,js,jn,jw
       !!----------------------------------------------------------------------
@@ -52,10 +53,10 @@
       IF( lrst_sed )            CALL sed_rst_cal  ( kt, 'WRITE' )   ! calenda
 
-      IF(ln_sediment_offline)   CALL trc_dmp_sed  ( kt )
+      IF(ln_sediment_offline)   CALL trc_dmp_sed  ( kt, Kbb, Kmm, Krhs )
 
-      dtsed  = r2dttrc
+      dtsed  = rDt_trc
 !      dtsed2 = dtsed
       IF (kt /= nitsed000) THEN
-         CALL sed_dta( kt )       ! Load  Data for bot. wat. Chem and fluxes
+         CALL sed_dta( kt, Kbb, Kmm )       ! Load  Data for bot. wat. Chem and fluxes
       ENDIF
 
@@ -80,5 +81,5 @@
          CALL sed_mbc( kt )         ! cumulation for mass balance calculation
 
-         IF (ln_sed_2way) CALL sed_sfc( kt )         ! Give back new bottom wat chem to tracer model
+         IF (ln_sed_2way) CALL sed_sfc( kt, Kbb )         ! Give back new bottom wat chem to tracer model
       ENDIF
       CALL sed_wri( kt )         ! outputs
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/sedwri.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/sedwri.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/sedwri.F90	(revision 12928)
@@ -94,5 +94,5 @@
          DO ji = 1, jpoce
             zflx(ji,jw) = ( pwcp(ji,1,jw) - pwcp_dta(ji,jw) ) &
-               &         * 1.e3 / 1.e2 * dzkbot(ji) / r2dttrc
+               &         * 1.e3 / 1.e2 * dzkbot(ji) / rDt_trc
          ENDDO
       ENDDO
@@ -100,5 +100,5 @@
       ! Calculation of accumulation rate per dt
       DO js = 1, jpsol
-         zrate =  1.0 / ( denssol * por1(jpksed) ) / r2dttrc
+         zrate =  1.0 / ( denssol * por1(jpksed) ) / rDt_trc
          DO ji = 1, jpoce
             zflx(ji,jpwatp1) = zflx(ji,jpwatp1) + ( tosed(ji,js) - fromsed(ji,js) ) * zrate
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/trcdmp_sed.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/trcdmp_sed.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/trcdmp_sed.F90	(revision 12928)
@@ -35,5 +35,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -54,5 +54,5 @@
 
 
-   SUBROUTINE trc_dmp_sed( kt )
+   SUBROUTINE trc_dmp_sed( kt, Kbb, Kmm, Krhs )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE trc_dmp_sed  ***
@@ -64,14 +64,15 @@
       !! ** Method  :   Newtonian damping towards trdta computed 
       !!      and add to the general tracer trends:
-      !!                     trn = tra + restotr * (trdta - trb)
+      !!                     tr(Kmm) = tr(Krhs) + restotr * (trdta - tr(Kbb))
       !!         The trend is computed either throughout the water column
       !!      (nlmdmptr=0) or in area of weak vertical mixing (nlmdmptr=1) or
       !!      below the well mixed layer (nlmdmptr=2)
       !!
-      !! ** Action  : - update the tracer trends tra with the newtonian 
+      !! ** Action  : - update the tracer trends tr(Krhs) with the newtonian 
       !!                damping trends.
       !!              - save the trends ('key_trdmxl_trc')
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER, INTENT(in) ::   kt              ! ocean time-step index
+      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level index
       !
       INTEGER ::   ji, jj, jk, jn, jl, ikt   ! dummy loop indices
@@ -90,13 +91,11 @@
                !
                jl = n_trc_index(jn) 
-               CALL trc_dta( kt, sf_trcdta(jl), rf_trfac(jl), ztrcdta )   ! read tracer data at nit000
+               CALL trc_dta( kt, Kmm, sf_trcdta(jl), rf_trfac(jl), ztrcdta )   ! read tracer data at nit000
                !
-               DO jj = 1, jpj
-                  DO ji = 1, jpi   ! vector opt.
-                     ikt = mbkt(ji,jj)
-                     trb(ji,jj,ikt,jn) = ztrcdta(ji,jj,ikt) + ( trb(ji,jj,ikt,jn) -  ztrcdta(ji,jj,ikt) )     &
-                     &                  * exp( -restosed(ji,jj,ikt) * dtsed )
-                  END DO
-               END DO
+               DO_2D_11_11
+                  ikt = mbkt(ji,jj)
+                  tr(ji,jj,ikt,jn,Kbb) = ztrcdta(ji,jj,ikt) + ( tr(ji,jj,ikt,jn,Kbb) -  ztrcdta(ji,jj,ikt) )     &
+                  &                  * exp( -restosed(ji,jj,ikt) * dtsed )
+               END_2D
                ! 
             ENDIF
@@ -106,8 +105,8 @@
       !
       !                                          ! print mean trends (used for debugging)
-      IF( ln_ctl ) THEN
+      IF( sn_cfctl%l_prttrc ) THEN
          WRITE(charout, FMT="('dmp ')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+         CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
       ENDIF
       !
@@ -148,6 +147,7 @@
    !!----------------------------------------------------------------------
 CONTAINS
-   SUBROUTINE trc_dmp_sed( kt )        ! Empty routine
+   SUBROUTINE trc_dmp_sed( kt, Kbb, Kmm, Krhs )   ! Empty routine
       INTEGER, INTENT(in) :: kt
+      INTEGER, INTENT(in) :: Kbb, Kmm, Krhs
       WRITE(*,*) 'trc_dmp_sed: You should not have seen this print! error?', kt
    END SUBROUTINE trc_dmp_sed
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/par_pisces.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/par_pisces.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/par_pisces.F90	(revision 12928)
@@ -6,4 +6,5 @@
    !! History :   2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
    !!----------------------------------------------------------------------
+   USE par_kind
 
    IMPLICIT NONE
@@ -60,6 +61,12 @@
    !!   Default                                   No CFC geochemical model
    ! Starting/ending PISCES do-loop indices (N.B. no PISCES : jpl_pcs < jpf_pcs the do-loop are never done)
-   INTEGER, PUBLIC  ::   jp_pcs0  !: First index of PISCES tracers
-   INTEGER, PUBLIC  ::   jp_pcs1  !: Last  index of PISCES tracers
+   INTEGER, PUBLIC  ::  jp_pcs0  !: First index of PISCES tracers
+   INTEGER, PUBLIC  ::  jp_pcs1  !: Last  index of PISCES tracers
+
+   REAL(wp), PUBLIC ::  mMass_C  = 12.00      ! Molar mass of carbon
+   REAL(wp), PUBLIC ::  mMass_N  = 14.00      ! Molar mass of nitrogen
+   REAL(wp), PUBLIC ::  mMass_P  = 31.00      ! Molar mass of phosphorus
+   REAL(wp), PUBLIC ::  mMass_Fe = 55.85      ! Molar mass of iron
+   REAL(wp), PUBLIC ::  mMass_Si = 28.00      ! Molar mass of silver
 
    !!----------------------------------------------------------------------
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/sms_pisces.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/sms_pisces.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/sms_pisces.F90	(revision 12928)
@@ -13,7 +13,7 @@
    PUBLIC
 
-   INTEGER ::   numnatp_ref = -1           !! Logical units for namelist pisces
-   INTEGER ::   numnatp_cfg = -1           !! Logical units for namelist pisces
-   INTEGER ::   numonp      = -1           !! Logical unit for namelist pisces output
+   CHARACTER(:), ALLOCATABLE ::   numnatp_ref   !! Character buffer for reference namelist pisces
+   CHARACTER(:), ALLOCATABLE ::   numnatp_cfg   !! Character buffer for configuration namelist pisces
+   INTEGER ::   numonp      = -1                !! Logical unit for namelist pisces output
 
    !                                                       !:  PISCES  : silicon dependant half saturation
@@ -121,4 +121,6 @@
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tgfunc2   !: Temp. dependancy of mesozooplankton rates
 
+   LOGICAL, SAVE :: lk_sed
+
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/trcini_pisces.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/trcini_pisces.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/trcini_pisces.F90	(revision 12928)
@@ -32,5 +32,5 @@
 CONTAINS
 
-   SUBROUTINE trc_ini_pisces
+   SUBROUTINE trc_ini_pisces( Kmm )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE trc_ini_pisces ***
@@ -38,9 +38,10 @@
       !! ** Purpose :   Initialisation of the PISCES biochemical model
       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in)  ::  Kmm      ! time level indices
       !
       CALL trc_nam_pisces
       !
-      IF( ln_p4z .OR. ln_p5z ) THEN  ;   CALL p4z_ini   !  PISCES
-      ELSE                           ;   CALL p2z_ini   !  LOBSTER
+      IF( ln_p4z .OR. ln_p5z ) THEN  ;   CALL p4z_ini( Kmm )   !  PISCES
+      ELSE                           ;   CALL p2z_ini( Kmm )   !  LOBSTER
       ENDIF
 
@@ -48,5 +49,5 @@
 
 
-   SUBROUTINE p4z_ini
+   SUBROUTINE p4z_ini( Kmm )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE p4z_ini ***
@@ -58,5 +59,5 @@
       USE p4zsink         !  vertical flux of particulate matter due to sinking
       USE p4zopt          !  optical model
-      USE p4zsbc          !  Boundary conditions
+      USE p4zbc          !  Boundary conditions
       USE p4zfechem       !  Iron chemistry
       USE p4zrem          !  Remineralisation of organic matter
@@ -77,4 +78,5 @@
       USE p5zmort         !  Mortality terms for phytoplankton
       !
+      INTEGER, INTENT(in)  ::  Kmm      ! time level indices
       REAL(wp), SAVE ::   sco2   =  2.312e-3_wp
       REAL(wp), SAVE ::   alka0  =  2.426e-3_wp
@@ -189,47 +191,47 @@
       !--------------------------------------------------------------
       IF( .NOT.ln_rsttr ) THEN  
-         trn(:,:,:,jpdic) = sco2
-         trn(:,:,:,jpdoc) = bioma0
-         trn(:,:,:,jptal) = alka0
-         trn(:,:,:,jpoxy) = oxyg0
-         trn(:,:,:,jpcal) = bioma0
-         trn(:,:,:,jppo4) = po4 / po4r
-         trn(:,:,:,jppoc) = bioma0
-         trn(:,:,:,jpgoc) = bioma0
-         trn(:,:,:,jpbfe) = bioma0 * 5.e-6
-         trn(:,:,:,jpsil) = silic1
-         trn(:,:,:,jpdsi) = bioma0 * 0.15
-         trn(:,:,:,jpgsi) = bioma0 * 5.e-6
-         trn(:,:,:,jpphy) = bioma0
-         trn(:,:,:,jpdia) = bioma0
-         trn(:,:,:,jpzoo) = bioma0
-         trn(:,:,:,jpmes) = bioma0
-         trn(:,:,:,jpfer) = 0.6E-9
-         trn(:,:,:,jpsfe) = bioma0 * 5.e-6
-         trn(:,:,:,jpdfe) = bioma0 * 5.e-6
-         trn(:,:,:,jpnfe) = bioma0 * 5.e-6
-         trn(:,:,:,jpnch) = bioma0 * 12. / 55.
-         trn(:,:,:,jpdch) = bioma0 * 12. / 55.
-         trn(:,:,:,jpno3) = no3
-         trn(:,:,:,jpnh4) = bioma0
+         tr(:,:,:,jpdic,Kmm) = sco2
+         tr(:,:,:,jpdoc,Kmm) = bioma0
+         tr(:,:,:,jptal,Kmm) = alka0
+         tr(:,:,:,jpoxy,Kmm) = oxyg0
+         tr(:,:,:,jpcal,Kmm) = bioma0
+         tr(:,:,:,jppo4,Kmm) = po4 / po4r
+         tr(:,:,:,jppoc,Kmm) = bioma0
+         tr(:,:,:,jpgoc,Kmm) = bioma0
+         tr(:,:,:,jpbfe,Kmm) = bioma0 * 5.e-6
+         tr(:,:,:,jpsil,Kmm) = silic1
+         tr(:,:,:,jpdsi,Kmm) = bioma0 * 0.15
+         tr(:,:,:,jpgsi,Kmm) = bioma0 * 5.e-6
+         tr(:,:,:,jpphy,Kmm) = bioma0
+         tr(:,:,:,jpdia,Kmm) = bioma0
+         tr(:,:,:,jpzoo,Kmm) = bioma0
+         tr(:,:,:,jpmes,Kmm) = bioma0
+         tr(:,:,:,jpfer,Kmm) = 0.6E-9
+         tr(:,:,:,jpsfe,Kmm) = bioma0 * 5.e-6
+         tr(:,:,:,jpdfe,Kmm) = bioma0 * 5.e-6
+         tr(:,:,:,jpnfe,Kmm) = bioma0 * 5.e-6
+         tr(:,:,:,jpnch,Kmm) = bioma0 * 12. / 55.
+         tr(:,:,:,jpdch,Kmm) = bioma0 * 12. / 55.
+         tr(:,:,:,jpno3,Kmm) = no3
+         tr(:,:,:,jpnh4,Kmm) = bioma0
          IF( ln_ligand) THEN
-            trn(:,:,:,jplgw) = 0.6E-9
+            tr(:,:,:,jplgw,Kmm) = 0.6E-9
          ENDIF
          IF( ln_p5z ) THEN
-            trn(:,:,:,jpdon) = bioma0
-            trn(:,:,:,jpdop) = bioma0
-            trn(:,:,:,jppon) = bioma0
-            trn(:,:,:,jppop) = bioma0
-            trn(:,:,:,jpgon) = bioma0
-            trn(:,:,:,jpgop) = bioma0
-            trn(:,:,:,jpnph) = bioma0
-            trn(:,:,:,jppph) = bioma0
-            trn(:,:,:,jppic) = bioma0
-            trn(:,:,:,jpnpi) = bioma0
-            trn(:,:,:,jpppi) = bioma0
-            trn(:,:,:,jpndi) = bioma0
-            trn(:,:,:,jppdi) = bioma0
-            trn(:,:,:,jppfe) = bioma0 * 5.e-6
-            trn(:,:,:,jppch) = bioma0 * 12. / 55.
+            tr(:,:,:,jpdon,Kmm) = bioma0
+            tr(:,:,:,jpdop,Kmm) = bioma0
+            tr(:,:,:,jppon,Kmm) = bioma0
+            tr(:,:,:,jppop,Kmm) = bioma0
+            tr(:,:,:,jpgon,Kmm) = bioma0
+            tr(:,:,:,jpgop,Kmm) = bioma0
+            tr(:,:,:,jpnph,Kmm) = bioma0
+            tr(:,:,:,jppph,Kmm) = bioma0
+            tr(:,:,:,jppic,Kmm) = bioma0
+            tr(:,:,:,jpnpi,Kmm) = bioma0
+            tr(:,:,:,jpppi,Kmm) = bioma0
+            tr(:,:,:,jpndi,Kmm) = bioma0
+            tr(:,:,:,jppdi,Kmm) = bioma0
+            tr(:,:,:,jppfe,Kmm) = bioma0 * 5.e-6
+            tr(:,:,:,jppch,Kmm) = bioma0 * 12. / 55.
          ENDIF
          ! initialize the half saturation constant for silicate
@@ -254,5 +256,5 @@
          CALL p5z_prod_init      !  phytoplankton growth rate over the global ocean.
       ENDIF
-      CALL p4z_sbc_init          !  boundary conditions
+      CALL p4z_bc_init( Kmm )    !  boundary conditions
       CALL p4z_fechem_init       !  Iron chemistry
       CALL p4z_rem_init          !  remineralisation
@@ -275,5 +277,8 @@
 
       ! Initialization of the sediment model
-      IF( ln_sediment)   CALL sed_init
+      IF( ln_sediment)   &
+        & CALL sed_init ! Initialization of the sediment model 
+
+      CALL p4z_sed_init          ! loss of organic matter in the sediments 
 
       IF(lwp) WRITE(numout,*) 
@@ -284,5 +289,5 @@
 
 
-   SUBROUTINE p2z_ini
+   SUBROUTINE p2z_ini( Kmm )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE p2z_ini ***
@@ -296,4 +301,5 @@
       USE p2zsed
       !
+      INTEGER, INTENT(in)  ::  Kmm      ! time level indices
       INTEGER  ::  ji, jj, jk, jn, ierr
       CHARACTER(len = 10)  ::  cltra
@@ -334,18 +340,18 @@
       ! ----------------------
       IF( .NOT. ln_rsttr ) THEN             ! in case of  no restart 
-         trn(:,:,:,jpdet) = 0.1 * tmask(:,:,:)
-         trn(:,:,:,jpzoo) = 0.1 * tmask(:,:,:)
-         trn(:,:,:,jpnh4) = 0.1 * tmask(:,:,:)
-         trn(:,:,:,jpphy) = 0.1 * tmask(:,:,:)
-         trn(:,:,:,jpdom) = 1.0 * tmask(:,:,:)
-         WHERE( rhd(:,:,:) <= 24.5e-3 )  ;  trn(:,:,:,jpno3) = 2._wp * tmask(:,:,:)
-         ELSE WHERE                      ;  trn(:,:,:,jpno3) = ( 15.55 * ( rhd(:,:,:) * 1000. ) - 380.11 ) * tmask(:,:,:)
+         tr(:,:,:,jpdet,Kmm) = 0.1 * tmask(:,:,:)
+         tr(:,:,:,jpzoo,Kmm) = 0.1 * tmask(:,:,:)
+         tr(:,:,:,jpnh4,Kmm) = 0.1 * tmask(:,:,:)
+         tr(:,:,:,jpphy,Kmm) = 0.1 * tmask(:,:,:)
+         tr(:,:,:,jpdom,Kmm) = 1.0 * tmask(:,:,:)
+         WHERE( rhd(:,:,:) <= 24.5e-3 )  ;  tr(:,:,:,jpno3,Kmm) = 2._wp * tmask(:,:,:)
+         ELSE WHERE                      ;  tr(:,:,:,jpno3,Kmm) = ( 15.55 * ( rhd(:,:,:) * 1000. ) - 380.11 ) * tmask(:,:,:)
          END WHERE                       
       ENDIF
-      !                       !  Namelist read
-      CALL p2z_opt_init       !  Optics parameters
-      CALL p2z_sed_init       !  sedimentation
-      CALL p2z_bio_init       !  biology
-      CALL p2z_exp_init       !  export 
+      !                        !  Namelist read
+      CALL p2z_opt_init        !  Optics parameters
+      CALL p2z_sed_init        !  sedimentation
+      CALL p2z_bio_init        !  biology
+      CALL p2z_exp_init( Kmm ) !  export 
       !
       IF(lwp) WRITE(numout,*) 
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/trcnam_pisces.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/trcnam_pisces.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/trcnam_pisces.F90	(revision 12928)
@@ -51,12 +51,10 @@
       IF(lwp) WRITE(numout,*) 'trc_nam_pisces : read PISCES namelist'
       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~'
-      CALL ctl_opn( numnatp_ref, TRIM( clname )//'_ref', 'OLD'    , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
-      CALL ctl_opn( numnatp_cfg, TRIM( clname )//'_cfg', 'OLD'    , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+      CALL load_nml( numnatp_ref, TRIM( clname )//'_ref', numout, lwm )
+      CALL load_nml( numnatp_cfg, TRIM( clname )//'_cfg', numout, lwm )
       IF(lwm) CALL ctl_opn( numonp     , 'output.namelist.pis' , 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
       !
-      REWIND( numnatp_ref )              ! Namelist nampisbio in reference namelist : Pisces variables
       READ  ( numnatp_ref, nampismod, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampismod in reference namelist' )
-      REWIND( numnatp_cfg )              ! Namelist nampisbio in configuration namelist : Pisces variables
       READ  ( numnatp_cfg, nampismod, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampismod in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/trcsms_pisces.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/trcsms_pisces.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/trcsms_pisces.F90	(revision 12928)
@@ -25,5 +25,5 @@
 CONTAINS
 
-   SUBROUTINE trc_sms_pisces( kt )
+   SUBROUTINE trc_sms_pisces( kt, Kbb, Kmm, Krhs )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE trc_sms_pisces  ***
@@ -34,9 +34,10 @@
       !!---------------------------------------------------------------------
       !
-      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
+      INTEGER, INTENT( in ) ::   kt               ! ocean time-step index      
+      INTEGER, INTENT( in ) ::   Kbb, Kmm, Krhs   ! time level index
       !!---------------------------------------------------------------------
       !
-      IF( ln_p4z .OR. ln_p5z ) THEN  ;   CALL p4z_sms( kt )   !  PISCES
-      ELSE                           ;   CALL p2z_sms( kt )   !  LOBSTER
+      IF( ln_p4z .OR. ln_p5z ) THEN  ;   CALL p4z_sms( kt, Kbb, Kmm, Krhs )   !  PISCES
+      ELSE                           ;   CALL p2z_sms( kt,      Kmm, Krhs )   !  LOBSTER
       ENDIF
 
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/trcwri_pisces.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/trcwri_pisces.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/trcwri_pisces.F90	(revision 12928)
@@ -19,4 +19,6 @@
    PUBLIC trc_wri_pisces 
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -26,5 +28,5 @@
 CONTAINS
 
-   SUBROUTINE trc_wri_pisces
+   SUBROUTINE trc_wri_pisces( Kmm )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE trc_wri_trc  ***
@@ -32,4 +34,5 @@
       !! ** Purpose :   output passive tracers fields 
       !!---------------------------------------------------------------------
+      INTEGER, INTENT(in)          :: Kmm      ! time level indices
       CHARACTER (len=20)           :: cltra
       REAL(wp)                     :: zfact
@@ -43,5 +46,5 @@
          DO jn = jp_pcs0, jp_pcs1
             cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer
-            CALL iom_put( cltra, trn(:,:,:,jn) )
+            CALL iom_put( cltra, tr(:,:,:,jn,Kmm) )
          END DO
       ELSE
@@ -51,5 +54,5 @@
             IF( jn == jppo4  )                 zfact = po4r * 1.0e+6
             cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer
-            IF( iom_use( cltra ) )  CALL iom_put( cltra, trn(:,:,:,jn) * zfact )
+            IF( iom_use( cltra ) )  CALL iom_put( cltra, tr(:,:,:,jn,Kmm) * zfact )
          END DO
 
@@ -57,5 +60,5 @@
             zdic(:,:) = 0.
             DO jk = 1, jpkm1
-               zdic(:,:) = zdic(:,:) + trn(:,:,jk,jpdic) * e3t_n(:,:,jk) * tmask(:,:,jk) * 12.
+               zdic(:,:) = zdic(:,:) + tr(:,:,jk,jpdic,Kmm) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) * 12.
             ENDDO
             CALL iom_put( 'INTDIC', zdic )     
@@ -63,18 +66,14 @@
          !
          IF( iom_use( "O2MIN" ) .OR. iom_use ( "ZO2MIN" ) ) THEN  ! Oxygen minimum concentration and depth 
-            zo2min   (:,:) = trn(:,:,1,jpoxy) * tmask(:,:,1)
-            zdepo2min(:,:) = gdepw_n(:,:,1)   * tmask(:,:,1)
-            DO jk = 2, jpkm1
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     IF( tmask(ji,jj,jk) == 1 ) then
-                        IF( trn(ji,jj,jk,jpoxy) < zo2min(ji,jj) ) then
-                           zo2min   (ji,jj) = trn(ji,jj,jk,jpoxy)
-                           zdepo2min(ji,jj) = gdepw_n(ji,jj,jk)
-                        ENDIF
-                     ENDIF
-                  END DO
-               END DO
-            END DO
+            zo2min   (:,:) = tr(:,:,1,jpoxy,Kmm) * tmask(:,:,1)
+            zdepo2min(:,:) = gdepw(:,:,1,Kmm)   * tmask(:,:,1)
+            DO_3D_11_11( 2, jpkm1 )
+               IF( tmask(ji,jj,jk) == 1 ) then
+                  IF( tr(ji,jj,jk,jpoxy,Kmm) < zo2min(ji,jj) ) then
+                     zo2min   (ji,jj) = tr(ji,jj,jk,jpoxy,Kmm)
+                     zdepo2min(ji,jj) = gdepw(ji,jj,jk,Kmm)
+                  ENDIF
+               ENDIF
+            END_3D
             !
             CALL iom_put('O2MIN' , zo2min     )                              ! oxygen minimum concentration
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/README.rst
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/README.rst	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/README.rst	(revision 12928)
@@ -3,46 +3,51 @@
 ***************
 
+.. todo::
+
+
+
 .. contents::
-	:local:
-
-TOP (Tracers in the Ocean Paradigm) is the NEMO hardwired interface toward biogeochemical models and
-provide the physical constraints/boundaries for oceanic tracers.
-It consists of a modular framework to handle multiple ocean tracers, including also a variety of built-in modules.
+   :local:
+
+TOP (Tracers in the Ocean Paradigm) is the NEMO hardwired interface toward
+biogeochemical models and provide the physical constraints/boundaries for oceanic tracers.
+It consists of a modular framework to handle multiple ocean tracers,
+including also a variety of built-in modules.
 
 This component of the NEMO framework allows one to exploit available modules (see below) and
 further develop a range of applications, spanning from the implementation of a dye passive tracer to
 evaluate dispersion processes (by means of MY_TRC), track water masses age (AGE module),
-assess the ocean interior penetration of persistent chemical compounds (e.g., gases like CFC or even PCBs),
-up to the full set of equations involving marine biogeochemical cycles.
+assess the ocean interior penetration of persistent chemical compounds
+(e.g., gases like CFC or even PCBs), up to the full set of equations involving
+marine biogeochemical cycles.
 
 Structure
 =========
 
-TOP interface has the following location in the source code ``./src/MBG/`` and
+TOP interface has the following location in the source code :file:`./src/TOP` and
 the following modules are available:
 
-``TRP``
-	Interface to NEMO physical core for computing tracers transport
-
-``CFC``
-	Inert carbon tracers (CFC11,CFC12,SF6)
-
-``C14``
-	Radiocarbon passive tracer
-
-``AGE``
-	Water age tracking
-
-``MY_TRC``
-	Template for creation of new modules and external BGC models coupling
-
-``PISCES``
-	Built in BGC model.
-	See [https://www.geosci-model-dev.net/8/2465/2015/gmd-8-2465-2015-discussion.html Aumont et al. (2015)] for
-	a throughout description. |
-
-The usage of TOP is activated i) by including in the configuration definition  the component ``MBG`` and
-ii) by adding the macro ``key_top`` in the configuration CPP file
-(see for more details [http://forge.ipsl.jussieu.fr/nemo/wiki/Users "Learn more about the model"]).
+:file:`TRP`
+   Interface to NEMO physical core for computing tracers transport
+
+:file:`CFC`
+   Inert carbon tracers (CFC11,CFC12,SF6)
+
+:file:`C14`
+   Radiocarbon passive tracer
+
+:file:`AGE`
+   Water age tracking
+
+:file:`MY_TRC`
+   Template for creation of new modules and external BGC models coupling
+
+:file:`PISCES`
+   Built in BGC model. See :cite:`gmd-8-2465-2015` for a throughout description.
+
+The usage of TOP is activated
+*i)* by including in the configuration definition the component ``TOP`` and
+*ii)* by adding the macro ``key_top`` in the configuration CPP file
+(see for more details :forge:`"Learn more about the model" <wiki/Users>`).
 
 As an example, the user can refer to already available configurations in the code,
@@ -51,5 +56,6 @@
 (see also Section 4) .
 
-Note that, since version 4.0, TOP interface core functionalities are activated by means of logical keys and
+Note that, since version 4.0,
+TOP interface core functionalities are activated by means of logical keys and
 all submodules preprocessing macros from previous versions were removed.
 
@@ -57,118 +63,131 @@
 
 ``key_iomput``
-	use XIOS I/O
+   use XIOS I/O
 
 ``key_agrif``
-	enable AGRIF coupling
+   enable AGRIF coupling
 
 ``key_trdtrc`` & ``key_trdmxl_trc``
-	trend computation for tracers
+   trend computation for tracers
 
 Synthetic Workflow
 ==================
 
-A synthetic description of the TOP interface workflow is given below to summarize the steps involved in
-the computation of biogeochemical and physical trends and their time integration and outputs,
+A synthetic description of the TOP interface workflow is given below to
+summarize the steps involved in the computation of biogeochemical and physical trends and
+their time integration and outputs,
 by reporting also the principal Fortran subroutine herein involved.
 
-**Model initialization (OPA_SRC/nemogcm.F90)**
-
-call to trc_init (trcini.F90)
-
-  ↳ call trc_nam (trcnam.F90) to initialize TOP tracers and run setting
-
-  ↳ call trc_ini_sms, to initialize each submodule
-
-  ↳ call trc_ini_trp, to initialize transport for tracers
-
-  ↳ call trc_ice_ini, to initialize tracers in seaice
-
-  ↳ call trc_ini_state, read passive tracers from a restart or input data
-
-  ↳ call trc_sub_ini, setup substepping if {{{nn_dttrc /= 1}}}
-
-**Time marching procedure (OPA_SRC/stp.F90)**
-
-call to trc_stp.F90 (trcstp.F90)
-
-  ↳ call trc_sub_stp, averaging physical variables for sub-stepping
-
-  ↳ call trc_wri, call XIOS for output of data
-
-  ↳ call trc_sms, compute BGC trends for each submodule
-
-    ↳ call trc_sms_my_trc, includes also surface and coastal BCs trends
-
-  ↳ call trc_trp (TRP/trctrp.F90), compute physical trends
-
-    ↳ call trc_sbc, get trend due to surface concentration/dilution
-
-    ↳ call trc_adv, compute tracers advection
-
-    ↳ call to trc_ldf, compute tracers lateral diffusion
-
-    ↳ call to trc_zdf, vertical mixing and after tracer fields
-
-    ↳ call to trc_nxt, tracer fields at next time step. Lateral Boundary Conditions are solved in here.
-
-    ↳ call to trc_rad, Correct artificial negative concentrations
-
-  ↳ call trc_rst_wri, output tracers restart files
+Model initialization (:file:`./src/OCE/nemogcm.F90`)
+----------------------------------------------------
+
+Call to ``trc_init`` subroutine (:file:`./src/TOP/trcini.F90`) to initialize TOP.
+
+.. literalinclude:: ../../../src/TOP/trcini.F90
+   :language:        fortran
+   :lines:           41-86
+   :emphasize-lines: 21,30-32,38-40
+   :caption:         ``trc_init`` subroutine
+
+Time marching procedure (:file:`./src/OCE/step.F90`)
+----------------------------------------------------
+
+Call to ``trc_stp`` subroutine (:file:`./src/TOP/trcstp.F90`) to compute/update passive tracers.
+
+.. literalinclude:: ../../../src/TOP/trcstp.F90
+   :language:        fortran
+   :lines:           46-125
+   :emphasize-lines: 42,55-57
+   :caption:         ``trc_stp`` subroutine
+
+BGC trends computation for each submodule (:file:`./src/TOP/trcsms.F90`)
+------------------------------------------------------------------------
+
+.. literalinclude:: ../../../src/TOP/trcsms.F90
+   :language:        fortran
+   :lines:           21
+   :caption:         :file:`trcsms` snippet
+
+Physical trends computation (:file:`./src/TOP/TRP/trctrp.F90`)
+--------------------------------------------------------------
+
+.. literalinclude:: ../../../src/TOP/TRP/trctrp.F90
+   :language:        fortran
+   :lines:           46-95
+   :emphasize-lines: 17,21,29,33-35
+   :caption:         ``trc_trp`` subroutine
 
 Namelists walkthrough
 =====================
 
-namelist_top
-------------
-
-Here below are listed the features/options of the TOP interface accessible through the namelist_top_ref and
-modifiable by means of namelist_top_cfg (as for NEMO physical ones).
-
-Note that ## is used to refer to a number in an array field.
+:file:`namelist_top`
+--------------------
+
+Here below are listed the features/options of the TOP interface accessible through
+the :file:`namelist_top_ref` and modifiable by means of :file:`namelist_top_cfg`
+(as for NEMO physical ones).
+
+Note that ``##`` is used to refer to a number in an array field.
 
 .. literalinclude:: ../../namelists/namtrc_run
+   :language: fortran
 
 .. literalinclude:: ../../namelists/namtrc
+   :language: fortran
 
 .. literalinclude:: ../../namelists/namtrc_dta
+   :language: fortran
 
 .. literalinclude:: ../../namelists/namtrc_adv
+   :language: fortran
 
 .. literalinclude:: ../../namelists/namtrc_ldf
+   :language: fortran
 
 .. literalinclude:: ../../namelists/namtrc_rad
+   :language: fortran
 
 .. literalinclude:: ../../namelists/namtrc_snk
+   :language: fortran
 
 .. literalinclude:: ../../namelists/namtrc_dmp
+   :language: fortran
 
 .. literalinclude:: ../../namelists/namtrc_ice
+   :language: fortran
 
 .. literalinclude:: ../../namelists/namtrc_trd
+   :language: fortran
 
 .. literalinclude:: ../../namelists/namtrc_bc
+   :language: fortran
 
 .. literalinclude:: ../../namelists/namtrc_bdy
+   :language: fortran
 
 .. literalinclude:: ../../namelists/namage
-
-Two main types of data structure are used within TOP interface to initialize tracer properties (1) and
+   :language: fortran
+
+Two main types of data structure are used within TOP interface
+to initialize tracer properties (1) and
 to provide related initial and boundary conditions (2).
 
-**1. TOP tracers initialization**: sn_tracer (namtrc)
+1. TOP tracers initialization: ``sn_tracer`` (``&namtrc``)
+^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 
 Beside providing name and metadata for tracers,
-here are also defined the use of initial ({{{sn_tracer%llinit}}}) and
-boundary ({{{sn_tracer%llsbc, sn_tracer%llcbc, sn_tracer%llobc}}}) conditions.
-
-In the following, an example of the full structure definition is given for two idealized tracers both with
-initial conditions given, while the first has only surface boundary forcing and
+here are also defined the use of initial (``sn_tracer%llinit``) and
+boundary (``sn_tracer%llsbc, sn_tracer%llcbc, sn_tracer%llobc``) conditions.
+
+In the following, an example of the full structure definition is given for
+two idealized tracers both with initial conditions given,
+while the first has only surface boundary forcing and
 the second both surface and coastal forcings:
 
 .. code-block:: fortran
 
-	!             !    name   !           title of the field            !   units    ! initial data ! sbc   !   cbc  !   obc  !
-	sn_tracer(1)  = 'TRC1'    , 'Tracer 1 Concentration                ',   ' - '    ,  .true.      , .true., .false., .true.
-	sn_tracer(2)  = 'TRC2 '   , 'Tracer 2 Concentration                ',   ' - '    ,  .true.      , .true., .true. , .false.
+   !             !    name   !           title of the field            !   units    ! initial data ! sbc   !   cbc  !   obc  !
+   sn_tracer(1)  = 'TRC1'    , 'Tracer 1 Concentration                ',   ' - '    ,  .true.      , .true., .false., .true.
+   sn_tracer(2)  = 'TRC2 '   , 'Tracer 2 Concentration                ',   ' - '    ,  .true.      , .true., .true. , .false.
 
 As tracers in BGC models are increasingly growing,
@@ -177,94 +196,101 @@
 .. code-block:: fortran
 
-	!             !    name   !           title of the field            !   units    ! initial data !
-	sn_tracer(1)  = 'TRC1'    , 'Tracer 1 Concentration                ',   ' - '    ,   .true.
-	sn_tracer(2)  = 'TRC2 '   , 'Tracer 2 Concentration                ',   ' - '    ,   .true.
-	! sbc
-	sn_tracer(1)%llsbc = .true.
-	sn_tracer(2)%llsbc = .true.
-	! cbc
-	sn_tracer(2)%llcbc = .true.
+   !             !    name   !           title of the field            !   units    ! initial data !
+   sn_tracer(1)  = 'TRC1'    , 'Tracer 1 Concentration                ',   ' - '    ,   .true.
+   sn_tracer(2)  = 'TRC2 '   , 'Tracer 2 Concentration                ',   ' - '    ,   .true.
+   ! sbc
+   sn_tracer(1)%llsbc = .true.
+   sn_tracer(2)%llsbc = .true.
+   ! cbc
+   sn_tracer(2)%llcbc = .true.
 
 The data structure is internally initialized by code with dummy names and
-all initialization/forcing logical fields set to .false. .
-
-**2. Structures to read input initial and boundary conditions**: namtrc_dta (sn_trcdta), namtrc_bc (sn_trcsbc/sn_trccbc/sn_trcobc)
+all initialization/forcing logical fields set to ``.false.`` .
+
+2. Structures to read input initial and boundary conditions: ``&namtrc_dta`` (``sn_trcdta``), ``&namtrc_bc`` (``sn_trcsbc`` / ``sn_trccbc`` / ``sn_trcobc``)
+^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 
 The overall data structure (Fortran type) is based on the general one defined for NEMO core in the SBC component
-(see details in User Manual SBC Chapter on Input Data specification).
-
-Input fields are prescribed within namtrc_dta (with sn_trcdta structure),
-while Boundary Conditions are applied to the model by means of namtrc_bc,
-with dedicated structure fields for surface (sn_trcsbc), riverine (sn_trccbc), and
-lateral open (sn_trcobc) boundaries.
+(see details in ``SBC`` Chapter of :doc:`Reference Manual <cite>` on Input Data specification).
+
+Input fields are prescribed within ``&namtrc_dta`` (with ``sn_trcdta`` structure),
+while Boundary Conditions are applied to the model by means of ``&namtrc_bc``,
+with dedicated structure fields for surface (``sn_trcsbc``), riverine (``sn_trccbc``), and
+lateral open (``sn_trcobc``) boundaries.
 
 The following example illustrates the data structure in the case of initial condition for
-a single tracer contained in the file named tracer_1_data.nc (.nc is implicitly assumed in namelist filename),
-with a doubled initial value, and located in the usr/work/model/inputdata/ folder:
+a single tracer contained in the file named :file:`tracer_1_data.nc`
+(``.nc`` is implicitly assumed in namelist filename),
+with a doubled initial value, and located in the :file:`usr/work/model/inputdata` folder:
 
 .. code-block:: fortran
 
-	!               !  file name             ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
-	!               !                        !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
-	  sn_trcdta(1)  = 'tracer_1_data'        ,        -12        ,  'TRC1'   ,    .false.   , .true. , 'yearly'  , ''       , ''       , ''
-	  rf_trfac(1) = 2.0
-	  cn_dir = “usr/work/model/inputdata/”
-
-Note that, the Lateral Open Boundaries conditions are applied on the segments defined for the physical core of NEMO
-(see BDY description in the User Manual).
-
-namelist_trc
-------------
-
-Here below the description of namelist_trc_ref used to handle Carbon tracers modules, namely CFC and C14.
-
-|||| &'''namcfc'''     !   CFC ||
-
-|||| &'''namc14_typ'''     !  C14 - type of C14 tracer, default values of C14/C and pco2 ||
-
-|||| &'''namc14_sbc'''     !  C14 - surface BC ||
-
-|||| &'''namc14_fcg'''     !  files & dates ||
+   !               !  file name             ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+   !               !                        !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+     sn_trcdta(1)  = 'tracer_1_data'        ,        -12        ,  'TRC1'   ,    .false.   , .true. , 'yearly'  , ''       , ''       , ''
+     rf_trfac(1) = 2.0
+     cn_dir = 'usr/work/model/inputdata/'
+
+Note that, the Lateral Open Boundaries conditions are applied on
+the segments defined for the physical core of NEMO
+(see ``BDY`` description in the :doc:`Reference Manual <cite>`).
+
+:file:`namelist_trc`
+--------------------
+
+Here below the description of :file:`namelist_trc_ref` used to handle Carbon tracers modules,
+namely CFC and C14.
+
+.. literalinclude:: ../../../cfgs/SHARED/namelist_trc_ref
+   :language: fortran
+   :lines: 7,17,26,34
+   :caption: :file:`namelist_trc_ref` snippet
 
 ``MY_TRC`` interface for coupling external BGC models
 =====================================================
 
-The generalized interface is pivoted on MY_TRC module that contains template files to build the coupling between
+The generalized interface is pivoted on MY_TRC module that contains template files to
+build the coupling between
 NEMO and any external BGC model.
 
-The call to MY_TRC is activated by setting ``ln_my_trc = .true.`` (in namtrc)
+The call to MY_TRC is activated by setting ``ln_my_trc = .true.`` (in ``&namtrc``)
 
 The following 6 fortran files are available in MY_TRC with the specific purposes here described.
 
-``par_my_trc.F90``
-	This module allows to define additional arrays and public variables to be used within the MY_TRC interface
-
-``trcini_my_trc.F90``
-	Here are initialized user defined namelists and the call to the external BGC model initialization procedures to
-	populate general tracer array (trn and trb). Here are also likely to be defined suport arrays related to
-	system metrics that could be needed by the BGC model.
-
-``trcnam_my_trc.F90``
-	This routine is called at the beginning of trcini_my_trc and should contain the initialization of
-	additional namelists for the BGC model or user-defined code.
-
-``trcsms_my_trc.F90``
-	The routine performs the call to Boundary Conditions and its main purpose is to
-	contain the Source-Minus-Sinks terms due to the biogeochemical processes of the external model.
-	Be aware that lateral boundary conditions are applied in trcnxt routine.
-	IMPORTANT: the routines to compute the light penetration along the water column and
-	the tracer vertical sinking should be defined/called in here, as generalized modules are still missing in
-	the code.
-
-``trcice_my_trc.F90``
-	Here it is possible to prescribe the tracers concentrations in the seaice that will be used as
-	boundary conditions when ice melting occurs (nn_ice_tr =1 in namtrc_ice).
-	See e.g. the correspondent PISCES subroutine.
-
-``trcwri_my_trc.F90``
-	This routine performs the output of the model tracers (only those defined in namtrc) using IOM module
-	(see Manual Chapter “Output and Diagnostics”).
-	It is possible to place here the output of additional variables produced by the model,
-	if not done elsewhere in the code, using the call to iom_put.
+:file:`par_my_trc.F90`
+   This module allows to define additional arrays and public variables to
+   be used within the MY_TRC interface
+
+:file:`trcini_my_trc.F90`
+   Here are initialized user defined namelists and
+   the call to the external BGC model initialization procedures to populate general tracer array
+   (``trn`` and ``trb``).
+   Here are also likely to be defined support arrays related to system metrics that
+   could be needed by the BGC model.
+
+:file:`trcnam_my_trc.F90`
+   This routine is called at the beginning of ``trcini_my_trc`` and
+   should contain the initialization of additional namelists for the BGC model or user-defined code.
+
+:file:`trcsms_my_trc.F90`
+   The routine performs the call to Boundary Conditions and its main purpose is to
+   contain the Source-Minus-Sinks terms due to the biogeochemical processes of the external model.
+   Be aware that lateral boundary conditions are applied in trcnxt routine.
+
+   .. warning::
+      The routines to compute the light penetration along the water column and
+      the tracer vertical sinking should be defined/called in here,
+      as generalized modules are still missing in the code.
+
+:file:`trcice_my_trc.F90`
+   Here it is possible to prescribe the tracers concentrations in the sea-ice that
+   will be used as boundary conditions when ice melting occurs (``nn_ice_tr = 1`` in ``&namtrc_ice``).
+   See e.g. the correspondent PISCES subroutine.
+
+:file:`trcwri_my_trc.F90`
+   This routine performs the output of the model tracers (only those defined in ``&namtrc``) using
+   IOM module (see chapter “Output and Diagnostics” in the :doc:`Reference Manual <cite>`).
+   It is possible to place here the output of additional variables produced by the model,
+   if not done elsewhere in the code, using the call to ``iom_put``.
 
 Coupling an external BGC model using NEMO framework
@@ -273,18 +299,20 @@
 The coupling with an external BGC model through the NEMO compilation framework can be achieved in
 different ways according to the degree of coding complexity of the Biogeochemical model, like e.g.,
-the whole code is made only by one file or it has multiple modules and interfaces spread across several subfolders.
-
-Beside the 6 core files of MY_TRC module, let’s assume an external BGC model named *MYBGC* and constituted by
-a rather essential coding structure, likely few Fortran files.
+the whole code is made only by one file or
+it has multiple modules and interfaces spread across several subfolders.
+
+Beside the 6 core files of MY_TRC module, let’s assume an external BGC model named *MYBGC* and
+constituted by a rather essential coding structure, likely few Fortran files.
 The new coupled configuration name is *NEMO_MYBGC*.
 
-The best solution is to have all files (the modified ``MY_TRC`` routines and the BGC model ones) placed in
-a unique folder with root ``MYBGCPATH`` and to use the makenemo external readdressing of ``MY_SRC`` folder.
-
-The coupled configuration listed in ``work_cfgs.txt`` will look like
+The best solution is to have all files (the modified ``MY_TRC`` routines and the BGC model ones)
+placed in a unique folder with root ``MYBGCPATH`` and
+to use the makenemo external readdressing of ``MY_SRC`` folder.
+
+The coupled configuration listed in :file:`work_cfgs.txt` will look like
 
 ::
 
-	NEMO_MYBGC OPA_SRC TOP_SRC
+   NEMO_MYBGC OCE TOP
 
 and the related ``cpp_MYBGC.fcm`` content will be
@@ -292,46 +320,46 @@
 .. code-block:: perl
 
-	bld::tool::fppkeys  key_iomput key_mpp_mpi key_top
-
-the compilation with ``makenemo`` will be executed through the following syntax
+   bld::tool::fppkeys key_iomput key_mpp_mpi key_top
+
+the compilation with :file:`makenemo` will be executed through the following syntax
 
 .. code-block:: console
 
-	$ makenemo -n 'NEMO_MYBGC' -m '<arch_my_machine>' -j 8 -e '<MYBGCPATH>'
-
-The makenemo feature “-e” was introduced to readdress at compilation time the standard MY_SRC folder
-(usually found in NEMO configurations) with a user defined external one.
-
-The compilation of more articulated BGC model code & infrastructure, like in the case of BFM
-([http://www.bfm-community.eu/publications/bfmnemomanual_r1.0_201508.pdf BFM-NEMO coupling manual]),
-requires some additional features.
+   $ makenemo -n 'NEMO_MYBGC' -m '<arch_my_machine>' -j 8 -e '<MYBGCPATH>'
+
+The makenemo feature ``-e`` was introduced to
+readdress at compilation time the standard MY_SRC folder (usually found in NEMO configurations) with
+a user defined external one.
+
+The compilation of more articulated BGC model code & infrastructure,
+like in the case of BFM (|BFM man|_), requires some additional features.
 
 As before, let’s assume a coupled configuration name *NEMO_MYBGC*,
-but in this case MYBGC model root becomes ``<MYBGCPATH>`` that contains 4 different subfolders for
-biogeochemistry, named ``initialization``, ``pelagic``, and ``benthic``, and
-a separate one named ``nemo_coupling`` including the modified ``MY_SRC`` routines.
+but in this case MYBGC model root becomes :file:`MYBGC` path that
+contains 4 different subfolders for biogeochemistry,
+named :file:`initialization`, :file:`pelagic`, and :file:`benthic`,
+and a separate one named :file:`nemo_coupling` including the modified `MY_SRC` routines.
 The latter folder containing the modified NEMO coupling interface will be still linked using
-the makenemo “-e” option.
+the makenemo ``-e`` option.
 
 In order to include the BGC model subfolders in the compilation of NEMO code,
-it will be necessary to extend the configuration ``cpp_NEMO_MYBGC.fcm`` file to include the specific paths of
-``MYBGC`` folders, as in the following example
+it will be necessary to extend the configuration :file:`cpp_NEMO_MYBGC.fcm` file to include the specific paths of :file:`MYBGC` folders, as in the following example
 
 .. code-block:: perl
 
-	bld::tool::fppkeys  key_iomput key_mpp_mpi key_top
-	
-	src::MYBGC::initialization         <MYBGCPATH>/initialization
-	src::MYBGC::pelagic                <MYBGCPATH>/pelagic
-	src::MYBGC::benthic                <MYBGCPATH>/benthic
-	
-	bld::pp::MYBGC      1
-	bld::tool::fppflags::MYBGC   %FPPFLAGS
-	bld::tool::fppkeys           %bld::tool::fppkeys MYBGC_MACROS
+   bld::tool::fppkeys  key_iomput key_mpp_mpi key_top
+
+   src::MYBGC::initialization         <MYBGCPATH>/initialization
+   src::MYBGC::pelagic                <MYBGCPATH>/pelagic
+   src::MYBGC::benthic                <MYBGCPATH>/benthic
+
+   bld::pp::MYBGC      1
+   bld::tool::fppflags::MYBGC   %FPPFLAGS
+   bld::tool::fppkeys           %bld::tool::fppkeys MYBGC_MACROS
 
 where *MYBGC_MACROS* is the space delimited list of macros used in *MYBGC* model for
 selecting/excluding specific parts of the code.
-The BGC model code will be preprocessed in the configuration ``BLD`` folder as for NEMO,
-but with an independent path, like ``NEMO_MYBGC/BLD/MYBGC/<subforlders>``.
+The BGC model code will be preprocessed in the configuration :file:`BLD` folder as for NEMO,
+but with an independent path, like :file:`NEMO_MYBGC/BLD/MYBGC/<subforlders>`.
 
 The compilation will be performed similarly to in the previous case with the following
@@ -339,20 +367,26 @@
 .. code-block:: console
 
-	$ makenemo -n 'NEMO_MYBGC' -m '<arch_my_machine>' -j 8 -e '<MYBGCPATH>/nemo_coupling'
-
-Note that, the additional lines specific for the BGC model source and build paths can be written into
-a separate file, e.g. named ``MYBGC.fcm``, and then simply included in the ``cpp_NEMO_MYBGC.fcm`` as follow
-
-.. code-block:: perl
-
-	bld::tool::fppkeys  key_zdftke key_dynspg_ts key_iomput key_mpp_mpi key_top
-	inc <MYBGCPATH>/MYBGC.fcm
-
-This will enable a more portable compilation structure for all MYBGC related configurations.
-
-**Important**: the coupling interface contained in nemo_coupling cannot be added using the FCM syntax,
-as the same files already exists in NEMO and they are overridden only with the readdressing of MY_SRC contents to
-avoid compilation conflicts due to duplicate routines.
-
-All modifications illustrated above, can be easily implemented using shell or python scripting to
-edit the NEMO configuration CPP.fcm file and to create the BGC model specific FCM compilation file with code paths.
+   $ makenemo -n 'NEMO_MYBGC' -m '<arch_my_machine>' -j 8 -e '<MYBGCPATH>/nemo_coupling'
+
+.. note::
+   The additional lines specific for the BGC model source and build paths can be written into
+   a separate file, e.g. named :file:`MYBGC.fcm`,
+   and then simply included in the :file:`cpp_NEMO_MYBGC.fcm` as follow
+
+   .. code-block:: perl
+
+      bld::tool::fppkeys  key_zdftke key_dynspg_ts key_iomput key_mpp_mpi key_top
+      inc <MYBGCPATH>/MYBGC.fcm
+
+   This will enable a more portable compilation structure for all MYBGC related configurations.
+
+.. warning::
+   The coupling interface contained in :file:`nemo_coupling` cannot be added using the FCM syntax,
+   as the same files already exists in NEMO and they are overridden only with
+   the readdressing of MY_SRC contents to avoid compilation conflicts due to duplicate routines.
+
+All modifications illustrated above, can be easily implemented using shell or python scripting
+to edit the NEMO configuration :file:`CPP.fcm` file and
+to create the BGC model specific FCM compilation file with code paths.
+
+.. |BFM man| replace:: BFM-NEMO coupling manual
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trcadv.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trcadv.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trcadv.F90	(revision 12928)
@@ -59,6 +59,4 @@
    INTEGER, PARAMETER ::   np_QCK     = 5   ! QUICK scheme
    
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -68,5 +66,5 @@
 CONTAINS
 
-   SUBROUTINE trc_adv( kt )
+   SUBROUTINE trc_adv( kt, Kbb, Kmm, ptr, Krhs  )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE trc_adv  ***
@@ -74,11 +72,13 @@
       !! ** Purpose :   compute the ocean tracer advection trend.
       !!
-      !! ** Method  : - Update after tracers (tra) with the advection term following nadv
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !! ** Method  : - Update after tracers (tr(Krhs)) with the advection term following nadv
+      !!----------------------------------------------------------------------
+      INTEGER                                   , INTENT(in)    :: kt   ! ocean time-step index
+      INTEGER                                   , INTENT(in)    :: Kbb, Kmm, Krhs ! time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr            ! passive tracers and RHS of tracer equation
       !
       INTEGER ::   jk   ! dummy loop index
       CHARACTER (len=22) ::   charout
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zun, zvn, zwn  ! effective velocity
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zuu, zvv, zww  ! effective velocity
       !!----------------------------------------------------------------------
       !
@@ -87,34 +87,34 @@
       !                                         !==  effective transport  ==!
       IF( l_offline ) THEN
-         zun(:,:,:) = un(:,:,:)                    ! already in (un,vn,wn)
-         zvn(:,:,:) = vn(:,:,:)
-         zwn(:,:,:) = wn(:,:,:)
+         zuu(:,:,:) = uu(:,:,:,Kmm)                ! already in (uu(Kmm),vv(Kmm),ww)
+         zvv(:,:,:) = vv(:,:,:,Kmm)
+         zww(:,:,:) = ww(:,:,:)
       ELSE                                         ! build the effective transport
-         zun(:,:,jpk) = 0._wp
-         zvn(:,:,jpk) = 0._wp
-         zwn(:,:,jpk) = 0._wp
+         zuu(:,:,jpk) = 0._wp
+         zvv(:,:,jpk) = 0._wp
+         zww(:,:,jpk) = 0._wp
          IF( ln_wave .AND. ln_sdw )  THEN
             DO jk = 1, jpkm1                                                       ! eulerian transport + Stokes Drift
-               zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * ( un(:,:,jk) + usd(:,:,jk) )
-               zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * ( vn(:,:,jk) + vsd(:,:,jk) )
-               zwn(:,:,jk) = e1e2t(:,:)                 * ( wn(:,:,jk) + wsd(:,:,jk) )
+               zuu(:,:,jk) = e2u  (:,:) * e3u(:,:,jk,Kmm) * ( uu(:,:,jk,Kmm) + usd(:,:,jk) )
+               zvv(:,:,jk) = e1v  (:,:) * e3v(:,:,jk,Kmm) * ( vv(:,:,jk,Kmm) + vsd(:,:,jk) )
+               zww(:,:,jk) = e1e2t(:,:)                   * ( ww(:,:,jk) + wsd(:,:,jk) )
             END DO
          ELSE
             DO jk = 1, jpkm1
-               zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * un(:,:,jk)                   ! eulerian transport
-               zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * vn(:,:,jk)
-               zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk)
+               zuu(:,:,jk) = e2u  (:,:) * e3u(:,:,jk,Kmm) * uu(:,:,jk,Kmm)                   ! eulerian transport
+               zvv(:,:,jk) = e1v  (:,:) * e3v(:,:,jk,Kmm) * vv(:,:,jk,Kmm)
+               zww(:,:,jk) = e1e2t(:,:)                   * ww(:,:,jk)
             END DO
          ENDIF
          !
          IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                 ! add z-tilde and/or vvl corrections
-            zun(:,:,:) = zun(:,:,:) + un_td(:,:,:)
-            zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:)
+            zuu(:,:,:) = zuu(:,:,:) + un_td(:,:,:)
+            zvv(:,:,:) = zvv(:,:,:) + vn_td(:,:,:)
          ENDIF
          !
          IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   & 
-            &              CALL ldf_eiv_trp( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the eiv transport
-         !
-         IF( ln_mle    )   CALL tra_mle_trp( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the mle transport
+            &              CALL ldf_eiv_trp( kt, nittrc000, zuu, zvv, zww, 'TRC', Kmm, Krhs )  ! add the eiv transport
+         !
+         IF( ln_mle    )   CALL tra_mle_trp( kt, nittrc000, zuu, zvv, zww, 'TRC', Kmm       )  ! add the mle transport
          !
       ENDIF
@@ -123,20 +123,20 @@
       !
       CASE ( np_CEN )                                 ! Centered : 2nd / 4th order
-         CALL tra_adv_cen( kt, nittrc000,'TRC',          zun, zvn, zwn     , trn, tra, jptra, nn_cen_h, nn_cen_v )
+         CALL tra_adv_cen( kt, nittrc000,'TRC',          zuu, zvv, zww,      Kmm, ptr, jptra, Krhs, nn_cen_h, nn_cen_v )
       CASE ( np_FCT )                                 ! FCT      : 2nd / 4th order
-         CALL tra_adv_fct( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra, nn_fct_h, nn_fct_v )
+         CALL tra_adv_fct( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v )
       CASE ( np_MUS )                                 ! MUSCL
-         CALL tra_adv_mus( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb,      tra, jptra        , ln_mus_ups ) 
+         CALL tra_adv_mus( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups         ) 
       CASE ( np_UBS )                                 ! UBS
-         CALL tra_adv_ubs( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra          , nn_ubs_v )
+         CALL tra_adv_ubs( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_ubs_v           )
       CASE ( np_QCK )                                 ! QUICKEST
-         CALL tra_adv_qck( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra                     )
+         CALL tra_adv_qck( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs                     )
       !
       END SELECT
       !                  
-      IF( ln_ctl ) THEN                         !== print mean trends (used for debugging)
+      IF( sn_cfctl%l_prttrc ) THEN        !== print mean trends (used for debugging)
          WRITE(charout, FMT="('adv ')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+         CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
       END IF
       !
@@ -164,8 +164,6 @@
       !
       !                                !==  Namelist  ==!
-      REWIND( numnat_ref )                   !  namtrc_adv in reference namelist 
       READ  ( numnat_ref, namtrc_adv, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_adv in reference namelist' )
-      REWIND( numnat_cfg )                   ! namtrc_adv in configuration namelist
       READ  ( numnat_cfg, namtrc_adv, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_adv in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trcatf.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trcatf.F90	(revision 12928)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trcatf.F90	(revision 12928)
@@ -0,0 +1,275 @@
+MODULE trcatf
+   !!======================================================================
+   !!                       ***  MODULE  trcatf  ***
+   !! Ocean passive tracers:  time stepping on passives tracers
+   !!======================================================================
+   !! History :  7.0  !  1991-11  (G. Madec)  Original code
+   !!                 !  1993-03  (M. Guyon)  symetrical conditions
+   !!                 !  1995-02  (M. Levy)   passive tracers
+   !!                 !  1996-02  (G. Madec & M. Imbard)  opa release 8.0
+   !!            8.0  !  1996-04  (A. Weaver)  Euler forward step
+   !!            8.2  !  1999-02  (G. Madec, N. Grima)  semi-implicit pressure grad.
+   !!  NEMO      1.0  !  2002-08  (G. Madec)  F90: Free form and module
+   !!                 !  2002-08  (G. Madec)  F90: Free form and module
+   !!                 !  2002-11  (C. Talandier, A-M Treguier) Open boundaries
+   !!                 !  2004-03  (C. Ethe) passive tracers
+   !!                 !  2007-02  (C. Deltel) Diagnose ML trends for passive tracers
+   !!            2.0  !  2006-02  (L. Debreu, C. Mazauric) Agrif implementation
+   !!            3.0  !  2008-06  (G. Madec)  time stepping always done in trazdf
+   !!            3.1  !  2009-02  (G. Madec, R. Benshila)  re-introduce the vvl option
+   !!            3.3  !  2010-06  (C. Ethe, G. Madec) Merge TRA-TRC
+   !!            4.1  !  2019-08  (A. Coward, D. Storkey) rename trcnxt.F90 -> trcatf.F90. Now only does time filtering.
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_atf     : time stepping on passive tracers
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! ocean dynamics and tracers variables
+   USE trc             ! ocean passive tracers variables
+   USE trd_oce
+   USE trdtra
+   USE traatf
+   USE bdy_oce   , ONLY: ln_bdy
+   USE trcbdy          ! BDY open boundaries
+# if defined key_agrif
+   USE agrif_top_interp
+# endif
+   !
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE prtctl_trc      ! Print control for debbuging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_atf   ! routine called by step.F90
+
+   REAL(wp) ::   rfact1, rfact2
+
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
+   !! $Id$ 
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_atf( kt, Kbb, Kmm, Kaa, ptr )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE trcatf  ***
+      !!
+      !! ** Purpose :   Apply the boundary condition on the after passive tracers fields and
+      !!      apply Asselin time filter to the now passive tracer fields if using leapfrog timestep
+      !! 
+      !! ** Method  :   Apply lateral boundary conditions on (uu(Kaa),vv(Kaa)) through 
+      !!      call to lbc_lnk routine
+      !!
+      !!   For Arakawa or TVD Scheme : 
+      !!      A Asselin time filter applied on now tracers tr(Kmm) to avoid
+      !!      the divergence of two consecutive time-steps and tr arrays
+      !!      to prepare the next time_step:
+      !!         (tr(Kmm)) = (tr(Kmm)) + rn_atfp [ (tr(Kbb)) + (tr(Kaa)) - 2 (tr(Kmm)) ]
+      !!
+      !!
+      !! ** Action  : - update tr(Kmm), tr(Kaa)
+      !!----------------------------------------------------------------------
+      INTEGER                                   , INTENT( in )  :: kt             ! ocean time-step index
+      INTEGER                                   , INTENT( in )  :: Kbb, Kmm, Kaa ! time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr            ! passive tracers
+      !
+      INTEGER  ::   jk, jn   ! dummy loop indices
+      REAL(wp) ::   zfact            ! temporary scalar
+      CHARACTER (len=22) :: charout
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   ztrdt    ! 4D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( ln_timing )   CALL timing_start('trc_atf')
+      !
+      IF( kt == nittrc000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_atf : Asselin time filtering on passive tracers'
+      ENDIF
+      !
+#if defined key_agrif
+      CALL Agrif_trc                   ! AGRIF zoom boundaries
+#endif
+      ! Update after tracer on domain lateral boundaries
+      CALL lbc_lnk( 'trcatf', ptr(:,:,:,:,Kaa), 'T', 1. )   
+
+      IF( ln_bdy )  CALL trc_bdy( kt, Kbb, Kmm, Kaa )
+
+      IF( l_trdtrc )  THEN             ! trends: store now fields before the Asselin filter application
+         ALLOCATE( ztrdt(jpi,jpj,jpk,jptra) )
+         ztrdt(:,:,:,:)  = 0._wp
+         IF( ln_traldf_iso ) THEN                       ! diagnose the "pure" Kz diffusive trend 
+            DO jn = 1, jptra
+               CALL trd_tra( kt, Kmm, Kaa, 'TRC', jn, jptra_zdfp, ztrdt(:,:,:,jn) )
+            ENDDO
+         ENDIF
+
+         ! total trend for the non-time-filtered variables. 
+         zfact = 1.0 / rn_Dt
+         ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from ts(Kmm) terms
+         IF( ln_linssh ) THEN       ! linear sea surface height only
+            DO jn = 1, jptra
+               DO jk = 1, jpkm1
+                  ztrdt(:,:,jk,jn) = ( ptr(:,:,jk,jn,Kaa)*e3t(:,:,jk,Kaa) / e3t(:,:,jk,Kmm) - ptr(:,:,jk,jn,Kmm)) * zfact
+               END DO
+            END DO
+         ELSE
+            DO jn = 1, jptra
+               DO jk = 1, jpkm1
+                  ztrdt(:,:,jk,jn) = ( ptr(:,:,jk,jn,Kaa) - ptr(:,:,jk,jn,Kmm) ) * zfact
+               END DO
+            END DO
+         ENDIF
+         !
+         DO jn = 1, jptra
+            CALL trd_tra( kt, Kmm, Kaa, 'TRC', jn, jptra_tot, ztrdt(:,:,:,jn) )
+         ENDDO
+         !
+         IF( ln_linssh ) THEN       ! linear sea surface height only
+            ! Store now fields before applying the Asselin filter 
+            ! in order to calculate Asselin filter trend later.
+            ztrdt(:,:,:,:) = ptr(:,:,:,:,Kmm) 
+         ENDIF
+
+      ENDIF
+      !                                ! Leap-Frog + Asselin filter time stepping
+      IF( l_1st_euler .OR. ln_top_euler ) THEN    ! Euler time-stepping 
+         !
+         IF (l_trdtrc .AND. .NOT. ln_linssh ) THEN   ! Zero Asselin filter contribution must be explicitly written out since for vvl
+            !                                        ! Asselin filter is output by tra_nxt_vvl that is not called on this time step
+            ztrdt(:,:,:,:) = 0._wp            
+            DO jn = 1, jptra
+               CALL trd_tra( kt, Kmm, Kaa, 'TRC', jn, jptra_atf, ztrdt(:,:,:,jn) )
+            ENDDO
+         END IF
+         !
+      ELSE     
+         IF( .NOT. l_offline ) THEN ! Leap-Frog + Asselin filter time stepping
+            IF( ln_linssh ) THEN   ;   CALL tra_atf_fix( kt, Kbb, Kmm, Kaa, nittrc000,         'TRC', ptr, jptra )                     !     linear ssh
+            ELSE                   ;   CALL tra_atf_vvl( kt, Kbb, Kmm, Kaa, nittrc000, rn_Dt, 'TRC', ptr, sbc_trc, sbc_trc_b, jptra ) ! non-linear ssh
+            ENDIF
+         ELSE
+                                       CALL trc_atf_off( kt, Kbb, Kmm, Kaa, ptr )       ! offline 
+         ENDIF
+         !
+         CALL lbc_lnk_multi( 'trcatf', ptr(:,:,:,:,Kmm), 'T', 1._wp, ptr(:,:,:,:,Kaa), 'T', 1._wp, ptr(:,:,:,:,Kaa), 'T', 1._wp )
+      ENDIF
+      !
+      IF( l_trdtrc .AND. ln_linssh ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt )
+         DO jn = 1, jptra
+            DO jk = 1, jpkm1
+               zfact = 1._wp / rDt_trc  
+               ztrdt(:,:,jk,jn) = ( ptr(:,:,jk,jn,Kbb) - ztrdt(:,:,jk,jn) ) * zfact 
+            END DO
+            CALL trd_tra( kt, Kmm, Kaa, 'TRC', jn, jptra_atf, ztrdt(:,:,:,jn) )
+         END DO
+      END IF
+      IF( l_trdtrc ) DEALLOCATE( ztrdt ) 
+      !
+      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('nxt')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=ptr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm)
+      ENDIF
+      !
+      IF( ln_timing )   CALL timing_stop('trc_atf')
+      !
+   END SUBROUTINE trc_atf
+
+
+   SUBROUTINE trc_atf_off( kt, Kbb, Kmm, Kaa, ptr )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE tra_atf_off  ***
+      !!
+      !!          !!!!!!!!!!!!!!!!! REWRITE HEADER COMMENTS !!!!!!!!!!!!!!
+      !!
+      !! ** Purpose :   Time varying volume: apply the Asselin time filter  
+      !! 
+      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields.
+      !!              - save in (ta,sa) a thickness weighted average over the three 
+      !!             time levels which will be used to compute rdn and thus the semi-
+      !!             implicit hydrostatic pressure gradient (ln_dynhpg_imp = T)
+      !!              - swap tracer fields to prepare the next time_step.
+      !!                This can be summurized for tempearture as:
+      !!             ztm = ( e3t_n*tn + rbcp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )   ln_dynhpg_imp = T
+      !!                  /( e3t(:,:,:,Kmm)    + rbcp*[ e3t(:,:,:,Kbb)    - 2 e3t(:,:,:,Kmm)    + e3t(:,:,:,Kaa)    ] )   
+      !!             ztm = 0                                                       otherwise
+      !!             tb  = ( e3t_n*tn + rn_atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )
+      !!                  /( e3t(:,:,:,Kmm)    + rn_atfp*[ e3t(:,:,:,Kbb)    - 2 e3t(:,:,:,Kmm)    + e3t(:,:,:,Kaa)    ] )
+      !!             tn  = ta 
+      !!             ta  = zt        (NB: reset to 0 after eos_bn2 call)
+      !!
+      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
+      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
+      !!----------------------------------------------------------------------
+      INTEGER                                   , INTENT(in   ) ::  kt            ! ocean time-step index
+      INTEGER                                   , INTENT(in   ) ::  Kbb, Kmm, Kaa ! time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) ::  ptr           ! passive tracers
+      !!     
+      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
+      REAL(wp) ::   ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar
+      REAL(wp) ::   ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d   !   -      -
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nittrc000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'trc_atf_off : Asselin time filtering'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+         IF( .NOT. ln_linssh ) THEN
+            rfact1 = rn_atfp * rn_Dt
+            rfact2 = rfact1 / rho0
+         ENDIF
+        !  
+      ENDIF
+      !
+      DO jn = 1, jptra      
+         DO_3D_11_11( 1, jpkm1 )
+            ze3t_b = e3t(ji,jj,jk,Kbb)
+            ze3t_n = e3t(ji,jj,jk,Kmm)
+            ze3t_a = e3t(ji,jj,jk,Kaa)
+            !                                         ! tracer content at Before, now and after
+            ztc_b  = ptr(ji,jj,jk,jn,Kbb)  * ze3t_b
+            ztc_n  = ptr(ji,jj,jk,jn,Kmm)  * ze3t_n
+            ztc_a  = ptr(ji,jj,jk,jn,Kaa) * ze3t_a
+            !
+            ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b
+            ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b
+            !
+            ze3t_f = ze3t_n + rn_atfp * ze3t_d
+            ztc_f  = ztc_n  + rn_atfp * ztc_d
+            !
+            IF( .NOT. ln_linssh .AND. jk == mikt(ji,jj) ) THEN           ! first level 
+               ze3t_f = ze3t_f - rfact2 * ( emp_b(ji,jj)      - emp(ji,jj)   ) 
+               ztc_f  = ztc_f  - rfact1 * ( sbc_trc(ji,jj,jn) - sbc_trc_b(ji,jj,jn) )
+            ENDIF
+
+            ze3t_f = 1.e0 / ze3t_f
+            ptr(ji,jj,jk,jn,Kmm) = ztc_f * ze3t_f     ! time filtered "now" field
+            !
+         END_3D
+         ! 
+      END DO
+      !
+   END SUBROUTINE trc_atf_off
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+   USE par_oce
+   USE par_trc
+CONTAINS
+   SUBROUTINE trc_atf( kt, Kbb, Kmm, Kaa, ptr )  
+      INTEGER                                   , INTENT(in)    :: kt
+      INTEGER,                                    INTENT(in   ) :: Kbb, Kmm, Kaa ! time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr           ! passive tracers and RHS of tracer equation
+      WRITE(*,*) 'trc_atf: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_atf
+#endif
+   !!======================================================================
+END MODULE trcatf
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trcbbl.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trcbbl.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trcbbl.F90	(revision 12928)
@@ -20,5 +20,5 @@
    !!    trc_bbl      : update the tracer trends due to the bottom boundary layer (advective and/or diffusive)
    !!----------------------------------------------------------------------
-   USE oce_trc        ! ocean dynamics and active tracers variables
+   USE oce_trc        ! ocean dynamics and passive tracers variables
    USE trc            ! ocean passive tracers variables
    USE trd_oce        ! trends: ocean variables
@@ -36,5 +36,5 @@
 CONTAINS
 
-   SUBROUTINE trc_bbl( kt )
+   SUBROUTINE trc_bbl( kt, Kbb, Kmm, ptr, Krhs )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE bbl  ***
@@ -45,5 +45,7 @@
       !!
       !!----------------------------------------------------------------------  
-      INTEGER, INTENT( in ) ::   kt   ! ocean time-step 
+      INTEGER,                                    INTENT( in  ) :: kt              ! ocean time-step 
+      INTEGER,                                    INTENT( in  ) :: Kbb, Kmm, Krhs  ! time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr             ! passive tracers and RHS of tracer equation
       INTEGER :: jn                   ! loop index
       CHARACTER (len=22) :: charout
@@ -53,12 +55,12 @@
       IF( ln_timing )   CALL timing_start('trc_bbl')
       !
-      IF( .NOT. l_offline .AND. nn_dttrc == 1 ) THEN
-         CALL bbl( kt, nittrc000, 'TRC' )      ! Online coupling with dynamics  : Computation of bbl coef and bbl transport
-         l_bbl = .FALSE.                       ! Offline coupling with dynamics : Read bbl coef and bbl transport from input files
+      IF( .NOT. l_offline ) THEN
+         CALL bbl( kt, nittrc000, 'TRC', Kbb, Kmm )  ! Online coupling with dynamics  : Computation of bbl coef and bbl transport
+         l_bbl = .FALSE.                             ! Offline coupling with dynamics : Read bbl coef and bbl transport from input files
       ENDIF
 
       IF( l_trdtrc )  THEN
          ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) ) ! temporary save of trends
-         ztrtrd(:,:,:,:)  = tra(:,:,:,:)
+         ztrtrd(:,:,:,:)  = ptr(:,:,:,:,Krhs)
       ENDIF
 
@@ -66,8 +68,8 @@
       IF( nn_bbl_ldf == 1 ) THEN
          !
-         CALL tra_bbl_dif( trb, tra, jptra )  
-         IF( ln_ctl )   THEN
+         CALL tra_bbl_dif( ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, Kmm )  
+         IF( sn_cfctl%l_prttrc )   THEN
             WRITE(charout, FMT="(' bbl_dif')")  ;  CALL prt_ctl_trc_info(charout)
-            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+            CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
          ENDIF
          !
@@ -77,8 +79,8 @@
       IF( nn_bbl_adv /= 0 ) THEN
          !
-         CALL tra_bbl_adv( trb, tra, jptra )  
-         IF( ln_ctl )   THEN
+         CALL tra_bbl_adv( ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, Kmm )  
+         IF( sn_cfctl%l_prttrc )   THEN
             WRITE(charout, FMT="(' bbl_adv')")  ;  CALL prt_ctl_trc_info(charout)
-            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+            CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
          ENDIF
          !
@@ -87,6 +89,6 @@
       IF( l_trdtrc )   THEN                      ! save the horizontal diffusive trends for further diagnostics
         DO jn = 1, jptra
-           ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn)
-           CALL trd_tra( kt, 'TRC', jn, jptra_bbl, ztrtrd(:,:,:,jn) )
+           ztrtrd(:,:,:,jn) = ptr(:,:,:,jn,Krhs) - ztrtrd(:,:,:,jn)
+           CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_bbl, ztrtrd(:,:,:,jn) )
         END DO
         DEALLOCATE( ztrtrd ) ! temporary save of trends
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trcdmp.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trcdmp.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trcdmp.F90	(revision 12928)
@@ -44,5 +44,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -63,5 +63,5 @@
 
 
-   SUBROUTINE trc_dmp( kt )
+   SUBROUTINE trc_dmp( kt, Kbb, Kmm, ptr, Krhs )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE trc_dmp  ***
@@ -73,14 +73,16 @@
       !! ** Method  :   Newtonian damping towards trdta computed 
       !!      and add to the general tracer trends:
-      !!                     trn = tra + restotr * (trdta - trb)
+      !!                     tr(Kmm) = tr(Krhs) + restotr * (trdta - tr(Kbb))
       !!         The trend is computed either throughout the water column
       !!      (nlmdmptr=0) or in area of weak vertical mixing (nlmdmptr=1) or
       !!      below the well mixed layer (nlmdmptr=2)
       !!
-      !! ** Action  : - update the tracer trends tra with the newtonian 
+      !! ** Action  : - update the tracer trends tr(:,:,:,:,Krhs) with the newtonian 
       !!                damping trends.
       !!              - save the trends ('key_trdmxl_trc')
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER,                                    INTENT(in   ) :: kt              ! ocean time-step index
+      INTEGER,                                    INTENT(in   ) :: Kbb, Kmm, Krhs  ! time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr             ! passive tracers and RHS of tracer equation
       !
       INTEGER ::   ji, jj, jk, jn, jl   ! dummy loop indices
@@ -100,43 +102,31 @@
          DO jn = 1, jptra                                           ! tracer loop
             !                                                       ! ===========
-            IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)    ! save trends 
+            IF( l_trdtrc ) ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs)    ! save trends 
             !
             IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file
                !
                jl = n_trc_index(jn) 
-               CALL trc_dta( kt, sf_trcdta(jl), rf_trfac(jl), ztrcdta )   ! read tracer data at nit000
+               CALL trc_dta( kt, Kmm, sf_trcdta(jl), rf_trfac(jl), ztrcdta )   ! read tracer data at nit000
                !
                SELECT CASE ( nn_zdmp_tr )
                !
                CASE( 0 )                !==  newtonian damping throughout the water column  ==!
-                  DO jk = 1, jpkm1
-                     DO jj = 2, jpjm1
-                        DO ji = fs_2, fs_jpim1   ! vector opt.
-                           tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) )
-                        END DO
-                     END DO
-                  END DO
+                  DO_3D_00_00( 1, jpkm1 )
+                     ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - ptr(ji,jj,jk,jn,Kbb) )
+                  END_3D
                   !
                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.
-                           IF( avt(ji,jj,jk) <= avt_c )  THEN 
-                              tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) )
-                           ENDIF
-                        END DO
-                     END DO
-                  END DO
+                  DO_3D_00_00( 1, jpkm1 )
+                     IF( avt(ji,jj,jk) <= avt_c )  THEN 
+                        ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - ptr(ji,jj,jk,jn,Kbb) )
+                     ENDIF
+                  END_3D
                   !
                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( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN
-                              tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) )
-                           END IF
-                        END DO
-                     END DO
-                  END DO
+                  DO_3D_00_00( 1, jpkm1 )
+                     IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN
+                        ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - ptr(ji,jj,jk,jn,Kbb) )
+                     END IF
+                  END_3D
                   !  
                END SELECT
@@ -145,6 +135,6 @@
             !
             IF( l_trdtrc ) THEN
-               ztrtrd(:,:,:) = tra(:,:,:,jn) -  ztrtrd(:,:,:)
-               CALL trd_tra( kt, 'TRC', jn, jptra_dmp, ztrtrd )
+               ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs) -  ztrtrd(:,:,:)
+               CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_dmp, ztrtrd )
             END IF
             !                                                       ! ===========
@@ -156,8 +146,8 @@
       IF( l_trdtrc )  DEALLOCATE( ztrtrd )
       !                                          ! print mean trends (used for debugging)
-      IF( ln_ctl ) THEN
+      IF( sn_cfctl%l_prttrc ) THEN
          WRITE(charout, FMT="('dmp ')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+         CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
       ENDIF
       !
@@ -181,8 +171,6 @@
       !!----------------------------------------------------------------------
       !
-      REWIND( numnat_ref )              ! Namelist namtrc_dmp in reference namelist : Passive tracers newtonian damping
       READ  ( numnat_ref, namtrc_dmp, IOSTAT = ios, ERR = 909)
 909   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_dmp in reference namelist' )
-      REWIND( numnat_cfg )              ! Namelist namtrc_dmp in configuration namelist : Passive tracers newtonian damping
       READ  ( numnat_cfg, namtrc_dmp, IOSTAT = ios, ERR = 910)
 910   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_dmp in configuration namelist' )
@@ -224,5 +212,5 @@
 
 
-   SUBROUTINE trc_dmp_clo( kt )
+   SUBROUTINE trc_dmp_clo( kt, Kbb, Kmm )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE trc_dmp_clo  ***
@@ -236,5 +224,6 @@
       !!                nctsi2(), nctsj2() : north-east Closed sea limits (i,j)
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index
+      INTEGER, INTENT( in ) ::   Kbb, Kmm     ! time level indices
       !
       INTEGER :: ji , jj, jk, jn, jl, jc                    ! dummy loop indicesa
@@ -354,11 +343,11 @@
             IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file
                 jl = n_trc_index(jn)
-                CALL trc_dta( kt, sf_trcdta(jl), rf_trfac(jl), ztrcdta )   ! read tracer data at nit000
+                CALL trc_dta( kt, Kmm, sf_trcdta(jl), rf_trfac(jl), ztrcdta )   ! read tracer data at nit000
                 DO jc = 1, npncts
                    DO jk = 1, jpkm1
                       DO jj = nctsj1(jc), nctsj2(jc)
                          DO ji = nctsi1(jc), nctsi2(jc)
-                            trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk)
-                            trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn)
+                            tr(ji,jj,jk,jn,Kmm) = ztrcdta(ji,jj,jk)
+                            tr(ji,jj,jk,jn,Kbb) = tr(ji,jj,jk,jn,Kmm)
                          END DO
                       END DO
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trcldf.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trcldf.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trcldf.F90	(revision 12928)
@@ -43,5 +43,5 @@
    
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -51,5 +51,5 @@
 CONTAINS
 
-   SUBROUTINE trc_ldf( kt )
+   SUBROUTINE trc_ldf( kt, Kbb, Kmm, ptr, Krhs )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_ldf  ***
@@ -58,11 +58,13 @@
       !!
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      INTEGER,                                    INTENT(in   ) :: kt              ! ocean time-step index
+      INTEGER,                                    INTENT(in   ) :: Kbb, Kmm, Krhs  ! ocean time-level index
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr             ! passive tracers and RHS of tracer equation
       !
       INTEGER            :: ji, jj, jk, jn
       REAL(wp)           :: zdep
       CHARACTER (len=22) :: charout
-      REAL(wp), DIMENSION(jpi,jpj,jpk)   ::   zahu, zahv
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd
+      REAL(wp),          DIMENSION(jpi,jpj,jpk) ::   zahu, zahv
+      REAL(wp), POINTER, DIMENSION(:,:,:,:)     ::   ztrtrd
       !!----------------------------------------------------------------------
       !
@@ -73,5 +75,5 @@
       IF( l_trdtrc )  THEN
          ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) )
-         ztrtrd(:,:,:,:)  = tra(:,:,:,:)
+         ztrtrd(:,:,:,:)  = ptr(:,:,:,:,Krhs)
       ENDIF
       !                                  !* set the lateral diffusivity coef. for passive tracer      
@@ -79,39 +81,39 @@
       zahv(:,:,:) = rldf * ahtv(:,:,:)
       !                                  !* Enhanced zonal diffusivity coefficent in the equatorial domain
-      DO jk= 1, jpk
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( gdept_n(ji,jj,jk) > 200. .AND. gphit(ji,jj) < 5. .AND. gphit(ji,jj) > -5. ) THEN
-                  zdep = MAX( gdept_n(ji,jj,jk) - 1000., 0. ) / 1000.
-                  zahu(ji,jj,jk) = zahu(ji,jj,jk) * MAX( 1., rn_fact_lap * EXP( -zdep ) )
-               ENDIF
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1, jpk )
+         IF( gdept(ji,jj,jk,Kmm) > 200. .AND. gphit(ji,jj) < 5. .AND. gphit(ji,jj) > -5. ) THEN
+            zdep = MAX( gdept(ji,jj,jk,Kmm) - 1000., 0. ) / 1000.
+            zahu(ji,jj,jk) = zahu(ji,jj,jk) * MAX( 1., rn_fact_lap * EXP( -zdep ) )
+         ENDIF
+      END_3D
       !
       SELECT CASE ( nldf_trc )                 !* compute lateral mixing trend and add it to the general trend
       !
-      CASE ( np_lap   )                               ! iso-level laplacian
-         CALL tra_ldf_lap  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb,      tra, jptra,    1     )
-      CASE ( np_lap_i )                               ! laplacian : standard iso-neutral operator (Madec)
-         CALL tra_ldf_iso  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra,    1     )
-      CASE ( np_lap_it )                              ! laplacian : triad iso-neutral operator (griffies)
-         CALL tra_ldf_triad( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra,    1     )
-      CASE ( np_blp , np_blp_i , np_blp_it )          ! bilaplacian: all operator (iso-level, -neutral)
-         CALL tra_ldf_blp  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb     , tra, jptra, nldf_trc )
+      CASE ( np_lap   )                                                                                    ! iso-level laplacian
+         CALL tra_ldf_lap  ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            &
+           &                     ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs),                   jptra, 1 )
+      CASE ( np_lap_i )                                                                                    ! laplacian : standard iso-neutral operator (Madec)
+         CALL tra_ldf_iso  ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            &
+           &                     ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, 1 )
+      CASE ( np_lap_it )                                                                                   ! laplacian : triad iso-neutral operator (griffies)
+         CALL tra_ldf_triad( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            &
+           &                     ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, 1 )
+      CASE ( np_blp , np_blp_i , np_blp_it )                                                               ! bilaplacian: all operator (iso-level, -neutral)
+         CALL tra_ldf_blp  ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            &
+           &                     ptr(:,:,:,:,Kbb) , ptr(:,:,:,:,Krhs),                 jptra, nldf_trc )
       END SELECT
       !
       IF( l_trdtrc )   THEN                    ! send the trends for further diagnostics
         DO jn = 1, jptra
-           ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn)
-           CALL trd_tra( kt, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) )
+           ztrtrd(:,:,:,jn) = ptr(:,:,:,jn,Krhs) - ztrtrd(:,:,:,jn)
+           CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) )
         END DO
         DEALLOCATE( ztrtrd )
       ENDIF
       !                
-      IF( ln_ctl ) THEN                        ! print mean trends (used for debugging)
+      IF( sn_cfctl%l_prttrc ) THEN ! print mean trends (used for debugging)
          WRITE(charout, FMT="('ldf ')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+         CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
       ENDIF
       !
@@ -143,9 +145,7 @@
       ENDIF
       !
-      REWIND( numnat_ref )             !  namtrc_ldf in reference namelist 
       READ  ( numnat_ref, namtrc_ldf, IOSTAT = ios, ERR = 903)
 903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_ldf in reference namelist' )
       !
-      REWIND( numnat_cfg )             !  namtrc_ldf in configuration namelist 
       READ  ( numnat_cfg, namtrc_ldf, IOSTAT = ios, ERR = 904 )
 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_ldf in configuration namelist' )
@@ -167,5 +167,5 @@
       IF( ln_trcldf_OFF  ) THEN   ;   nldf_trc = np_no_ldf   ;   ioptio = ioptio + 1   ;   ENDIF
       IF( ln_trcldf_tra  ) THEN   ;   nldf_trc = nldf_tra    ;   ioptio = ioptio + 1   ;   ENDIF
-      IF( ioptio /=  1   )   CALL ctl_stop( 'trc_ldf_ini: use ONE of the 2 operator options (NONE/tra)' )
+      IF( ioptio /=  1   )   CALL ctl_stop( 'trc_ldf_ini: use ONE of the 2 operator options (OFF/tra)' )
       
       !                                ! multiplier : passive/active tracers ration
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trcnxt.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trcnxt.F90	(revision 12384)
+++ 	(revision )
@@ -1,279 +1,0 @@
-MODULE trcnxt
-   !!======================================================================
-   !!                       ***  MODULE  trcnxt  ***
-   !! Ocean passive tracers:  time stepping on passives tracers
-   !!======================================================================
-   !! History :  7.0  !  1991-11  (G. Madec)  Original code
-   !!                 !  1993-03  (M. Guyon)  symetrical conditions
-   !!                 !  1995-02  (M. Levy)   passive tracers
-   !!                 !  1996-02  (G. Madec & M. Imbard)  opa release 8.0
-   !!            8.0  !  1996-04  (A. Weaver)  Euler forward step
-   !!            8.2  !  1999-02  (G. Madec, N. Grima)  semi-implicit pressure grad.
-   !!  NEMO      1.0  !  2002-08  (G. Madec)  F90: Free form and module
-   !!                 !  2002-08  (G. Madec)  F90: Free form and module
-   !!                 !  2002-11  (C. Talandier, A-M Treguier) Open boundaries
-   !!                 !  2004-03  (C. Ethe) passive tracers
-   !!                 !  2007-02  (C. Deltel) Diagnose ML trends for passive tracers
-   !!            2.0  !  2006-02  (L. Debreu, C. Mazauric) Agrif implementation
-   !!            3.0  !  2008-06  (G. Madec)  time stepping always done in trazdf
-   !!            3.1  !  2009-02  (G. Madec, R. Benshila)  re-introduce the vvl option
-   !!            3.3  !  2010-06  (C. Ethe, G. Madec) Merge TRA-TRC
-   !!----------------------------------------------------------------------
-#if defined key_top
-   !!----------------------------------------------------------------------
-   !!   'key_top'                                                TOP models
-   !!----------------------------------------------------------------------
-   !!   trc_nxt     : time stepping on passive tracers
-   !!----------------------------------------------------------------------
-   USE oce_trc         ! ocean dynamics and tracers variables
-   USE trc             ! ocean passive tracers variables
-   USE trd_oce
-   USE trdtra
-   USE tranxt
-   USE bdy_oce   , ONLY: ln_bdy
-   USE trcbdy          ! BDY open boundaries
-# if defined key_agrif
-   USE agrif_top_interp
-# endif
-   !
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE prtctl_trc      ! Print control for debbuging
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   trc_nxt   ! routine called by step.F90
-
-   REAL(wp) ::   rfact1, rfact2
-
-   !!----------------------------------------------------------------------
-   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
-   !! $Id$ 
-   !! Software governed by the CeCILL license (see ./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE trc_nxt( kt )
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE trcnxt  ***
-      !!
-      !! ** Purpose :   Compute the passive tracers 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
-      !!   default:
-      !!      arrays swap
-      !!         (trn) = (tra) ; (tra) = (0,0)
-      !!         (trb) = (trn) 
-      !!
-      !!   For Arakawa or TVD Scheme : 
-      !!      A Asselin time filter applied on now tracers (trn) to avoid
-      !!      the divergence of two consecutive time-steps and tr arrays
-      !!      to prepare the next time_step:
-      !!         (trb) = (trn) + atfp [ (trb) + (tra) - 2 (trn) ]
-      !!         (trn) = (tra) ; (tra) = (0,0)
-      !!
-      !!
-      !! ** Action  : - update trb, trn
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt     ! ocean time-step index
-      !
-      INTEGER  ::   jk, jn   ! dummy loop indices
-      REAL(wp) ::   zfact            ! temporary scalar
-      CHARACTER (len=22) :: charout
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   ztrdt    ! 4D workspace
-      !!----------------------------------------------------------------------
-      !
-      IF( ln_timing )   CALL timing_start('trc_nxt')
-      !
-      IF( kt == nittrc000 .AND. lwp ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'trc_nxt : time stepping on passive tracers'
-      ENDIF
-      !
-#if defined key_agrif
-      CALL Agrif_trc                   ! AGRIF zoom boundaries
-#endif
-      ! Update after tracer on domain lateral boundaries
-      CALL lbc_lnk( 'trcnxt', tra(:,:,:,:), 'T', 1. )   
-
-      IF( ln_bdy )  CALL trc_bdy( kt )
-
-      IF( l_trdtrc )  THEN             ! trends: store now fields before the Asselin filter application
-         ALLOCATE( ztrdt(jpi,jpj,jpk,jptra) )
-         ztrdt(:,:,:,:)  = 0._wp
-         IF( ln_traldf_iso ) THEN                       ! diagnose the "pure" Kz diffusive trend 
-            DO jn = 1, jptra
-               CALL trd_tra( kt, 'TRC', jn, jptra_zdfp, ztrdt(:,:,:,jn) )
-            ENDDO
-         ENDIF
-
-         ! total trend for the non-time-filtered variables. 
-         zfact = 1.0 / rdttrc
-         ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from tsn terms
-         IF( ln_linssh ) THEN       ! linear sea surface height only
-            DO jn = 1, jptra
-               DO jk = 1, jpkm1
-                  ztrdt(:,:,jk,jn) = ( tra(:,:,jk,jn)*e3t_a(:,:,jk) / e3t_n(:,:,jk) - trn(:,:,jk,jn)) * zfact
-               END DO
-            END DO
-         ELSE
-            DO jn = 1, jptra
-               DO jk = 1, jpkm1
-                  ztrdt(:,:,jk,jn) = ( tra(:,:,jk,jn) - trn(:,:,jk,jn) ) * zfact
-               END DO
-            END DO
-         ENDIF
-         !
-         DO jn = 1, jptra
-            CALL trd_tra( kt, 'TRC', jn, jptra_tot, ztrdt(:,:,:,jn) )
-         ENDDO
-         !
-         IF( ln_linssh ) THEN       ! linear sea surface height only
-            ! Store now fields before applying the Asselin filter 
-            ! in order to calculate Asselin filter trend later.
-            ztrdt(:,:,:,:) = trn(:,:,:,:) 
-         ENDIF
-
-      ENDIF
-      !                                ! Leap-Frog + Asselin filter time stepping
-      IF( (neuler == 0 .AND. kt == nittrc000) .OR. ln_top_euler ) THEN    ! Euler time-stepping (only swap)
-         DO jn = 1, jptra
-            DO jk = 1, jpkm1
-               trn(:,:,jk,jn) = tra(:,:,jk,jn)
-               trb(:,:,jk,jn) = trn(:,:,jk,jn)  
-            END DO
-         END DO
-         IF (l_trdtrc .AND. .NOT. ln_linssh ) THEN   ! Zero Asselin filter contribution must be explicitly written out since for vvl
-            !                                        ! Asselin filter is output by tra_nxt_vvl that is not called on this time step
-            ztrdt(:,:,:,:) = 0._wp            
-            DO jn = 1, jptra
-               CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt(:,:,:,jn) )
-            ENDDO
-         END IF
-         !
-      ELSE     
-         IF( .NOT. l_offline ) THEN ! Leap-Frog + Asselin filter time stepping
-            IF( ln_linssh ) THEN   ;   CALL tra_nxt_fix( kt, nittrc000,         'TRC', trb, trn, tra, jptra )  !     linear ssh
-            ELSE                   ;   CALL tra_nxt_vvl( kt, nittrc000, rdttrc, 'TRC', trb, trn, tra,      &
-              &                                                                   sbc_trc, sbc_trc_b, jptra )  ! non-linear ssh
-            ENDIF
-         ELSE
-                                       CALL trc_nxt_off( kt )       ! offline 
-         ENDIF
-         !
-         CALL lbc_lnk_multi( 'trcnxt', trb(:,:,:,:), 'T', 1._wp, trn(:,:,:,:), 'T', 1._wp, tra(:,:,:,:), 'T', 1._wp )
-      ENDIF
-      !
-      IF( l_trdtrc .AND. ln_linssh ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt )
-         DO jn = 1, jptra
-            DO jk = 1, jpkm1
-               zfact = 1._wp / r2dttrc  
-               ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact 
-            END DO
-            CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt(:,:,:,jn) )
-         END DO
-      END IF
-      IF( l_trdtrc ) DEALLOCATE( ztrdt ) 
-      !
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
-         WRITE(charout, FMT="('nxt')")
-         CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm)
-      ENDIF
-      !
-      IF( ln_timing )   CALL timing_stop('trc_nxt')
-      !
-   END SUBROUTINE trc_nxt
-
-
-   SUBROUTINE trc_nxt_off( kt )
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE tra_nxt_vvl  ***
-      !!
-      !! ** Purpose :   Time varying volume: apply the Asselin time filter  
-      !!                and swap the tracer fields.
-      !! 
-      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields.
-      !!              - save in (ta,sa) a thickness weighted average over the three 
-      !!             time levels which will be used to compute rdn and thus the semi-
-      !!             implicit hydrostatic pressure gradient (ln_dynhpg_imp = T)
-      !!              - swap tracer fields to prepare the next time_step.
-      !!                This can be summurized for tempearture as:
-      !!             ztm = ( e3t_n*tn + rbcp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )   ln_dynhpg_imp = T
-      !!                  /( e3t_n    + rbcp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )   
-      !!             ztm = 0                                                       otherwise
-      !!             tb  = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )
-      !!                  /( e3t_n    + atfp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )
-      !!             tn  = ta 
-      !!             ta  = zt        (NB: reset to 0 after eos_bn2 call)
-      !!
-      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
-      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
-      !!----------------------------------------------------------------------
-      INTEGER , INTENT(in   )   ::  kt       ! ocean time-step index
-      !!     
-      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
-      REAL(wp) ::   ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar
-      REAL(wp) ::   ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d   !   -      -
-      !!----------------------------------------------------------------------
-      !
-      IF( kt == nittrc000 )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'trc_nxt_off : time stepping'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-         IF( .NOT. ln_linssh ) THEN
-            rfact1 = atfp * rdttrc
-            rfact2 = rfact1 / rau0
-         ENDIF
-        !  
-      ENDIF
-      !
-      DO jn = 1, jptra      
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  ze3t_b = e3t_b(ji,jj,jk)
-                  ze3t_n = e3t_n(ji,jj,jk)
-                  ze3t_a = e3t_a(ji,jj,jk)
-                  !                                         ! tracer content at Before, now and after
-                  ztc_b  = trb(ji,jj,jk,jn) * ze3t_b
-                  ztc_n  = trn(ji,jj,jk,jn) * ze3t_n
-                  ztc_a  = tra(ji,jj,jk,jn) * ze3t_a
-                  !
-                  ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b
-                  ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b
-                  !
-                  ze3t_f = ze3t_n + atfp * ze3t_d
-                  ztc_f  = ztc_n  + atfp * ztc_d
-                  !
-                  IF( .NOT. ln_linssh .AND. jk == mikt(ji,jj) ) THEN           ! first level 
-                     ze3t_f = ze3t_f - rfact2 * ( emp_b(ji,jj)      - emp(ji,jj)   ) 
-                     ztc_f  = ztc_f  - rfact1 * ( sbc_trc(ji,jj,jn) - sbc_trc_b(ji,jj,jn) )
-                  ENDIF
-
-                  ze3t_f = 1.e0 / ze3t_f
-                  trb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered
-                  trn(ji,jj,jk,jn) = tra(ji,jj,jk,jn)     ! ptn <-- pta
-                  !
-               END DO
-            END DO
-         END DO
-         ! 
-      END DO
-      !
-   END SUBROUTINE trc_nxt_off
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option                                         Empty module
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_nxt( kt )  
-      INTEGER, INTENT(in) :: kt
-      WRITE(*,*) 'trc_nxt: You should not have seen this print! error?', kt
-   END SUBROUTINE trc_nxt
-#endif
-   !!======================================================================
-END MODULE trcnxt
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trcrad.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trcrad.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trcrad.F90	(revision 12928)
@@ -6,4 +6,5 @@
    !! History :   -   !  01-01  (O. Aumont & E. Kestenare)  Original code
    !!            1.0  !  04-03  (C. Ethe)  free form F90
+   !!            4.1  !  08-19  (A. Coward, D. Storkey) tidy up using new time-level indices
    !!----------------------------------------------------------------------
 #if defined key_top
@@ -30,4 +31,6 @@
    REAL(wp), DIMENSION(:,:), ALLOCATABLE::   gainmass
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -37,5 +40,5 @@
 CONTAINS
 
-   SUBROUTINE trc_rad( kt )
+   SUBROUTINE trc_rad( kt, Kbb, Kmm, ptr )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE trc_rad  ***
@@ -52,5 +55,7 @@
       !!                (the total CFC content is not strictly preserved)
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER,                                    INTENT(in   ) :: kt         ! ocean time-step index
+      INTEGER,                                    INTENT(in   ) :: Kbb, Kmm   ! time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr        ! passive tracers and RHS of tracer equation
       !
       CHARACTER (len=22) :: charout
@@ -59,14 +64,14 @@
       IF( ln_timing )   CALL timing_start('trc_rad')
       !
-      IF( ln_age     )   CALL trc_rad_sms( kt, trb, trn, jp_age , jp_age                )  !  AGE
-      IF( ll_cfc     )   CALL trc_rad_sms( kt, trb, trn, jp_cfc0, jp_cfc1               )  !  CFC model
-      IF( ln_c14     )   CALL trc_rad_sms( kt, trb, trn, jp_c14 , jp_c14                )  !  C14
-      IF( ln_pisces  )   CALL trc_rad_sms( kt, trb, trn, jp_pcs0, jp_pcs1, cpreserv='Y' )  !  PISCES model
-      IF( ln_my_trc  )   CALL trc_rad_sms( kt, trb, trn, jp_myt0, jp_myt1               )  !  MY_TRC model
-      !
-      IF(ln_ctl) THEN      ! print mean trends (used for debugging)
+      IF( ln_age     )   CALL trc_rad_sms( kt, Kbb, Kmm, ptr, jp_age , jp_age                )  !  AGE
+      IF( ll_cfc     )   CALL trc_rad_sms( kt, Kbb, Kmm, ptr, jp_cfc0, jp_cfc1               )  !  CFC model
+      IF( ln_c14     )   CALL trc_rad_sms( kt, Kbb, Kmm, ptr, jp_c14 , jp_c14                )  !  C14
+      IF( ln_pisces  )   CALL trc_rad_sms( kt, Kbb, Kmm, ptr, jp_pcs0, jp_pcs1, cpreserv='Y' )  !  PISCES model
+      IF( ln_my_trc  )   CALL trc_rad_sms( kt, Kbb, Kmm, ptr, jp_myt0, jp_myt1               )  !  MY_TRC model
+      !
+      IF(sn_cfctl%l_prttrc) THEN      ! print mean trends (used for debugging)
          WRITE(charout, FMT="('rad')")
          CALL prt_ctl_trc_info( charout )
-         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )
+         CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Kbb), mask=tmask, clinfo=ctrcnm )
       ENDIF
       !
@@ -87,8 +92,6 @@
       !!----------------------------------------------------------------------
       !
-      REWIND( numnat_ref )              ! namtrc_rad in reference namelist 
       READ  ( numnat_ref, namtrc_rad, IOSTAT = ios, ERR = 907)
 907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_rad in reference namelist' )
-      REWIND( numnat_cfg )              ! namtrc_rad in configuration namelist 
       READ  ( numnat_cfg, namtrc_rad, IOSTAT = ios, ERR = 908 )
 908   IF( ios > 0 )   CALL ctl_nam ( ios , 'namtrc_rad in configuration namelist' )
@@ -113,167 +116,111 @@
 
 
-   SUBROUTINE trc_rad_sms( kt, ptrb, ptrn, jp_sms0, jp_sms1, cpreserv )
-      !!-----------------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_rad_sms  ***
-      !!
-      !! ** Purpose :   "crappy" routine to correct artificial negative
-      !!              concentrations due to isopycnal scheme
-      !!
-      !! ** Method  : 2 cases :
-      !!                - Set negative concentrations to zero while computing
-      !!                  the corresponding tracer content that is added to the
-      !!                  tracers. Then, adjust the tracer concentration using
-      !!                  a multiplicative factor so that the total tracer 
-      !!                  concentration is preserved.
-      !!                - simply set to zero the negative CFC concentration
-      !!                  (the total content of concentration is not strictly preserved)
-      !!--------------------------------------------------------------------------------
-      INTEGER                                , INTENT(in   ) ::   kt                 ! ocean time-step index
-      INTEGER                                , INTENT(in   ) ::   jp_sms0, jp_sms1   ! First & last index of the passive tracer model
-      REAL(wp), DIMENSION (jpi,jpj,jpk,jptra), INTENT(inout) ::   ptrb    , ptrn     ! before and now traceur concentration
-      CHARACTER( len = 1), OPTIONAL          , INTENT(in   ) ::   cpreserv           ! flag to preserve content or not
-      !
-      INTEGER ::   ji, ji2, jj, jj2, jk, jn     ! dummy loop indices
-      INTEGER ::   icnt
-      LOGICAL ::   lldebug = .FALSE.            ! local logical
-      REAL(wp)::   zcoef, zs2rdt, ztotmass
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrneg, ztrpos
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrtrd   ! workspace arrays
-      !!----------------------------------------------------------------------
-      !
-      IF( l_trdtrc )   ALLOCATE( ztrtrd(jpi,jpj,jpk) )
-      zs2rdt = 1. / ( 2. * rdt * REAL( nn_dttrc, wp ) )
-      !
-      IF( PRESENT( cpreserv )  ) THEN     !==  total tracer concentration is preserved  ==!
-         !
-         ALLOCATE( ztrneg(1:jpi,1:jpj,jp_sms0:jp_sms1), ztrpos(1:jpi,1:jpj,jp_sms0:jp_sms1) )
-
-         DO jn = jp_sms0, jp_sms1
-            ztrneg(:,:,jn) = SUM( MIN( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:), dim = 3 )   ! sum of the negative values
-            ztrpos(:,:,jn) = SUM( MAX( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:), dim = 3 )   ! sum of the positive values
-         END DO
-         CALL sum3x3( ztrneg )
-         CALL sum3x3( ztrpos )
-         
-         DO jn = jp_sms0, jp_sms1
-            !
-            IF( l_trdtrc )   ztrtrd(:,:,:) = ptrb(:,:,:,jn)                            ! save input trb for trend computation           
-            !
-            DO jk = 1, jpkm1
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     IF( ztrneg(ji,jj,jn) /= 0. ) THEN                                 ! if negative values over the 3x3 box
-                        !
-                        ptrb(ji,jj,jk,jn) = ptrb(ji,jj,jk,jn) * tmask(ji,jj,jk)   ! really needed?
-                        IF( ptrb(ji,jj,jk,jn) < 0. ) ptrb(ji,jj,jk,jn) = 0.       ! supress negative values
-                        IF( ptrb(ji,jj,jk,jn) > 0. ) THEN                         ! use positive values to compensate mass gain
-                           zcoef = 1. + ztrneg(ji,jj,jn) / ztrpos(ji,jj,jn)       ! ztrpos > 0 as ptrb > 0
-                           ptrb(ji,jj,jk,jn) = ptrb(ji,jj,jk,jn) * zcoef
-                           IF( zcoef < 0. ) THEN                                  ! if the compensation exceed the positive value
-                              gainmass(jn,1) = gainmass(jn,1) - ptrb(ji,jj,jk,jn) * cvol(ji,jj,jk)   ! we are adding mass...
-                              ptrb(ji,jj,jk,jn) = 0.                              ! limit the compensation to keep positive value
-                           ENDIF
-                        ENDIF
-                        !
-                     ENDIF
-                  END DO
-               END DO
-            END DO
-            !
-            IF( l_trdtrc ) THEN
-               ztrtrd(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrd(:,:,:) ) * zs2rdt
-               CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrd )       ! Asselin-like trend handling
-            ENDIF
-            !
-         END DO
- 
-         IF( kt == nitend ) THEN
-            CALL mpp_sum( 'trcrad', gainmass(:,1) )
-            DO jn = jp_sms0, jp_sms1
-               IF( gainmass(jn,1) > 0. ) THEN
-                  ztotmass = glob_sum( 'trcrad', ptrb(:,:,:,jn) * cvol(:,:,:) )
-                  IF(lwp) WRITE(numout, '(a, i2, a, D23.16, a, D23.16)') 'trcrad ptrb, traceur ', jn  &
-                     &        , ' total mass : ', ztotmass, ', mass gain : ',  gainmass(jn,1)
-               END IF
-            END DO
-         ENDIF
-
-         DO jn = jp_sms0, jp_sms1
-            ztrneg(:,:,jn) = SUM( MIN( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:), dim = 3 )   ! sum of the negative values
-            ztrpos(:,:,jn) = SUM( MAX( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:), dim = 3 )   ! sum of the positive values
-         END DO
-         CALL sum3x3( ztrneg )
-         CALL sum3x3( ztrpos )
-         
-         DO jn = jp_sms0, jp_sms1
-            !
-            IF( l_trdtrc )   ztrtrd(:,:,:) = ptrn(:,:,:,jn)                            ! save input trb for trend computation
-            !
-            DO jk = 1, jpkm1
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     IF( ztrneg(ji,jj,jn) /= 0. ) THEN                                 ! if negative values over the 3x3 box
-                        !
-                        ptrn(ji,jj,jk,jn) = ptrn(ji,jj,jk,jn) * tmask(ji,jj,jk)   ! really needed?
-                        IF( ptrn(ji,jj,jk,jn) < 0. ) ptrn(ji,jj,jk,jn) = 0.       ! supress negative values
-                        IF( ptrn(ji,jj,jk,jn) > 0. ) THEN                         ! use positive values to compensate mass gain
-                           zcoef = 1. + ztrneg(ji,jj,jn) / ztrpos(ji,jj,jn)       ! ztrpos > 0 as ptrb > 0
-                           ptrn(ji,jj,jk,jn) = ptrn(ji,jj,jk,jn) * zcoef
-                           IF( zcoef < 0. ) THEN                                  ! if the compensation exceed the positive value
-                              gainmass(jn,2) = gainmass(jn,2) - ptrn(ji,jj,jk,jn) * cvol(ji,jj,jk)   ! we are adding mass...
-                              ptrn(ji,jj,jk,jn) = 0.                              ! limit the compensation to keep positive value
-                           ENDIF
-                        ENDIF
-                        !
-                     ENDIF
-                  END DO
-               END DO
-            END DO
-            !
-            IF( l_trdtrc ) THEN
-               ztrtrd(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrd(:,:,:) ) * zs2rdt
-               CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrd )       ! standard     trend handling
-            ENDIF
-            !
-         END DO
- 
-         IF( kt == nitend ) THEN
-            CALL mpp_sum( 'trcrad', gainmass(:,2) )
-            DO jn = jp_sms0, jp_sms1
-               IF( gainmass(jn,2) > 0. ) THEN
-                  ztotmass = glob_sum( 'trcrad', ptrn(:,:,:,jn) * cvol(:,:,:) )
-                  WRITE(numout, '(a, i2, a, D23.16, a, D23.16)') 'trcrad ptrn, traceur ', jn  &
-                     &        , ' total mass : ', ztotmass, ', mass gain : ',  gainmass(jn,1)
-               END IF
-            END DO
-         ENDIF
-
-         DEALLOCATE( ztrneg, ztrpos )
-         !
-      ELSE                                !==  total CFC content is NOT strictly preserved  ==!
-         !
-         DO jn = jp_sms0, jp_sms1  
-            !
-            IF( l_trdtrc )   ztrtrd(:,:,:) = ptrb(:,:,:,jn)                        ! save input trb for trend computation
-            !
-            WHERE( ptrb(:,:,:,jn) < 0. )   ptrb(:,:,:,jn) = 0.
-            !
-            IF( l_trdtrc ) THEN
-               ztrtrd(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrd(:,:,:) ) * zs2rdt
-               CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrd )       ! Asselin-like trend handling
-            ENDIF
-            !
-            IF( l_trdtrc )   ztrtrd(:,:,:) = ptrn(:,:,:,jn)                        ! save input trn for trend computation
-            !
-            WHERE( ptrn(:,:,:,jn) < 0. )   ptrn(:,:,:,jn) = 0.
-            !
-            IF( l_trdtrc ) THEN
-               ztrtrd(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrd(:,:,:) ) * zs2rdt
-               CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrd )       ! standard     trend handling
-            ENDIF
-            !
-         END DO
-         !
-      ENDIF
+   SUBROUTINE trc_rad_sms( kt, Kbb, Kmm, ptr, jp_sms0, jp_sms1, cpreserv )
+     !!-----------------------------------------------------------------------------
+     !!                  ***  ROUTINE trc_rad_sms  ***
+     !!
+     !! ** Purpose :   "crappy" routine to correct artificial negative
+     !!              concentrations due to isopycnal scheme
+     !!
+     !! ** Method  : 2 cases :
+     !!                - Set negative concentrations to zero while computing
+     !!                  the corresponding tracer content that is added to the
+     !!                  tracers. Then, adjust the tracer concentration using
+     !!                  a multiplicative factor so that the total tracer 
+     !!                  concentration is preserved.
+     !!                - simply set to zero the negative CFC concentration
+     !!                  (the total content of concentration is not strictly preserved)
+     !!--------------------------------------------------------------------------------
+     INTEGER                                    , INTENT(in   ) ::   kt                 ! ocean time-step index
+     INTEGER                                    , INTENT(in   ) ::   Kbb, Kmm           ! time level indices
+     INTEGER                                    , INTENT(in   ) ::   jp_sms0, jp_sms1   ! First & last index of the passive tracer model
+     REAL(wp), DIMENSION (jpi,jpj,jpk,jptra,jpt), INTENT(inout) ::   ptr                ! before and now traceur concentration
+     CHARACTER( len = 1), OPTIONAL              , INTENT(in   ) ::   cpreserv           ! flag to preserve content or not
+     !
+     INTEGER ::   ji, ji2, jj, jj2, jk, jn, jt ! dummy loop indices
+     INTEGER ::   icnt, itime
+     LOGICAL ::   lldebug = .FALSE.            ! local logical
+     REAL(wp)::   zcoef, zs2rdt, ztotmass
+     REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrneg, ztrpos
+     REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrtrd   ! workspace arrays
+     !!----------------------------------------------------------------------
+     !
+     IF( l_trdtrc )   ALLOCATE( ztrtrd(jpi,jpj,jpk) )
+     zs2rdt = 1. / ( 2. * rn_Dt )
+     !
+     DO jt = 1,2  ! Loop over time indices since exactly the same fix is applied to "now" and "after" fields
+        IF( jt == 1 ) itime = Kbb
+        IF( jt == 2 ) itime = Kmm
+
+        IF( PRESENT( cpreserv )  ) THEN     !==  total tracer concentration is preserved  ==!
+           !
+           ALLOCATE( ztrneg(1:jpi,1:jpj,jp_sms0:jp_sms1), ztrpos(1:jpi,1:jpj,jp_sms0:jp_sms1) )
+
+           DO jn = jp_sms0, jp_sms1
+              ztrneg(:,:,jn) = SUM( MIN( 0., ptr(:,:,:,jn,itime) ) * cvol(:,:,:), dim = 3 )   ! sum of the negative values
+              ztrpos(:,:,jn) = SUM( MAX( 0., ptr(:,:,:,jn,itime) ) * cvol(:,:,:), dim = 3 )   ! sum of the positive values
+           END DO
+           CALL sum3x3( ztrneg )
+           CALL sum3x3( ztrpos )
+
+           DO jn = jp_sms0, jp_sms1
+              !
+              IF( l_trdtrc )   ztrtrd(:,:,:) = ptr(:,:,:,jn,itime)                       ! save input tr(:,:,:,:,Kbb) for trend computation           
+              !
+              DO_3D_11_11( 1, jpkm1 )
+                 IF( ztrneg(ji,jj,jn) /= 0. ) THEN                                 ! if negative values over the 3x3 box
+                    !
+                    ptr(ji,jj,jk,jn,itime) = ptr(ji,jj,jk,jn,itime) * tmask(ji,jj,jk)   ! really needed?
+                    IF( ptr(ji,jj,jk,jn,itime) < 0. ) ptr(ji,jj,jk,jn,itime) = 0.       ! suppress negative values
+                    IF( ptr(ji,jj,jk,jn,itime) > 0. ) THEN                    ! use positive values to compensate mass gain
+                       zcoef = 1. + ztrneg(ji,jj,jn) / ztrpos(ji,jj,jn)       ! ztrpos > 0 as ptr > 0
+                       ptr(ji,jj,jk,jn,itime) = ptr(ji,jj,jk,jn,itime) * zcoef
+                       IF( zcoef < 0. ) THEN                                  ! if the compensation exceed the positive value
+                          gainmass(jn,1) = gainmass(jn,1) - ptr(ji,jj,jk,jn,itime) * cvol(ji,jj,jk)   ! we are adding mass...
+                          ptr(ji,jj,jk,jn,itime) = 0.                         ! limit the compensation to keep positive value
+                       ENDIF
+                    ENDIF
+                    !
+                 ENDIF
+              END_3D
+              !
+              IF( l_trdtrc ) THEN
+                 ztrtrd(:,:,:) = ( ptr(:,:,:,jn,itime) - ztrtrd(:,:,:) ) * zs2rdt
+                 CALL trd_tra( kt, Kbb, Kmm, 'TRC', jn, jptra_radb, ztrtrd )       ! Asselin-like trend handling
+              ENDIF
+              !
+           END DO
+
+           IF( kt == nitend ) THEN
+              CALL mpp_sum( 'trcrad', gainmass(:,1) )
+              DO jn = jp_sms0, jp_sms1
+                 IF( gainmass(jn,1) > 0. ) THEN
+                    ztotmass = glob_sum( 'trcrad', ptr(:,:,:,jn,itime) * cvol(:,:,:) )
+                    IF(lwp) WRITE(numout, '(a, i2, a, D23.16, a, D23.16)') 'trcrad ptrb, traceur ', jn  &
+                         &        , ' total mass : ', ztotmass, ', mass gain : ',  gainmass(jn,1)
+                 END IF
+              END DO
+           ENDIF
+
+           DEALLOCATE( ztrneg, ztrpos )
+           !
+        ELSE                                !==  total CFC content is NOT strictly preserved  ==!
+           !
+           DO jn = jp_sms0, jp_sms1  
+              !
+              IF( l_trdtrc )   ztrtrd(:,:,:) = ptr(:,:,:,jn,itime)                 ! save input tr for trend computation
+              !
+              WHERE( ptr(:,:,:,jn,itime) < 0. )   ptr(:,:,:,jn,itime) = 0.
+              !
+              IF( l_trdtrc ) THEN
+                 ztrtrd(:,:,:) = ( ptr(:,:,:,jn,itime) - ztrtrd(:,:,:) ) * zs2rdt
+                 CALL trd_tra( kt, Kbb, Kmm, 'TRC', jn, jptra_radb, ztrtrd )       ! Asselin-like trend handling
+              ENDIF
+              !
+           END DO
+           !
+        ENDIF
+        !
+      END DO
       !
       IF( l_trdtrc )  DEALLOCATE( ztrtrd )
@@ -286,6 +233,7 @@
    !!----------------------------------------------------------------------
 CONTAINS
-   SUBROUTINE trc_rad( kt )              ! Empty routine
+   SUBROUTINE trc_rad( kt, Kbb, Kmm )              ! Empty routine
       INTEGER, INTENT(in) ::   kt
+      INTEGER, INTENT(in) ::   Kbb, Kmm  ! time level indices
       WRITE(*,*) 'trc_rad: You should not have seen this print! error?', kt
    END SUBROUTINE trc_rad
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trcsbc.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trcsbc.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trcsbc.F90	(revision 12928)
@@ -29,5 +29,5 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -37,5 +37,5 @@
 CONTAINS
 
-   SUBROUTINE trc_sbc ( kt )
+   SUBROUTINE trc_sbc ( kt, Kmm, ptr, Krhs )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE trc_sbc  ***
@@ -49,14 +49,16 @@
       !!            The surface freshwater flux modify the ocean volume
       !!         and thus the concentration of a tracer as :
-      !!            tra = tra + emp * trn / e3t   for k=1
+      !!            tr(Krhs) = tr(Krhs) + emp * tr(Kmm) / e3t   for k=1
       !!         where emp, the surface freshwater budget (evaporation minus
       !!         precipitation ) given in kg/m2/s is divided
       !!         by 1035 kg/m3 (density of ocean water) to obtain m/s.
       !!
-      !! ** Action  : - Update the 1st level of tra with the trend associated
+      !! ** Action  : - Update the 1st level of tr(:,:,:,:,Krhs) with the trend associated
       !!                with the tracer surface boundary condition 
       !!
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER,                                    INTENT(in   ) :: kt        ! ocean time-step index
+      INTEGER,                                    INTENT(in   ) :: Kmm, Krhs ! time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr       ! passive tracers and RHS of tracer equation
       !
       INTEGER  ::   ji, jj, jn                      ! dummy loop indices
@@ -82,5 +84,5 @@
          IF( ln_rsttr .AND. .NOT.ln_top_euler .AND.   &                     ! Restart: read in restart  file
             iom_varid( numrtr, 'sbc_'//TRIM(ctrcnm(1))//'_b', ldstop = .FALSE. ) > 0 ) THEN
-            IF(lwp) WRITE(numout,*) '          nittrc000-nn_dttrc surface tracer content forcing fields red in the restart file'
+            IF(lwp) WRITE(numout,*) '          nittrc000-1 surface tracer content forcing fields read in the restart file'
             zfact = 0.5_wp
             DO jn = 1, jptra
@@ -102,5 +104,5 @@
       ENDIF
 
-      ! Coupling online : river runoff is added to the horizontal divergence (hdivn) in the subroutine sbc_rnf_div 
+      ! Coupling online : river runoff is added to the horizontal divergence (hdiv) in the subroutine sbc_rnf_div 
       ! one only consider the concentration/dilution effect due to evaporation minus precipitation + freezing/melting of sea-ice
       ! Coupling offline : runoff are in emp which contains E-P-R
@@ -118,9 +120,7 @@
          !
          DO jn = 1, jptra
-            DO jj = 2, jpj
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rau0 * trn(ji,jj,1,jn)
-               END DO
-            END DO
+            DO_2D_01_00
+               sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rho0 * ptr(ji,jj,1,jn,Kmm)
+            END_2D
          END DO
          !
@@ -128,9 +128,7 @@
          !
          DO jn = 1, jptra
-            DO jj = 2, jpj
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  sbc_trc(ji,jj,jn) = ( zsfx(ji,jj) + fmmflx(ji,jj) ) * r1_rau0 * trn(ji,jj,1,jn)
-               END DO
-            END DO
+            DO_2D_01_00
+               sbc_trc(ji,jj,jn) = ( zsfx(ji,jj) + fmmflx(ji,jj) ) * r1_rho0 * ptr(ji,jj,1,jn,Kmm)
+            END_2D
          END DO
          !
@@ -138,21 +136,19 @@
          !
          DO jn = 1, jptra
-            DO jj = 2, jpj
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zse3t = 1. / e3t_n(ji,jj,1)
-                  ! tracer flux at the ice/ocean interface (tracer/m2/s)
-                  zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice
-                  !                                         ! only used in the levitating sea ice case
-                  ! tracer flux only       : add concentration dilution term in net tracer flux, no F-M in volume flux
-                  ! tracer and mass fluxes : no concentration dilution term in net tracer flux, F-M term in volume flux
-                  ztfx  = zftra                        ! net tracer flux
-                  !
-                  zdtra = r1_rau0 * ( ztfx + ( zsfx(ji,jj) + fmmflx(ji,jj) ) * trn(ji,jj,1,jn) ) 
-                  IF ( zdtra < 0. ) THEN
-                     zdtra  = MAX(zdtra, -trn(ji,jj,1,jn) * e3t_n(ji,jj,1) / r2dttrc )   ! avoid negative concentrations to arise
-                  ENDIF
-                  sbc_trc(ji,jj,jn) =  zdtra 
-               END DO
-            END DO
+            DO_2D_01_00
+               zse3t = 1. / e3t(ji,jj,1,Kmm)
+               ! tracer flux at the ice/ocean interface (tracer/m2/s)
+               zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice
+               !                                         ! only used in the levitating sea ice case
+               ! tracer flux only       : add concentration dilution term in net tracer flux, no F-M in volume flux
+               ! tracer and mass fluxes : no concentration dilution term in net tracer flux, F-M term in volume flux
+               ztfx  = zftra                        ! net tracer flux
+               !
+               zdtra = r1_rho0 * ( ztfx + ( zsfx(ji,jj) + fmmflx(ji,jj) ) * ptr(ji,jj,1,jn,Kmm) ) 
+               IF ( zdtra < 0. ) THEN
+                  zdtra  = MAX(zdtra, -ptr(ji,jj,1,jn,Kmm) * e3t(ji,jj,1,Kmm) / rDt_trc )   ! avoid negative concentrations to arise
+               ENDIF
+               sbc_trc(ji,jj,jn) =  zdtra 
+            END_2D
          END DO
       END SELECT
@@ -162,16 +158,14 @@
       DO jn = 1, jptra
          !
-         IF( l_trdtrc )   ztrtrd(:,:,:) = tra(:,:,:,jn)  ! save trends
-         !
-         DO jj = 2, jpj
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zse3t = zfact / e3t_n(ji,jj,1)
-               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t
-            END DO
-         END DO
+         IF( l_trdtrc )   ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs)  ! save trends
+         !
+         DO_2D_01_00
+            zse3t = zfact / e3t(ji,jj,1,Kmm)
+            ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t
+         END_2D
          !
          IF( l_trdtrc ) THEN
-            ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:)
-            CALL trd_tra( kt, 'TRC', jn, jptra_nsr, ztrtrd )
+            ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs) - ztrtrd(:,:,:)
+            CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_nsr, ztrtrd )
          END IF
          !                                                       ! ===========
@@ -191,7 +185,7 @@
       ENDIF
       !
-      IF( ln_ctl )   THEN
+      IF( sn_cfctl%l_prttrc )   THEN
          WRITE(charout, FMT="('sbc ')") ;  CALL prt_ctl_trc_info(charout)
-                                           CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+                                           CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
       ENDIF
       IF( l_trdtrc )  DEALLOCATE( ztrtrd )
@@ -205,7 +199,11 @@
    !!   Dummy module :                      NO passive tracer
    !!----------------------------------------------------------------------
+   USE par_oce
+   USE par_trc
 CONTAINS
-   SUBROUTINE trc_sbc (kt)              ! Empty routine
-      INTEGER, INTENT(in) :: kt
+   SUBROUTINE trc_sbc ( kt, Kmm, ptr, Krhs )      ! Empty routine
+      INTEGER,                                    INTENT(in   ) :: kt        ! ocean time-step index
+      INTEGER,                                    INTENT(in   ) :: Kmm, Krhs ! time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr       ! passive tracers and RHS of tracer equation
       WRITE(*,*) 'trc_sbc: You should not have seen this print! error?', kt
    END SUBROUTINE trc_sbc
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trcsink.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trcsink.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trcsink.F90	(revision 12928)
@@ -24,4 +24,6 @@
    INTEGER, PUBLIC :: nitermax      !: Maximum number of iterations for sinking
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -35,5 +37,5 @@
    !!----------------------------------------------------------------------
 
-   SUBROUTINE trc_sink ( kt, pwsink, psinkflx, jp_tra, rsfact )
+   SUBROUTINE trc_sink ( kt, Kbb, Kmm, pwsink, psinkflx, jp_tra, rsfact )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE trc_sink  ***
@@ -45,4 +47,5 @@
       !!---------------------------------------------------------------------
       INTEGER , INTENT(in)  :: kt
+      INTEGER , INTENT(in)  :: Kbb, Kmm
       INTEGER , INTENT(in)  :: jp_tra    ! tracer index index      
       REAL(wp), INTENT(in)  :: rsfact    ! time step duration
@@ -70,31 +73,25 @@
          iiter(:,:) = 1
       ELSE
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               iiter(ji,jj) = 1
-               DO jk = 1, jpkm1
-                  IF( tmask(ji,jj,jk) == 1.0 ) THEN
-                      zwsmax =  0.5 * e3t_n(ji,jj,jk) * rday / rsfact
-                      iiter(ji,jj) =  MAX( iiter(ji,jj), INT( pwsink(ji,jj,jk) / zwsmax ) )
-                  ENDIF
-               END DO
-            END DO
-         END DO
+         DO_2D_11_11
+            iiter(ji,jj) = 1
+            DO jk = 1, jpkm1
+               IF( tmask(ji,jj,jk) == 1.0 ) THEN
+                   zwsmax =  0.5 * e3t(ji,jj,jk,Kmm) * rday / rsfact
+                   iiter(ji,jj) =  MAX( iiter(ji,jj), INT( pwsink(ji,jj,jk) / zwsmax ) )
+               ENDIF
+            END DO
+         END_2D
          iiter(:,:) = MIN( iiter(:,:), nitermax )
       ENDIF
 
-      DO jk = 1,jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( tmask(ji,jj,jk) == 1.0 ) THEN
-                 zwsmax = 0.5 * e3t_n(ji,jj,jk) * rday / rsfact
-                 zwsink(ji,jj,jk) = MIN( pwsink(ji,jj,jk), zwsmax * REAL( iiter(ji,jj), wp ) )
-               ELSE
-                 ! provide a default value so there is no use of undefinite value in trc_sink2 for zwsink2 initialization
-                 zwsink(ji,jj,jk) = 0.
-               ENDIF
-            END DO
-         END DO
-      END DO
+      DO_3D_11_11( 1,jpkm1 )
+         IF( tmask(ji,jj,jk) == 1.0 ) THEN
+           zwsmax = 0.5 * e3t(ji,jj,jk,Kmm) * rday / rsfact
+           zwsink(ji,jj,jk) = MIN( pwsink(ji,jj,jk), zwsmax * REAL( iiter(ji,jj), wp ) )
+         ELSE
+           ! provide a default value so there is no use of undefinite value in trc_sink2 for zwsink2 initialization
+           zwsink(ji,jj,jk) = 0.
+         ENDIF
+      END_3D
 
       !  Initializa to zero all the sinking arrays 
@@ -104,5 +101,5 @@
       !   Compute the sedimentation term using trc_sink2 for the considered sinking particle
       !   -----------------------------------------------------
-      CALL trc_sink2( zwsink, psinkflx, jp_tra, iiter, rsfact )
+      CALL trc_sink2( Kbb, Kmm, zwsink, psinkflx, jp_tra, iiter, rsfact )
       !
       IF( ln_timing )   CALL timing_stop('trc_sink')
@@ -110,5 +107,5 @@
    END SUBROUTINE trc_sink
 
-   SUBROUTINE trc_sink2( pwsink, psinkflx, jp_tra, kiter, rsfact )
+   SUBROUTINE trc_sink2( Kbb, Kmm, pwsink, psinkflx, jp_tra, kiter, rsfact )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE trc_sink2  ***
@@ -121,4 +118,5 @@
       !!      transport term, i.e.  div(u*tra).
       !!---------------------------------------------------------------------
+      INTEGER,  INTENT(in   )                         ::   Kbb, Kmm  ! time level indices
       INTEGER,  INTENT(in   )                         ::   jp_tra    ! tracer index index      
       REAL(wp), INTENT(in   )                         ::   rsfact    ! duration of time step
@@ -136,5 +134,5 @@
       ztraz(:,:,:) = 0.e0
       zakz (:,:,:) = 0.e0
-      ztrb (:,:,:) = trb(:,:,:,jp_tra)
+      ztrb (:,:,:) = tr(:,:,:,jp_tra,Kbb)
 
       DO jk = 1, jpkm1
@@ -147,56 +145,50 @@
       DO jn = 1, 2
          !  first guess of the slopes interior values
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               !
-               zstep = rsfact / REAL( kiter(ji,jj), wp ) / 2.
-               !              
-               DO jk = 2, jpkm1
-                  ztraz(ji,jj,jk) = ( trb(ji,jj,jk-1,jp_tra) - trb(ji,jj,jk,jp_tra) ) * tmask(ji,jj,jk)
-               END DO
-               ztraz(ji,jj,1  ) = 0.0
-               ztraz(ji,jj,jpk) = 0.0
-
-               ! slopes
-               DO jk = 2, jpkm1
-                  zign = 0.25 + SIGN( 0.25, ztraz(ji,jj,jk) * ztraz(ji,jj,jk+1) )
-                  zakz(ji,jj,jk) = ( ztraz(ji,jj,jk) + ztraz(ji,jj,jk+1) ) * zign
-               END DO
-         
-               ! Slopes limitation
-               DO jk = 2, jpkm1
-                  zakz(ji,jj,jk) = SIGN( 1., zakz(ji,jj,jk) ) *        &
-                     &             MIN( ABS( zakz(ji,jj,jk) ), 2. * ABS(ztraz(ji,jj,jk+1)), 2. * ABS(ztraz(ji,jj,jk) ) )
-               END DO
-         
-               ! vertical advective flux
-               DO jk = 1, jpkm1
-                  zigma = zwsink2(ji,jj,jk+1) * zstep / e3w_n(ji,jj,jk+1)
-                  zew   = zwsink2(ji,jj,jk+1)
-                  psinkflx(ji,jj,jk+1) = -zew * ( trb(ji,jj,jk,jp_tra) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep
-               END DO
-               !
-               ! Boundary conditions
-               psinkflx(ji,jj,1  ) = 0.e0
-               psinkflx(ji,jj,jpk) = 0.e0
-         
-               DO jk=1,jpkm1
-                  zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t_n(ji,jj,jk)
-                  trb(ji,jj,jk,jp_tra) = trb(ji,jj,jk,jp_tra) + zflx
-               END DO
-            END DO
-         END DO
+         DO_2D_11_11
+            !
+            zstep = rsfact / REAL( kiter(ji,jj), wp ) / 2.
+            !              
+            DO jk = 2, jpkm1
+               ztraz(ji,jj,jk) = ( tr(ji,jj,jk-1,jp_tra,Kbb) - tr(ji,jj,jk,jp_tra,Kbb) ) * tmask(ji,jj,jk)
+            END DO
+            ztraz(ji,jj,1  ) = 0.0
+            ztraz(ji,jj,jpk) = 0.0
+
+            ! slopes
+            DO jk = 2, jpkm1
+               zign = 0.25 + SIGN( 0.25, ztraz(ji,jj,jk) * ztraz(ji,jj,jk+1) )
+               zakz(ji,jj,jk) = ( ztraz(ji,jj,jk) + ztraz(ji,jj,jk+1) ) * zign
+            END DO
+      
+            ! Slopes limitation
+            DO jk = 2, jpkm1
+               zakz(ji,jj,jk) = SIGN( 1., zakz(ji,jj,jk) ) *        &
+                  &             MIN( ABS( zakz(ji,jj,jk) ), 2. * ABS(ztraz(ji,jj,jk+1)), 2. * ABS(ztraz(ji,jj,jk) ) )
+            END DO
+      
+            ! vertical advective flux
+            DO jk = 1, jpkm1
+               zigma = zwsink2(ji,jj,jk+1) * zstep / e3w(ji,jj,jk+1,Kmm)
+               zew   = zwsink2(ji,jj,jk+1)
+               psinkflx(ji,jj,jk+1) = -zew * ( tr(ji,jj,jk,jp_tra,Kbb) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep
+            END DO
+            !
+            ! Boundary conditions
+            psinkflx(ji,jj,1  ) = 0.e0
+            psinkflx(ji,jj,jpk) = 0.e0
+      
+            DO jk=1,jpkm1
+               zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm)
+               tr(ji,jj,jk,jp_tra,Kbb) = tr(ji,jj,jk,jp_tra,Kbb) + zflx
+            END DO
+         END_2D
       END DO
 
-      DO jk = 1,jpkm1
-         DO jj = 1,jpj
-            DO ji = 1, jpi
-               zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t_n(ji,jj,jk)
-               ztrb(ji,jj,jk) = ztrb(ji,jj,jk) + 2. * zflx
-            END DO
-         END DO
-      END DO
-
-      trb(:,:,:,jp_tra) = ztrb(:,:,:)
+      DO_3D_11_11( 1,jpkm1 )
+         zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm)
+         ztrb(ji,jj,jk) = ztrb(ji,jj,jk) + 2. * zflx
+      END_3D
+
+      tr(:,:,:,jp_tra,Kbb) = ztrb(:,:,:)
       psinkflx(:,:,:)   = 2. * psinkflx(:,:,:)
       !
@@ -216,8 +208,6 @@
       !!----------------------------------------------------------------------
       !
-      REWIND( numnat_ref )              ! namtrc_rad in reference namelist 
       READ  ( numnat_ref, namtrc_snk, IOSTAT = ios, ERR = 907)
 907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_snk in reference namelist' )
-      REWIND( numnat_cfg )              ! namtrc_rad in configuration namelist 
       READ  ( numnat_cfg, namtrc_snk, IOSTAT = ios, ERR = 908 )
 908   IF( ios > 0 )   CALL ctl_nam ( ios , 'namtrc_snk in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trctrp.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trctrp.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trctrp.F90	(revision 12928)
@@ -20,7 +20,8 @@
    USE trcadv          ! advection                           (trc_adv routine)
    USE trczdf          ! vertical diffusion                  (trc_zdf routine)
-   USE trcnxt          ! time-stepping                       (trc_nxt routine)
+   USE trcatf          ! time filtering                      (trc_atf routine)
    USE trcrad          ! positivity                          (trc_rad routine)
    USE trcsbc          ! surface boundary condition          (trc_sbc routine)
+   USE trcbc           ! Tracers boundary condtions          ( trc_bc routine)
    USE zpshde          ! partial step: hor. derivative       (zps_hde routine)
    USE bdy_oce   , ONLY: ln_bdy
@@ -44,5 +45,5 @@
 CONTAINS
 
-   SUBROUTINE trc_trp( kt )
+   SUBROUTINE trc_trp( kt, Kbb, Kmm, Krhs, Kaa )
       !!----------------------------------------------------------------------
       !!                     ***  ROUTINE trc_trp  ***
@@ -53,5 +54,6 @@
       !!              - Update the passive tracers
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::  kt  ! ocean time-step index
+      INTEGER, INTENT( in ) :: kt                  ! ocean time-step index
+      INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs, Kaa ! time level indices (not swapped in this routine)
       !! ---------------------------------------------------------------------
       !
@@ -60,32 +62,42 @@
       IF( .NOT. lk_c1d ) THEN
          !
-                                CALL trc_sbc    ( kt )      ! surface boundary condition
-         IF( ln_trabbl )        CALL trc_bbl    ( kt )      ! advective (and/or diffusive) bottom boundary layer scheme
-         IF( ln_trcdmp )        CALL trc_dmp    ( kt )      ! internal damping trends
-         IF( ln_bdy )           CALL trc_bdy_dmp( kt )      ! BDY damping trends
-                                CALL trc_adv    ( kt )      ! horizontal & vertical advection 
+                                CALL trc_sbc    ( kt,      Kmm, tr, Krhs )      ! surface boundary condition
+         IF( ln_trcbc .AND. lltrcbc .AND. kt /= nit000 )  &
+                                CALL trc_bc     ( kt,      Kmm, tr, Krhs )      ! tracers: surface and lateral Boundary Conditions 
+         IF( ln_trabbl )        CALL trc_bbl    ( kt, Kbb, Kmm, tr, Krhs )      ! advective (and/or diffusive) bottom boundary layer scheme
+         IF( ln_trcdmp )        CALL trc_dmp    ( kt, Kbb, Kmm, tr, Krhs )      ! internal damping trends
+         IF( ln_bdy )           CALL trc_bdy_dmp( kt, Kbb,      Krhs )      ! BDY damping trends
+                                CALL trc_adv    ( kt, Kbb, Kmm, tr, Krhs )      ! horizontal & vertical advection 
          !                                                         ! Partial top/bottom cell: GRADh( trb )  
          IF( ln_zps ) THEN
-           IF( ln_isfcav ) THEN ; CALL zps_hde_isf( kt, jptra, trb, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi )  ! both top & bottom
-           ELSE                 ; CALL zps_hde    ( kt, jptra, trb, gtru, gtrv )                                      !  only bottom
+           IF( ln_isfcav ) THEN ; CALL zps_hde_isf( kt, Kmm, jptra, tr(:,:,:,:,Kbb), pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi )  ! both top & bottom
+           ELSE                 ; CALL zps_hde    ( kt, Kmm, jptra, tr(:,:,:,:,Kbb), gtru, gtrv )                                      !  only bottom
            ENDIF
          ENDIF
          !                                                      
-                                CALL trc_ldf    ( kt )      ! lateral mixing
+                                CALL trc_ldf    ( kt, Kbb, Kmm,       tr, Krhs )  ! lateral mixing
 #if defined key_agrif
          IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc       ! tracers sponge
 #endif
-                                CALL trc_zdf    ( kt )      ! vertical mixing and after tracer fields
-                                CALL trc_nxt    ( kt )      ! tracer fields at next time step     
-         IF( ln_trcrad )        CALL trc_rad    ( kt )      ! Correct artificial negative concentrations
-         IF( ln_trcdmp_clo )    CALL trc_dmp_clo( kt )      ! internal damping trends on closed seas only
+                                CALL trc_zdf    ( kt, Kbb, Kmm, Krhs, tr, Kaa  )  ! vert. mixing & after tracer	==> after
+                                CALL trc_atf    ( kt, Kbb, Kmm, Kaa , tr )        ! time filtering of "now" tracer fields    
+         !
+         ! Subsequent calls use the filtered values: Kmm and Kaa 
+         ! These are used explicitly here since time levels will not be swapped until after tra_atf/dyn_atf/ssh_atf in stp
+         !
+         IF( ln_trcrad )        CALL trc_rad    ( kt, Kmm, Kaa, tr       )    ! Correct artificial negative concentrations
+         IF( ln_trcdmp_clo )    CALL trc_dmp_clo( kt, Kmm, Kaa )              ! internal damping trends on closed seas only
 
          !
       ELSE                                               ! 1D vertical configuration
-                                CALL trc_sbc( kt )            ! surface boundary condition
-         IF( ln_trcdmp )        CALL trc_dmp( kt )            ! internal damping trends
-                                CALL trc_zdf( kt )            ! vertical mixing and after tracer fields
-                                CALL trc_nxt( kt )            ! tracer fields at next time step     
-          IF( ln_trcrad )       CALL trc_rad( kt )            ! Correct artificial negative concentrations
+                                CALL trc_sbc( kt,      Kmm,       tr, Krhs )  ! surface boundary condition
+         IF( ln_trcdmp )        CALL trc_dmp( kt, Kbb, Kmm,       tr, Krhs )  ! internal damping trends
+                                CALL trc_zdf( kt, Kbb, Kmm, Krhs, tr, Kaa  )  ! vert. mixing & after tracer	==> after
+                                CALL trc_atf( kt, Kbb, Kmm, Kaa , tr )        ! time filtering of "now" tracer fields
+         !
+         ! Subsequent calls use the filtered values: Kmm and Kaa 
+         ! These are used explicitly here since time levels will not be swapped until after tra_atf/dyn_atf/ssh_atf in stp
+         !
+         IF( ln_trcrad )       CALL trc_rad( kt, Kmm, Kaa, tr       )  ! Correct artificial negative concentrations
          !
       END IF
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trczdf.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trczdf.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trczdf.F90	(revision 12928)
@@ -36,5 +36,5 @@
 CONTAINS
 
-   SUBROUTINE trc_zdf( kt )
+   SUBROUTINE trc_zdf( kt, Kbb, Kmm, Krhs, ptr, Kaa )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE trc_zdf  ***
@@ -43,5 +43,7 @@
       !!              an implicit time-stepping scheme.
       !!---------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::  kt      ! ocean time-step index
+      INTEGER                                   , INTENT(in   ) ::   kt                   ! ocean time-step index
+      INTEGER                                   , INTENT(in   ) ::   Kbb, Kmm, Krhs, Kaa  ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) ::   ptr                  ! passive tracers and RHS of tracer equation
       !
       INTEGER               ::  jk, jn
@@ -52,21 +54,21 @@
       IF( ln_timing )   CALL timing_start('trc_zdf')
       !
-      IF( l_trdtrc )   ztrtrd(:,:,:,:)  = tra(:,:,:,:)
+      IF( l_trdtrc )   ztrtrd(:,:,:,:)  = ptr(:,:,:,:,Krhs)
       !
-      CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dttrc, trb, tra, jptra )    !   implicit scheme          
+      CALL tra_zdf_imp( kt, nittrc000, 'TRC', rDt_trc, Kbb, Kmm, Krhs, ptr, Kaa, jptra )    !   implicit scheme          
       !
       IF( l_trdtrc )   THEN                      ! save the vertical diffusive trends for further diagnostics
          DO jn = 1, jptra
             DO jk = 1, jpkm1
-               ztrtrd(:,:,jk,jn) = ( ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) / r2dttrc ) - ztrtrd(:,:,jk,jn)
+               ztrtrd(:,:,jk,jn) = ( ( ptr(:,:,jk,jn,Kaa) - ptr(:,:,jk,jn,Kbb) ) / rDt_trc ) - ztrtrd(:,:,jk,jn)
             END DO
-            CALL trd_tra( kt, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:,jn) )
+            CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:,jn) )
          END DO
       ENDIF
       !                                          ! print mean trends (used for debugging)
-      IF( ln_ctl )   THEN
+      IF( sn_cfctl%l_prttrc )   THEN
          WRITE(charout, FMT="('zdf ')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+         CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Kaa), mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
       END IF
       !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trdmxl_trc.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trdmxl_trc.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trdmxl_trc.F90	(revision 12928)
@@ -16,6 +16,5 @@
    !!   trd_mxl_trc_init : initialization step
    !!----------------------------------------------------------------------
-   USE trc               ! tracer definitions (trn, trb, tra, etc.)
-   USE trc_oce, ONLY :   nn_dttrc  ! frequency of step on passive tracers
+   USE trc               ! tracer definitions (tr etc.)
    USE dom_oce           ! domain definition
    USE zdfmxl  , ONLY : nmln ! number of level in the mixed layer
@@ -50,4 +49,6 @@
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  ztmltrd2   !
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -70,5 +71,5 @@
 
 
-   SUBROUTINE trd_mxl_trc_zint( ptrc_trdmxl, ktrd, ctype, kjn )
+   SUBROUTINE trd_mxl_trc_zint( ptrc_trdmxl, ktrd, ctype, kjn, Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE trd_mxl_trc_zint  ***
@@ -92,4 +93,5 @@
       !!
       INTEGER, INTENT( in ) ::   ktrd, kjn                        ! ocean trend index and passive tracer rank
+      INTEGER, INTENT( in ) ::   Kmm                              ! time level index
       CHARACTER(len=2), INTENT( in ) ::  ctype                    ! surface/bottom (2D) or interior (3D) physics
       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::  ptrc_trdmxl ! passive tracer trend
@@ -122,14 +124,12 @@
 
             IF( jpktrd_trc < jpk ) THEN                           ! description ???
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     IF( nmld_trc(ji,jj) <= jpktrd_trc ) THEN
-                        zvlmsk(ji,jj) = tmask(ji,jj,1)
-                     ELSE
-                        isum = isum + 1
-                        zvlmsk(ji,jj) = 0.e0
-                     ENDIF
-                  END DO
-               END DO
+               DO_2D_11_11
+                  IF( nmld_trc(ji,jj) <= jpktrd_trc ) THEN
+                     zvlmsk(ji,jj) = tmask(ji,jj,1)
+                  ELSE
+                     isum = isum + 1
+                     zvlmsk(ji,jj) = 0.e0
+                  ENDIF
+               END_2D
             ENDIF
 
@@ -147,11 +147,7 @@
          ! ... Weights for vertical averaging
          wkx_trc(:,:,:) = 0.e0
-         DO jk = 1, jpktrd_trc                                    ! initialize wkx_trc with vertical scale factor in mixed-layer
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  IF( jk - nmld_trc(ji,jj) < 0 )   wkx_trc(ji,jj,jk) = e3t_n(ji,jj,jk) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_11_11( 1, jpktrd_trc )
+            IF( jk - nmld_trc(ji,jj) < 0 )   wkx_trc(ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk)
+         END_3D
          
          rmld_trc(:,:) = 0.e0
@@ -183,5 +179,5 @@
 
 
-   SUBROUTINE trd_mxl_trc( kt )
+   SUBROUTINE trd_mxl_trc( kt, Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE trd_mxl_trc  ***
@@ -232,4 +228,5 @@
       !
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER, INTENT(in) ::   Kmm                              ! time level index
       !
       INTEGER ::   ji, jj, jk, jl, ik, it, itmod, jn
@@ -251,6 +248,4 @@
 
 
-      IF( nn_dttrc  /= 1  )   CALL ctl_stop( " Be careful, trends diags never validated " )
-
       ! ======================================================================
       ! I. Diagnose the purely vertical (K_z) diffusion trend
@@ -263,13 +258,11 @@
          !
          DO jn = 1, jptra
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  ik = nmld_trc(ji,jj)
-                  IF( ln_trdtrc(jn) )    &
-                  tmltrd_trc(ji,jj,jpmxl_trc_zdf,jn) = - avs(ji,jj,ik) / e3w_n(ji,jj,ik) * tmask(ji,jj,ik)  &
-                       &                    * ( trn(ji,jj,ik-1,jn) - trn(ji,jj,ik,jn) )            &
-                       &                    / MAX( 1., rmld_trc(ji,jj) ) * tmask(ji,jj,1)
-               END DO
-            END DO
+            DO_2D_11_11
+               ik = nmld_trc(ji,jj)
+               IF( ln_trdtrc(jn) )    &
+               tmltrd_trc(ji,jj,jpmxl_trc_zdf,jn) = - avs(ji,jj,ik) / e3w(ji,jj,ik,Kmm) * tmask(ji,jj,ik)  &
+                    &                    * ( tr(ji,jj,ik-1,jn,Kmm) - tr(ji,jj,ik,jn,Kmm) )            &
+                    &                    / MAX( 1., rmld_trc(ji,jj) ) * tmask(ji,jj,1)
+            END_2D
          END DO
 
@@ -322,5 +315,5 @@
          DO jn = 1, jptra
             IF( ln_trdtrc(jn) ) &
-               tml_trc(:,:,jn) = tml_trc(:,:,jn) + wkx_trc(:,:,jk) * trn(:,:,jk,jn)
+               tml_trc(:,:,jn) = tml_trc(:,:,jn) + wkx_trc(:,:,jk) * tr(:,:,jk,jn,Kmm)
          END DO
       END DO
@@ -328,5 +321,5 @@
       ! II.3 Initialize mixed-layer "before" arrays for the 1rst analysis window    
       ! ------------------------------------------------------------------------
-      IF( kt == nittrc000 + nn_dttrc ) THEN  !  i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1)    ???
+      IF( kt == nittrc000 + 1 ) THEN  !  i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1)    ???
          !
          DO jn = 1, jptra
@@ -408,9 +401,9 @@
          DO jn = 1, jptra
             IF( ln_trdtrc(jn) ) THEN
-               !-- Compute total trends    (use rdttrc instead of rdt ???)
+               !-- Compute total trends 
                IF ( ln_trcadv_muscl .OR. ln_trcadv_muscl2 ) THEN  ! EULER-FORWARD schemes
-                  ztmltot(:,:,jn) =  ( tml_trc(:,:,jn) - tmlbn_trc(:,:,jn) )/rdt
+                  ztmltot(:,:,jn) =  ( tml_trc(:,:,jn) - tmlbn_trc(:,:,jn) )/rn_Dt
                ELSE                                                                     ! LEAP-FROG schemes
-                  ztmltot(:,:,jn) =  ( tml_trc(:,:,jn) - tmlbn_trc(:,:,jn) + tmlb_trc(:,:,jn) - tmlbb_trc(:,:,jn))/(2.*rdt)
+                  ztmltot(:,:,jn) =  ( tml_trc(:,:,jn) - tmlbn_trc(:,:,jn) + tmlb_trc(:,:,jn) - tmlbb_trc(:,:,jn))/(2.*rn_Dt)
                ENDIF
                
@@ -446,5 +439,5 @@
             IF( ln_trdtrc(jn) ) THEN
                tml_sum_trc(:,:,jn) = tmlbn_trc(:,:,jn) + 2 * ( tml_sum_trc(:,:,jn) - tml_trc(:,:,jn) ) + tml_trc(:,:,jn)
-               ztmltot2   (:,:,jn) = ( tml_sum_trc(:,:,jn) - tml_sumb_trc(:,:,jn) ) /  ( 2.*rdt )    ! now tracer unit is /sec
+               ztmltot2   (:,:,jn) = ( tml_sum_trc(:,:,jn) - tml_sumb_trc(:,:,jn) ) /  ( 2.*rn_Dt )    ! now tracer unit is /sec
             ENDIF
          END DO
@@ -859,16 +852,16 @@
          CALL ctl_stop( 'STOP', 'trd_mxl_trc : this was never checked. Comment this line to proceed...' )
       ENDIF
-      zsto = nn_trd_trc * rdt
+      zsto = nn_trd_trc * rn_Dt
       clop = "inst("//TRIM(clop)//")"
 #  else
       IF( ln_trdmxl_trc_instant ) THEN
-         zsto = rdt                                               ! inst. diags : we use IOIPSL time averaging
+         zsto = rn_Dt                                               ! inst. diags : we use IOIPSL time averaging
       ELSE
-         zsto = nn_trd_trc * rdt                                    ! mean  diags : we DO NOT use any IOIPSL time averaging
+         zsto = nn_trd_trc * rn_Dt                                    ! mean  diags : we DO NOT use any IOIPSL time averaging
       ENDIF
       clop = "ave("//TRIM(clop)//")"
 #  endif
-      zout = nn_trd_trc * rdt
-      iiter = ( nittrc000 - 1 ) / nn_dttrc
+      zout = nn_trd_trc * rn_Dt
+      iiter = nittrc000 - 1
 
       IF(lwp) WRITE (numout,*) '                netCDF initialization'
@@ -876,5 +869,5 @@
       ! II.2 Compute julian date from starting date of the run
       ! ------------------------------------------------------
-      CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )
+      CALL ymds2ju( nyear, nmonth, nday, rn_Dt, zjulian )
       zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
       IF(lwp) WRITE(numout,*)' '  
@@ -908,5 +901,5 @@
             CALL dia_nam( clhstnam, nn_trd_trc, csuff )
             CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,                                            &
-               &        1, jpi, 1, jpj, iiter, zjulian, rdt, nh_t(jn), nidtrd(jn), domain_id=nidom, snc4chunks=snc4set )
+               &        1, jpi, 1, jpj, iiter, zjulian, rn_Dt, nh_t(jn), nidtrd(jn), domain_id=nidom, snc4chunks=snc4set )
       
             !-- Define the ML depth variable
@@ -945,5 +938,5 @@
                CALL histdef(nidtrd(jn), trim(clvar)//trim(ctrd_trc(jl,2)), clmxl//" "//clvar//ctrd_trc(jl,1),                      & 
                  &    cltrcu, jpi, jpj, nh_t(jn), 1  , 1, 1  , -99 , 32, clop, zsto, zout ) ! IOIPSL: time mean
-            END DO                                                                         ! if zsto=rdt above
+            END DO                                                                         ! if zsto=rn_Dt above
          
             CALL histdef(nidtrd(jn), trim(clvar)//trim(ctrd_trc(jpmxl_trc_radb,2)), clmxl//" "//clvar//ctrd_trc(jpmxl_trc_radb,1), & 
@@ -970,10 +963,12 @@
    !!----------------------------------------------------------------------
 CONTAINS
-   SUBROUTINE trd_mxl_trc( kt )                                   ! Empty routine
+   SUBROUTINE trd_mxl_trc( kt, Kmm )                                   ! Empty routine
       INTEGER, INTENT( in) ::   kt
+      INTEGER, INTENT( in) ::   Kmm            ! time level index
       WRITE(*,*) 'trd_mxl_trc: You should not have seen this print! error?', kt
    END SUBROUTINE trd_mxl_trc
-   SUBROUTINE trd_mxl_trc_zint( ptrc_trdmxl, ktrd, ctype, kjn )
+   SUBROUTINE trd_mxl_trc_zint( ptrc_trdmxl, ktrd, ctype, kjn, Kmm )
       INTEGER               , INTENT( in ) ::  ktrd, kjn              ! ocean trend index and passive tracer rank
+      INTEGER               , INTENT( in ) ::  Kmm                    ! time level index
       CHARACTER(len=2)      , INTENT( in ) ::  ctype                  ! surface/bottom (2D) or interior (3D) physics
       REAL, DIMENSION(:,:,:), INTENT( in ) ::  ptrc_trdmxl            ! passive trc trend
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trdmxl_trc_rst.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trdmxl_trc_rst.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trdmxl_trc_rst.F90	(revision 12928)
@@ -11,5 +11,5 @@
    USE in_out_manager  ! I/O manager
    USE iom             ! I/O module
-   USE trc             ! for nn_dttrc ctrcnm
+   USE trc             ! for ctrcnm
    USE trdmxl_trc_oce  ! for lk_trdmxl_trc
 
@@ -44,5 +44,5 @@
       !!--------------------------------------------------------------------------------
 
-      IF( kt == nitrst - nn_dttrc .OR. nitend - nit000 + 1 < 2 * nn_dttrc ) THEN ! idem trcrst.F90
+      IF( kt == nitrst - 1 .OR. nitend - nit000 + 1 < 2 ) THEN ! idem trcrst.F90
          IF( nitrst > 1.0e9 ) THEN
             WRITE(clkt,*) nitrst
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trdtrc.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trdtrc.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/TRP/trdtrc.F90	(revision 12928)
@@ -13,5 +13,5 @@
    !!   trdtrc      : passive tracer trends 
    !!----------------------------------------------------------------------
-   USE trc               ! tracer definitions (trn, trb, tra, etc.)
+   USE trc               ! tracer definitions (tr(:,:,:,:,Kmm), tr(:,:,:,:,Kbb), tr(:,:,:,:,Krhs), etc.)
    USE trd_oce
    USE trdtrc_oce       ! definition of main arrays used for trends computations
@@ -32,9 +32,10 @@
 CONTAINS
 
-   SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt )
+   SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt, Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE trd_trc  ***
       !!----------------------------------------------------------------------
       INTEGER, INTENT( in )  ::   kt                                  ! time step
+      INTEGER, INTENT( in )  ::   Kmm                                 ! time level index
       INTEGER, INTENT( in )  ::   kjn                                 ! tracer index
       INTEGER, INTENT( in )  ::   ktrd                                ! tracer trend index
@@ -56,21 +57,21 @@
          !
          SELECT CASE ( ktrd )
-         CASE ( jptra_xad     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_xad, '3D', kjn )
-         CASE ( jptra_yad     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_yad, '3D', kjn )
-         CASE ( jptra_zad     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_zad, '3D', kjn )
-         CASE ( jptra_ldf     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_ldf, '3D', kjn )
-         CASE ( jptra_bbl     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_bbl, '3D', kjn )
+         CASE ( jptra_xad     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_xad, '3D', kjn, Kmm )
+         CASE ( jptra_yad     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_yad, '3D', kjn, Kmm )
+         CASE ( jptra_zad     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_zad, '3D', kjn, Kmm )
+         CASE ( jptra_ldf     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_ldf, '3D', kjn, Kmm )
+         CASE ( jptra_bbl     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_bbl, '3D', kjn, Kmm )
          CASE ( jptra_zdf     )
             IF( ln_trcldf_iso ) THEN
-               CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_ldf, '3D', kjn )
+               CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_ldf, '3D', kjn, Kmm )
             ELSE
-               CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_zdf, '3D', kjn )
+               CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_zdf, '3D', kjn, Kmm )
             ENDIF
-         CASE ( jptra_dmp     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_dmp , '3D', kjn )
-         CASE ( jptra_nsr     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_sbc , '2D', kjn )
-         CASE ( jptra_sms     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_sms , '3D', kjn )
-         CASE ( jptra_radb    )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_radb, '3D', kjn )
-         CASE ( jptra_radn    )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_radn, '3D', kjn )
-         CASE ( jptra_atf     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_atf , '3D', kjn )
+         CASE ( jptra_dmp     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_dmp , '3D', kjn, Kmm )
+         CASE ( jptra_nsr     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_sbc , '2D', kjn, Kmm )
+         CASE ( jptra_sms     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_sms , '3D', kjn, Kmm )
+         CASE ( jptra_radb    )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_radb, '3D', kjn, Kmm )
+         CASE ( jptra_radn    )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_radn, '3D', kjn, Kmm )
+         CASE ( jptra_atf     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_atf , '3D', kjn, Kmm )
          END SELECT
          !
@@ -110,6 +111,7 @@
 CONTAINS
 
-   SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt )
+   SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt, Kmm )
       INTEGER               , INTENT( in )     ::   kt      ! time step
+      INTEGER               , INTENT( in )     ::   Kmm     ! time level index
       INTEGER               , INTENT( in )     ::   kjn     ! tracer index
       INTEGER               , INTENT( in )     ::   ktrd    ! tracer trend index
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/oce_trc.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/oce_trc.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/oce_trc.F90	(revision 12928)
@@ -8,4 +8,5 @@
    !!----------------------------------------------------------------------
    !                                            !* Domain size *
+   USE par_oce , ONLY :   jpt      =>   jpt        !: time dimension
    USE par_oce , ONLY :   jpi      =>   jpi        !: first  dimension of grid --> i 
    USE par_oce , ONLY :   jpj      =>   jpj        !: second dimension of grid --> j  
@@ -33,17 +34,13 @@
 
    !* ocean fields: here now and after fields *
-   USE oce , ONLY :   un      =>    un      !: i-horizontal velocity (m s-1) 
-   USE oce , ONLY :   vn      =>    vn      !: j-horizontal velocity (m s-1)
-   USE oce , ONLY :   wn      =>    wn      !: vertical velocity (m s-1)  
-   USE oce , ONLY :   tsn     =>    tsn     !: 4D array contaning ( tn, sn )
-   USE oce , ONLY :   tsb     =>    tsb     !: 4D array contaning ( tb, sb )
-   USE oce , ONLY :   tsa     =>    tsa     !: 4D array contaning ( ta, sa )
-   USE oce , ONLY :   rhop    =>    rhop    !: potential volumic mass (kg m-3) 
-   USE oce , ONLY :   rhd     =>    rhd     !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units)
-   USE oce , ONLY :   hdivn   =>    hdivn   !: horizontal divergence (1/s)
-   USE oce , ONLY :   sshn    =>    sshn    !: sea surface height at t-point [m]   
-   USE oce , ONLY :   sshb    =>    sshb    !: sea surface height at t-point [m]   
-   USE oce , ONLY :   ssha    =>    ssha    !: sea surface height at t-point [m]   
-   USE oce , ONLY :   rab_n   =>    rab_n   !: local thermal/haline expension ratio at T-points
+   USE oce , ONLY :   uu     =>    uu     !: i-horizontal velocity (m s-1) 
+   USE oce , ONLY :   vv     =>    vv     !: j-horizontal velocity (m s-1)
+   USE oce , ONLY :   ww     =>    ww     !: vertical velocity (m s-1)  
+   USE oce , ONLY :   ts     =>    ts     !: 4D array contaning ( tn, sn )
+   USE oce , ONLY :   rhop   =>    rhop   !: potential volumic mass (kg m-3) 
+   USE oce , ONLY :   rhd    =>    rhd    !: in situ density anomalie rhd=(rho-rho0)/rho0 (no units)
+   USE oce , ONLY :   hdiv   =>    hdiv   !: horizontal divergence (1/s)
+   USE oce , ONLY :   ssh    =>    ssh    !: sea surface height at t-point [m]   
+   USE oce , ONLY :   rab_n  =>    rab_n  !: local thermal/haline expension ratio at T-points
 
    !* surface fluxes *
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/prtctl_trc.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/prtctl_trc.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/prtctl_trc.F90	(revision 12928)
@@ -35,5 +35,5 @@
    SUBROUTINE prt_ctl_trc( tab4d, mask, clinfo, ovlap, kdim, clinfo2 )
       !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE prt_ctl  ***
+      !!                     ***  ROUTINE prt_ctl_trc  ***
       !!
       !! ** Purpose : - print sum control 3D arrays over the same area 
@@ -41,5 +41,5 @@
       !!                debugging a new parametrization in mono or mpp. 
       !!
-      !! ** Method  : 2 possibilities exist when setting the ln_ctl parameter to
+      !! ** Method  : 2 possibilities exist when setting the sn_cfctl%prttrc parameter to
       !!                .true. in the ocean namelist:
       !!              - to debug a MPI run .vs. a mono-processor one; 
@@ -54,6 +54,6 @@
       !!              - All arguments of the above calling sequence are optional so their
       !!                name must be explicitly typed if used. For instance if the mask
-      !!                array tmask(:,:,:) must be passed through the prt_ctl subroutine, 
-      !!                it must looks like: CALL prt_ctl( mask=tmask ).
+      !!                array tmask(:,:,:) must be passed through the prt_ctl_trc subroutine, 
+      !!                it must look like: CALL prt_ctl_trc( mask=tmask ).
       !!----------------------------------------------------------------------
       REAL(wp)         , DIMENSION(:,:,:,:), INTENT(in), OPTIONAL ::   tab4d     ! 4D array
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trc.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trc.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trc.F90	(revision 12928)
@@ -18,13 +18,13 @@
 
    !                                     !!- logical units of passive tracers
-   INTEGER, PUBLIC ::   numnat_ref = -1   !: reference passive tracer namelist_top_ref
-   INTEGER, PUBLIC ::   numnat_cfg = -1   !: reference passive tracer namelist_top_cfg
    INTEGER, PUBLIC ::   numont     = -1   !: reference passive tracer namelist output output.namelist.top
-   INTEGER, PUBLIC ::   numtrc_ref = -1   !: reference passive tracer namelist_top_ref
-   INTEGER, PUBLIC ::   numtrc_cfg = -1   !: reference passive tracer namelist_top_cfg
    INTEGER, PUBLIC ::   numonr     = -1   !: reference passive tracer namelist output output.namelist.top
    INTEGER, PUBLIC ::   numstr            !: tracer statistics
    INTEGER, PUBLIC ::   numrtr            !: trc restart (read )
    INTEGER, PUBLIC ::   numrtw            !: trc restart ( write )
+   CHARACTER(:), ALLOCATABLE, PUBLIC ::   numnat_ref   !: character buffer for reference passive tracer namelist_top_ref
+   CHARACTER(:), ALLOCATABLE, PUBLIC ::   numnat_cfg   !: character buffer for configuration specific passive tracer namelist_top_cfg
+   CHARACTER(:), ALLOCATABLE, PUBLIC ::   numtrc_ref   !: character buffer for reference passive tracer namelist_trc_ref
+   CHARACTER(:), ALLOCATABLE, PUBLIC ::   numtrc_cfg   !: character buffer for configuration specific passive tracer namelist_trc_cfg
 
    !! passive tracers fields (before,now,after)
@@ -33,7 +33,5 @@
    REAL(wp), PUBLIC                                        ::  areatot        !: total volume 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::  cvol           !: volume correction -degrad option- 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  trn            !: tracer concentration for now time step
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  tra            !: tracer concentration for next time step
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  trb            !: tracer concentration for before time step
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::  tr           !: tracer concentration 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::  sbc_trc_b      !: Before sbc fluxes for tracers
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::  sbc_trc        !: Now sbc fluxes for tracers
@@ -63,8 +61,8 @@
    CHARACTER(len = 80) , PUBLIC ::   cn_trcrst_out      !: suffix of pass. tracer restart name (output)
    CHARACTER(len = 256), PUBLIC ::   cn_trcrst_outdir   !: restart output directory
-   REAL(wp)            , PUBLIC ::   rdttrc             !: passive tracer time step
-   REAL(wp)            , PUBLIC ::   r2dttrc            !: = 2*rdttrc except at nit000 (=rdttrc) if neuler=0
+   REAL(wp)            , PUBLIC ::   rDt_trc            !: = 2*rn_Dt except at nit000 (=rn_Dt) if l_1st_euler=.true.
    LOGICAL             , PUBLIC ::   ln_top_euler       !: boolean term for euler integration 
    LOGICAL             , PUBLIC ::   ln_trcdta          !: Read inputs data from files
+   LOGICAL             , PUBLIC ::   ln_trcbc           !: Enable surface, lateral or open boundaries conditions
    LOGICAL             , PUBLIC ::   ln_trcdmp          !: internal damping flag
    LOGICAL             , PUBLIC ::   ln_trcdmp_clo      !: internal damping flag on closed seas
@@ -117,5 +115,7 @@
    LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ln_trc_cbc    !: Use coastal boundary condition data
    LOGICAL , PUBLIC                                  ::   ln_rnf_ctl    !: remove runoff dilution on tracers
-   REAL(wp), PUBLIC                                  ::   rn_bc_time    !: Time scaling factor for SBC and CBC data (seconds in a day)
+   REAL(wp), PUBLIC                                  ::   rn_sbc_time   !: Time scaling factor for SBC data (seconds in a day)
+   REAL(wp), PUBLIC                                  ::   rn_cbc_time   !: Time scaling factor for CBC data (seconds in a day)
+   LOGICAL , PUBLIC                                  ::   lltrcbc       !: Applying one of the boundary conditions 
    !
    CHARACTER(len=20), PUBLIC, DIMENSION(jp_bdy) :: cn_trc_dflt   ! Default OBC condition for all tracers
@@ -130,4 +130,6 @@
 !$AGRIF_END_DO_NOT_TREAT
    !
+   !! Substitutions
+#include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -147,5 +149,5 @@
       ierr(:) = 0
       !
-      ALLOCATE( trn(jpi,jpj,jpk,jptra), trb(jpi,jpj,jpk,jptra), tra(jpi,jpj,jpk,jptra),       &  
+      ALLOCATE( tr(jpi,jpj,jpk,jptra,jpt)                                             ,       &  
          &      trc_i(jpi,jpj,jptra)  , trc_o(jpi,jpj,jptra)                          ,       &
          &      gtru (jpi,jpj,jptra)  , gtrv (jpi,jpj,jptra)                          ,       &
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcbc.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcbc.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcbc.F90	(revision 12928)
@@ -7,8 +7,4 @@
    !!            3.6 !  2015 (T . Lovato) Revision and BDY support
    !!            4.0 !  2016 (T . Lovato) Include application of sbc and cbc
-   !!----------------------------------------------------------------------
-#if defined key_top
-   !!----------------------------------------------------------------------
-   !!   'key_top'                                                TOP model 
    !!----------------------------------------------------------------------
    !!   trc_bc       :  Apply tracer Boundary Conditions
@@ -45,6 +41,11 @@
 #endif
 
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP model 
+   !!----------------------------------------------------------------------
+
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -54,5 +55,5 @@
 CONTAINS
 
-   SUBROUTINE trc_bc_ini( ntrc )
+   SUBROUTINE trc_bc_ini( ntrc, Kmm )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE trc_bc_ini  ***
@@ -63,5 +64,6 @@
       !!              - allocates passive tracer BC data structure 
       !!----------------------------------------------------------------------
-      INTEGER,INTENT(in) :: ntrc                           ! number of tracers
+      INTEGER, INTENT(in) :: ntrc                          ! number of tracers
+      INTEGER, INTENT(in) ::   Kmm                         ! time level index
       !
       INTEGER            :: jl, jn , ib, ibd, ii, ij, ik   ! dummy loop indices
@@ -81,5 +83,5 @@
       !!
       NAMELIST/namtrc_bc/ cn_dir_obc, sn_trcobc, rn_trofac, cn_dir_sbc, sn_trcsbc, rn_trsfac, & 
-                        & cn_dir_cbc, sn_trccbc, rn_trcfac, ln_rnf_ctl, rn_bc_time
+                        & cn_dir_cbc, sn_trccbc, rn_trcfac, ln_rnf_ctl, rn_sbc_time, rn_cbc_time
       NAMELIST/namtrc_bdy/ cn_trc_dflt, cn_trc, nn_trcdmp_bdy
       !!----------------------------------------------------------------------
@@ -120,8 +122,6 @@
       !
       ! Read Boundary Conditions Namelists
-      REWIND( numnat_ref )              ! Namelist namtrc_bc in reference namelist : Passive tracer data structure
       READ  ( numnat_ref, namtrc_bc, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_bc in reference namelist' )
-      REWIND( numnat_cfg )              ! Namelist namtrc_bc in configuration namelist : Passive tracer data structure
       READ  ( numnat_cfg, namtrc_bc, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_bc in configuration namelist' )
@@ -129,5 +129,4 @@
 
       IF ( ln_bdy ) THEN
-         REWIND( numnat_ref )              ! Namelist namtrc_bdy in reference namelist : Passive tracer data structure
          READ  ( numnat_ref, namtrc_bdy, IOSTAT = ios, ERR = 903)
 903      IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_bdy in reference namelist' )
@@ -135,5 +134,4 @@
          cn_trc     (2:jp_bdy) = cn_trc     (1)
          cn_trc_dflt(2:jp_bdy) = cn_trc_dflt(1)
-         REWIND( numnat_cfg )              ! Namelist namtrc_bdy in configuration namelist : Passive tracer data structure
          READ  ( numnat_cfg, namtrc_bdy, IOSTAT = ios, ERR = 904 )
 904      IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_bdy in configuration namelist' )
@@ -153,5 +151,5 @@
                IF(trcdta_bdy(jn,ib)%cn_obc == 'frs' .AND. nn_trcdmp_bdy(ib) /= 0 )  &
                    & CALL ctl_stop( 'trc_bc_ini: Use FRS OR relaxation' )
-               IF(  .NOT.( 0 < nn_trcdmp_bdy(ib)  .AND.  nn_trcdmp_bdy(ib) <= 2 )  )   &
+               IF(  .NOT.( 0 <= nn_trcdmp_bdy(ib)  .AND.  nn_trcdmp_bdy(ib) <= 2 )  )   &
                    & CALL ctl_stop( 'trc_bc_ini: Not a valid option for nn_trcdmp_bdy. Allowed: 0,1,2.' )
             END DO
@@ -264,5 +262,5 @@
                         ii = idx_bdy(ib)%nbi(ibd,igrd)
                         ij = idx_bdy(ib)%nbj(ibd,igrd)
-                        trcdta_bdy(jn,ib)%trc(ibd,ik) = trn(ii,ij,ik,jn) * tmask(ii,ij,ik)
+                        trcdta_bdy(jn,ib)%trc(ibd,ik) = tr(ii,ij,ik,jn,Kmm) * tmask(ii,ij,ik)
                      END DO
                   END DO
@@ -339,5 +337,5 @@
 
 
-   SUBROUTINE trc_bc(kt, jit)
+   SUBROUTINE trc_bc(kt, Kmm, ptr, Krhs, jit)
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE trc_bc  ***
@@ -350,6 +348,8 @@
       USE fldread
       !!      
-      INTEGER, INTENT(in)           ::   kt    ! ocean time-step index
-      INTEGER, INTENT(in), OPTIONAL ::   jit   ! subcycle time-step index (for timesplitting option)
+      INTEGER                                   , INTENT(in)           ::   kt        ! ocean time-step index
+      INTEGER                                   , INTENT(in)           ::   Kmm, Krhs ! time level indices
+      INTEGER                                   , INTENT(in), OPTIONAL ::   jit       ! subcycle time-step index (for timesplitting option)
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr            ! passive tracers and RHS of tracer equation
       !!
       INTEGER  :: ji, jj, jk, jn, jl             ! Loop index
@@ -368,8 +368,8 @@
       IF( PRESENT(jit) ) THEN 
          !
-         ! OPEN boundary conditions (use kt_offset=+1 as they are applied at the end of the step)
+         ! BDY: use pt_offset=0.5 as applied at the end of the step and fldread is referenced at the middle of the step
          IF( nb_trcobc > 0 ) THEN
            if (lwp) write(numout,'(a,i5,a,i10)') '   reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt
-           CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, kit=jit, kt_offset=+1)
+           CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, kit=jit, pt_offset = 0.5_wp )
          ENDIF
          !
@@ -388,8 +388,8 @@
       ELSE
          !
-         ! OPEN boundary conditions (use kt_offset=+1 as they are applied at the end of the step)
+         ! BDY: use pt_offset=0.5 as applied at the end of the step and fldread is referenced at the middle of the step
          IF( nb_trcobc > 0 ) THEN
            if (lwp) write(numout,'(a,i5,a,i10)') '   reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt
-           CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, kt_offset=+1)
+           CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, pt_offset = 0.5_wp )
          ENDIF
          !
@@ -414,12 +414,10 @@
          ! Remove river dilution for tracers with absent river load
          IF( ln_rnf_ctl .AND. .NOT.ln_trc_cbc(jn) ) THEN
-            DO jj = 2, jpj
-               DO ji = fs_2, fs_jpim1
-                  DO jk = 1, nk_rnf(ji,jj)
-                     zrnf = (rnf(ji,jj) + rnf_b(ji,jj)) * 0.5_wp * r1_rau0 / h_rnf(ji,jj)
-                     tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn)  + (trn(ji,jj,jk,jn) * zrnf)
-                  END DO
+            DO_2D_01_00
+               DO jk = 1, nk_rnf(ji,jj)
+                  zrnf = (rnf(ji,jj) + rnf_b(ji,jj)) * 0.5_wp * r1_rho0 / h_rnf(ji,jj)
+                  ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs)  + (ptr(ji,jj,jk,jn,Kmm) * zrnf)
                END DO
-            END DO
+            END_2D
          ENDIF
          !
@@ -429,23 +427,21 @@
          IF( ln_trc_sbc(jn) ) THEN
             jl = n_trc_indsbc(jn)
-            DO jj = 2, jpj
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zfact = 1. / ( e3t_n(ji,jj,1) * rn_bc_time )
-                  tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + rf_trsfac(jl) * sf_trcsbc(jl)%fnow(ji,jj,1) * zfact
+            sf_trcsbc(jl)%fnow(:,:,1) = MAX( rtrn, sf_trcsbc(jl)%fnow(:,:,1) ) ! avoid nedgative value due to interpolation
+            DO_2D_01_00
+               zfact = 1. / ( e3t(ji,jj,1,Kmm) * rn_sbc_time )
+               ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + rf_trsfac(jl) * sf_trcsbc(jl)%fnow(ji,jj,1) * zfact
+            END_2D
+         ENDIF
+         !
+         ! COASTAL boundary conditions
+         IF( ( ln_rnf .OR. l_offline ) .AND. ln_trc_cbc(jn) ) THEN
+            IF( l_offline )   rn_rfact = 1._wp
+            jl = n_trc_indcbc(jn)
+            DO_2D_01_00
+               DO jk = 1, nk_rnf(ji,jj)
+                  zfact = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_cbc_time ) * tmask(ji,jj,1)
+                  ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zfact
                END DO
-            END DO
-         ENDIF
-         !
-         ! COASTAL boundary conditions
-         IF( ln_rnf .AND. ln_trc_cbc(jn) ) THEN
-            jl = n_trc_indcbc(jn)
-            DO jj = 2, jpj
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  DO jk = 1, nk_rnf(ji,jj)
-                     zfact = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_bc_time ) 
-                     tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zfact
-                  END DO
-               END DO
-            END DO
+            END_2D
          ENDIF
          !                                                       ! ===========
@@ -461,10 +457,12 @@
    !!----------------------------------------------------------------------
 CONTAINS
-   SUBROUTINE trc_bc_ini( ntrc )        ! Empty routine
-      INTEGER,INTENT(IN) :: ntrc                           ! number of tracers
-      WRITE(*,*) 'trc_bc_ini: You should not have seen this print! error?', kt
+   SUBROUTINE trc_bc_ini( ntrc, Kmm )        ! Empty routine
+      INTEGER, INTENT(IN) :: ntrc                           ! number of tracers
+      INTEGER, INTENT(in) :: Kmm                            ! time level index
+      WRITE(*,*) 'trc_bc_ini: You should not have seen this print! error?', ntrc, Kmm
    END SUBROUTINE trc_bc_ini
-   SUBROUTINE trc_bc( kt )        ! Empty routine
-      WRITE(*,*) 'trc_bc: You should not have seen this print! error?', kt
+   SUBROUTINE trc_bc( kt, Kmm, Krhs )        ! Empty routine
+      INTEGER, INTENT(in) :: kt, Kmm, Krhs ! time level indices
+      WRITE(*,*) 'trc_bc: You should not have seen this print! error?', kt, Kmm, Krhs 
    END SUBROUTINE trc_bc
 #endif
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcbdy.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcbdy.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcbdy.F90	(revision 12928)
@@ -37,5 +37,5 @@
 CONTAINS
 
-   SUBROUTINE trc_bdy( kt )
+   SUBROUTINE trc_bdy( kt, Kbb, Kmm, Krhs )
       !!----------------------------------------------------------------------
       !!                  ***  SUBROUTINE trc_bdy  ***
@@ -44,5 +44,6 @@
       !!
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) :: kt     ! Main time step counter
+      INTEGER, INTENT( in ) :: kt              ! Main time step counter
+      INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs  ! time level indices
       !!
       INTEGER                           :: ib_bdy ,ir, jn ,igrd ! Loop indices
@@ -70,10 +71,10 @@
                CASE('none'        )   ;   CYCLE
                CASE('frs'         )   ! treat the whole boundary at once
-                  IF( ir == 0 ) CALL bdy_frs( idx_bdy(ib_bdy),                tra(:,:,:,jn), ztrc*zfac )
+                  IF( ir == 0 ) CALL bdy_frs( idx_bdy(ib_bdy),                tr(:,:,:,jn,Krhs), ztrc*zfac )
                CASE('specified'   )   ! treat the whole rim      at once
-                  IF( ir == 0 ) CALL bdy_spe( idx_bdy(ib_bdy),                tra(:,:,:,jn), ztrc*zfac )
-               CASE('neumann'     )   ;   CALL bdy_nmn( idx_bdy(ib_bdy), igrd         , tra(:,:,:,jn) )   ! tra masked
-               CASE('orlanski'    )   ;   CALL bdy_orl( idx_bdy(ib_bdy), trb(:,:,:,jn), tra(:,:,:,jn), ztrc*zfac, ll_npo=.false. )
-               CASE('orlanski_npo')   ;   CALL bdy_orl( idx_bdy(ib_bdy), trb(:,:,:,jn), tra(:,:,:,jn), ztrc*zfac, ll_npo=.true. )
+                  IF( ir == 0 ) CALL bdy_spe( idx_bdy(ib_bdy),                tr(:,:,:,jn,Krhs), ztrc*zfac )
+               CASE('neumann'     )   ;   CALL bdy_nmn( idx_bdy(ib_bdy), igrd         , tr(:,:,:,jn,Krhs) )   ! tra masked
+               CASE('orlanski'    )   ;   CALL bdy_orl( idx_bdy(ib_bdy), tr(:,:,:,jn,Kbb), tr(:,:,:,jn,Krhs), ztrc*zfac, ll_npo=.false. )
+               CASE('orlanski_npo')   ;   CALL bdy_orl( idx_bdy(ib_bdy), tr(:,:,:,jn,Kbb), tr(:,:,:,jn,Krhs), ztrc*zfac, ll_npo=.true. )
                CASE DEFAULT           ;   CALL ctl_stop( 'trc_bdy : unrecognised option for open boundaries for passive tracers' )
                END SELECT
@@ -95,5 +96,5 @@
          END DO
          IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction
-            CALL lbc_lnk( 'bdytra', tsa, 'T',  1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 )
+            CALL lbc_lnk( 'trcbdy', tr(:,:,:,:,Krhs), 'T',  1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 )
          END IF
          !
@@ -105,5 +106,5 @@
 
 
-   SUBROUTINE trc_bdy_dmp( kt )
+   SUBROUTINE trc_bdy_dmp( kt, Kbb, Krhs )
       !!----------------------------------------------------------------------
       !!                 ***  SUBROUTINE trc_bdy_dmp  ***
@@ -114,4 +115,5 @@
       !!----------------------------------------------------------------------
       INTEGER,         INTENT(in) ::   kt
+      INTEGER,         INTENT(in) ::   Kbb, Krhs  ! time level indices
       !! 
       INTEGER  ::   jn             ! Tracer index
@@ -134,6 +136,6 @@
                   zwgt = idx_bdy(ib_bdy)%nbd(ib,igrd)
                   DO ik = 1, jpkm1
-                     zta = zwgt * ( trcdta_bdy(jn, ib_bdy)%trc(ib,ik) - trb(ii,ij,ik,jn) ) * tmask(ii,ij,ik)
-                     tra(ii,ij,ik,jn) = tra(ii,ij,ik,jn) + zta
+                     zta = zwgt * ( trcdta_bdy(jn, ib_bdy)%trc(ib,ik) - tr(ii,ij,ik,jn,Kbb) ) * tmask(ii,ij,ik)
+                     tr(ii,ij,ik,jn,Krhs) = tr(ii,ij,ik,jn,Krhs) + zta
                   END DO
                END DO
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcdta.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcdta.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcdta.F90	(revision 12928)
@@ -39,4 +39,6 @@
 !$AGRIF_END_DO_NOT_TREAT
 
+   !! Substitutions
+#include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -98,8 +100,6 @@
       ENDIF
       !
-      REWIND( numnat_ref )              ! Namelist namtrc_dta in reference namelist : Passive tracer input data
       READ  ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_dta_ini in reference namelist' )
-      REWIND( numnat_cfg )              ! Namelist namtrc_dta in configuration namelist : Passive tracer input data
       READ  ( numnat_cfg, namtrc_dta, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_dta_ini in configuration namelist' )
@@ -154,5 +154,5 @@
 
 
-   SUBROUTINE trc_dta( kt, sf_trcdta, ptrcfac, ptrcdta)
+   SUBROUTINE trc_dta( kt, Kmm, sf_trcdta, ptrcfac, ptrcdta)
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE trc_dta  ***
@@ -167,4 +167,5 @@
       !!----------------------------------------------------------------------
       INTEGER                          , INTENT(in   )   ::   kt         ! ocean time-step
+      INTEGER                          , INTENT(in   )   ::   Kmm        ! time level index
       TYPE(FLD), DIMENSION(1)          , INTENT(inout)   ::   sf_trcdta  ! array of information on the field to read
       REAL(wp)                         , INTENT(in   )   ::   ptrcfac    ! multiplication factor
@@ -178,4 +179,10 @@
       !
       IF( ln_timing )   CALL timing_start('trc_dta')
+      !
+      IF( kt == nit000 .AND. lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_dta : passive tracers data for IC'
+         WRITE(numout,*) '~~~~~~~ '
+      ENDIF
       !
       IF( nb_trcdta > 0 ) THEN
@@ -191,27 +198,25 @@
                WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh'
             ENDIF
-            DO jj = 1, jpj                         ! vertical interpolation of T & S
-               DO ji = 1, jpi
-                  DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points
-                     zl = gdept_n(ji,jj,jk)
-                     IF(     zl < gdept_1d(1  ) ) THEN         ! above the first level of data
-                        ztp(jk) = ptrcdta(ji,jj,1)
-                     ELSEIF( zl > gdept_1d(jpk) ) THEN         ! below the last level of data
-                        ztp(jk) = ptrcdta(ji,jj,jpkm1)
-                     ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1
-                        DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1)
-                           IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN
-                              zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk))
-                              ztp(jk) = ptrcdta(ji,jj,jkk) + ( ptrcdta(ji,jj,jkk+1) - ptrcdta(ji,jj,jkk) ) * zi
-                           ENDIF
-                        END DO
-                     ENDIF
-                  END DO
-                  DO jk = 1, jpkm1
-                     ptrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord
-                  END DO
-                  ptrcdta(ji,jj,jpk) = 0._wp
-                END DO
-            END DO
+            DO_2D_11_11
+               DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points
+                  zl = gdept(ji,jj,jk,Kmm)
+                  IF(     zl < gdept_1d(1  ) ) THEN         ! above the first level of data
+                     ztp(jk) = ptrcdta(ji,jj,1)
+                  ELSEIF( zl > gdept_1d(jpk) ) THEN         ! below the last level of data
+                     ztp(jk) = ptrcdta(ji,jj,jpkm1)
+                  ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1
+                     DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1)
+                        IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN
+                           zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk))
+                           ztp(jk) = ptrcdta(ji,jj,jkk) + ( ptrcdta(ji,jj,jkk+1) - ptrcdta(ji,jj,jkk) ) * zi
+                        ENDIF
+                     END DO
+                  ENDIF
+               END DO
+               DO jk = 1, jpkm1
+                  ptrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord
+               END DO
+               ptrcdta(ji,jj,jpk) = 0._wp
+            END_2D
             ! 
          ELSE                                !==   z- or zps- coordinate   ==!
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcice.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcice.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcice.F90	(revision 12928)
@@ -85,8 +85,6 @@
       ENDIF
       !
-      REWIND( numnat_ref )              ! Namelist namtrc_ice in reference namelist : Passive tracer input data
       READ  ( numnat_ref, namtrc_ice, IOSTAT = ios, ERR = 901)
  901  IF( ios /= 0 )   CALL ctl_nam ( ios , ' namtrc_ice in reference namelist ' )
-      REWIND( numnat_cfg )              ! Namelist namtrc_ice in configuration namelist : Pisces external sources of nutrients
       READ  ( numnat_cfg, namtrc_ice, IOSTAT = ios, ERR = 902 )
  902  IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_ice in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcini.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcini.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcini.F90	(revision 12928)
@@ -21,9 +21,8 @@
    USE daymod          ! calendar manager
    USE prtctl_trc      ! Print control passive tracers (prt_ctl_trc_init routine)
-   USE trcsub          ! variables to substep passive tracers
    USE trcrst
    USE lib_mpp         ! distribued memory computing library
    USE trcice          ! tracers in sea ice
-   USE trcbc,   only : trc_bc_ini ! generalized Boundary Conditions
+   USE trcbc           ! generalized Boundary Conditions
  
    IMPLICIT NONE
@@ -39,5 +38,5 @@
 CONTAINS
    
-   SUBROUTINE trc_init
+   SUBROUTINE trc_init( Kbb, Kmm, Kaa )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE trc_init  ***
@@ -51,4 +50,5 @@
       !!                or read data or analytical formulation
       !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) :: Kbb, Kmm, Kaa   ! time level indices
       !
       IF( ln_timing )   CALL timing_start('trc_init')
@@ -58,7 +58,7 @@
       IF(lwp) WRITE(numout,*) '~~~~~~~~'
       !
-      CALL trc_ini_ctl   ! control 
       CALL trc_nam       ! read passive tracers namelists
       CALL top_alloc()   ! allocate TOP arrays
+
       !
       IF(.NOT.ln_trcdta )   ln_trc_ini(:) = .FALSE.
@@ -68,7 +68,7 @@
       IF(lwp) WRITE(numout,*)
       !
-      CALL trc_ini_sms   ! SMS
-      CALL trc_ini_trp   ! passive tracers transport
-      CALL trc_ice_ini   ! Tracers in sea ice
+      CALL trc_ini_sms( Kmm )   ! SMS
+      CALL trc_ini_trp          ! passive tracers transport
+      CALL trc_ice_ini          ! Tracers in sea ice
       !
       IF( lwm .AND. sn_cfctl%l_trcstat ) THEN
@@ -76,9 +76,7 @@
       ENDIF
       !
-      CALL trc_ini_state  !  passive tracers initialisation : from a restart or from clim
-      IF( nn_dttrc /= 1 ) &
-      CALL trc_sub_ini    ! Initialize variables for substepping passive tracers
-      !
-      CALL trc_ini_inv   ! Inventories
+      CALL trc_ini_state( Kbb, Kmm, Kaa )  !  passive tracers initialisation : from a restart or from clim
+      !
+      CALL trc_ini_inv( Kmm )              ! Inventories
       !
       IF( ln_timing )   CALL timing_stop('trc_init')
@@ -87,26 +85,11 @@
 
 
-   SUBROUTINE trc_ini_ctl
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE trc_ini_ctl  ***
-      !! ** Purpose :        Control  + ocean volume
-      !!----------------------------------------------------------------------
-      INTEGER ::   jk    ! dummy loop indices
-      !
-      ! Define logical parameter ton control dirunal cycle in TOP
-      l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 )
-      l_trcdm2dc = l_trcdm2dc  .AND. .NOT. l_offline
-      IF( l_trcdm2dc .AND. lwp )   CALL ctl_warn( 'Coupling with passive tracers and used of diurnal cycle.',   &
-         &                           'Computation of a daily mean shortwave for some biogeochemical models ' )
-      !
-   END SUBROUTINE trc_ini_ctl
-
-
-   SUBROUTINE trc_ini_inv
+   SUBROUTINE trc_ini_inv( Kmm )
       !!----------------------------------------------------------------------
       !!                     ***  ROUTINE trc_ini_stat  ***
       !! ** Purpose :      passive tracers inventories at initialsation phase
       !!----------------------------------------------------------------------
-      INTEGER ::  jk, jn    ! dummy loop indices
+      INTEGER, INTENT(in) ::   Kmm    ! time level index
+      INTEGER             ::  jk, jn  ! dummy loop indices
       CHARACTER (len=25) :: charout
       !!----------------------------------------------------------------------
@@ -118,5 +101,5 @@
       !                          ! masked grid volume
       DO jk = 1, jpk
-         cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk)
+         cvol(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk)
       END DO
       !                          ! total volume of the ocean 
@@ -125,5 +108,5 @@
       trai(:) = 0._wp            ! initial content of all tracers
       DO jn = 1, jptra
-         trai(jn) = trai(jn) + glob_sum( 'trcini', trn(:,:,:,jn) * cvol(:,:,:)   )
+         trai(jn) = trai(jn) + glob_sum( 'trcini', tr(:,:,:,jn,Kmm) * cvol(:,:,:)   )
       END DO
 
@@ -140,9 +123,9 @@
       ENDIF
       IF(lwp) WRITE(numout,*)
-      IF(ln_ctl) THEN            ! print mean trends (used for debugging)
+      IF(sn_cfctl%l_prttrc) THEN            ! print mean trends (used for debugging)
          CALL prt_ctl_trc_init
          WRITE(charout, FMT="('ini ')")
          CALL prt_ctl_trc_info( charout )
-         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )
+         CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm )
       ENDIF
 9000  FORMAT('      tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10)
@@ -151,5 +134,5 @@
 
 
-   SUBROUTINE trc_ini_sms
+   SUBROUTINE trc_ini_sms( Kmm )
       !!----------------------------------------------------------------------
       !!                     ***  ROUTINE trc_ini_sms  ***
@@ -162,4 +145,5 @@
       USE trcini_my_trc  ! MY_TRC   initialisation
       !
+      INTEGER, INTENT(in) ::   Kmm ! time level indices
       INTEGER :: jn
       !!----------------------------------------------------------------------
@@ -175,10 +159,20 @@
          ln_trc_obc(jn) =       sn_tracer(jn)%llobc
       END DO
+      !
+      IF( .NOT.ln_trcbc ) THEN
+         DO jn = 1, jp_bgc
+            ln_trc_sbc(jn) = .FALSE.
+            ln_trc_cbc(jn) = .FALSE.
+            ln_trc_obc(jn) = .FALSE.
+         END DO
+      ENDIF
+     
+      lltrcbc = ( COUNT(ln_trc_sbc) + COUNT(ln_trc_obc) + COUNT(ln_trc_cbc) ) > 0 
       !    
-      IF( ln_pisces      )   CALL trc_ini_pisces     !  PISCES model
-      IF( ln_my_trc      )   CALL trc_ini_my_trc     !  MY_TRC model
-      IF( ll_cfc         )   CALL trc_ini_cfc        !  CFC's
-      IF( ln_c14         )   CALL trc_ini_c14        !  C14 model
-      IF( ln_age         )   CALL trc_ini_age        !  AGE
+      IF( ln_pisces      )   CALL trc_ini_pisces( Kmm )     !  PISCES model
+      IF( ln_my_trc      )   CALL trc_ini_my_trc( Kmm )     !  MY_TRC model
+      IF( ll_cfc         )   CALL trc_ini_cfc   ( Kmm )     !  CFC's
+      IF( ln_c14         )   CALL trc_ini_c14   ( Kmm )     !  C14 model
+      IF( ln_age         )   CALL trc_ini_age   ( Kmm )     !  AGE
       !
       IF(lwp) THEN                   ! control print
@@ -191,4 +185,9 @@
          END DO
       ENDIF
+      IF( lwp .AND. ln_trcbc .AND. lltrcbc ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' Applying tracer boundary conditions '
+      ENDIF
+     
 9001  FORMAT(3x,i3,1x,a10,3x,l2,3x,l2,3x,l2,3x,l2)
       !
@@ -221,5 +220,5 @@
 
 
-   SUBROUTINE trc_ini_state
+   SUBROUTINE trc_ini_state( Kbb, Kmm, Kaa )
       !!----------------------------------------------------------------------
       !!                     ***  ROUTINE trc_ini_state ***
@@ -230,15 +229,19 @@
       USE trcdta          ! initialisation from files
       !
-      INTEGER :: jn, jl   ! dummy loop indices
-      !!----------------------------------------------------------------------
-      !
-      IF( ln_trcdta )   CALL trc_dta_ini( jptra )      ! set initial tracers values
-      !
-      IF( ln_my_trc )   CALL trc_bc_ini ( jptra )      ! set tracers Boundary Conditions
+      INTEGER, INTENT(in) :: Kbb, Kmm, Kaa   ! time level index
+      INTEGER             :: jn, jl          ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      IF( ln_trcdta )   CALL trc_dta_ini( jptra )           ! set initial tracers values
+      !
+      IF( ln_trcbc .AND. lltrcbc )  THEN 
+        CALL trc_bc_ini ( jptra, Kmm  )            ! set tracers Boundary Conditions
+        CALL trc_bc     ( nit000, Kmm, tr, Kaa )   ! tracers: surface and lateral Boundary Conditions
+      ENDIF
       !
       !
       IF( ln_rsttr ) THEN              ! restart from a file
         !
-        CALL trc_rst_read
+        CALL trc_rst_read( Kbb, Kmm )
         !
       ELSE                             ! Initialisation of tracer from a file that may also be used for damping
@@ -249,5 +252,5 @@
                IF( ln_trc_ini(jn) ) THEN
                   jl = n_trc_index(jn) 
-                  CALL trc_dta( nit000, sf_trcdta(jl), rf_trfac(jl), trn(:,:,:,jn) )
+                  CALL trc_dta( nit000, Kmm, sf_trcdta(jl), rf_trfac(jl), tr(:,:,:,jn,Kmm) )
                   !
                   ! deallocate data structure if data are not used for damping
@@ -263,10 +266,10 @@
         ENDIF
         !
-        trb(:,:,:,:) = trn(:,:,:,:)
+        tr(:,:,:,:,Kbb) = tr(:,:,:,:,Kmm)
         ! 
       ENDIF
       !
-      tra(:,:,:,:) = 0._wp
-      !                                                         ! Partial top/bottom cell: GRADh(trn)
+      tr(:,:,:,:,Kaa) = 0._wp
+      !                                                         ! Partial top/bottom cell: GRADh(tr(Kmm))
    END SUBROUTINE trc_ini_state
 
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcnam.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcnam.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcnam.F90	(revision 12928)
@@ -23,7 +23,4 @@
    USE trdtrc_oce  !
    USE iom         ! I/O manager
-#if defined key_mpp_mpi
-   USE lib_mpp, ONLY: ncom_dttrc
-#endif
 
    IMPLICIT NONE
@@ -79,9 +76,7 @@
       ENDIF
       !
-      rdttrc = rdt * FLOAT( nn_dttrc )          ! passive tracer time-step      
-      ! 
       IF(lwp) THEN                              ! control print
         WRITE(numout,*) 
-        WRITE(numout,*) '   ==>>>   Passive Tracer  time step    rdttrc = nn_dttrc*rdt = ', rdttrc
+        WRITE(numout,*) '   ==>>>   Passive Tracer time step = rn_Dt = ', rn_Dt
       ENDIF
       !
@@ -100,5 +95,5 @@
       INTEGER  ::   ios   ! Local integer
       !!
-      NAMELIST/namtrc_run/ nn_dttrc, ln_rsttr, nn_rsttr, ln_top_euler, &
+      NAMELIST/namtrc_run/ ln_rsttr, nn_rsttr, ln_top_euler, &
         &                  cn_trcrst_indir, cn_trcrst_outdir, cn_trcrst_in, cn_trcrst_out
       !!---------------------------------------------------------------------
@@ -108,21 +103,18 @@
       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
       !
-      CALL ctl_opn( numnat_ref, 'namelist_top_ref'   , 'OLD'    , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
-      CALL ctl_opn( numnat_cfg, 'namelist_top_cfg'   , 'OLD'    , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+      CALL load_nml( numnat_ref, 'namelist_top_ref' , numout, lwm )
+      CALL load_nml( numnat_cfg, 'namelist_top_cfg' , numout, lwm )
       IF(lwm) CALL ctl_opn( numont, 'output.namelist.top', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., 1 )
       !
-      REWIND( numnat_ref )              ! Namelist namtrc in reference namelist : Passive tracer variables
       READ  ( numnat_ref, namtrc_run, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc in reference namelist' )
-      REWIND( numnat_cfg )              ! Namelist namtrc in configuration namelist : Passive tracer variables
       READ  ( numnat_cfg, namtrc_run, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc in configuration namelist' )
       IF(lwm) WRITE( numont, namtrc_run )
 
-      nittrc000 = nit000 + nn_dttrc - 1      ! first time step of tracer model
+      nittrc000 = nit000             ! first time step of tracer model
 
       IF(lwp) THEN                   ! control print
          WRITE(numout,*) '   Namelist : namtrc_run'
-         WRITE(numout,*) '      time step freq. for passive tracer           nn_dttrc      = ', nn_dttrc
          WRITE(numout,*) '      restart  for passive tracer                  ln_rsttr      = ', ln_rsttr
          WRITE(numout,*) '      control of time step for passive tracer      nn_rsttr      = ', nn_rsttr
@@ -131,8 +123,4 @@
       ENDIF
       !
-#if defined key_mpp_mpi
-      ncom_dttrc = nn_dttrc    ! make nn_fsbc available for lib_mpp
-#endif
-      !
    END SUBROUTINE trc_nam_run
 
@@ -148,5 +136,5 @@
       !!
       NAMELIST/namtrc/jp_bgc, ln_pisces, ln_my_trc, ln_age, ln_cfc11, ln_cfc12, ln_sf6, ln_c14, &
-         &            sn_tracer, ln_trcdta, ln_trcdmp, ln_trcdmp_clo, jp_dia3d, jp_dia2d
+         &            sn_tracer, ln_trcdta, ln_trcbc, ln_trcdmp, ln_trcdmp_clo, jp_dia3d, jp_dia2d
       !!---------------------------------------------------------------------
       ! Dummy settings to fill tracers data structure
@@ -158,8 +146,6 @@
       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
 
-      REWIND( numnat_ref )              ! Namelist namtrc in reference namelist : Passive tracer variables
       READ  ( numnat_ref, namtrc, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc in reference namelist' )
-      REWIND( numnat_cfg )              ! Namelist namtrc in configuration namelist : Passive tracer variables
       READ  ( numnat_cfg, namtrc, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc in configuration namelist' )
@@ -222,4 +208,5 @@
          WRITE(numout,*) '      Simulating C14   passive tracer              ln_c14        = ', ln_c14
          WRITE(numout,*) '      Read inputs data from file (y/n)             ln_trcdta     = ', ln_trcdta
+         WRITE(numout,*) '      Enable surface, lateral or open boundaries conditions (y/n)  ln_trcbc  = ', ln_trcbc
          WRITE(numout,*) '      Damping of passive tracer (y/n)              ln_trcdmp     = ', ln_trcdmp
          WRITE(numout,*) '      Restoring of tracer on closed seas           ln_trcdmp_clo = ', ln_trcdmp_clo
@@ -228,6 +215,6 @@
       IF( ll_cfc .OR. ln_c14 ) THEN
         !                             ! Open namelist files
-        CALL ctl_opn( numtrc_ref, 'namelist_trc_ref'   ,     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
-        CALL ctl_opn( numtrc_cfg, 'namelist_trc_cfg'   ,     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+        CALL load_nml( numtrc_ref, 'namelist_trc_ref' , numout, lwm )
+        CALL load_nml( numtrc_cfg, 'namelist_trc_cfg' , numout, lwm )
         IF(lwm) CALL ctl_opn( numonr, 'output.namelist.trc', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
         !
@@ -261,8 +248,6 @@
       ALLOCATE( ln_trdtrc(jptra) ) 
       !
-      REWIND( numnat_ref )              ! Namelist namtrc_trd in reference namelist : Passive tracer trends
       READ  ( numnat_ref, namtrc_trd, IOSTAT = ios, ERR = 905)
 905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_trd in reference namelist' )
-      REWIND( numnat_cfg )              ! Namelist namtrc_trd in configuration namelist : Passive tracer trends
       READ  ( numnat_cfg, namtrc_trd, IOSTAT = ios, ERR = 906 )
 906   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_trd in configuration namelist' )
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcrst.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcrst.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcrst.F90	(revision 12928)
@@ -76,7 +76,7 @@
 
       ! to get better performances with NetCDF format:
-      ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*nn_dttrc + 1)
-      ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 2*nn_dttrc + 1
-      IF( kt == nitrst - 2*nn_dttrc .OR. nn_stock == nn_dttrc .OR. ( kt == nitend - nn_dttrc .AND. .NOT. lrst_trc ) ) THEN
+      ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 1)
+      ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 1
+      IF( kt == nitrst - 1 .OR. nn_stock == 1 .OR. ( kt == nitend - 1 .AND. .NOT. lrst_trc ) ) THEN
          ! beware of the format used to write kt (default is i8.8, that should be large enough)
          IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst
@@ -96,5 +96,5 @@
    END SUBROUTINE trc_rst_opn
 
-   SUBROUTINE trc_rst_read
+   SUBROUTINE trc_rst_read( Kbb, Kmm )
       !!----------------------------------------------------------------------
       !!                    ***  trc_rst_opn  ***
@@ -102,4 +102,5 @@
       !! ** purpose  :   read passive tracer fields in restart files
       !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   Kbb, Kmm  ! time level indices
       INTEGER  ::  jn     
 
@@ -112,9 +113,9 @@
       ! READ prognostic variables and computes diagnostic variable
       DO jn = 1, jptra
-         CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )
-      END DO
-
-      DO jn = 1, jptra
-         CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
+         CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), tr(:,:,:,jn,Kmm) )
+      END DO
+
+      DO jn = 1, jptra
+         CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), tr(:,:,:,jn,Kbb) )
       END DO
       !
@@ -123,5 +124,5 @@
    END SUBROUTINE trc_rst_read
 
-   SUBROUTINE trc_rst_wri( kt )
+   SUBROUTINE trc_rst_wri( kt, Kbb, Kmm, Krhs )
       !!----------------------------------------------------------------------
       !!                    ***  trc_rst_wri  ***
@@ -129,18 +130,19 @@
       !! ** purpose  :   write passive tracer fields in restart files
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt    ! ocean time-step index
+      INTEGER, INTENT( in ) ::   kt              ! ocean time-step index
+      INTEGER, INTENT( in ) ::   Kbb, Kmm, Krhs  ! time level indices
       !!
       INTEGER  :: jn
       !!----------------------------------------------------------------------
       !
-      CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rdttrc )   ! passive tracer time step
+      CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rn_Dt )   ! passive tracer time step (= ocean time step)
       ! prognostic variables 
       ! -------------------- 
       DO jn = 1, jptra
-         CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )
-      END DO
-
-      DO jn = 1, jptra
-         CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
+         CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), tr(:,:,:,jn,Kmm) )
+      END DO
+
+      DO jn = 1, jptra
+         CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), tr(:,:,:,jn,Kbb) )
       END DO
       !
@@ -148,5 +150,5 @@
     
       IF( kt == nitrst ) THEN
-          CALL trc_rst_stat            ! statistics
+          CALL trc_rst_stat( Kmm, Krhs )             ! statistics
           CALL iom_close( numrtw )     ! close the restart file (only at last time step)
 #if ! defined key_trdmxl_trc
@@ -181,5 +183,5 @@
       !!       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 (nittrc000-1)*rdt.
+      !!       is not stored in the restart and is assumed to be (nittrc000-1)*rn_Dt.
       !!       This is valid is the time step has remained constant.
       !!
@@ -219,5 +221,5 @@
             ENDIF
             ! Control of date 
-            IF( nittrc000  - NINT( zkt ) /= nn_dttrc .AND.  nn_rsttr /= 0 )                                  &
+            IF( nittrc000  - NINT( zkt ) /= 1 .AND.  nn_rsttr /= 0 )                                  &
                &   CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart',                 &
                &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' )
@@ -261,5 +263,5 @@
                nminute = ( nn_time0 - nhour * 100 )
                IF( nhour*3600+nminute*60-ndt05 .lt. 0 )  ndastp=ndastp-1      ! Start hour is specified in the namelist (default 0)
-               adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday
+               adatrj = ( REAL( nit000-1, wp ) * rn_Dt ) / rday
                ! note this is wrong if time step has changed during run
             ENDIF
@@ -274,6 +276,6 @@
             ENDIF
             !
-            IF( ln_rsttr )  THEN   ;    neuler = 1
-            ELSE                   ;    neuler = 0
+            IF( ln_rsttr )  THEN   ;    l_1st_euler = .false.
+            ELSE                   ;    l_1st_euler = .true.
             ENDIF
             !
@@ -299,5 +301,5 @@
 
 
-   SUBROUTINE trc_rst_stat
+   SUBROUTINE trc_rst_stat( Kmm, Krhs )
       !!----------------------------------------------------------------------
       !!                    ***  trc_rst_stat  ***
@@ -305,4 +307,5 @@
       !! ** purpose  :   Compute tracers statistics
       !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   Kmm, Krhs  ! time level indices
       INTEGER  :: jk, jn
       REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift
@@ -317,11 +320,11 @@
       !
       DO jk = 1, jpk
-         zvol(:,:,jk) = e1e2t(:,:) * e3t_a(:,:,jk) * tmask(:,:,jk)
-      END DO
-      !
-      DO jn = 1, jptra
-         ztraf = glob_sum( 'trcrst', trn(:,:,:,jn) * zvol(:,:,:) )
-         zmin  = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
-         zmax  = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
+         zvol(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Krhs) * tmask(:,:,jk)
+      END DO
+      !
+      DO jn = 1, jptra
+         ztraf = glob_sum( 'trcrst', tr(:,:,:,jn,Kmm) * zvol(:,:,:) )
+         zmin  = MINVAL( tr(:,:,:,jn,Kmm), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
+         zmax  = MAXVAL( tr(:,:,:,jn,Kmm), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
          IF( lk_mpp ) THEN
             CALL mpp_min( 'trcrst', zmin )      ! min over the global domain
@@ -343,8 +346,10 @@
    !!----------------------------------------------------------------------
 CONTAINS
-   SUBROUTINE trc_rst_read                      ! Empty routines
+   SUBROUTINE trc_rst_read( Kbb, Kmm)                      ! Empty routines
+      INTEGER, INTENT( in ) :: Kbb, Kmm  ! time level indices
    END SUBROUTINE trc_rst_read
-   SUBROUTINE trc_rst_wri( kt )
-      INTEGER, INTENT ( in ) :: kt
+   SUBROUTINE trc_rst_wri( kt, Kbb, Kmm, Krhs )
+      INTEGER, INTENT( in ) :: kt
+      INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs  ! time level indices
       WRITE(*,*) 'trc_rst_wri: You should not have seen this print! error?', kt
    END SUBROUTINE trc_rst_wri   
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcsms.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcsms.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcsms.F90	(revision 12928)
@@ -34,5 +34,5 @@
 CONTAINS
 
-   SUBROUTINE trc_sms( kt )
+   SUBROUTINE trc_sms( kt, Kbb, Kmm , Krhs )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE trc_sms  ***
@@ -42,5 +42,6 @@
       !! ** Method  : -  call the main routine of of each defined tracer model
       !! -------------------------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
+      INTEGER, INTENT( in ) ::   kt        ! ocean time-step index      
+      INTEGER, INTENT( in ) ::   Kbb, Kmm, Krhs ! time level indices
       !!
       CHARACTER (len=25) :: charout
@@ -49,14 +50,14 @@
       IF( ln_timing )   CALL timing_start('trc_sms')
       !
-      IF( ln_pisces  )   CALL trc_sms_pisces ( kt )    ! main program of PISCES 
-      IF( ll_cfc     )   CALL trc_sms_cfc    ( kt )    ! surface fluxes of CFC
-      IF( ln_c14     )   CALL trc_sms_c14    ( kt )    ! surface fluxes of C14
-      IF( ln_age     )   CALL trc_sms_age    ( kt )    ! Age tracer
-      IF( ln_my_trc  )   CALL trc_sms_my_trc ( kt )    ! MY_TRC  tracers
+      IF( ln_pisces  )   CALL trc_sms_pisces ( kt, Kbb, Kmm, Krhs )    ! main program of PISCES 
+      IF( ll_cfc     )   CALL trc_sms_cfc    ( kt, Kbb, Kmm, Krhs )    ! surface fluxes of CFC
+      IF( ln_c14     )   CALL trc_sms_c14    ( kt, Kbb, Kmm, Krhs )    ! surface fluxes of C14
+      IF( ln_age     )   CALL trc_sms_age    ( kt, Kbb, Kmm, Krhs )    ! Age tracer
+      IF( ln_my_trc  )   CALL trc_sms_my_trc ( kt, Kbb, Kmm, Krhs )    ! MY_TRC  tracers
 
-      IF(ln_ctl) THEN      ! print mean trends (used for debugging)
+      IF(sn_cfctl%l_prttrc) THEN                       ! print mean trends (used for debugging)
          WRITE(charout, FMT="('sms ')")
          CALL prt_ctl_trc_info( charout )
-         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )
+         CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm )
       ENDIF
       !
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcstp.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcstp.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcstp.F90	(revision 12928)
@@ -5,4 +5,5 @@
    !!======================================================================
    !! History :  1.0  !  2004-03  (C. Ethe)  Original
+   !!            4.1  !  2019-08  (A. Coward, D. Storkey) rewrite in preparation for new timestepping scheme
    !!----------------------------------------------------------------------
 #if defined key_top
@@ -17,5 +18,4 @@
    USE trcwri
    USE trcrst
-   USE trcsub         !
    USE trdtrc_oce
    USE trdmxl_trc
@@ -44,5 +44,5 @@
 CONTAINS
 
-   SUBROUTINE trc_stp( kt )
+   SUBROUTINE trc_stp( kt, Kbb, Kmm, Krhs, Kaa )
       !!-------------------------------------------------------------------
       !!                     ***  ROUTINE trc_stp  ***
@@ -53,5 +53,6 @@
       !!                Update the passive tracers
       !!-------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      INTEGER, INTENT( in ) :: kt                  ! ocean time-step index
+      INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs, Kaa ! time level indices
       !
       INTEGER ::   jk, jn   ! dummy loop indices
@@ -63,19 +64,21 @@
       IF( ln_timing )   CALL timing_start('trc_stp')
       !
-      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN     ! at nittrc000
-         r2dttrc =  rdttrc           ! = rdttrc (use or restarting with Euler time stepping)
-      ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1
-         r2dttrc = 2. * rdttrc       ! = 2 rdttrc (leapfrog)
-      ENDIF
-      !
-      ll_trcstat  = ( ln_ctl .OR. sn_cfctl%l_trcstat ) .AND. &
+      IF( l_1st_euler .OR. ln_top_euler ) THEN     ! at nittrc000
+         rDt_trc =  rn_Dt           ! = rn_Dt (use or restarting with Euler time stepping)
+      ELSEIF( kt <= nittrc000 + 1 ) THEN                                     ! at nittrc000 or nittrc000+1 
+         rDt_trc = 2. * rn_Dt       ! = 2 rn_Dt (leapfrog) 
+      ENDIF
+      !
+      ll_trcstat  = ( sn_cfctl%l_trcstat ) .AND. &
      &              ( ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) )
+
+      IF( kt == nittrc000 )                      CALL trc_stp_ctl   ! control 
       IF( kt == nittrc000 .AND. lk_trdmxl_trc )  CALL trd_mxl_trc_init    ! trends: Mixed-layer
       !
       IF( .NOT.ln_linssh ) THEN                                           ! update ocean volume due to ssh temporal evolution
          DO jk = 1, jpk
-            cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk)
+            cvol(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk)
          END DO
-         IF ( ln_ctl .OR. kt == nitrst .OR. ( ln_check_mass .AND. kt == nitend )              &
+         IF ( ll_trcstat .OR. kt == nitrst .OR. ( ln_check_mass .AND. kt == nitend )   &
             & .OR. iom_use( "pno3tot" ) .OR. iom_use( "ppo4tot" ) .OR. iom_use( "psiltot" )   &
             & .OR. iom_use( "palktot" ) .OR. iom_use( "pfertot" ) )                           &
@@ -85,29 +88,35 @@
       IF( l_trcdm2dc )   CALL trc_mean_qsr( kt )
       !    
-      IF( nn_dttrc /= 1 )   CALL trc_sub_stp( kt )  ! averaging physical variables for sub-stepping
-      !    
-      IF( MOD( kt , nn_dttrc ) == 0 ) THEN      ! only every nn_dttrc time step
-         !
-         IF(ln_ctl) THEN
-            WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear
-            CALL prt_ctl_trc_info(charout)
-         ENDIF
-         !
-         tra(:,:,:,:) = 0.e0
-         !
-                                   CALL trc_rst_opn  ( kt )       ! Open tracer restart file 
-         IF( lrst_trc )            CALL trc_rst_cal  ( kt, 'WRITE' )   ! calendar
-                                   CALL trc_wri      ( kt )       ! output of passive tracers with iom I/O manager
-                                   CALL trc_sms      ( kt )       ! tracers: sinks and sources
-                                   CALL trc_trp      ( kt )       ! transport of passive tracers
-         IF( kt == nittrc000 ) THEN
-            CALL iom_close( numrtr )       ! close input tracer restart file
-            IF(lwm) CALL FLUSH( numont )   ! flush namelist output
-         ENDIF
-         IF( lrst_trc )            CALL trc_rst_wri  ( kt )       ! write tracer restart file
-         IF( lk_trdmxl_trc  )      CALL trd_mxl_trc  ( kt )       ! trends: Mixed-layer
-         !
-         IF( nn_dttrc /= 1   )     CALL trc_sub_reset( kt )       ! resetting physical variables when sub-stepping
-         !
+      !
+      IF(sn_cfctl%l_prttrc) THEN
+         WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear
+         CALL prt_ctl_trc_info(charout)
+      ENDIF
+      !
+      tr(:,:,:,:,Krhs) = 0._wp
+      !
+      CALL trc_rst_opn  ( kt )                            ! Open tracer restart file 
+      IF( lrst_trc )  CALL trc_rst_cal  ( kt, 'WRITE' )   ! calendar
+      CALL trc_wri      ( kt,      Kmm            )       ! output of passive tracers with iom I/O manager
+      CALL trc_sms      ( kt, Kbb, Kmm, Krhs      )       ! tracers: sinks and sources
+      CALL trc_trp      ( kt, Kbb, Kmm, Krhs, Kaa )       ! transport of passive tracers
+           !
+           ! Note passive tracers have been time-filtered in trc_trp but the time level
+           ! indices will not be swapped until after tra_atf/dyn_atf/ssh_atf in stp. Subsequent calls here
+           ! anticipate this update which will be: Nrhs= Nbb ; Nbb = Nnn ; Nnn = Naa ; Naa = Nrhs
+           ! and use the filtered levels explicitly.
+           !
+      IF( kt == nittrc000 ) THEN
+         CALL iom_close( numrtr )                         ! close input tracer restart file
+         IF(lwm) CALL FLUSH( numont )                     ! flush namelist output
+      ENDIF
+      IF( lrst_trc )            CALL trc_rst_wri  ( kt, Kmm, Kaa, Kbb  )       ! write tracer restart file
+      IF( lk_trdmxl_trc  )      CALL trd_mxl_trc  ( kt,      Kaa       )       ! trends: Mixed-layer
+      !
+      IF( ln_top_euler ) THEN 
+         ! For Euler timestepping for TOP we need to copy the "after" to the "now" fields 
+         ! here then after the (leapfrog) swapping of the time-level indices in OCE/step.F90 we have 
+         ! "before" fields = "now" fields.
+         tr(:,:,:,:,Kmm) = tr(:,:,:,:,Kaa)
       ENDIF
       !
@@ -115,5 +124,5 @@
          ztrai = 0._wp                                                   !  content of all tracers
          DO jn = 1, jptra
-            ztrai = ztrai + glob_sum( 'trcstp', trn(:,:,:,jn) * cvol(:,:,:)   )
+            ztrai = ztrai + glob_sum( 'trcstp', tr(:,:,:,jn,Kaa) * cvol(:,:,:)   )
          END DO
          IF( lwm ) WRITE(numstr,9300) kt,  ztrai / areatot
@@ -124,4 +133,20 @@
       !
    END SUBROUTINE trc_stp
+
+
+   SUBROUTINE trc_stp_ctl
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_stp_ctl  ***
+      !! ** Purpose :        Control  + ocean volume
+      !!----------------------------------------------------------------------
+      !
+      ! Define logical parameter ton control dirunal cycle in TOP
+      l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 .AND. ncpl_qsr_freq /= 0 )
+      l_trcdm2dc = l_trcdm2dc .AND. .NOT. l_offline
+      !
+      IF( l_trcdm2dc .AND. lwp )   CALL ctl_warn( 'Coupling with passive tracers and used of diurnal cycle.',   &
+         &                           'Computation of a daily mean shortwave for some biogeochemical models ' )
+      !
+   END SUBROUTINE trc_stp_ctl
 
 
@@ -153,5 +178,5 @@
             nb_rec_per_day = ncpl_qsr_freq
          ELSE  
-            rdt_sampl = MAX( 3600., rdttrc )
+            rdt_sampl = MAX( 3600., rn_Dt )
             nb_rec_per_day = INT( rday / rdt_sampl )
          ENDIF
@@ -172,5 +197,5 @@
 
             CALL iom_get( numrtr, 'ktdcy', zkt )  
-            rsecfst = INT( zkt ) * rdttrc
+            rsecfst = INT( zkt ) * rn_Dt
             IF(lwp) WRITE(numout,*) 'trc_qsr_mean:   qsr_mean read in the restart file at time-step rsecfst =', rsecfst, ' s '
             CALL iom_get( numrtr, jpdom_autoglo, 'qsr_mean', qsr_mean )   !  A mean of qsr
@@ -193,5 +218,5 @@
          ELSE                                         !* no restart: set from nit000 values
             IF(lwp) WRITE(numout,*) 'trc_qsr_mean:   qsr_mean set to nit000 values'
-            rsecfst  = kt * rdttrc
+            rsecfst  = kt * rn_Dt
             !
             qsr_mean(:,:) = qsr(:,:)
@@ -203,5 +228,5 @@
       ENDIF
       !
-      rseclast = kt * rdttrc
+      rseclast = kt * rn_Dt
       !
       llnew   = ( rseclast - rsecfst ) .ge.  rdt_sampl    !   new shortwave to store
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcsub.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcsub.F90	(revision 12384)
+++ 	(revision )
@@ -1,597 +1,0 @@
-MODULE trcsub
-   !!======================================================================
-   !!                       ***  MODULE trcsubstp  ***
-   !!   TOP :   Averages physics variables for TOP substepping. 
-   !!======================================================================
-   !! History :  1.0  !  2011-10  (K. Edwards)  Original
-   !!----------------------------------------------------------------------
-#if defined key_top
-   !!----------------------------------------------------------------------
-   !!   trc_sub       : passive tracer system sub-stepping 
-   !!----------------------------------------------------------------------
-   USE oce_trc        ! ocean dynamics and active tracers variables
-   USE trc
-   USE trabbl         ! bottom boundary layer
-   USE zdf_oce
-   USE domvvl
-   USE divhor         ! horizontal divergence
-   USE sbcrnf   , ONLY: h_rnf, nk_rnf    ! River runoff
-   USE bdy_oce  , ONLY: ln_bdy, bdytmask ! BDY
-   !
-   USE prtctl_trc     ! Print control for debbuging
-   USE in_out_manager ! 
-   USE iom
-   USE lbclnk
-#if defined key_agrif
-   USE agrif_oce_update
-   USE agrif_oce_interp
-#endif
-
-   IMPLICIT NONE
-
-   PUBLIC   trc_sub_stp     ! called by trc_stp
-   PUBLIC   trc_sub_ini     ! called by trc_ini to initialize substepping arrays.
-   PUBLIC   trc_sub_reset   ! called by trc_stp to reset physics variables
-   PUBLIC   trc_sub_ssh     ! called by trc_stp to reset physics variables
-
-   REAL(wp) :: r1_ndttrc     ! = 1 /  nn_dttrc 
-   REAL(wp) :: r1_ndttrcp1   ! = 1 / (nn_dttrc+1) 
-
-
-   !! averaged and temporary saved variables  (needed when a larger passive tracer time-step is used)
-   !! ----------------------------------------------------------------
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::    un_tm ,   un_temp   !: i-horizontal velocity average     [m/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::    vn_tm ,   vn_temp   !: j-horizontal velocity average     [m/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::              wn_temp   !: hold current values of avt, un, vn, wn
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tsn_tm ,  tsn_temp   !: t/s average     [m/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   avs_tm ,  avs_temp   !: vertical diffusivity coeff. at  w-point   [m2/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  rhop_tm , rhop_temp   !: 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshn_tm , sshn_temp   !: average ssh for the now step [m]
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::    rnf_tm ,    rnf_temp   !: river runoff
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  h_rnf_tm ,  h_rnf_temp   !: depth in metres to the bottom of the relevant grid box
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   hmld_tm ,   hmld_temp   !: mixed layer depth average [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   fr_i_tm ,   fr_i_temp   !: average ice fraction     [m/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::    emp_tm ,    emp_temp   !: freshwater budget: volume flux [Kg/m2/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     :: fmmflx_tm , fmmflx_temp   !: freshwater budget: freezing/melting [Kg/m2/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     :: emp_b_hold,  emp_b_temp   !: hold emp from the beginning of each sub-stepping[m]  
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::    qsr_tm ,    qsr_temp   !: solar radiation average [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   wndm_tm ,   wndm_temp   !: 10m wind average [m]
-   !
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshb_hold   !:hold sshb from the beginning of each sub-stepping[m]  
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   sshb_temp, ssha_temp
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  hdivn_temp, rotn_temp
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  hdivb_temp, rotb_temp
-   !
-   !                                                    !!- bottom boundary layer param (ln_trabbl=T)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahu_bbl_tm, ahu_bbl_temp  ! BBL diffusive i-coef.
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahv_bbl_tm, ahv_bbl_temp  ! BBL diffusive j-coef.
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  utr_bbl_tm, utr_bbl_temp  ! BBL u-advection
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  vtr_bbl_tm, vtr_bbl_temp  ! BBL v-advection
-
-   !                                                      !!- iso-neutral slopes (if l_ldfslp=T)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   uslp_temp, vslp_temp, wslpi_temp, wslpj_temp   !: hold current values 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   uslp_tm  , vslp_tm  , wslpi_tm  , wslpj_tm     !: time mean 
-
-
-   !!----------------------------------------------------------------------
-   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
-   !! $Id$ 
-   !! Software governed by the CeCILL license (see ./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE trc_sub_stp( kt )
-      !!-------------------------------------------------------------------
-      !!                     ***  ROUTINE trc_stp  ***
-      !!                      
-      !! ** Purpose : Average variables needed for sub-stepping passive tracers
-      !! 
-      !! ** Method  : Called every timestep to increment _tm (time mean) variables
-      !!              on TOP steps, calculate averages.
-      !!-------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
-      !
-      INTEGER ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp)::   z1_ne3t, z1_ne3u, z1_ne3v, z1_ne3w   ! local scalars
-      !!-------------------------------------------------------------------
-      !
-      IF( ln_timing )   CALL timing_start('trc_sub_stp')
-      !
-      IF( kt == nit000 ) THEN
-           IF(lwp) WRITE(numout,*)
-           IF(lwp) WRITE(numout,*) 'trc_sub_stp : substepping of the passive tracers'
-           IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-           !
-           sshb_hold  (:,:) = sshn  (:,:)
-           emp_b_hold (:,:) = emp_b (:,:)
-           !
-           r1_ndttrc        = 1._wp / REAL( nn_dttrc    , wp ) 
-           r1_ndttrcp1      = 1._wp / REAL( nn_dttrc + 1, wp )
-      ENDIF  
-
-      IF( MOD( kt , nn_dttrc ) /= 0 ) THEN
-         !
-         un_tm   (:,:,:)        = un_tm   (:,:,:)        + un   (:,:,:)        * e3u_n(:,:,:) 
-         vn_tm   (:,:,:)        = vn_tm   (:,:,:)        + vn   (:,:,:)        * e3v_n(:,:,:) 
-         tsn_tm  (:,:,:,jp_tem) = tsn_tm  (:,:,:,jp_tem) + tsn  (:,:,:,jp_tem) * e3t_n(:,:,:)  
-         tsn_tm  (:,:,:,jp_sal) = tsn_tm  (:,:,:,jp_sal) + tsn  (:,:,:,jp_sal) * e3t_n(:,:,:)  
-         rhop_tm (:,:,:)        = rhop_tm (:,:,:)        + rhop (:,:,:)        * e3t_n(:,:,:)  
-         avs_tm  (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * e3w_n(:,:,:)  
-         IF( l_ldfslp ) THEN
-            uslp_tm (:,:,:)      = uslp_tm (:,:,:)        + uslp (:,:,:)
-            vslp_tm (:,:,:)      = vslp_tm (:,:,:)        + vslp (:,:,:)
-            wslpi_tm(:,:,:)      = wslpi_tm(:,:,:)        + wslpi(:,:,:)
-            wslpj_tm(:,:,:)      = wslpj_tm(:,:,:)        + wslpj(:,:,:)
-         ENDIF
-         IF( ln_trabbl ) THEN
-            IF( nn_bbl_ldf == 1 ) THEN
-               ahu_bbl_tm(:,:)     = ahu_bbl_tm(:,:)        + ahu_bbl(:,:) 
-               ahv_bbl_tm(:,:)     = ahv_bbl_tm(:,:)        + ahv_bbl(:,:) 
-            ENDIF
-            IF( nn_bbl_adv == 1 ) THEN
-               utr_bbl_tm(:,:)     = utr_bbl_tm(:,:)        + utr_bbl(:,:) 
-               vtr_bbl_tm(:,:)     = vtr_bbl_tm(:,:)        + vtr_bbl(:,:) 
-            ENDIF
-         ENDIF 
-         !
-         sshn_tm  (:,:)         = sshn_tm  (:,:)         + sshn  (:,:) 
-         rnf_tm   (:,:)         = rnf_tm   (:,:)         + rnf   (:,:) 
-         h_rnf_tm (:,:)         = h_rnf_tm (:,:)         + h_rnf (:,:) 
-         hmld_tm  (:,:)         = hmld_tm  (:,:)         + hmld  (:,:)
-         fr_i_tm  (:,:)         = fr_i_tm  (:,:)         + fr_i  (:,:)
-         emp_tm   (:,:)         = emp_tm   (:,:)         + emp   (:,:) 
-         fmmflx_tm(:,:)         = fmmflx_tm(:,:)         + fmmflx(:,:)
-         qsr_tm   (:,:)         = qsr_tm   (:,:)         + qsr   (:,:)
-         wndm_tm  (:,:)         = wndm_tm  (:,:)         + wndm  (:,:)
-         !
-      ELSE                           !  It is time to substep 
-         !   1. set temporary arrays to hold physics/dynamical variables
-         un_temp    (:,:,:)      = un    (:,:,:)
-         vn_temp    (:,:,:)      = vn    (:,:,:)
-         wn_temp    (:,:,:)      = wn    (:,:,:)
-         tsn_temp   (:,:,:,:)    = tsn   (:,:,:,:)
-         rhop_temp  (:,:,:)      = rhop  (:,:,:)    
-         avs_temp   (:,:,:)      = avs   (:,:,:)
-         IF( l_ldfslp ) THEN
-            uslp_temp  (:,:,:)   = uslp  (:,:,:)   ;   wslpi_temp (:,:,:)   = wslpi (:,:,:)
-            vslp_temp  (:,:,:)   = vslp  (:,:,:)   ;   wslpj_temp (:,:,:)   = wslpj (:,:,:)
-         ENDIF
-         IF( ln_trabbl ) THEN
-            IF( nn_bbl_ldf == 1 ) THEN
-               ahu_bbl_temp(:,:)   = ahu_bbl(:,:)  
-               ahv_bbl_temp(:,:)   = ahv_bbl(:,:) 
-            ENDIF
-            IF( nn_bbl_adv == 1 ) THEN
-               utr_bbl_temp(:,:)   = utr_bbl(:,:) 
-               vtr_bbl_temp(:,:)   = vtr_bbl(:,:) 
-            ENDIF
-         ENDIF 
-         sshn_temp  (:,:)        = sshn  (:,:)
-         sshb_temp  (:,:)        = sshb  (:,:)
-         ssha_temp  (:,:)        = ssha  (:,:)
-         rnf_temp   (:,:)        = rnf   (:,:)
-         h_rnf_temp (:,:)        = h_rnf (:,:)
-         hmld_temp  (:,:)        = hmld  (:,:)
-         fr_i_temp  (:,:)        = fr_i  (:,:)
-         emp_temp   (:,:)        = emp   (:,:)
-         emp_b_temp (:,:)        = emp_b (:,:)
-         fmmflx_temp(:,:)        = fmmflx(:,:)
-         qsr_temp   (:,:)        = qsr   (:,:)
-         wndm_temp  (:,:)        = wndm  (:,:)
-         !                                    !  Variables reset in trc_sub_ssh
-         hdivn_temp (:,:,:)      = hdivn (:,:,:)
-         !
-         ! 2. Create averages and reassign variables
-         un_tm    (:,:,:)        = un_tm   (:,:,:)        + un   (:,:,:)        * e3u_n(:,:,:) 
-         vn_tm    (:,:,:)        = vn_tm   (:,:,:)        + vn   (:,:,:)        * e3v_n(:,:,:) 
-         tsn_tm   (:,:,:,jp_tem) = tsn_tm  (:,:,:,jp_tem) + tsn  (:,:,:,jp_tem) * e3t_n(:,:,:)  
-         tsn_tm   (:,:,:,jp_sal) = tsn_tm  (:,:,:,jp_sal) + tsn  (:,:,:,jp_sal) * e3t_n(:,:,:)  
-         rhop_tm (:,:,:)         = rhop_tm (:,:,:)        + rhop (:,:,:)        * e3t_n(:,:,:)  
-         avs_tm   (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * e3w_n(:,:,:)  
-         IF( l_ldfslp ) THEN
-            uslp_tm  (:,:,:)     = uslp_tm (:,:,:)        + uslp (:,:,:) 
-            vslp_tm  (:,:,:)     = vslp_tm (:,:,:)        + vslp (:,:,:)
-            wslpi_tm (:,:,:)     = wslpi_tm(:,:,:)        + wslpi(:,:,:) 
-            wslpj_tm (:,:,:)     = wslpj_tm(:,:,:)        + wslpj(:,:,:) 
-         ENDIF
-         IF( ln_trabbl ) THEN
-            IF( nn_bbl_ldf == 1 ) THEN
-               ahu_bbl_tm(:,:)     = ahu_bbl_tm(:,:)        + ahu_bbl(:,:) 
-               ahv_bbl_tm(:,:)     = ahv_bbl_tm(:,:)        + ahv_bbl(:,:) 
-            ENDIF
-            IF( nn_bbl_adv == 1 ) THEN
-               utr_bbl_tm(:,:)     = utr_bbl_tm(:,:)        + utr_bbl(:,:) 
-               vtr_bbl_tm(:,:)     = vtr_bbl_tm(:,:)        + vtr_bbl(:,:) 
-            ENDIF
-         ENDIF 
-         sshn_tm  (:,:)          = sshn_tm    (:,:)       + sshn  (:,:) 
-         rnf_tm   (:,:)          = rnf_tm     (:,:)       + rnf   (:,:) 
-         h_rnf_tm (:,:)          = h_rnf_tm   (:,:)       + h_rnf (:,:) 
-         hmld_tm  (:,:)          = hmld_tm    (:,:)       + hmld  (:,:)
-         fr_i_tm  (:,:)          = fr_i_tm    (:,:)       + fr_i  (:,:)
-         emp_tm   (:,:)          = emp_tm     (:,:)       + emp   (:,:) 
-         fmmflx_tm(:,:)          = fmmflx_tm  (:,:)       + fmmflx(:,:)
-         qsr_tm   (:,:)          = qsr_tm     (:,:)       + qsr   (:,:)
-         wndm_tm  (:,:)          = wndm_tm    (:,:)       + wndm  (:,:)
-         !
-         sshn     (:,:)          = sshn_tm    (:,:) * r1_ndttrcp1 
-         sshb     (:,:)          = sshb_hold  (:,:)
-         rnf      (:,:)          = rnf_tm     (:,:) * r1_ndttrcp1 
-         h_rnf    (:,:)          = h_rnf_tm   (:,:) * r1_ndttrcp1 
-         hmld     (:,:)          = hmld_tm    (:,:) * r1_ndttrcp1 
-         !  variables that are initialized after averages
-         emp_b    (:,:) = emp_b_hold (:,:)
-         IF( kt == nittrc000 ) THEN
-            wndm  (:,:)          = wndm_tm    (:,:) * r1_ndttrc 
-            qsr   (:,:)          = qsr_tm     (:,:) * r1_ndttrc 
-            emp   (:,:)          = emp_tm     (:,:) * r1_ndttrc 
-            fmmflx(:,:)          = fmmflx_tm  (:,:) * r1_ndttrc 
-            fr_i  (:,:)          = fr_i_tm    (:,:) * r1_ndttrc
-            IF( ln_trabbl ) THEN
-               IF( nn_bbl_ldf == 1 ) THEN
-                  ahu_bbl(:,:)      = ahu_bbl_tm (:,:) * r1_ndttrc  
-                  ahv_bbl(:,:)      = ahv_bbl_tm (:,:) * r1_ndttrc 
-               ENDIF
-               IF( nn_bbl_adv == 1 ) THEN
-                  utr_bbl(:,:)      = utr_bbl_tm (:,:) * r1_ndttrc  
-                  vtr_bbl(:,:)      = vtr_bbl_tm (:,:) * r1_ndttrc 
-               ENDIF
-            ENDIF
-         ELSE
-            wndm  (:,:)          = wndm_tm    (:,:) * r1_ndttrcp1 
-            qsr   (:,:)          = qsr_tm     (:,:) * r1_ndttrcp1 
-            emp   (:,:)          = emp_tm     (:,:) * r1_ndttrcp1 
-            fmmflx(:,:)          = fmmflx_tm  (:,:) * r1_ndttrcp1 
-            fr_i  (:,:)          = fr_i_tm    (:,:) * r1_ndttrcp1 
-            IF( ln_trabbl ) THEN
-               IF( nn_bbl_ldf == 1 ) THEN
-                  ahu_bbl(:,:)      = ahu_bbl_tm (:,:) * r1_ndttrcp1  
-                  ahv_bbl(:,:)      = ahv_bbl_tm (:,:) * r1_ndttrcp1 
-               ENDIF
-               IF( nn_bbl_adv == 1 ) THEN
-                  utr_bbl(:,:)      = utr_bbl_tm (:,:) * r1_ndttrcp1  
-                  vtr_bbl(:,:)      = vtr_bbl_tm (:,:) * r1_ndttrcp1 
-               ENDIF
-            ENDIF
-         ENDIF
-         !
-         DO jk = 1, jpk
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  z1_ne3t = r1_ndttrcp1  / e3t_n(ji,jj,jk)
-                  z1_ne3u = r1_ndttrcp1  / e3u_n(ji,jj,jk)
-                  z1_ne3v = r1_ndttrcp1  / e3v_n(ji,jj,jk)
-                  z1_ne3w = r1_ndttrcp1  / e3w_n(ji,jj,jk)
-                  !
-                  un   (ji,jj,jk)        = un_tm   (ji,jj,jk)        * z1_ne3u
-                  vn   (ji,jj,jk)        = vn_tm   (ji,jj,jk)        * z1_ne3v
-                  tsn  (ji,jj,jk,jp_tem) = tsn_tm  (ji,jj,jk,jp_tem) * z1_ne3t
-                  tsn  (ji,jj,jk,jp_sal) = tsn_tm  (ji,jj,jk,jp_sal) * z1_ne3t
-                  rhop (ji,jj,jk)        = rhop_tm (ji,jj,jk)        * z1_ne3t
-!!gm : BUG ==>> for avs I don't understand the division by e3w
-                  avs  (ji,jj,jk)        = avs_tm  (ji,jj,jk)        * z1_ne3w
-               END DO
-            END DO
-         END DO
-         IF( l_ldfslp ) THEN
-            wslpi(:,:,:)        = wslpi_tm(:,:,:) 
-            wslpj(:,:,:)        = wslpj_tm(:,:,:)
-            uslp (:,:,:)        = uslp_tm (:,:,:)
-            vslp (:,:,:)        = vslp_tm (:,:,:)
-         ENDIF
-         !
-         CALL trc_sub_ssh( kt )         ! after ssh & vertical velocity
-         !
-      ENDIF
-      !
-      IF( ln_timing )   CALL timing_stop('trc_sub_stp')
-      !
-   END SUBROUTINE trc_sub_stp
-
-
-   SUBROUTINE trc_sub_ini
-      !!-------------------------------------------------------------------
-      !!                     ***  ROUTINE trc_sub_ini  ***
-      !!                      
-      !! ** Purpose : Initialize variables needed for sub-stepping passive tracers
-      !! 
-      !! ** Method  : 
-      !!              Compute the averages for sub-stepping
-      !!-------------------------------------------------------------------
-      INTEGER ::   ierr
-      !!-------------------------------------------------------------------
-      !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'trc_sub_ini : initial set up of the passive tracers substepping'
-      IF(lwp) WRITE(numout,*) '~~~~~~~'
-
-      ierr =  trc_sub_alloc    ()
-      CALL mpp_sum( 'trcsub', ierr )
-      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'top_sub_alloc : unable to allocate standard ocean arrays' )
-
-      un_tm   (:,:,:)        = un   (:,:,:)        * e3u_n(:,:,:) 
-      vn_tm   (:,:,:)        = vn   (:,:,:)        * e3v_n(:,:,:) 
-      tsn_tm  (:,:,:,jp_tem) = tsn  (:,:,:,jp_tem) * e3t_n(:,:,:)  
-      tsn_tm  (:,:,:,jp_sal) = tsn  (:,:,:,jp_sal) * e3t_n(:,:,:)  
-      rhop_tm (:,:,:)        = rhop (:,:,:)        * e3t_n(:,:,:)  
-!!gm : BUG? ==>> for avt & avs I don't understand the division by e3w
-      avs_tm  (:,:,:)        = avs  (:,:,:)        * e3w_n(:,:,:)  
-      IF( l_ldfslp ) THEN
-         wslpi_tm(:,:,:)     = wslpi(:,:,:)
-         wslpj_tm(:,:,:)     = wslpj(:,:,:)
-         uslp_tm (:,:,:)     = uslp (:,:,:)
-         vslp_tm (:,:,:)     = vslp (:,:,:)
-      ENDIF
-      sshn_tm  (:,:) = sshn  (:,:) 
-      rnf_tm   (:,:) = rnf   (:,:) 
-      h_rnf_tm (:,:) = h_rnf (:,:) 
-      hmld_tm  (:,:) = hmld  (:,:)
-
-      ! Physics variables that are set after initialization:
-      fr_i_tm  (:,:) = 0._wp
-      emp_tm   (:,:) = 0._wp
-      fmmflx_tm(:,:)  = 0._wp
-      qsr_tm   (:,:) = 0._wp
-      wndm_tm  (:,:) = 0._wp
-      IF( ln_trabbl ) THEN
-         IF( nn_bbl_ldf == 1 ) THEN
-            ahu_bbl_tm(:,:) = 0._wp
-            ahv_bbl_tm(:,:) = 0._wp
-         ENDIF
-         IF( nn_bbl_adv == 1 ) THEN
-            utr_bbl_tm(:,:) = 0._wp
-            vtr_bbl_tm(:,:) = 0._wp
-         ENDIF
-      ENDIF
-      !
-   END SUBROUTINE trc_sub_ini
-
-
-   SUBROUTINE trc_sub_reset( kt )
-      !!-------------------------------------------------------------------
-      !!                     ***  ROUTINE trc_sub_reset  ***
-      !!                      
-      !! ** Purpose : Reset physics variables averaged for substepping
-      !! 
-      !! ** Method  : 
-      !!              Compute the averages for sub-stepping
-      !!-------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::  kt  ! ocean time-step index
-      INTEGER :: jk                 ! dummy loop indices
-      !!-------------------------------------------------------------------
-      !
-      IF( ln_timing )   CALL timing_start('trc_sub_reset')
-      !
-      !   restore physics variables
-      un    (:,:,:)   =  un_temp    (:,:,:)
-      vn    (:,:,:)   =  vn_temp    (:,:,:)
-      wn    (:,:,:)   =  wn_temp    (:,:,:)
-      tsn   (:,:,:,:) =  tsn_temp   (:,:,:,:)
-      rhop  (:,:,:)   =  rhop_temp  (:,:,:)
-      avs   (:,:,:)   =  avs_temp   (:,:,:)
-      IF( l_ldfslp ) THEN
-         wslpi (:,:,:)=  wslpi_temp (:,:,:)
-         wslpj (:,:,:)=  wslpj_temp (:,:,:)
-         uslp  (:,:,:)=  uslp_temp  (:,:,:)
-         vslp  (:,:,:)=  vslp_temp  (:,:,:)
-      ENDIF
-      sshn  (:,:)     =  sshn_temp  (:,:)
-      sshb  (:,:)     =  sshb_temp  (:,:)
-      ssha  (:,:)     =  ssha_temp  (:,:)
-      rnf   (:,:)     =  rnf_temp   (:,:)
-      h_rnf (:,:)     =  h_rnf_temp (:,:)
-      !
-      hmld  (:,:)     =  hmld_temp  (:,:)
-      fr_i  (:,:)     =  fr_i_temp  (:,:)
-      emp   (:,:)     =  emp_temp   (:,:)
-      fmmflx(:,:)     =  fmmflx_temp(:,:)
-      emp_b (:,:)     =  emp_b_temp (:,:)
-      qsr   (:,:)     =  qsr_temp   (:,:)
-      wndm  (:,:)     =  wndm_temp  (:,:)
-      IF( ln_trabbl ) THEN
-         IF( nn_bbl_ldf == 1 ) THEN
-            ahu_bbl(:,:) = ahu_bbl_temp(:,:) 
-            ahv_bbl(:,:) = ahv_bbl_temp(:,:) 
-         ENDIF
-         IF( nn_bbl_adv == 1 ) THEN
-            utr_bbl(:,:) = utr_bbl_temp(:,:) 
-            vtr_bbl(:,:) = vtr_bbl_temp(:,:) 
-         ENDIF
-      ENDIF
-      !
-      hdivn (:,:,:)   =  hdivn_temp (:,:,:)
-      !                                      
-      ! Start new averages
-         un_tm   (:,:,:)        = un   (:,:,:)        * e3u_n(:,:,:) 
-         vn_tm   (:,:,:)        = vn   (:,:,:)        * e3v_n(:,:,:) 
-         tsn_tm  (:,:,:,jp_tem) = tsn  (:,:,:,jp_tem) * e3t_n(:,:,:)  
-         tsn_tm  (:,:,:,jp_sal) = tsn  (:,:,:,jp_sal) * e3t_n(:,:,:)  
-         rhop_tm (:,:,:)        = rhop (:,:,:)        * e3t_n(:,:,:)  
-         avs_tm  (:,:,:)        = avs  (:,:,:)        * e3w_n(:,:,:)  
-      IF( l_ldfslp ) THEN
-         uslp_tm (:,:,:)        = uslp (:,:,:)
-         vslp_tm (:,:,:)        = vslp (:,:,:)
-         wslpi_tm(:,:,:)        = wslpi(:,:,:) 
-         wslpj_tm(:,:,:)        = wslpj(:,:,:)
-      ENDIF
-      !
-      sshb_hold  (:,:) = sshn  (:,:)
-      emp_b_hold (:,:) = emp   (:,:)
-      sshn_tm    (:,:) = sshn  (:,:) 
-      rnf_tm     (:,:) = rnf   (:,:) 
-      h_rnf_tm   (:,:) = h_rnf (:,:) 
-      hmld_tm    (:,:) = hmld  (:,:)
-      fr_i_tm    (:,:) = fr_i  (:,:)
-      emp_tm     (:,:) = emp   (:,:)
-      fmmflx_tm  (:,:) = fmmflx(:,:)
-      qsr_tm     (:,:) = qsr   (:,:)
-      wndm_tm    (:,:) = wndm  (:,:)
-      IF( ln_trabbl ) THEN
-         IF( nn_bbl_ldf == 1 ) THEN
-            ahu_bbl_tm(:,:) = ahu_bbl(:,:) 
-            ahv_bbl_tm(:,:) = ahv_bbl(:,:) 
-         ENDIF
-         IF( nn_bbl_adv == 1 ) THEN
-            utr_bbl_tm(:,:) = utr_bbl(:,:) 
-            vtr_bbl_tm(:,:) = vtr_bbl(:,:) 
-         ENDIF
-      ENDIF
-      !
-      !
-      IF( ln_timing )   CALL timing_stop('trc_sub_reset')
-      !
-   END SUBROUTINE trc_sub_reset
-
-
-   SUBROUTINE trc_sub_ssh( kt ) 
-      !!----------------------------------------------------------------------
-      !!                ***  ROUTINE trc_sub_ssh  ***
-      !!                   
-      !! ** Purpose :   compute the after ssh (ssha), the now vertical velocity
-      !!              and update the now vertical coordinate (ln_linssh=F).
-      !!
-      !! ** Method  : - Using the incompressibility hypothesis, the vertical 
-      !!      velocity is computed by integrating the horizontal divergence  
-      !!      from the bottom to the surface minus the scale factor evolution.
-      !!        The boundary conditions are w=0 at the bottom (no flux) and.
-      !!
-      !! ** action  :   ssha    : after sea surface height
-      !!                wn      : now vertical velocity
-      !!                sshu_a, sshv_a, sshf_a  : after sea surface height (ln_linssh=F)
-      !!
-      !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling.
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! time step
-      !
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   zcoefu, zcoefv, zcoeff, z2dt, z1_2dt, z1_rau0   ! local scalars
-      REAL(wp), DIMENSION(jpi,jpj) :: zhdiv
-      !!---------------------------------------------------------------------
-      !
-      IF( ln_timing )   CALL timing_start('trc_sub_ssh')
-      !
-
-      IF( kt == nittrc000 ) THEN
-         !
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'trc_sub_ssh : after sea surface height and now vertical velocity '
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
-         !
-         wn(:,:,jpk) = 0._wp                  ! bottom boundary condition: w=0 (set once for all)
-         !
-      ENDIF
-      !
-!!gm BUG here !   hdivn will include the runoff divergence at the wrong timestep !!!!
-      CALL div_hor( kt )                              ! Horizontal divergence & Relative vorticity
-      !
-      z2dt = 2._wp * rdt                              ! set time step size (Euler/Leapfrog)
-      IF( neuler == 0 .AND. kt == nittrc000 )   z2dt = rdt
-
-      !                                           !------------------------------!
-      !                                           !   After Sea Surface Height   !
-      !                                           !------------------------------!
-      zhdiv(:,:) = 0._wp
-      DO jk = 1, jpkm1                                 ! Horizontal divergence of barotropic transports
-        zhdiv(:,:) = zhdiv(:,:) + e3t_n(:,:,jk) * hdivn(:,:,jk)
-      END DO
-      !                                                ! Sea surface elevation time stepping
-      ! In forward Euler time stepping case, the same formulation as in the leap-frog case can be used
-      ! because emp_b field is initialized with the vlaues of emp field. Hence, 0.5 * ( emp + emp_b ) = emp
-      z1_rau0 = 0.5 / rau0
-      ssha(:,:) = (  sshb(:,:) - z2dt * ( z1_rau0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * tmask(:,:,1)
-
-      IF( .NOT.ln_dynspg_ts ) THEN
-      ! These lines are not necessary with time splitting since
-      ! boundary condition on sea level is set during ts loop
-#if defined key_agrif
-      CALL agrif_ssh( kt )
-#endif
-         IF( ln_bdy ) THEN
-            ssha(:,:) = ssha(:,:) * bdytmask(:,:)
-            CALL lbc_lnk( 'trcsub', ssha, 'T', 1. ) 
-         ENDIF
-      ENDIF
-      !
-      !                                           !------------------------------!
-      !                                           !     Now Vertical Velocity    !
-      !                                           !------------------------------!
-      z1_2dt = 1.e0 / z2dt
-      DO jk = jpkm1, 1, -1                             ! integrate from the bottom the hor. divergence
-         ! - ML - need 3 lines here because replacement of e3t by its expression yields too long lines otherwise
-         wn(:,:,jk) = wn(:,:,jk+1) -   e3t_n(:,:,jk) * hdivn(:,:,jk)        &
-            &                      - ( e3t_a(:,:,jk) - e3t_b(:,:,jk) )    &
-            &                         * tmask(:,:,jk) * z1_2dt
-         IF( ln_bdy ) wn(:,:,jk) = wn(:,:,jk) * bdytmask(:,:)
-      END DO
-      !
-      IF( ln_timing )   CALL timing_stop('trc_sub_ssh')
-      !
-   END SUBROUTINE trc_sub_ssh
-
-
-   INTEGER FUNCTION trc_sub_alloc()
-      !!-------------------------------------------------------------------
-      !!                    *** ROUTINE trc_sub_alloc ***
-      !!-------------------------------------------------------------------
-      USE lib_mpp, ONLY: ctl_stop
-      INTEGER ::  ierr(3)
-      !!-------------------------------------------------------------------
-      !
-      ierr(:) = 0
-      !
-      ALLOCATE( un_temp(jpi,jpj,jpk)      ,  vn_temp(jpi,jpj,jpk)   ,     &
-         &      wn_temp(jpi,jpj,jpk)      ,                               &
-         &      rhop_temp(jpi,jpj,jpk)    ,  rhop_tm(jpi,jpj,jpk)   ,     &
-         &      sshn_temp(jpi,jpj)        ,  sshb_temp(jpi,jpj)     ,     &
-         &      ssha_temp(jpi,jpj)        ,                               &
-         &      rnf_temp(jpi,jpj)         ,  h_rnf_temp(jpi,jpj)    ,     &
-         &      tsn_temp(jpi,jpj,jpk,2)   ,  emp_b_temp(jpi,jpj)    ,     &
-         &      emp_temp(jpi,jpj)         ,  fmmflx_temp(jpi,jpj)   ,     &
-         &      hmld_temp(jpi,jpj)        ,  qsr_temp(jpi,jpj)      ,     &
-         &      fr_i_temp(jpi,jpj)        ,  fr_i_tm(jpi,jpj)       ,     &
-         &      wndm_temp(jpi,jpj)        ,  wndm_tm(jpi,jpj)       ,     &
-         &      avs_tm(jpi,jpj,jpk)       ,  avs_temp(jpi,jpj,jpk)  ,     &
-         &      hdivn_temp(jpi,jpj,jpk)   ,  hdivb_temp(jpi,jpj,jpk),     &
-         &      un_tm(jpi,jpj,jpk)        ,  vn_tm(jpi,jpj,jpk)     ,     &
-         &      sshn_tm(jpi,jpj)          ,  sshb_hold(jpi,jpj)     ,     &
-         &      tsn_tm(jpi,jpj,jpk,2)     ,                               &
-         &      emp_tm(jpi,jpj)           ,  fmmflx_tm(jpi,jpj)     ,     &
-         &      emp_b_hold(jpi,jpj)       ,                               &
-         &      hmld_tm(jpi,jpj)          ,  qsr_tm(jpi,jpj)        ,     &
-         &      rnf_tm(jpi,jpj)           ,  h_rnf_tm(jpi,jpj)      , STAT=ierr(1) )  
-      !
-      IF( l_ldfslp ) THEN
-         ALLOCATE( uslp_temp(jpi,jpj,jpk) ,  wslpi_temp(jpi,jpj,jpk),     &
-            &      vslp_temp(jpi,jpj,jpk) ,  wslpj_temp(jpi,jpj,jpk),     &
-            &      uslp_tm  (jpi,jpj,jpk) ,  wslpi_tm  (jpi,jpj,jpk),     &
-            &      vslp_tm  (jpi,jpj,jpk) ,  wslpj_tm  (jpi,jpj,jpk), STAT=ierr(2) )
-      ENDIF
-      IF( ln_trabbl ) THEN
-         ALLOCATE( ahu_bbl_temp(jpi,jpj)  , utr_bbl_temp(jpi,jpj)   ,     &
-            &      ahv_bbl_temp(jpi,jpj)  , vtr_bbl_temp(jpi,jpj)   ,     &
-            &      ahu_bbl_tm  (jpi,jpj)  , utr_bbl_tm  (jpi,jpj)   ,     &
-            &      ahv_bbl_tm  (jpi,jpj)  , vtr_bbl_tm  (jpi,jpj)   , STAT=ierr(3) ) 
-      ENDIF
-      !
-      trc_sub_alloc = MAXVAL( ierr )
-      !
-      IF( trc_sub_alloc /= 0 )   CALL ctl_stop( 'STOP', 'trc_sub_alloc: failed to allocate arrays' )
-      !
-   END FUNCTION trc_sub_alloc
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default key                                     NO passive tracers
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_sub_stp( kt )        ! Empty routine
-      WRITE(*,*) 'trc_sub_stp: You should not have seen this print! error?', kt
-   END SUBROUTINE trc_sub_stp
-   SUBROUTINE trc_sub_ini        ! Empty routine
-      WRITE(*,*) 'trc_sub_ini: You should not have seen this print! error?', kt
-   END SUBROUTINE trc_sub_ini
-#endif
-
-   !!======================================================================
-END MODULE trcsub
Index: NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcwri.F90
===================================================================
--- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcwri.F90	(revision 12384)
+++ NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcwri.F90	(revision 12928)
@@ -30,5 +30,5 @@
 CONTAINS
 
-   SUBROUTINE trc_wri( kt )
+   SUBROUTINE trc_wri( kt, Kmm )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE trc_wri  ***
@@ -37,4 +37,5 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT( in )     :: kt
+      INTEGER, INTENT( in )     :: Kmm  ! time level indices
       !
       INTEGER                   :: jn
@@ -46,17 +47,29 @@
       IF( ln_timing )   CALL timing_start('trc_wri')
       !
-      IF( l_offline .AND. kt == nittrc000 .AND. lwp ) THEN    ! WRITE root name in date.file for use by postpro
-         CALL dia_nam( clhstnam, nn_writetrc,' ' )
-         CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
-         WRITE(inum,*) clhstnam
-         CLOSE(inum)
+      IF( l_offline ) THEN    ! WRITE root name in date.file for use by postpro
+         IF(  kt == nittrc000 .AND. lwp ) THEN    ! WRITE root name in date.file for use by postpro
+           CALL dia_nam( clhstnam, nn_writetrc,' ' )
+           CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
+           WRITE(inum,*) clhstnam
+           CLOSE(inum)
+        ENDIF
+
+       ! Output of initial vertical scale factor
+       CALL iom_put( "e3t_0", e3t_0(:,:,:) )
+       CALL iom_put( "e3u_0", e3u_0(:,:,:) )
+       CALL iom_put( "e3v_0", e3v_0(:,:,:) )
+       !
+       CALL iom_put( "e3t" , e3t(:,:,:,Kmm) )
+       CALL iom_put( "e3u" , e3u(:,:,:,Kmm) )
+       CALL iom_put( "e3v" , e3v(:,:,:,Kmm) )
+       !
       ENDIF
       ! write the tracer concentrations in the file
       ! ---------------------------------------
-      IF( ln_pisces  )   CALL trc_wri_pisces     ! PISCES 
-      IF( ll_cfc     )   CALL trc_wri_cfc        ! surface fluxes of CFC
-      IF( ln_c14     )   CALL trc_wri_c14        ! surface fluxes of C14
-      IF( ln_age     )   CALL trc_wri_age        ! AGE tracer
-      IF( ln_my_trc  )   CALL trc_wri_my_trc     ! MY_TRC  tracers
+      IF( ln_pisces  )   CALL trc_wri_pisces( Kmm )     ! PISCES 
+      IF( ll_cfc     )   CALL trc_wri_cfc   ( Kmm )     ! surface fluxes of CFC
+      IF( ln_c14     )   CALL trc_wri_c14   ( Kmm )     ! surface fluxes of C14
+      IF( ln_age     )   CALL trc_wri_age   ( Kmm )     ! AGE tracer
+      IF( ln_my_trc  )   CALL trc_wri_my_trc( Kmm )     ! MY_TRC  tracers
       !
       IF( ln_timing )   CALL timing_stop('trc_wri')
@@ -70,6 +83,7 @@
    PUBLIC trc_wri
 CONTAINS
-   SUBROUTINE trc_wri( kt )                     ! Empty routine   
+   SUBROUTINE trc_wri( kt, Kmm )                     ! Empty routine   
    INTEGER, INTENT(in) :: kt
+   INTEGER, INTENT(in) :: Kmm  ! time level indices
    END SUBROUTINE trc_wri
 #endif
