Index: branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
===================================================================
--- branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90	(revision 6827)
+++ 	(revision )
@@ -1,274 +1,0 @@
-MODULE traadv
-   !!==============================================================================
-   !!                       ***  MODULE  traadv  ***
-   !! Ocean active tracers:  advection trend 
-   !!==============================================================================
-   !! History :  2.0  !  2005-11  (G. Madec)  Original code
-   !!            3.3  !  2010-09  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
-   !!            3.6  !  2011-06  (G. Madec)  Addition of Mixed Layer Eddy parameterisation
-   !!            3.7  !  2014-05  (G. Madec)  Add 2nd/4th order cases for CEN and FCT schemes 
-   !!             -   !  2014-12  (G. Madec) suppression of cross land advection option
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_adv       : compute ocean tracer advection trend
-   !!   tra_adv_ctl   : control the different options of advection scheme
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and active tracers
-   USE dom_oce        ! ocean space and time domain
-   USE domvvl         ! variable vertical scale factors
-   USE traadv_cen     ! centered scheme           (tra_adv_cen  routine)
-   USE traadv_fct     ! FCT      scheme           (tra_adv_fct  routine)
-   USE traadv_mus     ! MUSCL    scheme           (tra_adv_mus  routine)
-   USE traadv_ubs     ! UBS      scheme           (tra_adv_ubs  routine)
-   USE traadv_qck     ! QUICKEST scheme           (tra_adv_qck  routine)
-   USE traadv_mle     ! ML eddy induced velocity  (tra_adv_mle  routine)
-   USE ldftra         ! lateral diffusion: eddy diffusivity & EIV coeff.
-   USE ldfslp         ! Lateral diffusion: slopes of neutral surfaces
-   !
-   USE in_out_manager ! I/O manager
-   USE iom            ! I/O module
-   USE prtctl         ! Print control
-   USE lib_mpp        ! MPP library
-   USE wrk_nemo       ! Memory Allocation
-   USE timing         ! Timing
-
-   USE diaptr          ! Poleward heat transport 
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_adv        ! routine called by step module
-   PUBLIC   tra_adv_init   ! routine called by opa module
-
-   !                            !!* Namelist namtra_adv *
-   LOGICAL ::   ln_traadv_cen    ! centered scheme flag
-   INTEGER ::      nn_cen_h, nn_cen_v   ! =2/4 : horizontal and vertical choices of the order of CEN scheme
-   LOGICAL ::   ln_traadv_fct    ! FCT scheme flag
-   INTEGER ::      nn_fct_h, nn_fct_v   ! =2/4 : horizontal and vertical choices of the order of FCT scheme
-   INTEGER ::      nn_fct_zts           ! >=1 : 2nd order FCT with vertical sub-timestepping
-   LOGICAL ::   ln_traadv_mus    ! MUSCL scheme flag
-   LOGICAL ::      ln_mus_ups           ! use upstream scheme in vivcinity of river mouths
-   LOGICAL ::   ln_traadv_ubs    ! UBS scheme flag
-   INTEGER ::      nn_ubs_v             ! =2/4 : vertical choice of the order of UBS scheme
-   LOGICAL ::   ln_traadv_qck    ! QUICKEST scheme flag
-
-   INTEGER ::              nadv             ! choice of the type of advection scheme
-   !
-   !                                        ! associated indices:
-   INTEGER, PARAMETER ::   np_NO_adv  = 0   ! no T-S advection
-   INTEGER, PARAMETER ::   np_CEN     = 1   ! 2nd/4th order centered scheme
-   INTEGER, PARAMETER ::   np_FCT     = 2   ! 2nd/4th order Flux Corrected Transport scheme
-   INTEGER, PARAMETER ::   np_FCT_zts = 3   ! 2nd order FCT scheme with vertical sub-timestepping
-   INTEGER, PARAMETER ::   np_MUS     = 4   ! MUSCL scheme
-   INTEGER, PARAMETER ::   np_UBS     = 5   ! 3rd order Upstream Biased Scheme
-   INTEGER, PARAMETER ::   np_QCK     = 6   ! QUICK scheme
-   
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tra_adv( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_adv  ***
-      !!
-      !! ** 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
-      !
-      INTEGER ::   jk   ! dummy loop index
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_adv')
-      !
-      CALL wrk_alloc( jpi,jpj,jpk,   zun, zvn, zwn )
-      !
-      !                                          ! set time step
-      IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000
-         r2dt = rdt                                 ! = rdt (restarting with Euler time stepping)
-      ELSEIF( kt <= nit000 + 1) THEN                ! at nit000 or nit000+1
-         r2dt = 2._wp * rdt                         ! = 2 rdt (leapfrog)
-      ENDIF
-      !
-      !                                         !==  effective transport  ==!
-      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)
-      END DO
-      !
-      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
-      !
-      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_adv_mle( 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 )
-      !
-!!gm ???
-      IF( ln_diaptr )   CALL dia_ptr( zvn )                                    ! diagnose the effective MSF 
-!!gm ???
-      !
-      SELECT CASE ( nadv )                      !==  compute advection trend and add it to general trend  ==!
-      !
-      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 )
-      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 )
-      CASE ( np_FCT_zts )                                ! 2nd order FCT with vertical time-splitting
-         CALL tra_adv_fct_zts( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts        , nn_fct_zts )
-      CASE ( np_MUS )                                    ! MUSCL
-         CALL tra_adv_mus    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb,      tsa, jpts        , 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   )
-      CASE ( np_QCK )                                    ! QUICKEST
-         CALL tra_adv_qck    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts                     )
-      !
-      END SELECT
-      !
-      !                                         ! 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( nn_timing == 1 )  CALL timing_stop( 'tra_adv' )
-      !
-      CALL wrk_dealloc( jpi,jpj,jpk,   zun, zvn, zwn )
-      !                                          
-   END SUBROUTINE tra_adv
-
-
-   SUBROUTINE tra_adv_init
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_adv_init  ***
-      !!                
-      !! ** Purpose :   Control the consistency between namelist options for 
-      !!              tracer advection schemes and set nadv
-      !!----------------------------------------------------------------------
-      INTEGER ::   ioptio, ios   ! Local integers
-      !
-      NAMELIST/namtra_adv/ ln_traadv_cen, nn_cen_h, nn_cen_v,               &   ! CEN
-         &                 ln_traadv_fct, nn_fct_h, nn_fct_v, nn_fct_zts,   &   ! FCT
-         &                 ln_traadv_mus,                     ln_mus_ups,   &   ! MUSCL
-         &                 ln_traadv_ubs,           nn_ubs_v,               &   ! UBS
-         &                 ln_traadv_qck                                        ! QCK
-      !!----------------------------------------------------------------------
-      !
-      !                                !==  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', lwp )
-      !
-      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', lwp )
-      IF(lwm) WRITE( numond, namtra_adv )
-      !
-      IF(lwp) THEN                           ! Namelist print
-         WRITE(numout,*)
-         WRITE(numout,*) 'tra_adv_init : choice/control of the tracer advection scheme'
-         WRITE(numout,*) '~~~~~~~~~~~'
-         WRITE(numout,*) '   Namelist namtra_adv : chose a advection scheme for tracers'
-         WRITE(numout,*) '      centered scheme                           ln_traadv_cen = ', ln_traadv_cen
-         WRITE(numout,*) '            horizontal 2nd/4th order               nn_cen_h   = ', nn_fct_h
-         WRITE(numout,*) '            vertical   2nd/4th order               nn_cen_v   = ', nn_fct_v
-         WRITE(numout,*) '      Flux Corrected Transport scheme           ln_traadv_fct = ', ln_traadv_fct
-         WRITE(numout,*) '            horizontal 2nd/4th order               nn_fct_h   = ', nn_fct_h
-         WRITE(numout,*) '            vertical   2nd/4th order               nn_fct_v   = ', nn_fct_v
-         WRITE(numout,*) '            2nd order + vertical sub-timestepping  nn_fct_zts = ', nn_fct_zts
-         WRITE(numout,*) '      MUSCL scheme                              ln_traadv_mus = ', ln_traadv_mus
-         WRITE(numout,*) '            + upstream scheme near river mouths    ln_mus_ups = ', ln_mus_ups
-         WRITE(numout,*) '      UBS scheme                                ln_traadv_ubs = ', ln_traadv_ubs
-         WRITE(numout,*) '            vertical   2nd/4th order               nn_ubs_v   = ', nn_ubs_v
-         WRITE(numout,*) '      QUICKEST scheme                           ln_traadv_qck = ', ln_traadv_qck
-      ENDIF
-      !
-      ioptio = 0                       !==  Parameter control  ==!
-      IF( ln_traadv_cen )   ioptio = ioptio + 1
-      IF( ln_traadv_fct )   ioptio = ioptio + 1
-      IF( ln_traadv_mus )   ioptio = ioptio + 1
-      IF( ln_traadv_ubs )   ioptio = ioptio + 1
-      IF( ln_traadv_qck )   ioptio = ioptio + 1
-      !
-      IF( ioptio == 0 ) THEN
-         nadv = np_NO_adv
-         CALL ctl_warn( 'tra_adv_init: You are running without tracer advection.' )
-      ENDIF
-      IF( ioptio /= 1 )   CALL ctl_stop( 'tra_adv_init: Choose ONE advection scheme in namelist namtra_adv' )
-      !
-      IF( ln_traadv_cen .AND. ( nn_cen_h /= 2 .AND. nn_cen_h /= 4 )   &          ! Centered
-                        .AND. ( nn_cen_v /= 2 .AND. nn_cen_v /= 4 )   ) THEN
-        CALL ctl_stop( 'tra_adv_init: CEN scheme, choose 2nd or 4th order' )
-      ENDIF
-      IF( ln_traadv_fct .AND. ( nn_fct_h /= 2 .AND. nn_fct_h /= 4 )   &          ! FCT
-                        .AND. ( nn_fct_v /= 2 .AND. nn_fct_v /= 4 )   ) THEN
-        CALL ctl_stop( 'tra_adv_init: FCT scheme, choose 2nd or 4th order' )
-      ENDIF
-      IF( ln_traadv_fct .AND. nn_fct_zts > 0 ) THEN
-         IF( nn_fct_h == 4 ) THEN
-            nn_fct_h = 2
-            CALL ctl_stop( 'tra_adv_init: force 2nd order FCT scheme, 4th order does not exist with sub-timestepping' )
-         ENDIF
-         IF( .NOT.ln_linssh ) THEN
-            CALL ctl_stop( 'tra_adv_init: vertical sub-timestepping not allow in non-linear free surface' )
-         ENDIF
-         IF( nn_fct_zts == 1 )   CALL ctl_warn( 'tra_adv_init: FCT with ONE sub-timestep = FCT without sub-timestep' )
-      ENDIF
-      IF( ln_traadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 )   ) THEN     ! UBS
-        CALL ctl_stop( 'tra_adv_init: UBS scheme, choose 2nd or 4th order' )
-      ENDIF
-      IF( ln_traadv_ubs .AND. nn_ubs_v == 4 ) THEN
-         CALL ctl_warn( 'tra_adv_init: UBS scheme, only 2nd FCT scheme available on the vertical. It will be used' )
-      ENDIF
-      IF( ln_isfcav ) THEN                                                       ! ice-shelf cavities
-         IF(  ln_traadv_cen .AND. nn_cen_v == 4    .OR.   &                            ! NO 4th order with ISF
-            & ln_traadv_fct .AND. nn_fct_v == 4   )   CALL ctl_stop( 'tra_adv_init: 4th order COMPACT scheme not allowed with ISF' )
-      ENDIF
-      !
-      !                                !==  used advection scheme  ==!  
-      !                                      ! set nadv
-      IF( ln_traadv_cen                      )   nadv = np_CEN
-      IF( ln_traadv_fct                      )   nadv = np_FCT
-      IF( ln_traadv_fct .AND. nn_fct_zts > 0 )   nadv = np_FCT_zts
-      IF( ln_traadv_mus                      )   nadv = np_MUS
-      IF( ln_traadv_ubs                      )   nadv = np_UBS
-      IF( ln_traadv_qck                      )   nadv = np_QCK
-      !
-      IF(lwp) THEN                           ! Print the choice
-         WRITE(numout,*)
-         SELECT CASE ( nadv )
-         CASE( np_NO_adv  )   ;   WRITE(numout,*) '         NO T-S advection'
-         CASE( np_CEN     )   ;   WRITE(numout,*) '         CEN      scheme is used. Horizontal order: ', nn_cen_h,   &
-            &                                                                     ' Vertical   order: ', nn_cen_v
-         CASE( np_FCT     )   ;   WRITE(numout,*) '         FCT      scheme is used. Horizontal order: ', nn_fct_h,   &
-            &                                                                      ' Vertical   order: ', nn_fct_v
-         CASE( np_FCT_zts )   ;   WRITE(numout,*) '         use 2nd order FCT with ', nn_fct_zts,'vertical sub-timestepping'
-         CASE( np_MUS     )   ;   WRITE(numout,*) '         MUSCL    scheme is used'
-         CASE( np_UBS     )   ;   WRITE(numout,*) '         UBS      scheme is used'
-         CASE( np_QCK     )   ;   WRITE(numout,*) '         QUICKEST scheme is used'
-         END SELECT
-      ENDIF
-      !
-      CALL tra_adv_mle_init            !== initialisation of the Mixed Layer Eddy parametrisation (MLE)  ==!
-      !
-   END SUBROUTINE tra_adv_init
-
-  !!======================================================================
-END MODULE traadv
Index: branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen.F90
===================================================================
--- branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen.F90	(revision 6827)
+++ 	(revision )
@@ -1,206 +1,0 @@
-MODULE traadv_cen
-   !!======================================================================
-   !!                     ***  MODULE  traadv_cen  ***
-   !! Ocean  tracers:   advective trend (2nd/4th order centered)
-   !!======================================================================
-   !! History :  3.7  ! 2014-05  (G. Madec)  original code
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_adv_cen   : update the tracer trend with the advection trends using a centered or scheme (2nd or 4th order)
-   !!                   NB: on the vertical it is actually a 4th order COMPACT scheme which is used
-   !!----------------------------------------------------------------------
-   USE oce      , ONLY: tsn ! now ocean temperature and salinity
-   USE dom_oce        ! ocean space and time domain
-   USE eosbn2         ! equation of state
-   USE traadv_fct     ! acces to routine interp_4th_cpt 
-   USE trd_oce        ! trends: ocean variables
-   USE trdtra         ! trends manager: tracers 
-   USE diaptr         ! poleward transport diagnostics
-   !
-   USE in_out_manager ! I/O manager
-   USE iom            ! IOM library
-   USE trc_oce        ! share passive tracers/Ocean variables
-   USE lib_mpp        ! MPP library
-   USE wrk_nemo       ! Memory Allocation
-   USE timing         ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_adv_cen       ! routine called by step.F90
-   
-   REAL(wp) ::   r1_6 = 1._wp / 6._wp   ! =1/6
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
-   !! $Id: traadv_cen2.F90 5737 2015-09-13 07:42:41Z gm $
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tra_adv_cen( kt, kit000, cdtype, pun, pvn, pwn,     &
-      &                                             ptn, pta, kjpt, kn_cen_h, kn_cen_v ) 
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_adv_cen  ***
-      !!                 
-      !! ** Purpose :   Compute the now trend due to the advection of tracers
-      !!      and add it to the general trend of passive tracer equations.
-      !!
-      !! ** Method  :   The advection is evaluated by a 2nd or 4th order scheme
-      !!               using now fields (leap-frog scheme). 
-      !!       kn_cen_h = 2  ==>> 2nd order centered scheme on the horizontal
-      !!                = 4  ==>> 4th order    -        -       -      -
-      !!       kn_cen_v = 2  ==>> 2nd order centered scheme on the vertical
-      !!                = 4  ==>> 4th order COMPACT  scheme     -      -
-      !!
-      !! ** Action : - update pta  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)
-      !!----------------------------------------------------------------------
-      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  ::   ji, jj, jk, jn   ! dummy loop indices
-      INTEGER  ::   ierr             ! local integer
-      REAL(wp) ::   zC2t_u, zC4t_u   ! local scalars
-      REAL(wp) ::   zC2t_v, zC4t_v   !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwx, zwy, zwz, ztu, ztv, ztw
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_adv_cen')
-      !
-      CALL wrk_alloc( jpi,jpj,jpk,   zwx, zwy, zwz, ztu, ztv, ztw )
-      !
-      IF( kt == kit000 )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_adv_cen : centered advection scheme on ', cdtype, ' order h/v =', kn_cen_h,'/', kn_cen_v
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~ '
-      ENDIF
-      !
-      !                    
-      zwz(:,:, 1 ) = 0._wp       ! surface & bottom vertical flux set to zero for all tracers
-      zwz(:,:,jpk) = 0._wp
-      !
-      DO jn = 1, kjpt            !==  loop over the tracers  ==!
-         !
-         SELECT CASE( kn_cen_h )       !--  Horizontal fluxes  --!
-         !
-         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
-            !
-         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
-            CALL lbc_lnk( ztu, 'U', -1. )   ;    CALL lbc_lnk( ztv, 'V', -1. )   ! Lateral boundary cond. (unchanged sgn)
-            !
-            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         
-            !
-         CASE DEFAULT
-            CALL ctl_stop( 'traadv_fct: wrong value for nn_fct' )
-         END SELECT
-         !
-         SELECT CASE( kn_cen_v )       !--  Vertical fluxes  --!   (interior)
-         !
-         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
-            !
-         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
-            !
-         END SELECT
-         !
-         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   
-            ELSE                                   ! no ice-shelf cavities (only ocean surface)
-               zwz(:,:,1) = pwn(:,:,1) * ptn(:,:,1,jn)
-            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
-         !                             ! trend diagnostics
-         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) 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) )
-         END IF
-         !                             ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
-           IF( jn == jp_tem )   htr_adv(:) = ptr_sj( zwy(:,:,:) )
-           IF( jn == jp_sal )   str_adv(:) = ptr_sj( zwy(:,:,:) )
-         ENDIF
-         !
-      END DO
-      !
-      CALL wrk_dealloc( jpi,jpj,jpk,   zwx, zwy, zwz, ztu, ztv, ztw )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_cen')
-      !
-   END SUBROUTINE tra_adv_cen
-   
-   !!======================================================================
-END MODULE traadv_cen
Index: branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90
===================================================================
--- branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90	(revision 6827)
+++ 	(revision )
@@ -1,794 +1,0 @@
-MODULE traadv_fct
-   !!==============================================================================
-   !!                       ***  MODULE  traadv_fct  ***
-   !! Ocean  tracers:  horizontal & vertical advective trend (2nd/4th order Flux Corrected Transport method)
-   !!==============================================================================
-   !! History :  3.7  !  2015-09  (L. Debreu, G. Madec)  original code (inspired from traadv_tvd.F90)
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!  tra_adv_fct    : update the tracer trend with a 3D advective trends using a 2nd or 4th order FCT scheme
-   !!  tra_adv_fct_zts: update the tracer trend with a 3D advective trends using a 2nd order FCT scheme 
-   !!                   with sub-time-stepping in the vertical direction
-   !!  nonosc         : compute monotonic tracer fluxes by a non-oscillatory algorithm 
-   !!  interp_4th_cpt : 4th order compact scheme for the vertical component of the advection
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and active tracers
-   USE dom_oce        ! ocean space and time domain
-   USE trc_oce        ! share passive tracers/Ocean variables
-   USE trd_oce        ! trends: ocean variables
-   USE trdtra         ! tracers trends
-   USE diaptr         ! poleward transport diagnostics
-   !
-   USE in_out_manager ! I/O manager
-   USE lib_mpp        ! MPP library
-   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-   USE wrk_nemo       ! Memory Allocation
-   USE timing         ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_adv_fct        ! routine called by traadv.F90
-   PUBLIC   tra_adv_fct_zts    ! routine called by traadv.F90
-   PUBLIC   interp_4th_cpt     ! routine called by traadv_cen.F90
-
-   LOGICAL  ::   l_trd   ! flag to compute trends
-   REAL(wp) ::   r1_6 = 1._wp / 6._wp   ! =1/6
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tra_adv_fct( kt, kit000, cdtype, p2dt, pun, pvn, pwn,       &
-      &                                              ptb, ptn, pta, kjpt, kn_fct_h, kn_fct_v )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_adv_fct  ***
-      !! 
-      !! **  Purpose :   Compute the now trend due to total advection of tracers
-      !!               and add it to the general trend of tracer equations
-      !!
-      !! **  Method  : - 2nd or 4th FCT scheme on the horizontal direction
-      !!               (choice through the value of kn_fct)
-      !!               - on the vertical the 4th order is a compact scheme 
-      !!               - corrected flux (monotonic correction) 
-      !!
-      !! ** Action : - update pta  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)
-      !!----------------------------------------------------------------------
-      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 
-      !
-      INTEGER  ::   ji, jj, jk, jn                           ! dummy loop indices  
-      REAL(wp) ::   ztra                                     ! local scalar
-      REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk, zC2t_u, zC4t_u   !   -      -
-      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk, zC2t_v, zC4t_v   !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdx, ztrdy, ztrdz
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_adv_fct')
-      !
-      CALL wrk_alloc( jpi,jpj,jpk,   zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw )
-      !
-      IF( kt == kit000 )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_adv_fct : FCT advection scheme on ', cdtype
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-      ENDIF
-      !
-      l_trd = .FALSE.
-      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .TRUE.
-      !
-      IF( l_trd )  THEN
-         CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )
-         ztrdx(:,:,:) = 0._wp   ;    ztrdy(:,:,:) = 0._wp   ;   ztrdz(:,:,:) = 0._wp
-      ENDIF
-      !
-      !                          ! surface & bottom value : flux set to zero one for all
-      zwz(:,:, 1 ) = 0._wp            
-      zwx(:,:,jpk) = 0._wp   ;   zwy(:,:,jpk) = 0._wp    ;    zwz(:,:,jpk) = 0._wp
-      !
-      zwi(:,:,:) = 0._wp        
-      !
-      DO jn = 1, kjpt            !==  loop over the tracers  ==!
-         !
-         !        !==  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
-         !                    !* 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
-         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   
-            ELSE                             ! no cavities: only at the ocean surface
-               zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)
-            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
-         CALL lbc_lnk( zwi, 'T', 1. )  ! Lateral boundary conditions on zwi  (unchanged sign)
-         !                
-         IF( l_trd )  THEN             ! trend diagnostics (contribution of upstream fluxes)
-            ztrdx(:,:,:) = zwx(:,:,:)   ;   ztrdy(:,:,:) = zwy(:,:,:)   ;   ztrdz(:,:,:) = zwz(:,:,:)
-         END IF
-         !                             ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
-           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) )
-           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) )
-         ENDIF
-         !
-         !        !==  anti-diffusive flux : high order minus low order  ==!
-         !
-         SELECT CASE( kn_fct_h )    !* horizontal anti-diffusive fluxes
-         !
-         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
-            !
-         CASE(  4  )                   !- 4th order centered
-            zltu(:,:,jpk) = 0._wp            ! Bottom value : flux set to zero
-            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
-            END DO
-            CALL lbc_lnk( zltu, 'T', 1. )   ;    CALL lbc_lnk( 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         
-            !
-         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
-            CALL lbc_lnk( ztu, 'U', -1. )   ;    CALL lbc_lnk( 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
-            !
-         END SELECT
-         !                      
-         SELECT CASE( kn_fct_v )    !* vertical anti-diffusive fluxes (w-masked interior values)
-         !
-         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
-            !
-         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
-            !
-         END SELECT
-         IF( ln_linssh ) THEN    ! top ocean value: high order = upstream  ==>>  zwz=0
-            zwz(:,:,1) = 0._wp   ! only ocean surface as interior zwz values have been w-masked
-         ENDIF
-         !
-         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )         ! Lateral bondary conditions
-         CALL lbc_lnk( zwz, 'W',  1. )
-         !
-         !        !==  monotonicity algorithm  ==!
-         !
-         CALL nonosc( ptb(:,:,:,jn), 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.  
-                  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
-         !
-         IF( l_trd ) THEN     ! trend diagnostics (contribution of upstream fluxes)
-            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed
-            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed
-            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed
-            !
-            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 wrk_dealloc( jpi,jpj,jpk,   ztrdx, ztrdy, ztrdz )
-         END IF
-         !                    ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
-           IF( jn == jp_tem )   htr_adv(:) = htr_adv(:) + ptr_sj( zwy(:,:,:) )
-           IF( jn == jp_sal )   str_adv(:) = str_adv(:) + ptr_sj( zwy(:,:,:) )
-         ENDIF
-         !
-      END DO                     ! end of tracer loop
-      !
-      CALL wrk_dealloc( jpi,jpj,jpk,    zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_fct')
-      !
-   END SUBROUTINE tra_adv_fct
-
-
-   SUBROUTINE tra_adv_fct_zts( kt, kit000, cdtype, p2dt, pun, pvn, pwn,      &
-      &                                                  ptb, ptn, pta, kjpt, kn_fct_zts )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_adv_fct_zts  ***
-      !! 
-      !! **  Purpose :   Compute the now trend due to total advection of 
-      !!       tracers and add it to the general trend of tracer equations
-      !!
-      !! **  Method  :   TVD ZTS scheme, i.e. 2nd order centered scheme with
-      !!       corrected flux (monotonic correction). This version use sub-
-      !!       timestepping for the vertical advection which increases stability
-      !!       when vertical metrics are small.
-      !!       note: - this advection scheme needs a leap-frog time scheme
-      !!
-      !! ** Action : - update (pta) with the now advective tracer trends
-      !!             - save the trends 
-      !!----------------------------------------------------------------------
-      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_zts      ! number of number of vertical sub-timesteps
-      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 
-      !
-      REAL(wp), DIMENSION( jpk )                           ::   zts             ! length of sub-timestep for vertical advection
-      REAL(wp)                                             ::   zr_p2dt         ! reciprocal of tracer timestep
-      INTEGER  ::   ji, jj, jk, jl, jn       ! dummy loop indices  
-      INTEGER  ::   jtb, jtn, jta   ! sub timestep pointers for leap-frog/euler forward steps
-      INTEGER  ::   jtaken          ! toggle for collecting appropriate fluxes from sub timesteps
-      REAL(wp) ::   z_rzts          ! Fractional length of Euler forward sub-timestep for vertical advection
-      REAL(wp) ::   ztra            ! local scalar
-      REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk   !   -      -
-      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk   !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:  )   ::   zwx_sav , zwy_sav
-      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zwi, zwx, zwy, zwz, zhdiv, zwzts, zwz_sav
-      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   ztrdx, ztrdy, ztrdz
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrs
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_adv_fct_zts')
-      !
-      CALL wrk_alloc( jpi,jpj,             zwx_sav, zwy_sav )
-      CALL wrk_alloc( jpi,jpj,jpk,         zwx, zwy, zwz, zwi, zhdiv, zwzts, zwz_sav )
-      CALL wrk_alloc( jpi,jpj,jpk,kjpt+1,  ztrs )
-      !
-      IF( kt == kit000 )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_adv_fct_zts : 2nd order FCT scheme with ', kn_fct_zts, ' vertical sub-timestep on ', cdtype
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-      ENDIF
-      !
-      l_trd = .FALSE.
-      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .TRUE.
-      !
-      IF( l_trd )  THEN
-         CALL wrk_alloc( jpi,jpj,jpk,   ztrdx, ztrdy, ztrdz )
-         ztrdx(:,:,:) = 0._wp  ;    ztrdy(:,:,:) = 0._wp  ;   ztrdz(:,:,:) = 0._wp
-      ENDIF
-      !
-      zwi(:,:,:) = 0._wp
-      z_rzts = 1._wp / REAL( kn_fct_zts, wp )
-      zr_p2dt = 1._wp / p2dt
-      !
-      ! surface & Bottom value : flux set to zero for all tracers
-      zwz(:,:, 1 ) = 0._wp
-      zwx(:,:,jpk) = 0._wp   ;    zwz(:,:,jpk) = 0._wp
-      zwy(:,:,jpk) = 0._wp   ;    zwi(:,:,jpk) = 0._wp
-      !
-      !                                                          ! ===========
-      DO jn = 1, kjpt                                            ! tracer loop
-         !                                                       ! ===========
-         !
-         ! Upstream advection with initial mass fluxes & intermediate update
-         DO jk = 1, jpkm1        ! upstream tracer flux in the i and j direction
-            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_wp * ( zfp_ui * ptb(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj  ,jk,jn) )
-                  zwy(ji,jj,jk) = 0.5_wp * ( zfp_vj * ptb(ji,jj,jk,jn) + zfm_vj * ptb(ji  ,jj+1,jk,jn) )
-               END DO
-            END DO
-         END DO
-         !                       ! upstream tracer flux in the k direction
-         DO jk = 2, jpkm1              ! Interior value
-            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_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
-         IF( ln_linssh ) THEN          ! top value : linear free surface case only (as zwz is multiplied by wmask)
-            IF( ln_isfcav ) THEN             ! ice-shelf cavities: top value
-               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) 
-                  END DO
-               END DO   
-            ELSE                             ! no cavities, surface value
-               zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)
-            ENDIF
-         ENDIF
-         !
-         DO jk = 1, jpkm1         ! total advective trend
-            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
-         !                           
-         CALL lbc_lnk( zwi, 'T', 1. )     ! Lateral boundary conditions on zwi  (unchanged sign)
-         !                
-         IF( l_trd )  THEN                ! trend diagnostics (contribution of upstream fluxes)
-            ztrdx(:,:,:) = zwx(:,:,:)   ;    ztrdy(:,:,:) = zwy(:,:,:)  ;   ztrdz(:,:,:) = zwz(:,:,:)
-         END IF
-         !                                ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
-           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) )
-           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) )
-         ENDIF
-
-         ! 3. anti-diffusive flux : high order minus low order
-         ! ---------------------------------------------------
-
-         DO jk = 1, jpkm1                    !* horizontal anti-diffusive fluxes
-            !
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwx_sav(ji,jj) = zwx(ji,jj,jk)
-                  zwy_sav(ji,jj) = zwy(ji,jj,jk)
-                  !
-                  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
-            !
-            DO jj = 2, jpjm1                    ! partial horizontal divergence
-               DO ji = fs_2, fs_jpim1
-                  zhdiv(ji,jj,jk) = (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk)   &
-                     &               + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk)  )
-               END DO
-            END DO
-            !
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwx(ji,jj,jk) = zwx(ji,jj,jk) - zwx_sav(ji,jj)
-                  zwy(ji,jj,jk) = zwy(ji,jj,jk) - zwy_sav(ji,jj)
-               END DO
-            END DO
-         END DO
-         !
-         !                                !* vertical anti-diffusive flux
-         zwz_sav(:,:,:)   = zwz(:,:,:)
-         ztrs   (:,:,:,1) = ptb(:,:,:,jn)
-         ztrs   (:,:,1,2) = ptb(:,:,1,jn)
-         ztrs   (:,:,1,3) = ptb(:,:,1,jn)
-         zwzts  (:,:,:)   = 0._wp
-         !
-         DO jl = 1, kn_fct_zts                  ! Start of sub timestepping loop
-            !
-            IF( jl == 1 ) THEN                        ! Euler forward to kick things off
-               jtb = 1   ;   jtn = 1   ;   jta = 2
-               zts(:) = p2dt * z_rzts
-               jtaken = MOD( kn_fct_zts + 1 , 2)            ! Toggle to collect every second flux
-               !                                            ! starting at jl =1 if kn_fct_zts is odd; 
-               !                                            ! starting at jl =2 otherwise
-            ELSEIF( jl == 2 ) THEN                    ! First leapfrog step
-               jtb = 1   ;   jtn = 2   ;   jta = 3
-               zts(:) = 2._wp * p2dt * z_rzts
-            ELSE                                      ! Shuffle pointers for subsequent leapfrog steps
-               jtb = MOD(jtb,3) + 1
-               jtn = MOD(jtn,3) + 1
-               jta = MOD(jta,3) + 1
-            ENDIF
-            DO jk = 2, jpkm1                          ! interior value
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     zwz(ji,jj,jk) = 0.5_wp * pwn(ji,jj,jk) * ( ztrs(ji,jj,jk,jtn) + ztrs(ji,jj,jk-1,jtn) ) * wmask(ji,jj,jk)
-                     IF( jtaken == 0 )   zwzts(ji,jj,jk) = zwzts(ji,jj,jk) + zwz(ji,jj,jk) * zts(jk)    ! Accumulate time-weighted vertcal flux
-                  END DO
-               END DO
-            END DO
-            IF( ln_linssh ) THEN                    ! top value (only in linear free surface case)
-               IF( ln_isfcav ) THEN                      ! ice-shelf cavities
-                  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   
-               ELSE                                      ! no ocean cavities
-                  zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)
-               ENDIF
-            ENDIF
-            !
-            jtaken = MOD( jtaken + 1 , 2 )
-            !
-            DO jk = 2, jpkm1                             ! total advective trends
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     ztrs(ji,jj,jk,jta) = ztrs(ji,jj,jk,jtb)                                                 &
-                        &               - zts(jk) * (  zhdiv(ji,jj,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
-            !
-         END DO
-
-         DO jk = 2, jpkm1          ! Anti-diffusive vertical flux using average flux from the sub-timestepping
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  zwz(ji,jj,jk) = ( zwzts(ji,jj,jk) * zr_p2dt - zwz_sav(ji,jj,jk) ) * wmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )         ! Lateral bondary conditions
-         CALL lbc_lnk( zwz, 'W',  1. )
-
-         ! 4. monotonicity algorithm
-         ! -------------------------
-         CALL nonosc( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt )
-
-
-         ! 5. final trend with corrected fluxes
-         ! ------------------------------------
-         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) + (   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
-
-         !                                 ! trend diagnostics (contribution of upstream fluxes)
-         IF( l_trd )  THEN 
-            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed
-            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed
-            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed
-            !
-            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 wrk_dealloc( jpi,jpj,jpk,   ztrdx, ztrdy, ztrdz )
-         END IF
-         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
-           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:)
-           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:)
-         ENDIF
-         !
-      END DO
-      !
-      CALL wrk_alloc( jpi,jpj,             zwx_sav, zwy_sav )
-      CALL wrk_alloc( jpi,jpj, jpk,        zwx, zwy, zwz, zwi, zhdiv, zwzts, zwz_sav )
-      CALL wrk_alloc( jpi,jpj,jpk,kjpt+1,  ztrs )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_fct_zts')
-      !
-   END SUBROUTINE tra_adv_fct_zts
-
-
-   SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, p2dt )
-      !!---------------------------------------------------------------------
-      !!                    ***  ROUTINE nonosc  ***
-      !!     
-      !! **  Purpose :   compute monotonic tracer fluxes from the upstream 
-      !!       scheme and the before field by a nonoscillatory algorithm 
-      !!
-      !! **  Method  :   ... ???
-      !!       warning : pbef and paft must be masked, but the boundaries
-      !!       conditions on the fluxes are not necessary zalezak (1979)
-      !!       drange (1995) multi-dimensional forward-in-time and upstream-
-      !!       in-space based differencing for fluid
-      !!----------------------------------------------------------------------
-      REAL(wp)                         , INTENT(in   ) ::   p2dt            ! tracer time-step
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pbef, paft      ! before & after field
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(inout) ::   paa, pbb, pcc   ! monotonic fluxes in the 3 directions
-      !
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      INTEGER  ::   ikm1         ! local integer
-      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn    ! local scalars
-      REAL(wp) ::   zau, zbu, zcu, zav, zbv, zcv, zup, zdo            !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zbetup, zbetdo, zbup, zbdo
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('nonosc')
-      !
-      CALL wrk_alloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo )
-      !
-      zbig  = 1.e+40_wp
-      zrtrn = 1.e-15_wp
-      zbetup(:,:,:) = 0._wp   ;   zbetdo(:,:,:) = 0._wp
-
-      ! Search local extrema
-      ! --------------------
-      ! max/min of pbef & paft with large negative/positive value (-/+zbig) inside land
-      zbup = MAX( pbef * tmask - zbig * ( 1._wp - tmask ),   &
-         &        paft * tmask - zbig * ( 1._wp - tmask )  )
-      zbdo = MIN( pbef * tmask + zbig * ( 1._wp - tmask ),   &
-         &        paft * tmask + zbig * ( 1._wp - tmask )  )
-
-      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
-      END DO
-      CALL lbc_lnk( zbetup, 'T', 1. )   ;   CALL lbc_lnk( zbetdo, 'T', 1. )   ! lateral boundary cond. (unchanged sign)
-
-      ! 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
-      CALL lbc_lnk( paa, 'U', -1. )   ;   CALL lbc_lnk( pbb, 'V', -1. )   ! lateral boundary condition (changed sign)
-      !
-      CALL wrk_dealloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('nonosc')
-      !
-   END SUBROUTINE nonosc
-
-
-   SUBROUTINE interp_4th_cpt( pt_in, pt_out )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interp_4th_cpt  ***
-      !! 
-      !! **  Purpose :   Compute the interpolation of tracer at w-point
-      !!
-      !! **  Method  :   4th order compact interpolation
-      !!----------------------------------------------------------------------
-      REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pt_in    ! now tracer fields
-      REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   pt_out   ! now tracer field interpolated at w-pts
-      !
-      INTEGER :: ji, jj, jk   ! dummy loop integers
-      REAL(wp),DIMENSION(jpi,jpj,jpk) :: zwd, zwi, zws, zwrm, zwt
-      !!----------------------------------------------------------------------
-      
-      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
-            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   
-      !
-      !                       !==  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
-      !    
-   END SUBROUTINE interp_4th_cpt
-   
-   !!======================================================================
-END MODULE traadv_fct
Index: branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90
===================================================================
--- branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90	(revision 6827)
+++ 	(revision )
@@ -1,357 +1,0 @@
-MODULE traadv_mle
-   !!======================================================================
-   !!                    ***  MODULE  traadv_mle  ***
-   !! Ocean tracers: Mixed Layer Eddy induced transport
-   !!======================================================================
-   !! History :  3.3  !  2010-08  (G. Madec)  Original code
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_adv_mle      : update the effective transport with the Mixed Layer Eddy induced transport
-   !!   tra_adv_mle_init : initialisation of the Mixed Layer Eddy induced transport computation
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and tracers variables
-   USE dom_oce        ! ocean space and time domain variables
-   USE phycst         ! physical constant
-   USE zdfmxl         ! mixed layer depth
-   USE lbclnk         ! lateral boundary condition / mpp link
-   USE in_out_manager ! I/O manager
-   USE iom            ! IOM library
-   USE lib_mpp        ! MPP library
-   USE wrk_nemo       ! work arrays
-   USE timing         ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_adv_mle        ! routine called in traadv.F90
-   PUBLIC   tra_adv_mle_init   ! routine called in traadv.F90
-
-   !                                       !!* namelist namtra_adv_mle *
-   LOGICAL, PUBLIC ::   ln_mle              ! flag to activate the Mixed Layer Eddy (MLE) parameterisation
-   INTEGER         ::   nn_mle              ! MLE type: =0 standard Fox-Kemper ; =1 new formulation
-   INTEGER         ::   nn_mld_uv           ! space interpolation of MLD at u- & v-pts (0=min,1=averaged,2=max)
-   INTEGER         ::   nn_conv             ! =1 no MLE in case of convection ; =0 always MLE
-   REAL(wp)        ::   rn_ce               ! MLE coefficient
-   !                                        ! parameters used in nn_mle = 0 case
-   REAL(wp)        ::   rn_lf                  ! typical scale of mixed layer front
-   REAL(wp)        ::   rn_time                ! time scale for mixing momentum across the mixed layer
-   !                                        ! parameters used in nn_mle = 1 case
-   REAL(wp)        ::   rn_lat                 ! reference latitude for a 5 km scale of ML front
-   REAL(wp)        ::   rn_rho_c_mle           ! Density criterion for definition of MLD used by FK
-
-   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) ::   rc_f                   ! MLE coefficient (= rn_ce / (5 km * fo) ) in nn_mle=1 case
-
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rfu, rfv   ! modified Coriolis parameter (f+tau) at u- & v-pts
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   r1_ft      ! inverse of the modified Coriolis parameter at t-pts
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 4.0 , NEMO Consortium (2015)
-   !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tra_adv_mle( kt, kit000, pu, pv, pw, cdtype )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE adv_mle  ***
-      !!
-      !! ** 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  ::   ikmax        ! temporary integer
-      REAL(wp) ::   zcuw, zmuw   ! local scalar
-      REAL(wp) ::   zcvw, zmvw   !   -      -
-      REAL(wp) ::   zc                                     !   -      -
-      !
-      INTEGER  ::   ii, ij, ik              ! local integers
-      INTEGER, DIMENSION(3) ::   ilocu      !
-      INTEGER, DIMENSION(2) ::   ilocs      !
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpsi_uw, zpsi_vw
-      INTEGER, POINTER, DIMENSION(:,:) :: inml_mle
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_adv_mle')
-      CALL wrk_alloc( jpi, jpj, zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH)
-      CALL wrk_alloc( jpi, jpj, jpk, zpsi_uw, zpsi_vw)
-      CALL wrk_alloc( jpi, jpj, inml_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)
-      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
-      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
-      !
-      !                                      !==  structure function value at uw- and vw-points  ==!
-      DO jj = 1, jpjm1
-         DO ji = 1, fs_jpim1   ! vector opt.
-            zhu(ji,jj) = 1._wp / zhu(ji,jj)                   ! hu --> 1/hu
-            zhv(ji,jj) = 1._wp / zhv(ji,jj)
-         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
-
-      IF( cdtype == 'TRA') THEN              !==  outputs  ==!
-         !
-         zLf_NH(:,:) = SQRT( rb_c * zmld(:,:) ) * r1_ft(:,:)      ! Lf = N H / f
-         CALL iom_put( "Lf_NHpf" , zLf_NH  )    ! Lf = N H / f
-         !
-         ! divide by cross distance to give streamfunction with dimensions m^2/s
-         DO jk = 1, ikmax+1
-            zpsi_uw(:,:,jk) = zpsi_uw(:,:,jk) * r1_e2u(:,:)
-            zpsi_vw(:,:,jk) = zpsi_vw(:,:,jk) * r1_e1v(:,:)
-         END DO
-         CALL iom_put( "psiu_mle", zpsi_uw )    ! i-mle streamfunction
-         CALL iom_put( "psiv_mle", zpsi_vw )    ! j-mle streamfunction
-      ENDIF
-      CALL wrk_dealloc( jpi, jpj, zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH)
-      CALL wrk_dealloc( jpi, jpj, jpk, zpsi_uw, zpsi_vw)
-      CALL wrk_dealloc( jpi, jpj, inml_mle)
-
-      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_mle')
-      !
-   END SUBROUTINE tra_adv_mle
-
-
-   SUBROUTINE tra_adv_mle_init
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_adv_mle_init  ***
-      !!
-      !! ** Purpose :   Control the consistency between namelist options for
-      !!              tracer advection schemes and set nadv
-      !!----------------------------------------------------------------------
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      INTEGER  ::   ierr
-      INTEGER ::    ios                 ! Local integer output status for namelist read
-      REAL(wp) ::   z1_t2, zfu, zfv                                !    -         -
-      !
-      NAMELIST/namtra_adv_mle/ ln_mle , nn_mle, rn_ce, rn_lf, rn_time, rn_lat, nn_mld_uv, nn_conv, rn_rho_c_mle
-      !!----------------------------------------------------------------------
-
-      REWIND( numnam_ref )              ! Namelist namtra_adv_mle in reference namelist : Tracer advection scheme
-      READ  ( numnam_ref, namtra_adv_mle, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_adv_mle in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namtra_adv_mle in configuration namelist : Tracer advection scheme
-      READ  ( numnam_cfg, namtra_adv_mle, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_adv_mle in configuration namelist', lwp )
-      IF(lwm) WRITE ( numond, namtra_adv_mle )
-
-      IF(lwp) THEN                     ! Namelist print
-         WRITE(numout,*)
-         WRITE(numout,*) 'tra_adv_mle_init : mixed layer eddy (MLE) advection acting on tracers'
-         WRITE(numout,*) '~~~~~~~~~~~~~~~~'
-         WRITE(numout,*) '   Namelist namtra_adv_mle : mixed layer eddy advection on tracers'
-         WRITE(numout,*) '      use mixed layer eddy (MLE, i.e. Fox-Kemper param) (T/F)      ln_mle    = ', ln_mle
-         WRITE(numout,*) '      MLE type: =0 standard Fox-Kemper ; =1 new formulation        nn_mle    = ', nn_mle
-         WRITE(numout,*) '      magnitude of the MLE (typical value: 0.06 to 0.08)           rn_ce     = ', rn_ce
-         WRITE(numout,*) '      scale of ML front (ML radius of deformation) (rn_mle=0)      rn_lf     = ', rn_lf, 'm'
-         WRITE(numout,*) '      maximum time scale of MLE                    (rn_mle=0)      rn_time   = ', rn_time, 's'
-         WRITE(numout,*) '      reference latitude (degrees) of MLE coef.    (rn_mle=1)      rn_lat    = ', rn_lat, 'deg'
-         WRITE(numout,*) '      space interp. of MLD at u-(v-)pts (0=min,1=averaged,2=max)   nn_mld_uv = ', nn_mld_uv
-         WRITE(numout,*) '      =1 no MLE in case of convection ; =0 always MLE              nn_conv   = ', nn_conv
-         WRITE(numout,*) '      Density difference used to define ML for FK              rn_rho_c_mle  = ', rn_rho_c_mle
-      ENDIF
-      !
-      IF(lwp) THEN
-         WRITE(numout,*)
-         IF( ln_mle ) THEN
-            WRITE(numout,*) '   Mixed Layer Eddy induced transport added to tracer advection'
-            IF( nn_mle == 0 )   WRITE(numout,*) '   Fox-Kemper et al 2010 formulation'
-            IF( nn_mle == 1 )   WRITE(numout,*) '   New formulation'
-         ELSE
-            WRITE(numout,*) '   Mixed Layer Eddy parametrisation NOT used'
-         ENDIF
-      ENDIF
-      !
-      IF( ln_mle ) THEN                ! MLE initialisation
-         !
-         rb_c = grav * rn_rho_c_mle /rau0        ! Mixed Layer buoyancy criteria
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '      ML buoyancy criteria = ', rb_c, ' m/s2 '
-         IF(lwp) WRITE(numout,*) '      associated ML density criteria defined in zdfmxl = ', rho_c, 'kg/m3'
-         !
-         IF( nn_mle == 0 ) THEN           ! MLE array allocation & initialisation
-            ALLOCATE( rfu(jpi,jpj) , rfv(jpi,jpj) , STAT= ierr )
-            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(ji,jj) + ff(ji,jj-1) ) * 0.5_wp
-                  zfv = ( ff(ji,jj) + ff(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
-            CALL lbc_lnk( rfu, 'U', 1. )   ;   CALL lbc_lnk( rfv, 'V', 1. )
-            !
-         ELSEIF( nn_mle == 1 ) THEN           ! MLE array allocation & initialisation
-            rc_f = rn_ce / (  5.e3_wp * 2._wp * omega * SIN( rad * rn_lat )  )
-            !
-         ENDIF
-         !
-         !                                ! 1/(f^2+tau^2)^1/2 at t-point (needed in both nn_mle case)
-         ALLOCATE( r1_ft(jpi,jpj) , STAT= ierr )
-         IF( ierr /= 0 )   CALL ctl_stop( 'tra_adv_mle_init: failed to allocate r1_ft array' )
-         !
-         z1_t2 = 1._wp / ( rn_time * rn_time )
-         r1_ft(:,:) = 2._wp * omega * SIN( rad * gphit(:,:) )
-         r1_ft(:,:) = 1._wp / SQRT(  r1_ft(:,:) * r1_ft(:,:) + z1_t2 )
-         !
-      ENDIF
-      !
-   END SUBROUTINE tra_adv_mle_init
-
-   !!==============================================================================
-END MODULE traadv_mle
Index: branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90
===================================================================
--- branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90	(revision 6827)
+++ 	(revision )
@@ -1,277 +1,0 @@
-MODULE traadv_mus
-   !!======================================================================
-   !!                       ***  MODULE  traadv_mus  ***
-   !! Ocean  tracers:  horizontal & vertical advective trend
-   !!======================================================================
-   !! History :       !  2000-06  (A.Estublier)  for passive tracers
-   !!                 !  2001-08  (E.Durand, G.Madec)  adapted for T & S
-   !!   NEMO     1.0  !  2002-06  (G. Madec)  F90: Free form and module
-   !!            3.2  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
-   !!            3.4  !  2012-06  (P. Oddo, M. Vichi) include the upstream where needed
-   !!            3.7  !  2015-09  (G. Madec) add the ice-shelf cavities boundary condition
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_adv_mus   : update the tracer trend with the horizontal
-   !!                   and vertical advection trends using MUSCL scheme
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and active tracers
-   USE trc_oce        ! share passive tracers/Ocean variables
-   USE dom_oce        ! ocean space and time domain
-   USE trd_oce        ! trends: ocean variables
-   USE trdtra         ! tracers trends manager
-   USE sbcrnf         ! river runoffs
-   USE diaptr         ! poleward transport diagnostics
-   !
-   USE wrk_nemo       ! Memory Allocation
-   USE timing         ! Timing
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-   USE in_out_manager ! I/O manager
-   USE lib_mpp        ! distribued memory computing
-   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_adv_mus   ! routine called by traadv.F90
-   
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   upsmsk   !: mixed upstream/centered scheme near some straits
-   !                                                           !  and in closed seas (orca 2 and 4 configurations)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xind     !: mixed upstream/centered index
-   
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tra_adv_mus( kt, kit000, cdtype, p2dt, pun, pvn, pwn,             &
-      &                                              ptb, pta, kjpt, ld_msc_ups )
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE tra_adv_mus  ***
-      !!
-      !! ** Purpose :   Compute the now trend due to total advection of tracers
-      !!              using a MUSCL scheme (Monotone Upstream-centered Scheme for
-      !!              Conservation Laws) and add it to the general tracer trend.
-      !!
-      !! ** Method  : MUSCL scheme plus centered scheme at ocean boundaries
-      !!              ld_msc_ups=T : 
-      !!
-      !! ** Action : - update pta  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)
-      !!
-      !! 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  ::   ji, jj, jk, jn       ! dummy loop indices
-      INTEGER  ::   ierr                 ! local integer
-      REAL(wp) ::   zu, z0u, zzwx, zw    ! local scalars
-      REAL(wp) ::   zv, z0v, zzwy, z0w   !   -      -
-      REAL(wp) ::   zalpha               !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zslpx, zslpy   ! 3D workspace
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwx  , zwy     ! -      - 
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_adv_mus')
-      !
-      CALL wrk_alloc( jpi,jpj,jpk,   zslpx, zslpy, zwx, zwy )
-      !
-      IF( kt == kit000 )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_adv : MUSCL advection scheme on ', cdtype
-         IF(lwp) WRITE(numout,*) '        : mixed up-stream           ', ld_msc_ups
-         IF(lwp) WRITE(numout,*) '~~~~~~~'
-         IF(lwp) WRITE(numout,*)
-         !
-         ! Upstream / MUSCL scheme indicator
-         !
-         ALLOCATE( xind(jpi,jpj,jpk), STAT=ierr )
-         xind(:,:,:) = 1._wp              ! set equal to 1 where up-stream is not needed
-         !
-         IF( ld_msc_ups ) THEN            ! define the upstream indicator (if asked)
-            ALLOCATE( upsmsk(jpi,jpj), STAT=ierr )
-            upsmsk(:,:) = 0._wp                             ! not upstream by default
-            !
-            DO jk = 1, jpkm1
-               xind(:,:,jk) = 1._wp                              &                 ! =>1 where up-stream is not needed
-                  &         - MAX ( rnfmsk(:,:) * rnfmsk_z(jk),  &                 ! =>0 near runoff mouths (& closed sea outflows)
-                  &                 upsmsk(:,:)                ) * tmask(:,:,jk)   ! =>0 in some user defined area
-            END DO
-         ENDIF 
-         !
-      ENDIF 
-      !      
-      DO jn = 1, kjpt            !==  loop over the tracers  ==!
-         !
-         !                          !* Horizontal advective fluxes
-         !
-         !                                !-- first guess of the slopes
-         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
-         CALL lbc_lnk( zwx, 'U', -1. )          ! lateral boundary conditions   (changed sign)
-         CALL lbc_lnk( zwy, 'V', -1. )
-         !                                !-- Slopes of tracer
-         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
-         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( 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        
-         !                                ! trend diagnostics
-         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR.   &
-            &( cdtype == 'TRC' .AND. l_trdtrc )      )  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) )
-         END IF
-         !                                ! "Poleward" heat and salt transports
-         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
-            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) )
-            IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) )
-         ENDIF
-         !
-         !                          !* Vertical advective fluxes
-         !
-         !                                !-- first guess of the slopes
-         zwx(:,:, 1 ) = 0._wp                   ! surface & bottom boundary conditions
-         zwx(:,:,jpk) = 0._wp
-         DO jk = 2, jpkm1                       ! interior values
-            zwx(:,:,jk) = tmask(:,:,jk) * ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) )
-         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
-         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   
-            ELSE                                      ! no cavities: only at the ocean surface
-               zwx(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)
-            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
-         !                                ! send trends for diagnostic
-         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR.     &
-            &( cdtype == 'TRC' .AND. l_trdtrc )      )   &
-            CALL trd_tra( kt, cdtype, jn, jptra_zad, zwx, pwn, ptb(:,:,:,jn) )
-         !
-      END DO                     ! end of tracer loop
-      !
-      CALL wrk_dealloc( jpi,jpj,jpk,   zslpx, zslpy, zwx, zwy )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_mus')
-      !
-   END SUBROUTINE tra_adv_mus
-
-   !!======================================================================
-END MODULE traadv_mus
Index: branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
===================================================================
--- branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90	(revision 6827)
+++ 	(revision )
@@ -1,479 +1,0 @@
-MODULE traadv_qck
-   !!==============================================================================
-   !!                       ***  MODULE  traadv_qck  ***
-   !! Ocean tracers:  horizontal & vertical advective trend
-   !!==============================================================================
-   !! History :  3.0  !  2008-07  (G. Reffray)  Original code
-   !!            3.3  !  2010-05  (C.Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_adv_qck    : update the tracer trend with the horizontal advection
-   !!                    trends using a 3rd order finite difference scheme
-   !!   tra_adv_qck_i  : apply QUICK scheme in i-direction
-   !!   tra_adv_qck_j  : apply QUICK scheme in j-direction
-   !!   tra_adv_cen2_k : 2nd centered scheme for the vertical advection
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and active tracers
-   USE dom_oce         ! ocean space and time domain
-   USE trc_oce         ! share passive tracers/Ocean variables
-   USE trd_oce         ! trends: ocean variables
-   USE trdtra          ! trends manager: tracers 
-   USE diaptr          ! poleward transport diagnostics
-   !
-   USE lib_mpp         ! distribued memory computing
-   USE lbclnk          ! ocean lateral boundary condition (or mpp link)
-   USE in_out_manager  ! I/O manager
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
-   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_adv_qck   ! routine called by step.F90
-
-   LOGICAL  :: l_trd           ! flag to compute trends
-   REAL(wp) :: r1_6 = 1./ 6.   ! 1/6 ratio
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tra_adv_qck ( kt, kit000, cdtype, p2dt, pun, pvn, pwn,      &
-      &                                       ptb, ptn, pta, kjpt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_adv_qck  ***
-      !!
-      !! ** Purpose :   Compute the now trend due to the advection of tracers
-      !!      and add it to the general trend of passive tracer equations.
-      !!
-      !! ** Method :   The advection is evaluated by a third order scheme
-      !!             For a positive velocity u :              u(i)>0
-      !!                                          |--FU--|--FC--|--FD--|------|
-      !!                                             i-1    i      i+1   i+2
-      !!
-      !!             For a negative velocity u :              u(i)<0
-      !!                                          |------|--FD--|--FC--|--FU--|
-      !!                                             i-1    i      i+1   i+2
-      !!             where  FU is the second upwind point
-      !!                    FD is the first douwning point
-      !!                    FC is the central point (or the first upwind point)
-      !!
-      !!      Flux(i) = u(i) * { 0.5(FC+FD)  -0.5C(i)(FD-FC)  -((1-C(i))/6)(FU+FD-2FC) }
-      !!                with C(i)=|u(i)|dx(i)/dt (=Courant number)
-      !!
-      !!         dt = 2*rdtra and the scalar values are tb and sb
-      !!
-      !!       On the vertical, the simple centered scheme used ptn
-      !!
-      !!               The fluxes are bounded by the ULTIMATE limiter to
-      !!             guarantee the monotonicity of the solution and to
-      !!            prevent the appearance of spurious numerical oscillations
-      !!
-      !! ** Action : - update pta  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)
-      !!
-      !! ** 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 
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_adv_qck')
-      !
-      IF( kt == kit000 )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_adv_qck : 3rd order quickest advection scheme on ', cdtype
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
-         IF(lwp) WRITE(numout,*)
-      ENDIF
-      !
-      l_trd = .FALSE.
-      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .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 ) 
-
-      !        ! vertical fluxes are computed with the 2nd order centered scheme
-      CALL tra_adv_cen2_k( kt, cdtype, pwn,         ptn, pta, kjpt )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_qck')
-      !
-   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 
-      !!
-      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp) ::   ztra, zbtr, zdir, zdx, zmsk   ! local scalars
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwx, zfu, zfc, zfd
-      !----------------------------------------------------------------------
-      !
-      CALL wrk_alloc( jpi, jpj, jpk, zwx, zfu, zfc, zfd )
-      !                                                          ! ===========
-      DO jn = 1, kjpt                                            ! tracer loop
-         !                                                       ! ===========
-         zfu(:,:,:) = 0._wp     ;   zfc(:,:,:) = 0._wp 
-         zfd(:,:,:) = 0._wp     ;   zwx(:,:,:) = 0._wp   
-         !
-!!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
-         CALL lbc_lnk( zfc(:,:,:), 'T', 1. )   ;   CALL lbc_lnk( zfd(:,:,:), 'T', 1. )   ! Lateral boundary conditions 
-         
-         !
-         ! 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 
-         !--- Lateral boundary conditions 
-         CALL lbc_lnk( zfu(:,:,:), 'T', 1. )   ;   CALL lbc_lnk( zfd(:,:,:), 'T', 1. )
-         CALL lbc_lnk( zfc(:,:,:), 'T', 1. )   ;   CALL lbc_lnk( zwx(:,:,:), 'T', 1. )
-
-         !--- QUICKEST scheme
-         CALL quickest( zfu, zfd, zfc, zwx )
-         !
-         ! 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
-         CALL lbc_lnk( zfu(:,:,:), 'T', 1. )      ! Lateral boundary conditions 
-
-         !
-         ! Tracer flux on the x-direction
-         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
-         END DO
-         !
-         CALL lbc_lnk( zwx(:,:,:), 'T', 1. ) ! Lateral boundary conditions
-         !
-         ! 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
-         !                                 ! trend diagnostics
-         IF( l_trd )   CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) )
-         !
-      END DO
-      !
-      CALL wrk_dealloc( jpi, jpj, jpk, zwx, zfu, zfc, zfd )
-      !
-   END SUBROUTINE tra_adv_qck_i
-
-
-   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 
-      !!
-      INTEGER  :: ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp) :: ztra, zbtr, zdir, zdx, zmsk   ! local scalars
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwy, zfu, zfc, zfd
-      !----------------------------------------------------------------------
-      !
-      CALL wrk_alloc( jpi, jpj, jpk, zwy, zfu, zfc, zfd )
-      !
-      !                                                          ! ===========
-      DO jn = 1, kjpt                                            ! tracer loop
-         !                                                       ! ===========
-         zfu(:,:,:) = 0.0     ;   zfc(:,:,:) = 0.0  
-         zfd(:,:,:) = 0.0     ;   zwy(:,:,:) = 0.0     
-         !                                                  
-         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.
-                  ! 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
-         END DO
-         CALL lbc_lnk( zfc(:,:,:), 'T', 1. )   ;   CALL lbc_lnk( zfd(:,:,:), 'T', 1. )   ! Lateral boundary conditions 
-
-         
-         !
-         ! 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, 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
-
-         !--- Lateral boundary conditions 
-         CALL lbc_lnk( zfu(:,:,:), 'T', 1. )      ;     CALL lbc_lnk( zfd(:,:,:), 'T', 1. )
-         CALL lbc_lnk( zfc(:,:,:), 'T', 1. )      ;     CALL lbc_lnk( zwy(:,:,:), 'T', 1. )
-
-         !--- QUICKEST scheme
-         CALL quickest( zfu, zfd, zfc, zwy )
-         !
-         ! 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
-         !--- Lateral boundary conditions 
-         CALL lbc_lnk( zfu(:,:,:), 'T', 1. ) 
-         !
-         ! Tracer flux on the x-direction
-         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
-         END DO
-         !
-         CALL lbc_lnk( zwy(:,:,:), 'T', 1. ) ! Lateral boundary conditions
-         !
-         ! 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
-         !                                 ! trend diagnostics
-         IF( l_trd )   CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) )
-         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
-           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) )
-           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) )
-         ENDIF
-         !
-      END DO
-      !
-      CALL wrk_dealloc( jpi, jpj, jpk, zwy, zfu, zfc, zfd )
-      !
-   END SUBROUTINE tra_adv_qck_j
-
-
-   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 
-      !
-      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwz
-      !!----------------------------------------------------------------------
-      !
-      CALL wrk_alloc( jpi,jpj,jpk,   zwz )
-      !
-      zwz(:,:, 1 ) = 0._wp       ! surface & bottom values set to zero for all tracers
-      zwz(:,:,jpk) = 0._wp
-      !
-      !                                                          ! ===========
-      DO jn = 1, kjpt                                            ! tracer loop
-         !                                                       ! ===========
-         !
-         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
-         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   
-            ELSE                                   ! no ocean cavities (only ocean surface)
-               zwz(:,:,1) = pwn(:,:,1) * ptn(:,:,1,jn)
-            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
-         !                                 ! Send trends for diagnostic
-         IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pwn, ptn(:,:,:,jn) )
-         !
-      END DO
-      !
-      CALL wrk_dealloc( jpi,jpj,jpk,   zwz )
-      !
-   END SUBROUTINE tra_adv_cen2_k
-
-
-   SUBROUTINE quickest( pfu, pfd, pfc, puc )
-      !!----------------------------------------------------------------------
-      !!
-      !! ** Purpose :  Computation of advective flux with Quickest scheme
-      !!
-      !! ** Method :   
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pfu   ! second upwind point
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pfd   ! first douwning point
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pfc   ! the central point (or the first upwind point)
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   puc   ! input as Courant number ; output as flux
-      !!
-      INTEGER  ::  ji, jj, jk               ! dummy loop indices 
-      REAL(wp) ::  zcoef1, zcoef2, zcoef3   ! local scalars          
-      REAL(wp) ::  zc, zcurv, zfho          !   -      -
-      !----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('quickest')
-      !
-      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
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('quickest')
-      !
-   END SUBROUTINE quickest
-
-   !!======================================================================
-END MODULE traadv_qck
Index: branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
===================================================================
--- branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90	(revision 6827)
+++ 	(revision )
@@ -1,384 +1,0 @@
-MODULE traadv_ubs
-   !!==============================================================================
-   !!                       ***  MODULE  traadv_ubs  ***
-   !! Ocean active tracers:  horizontal & vertical advective trend
-   !!==============================================================================
-   !! History :  1.0  !  2006-08  (L. Debreu, R. Benshila)  Original code
-   !!            3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_adv_ubs : update the tracer trend with the horizontal
-   !!                 advection trends using a third order biaised scheme  
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and active tracers
-   USE dom_oce        ! ocean space and time domain
-   USE trc_oce        ! share passive tracers/Ocean variables
-   USE trd_oce        ! trends: ocean variables
-   USE traadv_fct      ! acces to routine interp_4th_cpt 
-   USE trdtra         ! trends manager: tracers 
-   USE diaptr         ! poleward transport diagnostics
-   !
-   USE lib_mpp        ! I/O library
-   USE lbclnk         ! ocean lateral boundary condition (or mpp link)
-   USE in_out_manager ! I/O manager
-   USE wrk_nemo       ! Memory Allocation
-   USE timing         ! Timing
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_adv_ubs   ! routine called by traadv module
-
-   LOGICAL :: l_trd  ! flag to compute trends or not
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tra_adv_ubs( kt, kit000, cdtype, p2dt, pun, pvn, pwn,          &
-      &                                                ptb, ptn, pta, kjpt, kn_ubs_v )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_adv_ubs  ***
-      !!                 
-      !! ** Purpose :   Compute the now trend due to the advection of tracers
-      !!      and add it to the general trend of passive tracer equations.
-      !!
-      !! ** Method  :   The 3rd order Upstream Biased Scheme (UBS) is based on an
-      !!      upstream-biased parabolic interpolation (Shchepetkin and McWilliams 2005)
-      !!      It is only used in the horizontal direction.
-      !!      For example the i-component of the advective fluxes are given by :
-      !!                !  e2u e3u un ( mi(Tn) - zltu(i  ) )   if un(i) >= 0
-      !!          ztu = !  or 
-      !!                !  e2u e3u un ( mi(Tn) - zltu(i+1) )   if un(i) < 0
-      !!      where zltu is the second derivative of the before temperature field:
-      !!          zltu = 1/e3t di[ e2u e3u / e1u di[Tb] ]
-      !!        This results in a dissipatively dominant (i.e. hyper-diffusive) 
-      !!      truncation error. The overall performance of the advection scheme 
-      !!      is similar to that reported in (Farrow and Stevens, 1995). 
-      !!        For stability reasons, the first term of the fluxes which corresponds
-      !!      to a second order centered scheme is evaluated using the now velocity 
-      !!      (centered in time) while the second term which is the diffusive part 
-      !!      of the scheme, is evaluated using the before velocity (forward in time). 
-      !!      Note that UBS is not positive. Do not use it on passive tracers.
-      !!                On the vertical, the advection is evaluated using a FCT scheme,
-      !!      as the UBS have been found to be too diffusive. 
-      !!                kn_ubs_v argument controles whether the FCT is based on 
-      !!      a 2nd order centrered scheme (kn_ubs_v=2) or on a 4th order compact 
-      !!      scheme (kn_ubs_v=4).
-      !!
-      !! ** Action : - update pta  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)
-      !!
-      !! 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  ::   ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp) ::   ztra, zbtr, zcoef                       ! local scalars
-      REAL(wp) ::   zfp_ui, zfm_ui, zcenut, ztak, zfp_wk, zfm_wk   !   -      -
-      REAL(wp) ::   zfp_vj, zfm_vj, zcenvt, zeeu, zeev, z_hdivn    !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztu, ztv, zltu, zltv, zti, ztw
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_adv_ubs')
-      !
-      CALL wrk_alloc( jpi,jpj,jpk,   ztu, ztv, zltu, zltv, zti, ztw )
-      !
-      IF( kt == kit000 )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_adv_ubs :  horizontal UBS advection scheme on ', cdtype
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
-      ENDIF
-      !
-      l_trd = .FALSE.
-      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
-      !
-      ztw (:,:, 1 ) = 0._wp      ! surface & bottom value : set to zero for all tracers
-      zltu(:,:,jpk) = 0._wp   ;   zltv(:,:,jpk) = 0._wp
-      ztw (:,:,jpk) = 0._wp   ;   zti (:,:,jpk) = 0._wp
-      !
-      !                                                          ! ===========
-      DO jn = 1, kjpt                                            ! tracer loop
-         !                                                       ! ===========
-         !                                              
-         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
-            !                                    
-         END DO         
-         CALL lbc_lnk( zltu, 'T', 1. )   ;    CALL lbc_lnk( 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 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
-            !                                             
-         END DO
-         !
-         zltu(:,:,:) = pta(:,:,:,jn) - 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) )
-         END IF
-         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
-            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( ztv(:,:,:) )
-            IF( jn == jp_sal )  str_adv(:) = ptr_sj( ztv(:,:,:) )
-         ENDIF
-         !
-         !                       !== vertical advective trend  ==!
-         !
-         SELECT CASE( kn_ubs_v )       ! select the vertical advection scheme
-         !
-         CASE(  2  )                   ! 2nd order FCT 
-            !         
-            IF( l_trd )   zltv(:,:,:) = pta(:,:,:,jn)          ! store pta 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 
-            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   
-               ELSE                                ! no cavities: only at the ocean surface
-                  ztw(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)
-               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
-            CALL lbc_lnk( 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
-            !                                            ! 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
-            !
-         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
-            !
-         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
-         !
-         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 )
-         ENDIF
-         !
-      END DO
-      !
-      CALL wrk_dealloc( jpi,jpj,jpk,   ztu, ztv, zltu, zltv, zti, ztw )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_ubs')
-      !
-   END SUBROUTINE tra_adv_ubs
-
-
-   SUBROUTINE nonosc_z( pbef, pcc, paft, p2dt )
-      !!---------------------------------------------------------------------
-      !!                    ***  ROUTINE nonosc_z  ***
-      !!     
-      !! **  Purpose :   compute monotonic tracer fluxes from the upstream 
-      !!       scheme and the before field by a nonoscillatory algorithm 
-      !!
-      !! **  Method  :   ... ???
-      !!       warning : pbef and paft must be masked, but the boundaries
-      !!       conditions on the fluxes are not necessary zalezak (1979)
-      !!       drange (1995) multi-dimensional forward-in-time and upstream-
-      !!       in-space based differencing for fluid
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in   )                          ::   p2dt   ! tracer time-step
-      REAL(wp),                DIMENSION (jpi,jpj,jpk) ::   pbef   ! before field
-      REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) ::   paft   ! after field
-      REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) ::   pcc    ! monotonic flux in the k direction
-      !
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      INTEGER  ::   ikm1         ! local integer
-      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn   ! local scalars
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zbetup, zbetdo
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('nonosc_z')
-      !
-      CALL wrk_alloc( jpi,jpj,jpk,   zbetup, zbetdo )
-      !
-      zbig  = 1.e+40_wp
-      zrtrn = 1.e-15_wp
-      zbetup(:,:,:) = 0._wp   ;   zbetdo(:,:,:) = 0._wp
-      !
-      ! Search local extrema
-      ! --------------------
-      !                    ! large negative value (-zbig) inside land
-      pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:) - zbig * ( 1.e0 - tmask(:,:,:) )
-      paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) - zbig * ( 1.e0 - tmask(:,:,:) )
-      !
-      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
-      END DO
-      !                    ! large positive value (+zbig) inside land
-      pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:) + zbig * ( 1.e0 - tmask(:,:,:) )
-      paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) + zbig * ( 1.e0 - tmask(:,:,:) )
-      !
-      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
-      END DO
-      !                    ! restore masked values to zero
-      pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:)
-      paft(:,:,:) = paft(:,:,:) * tmask(:,:,:)
-      !
-      ! 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
-      !
-      ! 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
-      !
-      CALL wrk_dealloc( jpi,jpj,jpk,   zbetup, zbetdo )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('nonosc_z')
-      !
-   END SUBROUTINE nonosc_z
-
-   !!======================================================================
-END MODULE traadv_ubs
Index: branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90
===================================================================
--- branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90	(revision 6827)
+++ 	(revision )
@@ -1,195 +1,0 @@
-MODULE trabbc
-   !!==============================================================================
-   !!                       ***  MODULE  trabbc  ***
-   !! Ocean active tracers:  bottom boundary condition (geothermal heat flux)
-   !!==============================================================================
-   !! History :  OPA  ! 1999-10 (G. Madec)  original code
-   !!   NEMO     1.0  ! 2002-08 (G. Madec)  free form + modules
-   !!             -   ! 2002-11 (A. Bozec)  tra_bbc_init: original code
-   !!            3.3  ! 2010-10 (G. Madec)  dynamical allocation + suppression of key_trabbc
-   !!             -   ! 2010-11 (G. Madec)  use mbkt array (deepest ocean t-level)
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_bbc       : update the tracer trend at ocean bottom 
-   !!   tra_bbc_init  : initialization of geothermal heat flux trend
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean variables
-   USE dom_oce        ! domain: ocean
-   USE phycst         ! physical constants
-   USE trd_oce        ! trends: ocean variables
-   USE trdtra         ! trends manager: tracers 
-   !
-   USE in_out_manager ! I/O manager
-   USE iom            ! xIOS 
-   USE fldread        ! read input fields
-   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
-   USE lib_mpp        ! distributed memory computing library
-   USE prtctl         ! Print control
-   USE wrk_nemo       ! Memory Allocation
-   USE timing         ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC tra_bbc          ! routine called by step.F90
-   PUBLIC tra_bbc_init     ! routine called by opa.F90
-
-   !                                 !!* Namelist nambbc: bottom boundary condition *
-   LOGICAL, PUBLIC ::   ln_trabbc     !: Geothermal heat flux flag
-   INTEGER         ::   nn_geoflx     !  Geothermal flux (=1:constant flux, =2:read in file )
-   REAL(wp)        ::   rn_geoflx_cst !  Constant value of geothermal heat flux
-
-   REAL(wp), PUBLIC , ALLOCATABLE, DIMENSION(:,:) ::   qgh_trd0   ! geothermal heating trend
-
-   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_qgh   ! structure of input qgh (file informations, fields read)
- 
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tra_bbc( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_bbc  ***
-      !!
-      !! ** Purpose :   Compute the bottom boundary contition on temperature 
-      !!              associated with geothermal heating and add it to the 
-      !!              general trend of temperature equations.
-      !!
-      !! ** Method  :   The geothermal heat flux set to its constant value of 
-      !!              86.4 mW/m2 (Stein and Stein 1992, Huang 1999).
-      !!       The temperature trend associated to this heat flux through the
-      !!       ocean bottom can be computed once and is added to the temperature
-      !!       trend juste above the bottom at each time step:
-      !!            ta = ta + Qsf / (rau0 rcp e3T) for k= mbkt
-      !!       Where Qsf is the geothermal heat flux.
-      !!
-      !! ** Action  : - update the temperature trends with geothermal heating trend
-      !!              - send the trend for further diagnostics (ln_trdtra=T)
-      !!
-      !! References : Stein, C. A., and S. Stein, 1992, Nature, 359, 123-129.
-      !!              Emile-Geay and Madec, 2009, Ocean Science.
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
-      !
-      INTEGER  ::   ji, jj    ! dummy loop indices
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdt
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_bbc')
-      !
-      IF( l_trdtra )   THEN         ! Save the input temperature trend
-         CALL wrk_alloc( jpi,jpj,jpk,   ztrdt )
-         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
-      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
-      !
-      CALL lbc_lnk( tsa(:,:,:,jp_tem) , '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 )
-         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdt )
-      ENDIF
-      !
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbc  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_bbc')
-      !
-   END SUBROUTINE tra_bbc
-
-
-   SUBROUTINE tra_bbc_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_bbc_init  ***
-      !!
-      !! ** Purpose :   Compute once for all the trend associated with geothermal
-      !!              heating that will be applied at each time step at the
-      !!              last ocean level
-      !!
-      !! ** Method  :   Read the nambbc namelist and check the parameters.
-      !!
-      !! ** Input   : - Namlist nambbc
-      !!              - NetCDF file  : geothermal_heating.nc ( if necessary )
-      !!
-      !! ** Action  : - read/fix the geothermal heat qgh_trd0
-      !!----------------------------------------------------------------------
-      INTEGER  ::   ji, jj              ! dummy loop indices
-      INTEGER  ::   inum                ! temporary logical unit
-      INTEGER  ::   ios                 ! Local integer output status for namelist read
-      INTEGER  ::   ierror              ! local integer
-      !
-      TYPE(FLD_N)        ::   sn_qgh    ! informations about the geotherm. field to be read
-      CHARACTER(len=256) ::   cn_dir    ! Root directory for location of ssr files
-      !
-      NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst, sn_qgh, cn_dir 
-      !!----------------------------------------------------------------------
-      !
-      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', lwp )
-      !
-      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', lwp )
-      IF(lwm) WRITE ( numond, nambbc )
-      !
-      IF(lwp) THEN                     ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'tra_bbc : Bottom Boundary Condition (bbc), apply a Geothermal heating'
-         WRITE(numout,*) '~~~~~~~   '
-         WRITE(numout,*) '   Namelist nambbc : set bbc parameters'
-         WRITE(numout,*) '      Apply a geothermal heating at ocean bottom   ln_trabbc     = ', ln_trabbc
-         WRITE(numout,*) '      type of geothermal flux                      nn_geoflx     = ', nn_geoflx
-         WRITE(numout,*) '      Constant geothermal flux value               rn_geoflx_cst = ', rn_geoflx_cst
-         WRITE(numout,*)
-      ENDIF
-      !
-      IF( ln_trabbc ) THEN             !==  geothermal heating  ==!
-         !
-         ALLOCATE( qgh_trd0(jpi,jpj) )    ! allocation
-         !
-         SELECT CASE ( nn_geoflx )        ! geothermal heat flux / (rauO * Cp)
-         !
-         CASE ( 1 )                          !* constant flux
-            IF(lwp) WRITE(numout,*) '      *** constant heat flux  =   ', rn_geoflx_cst
-            qgh_trd0(:,:) = r1_rau0_rcp * rn_geoflx_cst
-            !
-         CASE ( 2 )                          !* variable geothermal heat flux : read the geothermal fluxes in mW/m2
-            IF(lwp) WRITE(numout,*) '      *** variable geothermal heat flux'
-            !
-            ALLOCATE( sf_qgh(1), STAT=ierror )
-            IF( ierror > 0 ) THEN
-               CALL ctl_stop( 'tra_bbc_init: unable to allocate sf_qgh structure' )   ;
-               RETURN
-            ENDIF
-            ALLOCATE( sf_qgh(1)%fnow(jpi,jpj,1)   )
-            IF( sn_qgh%ln_tint )ALLOCATE( sf_qgh(1)%fdta(jpi,jpj,1,2) )
-            ! fill sf_chl with sn_chl and control print
-            CALL fld_fill( sf_qgh, (/ sn_qgh /), cn_dir, 'tra_bbc_init',   &
-               &          'bottom temperature boundary condition', 'nambbc' )
-
-            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
-            !
-         CASE DEFAULT
-            WRITE(ctmp1,*) '     bad flag value for nn_geoflx = ', nn_geoflx
-            CALL ctl_stop( ctmp1 )
-         END SELECT
-         !
-      ELSE
-         IF(lwp) WRITE(numout,*) '      *** no geothermal heat flux'
-      ENDIF
-      !
-   END SUBROUTINE tra_bbc_init
-
-   !!======================================================================
-END MODULE trabbc
Index: branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
===================================================================
--- branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90	(revision 6827)
+++ 	(revision )
@@ -1,610 +1,0 @@
-MODULE trabbl
-   !!==============================================================================
-   !!                       ***  MODULE  trabbl  ***
-   !! Ocean physics :  advective and/or diffusive bottom boundary layer scheme
-   !!==============================================================================
-   !! History :  OPA  ! 1996-06  (L. Mortier)  Original code
-   !!            8.0  ! 1997-11  (G. Madec)    Optimization
-   !!   NEMO     1.0  ! 2002-08  (G. Madec)  free form + modules
-   !!             -   ! 2004-01  (A. de Miranda, G. Madec, J.M. Molines ) add advective bbl
-   !!            3.3  ! 2009-11  (G. Madec)  merge trabbl and trabbl_adv + style + optimization
-   !!             -   ! 2010-04  (G. Madec)  Campin & Goosse advective bbl
-   !!             -   ! 2010-06  (C. Ethe, G. Madec)  merge TRA-TRC
-   !!             -   ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level
-   !!             -   ! 2013-04  (F. Roquet, G. Madec)  use of eosbn2 instead of local hard coded alpha and beta
-   !!----------------------------------------------------------------------
-#if   defined key_trabbl
-   !!----------------------------------------------------------------------
-   !!   'key_trabbl'   or                             bottom boundary layer
-   !!----------------------------------------------------------------------
-   !!   tra_bbl_alloc : allocate trabbl arrays
-   !!   tra_bbl       : update the tracer trends due to the bottom boundary layer (advective and/or diffusive)
-   !!   tra_bbl_dif   : generic routine to compute bbl diffusive trend
-   !!   tra_bbl_adv   : generic routine to compute bbl advective trend
-   !!   bbl           : computation of bbl diffu. flux coef. & transport in bottom boundary layer
-   !!   tra_bbl_init  : initialization, namelist read, parameters control
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and active tracers
-   USE dom_oce        ! ocean space and time domain
-   USE phycst         ! physical constant
-   USE eosbn2         ! equation of state
-   USE trd_oce        ! trends: ocean variables
-   USE trdtra         ! trends: active tracers
-   !
-   USE iom            ! IOM library               
-   USE in_out_manager ! I/O manager
-   USE lbclnk         ! ocean lateral boundary conditions
-   USE prtctl         ! Print control
-   USE wrk_nemo       ! Memory Allocation
-   USE timing         ! Timing
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_bbl       !  routine called by step.F90
-   PUBLIC   tra_bbl_init  !  routine called by opa.F90
-   PUBLIC   tra_bbl_dif   !  routine called by trcbbl.F90
-   PUBLIC   tra_bbl_adv   !  -          -          -              -
-   PUBLIC   bbl           !  routine called by trcbbl.F90 and dtadyn.F90
-
-   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl = .TRUE.    !: bottom boundary layer flag
-
-   !                                !!* Namelist nambbl *
-   INTEGER , PUBLIC ::   nn_bbl_ldf  !: =1   : diffusive bbl or not (=0)
-   INTEGER , PUBLIC ::   nn_bbl_adv  !: =1/2 : advective bbl or not (=0)
-   !                                            !  =1 : advective bbl using the bottom ocean velocity
-   !                                            !  =2 :     -      -  using utr_bbl proportional to grad(rho)
-   REAL(wp), PUBLIC ::   rn_ahtbbl   !: along slope bbl diffusive coefficient [m2/s]
-   REAL(wp), PUBLIC ::   rn_gambbl   !: lateral coeff. for bottom boundary layer scheme [s]
-
-   LOGICAL , PUBLIC ::   l_bbl       !: flag to compute bbl diffu. flux coef and transport
-
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   utr_bbl  , vtr_bbl   ! u- (v-) transport in the bottom boundary layer
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   ahu_bbl  , ahv_bbl   ! masked diffusive bbl coeff. at u & v-pts
-
-   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   mbku_d   , mbkv_d      ! vertical index of the "lower" bottom ocean U/V-level (PUBLIC for TAM)
-   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   mgrhu    , mgrhv       ! = +/-1, sign of grad(H) in u-(v-)direction (PUBLIC for TAM)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   ahu_bbl_0, ahv_bbl_0   ! diffusive bbl flux coefficients at u and v-points
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   e3u_bbl_0, e3v_bbl_0   ! thichness of the bbl (e3) at u and v-points (PUBLIC for TAM)
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   INTEGER FUNCTION tra_bbl_alloc()
-      !!----------------------------------------------------------------------
-      !!                ***  FUNCTION tra_bbl_alloc  ***
-      !!----------------------------------------------------------------------
-      ALLOCATE( utr_bbl  (jpi,jpj) , ahu_bbl  (jpi,jpj) , mbku_d  (jpi,jpj) , mgrhu(jpi,jpj) ,     &
-         &      vtr_bbl  (jpi,jpj) , ahv_bbl  (jpi,jpj) , mbkv_d  (jpi,jpj) , mgrhv(jpi,jpj) ,     &
-         &      ahu_bbl_0(jpi,jpj) , ahv_bbl_0(jpi,jpj) ,                                          &
-         &      e3u_bbl_0(jpi,jpj) , e3v_bbl_0(jpi,jpj) ,                                      STAT=tra_bbl_alloc )
-         !
-      IF( lk_mpp            )   CALL mpp_sum ( tra_bbl_alloc )
-      IF( tra_bbl_alloc > 0 )   CALL ctl_warn('tra_bbl_alloc: allocation of arrays failed.')
-   END FUNCTION tra_bbl_alloc
-
-
-   SUBROUTINE tra_bbl( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE bbl  ***
-      !!
-      !! ** Purpose :   Compute the before tracer (t & s) trend associated
-      !!              with the bottom boundary layer and add it to the general
-      !!              trend of tracer equations.
-      !!
-      !! ** Method  :   Depending on namtra_bbl namelist parameters the bbl
-      !!              diffusive and/or advective contribution to the tracer trend
-      !!              is added to the general tracer trend
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt   ! ocean time-step
-      !
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start( 'tra_bbl')
-      !
-      IF( l_trdtra )   THEN                         !* Save the input trends
-         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )
-         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)
-
-      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' )
-         ! lateral boundary conditions ; just need for outputs
-         CALL lbc_lnk( ahu_bbl, 'U', 1. )     ;     CALL lbc_lnk( ahv_bbl, 'V', 1. )
-         CALL iom_put( "ahu_bbl", ahu_bbl )   ! bbl diffusive flux i-coef
-         CALL iom_put( "ahv_bbl", ahv_bbl )   ! bbl diffusive flux j-coef
-         !
-      END IF
-      !
-      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' )
-         ! lateral boundary conditions ; just need for outputs
-         CALL lbc_lnk( utr_bbl, 'U', 1. )     ;   CALL lbc_lnk( vtr_bbl, 'V', 1. )
-         CALL iom_put( "uoce_bbl", utr_bbl )  ! bbl i-transport
-         CALL iom_put( "voce_bbl", vtr_bbl )  ! bbl j-transport
-         !
-      END IF
-
-      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 )
-         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )
-      ENDIF
-      !
-      IF( nn_timing == 1 )  CALL timing_stop( 'tra_bbl')
-      !
-   END SUBROUTINE tra_bbl
-
-
-   SUBROUTINE tra_bbl_dif( ptb, pta, kjpt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_bbl_dif  ***
-      !!
-      !! ** Purpose :   Computes the bottom boundary horizontal and vertical
-      !!                advection terms.
-      !!
-      !! ** Method  : * diffusive bbl only (nn_bbl_ldf=1) :
-      !!        When the product grad( rho) * grad(h) < 0 (where grad is an
-      !!      along bottom slope gradient) an additional lateral 2nd order
-      !!      diffusion along the bottom slope is added to the general
-      !!      tracer trend, otherwise the additional trend is set to 0.
-      !!      A typical value of ahbt is 2000 m2/s (equivalent to
-      !!      a downslope velocity of 20 cm/s if the condition for slope
-      !!      convection is satified)
-      !!
-      !! ** Action  :   pta   increased by the bbl diffusive trend
-      !!
-      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
-      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430.
-      !!----------------------------------------------------------------------
-      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
-      !
-      INTEGER  ::   ji, jj, jn   ! dummy loop indices
-      INTEGER  ::   ik           ! local integers
-      REAL(wp) ::   zbtr         ! local scalars
-      REAL(wp), POINTER, DIMENSION(:,:) :: zptb
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_bbl_dif')
-      !
-      CALL wrk_alloc( jpi, jpj, zptb )
-      !
-      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 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
-         !                                                  ! ===========
-      END DO                                                ! end tracer
-      !                                                     ! ===========
-      CALL wrk_dealloc( jpi, jpj, zptb )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_bbl_dif')
-      !
-   END SUBROUTINE tra_bbl_dif
-
-
-   SUBROUTINE tra_bbl_adv( ptb, pta, kjpt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_bbl  ***
-      !!
-      !! ** Purpose :   Compute the before passive tracer trend associated
-      !!     with the bottom boundary layer and add it to the general trend
-      !!     of tracer equations.
-      !! ** Method  :   advective bbl (nn_bbl_adv = 1 or 2) :
-      !!      nn_bbl_adv = 1   use of the ocean near bottom velocity as bbl velocity
-      !!      nn_bbl_adv = 2   follow Campin and Goosse (1999) implentation i.e.
-      !!                       transport proportional to the along-slope density gradient
-      !!
-      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
-      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430.
-      !!----------------------------------------------------------------------
-      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
-      !
-      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices
-      INTEGER  ::   iis , iid , ijs , ijd    ! local integers
-      INTEGER  ::   ikus, ikud, ikvs, ikvd   !   -       -
-      REAL(wp) ::   zbtr, ztra               ! local scalars
-      REAL(wp) ::   zu_bbl, zv_bbl           !   -      -
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start( 'tra_bbl_adv')
-      !                                                          ! ===========
-      DO jn = 1, kjpt                                            ! tracer loop
-         !                                                       ! ===========
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1            ! CAUTION start from i=1 to update i=2 when cyclic east-west
-               IF( utr_bbl(ji,jj) /= 0.e0 ) THEN            ! non-zero i-direction bbl advection
-                  ! down-slope i/k-indices (deep)      &   up-slope i/k indices (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)
-                  zu_bbl = ABS( utr_bbl(ji,jj) )
-                  !
-                  !                                               ! 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
-                  !
-                  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
-                  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
-               ENDIF
-               !
-               IF( vtr_bbl(ji,jj) /= 0.e0 ) THEN            ! non-zero j-direction bbl advection
-                  ! down-slope j/k-indices (deep)        &   up-slope j/k indices (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)
-                  zv_bbl = ABS( vtr_bbl(ji,jj) )
-                  !
-                  ! 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
-                  !
-                  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
-                  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
-               ENDIF
-            END DO
-            !
-         END DO
-         !                                                       ! ===========
-      END DO                                                     ! end tracer
-      !                                                          ! ===========
-      IF( nn_timing == 1 )  CALL timing_stop( 'tra_bbl_adv')
-      !
-   END SUBROUTINE tra_bbl_adv
-
-
-   SUBROUTINE bbl( kt, kit000, cdtype )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE bbl  ***
-      !!
-      !! ** Purpose :   Computes the bottom boundary horizontal and vertical
-      !!                advection terms.
-      !!
-      !! ** Method  : * diffusive bbl (nn_bbl_ldf=1) :
-      !!        When the product grad( rho) * grad(h) < 0 (where grad is an
-      !!      along bottom slope gradient) an additional lateral 2nd order
-      !!      diffusion along the bottom slope is added to the general
-      !!      tracer trend, otherwise the additional trend is set to 0.
-      !!      A typical value of ahbt is 2000 m2/s (equivalent to
-      !!      a downslope velocity of 20 cm/s if the condition for slope
-      !!      convection is satified)
-      !!              * advective bbl (nn_bbl_adv=1 or 2) :
-      !!      nn_bbl_adv = 1   use of the ocean velocity as bbl velocity
-      !!      nn_bbl_adv = 2   follow Campin and Goosse (1999) implentation
-      !!        i.e. transport proportional to the along-slope density gradient
-      !!
-      !!      NB: the along slope density gradient is evaluated using the
-      !!      local density (i.e. referenced at a common local depth).
-      !!
-      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
-      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430.
-      !!----------------------------------------------------------------------
-      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  ::   ji, jj                    ! dummy loop indices
-      INTEGER  ::   ik                        ! local integers
-      INTEGER  ::   iis, iid, ikus, ikud      !   -       -
-      INTEGER  ::   ijs, ijd, ikvs, ikvd      !   -       -
-      REAL(wp) ::   za, zb, zgdrho            ! local scalars
-      REAL(wp) ::   zsign, zsigna, zgbbl      !   -      -
-      REAL(wp), DIMENSION(jpi,jpj,jpts)   :: zts, zab         ! 3D workspace
-      REAL(wp), DIMENSION(jpi,jpj)        :: zub, zvb, zdep   ! 2D workspace
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start( 'bbl')
-      !
-      IF( kt == kit000 )  THEN
-         IF(lwp)  WRITE(numout,*)
-         IF(lwp)  WRITE(numout,*) 'trabbl:bbl : Compute bbl velocities and diffusive coefficients in ', cdtype
-         IF(lwp)  WRITE(numout,*) '~~~~~~~~~~'
-      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 )
-      !
-      !                                   !-------------------!
-      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
-         !
-      ENDIF
-      !
-      !                                   !-------------------!
-      IF( nn_bbl_adv /= 0 ) THEN          !   advective bbl   !
-         !                                !-------------------!
-         SELECT CASE ( nn_bbl_adv )             !* bbl transport type
-         !
-         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
-            !
-         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
-         END SELECT
-         !
-      ENDIF
-      !
-      IF( nn_timing == 1 )  CALL timing_stop( 'bbl')
-      !
-   END SUBROUTINE bbl
-
-
-   SUBROUTINE tra_bbl_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_bbl_init  ***
-      !!
-      !! ** Purpose :   Initialization for the bottom boundary layer scheme.
-      !!
-      !! ** Method  :   Read the nambbl namelist and check the parameters
-      !!              called by nemo_init at the first timestep (kit000)
-      !!----------------------------------------------------------------------
-      INTEGER ::   ji, jj               ! dummy loop indices
-      INTEGER ::   ii0, ii1, ij0, ij1   ! local integer
-      INTEGER ::   ios                  !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:) :: zmbk
-      !
-      NAMELIST/nambbl/ nn_bbl_ldf, nn_bbl_adv, rn_ahtbbl, rn_gambbl
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start( 'tra_bbl_init')
-      !
-      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', lwp )
-      !
-      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', lwp )
-      IF(lwm) WRITE ( numond, nambbl )
-      !
-      l_bbl = .TRUE.                 !* flag to compute bbl coef and transport
-      !
-      IF(lwp) THEN                   !* Parameter control and print
-         WRITE(numout,*)
-         WRITE(numout,*) 'tra_bbl_init : bottom boundary layer initialisation'
-         WRITE(numout,*) '~~~~~~~~~~~~'
-         WRITE(numout,*) '       Namelist nambbl : set bbl parameters'
-         WRITE(numout,*) '          diffusive bbl (=1)   or not (=0)    nn_bbl_ldf = ', nn_bbl_ldf
-         WRITE(numout,*) '          advective bbl (=1/2) or not (=0)    nn_bbl_adv = ', nn_bbl_adv
-         WRITE(numout,*) '          diffusive bbl coefficient           rn_ahtbbl  = ', rn_ahtbbl, ' m2/s'
-         WRITE(numout,*) '          advective bbl coefficient           rn_gambbl  = ', rn_gambbl, ' s'
-      ENDIF
-
-      !                              ! allocate trabbl arrays
-      IF( tra_bbl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_bbl_init : unable to allocate arrays' )
-
-      IF( nn_bbl_adv == 1 )    WRITE(numout,*) '       * Advective BBL using upper velocity'
-      IF( nn_bbl_adv == 2 )    WRITE(numout,*) '       * Advective BBL using velocity = F( delta rho)'
-
-      !                             !* 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
-      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk
-      CALL wrk_alloc( jpi, jpj, zmbk )
-      zmbk(:,:) = REAL( mbku_d(:,:), wp )   ;   CALL lbc_lnk(zmbk,'U',1.)   ;   mbku_d(:,:) = MAX( INT( zmbk(:,:) ), 1 )
-      zmbk(:,:) = REAL( mbkv_d(:,:), wp )   ;   CALL lbc_lnk(zmbk,'V',1.)   ;   mbkv_d(:,:) = MAX( INT( zmbk(:,:) ), 1 )
-      CALL wrk_dealloc( jpi, jpj, zmbk )
-
-                                        !* sign of grad(H) at u- and v-points
-      mgrhu(jpi,:) = 0   ;   mgrhu(:,jpj) = 0   ;   mgrhv(jpi,:) = 0   ;   mgrhv(:,jpj) = 0
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-            mgrhu(ji,jj) = INT(  SIGN( 1.e0, gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) )  )
-            mgrhv(ji,jj) = INT(  SIGN( 1.e0, gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) )  )
-         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
-      CALL lbc_lnk( e3u_bbl_0, 'U', 1. )   ;   CALL lbc_lnk( e3v_bbl_0, 'V', 1. )      ! lateral boundary conditions
-
-      !                             !* masked diffusive flux coefficients
-      ahu_bbl_0(:,:) = rn_ahtbbl * e2_e1u(:,:) * e3u_bbl_0(:,:) * umask(:,:,1)
-      ahv_bbl_0(:,:) = rn_ahtbbl * e1_e2v(:,:) * e3v_bbl_0(:,:) * vmask(:,:,1)
-
-
-      IF( cp_cfg == "orca" ) THEN   !* ORCA configuration : regional enhancement of ah_bbl
-         !
-         SELECT CASE ( jp_cfg )
-         CASE ( 2 )                          ! ORCA_R2
-            ij0 = 102   ;   ij1 = 102              ! Gibraltar enhancement of BBL
-            ii0 = 139   ;   ii1 = 140
-            ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
-            ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
-            !
-            ij0 =  88   ;   ij1 =  88              ! Red Sea enhancement of BBL
-            ii0 = 161   ;   ii1 = 162
-            ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 10.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
-            ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 10.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
-            !
-         CASE ( 4 )                          ! ORCA_R4
-            ij0 =  52   ;   ij1 =  52              ! Gibraltar enhancement of BBL
-            ii0 =  70   ;   ii1 =  71
-            ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
-            ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
-         END SELECT
-         !
-      ENDIF
-      !
-      IF( nn_timing == 1 )  CALL timing_stop( 'tra_bbl_init')
-      !
-   END SUBROUTINE tra_bbl_init
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Dummy module :                      No bottom boundary layer scheme
-   !!----------------------------------------------------------------------
-   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl = .FALSE.   !: bbl flag
-CONTAINS
-   SUBROUTINE tra_bbl_init               ! Dummy routine
-   END SUBROUTINE tra_bbl_init
-   SUBROUTINE tra_bbl( kt )              ! Dummy routine
-      WRITE(*,*) 'tra_bbl: You should not have seen this print! error?', kt
-   END SUBROUTINE tra_bbl
-#endif
-
-   !!======================================================================
-END MODULE trabbl
Index: branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90
===================================================================
--- branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90	(revision 6827)
+++ 	(revision )
@@ -1,231 +1,0 @@
-MODULE tradmp
-   !!======================================================================
-   !!                       ***  MODULE  tradmp  ***
-   !! Ocean physics: internal restoring trend on active tracers (T and S)
-   !!======================================================================
-   !! History :  OPA  ! 1991-03  (O. Marti, G. Madec)  Original code
-   !!                 ! 1992-06  (M. Imbard)  doctor norme
-   !!                 ! 1998-07  (M. Imbard, G. Madec) ORCA version
-   !!            7.0  ! 2001-02  (M. Imbard)  add distance to coast, Original code
-   !!            8.1  ! 2001-02  (G. Madec, E. Durand)  cleaning
-   !!  NEMO      1.0  ! 2002-08  (G. Madec, E. Durand)  free form + modules
-   !!            3.2  ! 2009-08  (G. Madec, C. Talandier)  DOCTOR norm for namelist parameter
-   !!            3.3  ! 2010-06  (C. Ethe, G. Madec) merge TRA-TRC 
-   !!            3.4  ! 2011-04  (G. Madec, C. Ethe) Merge of dtatem and dtasal + suppression of CPP keys
-   !!            3.6  ! 2015-06  (T. Graham)  read restoring coefficient in a file
-   !!            3.7  ! 2015-10  (G. Madec)  remove useless trends arrays
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_dmp_alloc : allocate tradmp arrays
-   !!   tra_dmp       : update the tracer trend with the internal damping
-   !!   tra_dmp_init  : initialization, namlist read, parameters control
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean: variables
-   USE dom_oce        ! ocean: domain variables
-   USE c1d            ! 1D vertical configuration
-   USE trd_oce        ! trends: ocean variables
-   USE trdtra         ! trends manager: tracers 
-   USE zdf_oce        ! ocean: vertical physics
-   USE phycst         ! physical constants
-   USE dtatsd         ! data: temperature & salinity
-   USE zdfmxl         ! vertical physics: mixed layer depth
-   !
-   USE in_out_manager ! I/O manager
-   USE lib_mpp        ! MPP library
-   USE prtctl         ! Print control
-   USE wrk_nemo       ! Memory allocation
-   USE timing         ! Timing
-   USE iom
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_dmp        ! called by step.F90
-   PUBLIC   tra_dmp_init   ! called by nemogcm.F90
-
-   !                                           !!* Namelist namtra_dmp : T & S newtonian damping *
-   LOGICAL            , PUBLIC ::   ln_tradmp   !: internal damping flag
-   INTEGER            , PUBLIC ::   nn_zdmp     !: = 0/1/2 flag for damping in the mixed layer
-   CHARACTER(LEN=200) , PUBLIC ::   cn_resto    !: name of netcdf file containing restoration coefficient field
-   !
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   resto    !: restoring coeff. on T and S (s-1)
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   INTEGER FUNCTION tra_dmp_alloc()
-      !!----------------------------------------------------------------------
-      !!                ***  FUNCTION tra_dmp_alloc  ***
-      !!----------------------------------------------------------------------
-      ALLOCATE( resto(jpi,jpj,jpk), STAT= tra_dmp_alloc )
-      !
-      IF( lk_mpp            )   CALL mpp_sum ( tra_dmp_alloc )
-      IF( tra_dmp_alloc > 0 )   CALL ctl_warn('tra_dmp_alloc: allocation of arrays failed')
-      !
-   END FUNCTION tra_dmp_alloc
-
-
-   SUBROUTINE tra_dmp( kt )
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE tra_dmp  ***
-      !!                  
-      !! ** Purpose :   Compute the tracer trend due to a newtonian damping
-      !!      of the tracer field towards given data field and add it to the
-      !!      general tracer trends.
-      !!
-      !! ** Method  :   Newtonian damping towards t_dta and s_dta computed 
-      !!      and add to the general tracer trends:
-      !!                     ta = ta + resto * (t_dta - tb)
-      !!                     sa = sa + resto * (s_dta - sb)
-      !!         The trend is computed either throughout the water column
-      !!      (nlmdmp=0) or in area of weak vertical mixing (nlmdmp=1) or
-      !!      below the well mixed layer (nlmdmp=2)
-      !!
-      !! ** Action  : - tsa: tracer trends updated with the damping trend
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
-      !
-      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  zts_dta, ztrdts
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )   CALL timing_start('tra_dmp')
-      !
-      CALL wrk_alloc( jpi,jpj,jpk,jpts,   zts_dta )
-      IF( l_trdtra )   THEN                    !* Save ta and sa trends
-         CALL wrk_alloc( jpi,jpj,jpk,jpts,   ztrdts ) 
-         ztrdts(:,:,:,:) = tsa(:,:,:,:) 
-      ENDIF
-      !                           !==  input T-S data at kt  ==!
-      CALL dta_tsd( kt, zts_dta )            ! read and interpolates T-S data at kt
-      !
-      SELECT CASE ( nn_zdmp )     !==  type of damping  ==!
-      !
-      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
-         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) <= 5.e-4_wp ) 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
-         !
-      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
-         !
-      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) )
-         CALL wrk_dealloc( jpi,jpj,jpk,jpts,   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' )
-      !
-      CALL wrk_dealloc( jpi,jpj,jpk,jpts,   zts_dta )
-      !
-      IF( nn_timing == 1 )   CALL timing_stop('tra_dmp')
-      !
-   END SUBROUTINE tra_dmp
-
-
-   SUBROUTINE tra_dmp_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_dmp_init  ***
-      !! 
-      !! ** Purpose :   Initialization for the newtonian damping 
-      !!
-      !! ** Method  :   read the namtra_dmp namelist and check the parameters
-      !!----------------------------------------------------------------------
-      INTEGER ::   ios, imask   ! local integers 
-      !
-      NAMELIST/namtra_dmp/ ln_tradmp, nn_zdmp, cn_resto
-      !!----------------------------------------------------------------------
-      !
-      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', lwp )
-      !
-      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', lwp )
-      IF(lwm) WRITE ( numond, namtra_dmp )
-      !
-      IF(lwp) THEN                  ! Namelist print
-         WRITE(numout,*)
-         WRITE(numout,*) 'tra_dmp_init : T and S newtonian relaxation'
-         WRITE(numout,*) '~~~~~~~~~~~'
-         WRITE(numout,*) '   Namelist namtra_dmp : set relaxation parameters'
-         WRITE(numout,*) '      Apply relaxation   or not       ln_tradmp = ', ln_tradmp
-         WRITE(numout,*) '      mixed layer damping option      nn_zdmp   = ', nn_zdmp
-         WRITE(numout,*) '      Damping file name               cn_resto  = ', cn_resto
-         WRITE(numout,*)
-      ENDIF
-      !
-      IF( ln_tradmp) THEN
-         !                          ! Allocate arrays
-         IF( tra_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' )
-         !
-         SELECT CASE (nn_zdmp)      ! Check values of nn_zdmp
-         CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping as specified by mask'
-         CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixing layer (kz > 5 cm2/s)'
-         CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed  layer'
-         CASE DEFAULT
-            CALL ctl_stop('tra_dmp_init : wrong value of nn_zdmp')
-         END SELECT
-         !
-         !!TG: Initialisation of dtatsd - Would it be better to have dmpdta routine
-         !    so can damp to something other than intitial conditions files?
-         !!gm: In principle yes. Nevertheless, we can't anticipate demands that have never been formulated.
-         IF( .NOT.ln_tsd_tradmp ) THEN
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout, *)  '   read T-S data not initialized, we force ln_tsd_tradmp=T'
-            CALL dta_tsd_init( ld_tradmp=ln_tradmp )        ! forces the initialisation of T-S data
-         ENDIF
-         !                          ! Read in mask from file
-         CALL iom_open ( cn_resto, imask)
-         CALL iom_get  ( imask, jpdom_autoglo, 'resto', resto )
-         CALL iom_close( imask )
-      ENDIF
-      !
-   END SUBROUTINE tra_dmp_init
-
-   !!======================================================================
-END MODULE tradmp
Index: branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
===================================================================
--- branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90	(revision 6827)
+++ 	(revision )
@@ -1,202 +1,0 @@
-MODULE traldf
-   !!======================================================================
-   !!                       ***  MODULE  traldf  ***
-   !! Ocean Active tracers : lateral diffusive trends 
-   !!=====================================================================
-   !! History :  9.0  ! 2005-11  (G. Madec)  Original code
-   !!  NEMO      3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA 
-   !!            3.7  ! 2013-12  (G. Madec) remove the optional computation from T & S anomaly profiles and traldf_bilapg
-   !!             -   ! 2013-12  (F. Lemarie, G. Madec)  triad operator (Griffies) + Method of Stabilizing Correction
-   !!             -   ! 2014-01  (G. Madec, S. Masson)  restructuration/simplification of lateral diffusive operators
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_ldf       : update the tracer trend with the lateral diffusion trend
-   !!   tra_ldf_init  : initialization, namelist read, and parameters control
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and tracers
-   USE dom_oce        ! ocean space and time domain
-   USE phycst         ! physical constants
-   USE ldftra         ! lateral diffusion: eddy diffusivity & EIV coeff.
-   USE ldfslp         ! lateral diffusion: iso-neutral slope
-   USE traldf_lap_blp ! lateral diffusion: laplacian iso-level            operator  (tra_ldf_lap/_blp   routines)
-   USE traldf_iso     ! lateral diffusion: laplacian iso-neutral standard operator  (tra_ldf_iso        routine )
-   USE traldf_triad   ! lateral diffusion: laplacian iso-neutral triad    operator  (tra_ldf_triad      routine )
-   USE trd_oce        ! trends: ocean variables
-   USE trdtra         ! ocean active tracers trends
-   !
-   USE prtctl         ! Print control
-   USE in_out_manager ! I/O manager
-   USE lib_mpp        ! distribued memory computing library
-   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
-   USE wrk_nemo       ! Memory allocation
-   USE timing         ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_ldf        ! called by step.F90 
-   PUBLIC   tra_ldf_init   ! called by nemogcm.F90 
-   !
-   INTEGER ::   nldf = 0   ! type of lateral diffusion used defined from ln_traldf_... (namlist logicals)
-   
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tra_ldf( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_ldf  ***
-      !! 
-      !! ** Purpose :   compute the lateral ocean tracer physics.
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
-      !!
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )   CALL timing_start('tra_ldf')
-      !
-      IF( l_trdtra )   THEN                    !* Save ta and sa trends
-         CALL wrk_alloc( jpi,jpj,jpk,   ztrdt, ztrds ) 
-         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
-         ztrds(:,:,:) = tsa(:,:,:,jp_sal)
-      ENDIF
-      !
-      SELECT CASE ( nldf )                     !* 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   )
-      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   )
-      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   )
-      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 )
-      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 )
-         CALL wrk_dealloc( jpi,jpj,jpk,   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( nn_timing == 1 )   CALL timing_stop('tra_ldf')
-      !
-   END SUBROUTINE tra_ldf
-
-
-   SUBROUTINE tra_ldf_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_ldf_init  ***
-      !! 
-      !! ** Purpose :   Choice of the operator for the lateral tracer diffusion
-      !!
-      !! ** Method  :   set nldf from the namtra_ldf logicals
-      !!----------------------------------------------------------------------
-      INTEGER ::   ioptio, ierr   ! temporary integers 
-      !!----------------------------------------------------------------------
-      !
-      IF(lwp) THEN                     ! Namelist print
-         WRITE(numout,*)
-         WRITE(numout,*) 'tra_ldf_init : lateral tracer diffusive operator'
-         WRITE(numout,*) '~~~~~~~~~~~'
-         WRITE(numout,*) '   Namelist namtra_ldf: already read in ldftra module'
-         WRITE(numout,*) '      see ldf_tra_init report for lateral mixing parameters'
-         WRITE(numout,*)
-      ENDIF
-      !                                   ! use of lateral operator or not
-      nldf   = np_ERROR
-      ioptio = 0
-      IF( ln_traldf_lap )   ioptio = ioptio + 1
-      IF( ln_traldf_blp )   ioptio = ioptio + 1
-      IF( ioptio >  1   )   CALL ctl_stop( 'tra_ldf_init: use ONE or NONE of the 2 lap/bilap operator type on tracer' )
-      IF( ioptio == 0   )   nldf = np_no_ldf     ! No lateral diffusion
-      !
-      IF( nldf /= np_no_ldf ) THEN        ! direction ==>> type of operator  
-         ioptio = 0
-         IF( ln_traldf_lev )   ioptio = ioptio + 1
-         IF( ln_traldf_hor )   ioptio = ioptio + 1
-         IF( ln_traldf_iso )   ioptio = ioptio + 1
-         IF( ioptio >  1 )   CALL ctl_stop( 'tra_ldf_init: use only ONE direction (level/hor/iso)' )
-         !
-         !                                ! defined the type of lateral diffusion from ln_traldf_... logicals
-         ierr = 0
-         IF( ln_traldf_lap ) THEN         ! laplacian operator
-            IF ( ln_zco ) THEN               ! z-coordinate
-               IF ( ln_traldf_lev   )   nldf = np_lap     ! iso-level = horizontal (no rotation)
-               IF ( ln_traldf_hor   )   nldf = np_lap     ! iso-level = horizontal (no rotation)
-               IF ( ln_traldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard  (   rotation)
-               IF ( ln_traldf_triad )   nldf = np_lap_it  ! iso-neutral: triad     (   rotation)
-            ENDIF
-            IF ( ln_zps ) THEN               ! z-coordinate with partial step
-               IF ( ln_traldf_lev   )   ierr = 1          ! iso-level not allowed 
-               IF ( ln_traldf_hor   )   nldf = np_lap     ! horizontal             (no rotation)
-               IF ( ln_traldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard     (rotation)
-               IF ( ln_traldf_triad )   nldf = np_lap_it  ! iso-neutral: triad        (rotation)
-            ENDIF
-            IF ( ln_sco ) THEN               ! s-coordinate
-               IF ( ln_traldf_lev   )   nldf = np_lap     ! iso-level              (no rotation)
-               IF ( ln_traldf_hor   )   nldf = np_lap_i   ! horizontal             (   rotation)
-               IF ( ln_traldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard  (   rotation)
-               IF ( ln_traldf_triad )   nldf = np_lap_it  ! iso-neutral: triad     (   rotation)
-            ENDIF
-         ENDIF
-         !
-         IF( ln_traldf_blp ) THEN         ! bilaplacian operator
-            IF ( ln_zco ) THEN               ! z-coordinate
-               IF ( ln_traldf_lev   )   nldf = np_blp     ! iso-level = horizontal (no rotation)
-               IF ( ln_traldf_hor   )   nldf = np_blp     ! iso-level = horizontal (no rotation)
-               IF ( ln_traldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard  (   rotation)
-               IF ( ln_traldf_triad )   nldf = np_blp_it  ! iso-neutral: triad     (   rotation)
-            ENDIF
-            IF ( ln_zps ) THEN               ! z-coordinate with partial step
-               IF ( ln_traldf_lev   )   ierr = 1          ! iso-level not allowed 
-               IF ( ln_traldf_hor   )   nldf = np_blp     ! horizontal             (no rotation)
-               IF ( ln_traldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard  (   rotation)
-               IF ( ln_traldf_triad )   nldf = np_blp_it  ! iso-neutral: triad     (   rotation)
-            ENDIF
-            IF ( ln_sco ) THEN               ! s-coordinate
-               IF ( ln_traldf_lev   )   nldf = np_blp     ! iso-level              (no rotation)
-               IF ( ln_traldf_hor   )   nldf = np_blp_it  ! horizontal             (   rotation)
-               IF ( ln_traldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard  (   rotation)
-               IF ( ln_traldf_triad )   nldf = np_blp_it  ! iso-neutral: triad     (   rotation)
-            ENDIF
-         ENDIF
-      ENDIF
-      !
-      IF( ierr == 1 )   CALL ctl_stop( 'iso-level in z-partial step, not allowed' )
-      IF( ln_ldfeiv .AND. .NOT.( ln_traldf_iso .OR. ln_traldf_triad ) )                                    &
-           &            CALL ctl_stop( 'eddy induced velocity on tracers requires iso-neutral laplacian diffusion' )
-      IF( ln_isfcav .AND. ln_traldf_triad ) &
-           &            CALL ctl_stop( ' ice shelf cavity and traldf_triad not tested' )
-           !
-      IF(  nldf == np_lap_i .OR. nldf == np_lap_it .OR. &
-         & nldf == np_blp_i .OR. nldf == np_blp_it  )   l_ldfslp = .TRUE.    ! slope of neutral surfaces required 
-      !
-      IF(lwp) THEN
-         WRITE(numout,*)
-         SELECT CASE( nldf )
-         CASE( np_no_ldf )   ;   WRITE(numout,*) '   NO lateral diffusion'
-         CASE( np_lap    )   ;   WRITE(numout,*) '   laplacian iso-level operator'
-         CASE( np_lap_i  )   ;   WRITE(numout,*) '   Rotated laplacian operator (standard)'
-         CASE( np_lap_it )   ;   WRITE(numout,*) '   Rotated laplacian operator (triad)'
-         CASE( np_blp    )   ;   WRITE(numout,*) '   bilaplacian iso-level operator'
-         CASE( np_blp_i  )   ;   WRITE(numout,*) '   Rotated bilaplacian operator (standard)'
-         CASE( np_blp_it )   ;   WRITE(numout,*) '   Rotated bilaplacian operator (triad)'
-         END SELECT
-      ENDIF
-      !
-   END SUBROUTINE tra_ldf_init
-
-   !!======================================================================
-END MODULE traldf
Index: branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
===================================================================
--- branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90	(revision 6827)
+++ 	(revision )
@@ -1,423 +1,0 @@
-MODULE traldf_iso
-   !!======================================================================
-   !!                   ***  MODULE  traldf_iso  ***
-   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
-   !!======================================================================
-   !! History :  OPA  ! 1994-08  (G. Madec, M. Imbard)
-   !!            8.0  ! 1997-05  (G. Madec)  split into traldf and trazdf
-   !!            NEMO ! 2002-08  (G. Madec)  Free form, F90
-   !!            1.0  ! 2005-11  (G. Madec)  merge traldf and trazdf :-)
-   !!            3.3  ! 2010-09  (C. Ethe, G. Madec) Merge TRA-TRC
-   !!            3.7  ! 2014-01  (G. Madec, S. Masson)  restructuration/simplification of aht/aeiv specification
-   !!             -   ! 2014-02  (F. Lemarie, G. Madec)  triad operator (Griffies) + Method of Stabilizing Correction
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_ldf_iso   : update the tracer trend with the horizontal component of a iso-neutral laplacian operator
-   !!                   and with the vertical part of the isopycnal or geopotential s-coord. operator 
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and active tracers
-   USE dom_oce        ! ocean space and time domain
-   USE trc_oce        ! share passive tracers/Ocean variables
-   USE zdf_oce        ! ocean vertical physics
-   USE ldftra         ! lateral diffusion: tracer eddy coefficients
-   USE ldfslp         ! iso-neutral slopes
-   USE diaptr         ! poleward transport diagnostics
-   !
-   USE in_out_manager ! I/O manager
-   USE iom            ! I/O library
-   USE phycst         ! physical constants
-   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
-   USE wrk_nemo       ! Memory Allocation
-   USE timing         ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_ldf_iso   ! routine called by step.F90
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-  SUBROUTINE tra_ldf_iso( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   &
-      &                                                   pgui, pgvi,   &
-      &                                       ptb , ptbb, pta , kjpt, kpass )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_ldf_iso  ***
-      !!
-      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
-      !!      trend for a laplacian tensor (ezxcept the dz[ dz[.] ] term) and 
-      !!      add it to the general trend of tracer equation.
-      !!
-      !! ** Method  :   The horizontal component of the lateral diffusive trends 
-      !!      is provided by a 2nd order operator rotated along neural or geopo-
-      !!      tential surfaces to which an eddy induced advection can be added
-      !!      It is computed using before fields (forward in time) and isopyc-
-      !!      nal or geopotential slopes computed in routine ldfslp.
-      !!
-      !!      1st part :  masked horizontal derivative of T  ( di[ t ] )
-      !!      ========    with partial cell update if ln_zps=T
-      !!                  with top     cell update if ln_isfcav
-      !!
-      !!      2nd part :  horizontal fluxes of the lateral mixing operator
-      !!      ========    
-      !!         zftu =  pahu e2u*e3u/e1u di[ tb ]
-      !!               - pahu e2u*uslp    dk[ mi(mk(tb)) ]
-      !!         zftv =  pahv e1v*e3v/e2v dj[ tb ]
-      !!               - pahv e2u*vslp    dk[ mj(mk(tb)) ]
-      !!      take the horizontal divergence of the fluxes:
-      !!         difft = 1/(e1e2t*e3t) {  di-1[ zftu ] +  dj-1[ zftv ]  }
-      !!      Add this trend to the general trend (ta,sa):
-      !!         ta = ta + difft
-      !!
-      !!      3rd part: vertical trends of the lateral mixing operator
-      !!      ========  (excluding the vertical flux proportional to dk[t] )
-      !!      vertical fluxes associated with the rotated lateral mixing:
-      !!         zftw = - {  mi(mk(pahu)) * e2t*wslpi di[ mi(mk(tb)) ]
-      !!                   + mj(mk(pahv)) * e1t*wslpj dj[ mj(mk(tb)) ]  }
-      !!      take the horizontal divergence of the fluxes:
-      !!         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
-      !!----------------------------------------------------------------------
-      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   ) ::   kpass      ! =1/2 first or second passage
-      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
-      !
-      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
-      INTEGER  ::  ikt
-      INTEGER  ::  ierr             ! local integer
-      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   !   -      -
-#if defined key_diaar5
-      REAL(wp) ::   zztmp   ! local scalar
-#endif
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   zdkt, zdk1t, z2d
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdit, zdjt, zftu, zftv, ztfw 
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_ldf_iso')
-      !
-      CALL wrk_alloc( jpi,jpj,       zdkt, zdk1t, z2d ) 
-      CALL wrk_alloc( jpi,jpj,jpk,   zdit, zdjt , zftu, zftv, ztfw  ) 
-      !
-      IF( kt == kit000 )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_ldf_iso : rotated laplacian diffusion operator on ', cdtype
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-         !
-         akz     (:,:,:) = 0._wp      
-         ah_wslp2(:,:,:) = 0._wp
-      ENDIF
-      !                                               ! 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)
-      ELSE                    ;   zsign = -1._wp
-      ENDIF
-         
-      !!----------------------------------------------------------------------
-      !!   0 - calculate  ah_wslp2 and akz
-      !!----------------------------------------------------------------------
-      !
-      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
-         !
-         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
-            !
-            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
-            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
-           ENDIF
-           !
-         ELSE                                    ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit
-            akz(:,:,:) = ah_wslp2(:,:,:)      
-         ENDIF
-      ENDIF
-      !
-      !                                                          ! ===========
-      DO jn = 1, kjpt                                            ! tracer loop
-         !                                                       ! ===========
-         !                                               
-         !!----------------------------------------------------------------------
-         !!   I - masked horizontal derivative 
-         !!----------------------------------------------------------------------
-!!gm : bug.... why (x,:,:)?   (1,jpj,:) and (jpi,1,:) should be sufficient....
-         zdit (1,:,:) = 0._wp     ;     zdit (jpi,:,:) = 0._wp
-         zdjt (1,:,:) = 0._wp     ;     zdjt (jpi,:,:) = 0._wp
-         !!end
-
-         ! 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
-         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
-            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
-            ENDIF
-         ENDIF
-         !
-         !!----------------------------------------------------------------------
-         !!   II - horizontal trend  (full)
-         !!----------------------------------------------------------------------
-         !
-         DO jk = 1, jpkm1                                 ! Horizontal slab
-            !
-            !                             !== Vertical tracer gradient
-            zdk1t(:,:) = ( ptb(:,:,jk,jn) - ptb(:,:,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)
-            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
-         END DO                                        !   End of slab  
-
-         !!----------------------------------------------------------------------
-         !!   III - vertical trend (full)
-         !!----------------------------------------------------------------------
-         !
-         ztfw(1,:,:) = 0._wp     ;     ztfw(jpi,:,:) = 0._wp
-         !
-         ! Vertical fluxes
-         ! ---------------
-         !                          ! Surface and bottom vertical fluxes set to zero
-         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
-         !                                !==  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) * 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
-            !
-         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)    &
-                           &           + 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 = 1, 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
-            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
-         !
-         IF( ( kpass == 1 .AND. ln_traldf_lap ) .OR.  &     !==  first pass only (  laplacian)  ==!
-             ( kpass == 2 .AND. ln_traldf_blp ) ) THEN      !==  2nd   pass      (bilaplacian)  ==!
-            !
-            !                             ! "Poleward" diffusive heat or salt transports (T-S case only)
-            IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
-               ! note sign is reversed to give down-gradient diffusive transports (#1043)
-               IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( -zftv(:,:,:) )
-               IF( jn == jp_sal)   str_ldf(:) = ptr_sj( -zftv(:,:,:) )
-            ENDIF
-            !
-            IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN
-              !
-              IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN
-                  z2d(:,:) = zftu(ji,jj,1) 
-                  DO jk = 2, jpkm1
-                     DO jj = 2, jpjm1
-                        DO ji = fs_2, fs_jpim1   ! vector opt.
-                           z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 
-                        END DO
-                     END DO
-                  END DO
-!!gm CAUTION I think there is an error of sign when using BLP operator....
-!!gm         a multiplication by zsign is required (to be checked twice !)
-                  z2d(:,:) = - rau0_rcp * z2d(:,:)     ! note sign is reversed to give down-gradient diffusive transports (#1043)
-                  CALL lbc_lnk( z2d, 'U', -1. )
-                  CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction
-                  !
-                  z2d(:,:) = zftv(ji,jj,1) 
-                  DO jk = 2, jpkm1
-                     DO jj = 2, jpjm1
-                        DO ji = fs_2, fs_jpim1   ! vector opt.
-                           z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 
-                        END DO
-                     END DO
-                  END DO
-                  z2d(:,:) = - rau0_rcp * z2d(:,:)     ! note sign is reversed to give down-gradient diffusive transports (#1043)
-                  CALL lbc_lnk( z2d, 'V', -1. )
-                  CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction
-               END IF
-               !
-            ENDIF
-            !
-         ENDIF                                                    !== end pass selection  ==!
-         !
-         !                                                        ! ===============
-      END DO                                                      ! end tracer loop
-      !                                                           ! ===============
-      !
-      CALL wrk_dealloc( jpi, jpj,      zdkt, zdk1t, z2d ) 
-      CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt , zftu, zftv, ztfw  ) 
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_iso')
-      !
-   END SUBROUTINE tra_ldf_iso
-
-   !!==============================================================================
-END MODULE traldf_iso
Index: branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_blp.F90
===================================================================
--- branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_blp.F90	(revision 6827)
+++ 	(revision )
@@ -1,253 +1,0 @@
-MODULE traldf_lap_blp
-   !!==============================================================================
-   !!                       ***  MODULE  traldf_lap_blp  ***
-   !! Ocean tracers:  lateral diffusivity trend  (laplacian and bilaplacian)
-   !!==============================================================================
-   !! History :  3.7  ! 2014-01  (G. Madec, S. Masson)  Original code, re-entrant laplacian 
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_ldf_lap   : tracer trend update with iso-level laplacian diffusive operator
-   !!   tra_ldf_blp   : tracer trend update with iso-level or iso-neutral bilaplacian operator
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and active tracers
-   USE dom_oce        ! ocean space and time domain
-   USE ldftra         ! lateral physics: eddy diffusivity
-   USE traldf_iso     ! iso-neutral lateral diffusion (standard operator)     (tra_ldf_iso   routine)
-   USE traldf_triad   ! iso-neutral lateral diffusion (triad    operator)     (tra_ldf_triad routine)
-   USE diaptr         ! poleward transport diagnostics
-   USE trc_oce        ! share passive tracers/Ocean variables
-   USE zpshde         ! partial step: hor. derivative     (zps_hde routine)
-   !
-   USE in_out_manager ! I/O manager
-   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
-   USE lib_mpp        ! distribued memory computing library
-   USE timing         ! Timing
-   USE wrk_nemo       ! Memory allocation
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_ldf_lap   ! called by traldf.F90
-   PUBLIC   tra_ldf_blp   ! called by traldf.F90
-
-   !                      ! Flag to control the type of lateral diffusive operator
-   INTEGER, PARAMETER, PUBLIC ::   np_ERROR  =-10   ! error in specification of lateral diffusion
-   INTEGER, PARAMETER, PUBLIC ::   np_no_ldf = 00   ! without operator (i.e. no lateral diffusive trend)
-   !                          !!      laplacian     !    bilaplacian    !
-   INTEGER, PARAMETER, PUBLIC ::   np_lap    = 10   ,   np_blp    = 20  ! iso-level operator
-   INTEGER, PARAMETER, PUBLIC ::   np_lap_i  = 11   ,   np_blp_i  = 21  ! standard iso-neutral or geopotential operator
-   INTEGER, PARAMETER, PUBLIC ::   np_lap_it = 12   ,   np_blp_it = 22  ! triad    iso-neutral or geopotential operator
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tra_ldf_lap( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   &
-      &                                                    pgui, pgvi,   &
-      &                                        ptb , pta , kjpt, kpass ) 
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_ldf_lap  ***
-      !!                   
-      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
-      !!      trend and add it to the general trend of tracer equation.
-      !!
-      !! ** Method  :   Second order diffusive operator evaluated using before
-      !!      fields (forward time scheme). The horizontal diffusive trends of 
-      !!      the tracer is given by:
-      !!          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 
-      !!                harmonic mixing trend.
-      !!----------------------------------------------------------------------
-      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   ) ::   kpass      ! =1/2 first or second passage
-      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 
-      !
-      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp) ::   zsign            ! local scalars
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztu, ztv, zaheeu, zaheev
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )   CALL timing_start('tra_ldf_lap')
-      !
-      IF( kt == nit000 .AND. lwp )  THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype, ', pass=', kpass
-         WRITE(numout,*) '~~~~~~~~~~~ '
-      ENDIF
-      !
-      CALL wrk_alloc( jpi,jpj,jpk,   ztu, ztv, zaheeu, zaheev ) 
-      !
-      !                                !==  Initialization of metric arrays used for all tracers  ==!
-      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0)
-      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 jn = 1, kjpt               ! tracer loop !
-         !                          ! =========== !    
-         !                               
-         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  
-         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  
-            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
-            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  
-         !
-         !                             !== "Poleward" diffusive heat or salt transports  ==!
-         IF( ( kpass == 1 .AND. .NOT.ln_traldf_blp ) .OR.  &     !==  first pass only (  laplacian)  ==!
-             ( kpass == 2 .AND.      ln_traldf_blp ) ) THEN      !==  2nd   pass only (bilaplacian)  ==!
-            IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
-               IF( jn  == jp_tem)   htr_ldf(:) = ptr_sj( -ztv(:,:,:) )
-               IF( jn  == jp_sal)   str_ldf(:) = ptr_sj( -ztv(:,:,:) )
-            ENDIF
-         ENDIF
-         !                          ! ==================
-      END DO                        ! end of tracer loop
-      !                             ! ==================
-      !
-      CALL wrk_dealloc( jpi,jpj,jpk,   ztu, ztv, zaheeu, zaheev ) 
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_lap')
-      !
-   END SUBROUTINE tra_ldf_lap
-   
-
-   SUBROUTINE tra_ldf_blp( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   &
-      &                                                    pgui, pgvi,   &
-      &                                                    ptb , pta , kjpt, kldf )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE tra_ldf_blp  ***
-      !!                    
-      !! ** Purpose :   Compute the before lateral tracer diffusive 
-      !!      trend and add it to the general trend of tracer equation.
-      !!
-      !! ** Method  :   The lateral diffusive trends is provided by a bilaplacian
-      !!      operator applied to before field (forward in time).
-      !!      It is computed by two successive calls to laplacian routine
-      !!
-      !! ** Action :   pta   updated with the before rotated bilaplacian diffusion
-      !!----------------------------------------------------------------------
-      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   ) ::   kldf       ! type of operator used
-      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
-      !
-      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zlap         ! laplacian at t-point
-      REAL(wp), POINTER, DIMENSION(:,:,:)   :: zglu, zglv   ! bottom GRADh of the laplacian (u- and v-points)
-      REAL(wp), POINTER, DIMENSION(:,:,:)   :: zgui, zgvi   ! top    GRADh of the laplacian (u- and v-points)
-      !!---------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_ldf_blp')
-      !
-      CALL wrk_alloc( jpi,jpj,jpk,kjpt,   zlap ) 
-      CALL wrk_alloc( jpi,jpj,    kjpt,   zglu, zglv, zgui, zgvi ) 
-      !
-      IF( kt == kit000 .AND. lwp )  THEN
-         WRITE(numout,*)
-         SELECT CASE ( kldf )
-         CASE ( np_blp    )   ;   WRITE(numout,*) 'tra_ldf_blp : iso-level   bilaplacian operator on ', cdtype
-         CASE ( np_blp_i  )   ;   WRITE(numout,*) 'tra_ldf_blp : iso-neutral bilaplacian operator on ', cdtype, ' (Standard)'
-         CASE ( np_blp_it )   ;   WRITE(numout,*) 'tra_ldf_blp : iso-neutral bilaplacian operator on ', cdtype, ' (triad)'
-         END SELECT
-         WRITE(numout,*) '~~~~~~~~~~~'
-      ENDIF
-
-      zlap(:,:,:,:) = 0._wp
-      !
-      SELECT CASE ( kldf )       !==  1st laplacian applied to ptb (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 )
-      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 )
-      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 )
-      END SELECT
-      !
-      DO jn = 1, kjpt
-         CALL lbc_lnk( zlap(:,:,:,jn) , 'T', 1. )     ! Lateral boundary conditions (unchanged sign)
-      END DO
-      !                                               ! 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)  ==!
-      !
-      CASE ( np_blp    )               ! iso-level bilaplacian
-         CALL tra_ldf_lap  ( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pta,      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 )
-      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 )
-      END SELECT
-      !
-      CALL wrk_dealloc( jpi,jpj,jpk,kjpt,   zlap ) 
-      CALL wrk_dealloc( jpi,jpj    ,kjpt,   zglu, zglv, zgui, zgvi ) 
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_blp')
-      !
-   END SUBROUTINE tra_ldf_blp
-
-   !!==============================================================================
-END MODULE traldf_lap_blp
Index: branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_triad.F90
===================================================================
--- branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_triad.F90	(revision 6827)
+++ 	(revision )
@@ -1,467 +1,0 @@
-MODULE traldf_triad
-   !!======================================================================
-   !!                   ***  MODULE  traldf_triad  ***
-   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
-   !!======================================================================
-   !! History :  3.3  ! 2010-10  (G. Nurser, C. Harris, G. Madec)  Griffies operator (original code)
-   !!            3.7  ! 2013-12  (F. Lemarie, G. Madec)  triad operator (Griffies) + Method of Stabilizing Correction
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_ldf_triad : update the tracer trend with the iso-neutral laplacian triad-operator
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and active tracers
-   USE dom_oce        ! ocean space and time domain
-   USE phycst         ! physical constants
-   USE trc_oce        ! share passive tracers/Ocean variables
-   USE zdf_oce        ! ocean vertical physics
-   USE ldftra         ! lateral physics: eddy diffusivity
-   USE ldfslp         ! lateral physics: iso-neutral slopes
-   USE traldf_iso     ! lateral diffusion (Madec operator)         (tra_ldf_iso routine)
-   USE diaptr         ! poleward transport diagnostics
-   USE zpshde         ! partial step: hor. derivative     (zps_hde routine)
-   !
-   USE in_out_manager ! I/O manager
-   USE iom            ! I/O library
-   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
-   USE lib_mpp        ! MPP library
-   USE wrk_nemo       ! Memory Allocation
-   USE timing         ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_ldf_triad   ! routine called by traldf.F90
-
-   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   zdkt3d   !: vertical tracer gradient at 2 levels
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-  SUBROUTINE tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   &
-      &                                                     pgui, pgvi,   &
-      &                                         ptb , ptbb, pta , kjpt, kpass )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_ldf_triad  ***
-      !!
-      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive
-      !!      trend for a laplacian tensor (ezxcept the dz[ dz[.] ] term) and
-      !!      add it to the general trend of tracer equation.
-      !!
-      !! ** Method  :   The horizontal component of the lateral diffusive trends
-      !!      is provided by a 2nd order operator rotated along neural or geopo-
-      !!      tential surfaces to which an eddy induced advection can be added
-      !!      It is computed using before fields (forward in time) and isopyc-
-      !!      nal or geopotential slopes computed in routine ldfslp.
-      !!
-      !!      see documentation for the desciption
-      !!
-      !! ** Action :   pta   updated with the before rotated diffusion
-      !!               ah_wslp2 ....
-      !!               akz   stabilizing vertical diffusivity coefficient (used in trazdf_imp)
-      !!----------------------------------------------------------------------
-      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   ) ::   kpass      ! =1/2 first or second passage
-      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
-      !
-      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) ::   zslope_skew, zslope_iso, zslope2, zbu, zbv
-      REAL(wp) ::   ze1ur, ze2vr, ze3wr, zdxt, zdyt, zdzt
-      REAL(wp) ::   zah, zah_slp, zaei_slp
-#if defined key_diaar5
-      REAL(wp) ::   zztmp              ! local scalar
-#endif
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: z2d                                            ! 2D workspace
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw   ! 3D     -
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_ldf_triad')
-      !
-      CALL wrk_alloc( jpi,jpj,       z2d ) 
-      CALL wrk_alloc( jpi,jpj,jpk,   zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw  ) 
-      !
-      IF( .NOT.ALLOCATED(zdkt3d) )  THEN
-         ALLOCATE( zdkt3d(jpi,jpj,0:1) , STAT=ierr )
-         IF( lk_mpp   )   CALL mpp_sum ( ierr )
-         IF( ierr > 0 )   CALL ctl_stop('STOP', 'tra_ldf_triad: unable to allocate arrays')
-      ENDIF
-     !
-      IF( kpass == 1 .AND. kt == kit000 )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_ldf_triad : rotated laplacian diffusion operator on ', cdtype
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'
-      ENDIF
-      !                                               ! set time step size (Euler/Leapfrog)
-      IF( neuler == 0 .AND. kt == kit000 ) 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)
-      ELSE                    ;   zsign = -1._wp
-      ENDIF
-      !    
-      !!----------------------------------------------------------------------
-      !!   0 - calculate  ah_wslp2, akz, and optionally zpsi_uw, zpsi_vw
-      !!----------------------------------------------------------------------
-      !
-      IF( kpass == 1 ) THEN         !==  first pass only  and whatever the tracer is  ==!
-         !
-         akz     (:,:,:) = 0._wp      
-         ah_wslp2(:,:,:) = 0._wp
-         IF( ln_ldfeiv_dia ) THEN
-            zpsi_uw(:,:,:) = 0._wp
-            zpsi_vw(:,:,:) = 0._wp
-         ENDIF
-         !
-         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
-            END DO
-         END DO
-         !
-         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
-            END DO
-         END DO
-         !
-         IF( ln_traldf_msc ) THEN                ! stabilizing vertical diffusivity coefficient
-            !
-            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
-            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
-           ENDIF
-           !
-         ELSE                                    ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit
-            akz(:,:,:) = ah_wslp2(:,:,:)      
-         ENDIF
-         !
-         IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' )   CALL ldf_eiv_dia( zpsi_uw, zpsi_vw )
-         !
-      ENDIF                                  !==  end 1st pass only  ==!
-      !
-      !                                                           ! ===========
-      DO jn = 1, kjpt                                             ! tracer loop
-         !                                                        ! ===========
-         ! Zero fluxes for each tracer
-!!gm  this should probably be done outside the jn loop
-         ztfw(:,:,:) = 0._wp
-         zftu(:,:,:) = 0._wp
-         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
-         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
-            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
-            ENDIF
-         ENDIF
-         !
-         !!----------------------------------------------------------------------
-         !!   II - horizontal trend  (full)
-         !!----------------------------------------------------------------------
-         !
-         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)
-            !
-            !                    ! 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)
-            ENDIF
-            !
-            zaei_slp = 0._wp
-            !
-            IF( ln_botmix_triad ) THEN
-               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
-                  END DO
-               END DO
-               !
-               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
-                  END DO
-               END DO
-               !
-            ELSE
-               !
-               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
-                  END DO
-               END DO
-               !
-               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
-                  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
-            !
-         END DO
-         !
-         !                                !==  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
-         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
-            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
-         !
-         IF( ( kpass == 1 .AND. ln_traldf_lap ) .OR.  &     !==  first pass only (  laplacian)  ==!
-             ( kpass == 2 .AND. ln_traldf_blp ) ) THEN      !==  2nd   pass      (bilaplacian)  ==!
-            !
-            !                          ! "Poleward" diffusive heat or salt transports (T-S case only)
-            IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
-               IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( zftv(:,:,:) )        ! 3.3  names
-               IF( jn == jp_sal)   str_ldf(:) = ptr_sj( zftv(:,:,:) )
-            ENDIF
-            !
-            IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN
-              !
-              IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN
-                  z2d(:,:) = zftu(ji,jj,1) 
-                  DO jk = 2, jpkm1
-                     DO jj = 2, jpjm1
-                        DO ji = fs_2, fs_jpim1   ! vector opt.
-                           z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 
-                        END DO
-                     END DO
-                  END DO
-                  z2d(:,:) = rau0_rcp * z2d(:,:) 
-                  CALL lbc_lnk( z2d, 'U', -1. )
-                  CALL iom_put( "udiff_heattr", z2d )                  ! heat i-transport
-                  !
-                  z2d(:,:) = zftv(ji,jj,1) 
-                  DO jk = 2, jpkm1
-                     DO jj = 2, jpjm1
-                        DO ji = fs_2, fs_jpim1   ! vector opt.
-                           z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 
-                        END DO
-                     END DO
-                  END DO
-                  z2d(:,:) = rau0_rcp * z2d(:,:)     
-                  CALL lbc_lnk( z2d, 'V', -1. )
-                  CALL iom_put( "vdiff_heattr", z2d )                  !  heat j-transport
-               ENDIF
-               !
-            ENDIF
-            !
-         ENDIF                                                    !== end pass selection  ==!
-         !
-         !                                                        ! ===============
-      END DO                                                      ! end tracer loop
-      !                                                           ! ===============
-      !
-      CALL wrk_dealloc( jpi,jpj,       z2d ) 
-      CALL wrk_dealloc( jpi,jpj,jpk,   zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw  ) 
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_triad')
-      !
-   END SUBROUTINE tra_ldf_triad
-
-   !!==============================================================================
-END MODULE traldf_triad
Index: branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90
===================================================================
--- branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90	(revision 6827)
+++ 	(revision )
@@ -1,337 +1,0 @@
-MODULE tranpc
-   !!==============================================================================
-   !!                       ***  MODULE  tranpc  ***
-   !! Ocean active tracers:  non penetrative convective adjustment scheme
-   !!==============================================================================
-   !! History :  1.0  ! 1990-09  (G. Madec)  Original code
-   !!                 ! 1996-01  (G. Madec)  statement function for e3
-   !!   NEMO     1.0  ! 2002-06  (G. Madec)  free form F90
-   !!            3.0  ! 2008-06  (G. Madec)  applied on ta, sa and called before tranxt in step.F90
-   !!            3.3  ! 2010-05  (C. Ethe, G. Madec)  merge TRC-TRA
-   !!            3.6  ! 2015-05  (L. Brodeau) new algorithm based on local Brunt-Vaisala freq.
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_npc       : apply the non penetrative convection scheme
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and active tracers
-   USE dom_oce        ! ocean space and time domain
-   USE phycst         ! physical constants
-   USE zdf_oce        ! ocean vertical physics
-   USE trd_oce        ! ocean active tracer trends
-   USE trdtra         ! ocean active tracer trends
-   USE eosbn2         ! equation of state (eos routine)
-   !
-   USE lbclnk         ! lateral boundary conditions (or mpp link)
-   USE in_out_manager ! I/O manager
-   USE lib_mpp        ! MPP library
-   USE wrk_nemo       ! Memory Allocation
-   USE timing         ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_npc    ! routine called by step.F90
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.6 , NEMO Consortium (2014)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tra_npc( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tranpc  ***
-      !!
-      !! ** Purpose : Non-penetrative convective adjustment scheme. solve
-      !!      the static instability of the water column on after fields
-      !!      while conserving heat and salt contents.
-      !!
-      !! ** Method  : updated algorithm able to deal with non-linear equation of state
-      !!              (i.e. static stability computed locally)
-      !!
-      !! ** Action  : - tsa: after tracers with the application of the npc scheme
-      !!              - send the associated trends for on-line diagnostics (l_trdtra=T)
-      !!
-      !! References :     Madec, et al., 1991, JPO, 21, 9, 1349-1371.
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
-      !
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      INTEGER  ::   inpcc        ! number of statically instable water column
-      INTEGER  ::   jiter, ikbot, ikp, ikup, ikdown, ilayer, ik_low   ! local integers
-      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), POINTER, DIMENSION(:)       ::   zvn2   ! vertical profile of N2 at 1 given point...
-      REAL(wp), POINTER, DIMENSION(:,:)     ::   zvts   ! vertical profile of T and S at 1 given point...
-      REAL(wp), POINTER, DIMENSION(:,:)     ::   zvab   ! vertical profile of alpha and beta
-      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zn2    ! N^2 
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zab    ! alpha and beta
-      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   ztrdt, ztrds   ! 3D workspace
-      !
-      LOGICAL, PARAMETER :: l_LB_debug = .FALSE. ! set to true if you want to follow what is
-      INTEGER :: ilc1, jlc1, klc1, nncpu         ! actually happening in a water column at point "ilc1, jlc1"
-      LOGICAL :: lp_monitor_point = .FALSE.      ! in CPU domain "nncpu"
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_npc')
-      !
-      IF( MOD( kt, nn_npc ) == 0 ) THEN
-         !
-         CALL wrk_alloc( jpi, jpj, jpk, zn2 )    ! N2
-         CALL wrk_alloc( jpi, jpj, jpk, 2, zab ) ! Alpha and Beta
-         CALL wrk_alloc( jpk, 2, zvts, zvab )    ! 1D column vector at point ji,jj
-         CALL wrk_alloc( jpk, zvn2 )             ! 1D column vector at point ji,jj
-
-         IF( l_trdtra )   THEN                    !* Save initial after fields
-            CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )
-            ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
-            ztrds(:,:,:) = tsa(:,:,:,jp_sal)
-         ENDIF
-
-         IF( l_LB_debug ) THEN
-            ! Location of 1 known convection site to follow what's happening in the water column
-            ilc1 = 45 ;  jlc1 = 3 ; !  ORCA2 4x4, Antarctic coast, more than 2 unstable portions in the  water column...           
-            nncpu = 1  ;            ! the CPU domain contains the convection spot
-            klc1 =  mbkt(ilc1,jlc1) ! bottom of the ocean for debug point...          
-         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)
-        
-         inpcc = 0
-
-         DO jj = 2, jpjm1                 ! interior column only
-            DO ji = fs_2, fs_jpim1
-               !
-               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 
-                              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,*)
-                           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:'
-                           DO jk = 1, klc1
-                              WRITE(numout,*) jk, zvn2(jk)
-                           END DO
-                           WRITE(numout,*)
-                        ENDIF
-                        !
-                        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 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
-         !
-         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 )
-            CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )
-         ENDIF
-         !
-         CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )   ;   CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )
-         !
-         IF( lwp .AND. l_LB_debug ) THEN
-            WRITE(numout,*) 'Exiting tra_npc , kt = ',kt,', => numb. of statically instable water-columns: ', inpcc
-            WRITE(numout,*)
-         ENDIF
-         !
-         CALL wrk_dealloc(jpi, jpj, jpk, zn2 )
-         CALL wrk_dealloc(jpi, jpj, jpk, 2, zab )
-         CALL wrk_dealloc(jpk, zvn2 )
-         CALL wrk_dealloc(jpk, 2, zvts, zvab )
-         !
-      ENDIF   ! IF( MOD( kt, nn_npc ) == 0 ) THEN
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_npc')
-      !
-   END SUBROUTINE tra_npc
-
-   !!======================================================================
-END MODULE tranpc
Index: branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
===================================================================
--- branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 6827)
+++ 	(revision )
@@ -1,332 +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 on tracers
-   USE ldfslp
-   USE bdy_oce         ! BDY open boundary condition variables
-   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 wrk_nemo        ! Memory allocation
-   USE timing          ! Timing
-#if defined key_agrif
-   USE agrif_opa_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/OPA 3.3 , NEMO-Consortium (2010) 
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-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 (lk_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), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  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
-      !
-      CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1._wp )      ! local domain boundaries  (T-point, unchanged sign)
-      CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1._wp )
-      !
-#if defined key_bdy 
-      IF( lk_bdy )   CALL bdy_tra( kt )  ! BDY open boundaries
-#endif
- 
-      ! 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                    ! store now fields before applying the Asselin filter
-         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )
-         ztrdt(:,:,:) = tsn(:,:,:,jp_tem) 
-         ztrds(:,:,:) = tsn(:,:,:,jp_sal)
-         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
-      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
-         !
-      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
-         !
-         DO jn = 1, jpts
-            CALL lbc_lnk( tsb(:,:,:,jn), 'T', 1._wp ) 
-            CALL lbc_lnk( tsn(:,:,:,jn), 'T', 1._wp )
-            CALL lbc_lnk( tsa(:,:,:,jn), 'T', 1._wp )
-         END DO
-      ENDIF     
-      !
-      IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt     
-         DO jk = 1, jpkm1
-            zfact = 1._wp / r2dt             
-            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 )
-         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )
-      END IF
-      !
-      !                        ! 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( nn_timing == 1 )   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) ::   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   !   -      -
-      !!----------------------------------------------------------------------
-      !
-      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
-      !
-      DO jn = 1, kjpt      
-         DO jk = 1, jpkm1
-            zfact1 = atfp * p2dt
-            zfact2 = zfact1 * r1_rau0
-            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)   )  &
-                            &                   - (rnf_b(ji,jj)    - rnf(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
-                  !
-                  ! 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
-                  !
-               END DO
-            END DO
-         END DO
-         ! 
-      END DO
-      !
-   END SUBROUTINE tra_nxt_vvl
-
-   !!======================================================================
-END MODULE tranxt
Index: branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
===================================================================
--- branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 6827)
+++ 	(revision )
@@ -1,442 +1,0 @@
-MODULE traqsr
-   !!======================================================================
-   !!                       ***  MODULE  traqsr  ***
-   !! Ocean physics:   solar radiation penetration in the top ocean levels
-   !!======================================================================
-   !! History :  OPA  !  1990-10  (B. Blanke)  Original code
-   !!            7.0  !  1991-11  (G. Madec)
-   !!                 !  1996-01  (G. Madec)  s-coordinates
-   !!   NEMO     1.0  !  2002-06  (G. Madec)  F90: Free form and module
-   !!             -   !  2005-11  (G. Madec) zco, zps, sco coordinate
-   !!            3.2  !  2009-04  (G. Madec & NEMO team) 
-   !!            3.6  !  2012-05  (C. Rousset) store attenuation coef for use in ice model 
-   !!            3.6  !  2015-12  (O. Aumont, J. Jouanno, C. Ethe) use vertical profile of chlorophyll
-   !!            3.7  !  2015-11  (G. Madec, A. Coward)  remove optimisation for fix volume 
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_qsr       : temperature trend due to the penetration of solar radiation 
-   !!   tra_qsr_init  : initialization of the qsr penetration 
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and active tracers
-   USE phycst         ! physical constants
-   USE dom_oce        ! ocean space and time domain
-   USE sbc_oce        ! surface boundary condition: ocean
-   USE trc_oce        ! share SMS/Ocean variables
-   USE trd_oce        ! trends: ocean variables
-   USE trdtra         ! trends manager: tracers
-   !
-   USE in_out_manager ! I/O manager
-   USE prtctl         ! Print control
-   USE iom            ! I/O manager
-   USE fldread        ! read input fields
-   USE restart        ! ocean restart
-   USE lib_mpp        ! MPP library
-   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
-   USE wrk_nemo       ! Memory Allocation
-   USE timing         ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_qsr       ! routine called by step.F90 (ln_traqsr=T)
-   PUBLIC   tra_qsr_init  ! routine called by nemogcm.F90
-
-   !                                 !!* Namelist namtra_qsr: penetrative solar radiation
-   LOGICAL , PUBLIC ::   ln_traqsr    !: light absorption (qsr) flag
-   LOGICAL , PUBLIC ::   ln_qsr_rgb   !: Red-Green-Blue light absorption flag  
-   LOGICAL , PUBLIC ::   ln_qsr_2bd   !: 2 band         light absorption flag
-   LOGICAL , PUBLIC ::   ln_qsr_bio   !: bio-model      light absorption flag
-   LOGICAL , PUBLIC ::   ln_qsr_ice   !: light penetration for ice-model LIM3 (clem)
-   INTEGER , PUBLIC ::   nn_chldta    !: use Chlorophyll data (=1) or not (=0)
-   REAL(wp), PUBLIC ::   rn_abs       !: fraction absorbed in the very near surface (RGB & 2 bands)
-   REAL(wp), PUBLIC ::   rn_si0       !: very near surface depth of extinction      (RGB & 2 bands)
-   REAL(wp), PUBLIC ::   rn_si1       !: deepest depth of extinction (water type I)       (2 bands)
-   !
-   INTEGER , PUBLIC ::   nksr         !: levels below which the light cannot penetrate (depth larger than 391 m)
- 
-   INTEGER, PARAMETER ::   np_RGB  = 1   ! R-G-B     light penetration with constant Chlorophyll
-   INTEGER, PARAMETER ::   np_RGBc = 2   ! R-G-B     light penetration with Chlorophyll data
-   INTEGER, PARAMETER ::   np_2BD  = 3   ! 2 bands   light penetration
-   INTEGER, PARAMETER ::   np_BIO  = 4   ! bio-model light penetration
-   !
-   INTEGER  ::   nqsr    ! user choice of the type of light penetration
-   REAL(wp) ::   xsi0r   ! inverse of rn_si0
-   REAL(wp) ::   xsi1r   ! inverse of rn_si1
-   !
-   REAL(wp) , DIMENSION(3,61)           ::   rkrgb    ! tabulated attenuation coefficients for RGB absorption
-   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_chl   ! structure of input Chl (file informations, fields read)
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tra_qsr( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_qsr  ***
-      !!
-      !! ** Purpose :   Compute the temperature trend due to the solar radiation
-      !!              penetration and add it to the general temperature trend.
-      !!
-      !! ** Method  : The profile of the solar radiation within the ocean is defined
-      !!      through 2 wavebands (rn_si0,rn_si1) or 3 wavebands (RGB) and a ratio rn_abs
-      !!      Considering the 2 wavebands case:
-      !!         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)
-      !!         At the bottom, boudary condition for the radiation is no flux :
-      !!      all heat which has not been absorbed in the above levels is put
-      !!      in the last ocean level.
-      !!         The computation is only done down to the level where 
-      !!      I(k) < 1.e-15 W/m2 (i.e. over the top nksr levels) . 
-      !!
-      !! ** Action  : - update ta with the penetrative solar radiation trend
-      !!              - send  trend for further diagnostics (l_trdtra=T)
-      !!
-      !! Reference  : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp.
-      !!              Lengaigne et al. 2007, Clim. Dyn., V28, 5, 503-516.
-      !!              Morel, A. et Berthon, JF, 1989, Limnol Oceanogr 34(8), 1545-1562
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt     ! ocean time-step
-      !
-      INTEGER  ::   ji, jj, jk               ! dummy loop indices
-      INTEGER  ::   irgb                     ! local integers
-      REAL(wp) ::   zchl, zcoef, z1_2        ! local scalars
-      REAL(wp) ::   zc0 , zc1 , zc2 , zc3    !    -         -
-      REAL(wp) ::   zzc0, zzc1, zzc2, zzc3   !    -         -
-      REAL(wp) ::   zz0 , zz1                !    -         -
-      REAL(wp) ::   zCb, zCmax, zze, zpsi, zpsimax, zdelpsi, zCtot, zCze
-      REAL(wp) ::   zlogc, zlogc2, zlogc3 
-      REAL(wp), POINTER, DIMENSION(:,:)   :: zekb, zekg, zekr
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zetot, zchl3d
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_qsr')
-      !
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_qsr : penetration of the surface solar radiation'
-         IF(lwp) WRITE(numout,*) '~~~~~~~'
-      ENDIF
-      !
-      IF( l_trdtra ) THEN      ! trends diagnostic: save the input temperature trend
-         CALL wrk_alloc( jpi,jpj,jpk,   ztrdt ) 
-         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
-      ENDIF
-      !
-      !                         !-----------------------------------!
-      !                         !  before qsr induced heat content  !
-      !                         !-----------------------------------!
-      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(lwp) WRITE(numout,*) '          nit000-1 qsr tracer content forcing field read in the restart file'
-            z1_2 = 0.5_wp
-            CALL iom_get( numror, jpdom_autoglo, 'qsr_hc_b', qsr_hc_b )   ! before heat content trend due to Qsr flux
-         ELSE                                           ! No restart or restart not found: Euler forward time stepping
-            z1_2 = 1._wp
-            qsr_hc_b(:,:,:) = 0._wp
-         ENDIF
-      ELSE                             !==  Swap of qsr heat content  ==!
-         z1_2 = 0.5_wp
-         qsr_hc_b(:,:,:) = qsr_hc(:,:,:)
-      ENDIF
-      !
-      !                         !--------------------------------!
-      SELECT CASE( nqsr )       !  now qsr induced heat content  !
-      !                         !--------------------------------!
-      !
-      CASE( np_BIO )                   !==  bio-model fluxes  ==!
-         !
-         DO jk = 1, nksr
-            qsr_hc(:,:,jk) = r1_rau0_rcp * ( etot3(:,:,jk) - etot3(:,:,jk+1) )
-         END DO
-         !
-      CASE( np_RGB , np_RGBc )         !==  R-G-B fluxes  ==!
-         !
-         CALL wrk_alloc( jpi,jpj,       zekb, zekg, zekr        ) 
-         CALL wrk_alloc( jpi,jpj,jpk,   ze0, ze1, ze2, ze3, zea, zchl3d ) 
-         !
-         IF( nqsr == np_RGBc ) THEN          !*  Variable Chlorophyll
-            CALL fld_read( kt, 1, sf_chl )         ! Read Chl data and provides it at the current time step
-            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
-                     zchl    = 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
-                     !
-                     zlogc   = LOG( zchl )
-                     zlogc2  = zlogc * zlogc
-                     zlogc3  = zlogc * zlogc * zlogc
-                     zCb     = 0.768 + 0.087 * zlogc - 0.179 * zlogc2 - 0.025 * zlogc3
-                     zCmax   = 0.299 - 0.289 * zlogc + 0.579 * zlogc2
-                     zpsimax = 0.6   - 0.640 * zlogc + 0.021 * zlogc2 + 0.115 * zlogc3
-                     zdelpsi = 0.710 + 0.159 * zlogc + 0.021 * zlogc2
-                     zCze    = 1.12  * (zchl)**0.803 
-                     !
-                     zchl3d(ji,jj,jk) = zCze * ( zCb + zCmax * EXP( -( (zpsi - zpsimax) / zdelpsi )**2 ) )
-                  END DO
-                  !
-               END DO
-            END DO
-         ELSE                                !* constant chrlorophyll
-           DO jk = 1, nksr + 1
-              zchl3d(:,:,jk) = 0.05 
-            ENDDO
-         ENDIF
-         !
-         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
-         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
-         !
-         CALL wrk_dealloc( jpi,jpj,        zekb, zekg, zekr        ) 
-         CALL wrk_dealloc( jpi,jpj,jpk,   ze0, ze1, ze2, ze3, zea, zchl3d ) 
-         !
-      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
-         !
-      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
-      !
-      IF( ln_qsr_ice ) THEN      ! 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
-         ! Update haloes since lim_thd needs fraqsr_1lev to be defined everywhere
-         CALL lbc_lnk( fraqsr_1lev(:,:), 'T', 1._wp )
-      ENDIF
-      !
-      IF( iom_use('qsr3d') ) THEN      ! output the shortwave Radiation distribution
-         CALL wrk_alloc( jpi,jpj,jpk,   zetot )
-         !
-         zetot(:,:,nksr+1:jpk) = 0._wp     ! below ~400m set to zero
-         DO jk = nksr, 1, -1
-            zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) / r1_rau0_rcp
-         END DO         
-         CALL iom_put( 'qsr3d', zetot )   ! 3D distribution of shortwave Radiation
-         !
-         CALL wrk_dealloc( jpi,jpj,jpk,   zetot ) 
-      ENDIF
-      !
-      IF( lrst_oce ) THEN     ! write in the ocean restart file
-         CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b'   , qsr_hc      )
-         CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev ) 
-      ENDIF
-      !
-      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 )
-         CALL wrk_dealloc( jpi,jpj,jpk,   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( nn_timing == 1 )  CALL timing_stop('tra_qsr')
-      !
-   END SUBROUTINE tra_qsr
-
-
-   SUBROUTINE tra_qsr_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_qsr_init  ***
-      !!
-      !! ** Purpose :   Initialization for the penetrative solar radiation
-      !!
-      !! ** Method  :   The profile of solar radiation within the ocean is set
-      !!      from two length scale of penetration (rn_si0,rn_si1) and a ratio
-      !!      (rn_abs). These parameters are read in the namtra_qsr namelist. The
-      !!      default values correspond to clear water (type I in Jerlov' 
-      !!      (1968) classification.
-      !!         called by tra_qsr at the first timestep (nit000)
-      !!
-      !! ** Action  : - initialize rn_si0, rn_si1 and rn_abs
-      !!
-      !! Reference : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp.
-      !!----------------------------------------------------------------------
-      INTEGER  ::   ji, jj, jk                  ! dummy loop indices
-      INTEGER  ::   ios, irgb, ierror, ioptio   ! local integer
-      REAL(wp) ::   zz0, zc0 , zc1, zcoef      ! local scalars
-      REAL(wp) ::   zz1, zc2 , zc3, zchl       !   -      -
-      !
-      CHARACTER(len=100) ::   cn_dir   ! Root directory for location of ssr files
-      TYPE(FLD_N)        ::   sn_chl   ! informations about the chlorofyl field to be read
-      !!
-      NAMELIST/namtra_qsr/  sn_chl, cn_dir, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, ln_qsr_ice,  &
-         &                  nn_chldta, rn_abs, rn_si0, rn_si1
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )   CALL timing_start('tra_qsr_init')
-      !
-      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', lwp )
-      !
-      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', lwp )
-      IF(lwm) WRITE ( numond, namtra_qsr )
-      !
-      IF(lwp) THEN                ! control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'tra_qsr_init : penetration of the surface solar radiation'
-         WRITE(numout,*) '~~~~~~~~~~~~'
-         WRITE(numout,*) '   Namelist namtra_qsr : set the parameter of penetration'
-         WRITE(numout,*) '      RGB (Red-Green-Blue) light penetration       ln_qsr_rgb = ', ln_qsr_rgb
-         WRITE(numout,*) '      2 band               light penetration       ln_qsr_2bd = ', ln_qsr_2bd
-         WRITE(numout,*) '      bio-model            light penetration       ln_qsr_bio = ', ln_qsr_bio
-         WRITE(numout,*) '      light penetration for ice-model (LIM3)       ln_qsr_ice = ', ln_qsr_ice
-         WRITE(numout,*) '      RGB : Chl data (=1) or cst value (=0)        nn_chldta  = ', nn_chldta
-         WRITE(numout,*) '      RGB & 2 bands: fraction of light (rn_si1)    rn_abs     = ', rn_abs
-         WRITE(numout,*) '      RGB & 2 bands: shortess depth of extinction  rn_si0     = ', rn_si0
-         WRITE(numout,*) '      2 bands: longest depth of extinction         rn_si1     = ', rn_si1
-         WRITE(numout,*)
-      ENDIF
-      !
-      ioptio = 0                    ! Parameter control
-      IF( ln_qsr_rgb  )   ioptio = ioptio + 1
-      IF( ln_qsr_2bd  )   ioptio = ioptio + 1
-      IF( ln_qsr_bio  )   ioptio = ioptio + 1
-      !
-      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE type of light penetration in namelist namtra_qsr',  &
-         &                               ' 2 bands, 3 RGB bands or bio-model light penetration' )
-      !
-      IF( ln_qsr_rgb .AND. nn_chldta == 0 )   nqsr = np_RGB 
-      IF( ln_qsr_rgb .AND. nn_chldta == 1 )   nqsr = np_RGBc
-      IF( ln_qsr_2bd                      )   nqsr = np_2BD
-      IF( ln_qsr_bio                      )   nqsr = np_BIO
-      !
-      !                             ! Initialisation
-      xsi0r = 1._wp / rn_si0
-      xsi1r = 1._wp / rn_si1
-      !
-      SELECT CASE( nqsr )
-      !                               
-      CASE( np_RGB , np_RGBc )         !==  Red-Green-Blue light penetration  ==!
-         !                             
-         IF(lwp)   WRITE(numout,*) '   R-G-B   light penetration '
-         !
-         CALL trc_oce_rgb( rkrgb )                 ! tabulated attenuation coef.
-         !                                   
-         nksr = trc_oce_ext_lev( r_si2, 33._wp )   ! level of light extinction
-         !
-         IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksr, ' ref depth = ', gdepw_1d(nksr+1), ' m'
-         !
-         IF( nqsr == np_RGBc ) THEN                ! Chl data : set sf_chl structure
-            IF(lwp) WRITE(numout,*) '        Chlorophyll read in a file'
-            ALLOCATE( sf_chl(1), STAT=ierror )
-            IF( ierror > 0 ) THEN
-               CALL ctl_stop( 'tra_qsr_init: unable to allocate sf_chl structure' )   ;   RETURN
-            ENDIF
-            ALLOCATE( sf_chl(1)%fnow(jpi,jpj,1)   )
-            IF( sn_chl%ln_tint )   ALLOCATE( sf_chl(1)%fdta(jpi,jpj,1,2) )
-            !                                        ! fill sf_chl with sn_chl and control print
-            CALL fld_fill( sf_chl, (/ sn_chl /), cn_dir, 'tra_qsr_init',   &
-               &           'Solar penetration function of read chlorophyll', 'namtra_qsr' )
-         ENDIF
-         IF( nqsr == np_RGB ) THEN                 ! constant Chl
-            IF(lwp) WRITE(numout,*) '        Constant Chlorophyll concentration = 0.05'
-         ENDIF
-         !
-      CASE( np_2BD )                   !==  2 bands light penetration  ==!
-         !
-         IF(lwp)  WRITE(numout,*) '   2 bands light penetration'
-         !
-         nksr = trc_oce_ext_lev( rn_si1, 100._wp )    ! level of light extinction
-         IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksr, ' ref depth = ', gdepw_1d(nksr+1), ' m'
-         !
-      CASE( np_BIO )                   !==  BIO light penetration  ==!
-         !
-         IF(lwp) WRITE(numout,*) '   bio-model light penetration'
-         IF( .NOT.lk_qsr_bio )   CALL ctl_stop( 'No bio model : ln_qsr_bio = true impossible ' )
-         !
-      END SELECT
-      !
-      qsr_hc(:,:,:) = 0._wp     ! now qsr heat content set to zero where it will not be computed
-      !
-      ! 1st ocean level attenuation coefficient (used in sbcssm)
-      IF( iom_varid( numror, 'fraqsr_1lev', ldstop = .FALSE. ) > 0 ) THEN
-         CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev'  , fraqsr_1lev  )
-      ELSE
-         fraqsr_1lev(:,:) = 1._wp   ! default : no penetration
-      ENDIF
-      !
-      IF( nn_timing == 1 )   CALL timing_stop('tra_qsr_init')
-      !
-   END SUBROUTINE tra_qsr_init
-
-   !!======================================================================
-END MODULE traqsr
Index: branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
===================================================================
--- branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90	(revision 6827)
+++ 	(revision )
@@ -1,249 +1,0 @@
-MODULE trasbc
-   !!==============================================================================
-   !!                       ***  MODULE  trasbc  ***
-   !! Ocean active tracers:  surface boundary condition
-   !!==============================================================================
-   !! History :  OPA  !  1998-10  (G. Madec, G. Roullet, M. Imbard)  Original code
-   !!            8.2  !  2001-02  (D. Ludicone)  sea ice and free surface
-   !!  NEMO      1.0  !  2002-06  (G. Madec)  F90: Free form and module
-   !!            3.3  !  2010-04  (M. Leclair, G. Madec)  Forcing averaged over 2 time steps
-   !!             -   !  2010-09  (C. Ethe, G. Madec) Merge TRA-TRC
-   !!            3.6  !  2014-11  (P. Mathiot) isf melting forcing 
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_sbc       : update the tracer trend at ocean surface
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and active tracers
-   USE sbc_oce        ! surface boundary condition: ocean
-   USE dom_oce        ! ocean space domain variables
-   USE phycst         ! physical constant
-   USE eosbn2         ! Equation Of State
-   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
-   USE trdtra         ! trends manager: tracers 
-   !
-   USE in_out_manager ! I/O manager
-   USE prtctl         ! Print control
-   USE iom            ! xIOS server
-   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
-   USE wrk_nemo       ! Memory Allocation
-   USE timing         ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_sbc   ! routine called by step.F90
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tra_sbc ( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_sbc  ***
-      !!                   
-      !! ** Purpose :   Compute the tracer surface boundary condition trend of
-      !!      (flux through the interface, concentration/dilution effect)
-      !!      and add it to the general trend of tracer equations.
-      !!
-      !! ** Method :   The (air+ice)-sea flux has two components: 
-      !!      (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).
-      !!               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
-      !!             interface. Therefore another term has to be added, to mimic the
-      !!             concentration/dilution effect associated with water exchanges.
-      !!
-      !! ** Action  : - Update tsa 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  ::   ji, jj, jk, jn        ! dummy loop indices  
-      INTEGER  ::   ikt, ikb              ! local integers
-      REAL(wp) ::   zfact, z1_e3t, zdep   ! local scalar
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_sbc')
-      !
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_sbc : TRAcer Surface Boundary Condition'
-         IF(lwp) WRITE(numout,*) '~~~~~~~ '
-      ENDIF
-      !
-      IF( l_trdtra ) THEN                    !* Save ta and sa trends
-         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
-         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
-         ztrds(:,:,:) = tsa(:,:,:,jp_sal)
-      ENDIF
-      !
-!!gm  This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist)
-      IF( .NOT.ln_traqsr ) THEN     ! no solar radiation penetration
-         qns(:,:) = qns(:,:) + qsr(:,:)      ! total heat flux in qns
-         qsr(:,:) = 0._wp                     ! qsr set to zero
-      ENDIF
-
-      !----------------------------------------
-      !        EMP, SFX and QNS effects
-      !----------------------------------------
-      !                             !==  Set before sbc tracer content fields  ==!
-      IF( kt == nit000 ) THEN             !* 1st time-step
-         IF( ln_rstart .AND.    &               ! Restart: read in restart file
-              & iom_varid( numror, 'sbc_hc_b', ldstop = .FALSE. ) > 0 ) THEN
-            IF(lwp) WRITE(numout,*) '          nit000-1 sbc tracer content field read in the restart file'
-            zfact = 0.5_wp
-            CALL iom_get( numror, jpdom_autoglo, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem) )   ! before heat content sbc trend
-            CALL iom_get( numror, jpdom_autoglo, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal) )   ! before salt content sbc trend
-         ELSE                                   ! No restart or restart not found: Euler forward time stepping
-            zfact = 1._wp
-            sbc_tsc(:,:,:) = 0._wp
-            sbc_tsc_b(:,:,:) = 0._wp
-         ENDIF
-      ELSE                                !* other time-steps: swap of forcing fields
-         zfact = 0.5_wp
-         sbc_tsc_b(:,:,:) = sbc_tsc(:,:,:)
-      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
-      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) )
-      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
-      END DO
-      !                  
-      IF( lrst_oce ) THEN           !==  write sbc_tsc in the ocean restart file  ==!
-         CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem) )
-         CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal) )
-      ENDIF
-      !
-      !----------------------------------------
-      !       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
-         IF( lrst_oce ) THEN
-            CALL iom_rstput( kt, nitrst, numrow, 'fwf_isf_b', fwfisf  (:,:)        )
-            CALL iom_rstput( kt, nitrst, numrow, 'isf_hc_b' , risf_tsc(:,:,jp_tem) )
-            CALL iom_rstput( kt, nitrst, numrow, 'isf_sc_b' , risf_tsc(:,:,jp_sal) )
-         ENDIF
-      END IF
-      !
-      !----------------------------------------
-      !        River Runoff effects
-      !----------------------------------------
-      !
-      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
-
-      !
-      !----------------------------------------
-      !        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 )
-         CALL wrk_dealloc( jpi, jpj, jpk, 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( nn_timing == 1 )  CALL timing_stop('tra_sbc')
-      !
-   END SUBROUTINE tra_sbc
-
-   !!======================================================================
-END MODULE trasbc
Index: branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90
===================================================================
--- branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90	(revision 6827)
+++ 	(revision )
@@ -1,150 +1,0 @@
-MODULE trazdf
-   !!==============================================================================
-   !!                 ***  MODULE  trazdf  ***
-   !! Ocean active tracers:  vertical component of the tracer mixing trend
-   !!==============================================================================
-   !! History :  1.0  ! 2005-11  (G. Madec)  Original code
-   !!            3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_zdf       : Update the tracer trend with the vertical diffusion
-   !!   tra_zdf_init  : initialisation of the computation
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and tracers variables
-   USE dom_oce        ! ocean space and time domain variables 
-   USE domvvl         ! variable volume
-   USE phycst         ! physical constant
-   USE zdf_oce        ! ocean vertical physics variables
-   USE sbc_oce        ! surface boundary condition: ocean
-   USE ldftra         ! lateral diffusion: eddy diffusivity
-   USE ldfslp         ! lateral diffusion: iso-neutral slope 
-   USE trazdf_exp     ! vertical diffusion: explicit (tra_zdf_exp routine)
-   USE trazdf_imp     ! vertical diffusion: implicit (tra_zdf_imp routine)
-   USE trd_oce        ! trends: ocean variables
-   USE trdtra         ! trends: tracer trend manager
-   !
-   USE in_out_manager ! I/O manager
-   USE prtctl         ! Print control
-   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
-   USE lib_mpp        ! MPP library
-   USE wrk_nemo       ! Memory allocation
-   USE timing         ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_zdf        ! routine called by step.F90
-   PUBLIC   tra_zdf_init   ! routine called by nemogcm.F90
-
-   INTEGER ::   nzdf = 0   ! type vertical diffusion algorithm used (defined from ln_zdf...  namlist logicals)
-
-   !! * Substitutions
-#  include "zdfddm_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tra_zdf( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_zdf  ***
-      !!
-      !! ** Purpose :   compute the vertical ocean tracer physics.
-      !!---------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
-      !
-      INTEGER  ::   jk                   ! Dummy loop indices
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdt, ztrds   ! 3D workspace
-      !!---------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_zdf')
-      !
-      IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000
-         r2dt =  rdt                          ! = rdt (restarting with Euler time stepping)
-      ELSEIF( kt <= nit000 + 1) THEN                ! at nit000 or nit000+1
-         r2dt = 2. * rdt                      ! = 2 rdt (leapfrog)
-      ENDIF
-      !
-      IF( l_trdtra )   THEN                    !* Save ta and sa trends
-         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )
-         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
-         ztrds(:,:,:) = tsa(:,:,:,jp_sal)
-      ENDIF
-      !
-      SELECT CASE ( nzdf )                       ! compute lateral mixing trend and add it to the general trend
-      CASE ( 0 )    ;    CALL tra_zdf_exp( kt, nit000, 'TRA', r2dt, nn_zdfexp, tsb, tsa, jpts )  !   explicit scheme 
-      CASE ( 1 )    ;    CALL tra_zdf_imp( kt, nit000, 'TRA', r2dt,            tsb, tsa, jpts )  !   implicit scheme 
-      END SELECT
-!!gm WHY here !   and I don't like that !
-      ! DRAKKAR SSS control {
-      ! 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
-!!gm
-
-      IF( l_trdtra )   THEN                      ! save the vertical diffusive trends for further diagnostics
-         DO jk = 1, jpkm1
-            ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / r2dt ) - ztrdt(:,:,jk)
-            ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dt ) - ztrds(:,:,jk)
-         END DO
-!!gm this should be moved in trdtra.F90 and done on all trends
-         CALL lbc_lnk( ztrdt, 'T', 1. )
-         CALL lbc_lnk( 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 wrk_dealloc( jpi, jpj, jpk, 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( nn_timing == 1 )  CALL timing_stop('tra_zdf')
-      !
-   END SUBROUTINE tra_zdf
-
-
-   SUBROUTINE tra_zdf_init
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE tra_zdf_init  ***
-      !!
-      !! ** Purpose :   Choose the vertical mixing scheme
-      !!
-      !! ** Method  :   Set nzdf from ln_zdfexp
-      !!      nzdf = 0   explicit (time-splitting) scheme (ln_zdfexp=T)
-      !!           = 1   implicit (euler backward) scheme (ln_zdfexp=F)
-      !!      NB: rotation of lateral mixing operator or TKE & GLS schemes,
-      !!          an implicit scheme is required.
-      !!----------------------------------------------------------------------
-      USE zdftke
-      USE zdfgls
-      !!----------------------------------------------------------------------
-      !
-      ! Choice from ln_zdfexp already read in namelist in zdfini module
-      IF( ln_zdfexp ) THEN   ;   nzdf = 0           ! use explicit scheme
-      ELSE                   ;   nzdf = 1           ! use implicit scheme
-      ENDIF
-      !
-      ! Force implicit schemes
-      IF( lk_zdftke .OR. lk_zdfgls   )   nzdf = 1   ! TKE, or GLS physics
-      IF( ln_traldf_iso              )   nzdf = 1   ! iso-neutral lateral physics
-      IF( ln_traldf_hor .AND. ln_sco )   nzdf = 1   ! horizontal lateral physics in s-coordinate
-      IF( ln_zdfexp .AND. nzdf == 1 )   CALL ctl_stop( 'tra_zdf : If using the rotation of lateral mixing operator',   &
-            &                         ' GLS or TKE scheme, the implicit scheme is required, set ln_zdfexp = .false.' )
-            !
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'tra_zdf_init : vertical tracer physics scheme'
-         WRITE(numout,*) '~~~~~~~~~~~'
-         IF( nzdf ==  0 )   WRITE(numout,*) '              Explicit time-splitting scheme'
-         IF( nzdf ==  1 )   WRITE(numout,*) '              Implicit (euler backward) scheme'
-      ENDIF
-      !
-   END SUBROUTINE tra_zdf_init
-
-   !!==============================================================================
-END MODULE trazdf
Index: branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90
===================================================================
--- branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90	(revision 6827)
+++ 	(revision )
@@ -1,153 +1,0 @@
-MODULE trazdf_exp
-   !!==============================================================================
-   !!                    ***  MODULE  trazdf_exp  ***
-   !! Ocean  tracers:  vertical component of the tracer mixing trend using
-   !!                  a split-explicit time-stepping 
-   !!==============================================================================
-   !! History :  OPA  !  1990-10  (B. Blanke)  Original code
-   !!            7.0  !  1991-11  (G. Madec)
-   !!                 !  1992-06  (M. Imbard)  correction on tracer trend loops
-   !!                 !  1996-01  (G. Madec)  statement function for e3
-   !!                 !  1997-05  (G. Madec)  vertical component of isopycnal
-   !!                 !  1997-07  (G. Madec)  geopotential diffusion in s-coord
-   !!                 !  2000-08  (G. Madec)  double diffusive mixing
-   !!   NEMO     1.0  !  2002-08  (G. Madec)  F90: Free form and module
-   !!             -   !  2004-08  (C. Talandier) New trends organisation
-   !!             -   !  2005-11  (G. Madec)  New organisation
-   !!            3.0  !  2008-04  (G. Madec)  leap-frog time stepping done in trazdf
-   !!            3.3  !  2010-06  (C. Ethe, G. Madec) Merge TRA-TRC
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_zdf_exp   : compute the tracer the vertical diffusion trend using a
-   !!                   split-explicit time stepping and provide the after tracer
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and active tracers 
-   USE dom_oce        ! ocean space and time domain 
-   USE domvvl         ! variable volume levels
-   USE zdf_oce        ! ocean vertical physics
-   USE zdfddm         ! ocean vertical physics: double diffusion
-   USE trc_oce        ! share passive tracers/Ocean variables
-   !
-   USE in_out_manager ! I/O manager
-   USE lib_mpp        ! MPP library
-   USE wrk_nemo       ! Memory Allocation
-   USE timing         ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_zdf_exp   ! routine called by step.F90
-
-   !! * Substitutions
-#  include "zdfddm_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tra_zdf_exp( kt, kit000, cdtype, p2dt, ksts,   &
-      &                                        ptb , pta , kjpt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_zdf_exp  ***
-      !!                   
-      !! ** Purpose :   Compute the after tracer fields due to the vertical
-      !!      tracer mixing alone, and then due to the whole tracer trend.
-      !!
-      !! ** Method  : - The after tracer fields due to the vertical diffusion
-      !!      of tracers alone is given by:
-      !!                ztb = ptb + p2dt difft
-      !!      where difft = dz( avt dz(ptb) ) = 1/e3t dk+1( avt/e3w dk(ptb) )
-      !!           (if lk_zdfddm=T use avs on salinity and passive tracers instead of avt)
-      !!      difft is evaluated with an Euler split-explit scheme using a
-      !!      no flux boundary condition at both surface and bottomi boundaries.
-      !!      (N.B. bottom condition is applied through the masked field avt).
-      !!              - the after tracer fields due to the whole trend is 
-      !!      obtained in leap-frog environment applied on thickness weighted tracer by :
-      !!          pta = [ ptb*e3tb + e3tn*( ztb - ptb + p2dt pta ) ] / e3tn
-      !!
-      !! ** Action : - after tracer fields pta
-      !!---------------------------------------------------------------------
-      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   ) ::   ksts     ! number of sub-time step
-      REAL(wp)                             , INTENT(in   ) ::   p2dt     ! vertical profile of 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 
-      !
-      INTEGER  ::  ji, jj, jk, jn, jl   ! dummy loop indices
-      REAL(wp) ::  z1_ksts, ze3tr       ! local scalars
-      REAL(wp) ::  ztra, ze3tb    !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztb, zwf
-      !!---------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_zdf_exp')
-      !
-      CALL wrk_alloc( jpi,jpj,jpk,   ztb, zwf ) 
-      !
-      IF( kt == kit000 )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_zdf_exp : explicit vertical mixing on ', cdtype
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-      ENDIF
-
-      ! Initializations
-      ! ---------------
-      z1_ksts = 1._wp / REAL( ksts, wp )
-      zwf(:,:, 1 ) = 0._wp    ! no flux at the surface and at bottom level
-      zwf(:,:,jpk) = 0._wp
-      !
-      !
-      DO jn = 1, kjpt         !==  loop over tracers  ==!
-         !
-         ztb(:,:,:) = ptb(:,:,:,jn)    ! initial before value for tracer
-         ! 
-         DO jl = 1, ksts         !==  Split-explicit loop  ==!
-            !              
-            DO jk = 2, jpk             ! 1st vertical derivative (w-flux)
-               DO jj = 2, jpjm1 
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN  ! temperature : use of avt
-                        zwf(ji,jj,jk) =   avt(ji,jj,jk) * ( ztb(ji,jj,jk-1) - ztb(ji,jj,jk) ) / e3w_b(ji,jj,jk)
-                     ELSE                                           ! salinity or pass. tracer : use of avs
-                        zwf(ji,jj,jk) = fsavs(ji,jj,jk) * ( ztb(ji,jj,jk-1) - ztb(ji,jj,jk) ) / e3w_b(ji,jj,jk)
-                     END IF
-                  END DO
-               END DO
-            END DO
-            !
-            DO jk = 1, jpkm1           ! 2nd vertical derivative   ==> tracer at kt+l*2*rdt/nn_zdfexp
-               DO jj = 2, jpjm1 
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ztb(ji,jj,jk) = ztb(ji,jj,jk) + p2dt * ( zwf(ji,jj,jk) - zwf(ji,jj,jk+1) ) / e3t_n(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
-            !
-         END DO                  ! end sub-time stepping
-
-         DO jk = 1, jpkm1        !==  After tracer due to all trends
-            DO jj = 2, jpjm1 
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ze3tb = e3t_b(ji,jj,jk) / e3t_n(ji,jj,jk)
-                  ztra  = ( ztb(ji,jj,jk) - ptb(ji,jj,jk,jn) ) + p2dt * pta(ji,jj,jk,jn)  ! total trend * 2dt 
-                  pta(ji,jj,jk,jn) = ( ze3tb * ptb(ji,jj,jk,jn) + ztra ) * tmask(ji,jj,jk)    ! after tracer
-               END DO
-            END DO
-         END DO
-         !
-      END DO                     ! end of tracer loop
-      !
-      CALL wrk_dealloc( jpi,jpj,jpk,   ztb, zwf ) 
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_zdf_exp')
-      !
-   END SUBROUTINE tra_zdf_exp
-
-   !!==============================================================================
-END MODULE trazdf_exp
Index: branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90
===================================================================
--- branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90	(revision 6827)
+++ 	(revision )
@@ -1,217 +1,0 @@
-MODULE trazdf_imp
-   !!======================================================================
-   !!                 ***  MODULE  trazdf_imp  ***
-   !! Ocean  tracers:  vertical component of the tracer mixing trend
-   !!======================================================================
-   !! History :  OPA  !  1990-10  (B. Blanke)  Original code
-   !!            7.0  !  1991-11  (G. Madec)
-   !!                 !  1992-06  (M. Imbard) correction on tracer trend loops
-   !!                 !  1996-01  (G. Madec) statement function for e3
-   !!                 !  1997-05  (G. Madec) vertical component of isopycnal
-   !!                 !  1997-07  (G. Madec) geopotential diffusion in s-coord
-   !!                 !  2000-08  (G. Madec) double diffusive mixing
-   !!   NEMO     1.0  !  2002-08  (G. Madec) F90: Free form and module
-   !!            2.0  !  2006-11  (G. Madec) New step reorganisation
-   !!            3.2  !  2009-03  (G. Madec)  heat and salt content trends
-   !!            3.3  !  2010-06  (C. Ethe, G. Madec) Merge TRA-TRC
-   !!             -   !  2011-02  (A. Coward, C. Ethe, G. Madec) improvment of surface boundary condition
-   !!            3.7  !  2015-11  (G. Madec, A. Coward)  non linear free surface by default 
-   !!----------------------------------------------------------------------
-  
-   !!----------------------------------------------------------------------
-   !!   tra_zdf_imp   : Update the tracer trend with vertical mixing, nad compute the after tracer field
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and tracers variables
-   USE dom_oce        ! ocean space and time domain variables 
-   USE zdf_oce        ! ocean vertical physics variables
-   USE trc_oce        ! share passive tracers/ocean variables
-   USE domvvl         ! variable volume
-   USE ldftra         ! lateral mixing type
-   USE ldfslp         ! lateral physics: slope of diffusion
-   USE zdfddm         ! ocean vertical physics: double diffusion
-   USE traldf_triad   ! active tracers: Method of Stabilizing Correction
-   !
-   USE in_out_manager ! I/O manager
-   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
-   USE lib_mpp        ! MPP library
-   USE wrk_nemo       ! Memory Allocation
-   USE timing         ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_zdf_imp   !  routine called by step.F90
-
-   !! * Substitutions
-#  include "zdfddm_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
- 
-   SUBROUTINE tra_zdf_imp( kt, kit000, cdtype, p2dt, ptb, pta, kjpt ) 
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_zdf_imp  ***
-      !!
-      !! ** Purpose :   Compute the after tracer through a implicit computation
-      !!     of the vertical tracer diffusion (including the vertical component 
-      !!     of lateral mixing (only for 2nd order operator, for fourth order 
-      !!     it is already computed and add to the general trend in traldf) 
-      !!
-      !! ** Method  :  The vertical diffusion of a tracer ,t , is given by:
-      !!          difft = dz( avt dz(t) ) = 1/e3t dk+1( avt/e3w dk(t) )
-      !!      It is computed using a backward time scheme (t=after field)
-      !!      which provide directly the after tracer field.
-      !!      If lk_zdfddm=T, use avs for salinity or for passive tracers
-      !!      Surface and bottom boundary conditions: no diffusive flux on
-      !!      both tracers (bottom, applied through the masked field avt).
-      !!      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
-      !
-      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp) ::  zrhs             ! local scalars
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwi, zwt, zwd, zws
-      !!---------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_zdf_imp')
-      !
-      CALL wrk_alloc( jpi,jpj,jpk,   zwi, zwt, zwd, zws ) 
-      !
-      IF( kt == kit000 )  THEN
-         IF(lwp)WRITE(numout,*)
-         IF(lwp)WRITE(numout,*) 'tra_zdf_imp : implicit vertical mixing on ', cdtype
-         IF(lwp)WRITE(numout,*) '~~~~~~~~~~~ '
-      ENDIF
-      !                                               ! ============= !
-      DO jn = 1, kjpt                                 !  tracer loop  !
-         !                                            ! ============= !
-         !  Matrix construction
-         ! --------------------
-         ! Build matrix if temperature or salinity (only in double diffusion case) or first passive tracer
-         !
-         IF(  ( cdtype == 'TRA' .AND. ( jn == jp_tem .OR. ( jn == jp_sal .AND. lk_zdfddm ) ) ) .OR.   &
-            & ( cdtype == 'TRC' .AND. jn == 1 )  )  THEN
-            !
-            ! vertical mixing coef.: avt for temperature, avs for salinity and passive tracers
-            IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN   ;   zwt(:,:,2:jpk) = avt  (:,:,2:jpk)
-            ELSE                                            ;   zwt(:,:,2:jpk) = fsavs(:,:,2:jpk)
-            ENDIF
-            zwt(:,:,1) = 0._wp
-            !
-            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
-               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
-               ENDIF
-            ENDIF
-            !
-            ! Diagonal, lower (i), upper (s)  (including the bottom boundary condition since avt is masked)
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-!!gm BUG  I think, use e3w_a instead of e3w_n
-                     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
-            !
-            !! Matrix inversion from the first level
-            !!----------------------------------------------------------------------
-            !   solve m.x = y  where m is a tri diagonal matrix ( jpk*jpk )
-            !
-            !        ( zwd1 zws1   0    0    0  )( zwx1 ) ( zwy1 )
-            !        ( zwi2 zwd2 zws2   0    0  )( zwx2 ) ( zwy2 )
-            !        (  0   zwi3 zwd3 zws3   0  )( zwx3 )=( zwy3 )
-            !        (        ...               )( ...  ) ( ...  )
-            !        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk )
-            !
-            !   m is decomposed in the product of an upper and lower triangular matrix.
-            !   The 3 diagonal terms are in 3d arrays: zwd, zws, zwi.
-            !   Suffices i,s and d indicate "inferior" (below diagonal), diagonal
-            !   and "superior" (above diagonal) components of the tridiagonal system.
-            !   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 
-            !   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
-            !
-         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 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
-         !                                            ! ================= !
-      END DO                                          !  end tracer loop  !
-      !                                               ! ================= !
-      !
-      CALL wrk_dealloc( jpi,jpj,jpk,   zwi, zwt, zwd, zws ) 
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_zdf_imp')
-      !
-   END SUBROUTINE tra_zdf_imp
-
-   !!==============================================================================
-END MODULE trazdf_imp
Index: branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90
===================================================================
--- branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90	(revision 6827)
+++ 	(revision )
@@ -1,459 +1,0 @@
-MODULE zpshde
-   !!======================================================================
-   !!                       ***  MODULE zpshde   ***
-   !! z-coordinate + partial step : Horizontal Derivative at ocean bottom level
-   !!======================================================================
-   !! History :  OPA  !  2002-04  (A. Bozec)  Original code
-   !!   NEMO     1.0  !  2002-08  (G. Madec E. Durand)  Optimization and Free form
-   !!             -   !  2004-03  (C. Ethe)  adapted for passive tracers
-   !!            3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA 
-   !!            3.6  !  2014-11  (P. Mathiot) Add zps_hde_isf (needed to open a cavity)
-   !!======================================================================
-   
-   !!----------------------------------------------------------------------
-   !!   zps_hde      :  Horizontal DErivative of T, S and rd at the last
-   !!                   ocean level (Z-coord. with Partial Steps)
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean: dynamics and tracers variables
-   USE dom_oce         ! domain: ocean variables
-   USE phycst          ! physical constants
-   USE eosbn2          ! ocean equation of state
-   USE in_out_manager  ! I/O manager
-   USE lbclnk          ! lateral boundary conditions (or mpp link)
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo        ! Memory allocation
-   USE timing          ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   zps_hde     ! routine called by step.F90
-   PUBLIC   zps_hde_isf ! routine called by step.F90
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE zps_hde( kt, kjpt, pta, pgtu, pgtv,   &
-      &                          prd, pgru, pgrv    )
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE zps_hde  ***
-      !!                    
-      !! ** Purpose :   Compute the horizontal derivative of T, S and rho
-      !!      at u- and v-points with a linear interpolation for z-coordinate
-      !!      with partial steps.
-      !!
-      !! ** Method  :   In z-coord with partial steps, scale factors on last 
-      !!      levels are different for each grid point, so that T, S and rd 
-      !!      points are not at the same depth as in z-coord. To have horizontal
-      !!      gradients again, we interpolate T and S at the good depth : 
-      !!      Linear interpolation of T, S   
-      !!         Computation of di(tb) and dj(tb) by vertical interpolation:
-      !!          di(t) = t~ - t(i,j,k) or t(i+1,j,k) - t~
-      !!          dj(t) = t~ - t(i,j,k) or t(i,j+1,k) - t~
-      !!         This formulation computes the two cases:
-      !!                 CASE 1                   CASE 2  
-      !!         k-1  ___ ___________   k-1   ___ ___________
-      !!                    Ti  T~                  T~  Ti+1
-      !!                  _____                        _____
-      !!         k        |   |Ti+1     k           Ti |   |
-      !!                  |   |____                ____|   |
-      !!              ___ |   |   |           ___  |   |   |
-      !!                  
-      !!      case 1->   e3w(i+1) >= e3w(i) ( and e3w(j+1) >= e3w(j) ) then
-      !!          t~ = t(i+1,j  ,k) + (e3w(i+1) - e3w(i)) * dk(Ti+1)/e3w(i+1)
-      !!        ( t~ = t(i  ,j+1,k) + (e3w(j+1) - e3w(j)) * dk(Tj+1)/e3w(j+1)  )
-      !!          or
-      !!      case 2->   e3w(i+1) <= e3w(i) ( and e3w(j+1) <= e3w(j) ) then
-      !!          t~ = t(i,j,k) + (e3w(i) - e3w(i+1)) * dk(Ti)/e3w(i )
-      !!        ( t~ = t(i,j,k) + (e3w(j) - e3w(j+1)) * dk(Tj)/e3w(j ) )
-      !!          Idem for di(s) and dj(s)          
-      !!
-      !!      For rho, we call eos which will compute rd~(t~,s~) at the right
-      !!      depth zh from interpolated T and S for the different formulations
-      !!      of the equation of state (eos).
-      !!      Gradient formulation for rho :
-      !!          di(rho) = rd~ - rd(i,j,k)   or   rd(i+1,j,k) - rd~
-      !!
-      !! ** Action  : compute for top interfaces
-      !!              - pgtu, pgtv: horizontal gradient of tracer at u- & v-points
-      !!              - pgru, pgrv: horizontal gradient of rho (if present) at u- & v-points
-      !!----------------------------------------------------------------------
-      INTEGER                              , INTENT(in   )           ::  kt          ! ocean time-step index
-      INTEGER                              , INTENT(in   )           ::  kjpt        ! number of tracers
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   )           ::  pta         ! 4D tracers fields
-      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtu, pgtv  ! hor. grad. of ptra at u- & v-pts 
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ), OPTIONAL ::  prd         ! 3D density anomaly fields
-      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgru, pgrv  ! hor. grad of prd at u- & v-pts (bottom)
-      !
-      INTEGER  ::   ji, jj, jn                  ! Dummy loop indices
-      INTEGER  ::   iku, ikv, ikum1, ikvm1      ! partial step level (ocean bottom level) at u- and v-points
-      REAL(wp) ::   ze3wu, ze3wv, zmaxu, zmaxv  ! local scalars
-      REAL(wp), DIMENSION(jpi,jpj)      ::   zri, zrj, zhi, zhj   ! NB: 3rd dim=1 to use eos
-      REAL(wp), DIMENSION(jpi,jpj,kjpt) ::   zti, ztj             ! 
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )   CALL timing_start( 'zps_hde')
-      !
-      pgtu(:,:,:)=0._wp   ;   zti (:,:,:)=0._wp   ;   zhi (:,:  )=0._wp
-      pgtv(:,:,:)=0._wp   ;   ztj (:,:,:)=0._wp   ;   zhj (:,:  )=0._wp
-      !
-      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
-         CALL lbc_lnk( pgtu(:,:,jn), 'U', -1. )   ;   CALL lbc_lnk( pgtv(:,:,jn), 'V', -1. )   ! Lateral boundary cond.
-         !
-      END DO
-      !                
-      IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part)
-         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
-         !
-         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
-         CALL lbc_lnk( pgru , 'U', -1. )   ;   CALL lbc_lnk( pgrv , 'V', -1. )   ! Lateral boundary conditions
-         !
-      END IF
-      !
-      IF( nn_timing == 1 )   CALL timing_stop( 'zps_hde')
-      !
-   END SUBROUTINE zps_hde
-   !
-   SUBROUTINE zps_hde_isf( kt, kjpt, pta, pgtu, pgtv, pgtui, pgtvi,  &
-      &                          prd, pgru, pgrv, pgrui, pgrvi )
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE zps_hde_isf  ***
-      !!                    
-      !! ** Purpose :   Compute the horizontal derivative of T, S and rho
-      !!      at u- and v-points with a linear interpolation for z-coordinate
-      !!      with partial steps for top (ice shelf) and bottom.
-      !!
-      !! ** Method  :   In z-coord with partial steps, scale factors on last 
-      !!      levels are different for each grid point, so that T, S and rd 
-      !!      points are not at the same depth as in z-coord. To have horizontal
-      !!      gradients again, we interpolate T and S at the good depth :
-      !!      For the bottom case:
-      !!      Linear interpolation of T, S   
-      !!         Computation of di(tb) and dj(tb) by vertical interpolation:
-      !!          di(t) = t~ - t(i,j,k) or t(i+1,j,k) - t~
-      !!          dj(t) = t~ - t(i,j,k) or t(i,j+1,k) - t~
-      !!         This formulation computes the two cases:
-      !!                 CASE 1                   CASE 2  
-      !!         k-1  ___ ___________   k-1   ___ ___________
-      !!                    Ti  T~                  T~  Ti+1
-      !!                  _____                        _____
-      !!         k        |   |Ti+1     k           Ti |   |
-      !!                  |   |____                ____|   |
-      !!              ___ |   |   |           ___  |   |   |
-      !!                  
-      !!      case 1->   e3w(i+1) >= e3w(i) ( and e3w(j+1) >= e3w(j) ) then
-      !!          t~ = t(i+1,j  ,k) + (e3w(i+1) - e3w(i)) * dk(Ti+1)/e3w(i+1)
-      !!        ( t~ = t(i  ,j+1,k) + (e3w(j+1) - e3w(j)) * dk(Tj+1)/e3w(j+1)  )
-      !!          or
-      !!      case 2->   e3w(i+1) <= e3w(i) ( and e3w(j+1) <= e3w(j) ) then
-      !!          t~ = t(i,j,k) + (e3w(i) - e3w(i+1)) * dk(Ti)/e3w(i )
-      !!        ( t~ = t(i,j,k) + (e3w(j) - e3w(j+1)) * dk(Tj)/e3w(j ) )
-      !!          Idem for di(s) and dj(s)          
-      !!
-      !!      For rho, we call eos which will compute rd~(t~,s~) at the right
-      !!      depth zh from interpolated T and S for the different formulations
-      !!      of the equation of state (eos).
-      !!      Gradient formulation for rho :
-      !!          di(rho) = rd~ - rd(i,j,k)   or   rd(i+1,j,k) - rd~
-      !!
-      !!      For the top case (ice shelf): As for the bottom case but upside down
-      !!
-      !! ** Action  : compute for top and bottom interfaces
-      !!              - pgtu, pgtv, pgtui, pgtvi: horizontal gradient of tracer at u- & v-points
-      !!              - pgru, pgrv, pgrui, pgtvi: horizontal gradient of rho (if present) at u- & v-points
-      !!----------------------------------------------------------------------
-      INTEGER                              , INTENT(in   )           ::  kt           ! ocean time-step index
-      INTEGER                              , INTENT(in   )           ::  kjpt         ! number of tracers
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   )           ::  pta          ! 4D tracers fields
-      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtu, pgtv   ! hor. grad. of ptra at u- & v-pts 
-      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF)
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ), OPTIONAL ::  prd          ! 3D density anomaly fields
-      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgru, pgrv   ! hor. grad of prd at u- & v-pts (bottom)
-      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgrui, pgrvi ! hor. grad of prd at u- & v-pts (top)
-      !
-      INTEGER  ::   ji, jj, jn      ! Dummy loop indices
-      INTEGER  ::   iku, ikv, ikum1, ikvm1,ikup1, ikvp1   ! partial step level (ocean bottom level) at u- and v-points
-      REAL(wp) ::  ze3wu, ze3wv, zmaxu, zmaxv             ! temporary scalars
-      REAL(wp), DIMENSION(jpi,jpj)      ::  zri, zrj, zhi, zhj   ! NB: 3rd dim=1 to use eos
-      REAL(wp), DIMENSION(jpi,jpj,kjpt) ::  zti, ztj             ! 
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start( 'zps_hde_isf')
-      !
-      pgtu (:,:,:) = 0._wp   ;   pgtv (:,:,:) =0._wp
-      pgtui(:,:,:) = 0._wp   ;   pgtvi(:,:,:) =0._wp
-      zti  (:,:,:) = 0._wp   ;   ztj  (:,:,:) =0._wp
-      zhi  (:,:  ) = 0._wp   ;   zhj  (:,:  ) =0._wp
-      !
-      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
-         CALL lbc_lnk( pgtu(:,:,jn), 'U', -1. )   ;   CALL lbc_lnk( pgtv(:,:,jn), 'V', -1. )   ! Lateral boundary cond.
-         !
-      END DO
-
-      ! horizontal derivative of density anomalies (rd)
-      IF( PRESENT( prd ) ) THEN         ! depth of the partial step level
-         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
-
-         ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial
-         ! step and store it in  zri, zrj for each  case
-         CALL eos( zti, zhi, zri )
-         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
-
-         CALL lbc_lnk( pgru , 'U', -1. )   ;   CALL lbc_lnk( pgrv , 'V', -1. )   ! Lateral boundary conditions
-         !
-      END IF
-      !
-      !     !==  (ISH)  compute grui and gruvi  ==!
-      !
-      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
-         CALL lbc_lnk( pgtui(:,:,jn), 'U', -1. ); CALL lbc_lnk( pgtvi(:,:,jn), 'V', -1. )   ! Lateral boundary cond.
-         !
-      END DO
-
-      IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part)
-         !
-         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
-         !
-         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
-         CALL lbc_lnk( pgrui   , 'U', -1. ); CALL lbc_lnk( pgrvi   , 'V', -1. )   ! Lateral boundary conditions
-         !
-      END IF  
-      !
-      IF( nn_timing == 1 )   CALL timing_stop( 'zps_hde_isf')
-      !
-   END SUBROUTINE zps_hde_isf
-   !!======================================================================
-END MODULE zpshde
Index: branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/module_example
===================================================================
--- branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/module_example	(revision 6827)
+++ 	(revision )
@@ -1,206 +1,0 @@
-MODULE exampl
-   !!======================================================================
-   !!                       ***  MODULE  exampl  ***
-   !! Ocean physics:  brief description of the purpose of the module
-   !!                 (please no more than 2 lines)
-   !!======================================================================
-   !! History : 3.0  !  2008-06  (Author Names)  Original code
-   !!            -   !  2008-08  (Author names)  brief description of modifications
-   !!           3.3  !  2010-11  (Author names)        -              -
-   !!----------------------------------------------------------------------
-#if defined key_example
-   !!----------------------------------------------------------------------
-   !!   'key_example'  :                brief description of the key option
-   !!----------------------------------------------------------------------
-   !!   exa_mpl       : list of module subroutine (caution, never use the
-   !!   exa_mpl_init  : name of the module for a routine)
-   !!   exa_mpl_stp   : Please try to use 3 letter block for routine names
-   !!----------------------------------------------------------------------
-   USE module_name1   ! brief description of the used module
-   USE module_name2   ! ....
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   exa_mpl        ! routine called in xxx.F90 module
-   PUBLIC   exa_mpl_init   ! routine called in nemogcm.F90 module
-
-   TYPE ::   FLD_E                !: Structure type definition
-      CHARACTER(lc) ::   clname      ! clname description (default length, lc, is 256, see par_kind.F90)
-      INTEGER       ::   nfreqh      ! nfreqh description 
-   END TYPE FLD_E 
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   var1         !: var1 description. CAUTION always use !: to describe
-   !                                                          !  a PUBLIC variable: simplify its search : 
-   !                                                          !  grep var1 *90 | grep '!:'
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   var2, var2   !: several variable on a same line OK, but 
-   !                                                          !  DO NOT use continuation lines in declaration
-
-   !                               !!* namelist nam_xxx *
-   LOGICAL   ::   ln_opt = .TRUE.   ! give the default value of each namelist parameter
-   CHARACTER ::   cn_tex = 'T'      ! short description  of the variable
-   INTEGER   ::   nn_opt = 1        ! please respect the DOCTOR norm for namelist variable
-   REAL(wp)  ::   rn_var = 2._wp    ! (it becomes easy to identify them in the code)
-   TYPE(FLD) ::   sn_ex             ! structure
-
-   INTEGER                          ::   nint    ! nint  description (local permanent variable)
-   REAL(wp)                         ::   var     ! var         -                -
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   array   ! array       -                -
-
-   !! * Substitutions
-#  include "exampl_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   INTEGER FUNCTION exa_mpl_alloc()
-      !!----------------------------------------------------------------------
-      !!                ***  FUNCTION exa_mpl_alloc  ***
-      !!----------------------------------------------------------------------
-      ALLOCATE( array(jpi,jpj,jpk) , STAT= exa_mpl_alloc )   ! Module array                                                                
-      !
-      IF( lk_mpp             )   CALL mpp_sum ( exa_mpl_alloc )
-      IF( exa_mpl_alloc /= 0 )   CALL ctl_warn('exa_mpl_alloc: failed to allocate arrays')
-      !
-   END FUNCTION exa_mpl_alloc
-   
-
-   SUBROUTINE exa_mpl( kt, pvar1, pvar2, ptab )
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE exa_mpl  ***
-      !!
-      !! ** Purpose :   Brief description of the routine
-      !!
-      !! ** Method  :   description of the methodoloy used to achieve the
-      !!                objectives of the routine. Be as clear as possible!
-      !!
-      !! ** Action  : - first action (share memory array/varible modified
-      !!                in this routine
-      !!              - second action .....
-      !!              - .....
-      !!
-      !! References :   Author et al., Short_name_review, Year
-      !!                Give references if exist otherwise suppress these lines
-      !!----------------------------------------------------------------------
-      USE toto_module      ! description of the module
-      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
-      USE wrk_nemo, ONLY:   zztab => wrk_2d_5                     ! 2D workspace
-      USE wrk_nemo, ONLY:   zwx => wrk_3d_12 , zwy => wrk_3d_13   ! 3D workspace
-      !!
-      INTEGER , INTENT(in   )                     ::   kt      ! short description 
-      INTEGER , INTENT(inout)                     ::   pvar1   !   -         -
-      REAL(wp), INTENT(  out)                     ::   pvar2   !   -         -
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   pvar2   !   -         -
-      !!
-      INTEGER  ::   ji, jj, jk       ! dummy loop arguments  (DOCTOR : start with j, but not jp)
-      INTEGER  ::   itoto, itata     ! temporary integers    (DOCTOR : start with i
-      REAL(wp) ::   zmlmin, zbbrau   ! temporary scalars     (DOCTOR : start with z)
-      REAL(wp) ::   zfact1, zfact2   ! do not use continuation lines in declaration
-      !!--------------------------------------------------------------------
-
-      IF( wrk_in_use(3, 12,13) .OR. wrk_in_use(2, 5 ) THEN
-         CALL ctl_stop('exa_mpl: requested workspace arrays unavailable')   ;   RETURN
-      ENDIF
-
-      IF( kt == nit000  )   CALL exa_mpl_init    ! Initialization (first time-step only)
-
-      zmlmin = 1.e-8                             ! Local constant initialization
-      zbbrau =  .5 * ebb / rau0
-      zfact1 = -.5 * rdt * efave
-      zfact2 = 1.5 * rdt * ediss
-
-      SELECT CASE ( npdl )                       ! short description of the action
-      !
-      CASE ( 0 )                                      ! describe case 1
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  avmv(ji,jj,jk) = ....
-               END DO
-            END DO
-         END DO
-         !
-      CASE ( 1 )                                      ! describe case 2
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  avmv(ji,jj,jk) = ...
-               END DO
-            END DO
-         END DO
-         !
-      END SELECT
-      !
-      CALL mpplnk2( avmu, 'U', 1. )              ! Lateral boundary conditions (unchanged sign)
-      !
-      IF( wrk_not_released(3, 12,13) .OR. wrk_not_released(2, 5 ) THEN
-         CALL ctl_stop('exa_mpl: failed to release workspace arrays')   ;   RETURN
-      ENDIF
-      !
-   END SUBROUTINE exa_mpl
-
-
-   SUBROUTINE exa_mpl_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE exa_mpl_init  ***
-      !!                   
-      !! ** Purpose :   initialization of ....
-      !!
-      !! ** Method  :   blah blah blah ...
-      !!
-      !! ** input   :   Namlist namexa
-      !!
-      !! ** Action  :   ...  
-      !!----------------------------------------------------------------------
-      INTEGER ::   ji, jj, jk, jit   ! dummy loop indices
-      INTEGER  ::   ios              ! Local integer output status for namelist read
-      !!
-      NAMELIST/namexa/ exa_v1, exa_v2, nexa_0, sn_ex     
-      !!----------------------------------------------------------------------
-      !
-      REWIND( numnam_ref )              ! Namelist namexa in reference namelist : Example
-      READ  ( numnam_ref, namexa, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namexa in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namexa in configuration namelist : Example
-      READ  ( numnam_cfg, namexa, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namexa in configuration namelist', lwp )
-   ! Output namelist for control
-      WRITE ( numond, namexa )
-      !
-      IF(lwp) THEN                              ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'exa_mpl_init : example '
-         WRITE(numout,*) '~~~~~~~~~~~~'
-         WRITE(numout,*) '   Namelist namexa : set example parameters'
-         WRITE(numout,*) '      brief desciption               exa_v1  = ', exa_v1
-         WRITE(numout,*) '      brief desciption               exa_v2  = ', exa_v2
-         WRITE(numout,*) '      brief desciption               nexa_0  = ', nexa_0
-         WRITE(numout,*) '      brief desciption          sn_ex%clname = ', sn_ex%clname
-         WRITE(numout,*) '      brief desciption          sn_ex%nfreqh = ', sn_ex%nfreqh
-      ENDIF
-      !
-      !                              ! allocate exa_mpl arrays      
-      IF( exa_mpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'exa_mpl_init : unable to allocate arrays' )
-      !                              ! Parameter control
-      IF( ln_opt      )   CALL ctl_stop( 'exa_mpl_init: this work and option xxx are incompatible'   )
-      IF( nn_opt == 2 )   CALL ctl_warn( 'exa_mpl_init: this work and option yyy may cause problems' )
-      !
-   END SUBROUTINE exa_mpl_init
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option :                                         NO example
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE exa_mpl( kt, pvar1, pvar2, ptab )              ! Empty routine
-      REAL::   ptab(:,:)
-      WRITE(*,*) 'exa_mpl: You should not have seen this print! error?', kt, pvar1, pvar2, ptab(1,1)
-   END SUBROUTINE exa_mpl
-#endif
-
-   !!======================================================================
-END MODULE exampl
Index: branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/step.F90
===================================================================
--- branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/step.F90	(revision 6827)
+++ 	(revision )
@@ -1,353 +1,0 @@
-MODULE step
-   !!======================================================================
-   !!                       ***  MODULE step  ***
-   !! Time-stepping   : manager of the ocean, tracer and ice time stepping
-   !!======================================================================
-   !! History :  OPA  !  1991-03  (G. Madec)  Original code
-   !!             -   !  1991-11  (G. Madec)
-   !!             -   !  1992-06  (M. Imbard)  add a first output record
-   !!             -   !  1996-04  (G. Madec)  introduction of dynspg
-   !!             -   !  1996-04  (M.A. Foujols)  introduction of passive tracer
-   !!            8.0  !  1997-06  (G. Madec)  new architecture of call
-   !!            8.2  !  1997-06  (G. Madec, M. Imbard, G. Roullet)  free surface
-   !!             -   !  1999-02  (G. Madec, N. Grima)  hpg implicit
-   !!             -   !  2000-07  (J-M Molines, M. Imbard)  Open Bondary Conditions
-   !!   NEMO     1.0  !  2002-06  (G. Madec)  free form, suppress macro-tasking
-   !!             -   !  2004-08  (C. Talandier) New trends organization
-   !!             -   !  2005-01  (C. Ethe) Add the KPP closure scheme
-   !!             -   !  2005-11  (G. Madec)  Reorganisation of tra and dyn calls
-   !!             -   !  2006-01  (L. Debreu, C. Mazauric)  Agrif implementation
-   !!             -   !  2006-07  (S. Masson)  restart using iom
-   !!            3.2  !  2009-02  (G. Madec, R. Benshila)  reintroduicing z*-coordinate
-   !!             -   !  2009-06  (S. Masson, G. Madec)  TKE restart compatible with key_cpl
-   !!            3.3  !  2010-05  (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface
-   !!             -   !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA
-   !!            3.4  !  2011-04  (G. Madec, C. Ethe) Merge of dtatem and dtasal
-   !!            3.6  !  2012-07  (J. Simeon, G. Madec. C. Ethe)  Online coarsening of outputs
-   !!            3.6  !  2014-04  (F. Roquet, G. Madec) New equations of state
-   !!            3.7  !  2014-10  (G. Madec)  LDF simplication 
-   !!             -   !  2014-12  (G. Madec) remove KPP scheme
-   !!             -   !  2015-11  (J. Chanut) free surface simplification
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   stp             : OPA system time-stepping
-   !!----------------------------------------------------------------------
-   USE step_oce         ! time stepping definition modules
-   !
-   USE iom              ! xIOs server
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   stp   ! called by nemogcm.F90
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-#if defined key_agrif
-   RECURSIVE SUBROUTINE stp( )
-      INTEGER             ::   kstp   ! ocean time-step index
-#else
-   SUBROUTINE stp( kstp )
-      INTEGER, INTENT(in) ::   kstp   ! ocean time-step index
-#endif
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE stp  ***
-      !!
-      !! ** Purpose : - Time stepping of OPA (momentum and active tracer eqs.)
-      !!              - Time stepping of LIM (dynamic and thermodynamic eqs.)
-      !!              - Tme stepping  of TRC (passive tracer eqs.)
-      !!
-      !! ** Method  : -1- Update forcings and data
-      !!              -2- Update ocean physics
-      !!              -3- Compute the t and s trends
-      !!              -4- Update t and s
-      !!              -5- Compute the momentum trends
-      !!              -6- Update the horizontal velocity
-      !!              -7- Compute the diagnostics variables (rd,N2, hdiv,w)
-      !!              -8- Outputs and diagnostics
-      !!----------------------------------------------------------------------
-      INTEGER ::   jk       ! dummy loop indice
-      INTEGER ::   indic    ! error indicator if < 0
-      INTEGER ::   kcall    ! optional integer argument (dom_vvl_sf_nxt)
-      !! ---------------------------------------------------------------------
-#if defined key_agrif
-      kstp = nit000 + Agrif_Nb_Step()
-      IF( lk_agrif_debug ) THEN
-         IF( Agrif_Root() .and. lwp)   WRITE(*,*) '---'
-         IF(lwp)   WRITE(*,*) 'Grid Number', Agrif_Fixed(),' time step ', kstp, 'int tstep', Agrif_NbStepint()
-      ENDIF
-      IF( kstp == nit000 + 1 )   lk_agrif_fstep = .FALSE.
-# if defined key_iomput
-      IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( cxios_context )
-# endif
-#endif
-      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! update I/O and calendar 
-      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-                             indic = 0                ! reset to no error condition
-                             
-      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)
-         IF( ln_crs      )   CALL iom_init( TRIM(cxios_context)//"_crs" )  ! for coarse grid
-      ENDIF
-      IF( kstp /= nit000 )   CALL day( kstp )         ! Calendar (day was already called at nit000 in day_init)
-                             CALL iom_setkt( kstp - nit000 + 1,      cxios_context          )   ! tell IOM we are at time step kstp
-      IF( ln_crs         )   CALL iom_setkt( kstp - nit000 + 1, TRIM(cxios_context)//"_crs" )   ! tell IOM we are at time step kstp
-
-      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! Update external forcing (tides, open boundaries, and surface boundary condition (including sea-ice)
-      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-      IF( lk_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( lk_bdy     )   CALL bdy_dta ( kstp, time_offset=+1 )   ! update dynamic & tracer data at open boundaries
-                         CALL sbc     ( kstp )                   ! Sea Boundary Condition (including sea-ice)
-
-      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! Update stochastic parameters and random T/S fluctuations
-      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      IF( ln_sto_eos ) CALL sto_par( kstp )          ! Stochastic parameters
-      IF( ln_sto_eos ) CALL sto_pts( tsn  )          ! Random T/S fluctuations
-
-      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! Ocean physics update                (ua, va, tsa used as workspace)
-      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-      !  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
-
-      !
-      !  VERTICAL PHYSICS
-                         CALL zdf_bfr( kstp )         ! bottom friction (if quadratic)
-      !                                               ! Vertical eddy viscosity and diffusivity coefficients
-      IF( lk_zdfric  )   CALL zdf_ric( kstp )            ! Richardson number dependent Kz
-      IF( lk_zdftke  )   CALL zdf_tke( kstp )            ! TKE closure scheme for Kz
-      IF( lk_zdfgls  )   CALL zdf_gls( kstp )            ! GLS closure scheme for Kz
-      IF( lk_zdfcst  ) THEN                              ! Constant Kz (reset avt, avm[uv] to the background value)
-         avt (:,:,:) = rn_avt0 * wmask (:,:,:)
-         avmu(:,:,:) = rn_avm0 * wumask(:,:,:)
-         avmv(:,:,:) = rn_avm0 * wvmask(:,:,:)
-      ENDIF
-
-      IF( ln_rnf_mouth ) THEN                         ! increase diffusivity at rivers mouths
-         DO jk = 2, nkrnf   ;   avt(:,:,jk) = avt(:,:,jk) + 2._wp * rn_avt_rnf * rnfmsk(:,:) * tmask(:,:,jk)   ;   END DO
-      ENDIF
-      IF( ln_zdfevd  )   CALL zdf_evd( kstp )         ! enhanced vertical eddy diffusivity
-
-      IF( lk_zdftmx  )   CALL zdf_tmx( kstp )         ! tidal vertical mixing
-
-      IF( lk_zdfddm  )   CALL zdf_ddm( kstp )         ! double diffusive mixing
-
-                         CALL zdf_mxl( kstp )         ! mixed layer depth
-
-                                                      ! write TKE or GLS information in the restart file
-      IF( lrst_oce .AND. lk_zdftke )   CALL tke_rst( kstp, 'WRITE' )
-      IF( lrst_oce .AND. lk_zdfgls )   CALL gls_rst( kstp, 'WRITE' )
-      !
-      !  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
-         IF( ln_traldf_triad ) THEN 
-                         CALL ldf_slp_triad( kstp )                       ! before slope for triad operator
-         ELSE     
-                         CALL ldf_slp     ( kstp, rhd, rn2b )             ! 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. 
-
-      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      !  Ocean dynamics : hdiv, ssh, e3, u, v, w
-      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-
-                            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 
-                            CALL eos    ( tsn, rhd, rhop, gdept_n(:,:,:) )  ! now in situ density for hpg computation
-                            
-!!jc: fs simplification
-!!jc: lines below are useless if ln_linssh=F. Keep them here (which maintains a bug if ln_linssh=T and ln_zps=T, cf ticket #1636) 
-!!                                         but ensures reproductible results
-!!                                         with previous versions using split-explicit free surface          
-            IF( ln_zps .AND. .NOT. ln_isfcav )                               &
-               &            CALL zps_hde    ( kstp, jpts, tsn, 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, tsn, gtsu, gtsv, gtui, gtvi,  &  ! Partial steps for top cell (ISF)
-               &                                          rhd, gru , grv , grui, grvi   )  ! of t, s, rd at the first ocean level
-!!jc: fs simplification
-                            
-                         ua(:,:,:) = 0._wp            ! set dynamics trends to zero
-                         va(:,:,:) = 0._wp
-
-      IF(  lk_asminc .AND. ln_asmiau .AND. ln_dyninc )   &
-               &         CALL dyn_asm_inc   ( kstp )  ! apply dynamics assimilation increment
-      IF( lk_bdy     )   CALL bdy_dyn3d_dmp ( kstp )  ! 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
-                         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
-      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)
-                            CALL wzv        ( kstp )              ! now cross-level velocity 
-      ENDIF
-
-                         CALL dyn_bfr       ( kstp )  ! bottom friction
-                         CALL dyn_zdf       ( kstp )  ! vertical diffusion
-
-      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! cool skin
-      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<      
-      IF ( ln_diurnal )  CALL stp_diurnal( kstp )
-      
-      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! diagnostics and outputs             (ua, va, tsa used as workspace)
-      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-      IF( lk_floats  )   CALL flo_stp( kstp )         ! drifting Floats
-      IF( nn_diacfl == 1 )   CALL dia_cfl( kstp )         ! Courant number diagnostics
-      IF( lk_diahth  )   CALL dia_hth( kstp )         ! Thermocline depth (20 degres isotherm depth)
-      IF(.NOT.ln_cpl )   CALL dia_fwb( kstp )         ! Fresh water budget diagnostics
-      IF( lk_diadct  )   CALL dia_dct( kstp )         ! Transports
-      IF( lk_diaar5  )   CALL dia_ar5( kstp )         ! ar5 diag
-      IF( lk_diaharm )   CALL dia_harm( kstp )        ! Tidal harmonic analysis
-                         CALL dia_wri( kstp )         ! ocean model: outputs
-      !
-      IF( ln_crs     )   CALL crs_fld       ( kstp )  ! ocean model: online field coarsening & output
-      
-#if defined key_top
-      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! Passive Tracer Model
-      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-                         CALL trc_stp       ( kstp )  ! time-stepping
-#endif
-
-      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! Active tracers                              
-      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-                         tsa(:,:,:,:) = 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( lk_trabbl  )   CALL tra_bbl       ( kstp )  ! advective (and/or diffusive) bottom boundary layer scheme
-      IF( ln_tradmp  )   CALL tra_dmp       ( kstp )  ! internal damping trends
-      IF( lk_bdy     )   CALL bdy_tra_dmp   ( kstp )  ! 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
-                         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
-      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-!!jc1: For agrif, it would be much better to finalize tracers/momentum here (e.g. bdy conditions) and move the swap 
-!!    (and time filtering) after Agrif update. Then restart would be done after and would contain updated fields. 
-!!    If so: 
-!!    (i) no need to call agrif update at initialization time
-!!    (ii) no need to update "before" fields 
-!!
-!!    Apart from creating new tra_swp/dyn_swp routines, this however: 
-!!    (i) makes boundary conditions at initialization time computed from updated fields which is not the case between 
-!!    two restarts => restartability issue. One can circumvent this, maybe, by assuming "interface separation", 
-!!    e.g. a shift of the feedback interface inside child domain. 
-!!    (ii) requires that all restart outputs of updated variables by agrif (e.g. passive tracers/tke/barotropic arrays) are done at the same
-!!    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
-                         CALL ssh_swp       ( kstp )  ! swap of sea surface height
-      IF(.NOT.ln_linssh) CALL dom_vvl_sf_swp( kstp )  ! swap of vertical scale factors
-      !
-
-!!gm : This does not only concern the dynamics ==>>> add a new title
-!!gm2: why ouput restart before AGRIF update?
-!!
-!!jc: That would be better, but see comment above
-!!
-      IF( lrst_oce         )   CALL rst_write    ( kstp )   ! 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
-      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<      
-                         CALL Agrif_Integrate_ChildGrids( stp )  
-
-      IF( Agrif_NbStepint() == 0 ) THEN               ! AGRIF Update 
-!!jc in fact update is useless at last time step, but do it for global diagnostics
-                         CALL Agrif_Update_Tra()      ! Update active tracers
-                         CALL Agrif_Update_Dyn()      ! Update momentum
-      ENDIF
-#endif
-      IF( ln_diahsb  )   CALL dia_hsb( kstp )         ! - ML - global conservation diagnostics
-      IF( ln_diaobs  )   CALL dia_obs( kstp )         ! obs-minus-model (assimilation) diagnostics (call after dynamics update)
-
-      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! Control
-      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-                         CALL stp_ctl       ( kstp, indic )
-      IF( indic < 0  ) THEN
-                         CALL ctl_stop( 'step: indic < 0' )
-                         CALL dia_wri_state( 'output.abort', kstp )
-      ENDIF
-      IF( kstp == nit000 ) THEN
-                 CALL iom_close( numror )     ! close input  ocean restart file
-         IF(lwm) CALL FLUSH    ( numond )     ! flush output namelist oce
-         IF(lwm.AND.numoni /= -1 )   &
-            &    CALL FLUSH    ( numoni )     ! flush output namelist ice (if exist)
-      ENDIF
-
-      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! Coupled mode
-      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-!!gm why lk_oasis and not lk_cpl ????
-      IF( lk_oasis   )   CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges
-      !
-#if defined key_iomput
-      IF( kstp == nitend .OR. indic < 0 ) THEN 
-                      CALL iom_context_finalize(      cxios_context          ) ! needed for XIOS+AGRIF
-         IF( ln_crs ) CALL iom_context_finalize( trim(cxios_context)//"_crs" ) ! 
-      ENDIF
-#endif
-      !
-      IF( nn_timing == 1 .AND.  kstp == nit000  )   CALL timing_reset
-      !
-   END SUBROUTINE stp
-   
-END MODULE step
Index: branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/stpctl.F90
===================================================================
--- branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/stpctl.F90	(revision 6827)
+++ 	(revision )
@@ -1,159 +1,0 @@
-MODULE stpctl
-   !!======================================================================
-   !!                       ***  MODULE  stpctl  ***
-   !! Ocean run control :  gross check of the ocean time stepping
-   !!======================================================================
-   !! History :  OPA  ! 1991-03  (G. Madec) Original code
-   !!            6.0  ! 1992-06  (M. Imbard)
-   !!            8.0  ! 1997-06  (A.M. Treguier)
-   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module
-   !!            2.0  ! 2009-07  (G. Madec)  Add statistic for time-spliting
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   stp_ctl      : Control the run
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers variables
-   USE dom_oce         ! ocean space and time domain variables 
-   USE c1d             ! 1D vertical configuration
-   !
-   USE in_out_manager  ! I/O manager
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE lib_mpp         ! distributed memory computing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC stp_ctl           ! routine called by step.F90
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE stp_ctl( kt, kindic )
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE stp_ctl  ***
-      !!                     
-      !! ** Purpose :   Control the run
-      !!
-      !! ** Method  : - Save the time step in numstp
-      !!              - Print it each 50 time steps
-      !!              - Stop the run IF problem ( indic < 0 )
-      !!
-      !! ** Actions :   'time.step' file containing the last ocean time-step
-      !!                
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index
-      INTEGER, INTENT(inout) ::   kindic   ! error indicator
-      !!
-      INTEGER  ::   ji, jj, jk             ! dummy loop indices
-      INTEGER  ::   ii, ij, ik             ! local integers
-      REAL(wp) ::   zumax, zsmin, zssh2    ! local scalars
-      INTEGER, DIMENSION(3) ::   ilocu     ! 
-      INTEGER, DIMENSION(2) ::   ilocs     ! 
-      !!----------------------------------------------------------------------
-      !
-      IF( kt == nit000 .AND. lwp ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'stp_ctl : time-stepping control'
-         WRITE(numout,*) '~~~~~~~'
-         ! open time.step file
-         CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
-      ENDIF
-      !
-      IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp
-      IF(lwp) REWIND( numstp )                       !  --------------------------
-      !
-      !                                              !* Test maximum of velocity (zonal only)
-      !                                              !  ------------------------
-      !! zumax = MAXVAL( ABS( un(:,:,:) ) )                ! slower than the following loop on NEC SX5
-      zumax = 0.e0
-      DO jk = 1, jpk
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zumax = MAX(zumax,ABS(un(ji,jj,jk)))
-          END DO 
-        END DO 
-      END DO        
-      IF( lk_mpp )   CALL mpp_max( zumax )                 ! max over the global domain
-      !
-      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' abs(U) max: ', zumax
-      !
-      IF( zumax > 20.e0 ) THEN
-         IF( lk_mpp ) THEN
-            CALL mpp_maxloc(ABS(un),umask,zumax,ii,ij,ik)
-         ELSE
-            ilocu = MAXLOC( ABS( un(:,:,:) ) )
-            ii = ilocu(1) + nimpp - 1
-            ij = ilocu(2) + njmpp - 1
-            ik = ilocu(3)
-         ENDIF
-         IF(lwp) THEN
-            WRITE(numout,cform_err)
-            WRITE(numout,*) ' stpctl: the zonal velocity is larger than 20 m/s'
-            WRITE(numout,*) ' ====== '
-            WRITE(numout,9400) kt, zumax, ii, ij, ik
-            WRITE(numout,*)
-            WRITE(numout,*) '          output of last fields in numwso'
-         ENDIF
-         kindic = -3
-      ENDIF
-9400  FORMAT (' kt=',i6,' max abs(U): ',1pg11.4,', i j k: ',3i5)
-      !
-      !                                              !* Test minimum of salinity
-      !                                              !  ------------------------
-      !! zsmin = MINVAL( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 )  slower than the following loop on NEC SX5
-      zsmin = 100._wp
-      DO jj = 2, jpjm1
-         DO ji = 1, jpi
-            IF( tmask(ji,jj,1) == 1) zsmin = MIN(zsmin,tsn(ji,jj,1,jp_sal))
-         END DO
-      END DO
-      IF( lk_mpp )   CALL mpp_min( zsmin )                ! min over the global domain
-      !
-      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' SSS min:', zsmin
-      !
-      IF( zsmin < 0.) THEN 
-         IF (lk_mpp) THEN
-            CALL mpp_minloc ( tsn(:,:,1,jp_sal),tmask(:,:,1), zsmin, ii,ij )
-         ELSE
-            ilocs = MINLOC( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 )
-            ii = ilocs(1) + nimpp - 1
-            ij = ilocs(2) + njmpp - 1
-         ENDIF
-         !
-         IF(lwp) THEN
-            WRITE(numout,cform_err)
-            WRITE(numout,*) 'stp_ctl : NEGATIVE sea surface salinity'
-            WRITE(numout,*) '======= '
-            WRITE(numout,9500) kt, zsmin, ii, ij
-            WRITE(numout,*)
-            WRITE(numout,*) '          output of last fields in numwso'
-         ENDIF
-         kindic = -3
-      ENDIF
-9500  FORMAT (' kt=',i6,' min SSS: ',1pg11.4,', i j: ',2i5)
-      !
-      !
-      IF( lk_c1d )  RETURN          ! No log file in case of 1D vertical configuration
-
-      ! log file (ssh statistics)
-      ! --------                                   !* ssh statistics (and others...)
-      IF( kt == nit000 .AND. lwp ) THEN   ! open ssh statistics file (put in solver.stat file)
-         CALL ctl_opn( numsol, 'solver.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
-      ENDIF
-      !
-      zssh2 = SUM( sshn(:,:) * sshn(:,:) * tmask_i(:,:) )
-      IF( lk_mpp )   CALL mpp_sum( zssh2 )      ! sum over the global domain
-      !
-      IF(lwp) WRITE(numsol,9300) kt, zssh2, zumax, zsmin      ! ssh statistics
-      !
-9200  FORMAT('it:', i8, ' iter:', i4, ' r: ',e16.10, ' b: ',e16.10 )
-9300  FORMAT(' it :', i8, ' ssh2: ', e16.10, ' Umax: ',e16.10,' Smin: ',e16.10)
-      !
-   END SUBROUTINE stp_ctl
-
-   !!======================================================================
-END MODULE stpctl
