Index: branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/CONFIG/SHARED/field_def.xml
===================================================================
--- branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/CONFIG/SHARED/field_def.xml	(revision 15582)
+++ branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/CONFIG/SHARED/field_def.xml	(revision 15603)
@@ -125,4 +125,48 @@
          <field id="Age"        long_name="Sea Water Age Since Surface contact" standard_name="sea_water_age_since_surface_contact"  unit="yr" grid_ref="grid_T_3D"   />
          <field id="Age_e3t"    long_name="Age * e3t"                                 unit="yr * m"  > Age * e3t </field >
+
+         <!-- variables available with ln_stopack set to .true. -->         
+         <field id="sppt_ran" long_name="Random field for SPPT" standard_name="sppt_random_field" unit="0-1"     />
+         <field id="skeb_ran" long_name="Random field for SKEB" standard_name="skeb_random_field" unit="0-1"     />
+         <field id="spp_ran" long_name="Random field for SPP" standard_name="spp_random_field" unit="0-1"     />
+         <field id="sppt_ar1" long_name="Perturbation field for SPPT" standard_name="sppt_perturb_field" unit="0-1" grid_ref="grid_T_3D"/>
+         <field id="spp_ar1" long_name="Perturbation field for SPP" standard_name="spp_perturb_field" unit="0-1" />
+         <field id="skeb_ar1" long_name="Perturbation field for SKEB" standard_name="skeb_perturb_field" unit="0-1" />
+
+         <!-- The following ones only when ln_stopack_diags is TRUE -->
+
+         <field id="spp_par01" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     />
+         <field id="spp_par02" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     />
+         <field id="spp_par03" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     />
+         <field id="spp_par04" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     />
+         <field id="spp_par05" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     />
+         <field id="spp_par06" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     />
+         <field id="spp_par07" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     />
+         <field id="spp_par08" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     />
+         <field id="spp_par09" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     />
+         <field id="spp_par10" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     />
+         <field id="spp_par11" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     />
+         <field id="spp_par12" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     />
+         <field id="spp_par13" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     />
+         <field id="spp_par14" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     />
+         <field id="spp_par15" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     />
+         <field id="spp_par16" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     />
+         <field id="spp_par17" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     />
+         <field id="spp_par18" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     />
+         <field id="spp_par19" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     />
+         <field id="spp_par20" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     />
+         <field id="spp_par21" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     />
+         <field id="spp_par22" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     />
+         <field id="spp_par23" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     />
+         <field id="spp_par24" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     />
+         <field id="spp_par25" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     />
+         <field id="spp_par26" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     />
+         <field id="spp_par27" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     />
+         <field id="spp_par28" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     />
+         <field id="spp_par29" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     />
+
+         <field id="ustar_skeb" long_name="Sea Water X Velocity Perturbation" standard_name="sea_water_x_velocity" unit="m/s" grid_ref="grid_U_3D" />
+         <field id="vstar_skeb" long_name="Sea Water Y Velocity Perturbation" standard_name="sea_water_y_velocity" unit="m/s" grid_ref="grid_V_3D" />
+
       </field_group>
 
Index: branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90	(revision 15582)
+++ branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90	(revision 15603)
@@ -30,4 +30,5 @@
    USE wrk_nemo        ! Memory Allocation
    USE timing          ! Timing
+   USE stopack
 
    IMPLICIT NONE
@@ -38,4 +39,11 @@
 
    INTEGER ::   nldf = -2   ! type of lateral diffusion used defined from ln_dynldf_... namlist logicals)
+
+#if defined key_dynldf_c3d
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ahm10, ahm20, ahm30, ahm40
+#endif
+#if defined key_dynldf_c2d
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) :: ahm10, ahm20, ahm30, ahm40
+#endif
 
    !! * Substitutions
@@ -67,4 +75,52 @@
          ztrdv(:,:,:) = va(:,:,:) 
       ENDIF
+
+#if defined key_dynldf_c3d
+         IF( kt == nit000 .AND. ln_stopack .AND. &
+            & ( (nn_spp_ahm1 + nn_spp_ahm2) > 0 ) ) THEN
+             ALLOCATE ( ahm10(jpi,jpj,jpk), ahm20(jpi,jpj,jpk) )
+             ALLOCATE ( ahm30(jpi,jpj,jpk), ahm40(jpi,jpj,jpk) )
+             ahm10 = ahm1
+             ahm20 = ahm2
+             ahm30 = ahm3
+             ahm40 = ahm4
+         ENDIF
+#endif
+#if defined key_dynldf_c2d
+         IF( kt == nit000 .AND. ln_stopack .AND. &
+            & ( (nn_spp_ahm1 + nn_spp_ahm2) > 0 ) ) THEN
+             ALLOCATE ( ahm10(jpi,jpj), ahm20(jpi,jpj) )
+             ALLOCATE ( ahm30(jpi,jpj), ahm40(jpi,jpj) )
+             ahm10 = ahm1
+             ahm20 = ahm2
+             ahm30 = ahm3
+             ahm40 = ahm4
+         ENDIF
+#endif
+
+#if defined key_traldf_c3d || defined key_traldf_c2d
+         IF( ln_stopack ) THEN
+            IF( nn_spp_ahm1 > 0 ) THEN
+               IF( ln_dynldf_lap ) THEN
+                  ahm1 = ahm10
+                  CALL spp_ahm(kt, ahm1, nn_spp_ahm1, rn_ahm1_sd, jk_spp_ahm1)
+               ENDIF
+               IF( ln_dynldf_bilap ) THEN
+                  ahm3 = ahm30
+                  CALL spp_ahm(kt, ahm3, nn_spp_ahm1, rn_ahm1_sd, jk_spp_ahm3)
+               ENDIF
+            ENDIF
+            IF( nn_spp_ahm2 > 0 ) THEN
+               IF( ln_dynldf_lap ) THEN
+               ahm2 = ahm20
+               CALL spp_ahm(kt, ahm2, nn_spp_ahm2, rn_ahm2_sd, jk_spp_ahm2)
+               ENDIF
+               IF( ln_dynldf_bilap ) THEN
+                  ahm4 = ahm40
+                  CALL spp_ahm(kt, ahm4, nn_spp_ahm2, rn_ahm2_sd, jk_spp_ahm4)
+               ENDIF
+            ENDIF
+         ENDIF
+#endif
 
       SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend
Index: branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90	(revision 15582)
+++ branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90	(revision 15603)
@@ -21,5 +21,6 @@
    USE lib_mpp        ! MPP library
    USE wrk_nemo       ! work arrays
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE stopack
 
    IMPLICIT NONE
@@ -30,5 +31,5 @@
 
    INTEGER  ::   albd_init = 0      !: control flag for initialization
-  
+
    REAL(wp) ::   rmue     = 0.40    !  cosine of local solar altitude
    REAL(wp) ::   ralb_oce = 0.066   ! ocean or lead albedo (Pegau and Paulson, Ann. Glac. 2001)
@@ -36,5 +37,5 @@
    REAL(wp) ::   c2       = 0.10    !  "        "
    REAL(wp) ::   rcloud   = 0.06    ! cloud effect on albedo (only-for nn_ice_alb=0)
- 
+
    !                             !!* namelist namsbc_alb
    INTEGER  ::   nn_ice_alb
@@ -51,7 +52,7 @@
       !!----------------------------------------------------------------------
       !!               ***  ROUTINE albedo_ice  ***
-      !!          
-      !! ** Purpose :   Computation of the albedo of the snow/ice system 
-      !!       
+      !!
+      !! ** Purpose :   Computation of the albedo of the snow/ice system
+      !!
       !! ** Method  :   Two schemes are available (from namelist parameter nn_ice_alb)
       !!                  0: the scheme is that of Shine & Henderson-Sellers (JGR 1985) for clear-skies
@@ -72,12 +73,12 @@
       !! ** Note    :   The parameterization from Shine & Henderson-Sellers presents several misconstructions:
       !!                  1) ice albedo when ice thick. tends to 0 is different than ocean albedo
-      !!                  2) for small ice thick. covered with some snow (<3cm?), albedo is larger 
+      !!                  2) for small ice thick. covered with some snow (<3cm?), albedo is larger
       !!                     under melting conditions than under freezing conditions
-      !!                  3) the evolution of ice albedo as a function of ice thickness shows  
+      !!                  3) the evolution of ice albedo as a function of ice thickness shows
       !!                     3 sharp inflexion points (at 5cm, 100cm and 150cm) that look highly unrealistic
       !!
       !! References :   Shine & Henderson-Sellers 1985, JGR, 90(D1), 2243-2250.
       !!                Brandt et al. 2005, J. Climate, vol 18
-      !!                Grenfell & Perovich 2004, JGR, vol 109 
+      !!                Grenfell & Perovich 2004, JGR, vol 109
       !!----------------------------------------------------------------------
       REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pt_ice      !  ice surface temperature (Kelvin)
@@ -96,10 +97,10 @@
 
       ijpl = SIZE( pt_ice, 3 )                     ! number of ice categories
-      
+
       CALL wrk_alloc( jpi,jpj,ijpl, zalb, zalb_it )
 
-      IF( albd_init == 0 )   CALL albedo_init      ! initialization 
-
-      
+      IF( albd_init == 0 )   CALL albedo_init      ! initialization
+
+
       SELECT CASE ( nn_ice_alb )
 
@@ -108,15 +109,15 @@
       !------------------------------------------
       CASE( 0 )
-       
+
          ralb_sf = 0.80       ! dry snow
          ralb_sm = 0.65       ! melting snow
          ralb_if = 0.72       ! bare frozen ice
-         ralb_im = rn_albice  ! bare puddled ice 
-         
+         ralb_im = rn_albice  ! bare puddled ice
+
          !  Computation of ice albedo (free of snow)
          WHERE     ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice )   ;   zalb(:,:,:) = ralb_im
          ELSE WHERE                                              ;   zalb(:,:,:) = ralb_if
          END  WHERE
-      
+
          WHERE     ( 1.5  < ph_ice                     )  ;  zalb_it = zalb
          ELSE WHERE( 1.0  < ph_ice .AND. ph_ice <= 1.5 )  ;  zalb_it = 0.472  + 2.0 * ( zalb - 0.472 ) * ( ph_ice - 1.0 )
@@ -126,5 +127,5 @@
          ELSE WHERE                                       ;  zalb_it = 0.1    + 3.6    * ph_ice
          END WHERE
-     
+
          DO jl = 1, ijpl
             DO jj = 1, jpj
@@ -132,9 +133,9 @@
                   ! freezing snow
                   ! no effect of underlying ice layer IF snow thickness > c1. Albedo does not depend on snow thick if > c2
-                  !                                        !  freezing snow        
+                  !                                        !  freezing snow
                   zswitch   = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ( ph_snw(ji,jj,jl) - c1 ) ) )
                   zalb_sf   = ( 1._wp - zswitch ) * (  zalb_it(ji,jj,jl)  &
                      &                           + ph_snw(ji,jj,jl) * ( ralb_sf - zalb_it(ji,jj,jl) ) / c1  )   &
-                     &        +         zswitch   * ralb_sf  
+                     &        +         zswitch   * ralb_sf
 
                   ! melting snow
@@ -142,10 +143,10 @@
                   zswitch   = MAX( 0._wp , SIGN( 1._wp , ph_snw(ji,jj,jl) - c2 ) )
                   zalb_sm = ( 1._wp - zswitch ) * ( ralb_im + ph_snw(ji,jj,jl) * ( ralb_sm - ralb_im ) / c2 )   &
-                      &     +         zswitch   *   ralb_sm 
+                      &     +         zswitch   *   ralb_sm
                   !
                   ! snow albedo
-                  zswitch  =  MAX( 0._wp , SIGN( 1._wp , pt_ice(ji,jj,jl) - rt0_snow ) )   
+                  zswitch  =  MAX( 0._wp , SIGN( 1._wp , pt_ice(ji,jj,jl) - rt0_snow ) )
                   zalb_st  =  zswitch * zalb_sm + ( 1._wp - zswitch ) * zalb_sf
-               
+
                   ! Ice/snow albedo
                   zswitch   = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ph_snw(ji,jj,jl) ) )
@@ -154,4 +155,13 @@
                END DO
             END DO
+
+#if defined key_traldf_c2d || key_traldf_c3d
+            IF ( ln_stopack .AND. nn_spp_icealb > 0 ) &
+               & CALL spp_gen( 1, pa_ice_cs(:,:,jl), nn_spp_icealb, rn_icealb_sd, jk_spp_alb, jl )
+#else
+            IF ( ln_stopack .AND. nn_spp_icealb > 0 ) &
+               & CALL ctl_stop( 'albedo_ice: parameter perturbation will only work with '// &
+                                'key_traldf_c2d or key_traldf_c3d')
+#endif
          END DO
 
@@ -161,5 +171,5 @@
       !  New parameterization (2016)
       !------------------------------------------
-      CASE( 1 ) 
+      CASE( 1 )
 
          ralb_im = rn_albice  ! bare puddled ice
@@ -176,12 +186,12 @@
 !         ralb_sm = 0.82      ! melting snow
 !         ralb_if = 0.54      ! bare frozen ice
-! 
+!
          !  Computation of ice albedo (free of snow)
-         z1_c1 = 1. / ( LOG(1.5) - LOG(0.05) ) 
+         z1_c1 = 1. / ( LOG(1.5) - LOG(0.05) )
          z1_c2 = 1. / 0.05
          WHERE     ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice )   ;   zalb = ralb_im
          ELSE WHERE                                              ;   zalb = ralb_if
          END  WHERE
-         
+
          WHERE     ( 1.5  < ph_ice                     )  ;  zalb_it = zalb
          ELSE WHERE( 0.05 < ph_ice .AND. ph_ice <= 1.5 )  ;  zalb_it = zalb     + ( 0.18 - zalb     ) * z1_c1 *  &
@@ -200,8 +210,8 @@
 
                    ! snow albedo
-                  zswitch = MAX( 0._wp , SIGN( 1._wp , pt_ice(ji,jj,jl) - rt0_snow ) )   
+                  zswitch = MAX( 0._wp , SIGN( 1._wp , pt_ice(ji,jj,jl) - rt0_snow ) )
                   zalb_st = zswitch * zalb_sm + ( 1._wp - zswitch ) * zalb_sf
 
-                  ! Ice/snow albedo   
+                  ! Ice/snow albedo
                   zswitch             = MAX( 0._wp , SIGN( 1._wp , - ph_snw(ji,jj,jl) ) )
                   pa_ice_os(ji,jj,jl) = ( 1._wp - zswitch ) * zalb_st + zswitch *  zalb_it(ji,jj,jl)
@@ -209,10 +219,19 @@
               END DO
             END DO
+
+#if defined key_traldf_c2d || key_traldf_c3d
+            IF ( ln_stopack .AND. nn_spp_icealb > 0 ) &
+               & CALL spp_gen( 1, pa_ice_os(:,:,jl), nn_spp_icealb, rn_icealb_sd, jk_spp_alb, jl )
+#else
+            IF ( ln_stopack .AND. nn_spp_icealb > 0 ) &
+               & CALL ctl_stop( 'albedo_ice: parameter perturbation will only work with '// &
+                                'key_traldf_c2d or key_traldf_c3d')
+#endif
          END DO
          ! Effect of the clouds (2d order polynomial)
-         pa_ice_cs = pa_ice_os - ( - 0.1010 * pa_ice_os * pa_ice_os + 0.1933 * pa_ice_os - 0.0148 ); 
+         pa_ice_cs = pa_ice_os - ( - 0.1010 * pa_ice_os * pa_ice_os + 0.1933 * pa_ice_os - 0.0148 );
 
       END SELECT
-      
+
       CALL wrk_dealloc( jpi,jpj,ijpl, zalb, zalb_it )
       !
@@ -223,5 +242,5 @@
       !!----------------------------------------------------------------------
       !!               ***  ROUTINE albedo_oce  ***
-      !! 
+      !!
       !! ** Purpose :   Computation of the albedo of the ocean
       !!----------------------------------------------------------------------
@@ -229,9 +248,9 @@
       REAL(wp), DIMENSION(:,:), INTENT(out) ::   pa_oce_cs   !  albedo of ocean under clear sky
       !!
-      REAL(wp) :: zcoef 
+      REAL(wp) :: zcoef
       !!----------------------------------------------------------------------
       !
       zcoef = 0.05 / ( 1.1 * rmue**1.4 + 0.15 )   ! Parameterization of Briegled and Ramanathan, 1982
-      pa_oce_cs(:,:) = zcoef 
+      pa_oce_cs(:,:) = zcoef
       pa_oce_os(:,:) = 0.06                       ! Parameterization of Kondratyev, 1969 and Payne, 1972
       !
@@ -248,5 +267,5 @@
       !!----------------------------------------------------------------------
       INTEGER  ::   ios                 ! Local integer output status for namelist read
-      NAMELIST/namsbc_alb/ nn_ice_alb, rn_albice 
+      NAMELIST/namsbc_alb/ nn_ice_alb, rn_albice
       !!----------------------------------------------------------------------
       !
Index: branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90	(revision 15582)
+++ branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90	(revision 15603)
@@ -51,4 +51,5 @@
    USE par_ice_2
 #endif
+   USE stopack
 
    IMPLICIT NONE
@@ -89,6 +90,8 @@
    REAL(wp) ::   rn_efac     ! multiplication factor for evaporation (clem)
    REAL(wp) ::   rn_vfac     ! multiplication factor for ice/ocean velocity in the calculation of wind stress (clem)
+   REAL(wp), ALLOCATABLE, SAVE ::   rn_vfac0(:,:) ! multiplication factor for ice/ocean velocity in the calculation of wind stress (clem)
    REAL(wp) ::   rn_zqt      ! z(q,t) : height of humidity and temperature measurements
    REAL(wp) ::   rn_zu       ! z(u)   : height of wind measurements
+   REAL(wp), PUBLIC :: rn_sfac ! multiplication factor for snow precipitation over sea-ice
 
    !! * Substitutions
@@ -151,5 +154,5 @@
          &                  sn_wndi, sn_wndj, sn_humi  , sn_qsr ,           &
          &                  sn_qlw , sn_tair, sn_prec  , sn_snow,           &
-         &                  sn_tdif, rn_zqt,  rn_zu
+         &                  sn_tdif, rn_zqt,  rn_zu, rn_sfac
       !!---------------------------------------------------------------------
       !
@@ -158,4 +161,5 @@
          !                                      ! ====================== !
          !
+         rn_sfac = 1._wp       ! Default to one if missing from namelist
          REWIND( numnam_ref )              ! Namelist namsbc_core in reference namelist : CORE bulk parameters
          READ  ( numnam_ref, namsbc_core, IOSTAT = ios, ERR = 901)
@@ -196,5 +200,19 @@
          sfx(:,:) = 0._wp                          ! salt flux; zero unless ice is present (computed in limsbc(_2).F90)
          !
-      ENDIF
+         ALLOCATE ( rn_vfac0(jpi,jpj) )
+         rn_vfac0(:,:) = rn_vfac
+         !
+      ENDIF
+
+#if defined key_traldf_c2d || key_traldf_c3d
+      IF( ln_stopack .AND. nn_spp_relw > 0 ) THEN
+         rn_vfac0(:,:) = rn_vfac
+         CALL spp_gen(kt, rn_vfac0, nn_spp_relw, rn_relw_sd, jk_spp_relw )
+      ENDIF
+#else
+      IF ( ln_stopack .AND. nn_spp_relw > 0 ) &
+         & CALL ctl_stop( 'sbc_blk_core: parameter perturbation will only work with '// &
+                          'key_traldf_c2d or key_traldf_c3d')
+#endif
 
       CALL fld_read( kt, nn_fsbc, sf )             ! input fields provided at the current time-step
@@ -205,9 +223,9 @@
 #if defined key_cice
       IF( MOD( kt - 1, nn_fsbc ) == 0 )   THEN
-         qlw_ice(:,:,1)   = sf(jp_qlw)%fnow(:,:,1) 
+         qlw_ice(:,:,1)   = sf(jp_qlw)%fnow(:,:,1)
          IF( ln_dm2dc ) THEN ; qsr_ice(:,:,1) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) )
          ELSE                ; qsr_ice(:,:,1) =          sf(jp_qsr)%fnow(:,:,1)
          ENDIF
-         tatm_ice(:,:)    = sf(jp_tair)%fnow(:,:,1)         
+         tatm_ice(:,:)    = sf(jp_tair)%fnow(:,:,1)
          qatm_ice(:,:)    = sf(jp_humi)%fnow(:,:,1)
          tprecip(:,:)     = sf(jp_prec)%fnow(:,:,1) * rn_pfac
@@ -219,6 +237,6 @@
       !
    END SUBROUTINE sbc_blk_core
-   
-   
+
+
    SUBROUTINE blk_oce_core( kt, sf, pst, pu, pv )
       !!---------------------------------------------------------------------
@@ -230,5 +248,5 @@
       !! ** Method  :   CORE bulk formulea for the ocean using atmospheric
       !!      fields read in sbc_read
-      !! 
+      !!
       !! ** Outputs : - utau    : i-component of the stress at U-point  (N/m2)
       !!              - vtau    : j-component of the stress at V-point  (N/m2)
@@ -268,5 +286,5 @@
       ! local scalars ( place there for vector optimisation purposes)
       zcoef_qsatw = 0.98 * 640380. / rhoa
-      
+
       zst(:,:) = pst(:,:) + rt0      ! convert SST from Celcius to Kelvin (and set minimum value far above 0 K)
 
@@ -276,5 +294,5 @@
 
       ! ... components ( U10m - U_oce ) at T-point (unmasked)
-      zwnd_i(:,:) = 0.e0  
+      zwnd_i(:,:) = 0.e0
       zwnd_j(:,:) = 0.e0
 #if defined key_cyclone
@@ -289,6 +307,6 @@
       DO jj = 2, jpjm1
          DO ji = fs_2, fs_jpim1   ! vect. opt.
-            zwnd_i(ji,jj) = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  )
-            zwnd_j(ji,jj) = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  )
+            zwnd_i(ji,jj) = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac0(ji,jj) * 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  )
+            zwnd_j(ji,jj) = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac0(ji,jj) * 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  )
          END DO
       END DO
@@ -320,5 +338,5 @@
       CALL turb_core_2z( rn_zqt, rn_zu, zst, sf(jp_tair)%fnow, zqsatw, sf(jp_humi)%fnow, wndm,   &
          &               Cd, Ch, Ce, zt_zu, zq_zu )
-    
+
       ! ... tau module, i and j component
       DO jj = 1, jpj
@@ -351,5 +369,5 @@
       CALL lbc_lnk( vtau(:,:), 'V', -1. )
 
-    
+
       !  Turbulent fluxes over ocean
       ! -----------------------------
@@ -376,5 +394,5 @@
          CALL prt_ctl( tab2d_1=zst   , clinfo1=' blk_oce_core: zst    : ')
       ENDIF
-       
+
       ! ----------------------------------------------------------------------------- !
       !     III    Total FLUXES                                                       !
@@ -384,5 +402,5 @@
          &         - sf(jp_prec)%fnow(:,:,1) * rn_pfac  ) * tmask(:,:,1)
       !
-      qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                &   ! Downward Non Solar 
+      qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                &   ! Downward Non Solar
          &     - sf(jp_snow)%fnow(:,:,1) * rn_pfac * lfus                         &   ! remove latent melting heat for solid precip
          &     - zevap(:,:) * pst(:,:) * rcp                                      &   ! remove evap heat content at SST
@@ -425,6 +443,6 @@
       !
    END SUBROUTINE blk_oce_core
- 
-   
+
+
 #if defined key_lim2 || defined key_lim3
    SUBROUTINE blk_ice_core_tau
@@ -465,8 +483,10 @@
             DO ji = 2, jpim1   ! B grid : NO vector opt
                ! ... scalar wind at I-point (fld being at T-point)
-               zwndi_f = 0.25 * (  sf(jp_wndi)%fnow(ji-1,jj  ,1) + sf(jp_wndi)%fnow(ji  ,jj  ,1)   &
-                  &              + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji  ,jj-1,1)  ) - rn_vfac * u_ice(ji,jj)
-               zwndj_f = 0.25 * (  sf(jp_wndj)%fnow(ji-1,jj  ,1) + sf(jp_wndj)%fnow(ji  ,jj  ,1)   &
-                  &              + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji  ,jj-1,1)  ) - rn_vfac * v_ice(ji,jj)
+               zwndi_f = 0.25 * (  sf(jp_wndi)%fnow(ji-1,jj  ,1) + sf(jp_wndi)%fnow(ji  ,jj  ,1)    &
+                  &              + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji  ,jj-1,1)  ) &
+                  &      - rn_vfac0(ji,jj) * u_ice(ji,jj)
+               zwndj_f = 0.25 * (  sf(jp_wndj)%fnow(ji-1,jj  ,1) + sf(jp_wndj)%fnow(ji  ,jj  ,1)    &
+                  &              + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji  ,jj-1,1)  ) &
+                  &      - rn_vfac0(ji,jj) * v_ice(ji,jj)
                zwnorm_f = zcoef_wnorm * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f )
                ! ... ice stress at I-point
@@ -474,8 +494,10 @@
                vtau_ice(ji,jj) = zwnorm_f * zwndj_f
                ! ... scalar wind at T-point (fld being at T-point)
-               zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  u_ice(ji,jj+1) + u_ice(ji+1,jj+1)   &
-                  &                                                    + u_ice(ji,jj  ) + u_ice(ji+1,jj  )  )
-               zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  v_ice(ji,jj+1) + v_ice(ji+1,jj+1)   &
-                  &                                                    + v_ice(ji,jj  ) + v_ice(ji+1,jj  )  )
+               zwndi_t = sf(jp_wndi)%fnow(ji,jj,1)                                         &
+                  &      - rn_vfac0(ji,jj) * 0.25 * (  u_ice(ji,jj+1) + u_ice(ji+1,jj+1)   &
+                  &                                  + u_ice(ji,jj  ) + u_ice(ji+1,jj  )  )
+               zwndj_t = sf(jp_wndj)%fnow(ji,jj,1)                                         &
+                  &      - rn_vfac0(ji,jj) * 0.25 * (  v_ice(ji,jj+1) + v_ice(ji+1,jj+1)   &
+                  &                                  + v_ice(ji,jj  ) + v_ice(ji+1,jj  )  )
                wndm_ice(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
             END DO
@@ -488,6 +510,6 @@
          DO jj = 2, jpj
             DO ji = fs_2, jpi   ! vect. opt.
-               zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( u_ice(ji-1,jj  ) + u_ice(ji,jj) )  )
-               zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( v_ice(ji  ,jj-1) + v_ice(ji,jj) )  )
+               zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac0(ji,jj) * 0.5 * ( u_ice(ji-1,jj  ) + u_ice(ji,jj) )  )
+               zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac0(ji,jj) * 0.5 * ( v_ice(ji  ,jj-1) + v_ice(ji,jj) )  )
                wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
             END DO
@@ -495,8 +517,10 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vect. opt.
-               utau_ice(ji,jj) = zcoef_wnorm2 * ( wndm_ice(ji+1,jj  ) + wndm_ice(ji,jj) )                          &
-                  &          * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * u_ice(ji,jj) )
-               vtau_ice(ji,jj) = zcoef_wnorm2 * ( wndm_ice(ji,jj+1  ) + wndm_ice(ji,jj) )                          &
-                  &          * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * v_ice(ji,jj) )
+               utau_ice(ji,jj) = zcoef_wnorm2 * ( wndm_ice(ji+1,jj  ) + wndm_ice(ji,jj) )             &
+                  &              * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) &
+                  &                  - rn_vfac0(ji,jj) * u_ice(ji,jj) )
+               vtau_ice(ji,jj) = zcoef_wnorm2 * ( wndm_ice(ji,jj+1  ) + wndm_ice(ji,jj) )             &
+                  &              * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) &
+                  &                  - rn_vfac0(ji,jj) * v_ice(ji,jj) )
             END DO
          END DO
@@ -513,5 +537,5 @@
 
       IF( nn_timing == 1 )  CALL timing_stop('blk_ice_core_tau')
-      
+
    END SUBROUTINE blk_ice_core_tau
 
@@ -526,5 +550,5 @@
       !!                between atmosphere and sea-ice using CORE bulk
       !!                formulea, ice variables and read atmmospheric fields.
-      !! 
+      !!
       !! caution : the net upward water flux has with mm/day unit
       !!---------------------------------------------------------------------
@@ -546,5 +570,5 @@
       IF( nn_timing == 1 )  CALL timing_start('blk_ice_core_flx')
       !
-      CALL wrk_alloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb ) 
+      CALL wrk_alloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb )
 
       ! local scalars ( place there for vector optimisation purposes)
@@ -569,5 +593,5 @@
                z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * ptsu(ji,jj,jl) * zst3 ) * tmask(ji,jj,1)
                ! lw sensitivity
-               z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3                                               
+               z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3
 
                ! ----------------------------!
@@ -579,5 +603,5 @@
                z_qsb(ji,jj,jl) = rhoa * cpa * Cice * wndm_ice(ji,jj) * ( ptsu(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) )
                ! Latent Heat
-               qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa * Ls  * Cice * wndm_ice(ji,jj)   &                           
+               qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa * Ls  * Cice * wndm_ice(ji,jj)   &
                   &                         * (  11637800. * EXP( -5897.8 / ptsu(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1)  ) )
               ! Latent heat sensitivity for ice (Dqla/Dt)
@@ -610,5 +634,5 @@
 
 #if defined  key_lim3
-      CALL wrk_alloc( jpi,jpj, zevap, zsnw ) 
+      CALL wrk_alloc( jpi,jpj, zevap, zsnw )
 
       ! --- evaporation --- !
@@ -620,5 +644,5 @@
       ! --- evaporation minus precipitation --- !
       zsnw(:,:) = 0._wp
-      CALL lim_thd_snwblow( pfrld, zsnw )  ! snow distribution over ice after wind blowing 
+      CALL lim_thd_snwblow( pfrld, zsnw )  ! snow distribution over ice after wind blowing
       emp_oce(:,:) = pfrld(:,:) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * (1._wp - zsnw )
       emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw
@@ -643,8 +667,8 @@
       DO jl = 1, jpl
          qevap_ice(:,:,jl) = 0._wp ! should be -evap_ice(:,:,jl)*( ( Tice - rt0 ) * cpic * tmask(:,:,1) )
-                                   ! But we do not have Tice => consider it at 0°C => evap=0 
+                                   ! But we do not have Tice => consider it at 0 degC => evap=0
       END DO
 
-      CALL wrk_dealloc( jpi,jpj, zevap, zsnw ) 
+      CALL wrk_dealloc( jpi,jpj, zevap, zsnw )
 #endif
 
@@ -670,5 +694,5 @@
       !
       IF( nn_timing == 1 )  CALL timing_stop('blk_ice_core_flx')
-      
+
    END SUBROUTINE blk_ice_core_flx
 #endif
@@ -683,5 +707,5 @@
       !!                If relevant (zt /= zu), adjust temperature and humidity from height zt to zu
       !!
-      !! ** Method : Monin Obukhov Similarity Theory 
+      !! ** Method : Monin Obukhov Similarity Theory
       !!             + Large & Yeager (2004,2008) closure: CD_n10 = f(U_n10)
       !!
@@ -693,5 +717,5 @@
       !!    - better first guess of stability by checking air-sea difference of virtual temperature
       !!       rather than temperature difference only...
-      !!    - added function "cd_neutral_10m" that uses the improved parametrization of 
+      !!    - added function "cd_neutral_10m" that uses the improved parametrization of
       !!      Large & Yeager 2008. Drag-coefficient reduction for Cyclone conditions!
       !!    - using code-wide physical constants defined into "phycst.mod" rather than redifining them
@@ -728,5 +752,5 @@
 
       IF( nn_timing == 1 )  CALL timing_start('turb_core_2z')
-    
+
       CALL wrk_alloc( jpi,jpj, U_zu, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd )
       CALL wrk_alloc( jpi,jpj, zeta_u, stab )
@@ -740,5 +764,5 @@
       U_zu = MAX( 0.5 , dU )   !  relative wind speed at zu (normally 10m), we don't want to fall under 0.5 m/s
 
-      !! First guess of stability: 
+      !! First guess of stability:
       ztmp0 = T_zt*(1. + 0.608*q_zt) - sst*(1. + 0.608*q_sat) ! air-sea difference of virtual pot. temp. at zt
       stab  = 0.5 + sign(0.5,ztmp0)                           ! stab = 1 if dTv > 0  => STABLE, 0 if unstable
@@ -754,5 +778,5 @@
       Ce_n10  = 1.e-3*( 34.6 * sqrt_Cd_n10 )
       Ch_n10  = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1. - stab))
-    
+
       !! Initializing transf. coeff. with their first guess neutral equivalents :
       Cd = ztmp0   ;   Ce = Ce_n10   ;   Ch = Ch_n10   ;   sqrt_Cd = sqrt_Cd_n10
@@ -765,14 +789,14 @@
          !
          ztmp1 = T_zu - sst   ! Updating air/sea differences
-         ztmp2 = q_zu - q_sat 
+         ztmp2 = q_zu - q_sat
 
          ! Updating turbulent scales :   (L&Y 2004 eq. (7))
          ztmp1  = Ch/sqrt_Cd*ztmp1    ! theta*
          ztmp2  = Ce/sqrt_Cd*ztmp2    ! q*
-       
+
          ztmp0 = T_zu*(1. + 0.608*q_zu) ! virtual potential temperature at zu
 
          ! Estimate the inverse of Monin-Obukov length (1/L) at height zu:
-         ztmp0 =  (vkarmn*grav/ztmp0*(ztmp1*(1.+0.608*q_zu) + 0.608*T_zu*ztmp2)) / (Cd*U_zu*U_zu) 
+         ztmp0 =  (vkarmn*grav/ztmp0*(ztmp1*(1.+0.608*q_zu) + 0.608*T_zu*ztmp2)) / (Cd*U_zu*U_zu)
          !                                                                     ( Cd*U_zu*U_zu is U*^2 at zu)
 
@@ -781,5 +805,5 @@
          zpsi_h_u = psi_h( zeta_u )
          zpsi_m_u = psi_m( zeta_u )
-       
+
          !! Shifting temperature and humidity at zu (L&Y 2004 eq. (9b-9c))
          IF ( .NOT. l_zt_equal_zu ) THEN
@@ -790,7 +814,7 @@
             q_zu = max(0., q_zu)
          END IF
-       
+
          IF( ln_cdgw ) THEN      ! surface wave case
-            sqrt_Cd = vkarmn / ( vkarmn / sqrt_Cd_n10 - zpsi_m_u ) 
+            sqrt_Cd = vkarmn / ( vkarmn / sqrt_Cd_n10 - zpsi_m_u )
             Cd      = sqrt_Cd * sqrt_Cd
          ELSE
@@ -802,5 +826,5 @@
            ztmp0 = cd_neutral_10m(ztmp0)                                                 ! Cd_n10
            sqrt_Cd_n10 = sqrt(ztmp0)
-       
+
            Ce_n10  = 1.e-3 * (34.6 * sqrt_Cd_n10)                     ! L&Y 2004 eq. (6b)
            stab    = 0.5 + sign(0.5,zeta_u)                           ! update stability
@@ -809,5 +833,5 @@
            !! Update of transfer coefficients:
            ztmp1 = 1. + sqrt_Cd_n10/vkarmn*(LOG(zu/10.) - zpsi_m_u)   ! L&Y 2004 eq. (10a)
-           Cd      = ztmp0 / ( ztmp1*ztmp1 )   
+           Cd      = ztmp0 / ( ztmp1*ztmp1 )
            sqrt_Cd = SQRT( Cd )
          ENDIF
@@ -815,8 +839,8 @@
          ztmp0 = (LOG(zu/10.) - zpsi_h_u) / vkarmn / sqrt_Cd_n10
          ztmp2 = sqrt_Cd / sqrt_Cd_n10
-         ztmp1 = 1. + Ch_n10*ztmp0               
+         ztmp1 = 1. + Ch_n10*ztmp0
          Ch  = Ch_n10*ztmp2 / ztmp1  ! L&Y 2004 eq. (10b)
          !
-         ztmp1 = 1. + Ce_n10*ztmp0               
+         ztmp1 = 1. + Ce_n10*ztmp0
          Ce  = Ce_n10*ztmp2 / ztmp1  ! L&Y 2004 eq. (10c)
          !
@@ -836,5 +860,5 @@
    FUNCTION cd_neutral_10m( zw10 )
       !!----------------------------------------------------------------------
-      !! Estimate of the neutral drag coefficient at 10m as a function 
+      !! Estimate of the neutral drag coefficient at 10m as a function
       !! of neutral wind  speed at 10m
       !!
@@ -842,15 +866,15 @@
       !!
       !! Author: L. Brodeau, june 2014
-      !!----------------------------------------------------------------------    
+      !!----------------------------------------------------------------------
       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   zw10           ! scalar wind speed at 10m (m/s)
       REAL(wp), DIMENSION(jpi,jpj)             ::   cd_neutral_10m
       !
       REAL(wp), DIMENSION(:,:), POINTER ::   rgt33
-      !!----------------------------------------------------------------------    
+      !!----------------------------------------------------------------------
       !
       CALL wrk_alloc( jpi,jpj, rgt33 )
       !
       !! When wind speed > 33 m/s => Cyclone conditions => special treatment
-      rgt33 = 0.5_wp + SIGN( 0.5_wp, (zw10 - 33._wp) )   ! If zw10 < 33. => 0, else => 1  
+      rgt33 = 0.5_wp + SIGN( 0.5_wp, (zw10 - 33._wp) )   ! If zw10 < 33. => 0, else => 1
       cd_neutral_10m = 1.e-3 * ( &
          &       (1._wp - rgt33)*( 2.7_wp/zw10 + 0.142_wp + zw10/13.09_wp - 3.14807E-10*zw10**6) & ! zw10< 33.
Index: branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90	(revision 15582)
+++ branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90	(revision 15603)
@@ -54,4 +54,5 @@
    REAL(wp)          , PUBLIC ::   rn_avt_rnf      !: runoffs, value of the additional vertical mixing coef. [m2/s]
    REAL(wp)          , PUBLIC ::   rn_rfact        !: multiplicative factor for runoff
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rn_avt_rnf0
 
    LOGICAL           , PUBLIC ::   l_rnfcpl = .false.       ! runoffs recieved from oasis
@@ -159,5 +160,5 @@
             rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)
          ENDIF
- 
+
          IF(lwp .AND. lflush) CALL flush(numout)
 
@@ -465,4 +466,7 @@
          !                                      !    - mixed upstream-centered (ln_traadv_cen2=T)
          !
+         ALLOCATE ( rn_avt_rnf0(jpi,jpj) )
+         rn_avt_rnf0(:,:) = rn_avt_rnf
+         !
          IF ( ln_rnf_depth )   CALL ctl_warn( 'sbc_rnf_init: increased mixing turned on but effects may already',   &
             &                                              'be spread through depth by ln_rnf_depth'               )
Index: branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90	(revision 15582)
+++ branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90	(revision 15603)
@@ -24,5 +24,7 @@
    USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
    USE timing         ! Timing
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE stopack
+   USE wrk_nemo       ! Memory Allocation
 
    IMPLICIT NONE
@@ -40,5 +42,5 @@
    REAL(wp)        ::   rn_dqdt         ! restoring factor on SST and SSS
    REAL(wp)        ::   rn_deds         ! restoring factor on SST and SSS
-   LOGICAL         ::   ln_sssr_bnd     ! flag to bound erp term 
+   LOGICAL         ::   ln_sssr_bnd     ! flag to bound erp term
    REAL(wp)        ::   rn_sssr_bnd     ! ABS(Max./Min.) value of erp term [mm/day]
 
@@ -75,6 +77,6 @@
       REAL(wp) ::   zerp     ! local scalar for evaporation damping
       REAL(wp) ::   zqrp     ! local scalar for heat flux damping
-      REAL(wp) ::   zsrp     ! local scalar for unit conversion of rn_deds factor
       REAL(wp) ::   zerp_bnd ! local scalar for unit conversion of rn_epr_max factor
+      REAL(wp), POINTER, DIMENSION(:,:) :: rn_dqdt_s, zsrp
       INTEGER  ::   ierror   ! return error code
       !!
@@ -95,7 +97,20 @@
             !
             IF( nn_sstr == 1 ) THEN                                   !* Temperature restoring term
+
+               CALL wrk_alloc( jpi, jpj, rn_dqdt_s )
+               rn_dqdt_s(:,:) = rn_dqdt
+
+#if defined key_traldf_c2d || key_traldf_c3d
+            IF( ln_stopack .AND. nn_spp_dqdt > 0 ) &
+               & CALL spp_gen( kt, rn_dqdt_s, nn_spp_dqdt, rn_dqdt_sd, jk_spp_dqdt )
+#else
+            IF ( ln_stopack .AND. nn_spp_dqdt > 0 ) &
+               & CALL ctl_stop( 'sbc_ssr: parameter perturbation will only work with '// &
+                                'key_traldf_c2d or key_traldf_c3d')
+#endif
+
                DO jj = 1, jpj
                   DO ji = 1, jpi
-                     zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) )
+                     zqrp = rn_dqdt_s(ji,jj) * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) )
                      qns(ji,jj) = qns(ji,jj) + zqrp
                      qrp(ji,jj) = zqrp
@@ -103,13 +118,25 @@
                END DO
                CALL iom_put( "qrp", qrp )                             ! heat flux damping
+               CALL wrk_dealloc( jpi, jpj, rn_dqdt_s )
             ENDIF
             !
             IF( nn_sssr == 1 ) THEN                                   !* Salinity damping term (salt flux only (sfx))
-               zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s]
+               CALL wrk_alloc( jpi, jpj, zsrp)
+               zsrp(:,:) = rn_deds
+#if defined key_traldf_c2d || key_traldf_c3d
+               IF( ln_stopack .AND. nn_spp_dedt > 0 ) &
+                  & CALL spp_gen(kt, zsrp, nn_spp_dedt, rn_dedt_sd, jk_spp_deds )
+#else
+            IF ( ln_stopack .AND. nn_spp_icealb > 0 ) &
+               & CALL ctl_stop( 'sbc_ssr: parameter perturbation will only work with '// &
+                                'key_traldf_c2d or key_traldf_c3d')
+#endif
+
+
 !CDIR COLLAPSE
                DO jj = 1, jpj
                   DO ji = 1, jpi
-                     zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths
-                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) 
+                     zerp = (zsrp(ji,jj)/rday) * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths
+                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )
                      sfx(ji,jj) = sfx(ji,jj) + zerp                 ! salt flux
                      erp(ji,jj) = zerp / MAX( sss_m(ji,jj), 1.e-20 ) ! converted into an equivalent volume flux (diagnostic only)
@@ -117,12 +144,22 @@
                END DO
                CALL iom_put( "erp", erp )                             ! freshwater flux damping
+               CALL wrk_dealloc( jpi,jpj, zsrp )
                !
             ELSEIF( nn_sssr == 2 ) THEN                               !* Salinity damping term (volume flux (emp) and associated heat flux (qns)
-               zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s]
-               zerp_bnd = rn_sssr_bnd / rday                          !       -              -    
+               CALL wrk_alloc( jpi, jpj, zsrp)
+               zsrp(:,:) = rn_deds
+#if defined key_traldf_c2d || key_traldf_c3d
+               IF( ln_stopack .AND. nn_spp_dedt > 0 ) &
+                  & CALL spp_gen( kt, zsrp, nn_spp_dedt, rn_dedt_sd, jk_spp_deds )
+#else
+               IF ( ln_stopack .AND. nn_spp_dedt > 0 ) &
+                  & CALL ctl_stop( 'sbc_ssr: parameter perturbation will only work with '// &
+                                   'key_traldf_c2d or key_traldf_c3d')
+#endif
+               zerp_bnd = rn_sssr_bnd / rday                          !       -              -
 !CDIR COLLAPSE
                DO jj = 1, jpj
-                  DO ji = 1, jpi                            
-                     zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths
+                  DO ji = 1, jpi
+                     zerp = (zsrp(ji,jj)/rday) * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths
                         &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )   &
                         &        / MAX(  sss_m(ji,jj), 1.e-20   )
@@ -134,4 +171,5 @@
                END DO
                CALL iom_put( "erp", erp )                             ! freshwater flux damping
+               CALL wrk_dealloc( jpi,jpj,zsrp )
             ENDIF
             !
@@ -144,5 +182,5 @@
    END SUBROUTINE sbc_ssr
 
- 
+
    SUBROUTINE sbc_ssr_init
       !!---------------------------------------------------------------------
@@ -167,6 +205,6 @@
       !!----------------------------------------------------------------------
       !
- 
-      REWIND( numnam_ref )              ! Namelist namsbc_ssr in reference namelist : 
+
+      REWIND( numnam_ref )              ! Namelist namsbc_ssr in reference namelist :
       READ  ( numnam_ref, namsbc_ssr, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_ssr in reference namelist', lwp )
@@ -224,10 +262,10 @@
       ENDIF
       !
-      !                            !* Initialize qrp and erp if no restoring 
+      !                            !* Initialize qrp and erp if no restoring
       IF( nn_sstr /= 1                   )   qrp(:,:) = 0._wp
       IF( nn_sssr /= 1 .OR. nn_sssr /= 2 )   erp(:,:) = 0._wp
       !
    END SUBROUTINE sbc_ssr_init
-      
+
    !!======================================================================
 END MODULE sbcssr
Index: branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/STO/stopack.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/STO/stopack.F90	(revision 15603)
+++ branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/STO/stopack.F90	(revision 15603)
@@ -0,0 +1,2831 @@
+!#define NEMO_V34
+
+! Portability to V34 is achieved through (aggressive) precompiler directives:
+! Uncomment the first line for NEMO v3.4
+
+#if defined NEMO_V34
+
+! Change name of trend indexes
+#define  jptra_xad jptra_trd_xad
+#define  jptra_yad jptra_trd_yad
+#define  jptra_zad jptra_trd_zad
+#define  jptra_ldf jptra_trd_ldf
+#define  jptra_zdf jptra_trd_zdf
+#define  jptra_bbc jptra_trd_bbc
+#define  jptra_bbl jptra_trd_bbl
+#define  jptra_npc jptra_trd_npc
+#define  jptra_dmp jptra_trd_dmp
+#define  jptra_qsr jptra_trd_qsr
+#define  jptra_nsr jptra_trd_nsr
+#define  jptra_atf jptra_trd_atf
+
+#define  jptra_sad  -999
+#define  jptra_zdfp -999
+#define  jptra_evd  -999
+
+#define  jpdyn_hpg jpdyn_trd_hpg
+#define  jpdyn_keg jpdyn_trd_keg
+#define  jpdyn_rvo jpdyn_trd_rvo
+#define  jpdyn_pvo jpdyn_trd_pvo
+#define  jpdyn_ldf jpdyn_trd_ldf
+#define  jpdyn_had jpdyn_trd_had
+#define  jpdyn_zad jpdyn_trd_zad
+#define  jpdyn_zdf jpdyn_trd_zdf
+#define  jpdyn_spg jpdyn_trd_spg
+#define  jpdyn_dat jpdyn_trd_dat
+#define  jpdyn_swf jpdyn_trd_swf
+#define  jpdyn_bfr jpdyn_trd_bfr
+
+#define jpdyn_spgflt  -999
+#define jpdyn_spgexp  -999
+#define jpdyn_atf     -999
+#define jpdyn_tau     -999
+#define jpdyn_bfri    -999
+
+! Change name of namelist units
+#define numnam_ref numnam
+#define numnam_cfg numnam
+#define lwm        lwp
+#define numond     numout
+
+#define wmask      tmask
+
+#endif
+
+MODULE stopack
+   !!======================================================================
+   !!                       ***  MODULE  stopack ***
+   !!        Calculate and Apply sotchastic physics perturbations
+   !!======================================================================
+   !! History :  1.0  !  2018-02  (A. Storto), Original SPPT code
+   !!                                          for NEMO 3.6
+   !!            2.0  !  2019-05  (A. Storto), upgrades and updates:
+   !!                                          (SPP, SKEB and sea-ice)
+   !!----------------------------------------------------------------------
+   !!
+   !!   stopack       : Generate stochastic physics perturbations
+   !!
+   !!                   Method
+   !!                   ======
+   !!                   The module allows users to activate:
+   !!   		- SPPT (Stochastically perturbed parameterization
+   !!			  tendencies )scheme for user-selected trends for
+   !!  			  tracers, momentum and sea-ice
+   !!   		- SPP (Schastically perturbed parameters) scheme
+   !!			  for some (namelist) parameters
+   !!   		- SEB (Stochastic Energy backscatter)
+   !!			  backscatter energy dissipated numerically or
+   !! 			  through deep convection.
+   !!
+   !!
+   !!                   Acknowledgements: C3S funded ERGO project
+   !!
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE timing          ! Timing
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE in_out_manager  ! I/O manager
+#ifdef NEMO_V34
+   USE trdmod_oce
+   USE restart
+#else
+   USE trd_oce
+#endif
+   USE iom             ! I/O manager library
+   USE lib_mpp         ! MPP library
+#if defined key_lim3
+   USE ice             ! LIM-3 variables
+#endif
+#if defined key_lim2
+   USE ice_2           ! LIM-2 variables
+#endif
+   USE wrk_nemo
+   USE diaptr
+   USE zdf_oce
+   USE phycst
+
+   IMPLICIT NONE
+   PRIVATE
+
+   ! Accessible routines
+   PUBLIC tra_sppt_collect
+   PUBLIC dyn_sppt_collect
+   PUBLIC tra_sppt_apply
+   PUBLIC dyn_sppt_apply
+   PUBLIC stopack_rst
+   PUBLIC stopack_init
+   PUBLIC stopack_pert
+   PUBLIC sppt_ice
+   PUBLIC spp_aht
+   PUBLIC spp_ahm
+   PUBLIC spp_gen
+   PUBLIC skeb_comp
+   PUBLIC skeb_apply
+
+   ! Main logical switch
+   LOGICAL, PUBLIC :: ln_stopack
+
+   ! Internal switches for SPPT
+   LOGICAL, PUBLIC, SAVE :: ln_sppt_tra = .FALSE.
+   LOGICAL, PUBLIC, SAVE :: ln_sppt_dyn = .FALSE.
+   LOGICAL, PUBLIC, SAVE :: ln_sppt_ice = .FALSE.
+
+   ! SPPT Options
+   INTEGER :: sppt_filter_pass, sppt_step, nn_vwei, &
+   & nn_sppt_step_bound, nn_rndm_freq, nn_deftau
+   REAL(wp), SAVE :: rn_sppt_tau, rn_sppt_bound, rn_distcoast, rn_sppt_stdev
+   REAL(wp), SAVE :: rn_skeb_tau, rn_skeb_stdev
+   REAL(wp), SAVE :: rn_spp_tau, rn_spp_stdev
+   INTEGER :: skeb_filter_pass, spp_filter_pass
+
+   ! SPPT Logical switches for individual tendencies
+   LOGICAL :: ln_sppt_taumap, ln_stopack_restart, ln_distcoast, &
+   ln_sppt_traxad, ln_sppt_trayad, ln_sppt_trazad, ln_sppt_trasad, ln_sppt_traldf, &
+   ln_sppt_trazdf, ln_sppt_trazdfp,ln_sppt_traevd, ln_sppt_trabbc, ln_sppt_trabbl, &
+   ln_sppt_tranpc, ln_sppt_tradmp, ln_sppt_traqsr, ln_sppt_transr, ln_sppt_traatf
+   LOGICAL :: &
+   ln_sppt_dynhpg, ln_sppt_dynspg, ln_sppt_dynkeg, ln_sppt_dynrvo, ln_sppt_dynpvo, ln_sppt_dynzad,&
+   ln_sppt_dynldf, ln_sppt_dynzdf, ln_sppt_dynbfr, ln_sppt_dynatf, ln_sppt_dyntau, ln_sppt_glocon
+   LOGICAL, PUBLIC :: &
+   ln_sppt_icehdf, ln_sppt_icelat, ln_sppt_icezdf
+
+   ! Arrays
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   gauss_n_2d
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   gauss_n_2d_p
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   gauss_n_2d_k
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   coeff_bfr
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gauss_n, zdc
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gauss_nu, gauss_nv
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   spptt, sppts, spptu, spptv
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   gauss_b, sppt_tau, sppt_a, sppt_b
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   skeb_a, skeb_b
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   spp_a, spp_b
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   gauss_bp, gauss_bk
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   g2d_save
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:    ) ::   gauss_w
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   zicewrk
+   REAL(wp),              SAVE                   ::   flt_fac,flt_fac_k,flt_fac_p
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   spp_tau
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   skeb_tau
+
+   INTEGER, PARAMETER, PUBLIC :: jk_spp_alb    = 1
+   INTEGER, PARAMETER, PUBLIC :: jk_spp_rhg    = 2
+   INTEGER, PARAMETER, PUBLIC :: jk_spp_relw   = 3
+   INTEGER, PARAMETER, PUBLIC :: jk_spp_dqdt   = 4
+   INTEGER, PARAMETER, PUBLIC :: jk_spp_deds   = 5
+   INTEGER, PARAMETER, PUBLIC :: jk_spp_arnf   = 6
+   INTEGER, PARAMETER, PUBLIC :: jk_spp_geot   = 7
+   INTEGER, PARAMETER, PUBLIC :: jk_spp_qsi0   = 8
+   INTEGER, PARAMETER, PUBLIC :: jk_spp_bfr    = 9
+   INTEGER, PARAMETER, PUBLIC :: jk_spp_aevd   = 10
+   INTEGER, PARAMETER, PUBLIC :: jk_spp_avt    = 11
+   INTEGER, PARAMETER, PUBLIC :: jk_spp_avm    = 12
+   INTEGER, PARAMETER, PUBLIC :: jk_spp_tkelc  = 13
+   INTEGER, PARAMETER, PUBLIC :: jk_spp_tkedf  = 14
+   INTEGER, PARAMETER, PUBLIC :: jk_spp_tkeds  = 15
+   INTEGER, PARAMETER, PUBLIC :: jk_spp_tkebb  = 16
+   INTEGER, PARAMETER, PUBLIC :: jk_spp_tkefr  = 17
+
+   INTEGER, PARAMETER, PUBLIC :: jk_spp_ahtu   = 18
+   INTEGER, PARAMETER, PUBLIC :: jk_spp_ahtv   = 19
+   INTEGER, PARAMETER, PUBLIC :: jk_spp_ahtw   = 20
+   INTEGER, PARAMETER, PUBLIC :: jk_spp_ahtt   = 21
+
+   INTEGER, PARAMETER, PUBLIC :: jk_spp_ahubbl = 22
+   INTEGER, PARAMETER, PUBLIC :: jk_spp_ahvbbl = 23
+
+   INTEGER, PARAMETER, PUBLIC :: jk_spp_ahm1   = 24
+   INTEGER, PARAMETER, PUBLIC :: jk_spp_ahm2   = 25
+   INTEGER, PARAMETER, PUBLIC :: jk_spp_ahm3   = 26
+   INTEGER, PARAMETER, PUBLIC :: jk_spp_ahm4   = 27
+
+   INTEGER, PARAMETER, PUBLIC :: jk_skeb_dnum  = 31
+   INTEGER, PARAMETER, PUBLIC :: jk_skeb_dcon  = 32
+   INTEGER, PARAMETER, PUBLIC :: jk_skeb_tot   = 33
+
+   INTEGER, PARAMETER, PUBLIC :: jk_sppt_tem   = 41
+   INTEGER, PARAMETER, PUBLIC :: jk_sppt_sal   = 42
+   INTEGER, PARAMETER, PUBLIC :: jk_sppt_uvl   = 43
+   INTEGER, PARAMETER, PUBLIC :: jk_sppt_vvl   = 44
+
+   INTEGER, PARAMETER, PUBLIC :: jk_spp        = 27
+   INTEGER, PARAMETER, PUBLIC :: jk_stpk_tot   = 44
+   REAL(wp), SAVE :: rn_mmax( jk_stpk_tot ) = 0._wp
+
+   INTEGER, SAVE :: numdiag      = 601
+   INTEGER, SAVE :: numrep        = 602
+   INTEGER, SAVE :: lkt
+
+   ! Randome generator seed
+   INTEGER, SAVE   :: nn_stopack_seed(4)
+   LOGICAL,   SAVE, PUBLIC :: ln_stopack_repr = .TRUE.
+
+   ! SPP switches
+   INTEGER, PUBLIC, SAVE :: nn_spp_bfr,nn_spp_dqdt,nn_spp_dedt,nn_spp_avt,nn_spp_avm,nn_spp_qsi0,nn_spp_relw, nn_spp_arnf,nn_spp_geot,nn_spp_aevd,nn_spp_ahubbl,nn_spp_ahvbbl
+   INTEGER, PUBLIC, SAVE :: nn_spp_tkelc,nn_spp_tkedf,nn_spp_tkeds,nn_spp_tkebb,nn_spp_tkefr
+   INTEGER, PUBLIC, SAVE :: nn_spp_ahtu, nn_spp_ahtv, nn_spp_ahtw, nn_spp_ahtt
+   INTEGER, PUBLIC, SAVE :: nn_spp_ahm1, nn_spp_ahm2
+   ! SPP Sea-ice switches
+   INTEGER, PUBLIC, SAVE :: nn_spp_icealb,nn_spp_icestr
+
+   ! SPP parameters
+   REAL(wp), PUBLIC, SAVE :: rn_bfr_sd, rn_dqdt_sd, rn_dedt_sd, rn_avt_sd, rn_avm_sd, rn_qsi0_sd, rn_relw_sd, rn_arnf_sd, rn_geot_sd, rn_aevd_sd, rn_ahubbl_sd, rn_ahvbbl_sd
+   REAL(wp), PUBLIC, SAVE :: rn_tkelc_sd,rn_tkedf_sd,rn_tkeds_sd,rn_tkebb_sd,rn_tkefr_sd
+   REAL(wp), PUBLIC, SAVE :: rn_ahtu_sd, rn_ahtv_sd, rn_ahtw_sd, rn_ahtt_sd
+   REAL(wp), PUBLIC, SAVE :: rn_ahm1_sd, rn_ahm2_sd
+   REAL(wp), PUBLIC, SAVE :: rn_icestr_sd, rn_icealb_sd
+
+   ! Internal switches for SPP
+   LOGICAL,   SAVE :: ln_spp_own_gauss
+   INTEGER         :: nn_spp
+
+   LOGICAL,  SAVE :: ln_stopack_diags
+
+   LOGICAL,  SAVE :: ln_skeb_own_gauss
+   LOGICAL,  SAVE, PUBLIC :: ln_skeb
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) :: dpsiv, dpsiu
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dnum , dcon
+   INTEGER,  SAVE :: jpri,jprj
+   INTEGER,  SAVE :: nn_dcom_freq = 1
+   REAL(wp), SAVE :: rn_skeb, rn_kh, rn_kc
+   LOGICAL,  SAVE, PUBLIC :: ln_dpsiv = .FALSE.
+   LOGICAL,  SAVE, PUBLIC :: ln_dpsiu = .FALSE.
+   REAL(wp), SAVE :: rn_beta_num, rn_beta_con
+   INTEGER,  SAVE :: nn_dconv = 1
+
+   ! Default/initial seeds
+   INTEGER(KIND=i8) :: x=1234567890987654321_8
+   INTEGER(KIND=i8) :: y=362436362436362436_8
+   INTEGER(KIND=i8) :: z=1066149217761810_8
+   INTEGER(KIND=i8) :: w=123456123456123456_8
+   ! Parameters to generate real random variates
+   REAL(KIND=wp), PARAMETER :: huge64=9223372036854775808.0  ! +1
+   REAL(KIND=wp), PARAMETER :: zero=0.0, half=0.5, one=1.0, two=2.0
+   ! Variables to store 2 Gaussian random numbers with current index (ig)
+   INTEGER(KIND=i8), SAVE :: ig=1
+   REAL(KIND=wp), SAVE :: gran1, gran2
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: bdytra.F90 4292 2013-11-20 16:28:04Z cetlod $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#if defined NEMO_V34
+   SUBROUTINE tra_sppt_collect( ptrdx, ptrdy, ktrd )
+#else
+   SUBROUTINE tra_sppt_collect( ptrdx, ptrdy, ktrd, kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_sppt_collect ***
+      !!
+      !! ** Purpose :   Collect tracer tendencies (additive)
+      !!                This function is called by the tendency diagnostics
+      !!                module
+      !!----------------------------------------------------------------------
+      INTEGER                   , INTENT(in   ) ::   kt      ! time step
+#endif
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   ptrdx   ! Temperature
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   ptrdy   ! Salinity
+      INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index
+
+      IF( ktrd .eq. jptra_xad .AND. ln_sppt_traxad ) THEN
+           spptt = spptt + ptrdx ; sppts = sppts + ptrdy
+      ENDIF
+      IF( ktrd .eq. jptra_yad .AND. ln_sppt_trayad ) THEN
+           spptt = spptt + ptrdx ; sppts = sppts + ptrdy
+      ENDIF
+      IF( ktrd .eq. jptra_zad .AND. ln_sppt_trazad ) THEN
+           spptt = spptt + ptrdx ; sppts = sppts + ptrdy
+      ENDIF
+      IF( ktrd .eq. jptra_sad .AND. ln_sppt_trasad ) THEN
+           spptt = spptt + ptrdx ; sppts = sppts + ptrdy
+      ENDIF
+      IF( ktrd .eq. jptra_ldf .AND. ln_sppt_traldf ) THEN
+           spptt = spptt + ptrdx ; sppts = sppts + ptrdy
+      ENDIF
+      IF( ktrd .eq. jptra_zdf .AND. ln_sppt_trazdf ) THEN
+           spptt = spptt + ptrdx ; sppts = sppts + ptrdy
+      ENDIF
+      IF( ktrd .eq. jptra_zdfp.AND. ln_sppt_trazdfp) THEN
+           spptt = spptt + ptrdx ; sppts = sppts + ptrdy
+      ENDIF
+      IF( ktrd .eq. jptra_evd .AND. ln_sppt_traevd ) THEN
+           spptt = spptt + ptrdx ; sppts = sppts + ptrdy
+      ENDIF
+      IF( ktrd .eq. jptra_bbc .AND. ln_sppt_trabbc ) THEN
+           spptt = spptt + ptrdx ; sppts = sppts + ptrdy
+      ENDIF
+      IF( ktrd .eq. jptra_bbl .AND. ln_sppt_trabbl ) THEN
+           spptt = spptt + ptrdx ; sppts = sppts + ptrdy
+      ENDIF
+      IF( ktrd .eq. jptra_npc .AND. ln_sppt_tranpc ) THEN
+           spptt = spptt + ptrdx ; sppts = sppts + ptrdy
+      ENDIF
+      IF( ktrd .eq. jptra_dmp .AND. ln_sppt_tradmp ) THEN
+           spptt = spptt + ptrdx ; sppts = sppts + ptrdy
+      ENDIF
+      IF( ktrd .eq. jptra_qsr .AND. ln_sppt_traqsr ) THEN
+           spptt = spptt + ptrdx ; sppts = sppts + ptrdy
+      ENDIF
+      IF( ktrd .eq. jptra_nsr .AND. ln_sppt_transr ) THEN
+           spptt = spptt + ptrdx ; sppts = sppts + ptrdy
+      ENDIF
+      IF( ktrd .eq. jptra_atf .AND. ln_sppt_traatf ) THEN
+           spptt = spptt + ptrdx ; sppts = sppts + ptrdy
+      ENDIF
+
+   END SUBROUTINE tra_sppt_collect
+
+#if defined NEMO_V34
+   SUBROUTINE dyn_sppt_collect( ptrdx, ptrdy, ktrd )
+#else
+   SUBROUTINE dyn_sppt_collect( ptrdx, ptrdy, ktrd, kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_sppt_collect ***
+      !!
+      !! ** Purpose :   Collect momentum tendencies (additive)
+      !!                This function is called by the tendency diagnostics
+      !!                module
+      !!----------------------------------------------------------------------
+      INTEGER                   , INTENT(in   ) ::   kt      ! time step
+#endif
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   ptrdx   ! Temperature
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   ptrdy   ! Salinity
+      INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index
+
+      IF( ktrd .eq. jpdyn_hpg .AND. ln_sppt_dynhpg ) THEN
+           spptu = spptu + ptrdx ; spptv = spptv + ptrdy
+      ENDIF
+      IF( ktrd .eq. jpdyn_spg .AND. ln_sppt_dynspg ) THEN
+           spptu = spptu + ptrdx ; spptv = spptv + ptrdy
+      ENDIF
+      IF( ktrd .eq. jpdyn_spgflt .AND. ln_sppt_dynspg ) THEN
+           spptu = spptu + ptrdx ; spptv = spptv + ptrdy
+      ENDIF
+      IF( ktrd .eq. jpdyn_spgexp .AND. ln_sppt_dynspg ) THEN
+           spptu = spptu + ptrdx ; spptv = spptv + ptrdy
+      ENDIF
+      IF( ktrd .eq. jpdyn_keg .AND. ln_sppt_dynkeg ) THEN
+           spptu = spptu + ptrdx ; spptv = spptv + ptrdy
+      ENDIF
+      IF( ktrd .eq. jpdyn_rvo .AND. ln_sppt_dynrvo ) THEN
+           spptu = spptu + ptrdx ; spptv = spptv + ptrdy
+      ENDIF
+      IF( ktrd .eq. jpdyn_pvo .AND. ln_sppt_dynpvo ) THEN
+           spptu = spptu + ptrdx ; spptv = spptv + ptrdy
+      ENDIF
+      IF( ktrd .eq. jpdyn_zad .AND. ln_sppt_dynzad ) THEN
+           spptu = spptu + ptrdx ; spptv = spptv + ptrdy
+      ENDIF
+      IF( ktrd .eq. jpdyn_ldf .AND. ln_sppt_dynldf ) THEN
+           spptu = spptu + ptrdx ; spptv = spptv + ptrdy
+      ENDIF
+      IF( ktrd .eq. jpdyn_zdf .AND. ln_sppt_dynzdf ) THEN
+           spptu = spptu + ptrdx ; spptv = spptv + ptrdy
+      ENDIF
+      IF( ktrd .eq. jpdyn_bfr .AND. ln_sppt_dynbfr ) THEN
+           spptu = spptu + ptrdx ; spptv = spptv + ptrdy
+      ENDIF
+      IF( ktrd .eq. jpdyn_atf .AND. ln_sppt_dynatf ) THEN
+           spptu = spptu + ptrdx ; spptv = spptv + ptrdy
+      ENDIF
+      IF( ktrd .eq. jpdyn_tau .AND. ln_sppt_dyntau ) THEN
+           spptu = spptu + ptrdx ; spptv = spptv + ptrdy
+      ENDIF
+      IF( ktrd .eq. jpdyn_bfri.AND. ln_sppt_dynbfr ) THEN
+           spptu = spptu + ptrdx ; spptv = spptv + ptrdy
+      ENDIF
+
+   END SUBROUTINE dyn_sppt_collect
+
+   SUBROUTINE stopack_pert( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE stopack_pert ***
+      !!
+      !! ** Purpose :   Update perturbation every nn_rndm_freq timestep
+      !!                Calculate for SPPT, eventually for SPP and SKEB
+      !!                If they are activeated and with different error scales
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) :: kt
+      INTEGER :: ji,jj
+
+      IF( ln_stopack_diags ) lkt = kt
+      IF( MOD( kt - 1, nn_rndm_freq ) == 0 .OR. kt == nit000 ) THEN
+
+       IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' Calculating perturbation at timestep ', kt
+         WRITE(numout,*)
+       ENDIF
+
+       ! Generate red noise
+       CALL gaussian_ar1_field ( gauss_n , sppt_filter_pass, gauss_w , gauss_b,&
+        sppt_a, sppt_b, gauss_n_2d,flt_fac,1)
+
+       ! Generate red noise for SPP, SKEB if required
+       IF( ln_spp_own_gauss ) CALL gaussian_ar1_field ( gauss_n , spp_filter_pass, gauss_w , gauss_bp,&
+        spp_a, spp_b, gauss_n_2d_p,flt_fac_p,2)
+       IF( ln_skeb_own_gauss ) CALL gaussian_ar1_field ( gauss_n ,skeb_filter_pass, gauss_w , gauss_bk,&
+        skeb_a, skeb_b, gauss_n_2d_k,flt_fac_k,3)
+
+      ! Staggering on U-,V- grids
+      ! (later should account also for possibly different bottom levels)
+       DO jj=1,jpj-1
+         DO ji=1,jpi-1
+          gauss_nu(ji,jj,:) = 0.5_wp * (gauss_n(ji,jj,:)+gauss_n(ji+1,jj,:))
+          gauss_nv(ji,jj,:) = 0.5_wp * (gauss_n(ji,jj,:)+gauss_n(ji,jj+1,:))
+         ENDDO
+       ENDDO
+       CALL lbc_lnk( gauss_nu, 'U', -1._wp)
+       CALL lbc_lnk( gauss_nv, 'V', -1._wp)
+
+      ENDIF
+
+#ifdef key_iomput
+      ! Output the perturbation field
+      CALL iom_put( "sppt_ar1" , gauss_n )
+      IF(ln_spp_own_gauss)  CALL iom_put( "spp_ar1"  , gauss_n_2d_p)
+      IF(ln_skeb_own_gauss) CALL iom_put( "skeb_ar1" , gauss_n_2d_k)
+#endif
+
+   END SUBROUTINE stopack_pert
+
+#if defined key_lim2
+   SUBROUTINE sppt_ice( kstep, kopt, z1,z2,z3,z4,z5,z6,z7 )
+#else
+   SUBROUTINE sppt_ice( kstep, kopt)
+#endif
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sppt_ice ***
+      !!
+      !! ** Purpose :   Apply collinear perturbation to ice fields
+      !!                For specific processes coded in LIM2/LIM3
+      !!----------------------------------------------------------------------
+      !
+      INTEGER, INTENT(IN) :: kstep         ! Start (1) or End (2) of ice routine
+      INTEGER, INTENT(IN) :: kopt          ! Option for sea-ice routine
+#if defined key_lim2
+      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(INOUT) :: z1,z2,z3,z4,z5,z6,z7
+#endif
+#if defined key_lim3 || defined key_lim2
+      INTEGER :: jmt                       ! Number of sea-ice variables (depends on LIM version, process)
+      INTEGER :: jm, jl, jk
+
+#if defined key_lim3
+      jmt = 3*jpl+jpl*nlay_i
+      IF( kopt == 2 ) jmt=jmt+3*jpl+1
+#else
+      IF( kopt == 1 ) jmt=6
+      IF( kopt == 2 ) jmt=7
+      IF( kopt == 3 ) jmt=8
+#endif
+      IF( kopt == 4 ) jmt=2
+
+      IF( kstep == 1 ) THEN        ! Store the before values
+       IF ( ALLOCATED ( zicewrk) ) DEALLOCATE ( zicewrk )
+       ALLOCATE ( zicewrk(jpi,jpj,jmt) )
+       jm=1
+#if defined key_lim3
+       DO jl = 1, jpl
+          zicewrk(:,:,jm) = a_i(:,:,jl) ; jm=jm+1
+          zicewrk(:,:,jm) = v_i(:,:,jl) ; jm=jm+1
+          zicewrk(:,:,jm) =smv_i(:,:,jl); jm=jm+1
+          DO jk = 1, nlay_i
+             zicewrk(:,:,jm) = e_i(:,:,jk,jl) ; jm=jm+1
+          END DO
+       END DO
+       IF( kopt .EQ. 2 ) THEN
+         DO jl = 1, jpl
+           zicewrk(:,:,jm) =oa_i(:,:,jl) ; jm=jm+1
+           zicewrk(:,:,jm) = e_s(:,:,1,jl) ; jm=jm+1
+           zicewrk(:,:,jm) = v_s(:,:,jl) ; jm=jm+1
+         ENDDO
+         zicewrk(:,:,jm) =ato_i(:,:); jm=jm+1
+       ENDIF
+#else
+       IF( kopt .EQ. 1 ) THEN
+         zicewrk(:,:,jm) = frld   ; jm=jm+1
+         zicewrk(:,:,jm) = hsnif  ; jm=jm+1
+         zicewrk(:,:,jm) = hicif  ; jm=jm+1
+         zicewrk(:,:,jm) = tbif(:,:,1)   ; jm=jm+1
+         zicewrk(:,:,jm) = tbif(:,:,2)   ; jm=jm+1
+         zicewrk(:,:,jm) = tbif(:,:,3)   ; jm=jm+1
+       ENDIF
+       IF( kopt .EQ. 2 ) THEN
+         IF(.NOT. PRESENT(z1) ) CALL ctl_stop( 'sppt icehdf problem, step 1')
+         zicewrk(:,:,jm) = z1     ; jm=jm+1
+         zicewrk(:,:,jm) = z2     ; jm=jm+1
+         zicewrk(:,:,jm) = z3     ; jm=jm+1
+         zicewrk(:,:,jm) = z4     ; jm=jm+1
+         zicewrk(:,:,jm) = z5     ; jm=jm+1
+         zicewrk(:,:,jm) = z6     ; jm=jm+1
+         zicewrk(:,:,jm) = z7
+       ENDIF
+       IF( kopt .EQ. 3 ) THEN
+         zicewrk(:,:,jm) = frld   ; jm=jm+1
+         zicewrk(:,:,jm) = hsnif  ; jm=jm+1
+         zicewrk(:,:,jm) = hicif  ; jm=jm+1
+         zicewrk(:,:,jm) = sist   ; jm=jm+1
+         zicewrk(:,:,jm) = tbif(:,:,1)   ; jm=jm+1
+         zicewrk(:,:,jm) = tbif(:,:,2)   ; jm=jm+1
+         zicewrk(:,:,jm) = tbif(:,:,3)   ; jm=jm+1
+       ENDIF
+#endif
+       IF ( kopt .EQ. 4 ) THEN
+         zicewrk(:,:,jm) = u_ice  ; jm=jm+1
+         zicewrk(:,:,jm) = v_ice  ; jm=jm+1
+       ENDIF
+      ELSEIF ( kstep == 2 ) THEN   ! Add collinear perturbation
+          jm=1
+#if defined key_lim3
+          DO jl = 1, jpl
+            a_i(:,:,jl) = a_i(:,:,jl) + (a_i(:,:,jl)-zicewrk(:,:,jm))*gauss_n_2d ; jm=jm+1 ; CALL lbc_lnk(a_i(:,:,jl), 'T', 1. )
+            v_i(:,:,jl) = v_i(:,:,jl) + (v_i(:,:,jl)-zicewrk(:,:,jm))*gauss_n_2d ; jm=jm+1 ; CALL lbc_lnk(v_i(:,:,jl), 'T', 1. )
+           smv_i(:,:,jl)=smv_i(:,:,jl)+ (smv_i(:,:,jl)-zicewrk(:,:,jm))*gauss_n_2d ; jm=jm+1 ; CALL lbc_lnk(smv_i(:,:,jl), 'T', 1. )
+            DO jk = 1, nlay_i
+               e_i(:,:,jk,jl) = e_i(:,:,jk,jl)+(e_i(:,:,jk,jl)-zicewrk(:,:,jm))*gauss_n_2d ; jm=jm+1 ; CALL lbc_lnk(e_i(:,:,jk,jl), 'T', 1. )
+            END DO
+          END DO
+          IF( kopt .EQ. 2 ) THEN
+            DO jl = 1, jpl
+              oa_i(:,:,jl)=oa_i(:,:,jl)+(oa_i(:,:,jl)-zicewrk(:,:,jm))*gauss_n_2d ; jm=jm+1 ; CALL lbc_lnk(oa_i(:,:,jl), 'T', 1. )
+               e_s(:,:,1,jl)= e_s(:,:,1,jl)+( e_s(:,:,1,jl)-zicewrk(:,:,jm))*gauss_n_2d ; jm=jm+1 ; CALL lbc_lnk(e_s(:,:,1,jl), 'T', 1. )
+               v_s(:,:,jl)= v_s(:,:,jl)+( v_s(:,:,jl)-zicewrk(:,:,jm))*gauss_n_2d ; jm=jm+1 ; CALL lbc_lnk(v_s(:,:,jl), 'T', 1. )
+            ENDDO
+            ato_i(:,:)=ato_i(:,:)+(ato_i(:,:)-zicewrk(:,:,jm))*gauss_n_2d ; jm=jm+1 ; CALL lbc_lnk(ato_i(:,:), 'T', 1. )
+          ENDIF
+          DEALLOCATE ( zicewrk )
+#else
+          IF( kopt .EQ. 1 ) THEN
+            frld   = frld   + gauss_n_2d * ( frld   - zicewrk(:,:,jm) ) ; jm=jm+1 ; CALL lbc_lnk(frld, 'T', 1. )
+            hsnif  = hsnif  + gauss_n_2d * ( hsnif  - zicewrk(:,:,jm) ) ; jm=jm+1 ; CALL lbc_lnk(hsnif, 'T', 1. )
+            hicif  = hicif  + gauss_n_2d * ( hicif  - zicewrk(:,:,jm) ) ; jm=jm+1 ; CALL lbc_lnk(hicif, 'T', 1. )
+        tbif(:,:,1)=tbif(:,:,1) + gauss_n_2d * ( tbif(:,:,1) - zicewrk(:,:,jm) ) ; jm=jm+1 ; CALL lbc_lnk(tbif(:,:,1), 'T', 1. )
+        tbif(:,:,2)=tbif(:,:,2) + gauss_n_2d * ( tbif(:,:,2) - zicewrk(:,:,jm) ) ; jm=jm+1 ; CALL lbc_lnk(tbif(:,:,2), 'T', 1. )
+        tbif(:,:,3)=tbif(:,:,3) + gauss_n_2d * ( tbif(:,:,3) - zicewrk(:,:,jm) ) ; jm=jm+1 ; CALL lbc_lnk(tbif(:,:,3), 'T', 1. )
+          ENDIF
+          IF( kopt .EQ. 2 ) THEN
+            IF(.NOT. PRESENT(z1) ) CALL ctl_stop( 'sppt icehdf problem, step 2')
+            z1 = z1 + gauss_n_2d * ( z1 - zicewrk(:,:,jm) ) ; jm=jm+1 ; CALL lbc_lnk( z1, 'T', 1. )
+            z2 = z2 + gauss_n_2d * ( z2 - zicewrk(:,:,jm) ) ; jm=jm+1 ; CALL lbc_lnk( z2, 'T', 1. )
+            z3 = z3 + gauss_n_2d * ( z3 - zicewrk(:,:,jm) ) ; jm=jm+1 ; CALL lbc_lnk( z3, 'T', 1. )
+            z4 = z4 + gauss_n_2d * ( z4 - zicewrk(:,:,jm) ) ; jm=jm+1 ; CALL lbc_lnk( z4, 'T', 1. )
+            z5 = z5 + gauss_n_2d * ( z5 - zicewrk(:,:,jm) ) ; jm=jm+1 ; CALL lbc_lnk( z5, 'T', 1. )
+            z6 = z6 + gauss_n_2d * ( z6 - zicewrk(:,:,jm) ) ; jm=jm+1 ; CALL lbc_lnk( z6, 'T', 1. )
+            z7 = z7 + gauss_n_2d * ( z7 - zicewrk(:,:,jm) )           ; CALL lbc_lnk( z7, 'T', 1. )
+          ENDIF
+          IF( kopt .EQ. 3 ) THEN
+            frld   = frld   + gauss_n_2d * ( frld   - zicewrk(:,:,jm) ) ; jm=jm+1  ; CALL lbc_lnk(frld, 'T', 1. )
+            hsnif  = hsnif  + gauss_n_2d * ( hsnif  - zicewrk(:,:,jm) ) ; jm=jm+1  ; CALL lbc_lnk(hsnif, 'T', 1. )
+            hicif  = hicif  + gauss_n_2d * ( hicif  - zicewrk(:,:,jm) ) ; jm=jm+1  ; CALL lbc_lnk(hicif, 'T', 1. )
+            sist   = sist   + gauss_n_2d * ( sist   - zicewrk(:,:,jm) ) ; jm=jm+1  ; CALL lbc_lnk(sist, 'T', 1. )
+        tbif(:,:,1)=tbif(:,:,1) + gauss_n_2d * ( tbif(:,:,1) - zicewrk(:,:,jm) ) ; jm=jm+1 ; CALL lbc_lnk(tbif(:,:,1), 'T', 1. )
+        tbif(:,:,2)=tbif(:,:,2) + gauss_n_2d * ( tbif(:,:,2) - zicewrk(:,:,jm) ) ; jm=jm+1 ; CALL lbc_lnk(tbif(:,:,2), 'T', 1. )
+        tbif(:,:,3)=tbif(:,:,3) + gauss_n_2d * ( tbif(:,:,3) - zicewrk(:,:,jm) ) ; jm=jm+1 ; CALL lbc_lnk(tbif(:,:,3), 'T', 1. )
+          ENDIF
+#endif
+   ! EVP or VP rheology common to LIM2-EVP and LIM3
+          IF ( kopt .EQ. 4 ) THEN
+            u_ice = u_ice + (u_ice - zicewrk(:,:,jm) ) * gauss_n_2d ; jm=jm+1
+            v_ice = v_ice + (v_ice - zicewrk(:,:,jm) ) * gauss_n_2d ; jm=jm+1
+#if defined key_lim3 || (  defined key_lim2 && ! defined key_lim2_vp )
+            CALL lbc_lnk( u_ice, 'U', -1. )
+            CALL lbc_lnk( v_ice, 'V', -1. )
+#endif
+#if defined key_lim2   &&   defined key_lim2_vp
+            CALL lbc_lnk( u_ice(:,1:jpj), 'I', -1. )
+            CALL lbc_lnk( v_ice(:,1:jpj), 'I', -1. )
+#endif
+          ENDIF
+          DEALLOCATE ( zicewrk )
+      ENDIF
+#endif
+   END SUBROUTINE sppt_ice
+
+   SUBROUTINE spp_gen  ( kt, coeff, nn_type, rn_sd, kspp, klev )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE spp_gen ***
+      !!
+      !! ** Purpose :   Perturbing parameters (generic function)
+      !!                Given a value of standard deviation, the 2D parameter
+      !!                coeff is perturbed following an additive Normal,
+      !!                a lognormal with mean the original coeff,
+      !!                a lognormal with median the original coeff,
+      !!		or the previous functions but with value bounded [0.1]
+      !!----------------------------------------------------------------------
+   INTEGER, INTENT( in ) :: kt
+   REAL(wp), INTENT( inout ), DIMENSION(jpi,jpj) :: coeff
+   INTEGER, INTENT( in ) ::  nn_type
+   REAL(wp), INTENT( in ) :: rn_sd
+   INTEGER, INTENT( in ) ::  kspp
+   INTEGER, INTENT( in ), OPTIONAL ::  klev
+   REAL(wp), POINTER, DIMENSION(:,:) ::   gauss
+   REAL(wp) :: zsd,xme,mm
+   CHARACTER (LEN=99) :: cstrng
+   INTEGER :: jklev
+
+#if defined key_traldf_c3d || key_traldf_c2d
+
+   CALL wrk_alloc(jpi,jpj,gauss)
+
+   IF( ln_spp_own_gauss ) THEN
+      gauss = gauss_n_2d_p
+   ELSE
+      gauss = rn_spp_stdev * gauss_n_2d / rn_sppt_stdev
+   ENDIF
+
+   IF( nn_type == 1 ) THEN
+       gauss = gauss * rn_sd
+       coeff = coeff * ( 1._wp + gauss )
+   ELSEIF ( nn_type  == 2 ) THEN
+       zsd = rn_sd
+       xme = -0.5_wp*zsd*zsd
+       gauss = gauss * zsd + xme
+       coeff = exp(gauss) * coeff
+   ELSEIF ( nn_type == 3 ) THEN
+       zsd = rn_sd
+       xme = 0._wp
+       gauss = gauss * zsd + xme
+       coeff = exp(gauss) * coeff
+   ELSEIF( nn_type == 4 ) THEN
+       gauss = gauss * rn_sd
+       coeff = coeff * ( 1._wp + gauss )
+       WHERE( coeff > 1._wp ) coeff = 1._wp
+       WHERE( coeff < 0._wp ) coeff = 0._wp
+   ELSEIF ( nn_type  == 5 ) THEN
+       zsd = rn_sd
+       xme = -0.5_wp*zsd*zsd
+       gauss = gauss * zsd + xme
+       coeff = exp(gauss) * coeff
+       WHERE( coeff > 1._wp ) coeff = 1._wp
+       WHERE( coeff < 0._wp ) coeff = 0._wp
+   ELSEIF ( nn_type == 6 ) THEN
+       zsd = rn_sd
+       xme = 0._wp
+       gauss = gauss * zsd + xme
+       coeff = exp(gauss) * coeff
+       WHERE( coeff > 1._wp ) coeff = 1._wp
+       WHERE( coeff < 0._wp ) coeff = 0._wp
+   ELSE
+       CALL ctl_stop( 'spp dqdt wrong option')
+   ENDIF
+
+#ifdef key_iomput
+   write(cstrng,'(A,I2.2)') 'spp_par',kspp
+   IF (iom_use(TRIM(cstrng)) ) CALL iom_put( TRIM(cstrng) , coeff )
+#endif
+
+   IF( ln_stopack_diags ) THEN
+     IF(PRESENT(klev)) THEN
+       jklev = klev
+     ELSE
+       jklev = 0
+     ENDIF
+     CALL spp_stats(kt,kspp,jklev,coeff)
+   ENDIF
+
+   CALL wrk_dealloc(jpi,jpj,gauss)
+
+#else
+   CALL ctl_stop('key_traldf_c1d is not a valid key for STO')
+#endif
+
+   END SUBROUTINE
+
+   SUBROUTINE spp_stats(mt,kp,kl,rcf)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE spp_stats ***
+      !!
+      !! ** Purpose :   Compute and print basic SPP statistics
+      !!----------------------------------------------------------------------
+   IMPLICIT NONE
+   INTEGER, INTENT(IN) :: mt,kp,kl
+   REAL(wp), INTENT(IN) :: rcf(jpi,jpj)
+   REAL(wp) :: mi,ma
+   CHARACTER(LEN=16) :: cstr = '                '
+   SELECT CASE ( kp )
+     CASE( jk_spp_alb   )
+       cstr = 'ALBEDO      '
+     CASE( jk_spp_rhg   )
+       cstr = 'ICE RHEOLOGY'
+     CASE( jk_spp_relw  )
+       cstr = 'RELATIVE WND'
+     CASE( jk_spp_dqdt  )
+       cstr = 'SST RELAXAT.'
+     CASE( jk_spp_deds  )
+       cstr = 'SSS RELAXAT.'
+     CASE( jk_spp_arnf  )
+       cstr = 'RIVER MIXING'
+     CASE( jk_spp_geot  )
+       cstr = 'GEOTHERM.FLX'
+     CASE( jk_spp_qsi0  )
+       cstr = 'SOLAR EXTIN.'
+     CASE( jk_spp_bfr   )
+       cstr = 'BOTTOM FRICT'
+     CASE( jk_spp_aevd  )
+       cstr = 'EDDY VISCDIF'
+     CASE( jk_spp_avt   )
+       cstr = 'VERT. DIFFUS'
+     CASE( jk_spp_avm   )
+       cstr = 'VERT. VISCOS'
+     CASE( jk_spp_tkelc )
+       cstr = 'TKE LANGMUIR'
+     CASE( jk_spp_tkedf )
+       cstr = 'TKE RN_EDIFF'
+     CASE( jk_spp_tkeds )
+       cstr = 'TKE RN_EDISS'
+     CASE( jk_spp_tkebb )
+       cstr = 'TKE RN_EBB  '
+     CASE( jk_spp_tkefr )
+       cstr = 'TKE RN_EFR  '
+     CASE( jk_spp_ahtu  )
+       cstr = 'TRALDF AHTU '
+     CASE( jk_spp_ahtv  )
+       cstr = 'TRALDF AHTV '
+     CASE( jk_spp_ahtw  )
+       cstr = 'TRALDF AHTW '
+     CASE( jk_spp_ahtt  )
+       cstr = 'TRALDF AHTT '
+     CASE( jk_spp_ahubbl )
+       cstr = 'BBL DIFFUSU '
+     CASE( jk_spp_ahvbbl )
+       cstr = 'BBL DIFFUSV '
+     CASE( jk_spp_ahm1 )
+       cstr = 'DYNLDF AHM1 '
+     CASE( jk_spp_ahm2 )
+       cstr = 'DYNLDF AHM2 '
+     CASE( jk_spp_ahm3 )
+       cstr = 'DYNLDF AHM3 '
+     CASE( jk_spp_ahm4 )
+       cstr = 'DYNLDF AHM4 '
+     CASE DEFAULT
+       CALL ctl_stop('Unrecognized SPP parameter: add it or turn off diagnostics')
+   END SELECT
+   mi = MINVAL(rcf)
+   ma = MAXVAL(rcf)
+   IF(lk_mpp) CALL mpp_min(mi)
+   IF(lk_mpp) CALL mpp_max(ma)
+   IF(lwp) THEN
+      IF ( kl > 0 ) write(cstr(14:16),'(I3.3)') kl
+      WRITE(numdiag,9300) lkt,cstr,mi,ma
+   ENDIF
+9300  FORMAT(' it :', i8, ' ', A16, ' Min: ',d10.3 , ' Max: ',d10.3)
+   rn_mmax ( kp ) =  MAX ( MAX( abs(mi), ma), rn_mmax ( kp ) )
+   END SUBROUTINE spp_stats
+
+   SUBROUTINE stopack_report
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE spp_stats ***
+      !!
+      !! ** Purpose :  Report at the end of the run
+      !!----------------------------------------------------------------------
+   IMPLICIT NONE
+   INTEGER :: jp, numrep
+   CHARACTER(LEN=16) :: cstr = '                '
+   REAL(wp) :: zmul
+
+   CALL ctl_opn(numrep, 'stopack.report', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
+
+   WRITE(numrep,'(A)') ' REPORT from STOPACK stochastic physics package'
+   WRITE(numrep,'(A)')
+   WRITE(numrep,'(A)') ' SPP  part'
+
+   DO jp=1,jk_spp
+     SELECT CASE ( jp )
+       CASE( jk_spp_alb   )
+         cstr = 'ALBEDO      '
+       CASE( jk_spp_rhg   )
+         cstr = 'ICE RHEOLOGY'
+       CASE( jk_spp_relw  )
+         cstr = 'RELATIVE WND'
+       CASE( jk_spp_dqdt  )
+         cstr = 'SST RELAXAT.'
+       CASE( jk_spp_deds  )
+         cstr = 'SSS RELAXAT.'
+       CASE( jk_spp_arnf  )
+         cstr = 'RIVER MIXING'
+       CASE( jk_spp_geot  )
+         cstr = 'GEOTHERM.FLX'
+       CASE( jk_spp_qsi0  )
+         cstr = 'SOLAR EXTIN.'
+       CASE( jk_spp_bfr   )
+         cstr = 'BOTTOM FRICT'
+       CASE( jk_spp_aevd  )
+         cstr = 'EDDY VISCDIF'
+       CASE( jk_spp_avt   )
+         cstr = 'VERT. DIFFUS'
+       CASE( jk_spp_avm   )
+         cstr = 'VERT. VISCOS'
+       CASE( jk_spp_tkelc )
+         cstr = 'TKE LANGMUIR'
+       CASE( jk_spp_tkedf )
+         cstr = 'TKE RN_EDIFF'
+       CASE( jk_spp_tkeds )
+         cstr = 'TKE RN_EDISS'
+       CASE( jk_spp_tkebb )
+         cstr = 'TKE RN_EBB  '
+       CASE( jk_spp_tkefr )
+         cstr = 'TKE RN_EFR  '
+       CASE( jk_spp_ahtu  )
+         cstr = 'TRALDF AHTU '
+       CASE( jk_spp_ahtv  )
+         cstr = 'TRALDF AHTV '
+       CASE( jk_spp_ahtw  )
+         cstr = 'TRALDF AHTW '
+       CASE( jk_spp_ahtt  )
+         cstr = 'TRALDF AHTT '
+       CASE( jk_spp_ahubbl )
+         cstr = 'BBL DIFFUSU '
+       CASE( jk_spp_ahvbbl )
+         cstr = 'BBL DIFFUSV '
+       CASE( jk_spp_ahm1 )
+         cstr = 'DYNLDF AHM1 '
+       CASE( jk_spp_ahm2 )
+         cstr = 'DYNLDF AHM2 '
+       CASE( jk_spp_ahm3 )
+         cstr = 'DYNLDF AHM3 '
+       CASE( jk_spp_ahm4 )
+         cstr = 'DYNLDF AHM4 '
+       CASE DEFAULT
+         CALL ctl_stop('Unrecognized SPP parameter: add it or turn off diagnostics')
+     END SELECT
+     IF ( rn_mmax(jp) .GT. 0._wp ) &
+     WRITE(numrep,'(A,A,A,D10.3)') ' Maximum of absolute values for parameter ', trim(cstr), ' = ', rn_mmax(jp)
+   ENDDO
+
+   IF(sppt_step .eq. 2 ) THEN
+        zmul = rdt
+      ELSEIF (sppt_step .eq. 0 .or. sppt_step .eq. 1 ) THEN
+        zmul = 1._wp
+   ENDIF
+   rn_mmax(jk_sppt_tem:jk_sppt_vvl) = rn_mmax(jk_sppt_tem:jk_sppt_vvl) * zmul
+
+   WRITE(numrep,'(A)')
+   WRITE(numrep,'(A)') ' SPPT part'
+   WRITE(numrep,'(A,D10.3)') ' Maximum of absolute values for TEM  ', rn_mmax(jk_sppt_tem)
+   IF( rn_mmax(jk_sppt_tem) > 0.5 ) WRITE(numrep,'(A)' ) 'Larger than 0.5, might be too big  '
+   WRITE(numrep,'(A,D10.3)') ' Maximum of absolute values for SAL  ', rn_mmax(jk_sppt_sal)
+   IF( rn_mmax(jk_sppt_sal) > 0.2 ) WRITE(numrep,'(A)' ) 'Larger than 0.2, might be too big  '
+   WRITE(numrep,'(A,D10.3)') ' Maximum of absolute values for U-VEL', rn_mmax(jk_sppt_uvl)
+   IF( rn_mmax(jk_sppt_uvl) > 0.1 ) WRITE(numrep,'(A)' ) 'Larger than 0.1, might be too big  '
+   WRITE(numrep,'(A,D10.3)') ' Maximum of absolute values for V-VEL', rn_mmax(jk_sppt_vvl)
+   IF( rn_mmax(jk_sppt_vvl) > 0.1 ) WRITE(numrep,'(A)' ) 'Larger than 0.1, might be too big  '
+
+   WRITE(numrep,'(A)')
+   WRITE(numrep,'(A)') ' SKEB part'
+   WRITE(numrep,'(A,A,A,D10.3)') ' Maximum of absolute values for NUM  ', trim(cstr), ' = ', rn_mmax(jk_skeb_dnum)
+   WRITE(numrep,'(A)'          ) ' (Perturbation from numerical dissipation)'
+   IF( rn_mmax(jk_skeb_dnum) < 0.5e-4 ) WRITE(numrep,'(A)' ) ' Smaller than 0.5e-4, might be too small'
+   IF( rn_mmax(jk_skeb_dnum) > 0.2e-2 ) WRITE(numrep,'(A)' ) ' Larger  than 0.2e-2, might be too big  '
+   WRITE(numrep,'(A)')
+   WRITE(numrep,'(A,A,A,D10.3)') ' Maximum of absolute values for CONV ', trim(cstr), ' = ', rn_mmax(jk_skeb_dcon)
+   WRITE(numrep,'(A)'          ) ' (Perturbation from convection dissipation)'
+   IF( rn_mmax(jk_skeb_dcon) < 0.5e-4 ) WRITE(numrep,'(A)' ) ' Smaller than 0.5e-4, might be too small'
+   IF( rn_mmax(jk_skeb_dcon) > 0.2e-2 ) WRITE(numrep,'(A)' ) ' Larger  than 0.2e-2, might be too big  '
+   WRITE(numrep,'(A)')
+   WRITE(numrep,'(A,A,A,D10.3)') ' Maximum of absolute values for TOTAL', trim(cstr), ' = ', rn_mmax(jk_skeb_tot)
+   WRITE(numrep,'(A)'          ) ' (Perturbation from total energy dissipation)'
+   IF( rn_mmax(jk_skeb_tot) < 0.5e-4 ) WRITE(numrep,'(A)' ) ' Smaller than 0.5e-4, might be too small'
+   IF( rn_mmax(jk_skeb_tot) > 0.2e-2 ) WRITE(numrep,'(A)' ) ' Larger  than 0.2e-2, might be too big  '
+
+   CLOSE(numrep)
+   CLOSE(numdiag)
+
+   END SUBROUTINE stopack_report
+
+   SUBROUTINE spp_aht ( kt, coeff,nn_type, rn_sd, kspp  )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE spp_aht ***
+      !!
+      !! ** Purpose :   Perturbing diffusivity parameters
+      !!                As spp_gen, but specifically designed for diffusivity
+      !!                where coeff can be 2D or 3D
+      !!----------------------------------------------------------------------
+   INTEGER, INTENT( in ) :: kt
+#if defined key_traldf_c3d
+   REAL(wp), INTENT( inout ), DIMENSION(jpi,jpj,jpk) :: coeff
+#elif defined key_traldf_c2d
+   REAL(wp), INTENT( inout ), DIMENSION(jpi,jpj) :: coeff
+#elif defined key_traldf_c1d
+   REAL(wp), INTENT( inout ), DIMENSION(jpk) :: coeff
+#else
+   REAL(wp), INTENT( inout ) :: coeff
+#endif
+   INTEGER, INTENT( in ) ::  kspp
+   INTEGER, INTENT( in ) ::  nn_type
+   REAL(wp), INTENT( in ) :: rn_sd
+   REAL(wp), POINTER, DIMENSION(:,:) ::   gauss
+   REAL(wp) :: zsd,xme
+   INTEGER :: jk
+
+#if defined key_traldf_c3d || key_traldf_c2d
+
+   CALL wrk_alloc(jpi,jpj,gauss)
+
+   IF( ln_spp_own_gauss ) THEN
+      gauss = gauss_n_2d_p
+   ELSE
+      gauss = rn_spp_stdev * gauss_n_2d / rn_sppt_stdev
+   ENDIF
+
+   IF( nn_type == 1 ) THEN
+       gauss = gauss * rn_sd
+#if defined key_traldf_c3d
+       DO jk=1,jpk
+         coeff(:,:,jk) = coeff(:,:,jk) * ( 1._wp + gauss )
+       ENDDO
+#elif defined key_traldf_c2d
+       coeff = coeff * ( 1._wp + gauss )
+#endif
+   ELSEIF ( nn_type == 2 ) THEN
+       zsd = rn_sd
+       xme = -0.5_wp*zsd*zsd
+       gauss = gauss * zsd + xme
+#if defined key_traldf_c3d
+       DO jk=1,jpk
+         coeff(:,:,jk) = exp(gauss) * coeff(:,:,jk)
+       ENDDOF
+#elif defined key_traldf_c2d
+       coeff = exp(gauss) * coeff
+#endif
+   ELSEIF ( nn_type == 3 ) THEN
+       zsd = rn_sd
+       xme = 0._wp
+       gauss = gauss * zsd + xme
+#if defined key_traldf_c3d
+       DO jk=1,jpk
+         coeff(:,:,jk) = exp(gauss) * coeff(:,:,jk)
+       ENDDOF
+#elif defined key_traldf_c2d
+       coeff = exp(gauss) * coeff
+#endif
+   ELSE
+       CALL ctl_stop( 'spp aht wrong option')
+   ENDIF
+
+   IF( ln_stopack_diags ) THEN
+     CALL spp_stats(kt,kspp,0,coeff)
+   ENDIF
+
+#else
+   CALL ctl_stop('key_traldf_c1d is not a valid key for STO')
+
+#endif
+
+   CALL wrk_dealloc(jpi,jpj,gauss)
+
+   END SUBROUTINE
+
+   SUBROUTINE spp_ahm ( kt, coeff,nn_type, rn_sd, kspp  )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE spp_ahm ***
+      !!
+      !! ** Purpose :   Perturbing viscosity parameters
+      !!                As spp_gen, but specifically designed for viscosity
+      !!                where coeff can be 2D or 3D
+      !!----------------------------------------------------------------------
+   INTEGER, INTENT( in ) :: kt
+#if defined key_dynldf_c3d
+   REAL(wp), INTENT( inout ), DIMENSION(jpi,jpj,jpk) :: coeff
+#elif defined key_dynldf_c2d
+   REAL(wp), INTENT( inout ), DIMENSION(jpi,jpj) :: coeff
+#elif defined key_dynldf_c1d
+   REAL(wp), INTENT( inout ), DIMENSION(jpk) :: coeff
+#else
+   REAL(wp), INTENT( inout ) :: coeff
+#endif
+   INTEGER, INTENT( in ) ::  kspp
+   INTEGER, INTENT( in ) ::  nn_type
+   REAL(wp), INTENT( in ) :: rn_sd
+   REAL(wp), POINTER, DIMENSION(:,:) ::   gauss
+   REAL(wp) :: zsd,xme
+   INTEGER :: jk
+
+#if defined key_dynldf_c3d || key_dynldf_c2d
+
+   CALL wrk_alloc(jpi,jpj,gauss)
+
+   IF( ln_spp_own_gauss ) THEN
+      gauss = gauss_n_2d_p
+   ELSE
+      gauss = rn_spp_stdev * gauss_n_2d / rn_sppt_stdev
+   ENDIF
+
+   IF( nn_type == 1 ) THEN
+       gauss = gauss * rn_sd
+#if defined key_dynldf_c3d
+       DO jk=1,jpk
+         coeff(:,:,jk) = coeff(:,:,jk) * ( 1._wp + gauss )
+       ENDDO
+#elif defined key_dynldf_c2d
+       coeff = coeff * ( 1._wp + gauss )
+#endif
+   ELSEIF ( nn_type == 2 ) THEN
+       zsd = rn_sd
+       xme = -0.5_wp*zsd*zsd
+       gauss = gauss * zsd + xme
+#if defined key_dynldf_c3d
+       DO jk=1,jpk
+         coeff(:,:,jk) = exp(gauss) * coeff(:,:,jk)
+       ENDDO
+#elif defined key_dynldf_c2d
+       coeff = exp(gauss) * coeff
+#endif
+   ELSEIF ( nn_type == 3 ) THEN
+       zsd = rn_sd
+       xme = 0._wp
+       gauss = gauss * zsd + xme
+#if defined key_dynldf_c3d
+       DO jk=1,jpk
+         coeff(:,:,jk) = exp(gauss) * coeff(:,:,jk)
+       ENDDO
+#elif defined key_dynldf_c2d
+       coeff = exp(gauss) * coeff
+#endif
+   ELSE
+       CALL ctl_stop( 'spp ahm wrong option')
+   ENDIF
+
+   IF( ln_stopack_diags ) THEN
+     CALL spp_stats(kt,kspp,0,coeff)
+   ENDIF
+
+   CALL wrk_dealloc(jpi,jpj,gauss)
+
+#else
+   CALL ctl_stop('key_traldf_c1d is not a valid key for STO')
+#endif
+
+   END SUBROUTINE
+
+   SUBROUTINE tra_sppt_apply ( kt , ks)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_sppt_apply ***
+      !!
+      !! ** Purpose :   Apply perturbation to tracers
+      !! 		Step 0/1 for tendencies, step 2 for variables
+      !! 		after timestepping
+      !!----------------------------------------------------------------------
+
+      INTEGER, INTENT( in ) :: kt, ks     ! Main time step counter
+      REAL(wp) :: mi,ma
+
+      IF( ks .NE. sppt_step ) RETURN
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' Applying sppt on tracers at timestep ', kt
+         WRITE(numout,*)
+      ENDIF
+
+      ! Modify the tendencies
+      IF(sppt_step .eq. 2 ) THEN
+        ! At the end of the timestepping, after array swapping
+        tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) + gauss_n * spptt * rdt
+        tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) + gauss_n * sppts * rdt
+        tsb(:,:,:,jp_tem) = tsb(:,:,:,jp_tem) + gauss_n * spptt * rdt
+        tsb(:,:,:,jp_sal) = tsb(:,:,:,jp_sal) + gauss_n * sppts * rdt
+        IF( ln_sppt_glocon ) CALL sppt_glocon( tsn(:,:,:,jp_tem), 'T' )
+        IF( ln_sppt_glocon ) CALL sppt_glocon( tsn(:,:,:,jp_sal), 'T' )
+        IF( ln_sppt_glocon ) CALL sppt_glocon( tsb(:,:,:,jp_tem), 'T' )
+        IF( ln_sppt_glocon ) CALL sppt_glocon( tsb(:,:,:,jp_sal), 'T' )
+        CALL lbc_lnk( tsb(:,:,:,jp_tem) , 'T', 1._wp)
+        CALL lbc_lnk( tsb(:,:,:,jp_sal) , 'T', 1._wp)
+        CALL lbc_lnk( tsn(:,:,:,jp_tem) , 'T', 1._wp)
+        CALL lbc_lnk( tsn(:,:,:,jp_sal) , 'T', 1._wp)
+      ELSEIF (sppt_step .eq. 0 .or. sppt_step .eq. 1 ) THEN
+        ! At the beginning / before vertical diffusion
+        tsa(:,:,:,jp_tem) = tsa(:,:,:,jp_tem) + gauss_n * spptt
+        tsa(:,:,:,jp_sal) = tsa(:,:,:,jp_sal) + gauss_n * sppts
+        IF( ln_sppt_glocon ) CALL sppt_glocon( tsa(:,:,:,jp_tem), 'T' )
+        IF( ln_sppt_glocon ) CALL sppt_glocon( tsa(:,:,:,jp_sal), 'T' )
+        CALL lbc_lnk( tsa(:,:,:,jp_tem) , 'T', 1._wp)
+        CALL lbc_lnk( tsa(:,:,:,jp_sal) , 'T', 1._wp)
+      ENDIF
+
+      IF( ln_stopack_diags ) THEN
+        mi = MINVAL(spptt)
+        ma = MAXVAL(spptt)
+        IF(lk_mpp) CALL mpp_min(mi)
+        IF(lk_mpp) CALL mpp_max(ma)
+        IF(lwp) WRITE(numdiag,9301) lkt,'SPPT TEMPERATURE' ,mi,ma
+        rn_mmax ( jk_sppt_tem ) =  MAX ( MAX( abs(mi), ma), rn_mmax ( jk_sppt_tem ) )
+
+        mi = MINVAL(sppts)
+        ma = MAXVAL(sppts)
+        IF(lk_mpp) CALL mpp_min(mi)
+        IF(lk_mpp) CALL mpp_max(ma)
+        IF(lwp) WRITE(numdiag,9301) lkt,'SPPT SALINITY   ' ,mi,ma
+9301  FORMAT(' it :', i8, ' ', A16, ' Min: ',d10.3 , ' Max: ',d10.3)
+        rn_mmax ( jk_sppt_sal ) =  MAX ( MAX( abs(mi), ma), rn_mmax ( jk_sppt_sal ) )
+      ENDIF
+      ! Reset the tendencies
+      spptt = 0._wp  ; sppts = 0._wp
+
+   END SUBROUTINE tra_sppt_apply
+
+   SUBROUTINE dyn_sppt_apply ( kt , ks)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_sppt_apply ***
+      !!
+      !! ** Purpose :   Apply perturbation to momentum
+      !! 		Step 0/1 for tendencies, step 2 for variables
+      !! 		after timestepping
+      !!----------------------------------------------------------------------
+
+      INTEGER, INTENT( in ) :: kt, ks     ! Main time step counter
+      REAL(wp) :: mi,ma
+
+      IF( ks .NE. sppt_step ) RETURN
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' Applying sppt on currents at timestep ', kt
+         WRITE(numout,*)
+      ENDIF
+
+      ! Modify the tendencies
+      IF(sppt_step .eq. 2 ) THEN
+        ! At the end of the timestepping, after array swapping
+        un(:,:,:) = un(:,:,:) + gauss_nu* spptu * rdt
+        vn(:,:,:) = vn(:,:,:) + gauss_nv* spptv * rdt
+        ub(:,:,:) = ub(:,:,:) + gauss_nu* spptu * rdt
+        vb(:,:,:) = vb(:,:,:) + gauss_nv* spptv * rdt
+        IF( ln_sppt_glocon ) CALL sppt_glocon( ub, 'U' )
+        IF( ln_sppt_glocon ) CALL sppt_glocon( vb, 'V' )
+        IF( ln_sppt_glocon ) CALL sppt_glocon( un, 'U' )
+        IF( ln_sppt_glocon ) CALL sppt_glocon( vn, 'V' )
+        CALL lbc_lnk( un , 'U', -1._wp)
+        CALL lbc_lnk( vn , 'V', -1._wp)
+        CALL lbc_lnk( ub , 'U', -1._wp)
+        CALL lbc_lnk( vb , 'V', -1._wp)
+      ELSEIF (sppt_step .eq. 0 .or. sppt_step .eq. 1 ) THEN
+        ! At the beginning / before vertical diffusion
+        ua(:,:,:) = ua(:,:,:) + gauss_nu* spptu
+        va(:,:,:) = va(:,:,:) + gauss_nv* spptv
+        IF( ln_sppt_glocon ) CALL sppt_glocon( ua, 'U' )
+        IF( ln_sppt_glocon ) CALL sppt_glocon( va, 'V' )
+        CALL lbc_lnk( ua , 'U', -1._wp)
+        CALL lbc_lnk( va , 'V', -1._wp)
+      ENDIF
+
+      IF( ln_stopack_diags ) THEN
+        mi = MINVAL(spptu)
+        ma = MAXVAL(spptu)
+        IF(lk_mpp) CALL mpp_min(mi)
+        IF(lk_mpp) CALL mpp_max(ma)
+        IF(lwp) WRITE(numdiag,9301) lkt,'SPPT ZONAL CURR.' ,mi,ma
+        rn_mmax ( jk_sppt_uvl ) =  MAX ( MAX( abs(mi), ma), rn_mmax ( jk_sppt_uvl ) )
+
+        mi = MINVAL(spptv)
+        ma = MAXVAL(spptv)
+        IF(lk_mpp) CALL mpp_min(mi)
+        IF(lk_mpp) CALL mpp_max(ma)
+        IF(lwp) WRITE(numdiag,9301) lkt,'SPPT MERID CURR.' ,mi,ma
+9301  FORMAT(' it :', i8, ' ', A16, ' Min: ',d10.3 , ' Max: ',d10.3)
+        rn_mmax ( jk_sppt_vvl ) =  MAX ( MAX( abs(mi), ma), rn_mmax ( jk_sppt_vvl ) )
+      ENDIF
+
+      ! Reset the tendencies
+      spptu = 0._wp  ; spptv = 0._wp
+
+   END SUBROUTINE dyn_sppt_apply
+
+   SUBROUTINE sppt_glocon ( zts, cd_type )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sppt_glocon ***
+      !!
+      !! ** Purpose :   Apply global conservation constraint
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(INOUT) :: zts(jpi,jpj,jpk)
+      CHARACTER(len=1), INTENT(IN) :: cd_type
+      INTEGER :: ji,jj,jk
+      REAL(wp) :: zv, vl
+      ! Calculate volume tendencies and renormalize
+      ! Note: sshn should be staggered before being used.
+      SELECT CASE ( cd_type )
+               CASE ( 'T' )
+                jk=1
+                zv = SUM( tmask_i(:,:)*tmask(:,:,jk)*e1t(:,:)*e2t(:,:)*sshn(:,:)*zts(:,:,1) )
+                vl = SUM( tmask_i(:,:)*tmask(:,:,jk)*e1t(:,:)*e2t(:,:)*sshn(:,:) )
+                DO jk = 1, jpkm1
+                   DO jj=1,jpj
+                      DO ji=1,jpi
+                        zv = zv + SUM( tmask_i(:,:)*tmask(:,:,jk)*e1t(:,:)*e2t(:,:)*fse3t(:,:,jk)*zts(:,:,jk) )
+                        vl = vl + SUM( tmask_i(:,:)*tmask(:,:,jk)*e1t(:,:)*e2t(:,:)*fse3t(:,:,jk) )
+                      END DO
+                   END DO
+                END DO
+                IF(lk_mpp) CALL mpp_sum(zv)
+                IF(lk_mpp) CALL mpp_sum(vl)
+                zv = zv / vl
+                zts = zts - zv*tmask
+               CASE ( 'U' )
+                jk=1
+#if defined NEMO_V34
+                zv = SUM( umask(:,:,jk)*e1u(:,:)*e2u(:,:)*sshn(:,:)*zts(:,:,1) )
+                vl = SUM( umask(:,:,jk)*e1u(:,:)*e2u(:,:)*sshn(:,:) )
+#else
+                zv = SUM( umask_i(:,:)*umask(:,:,jk)*e1u(:,:)*e2u(:,:)*sshn(:,:)*zts(:,:,1) )
+                vl = SUM( umask_i(:,:)*umask(:,:,jk)*e1u(:,:)*e2u(:,:)*sshn(:,:) )
+#endif
+                DO jk = 1, jpkm1
+                   DO jj=1,jpj
+                      DO ji=1,jpi
+#if defined NEMO_V34
+                        zv = zv + SUM( umask(:,:,jk)*e1u(:,:)*e2u(:,:)*fse3u(:,:,jk)*zts(:,:,jk) )
+                        vl = vl + SUM( umask(:,:,jk)*e1u(:,:)*e2u(:,:)*fse3u(:,:,jk) )
+#else
+                        zv = zv + SUM( umask_i(:,:)*umask(:,:,jk)*e1u(:,:)*e2u(:,:)*fse3u(:,:,jk)*zts(:,:,jk) )
+                        vl = vl + SUM( umask_i(:,:)*umask(:,:,jk)*e1u(:,:)*e2u(:,:)*fse3u(:,:,jk) )
+#endif
+                      END DO
+                   END DO
+                END DO
+                IF(lk_mpp) CALL mpp_sum(zv)
+                IF(lk_mpp) CALL mpp_sum(vl)
+                zv = zv / vl
+                zts = zts - zv*umask
+               CASE ( 'V' )
+                jk=1
+#if defined NEMO_V34
+                zv = SUM( vmask(:,:,jk)*e1v(:,:)*e2v(:,:)*sshn(:,:)*zts(:,:,1) )
+                vl = SUM( vmask(:,:,jk)*e1v(:,:)*e2v(:,:)*sshn(:,:) )
+#else
+                zv = SUM( vmask_i(:,:)*vmask(:,:,jk)*e1v(:,:)*e2v(:,:)*sshn(:,:)*zts(:,:,1) )
+                vl = SUM( vmask_i(:,:)*vmask(:,:,jk)*e1v(:,:)*e2v(:,:)*sshn(:,:) )
+#endif
+                DO jk = 1, jpkm1
+                   DO jj=1,jpj
+                      DO ji=1,jpi
+#if defined NEMO_V34
+                        zv = zv + SUM( vmask(:,:,jk)*e1v(:,:)*e2v(:,:)*fse3v(:,:,jk)*zts(:,:,jk) )
+                        vl = vl + SUM( vmask(:,:,jk)*e1v(:,:)*e2v(:,:)*fse3v(:,:,jk) )
+#else
+                        zv = zv + SUM( vmask_i(:,:)*vmask(:,:,jk)*e1v(:,:)*e2v(:,:)*fse3v(:,:,jk)*zts(:,:,jk) )
+                        vl = vl + SUM( vmask_i(:,:)*vmask(:,:,jk)*e1v(:,:)*e2v(:,:)*fse3v(:,:,jk) )
+#endif
+                      END DO
+                   END DO
+                END DO
+                IF(lk_mpp) CALL mpp_sum(zv)
+                IF(lk_mpp) CALL mpp_sum(vl)
+                zv = zv / vl
+                zts = zts - zv*vmask
+              ENDSELECT
+
+   END SUBROUTINE sppt_glocon
+
+   SUBROUTINE gaussian_ar1_field ( gn, nk, wei, gb, a, b,gn0, fltf, istep)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE gaussian_ar1_field ***
+      !!
+      !! ** Purpose :   Generate correlated perturbation field
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: a, b
+      REAL(wp), DIMENSION(jpk)    , INTENT(INOUT) :: wei
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(INOUT) :: gb
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(INOUT) :: gn
+      REAL(wp), DIMENSION(jpi,jpj    ), INTENT(OUT) :: gn0
+      INTEGER, INTENT(IN) :: nk,istep
+      REAL(wp), INTENT(IN) :: fltf
+      REAL(wp) :: g2d(jpi,jpj)
+      INTEGER :: jf, jk, ji, jj, nbl
+
+      ! Random noise on 2d field
+      IF ( istep == 1 ) THEN
+         CALL sppt_rand2d( g2d )
+         CALL lbc_lnk( g2d , 'T', 1._wp)
+         g2d_save = g2d
+         IF( nn_sppt_step_bound .EQ. 1 ) THEN
+           WHERE ( g2d < -ABS(rn_sppt_bound) ) g2d = -ABS(rn_sppt_bound)
+           WHERE ( g2d >  ABS(rn_sppt_bound) ) g2d =  ABS(rn_sppt_bound)
+         ENDIF
+      ELSEIF ( istep == 2 ) THEN
+         g2d = rn_spp_stdev * g2d_save / rn_sppt_stdev
+      ELSEIF ( istep == 3 ) THEN
+         g2d = rn_skeb_stdev * g2d_save / rn_sppt_stdev
+      ENDIF
+
+      ! Laplacian filter and re-normalization
+      DO jf = 1, nk
+         CALL sppt_flt( g2d )
+      END DO
+      g2d = g2d * fltf
+
+#ifdef key_iommput
+      ! Output the random field
+      IF(istep==1) THEN
+        CALL iom_put( "sppt_ran" , g2d )
+      ELSEIF (istep==2) THEN
+        CALL iom_put( "spp_ran" , g2d )
+      ELSEIF (istep==3) THEN
+        CALL iom_put( "skeb_ran" , g2d )
+      ENDIF
+#endif
+
+      ! AR(1) process and array swap
+      g2d = a*gb + b*g2d
+      gb = g2d
+      gn0 = g2d * zdc(:,:,1)
+
+      IF (istep==2 .or. istep==3) RETURN
+
+      ! From 2- to 3-d and vertical weigth
+      IF(nn_vwei .eq. 2) THEN
+       DO jj=1,jpj
+        DO ji=1,jpi
+         nbl = mbathy(ji,jj)
+         wei(:) = 0._wp
+         IF(nbl>0) THEN
+           wei(1:nbl) = 1._wp
+           wei(1) = 0._wp
+           wei(2) = 0.5_wp
+           wei(nbl-1) = 0.5_wp
+           wei(nbl) = 0._wp
+           DO jk=1,jpk
+             gn(ji,jj,jk) = g2d(ji,jj) * wei(jk) * zdc(ji,jj,jk)
+           ENDDO
+         ENDIF
+        ENDDO
+       ENDDO
+      ELSEIF(nn_vwei .eq. 3) THEN
+       DO jj=1,jpj
+        DO ji=1,jpi
+         nbl = mbathy(ji,jj)
+         wei(:) = 0._wp
+         IF(nbl>0) THEN
+           wei(1:nbl) = 1._wp
+           wei(nbl-1) = 0.5_wp
+           wei(nbl) = 0._wp
+           DO jk=1,jpk
+             gn(ji,jj,jk) = g2d(ji,jj) * wei(jk) * zdc(ji,jj,jk)
+           ENDDO
+         ENDIF
+        ENDDO
+       ENDDO
+       ELSE
+        DO jk=1,jpk
+          gn(:,:,jk) = g2d * wei(jk) * zdc(:,:,jk)
+        ENDDO
+      ENDIF
+
+      ! Bound
+      IF( nn_sppt_step_bound .EQ. 2 ) THEN
+        WHERE ( gn < -ABS(rn_sppt_bound) ) gn = -ABS(rn_sppt_bound)
+        WHERE ( gn >  ABS(rn_sppt_bound) ) gn =  ABS(rn_sppt_bound)
+        WHERE ( gn0< -ABS(rn_sppt_bound) ) gn0= -ABS(rn_sppt_bound)
+        WHERE ( gn0>  ABS(rn_sppt_bound) ) gn0=  ABS(rn_sppt_bound)
+      ENDIF
+
+   END SUBROUTINE gaussian_ar1_field
+   !
+   SUBROUTINE stopack_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE stopack_init ***
+      !!
+      !! ** Purpose :   Initialize stopack
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER  :: ios, inum
+      INTEGER  :: nn_sppt_tra, nn_sppt_dyn, nn_spp_aht, nn_sppt_ice
+      INTEGER  :: ivals(8)
+      INTEGER(KIND=8)     ::   ziseed(4)           ! RNG seeds in integer type
+      REAL(KIND=8)        ::   zrseed(4)           ! RNG seeds in real type
+      REAL(KIND=8)        ::   rdt_sppt
+      !!
+      NAMELIST/namstopack/ ln_stopack, ln_sppt_taumap, rn_sppt_tau, &
+      ln_stopack_restart, sppt_filter_pass, rn_sppt_bound, sppt_step, nn_deftau,rn_sppt_stdev,&
+      ln_distcoast, rn_distcoast, nn_vwei, nn_stopack_seed, nn_sppt_step_bound, nn_rndm_freq, &
+      ln_sppt_glocon, ln_stopack_repr, &
+      rn_icestr_sd, rn_icealb_sd, &
+      ln_sppt_traxad, ln_sppt_trayad, ln_sppt_trazad, ln_sppt_trasad, ln_sppt_traldf, &
+      ln_sppt_trazdf, ln_sppt_trazdfp,ln_sppt_traevd, ln_sppt_trabbc, ln_sppt_trabbl, &
+      ln_sppt_tranpc, ln_sppt_tradmp, ln_sppt_traqsr, ln_sppt_transr, ln_sppt_traatf ,&
+      ln_sppt_dynhpg, ln_sppt_dynspg, ln_sppt_dynkeg, ln_sppt_dynrvo, ln_sppt_dynpvo, &
+      ln_sppt_dynzad, ln_sppt_dynldf, ln_sppt_dynzdf, ln_sppt_dynbfr, ln_sppt_dynatf, ln_sppt_dyntau,&
+      ln_sppt_icehdf, ln_sppt_icelat, ln_sppt_icezdf, & !ln_sppt_icealb, ln_sppt_icestr
+      nn_spp_icealb, nn_spp_icestr,&
+      spp_filter_pass,rn_spp_stdev,rn_spp_tau,&
+      nn_spp_bfr,nn_spp_dqdt,nn_spp_dedt,nn_spp_avt,nn_spp_avm,nn_spp_qsi0,nn_spp_ahtu,nn_spp_ahtv,nn_spp_ahm1,nn_spp_ahm2,&
+      nn_spp_ahtw,nn_spp_ahtt,nn_spp_relw,nn_spp_arnf,nn_spp_geot,nn_spp_aevd,nn_spp_ahubbl,nn_spp_ahvbbl,&
+      nn_spp_tkelc,nn_spp_tkedf,nn_spp_tkeds,nn_spp_tkebb,nn_spp_tkefr,&
+      rn_bfr_sd,rn_dqdt_sd,rn_dedt_sd,rn_avt_sd,rn_avm_sd,rn_qsi0_sd,rn_ahtu_sd,rn_ahtv_sd,rn_ahm1_sd,rn_ahm2_sd,&
+      rn_ahtw_sd,rn_ahtt_sd, rn_relw_sd, rn_arnf_sd,rn_geot_sd, rn_aevd_sd,rn_ahubbl_sd,rn_ahvbbl_sd,&
+      rn_tkelc_sd,rn_tkedf_sd,rn_tkeds_sd,rn_tkebb_sd,rn_tkefr_sd,&
+      ln_skeb,rn_skeb,nn_dcom_freq,rn_kh,rn_kc,ln_stopack_diags,skeb_filter_pass,rn_skeb_stdev,rn_skeb_tau,&
+      nn_dconv,rn_beta_num, rn_beta_con
+
+      ! Default values
+      rn_sppt_bound = 3._wp
+      ln_stopack = .false.
+      ln_sppt_taumap = .false.
+      rn_sppt_tau =  86400._wp * 5._wp
+      sppt_filter_pass = 30
+      nn_vwei = 0
+      ln_distcoast = .false.
+      ln_sppt_glocon = .false.
+      rn_distcoast = 10._wp
+      ln_stopack_restart = .true.
+      nn_stopack_seed = (/1,2,3,narea/)
+      nn_rndm_freq = 1
+      nn_sppt_step_bound = 2
+      nn_deftau = 1
+      ln_sppt_traxad       = .false.  ! Switch for x advection
+      ln_sppt_trayad       = .false.  ! Switch for y advection
+      ln_sppt_trazad       = .false.  ! Switch for z advection
+      ln_sppt_trasad       = .false.  ! Switch for z advection  (s- case)
+      ln_sppt_traldf       = .false.  ! Switch for lateral diffusion
+      ln_sppt_trazdf       = .false.  ! Switch for vertical diffusion
+      ln_sppt_trazdfp      = .false.  ! Switch for pure vertical diffusion
+      ln_sppt_traevd       = .false.  ! Switch for enhanced vertical diffusion
+      ln_sppt_trabbc       = .false.  ! Switch for bottom boundary condition
+      ln_sppt_trabbl       = .false.  ! Switch for bottom boundary layer
+      ln_sppt_tranpc       = .false.  ! Switch for non-penetrative convection
+      ln_sppt_tradmp       = .false.  ! Switch for tracer damping
+      ln_sppt_traqsr       = .false.  ! Switch for solar radiation
+      ln_sppt_transr       = .false.  ! Switch for non-solar radiation / freshwater flux
+      ln_sppt_traatf       = .false.  ! Switch for Asselin time-filter
+
+      ln_sppt_dynhpg       = .false.  ! Switch for hydrost. press. grad.
+      ln_sppt_dynspg       = .false.  ! Switch for surface  press. grad.
+      ln_sppt_dynkeg       = .false.  ! Switch for horiz. advcetion
+      ln_sppt_dynrvo       = .false.  ! Switch for Relative vorticity
+      ln_sppt_dynpvo       = .false.  ! Switch for planetary vortic.
+      ln_sppt_dynzad       = .false.  ! Switch for vertical advection
+      ln_sppt_dynldf       = .false.  ! Switch for lateral viscosity
+      ln_sppt_dynzdf       = .false.  ! Switch for vertical viscosity
+      ln_sppt_dynbfr       = .false.  ! Switch for bottom friction
+      ln_sppt_dynatf       = .false.  ! Switch for Asselin filter
+      ln_sppt_dyntau       = .false.  ! Switch for wind stress
+
+      ln_sppt_icehdf  = .false.
+      ln_sppt_icelat  = .false.
+      ln_sppt_icezdf  = .false.
+
+      nn_spp_icestr  = 0
+      nn_spp_icealb  = 0
+      rn_icestr_sd = 0.30_wp
+      rn_icealb_sd = 0.30_wp
+
+      nn_spp_bfr  =0
+      nn_spp_dqdt =0
+      nn_spp_arnf =0
+      nn_spp_aevd =0
+      nn_spp_geot =0
+      nn_spp_dedt =0
+      nn_spp_avt  =0
+      nn_spp_avm  =0
+      nn_spp_qsi0 =0
+      nn_spp_relw =0
+      nn_spp_tkelc =0
+      nn_spp_tkedf =0
+      nn_spp_tkeds =0
+      nn_spp_tkebb =0
+      nn_spp_tkefr =0
+
+      ln_skeb = .false.
+      ln_stopack_diags = .false.
+      rn_skeb_stdev = 1.0_wp
+      skeb_filter_pass = 50
+      rn_skeb_tau      = 50
+
+#ifdef NEMO_V34
+      REWIND( numnam )
+      READ  ( numnam, namstopack )
+#else
+      REWIND( numnam_ref )
+      READ  ( numnam_ref, namstopack, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namstopack in reference namelist', lwp )
+
+      REWIND( numnam_cfg )
+      READ  ( numnam_cfg, namstopack, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namstopack in configuration namelist', lwp )
+      IF(lwm .AND. nprint > 2) WRITE ( numond, namstopack )     
+#endif
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'init_stopack : Stochastic physics package'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namstopack: '
+         WRITE(numout,*)
+         WRITE(numout,*) '       Switch on STOPACK                                     ln_stopack : ',ln_stopack
+         WRITE(numout,*) '       Verbose diagnostics for STOPACK                  ln_stopack_diags:', ln_stopack_diags
+         WRITE(numout,*)
+         WRITE(numout,*) '  ***  Random generation'
+         WRITE(numout,*) '       Read from restart file previous perturbation  ln_stopack_restart :', ln_stopack_restart
+         WRITE(numout,*) '       Frequency of calls of the SPPT perturbation field   nn_rndm_freq :', nn_rndm_freq
+         WRITE(numout,*) '       Reproducibility of random generation             ln_stopack_repr :', ln_stopack_repr
+         WRITE(numout,*) '       Seed for random number generator (no restart)    nn_stopack_seed :', nn_stopack_seed(:)
+         WRITE(numout,*)
+         WRITE(numout,*) '  ***  SPPT scheme '
+         WRITE(numout,*) '       SPPT step (0: beginning; 1: before ZVD; 2: after ZVD)  sppt_step : ',sppt_step
+         WRITE(numout,*) '       Use map of decorr. time scale                     ln_sppt_taumap :', ln_sppt_taumap
+         WRITE(numout,*) '       If ln_sppt_taumap FALSE, use this constant (in days) rn_sppt_tau :', rn_sppt_tau
+         WRITE(numout,*) '       Number of filter passes to correlate in space   sppt_filter_pass :', sppt_filter_pass
+         WRITE(numout,*) '       Standard deviation of the white noise              rn_sppt_stdev :', rn_sppt_stdev
+         WRITE(numout,*) '       Apply global conservation constraints             ln_sppt_glocon :', ln_sppt_glocon
+         WRITE(numout,*)
+         WRITE(numout,*) '       Perturbation on tracers:'
+         WRITE(numout,*) '       Switch for x advection                            ln_sppt_traxad :', ln_sppt_traxad
+         WRITE(numout,*) '       Switch for y advection                            ln_sppt_trayad :', ln_sppt_trayad
+         WRITE(numout,*) '       Switch for z advection                            ln_sppt_trazad :', ln_sppt_trazad
+         WRITE(numout,*) '       Switch for z advection  (s- case)                 ln_sppt_trasad :', ln_sppt_trasad
+         WRITE(numout,*) '       Switch for lateral diffusion                      ln_sppt_traldf :', ln_sppt_traldf
+         WRITE(numout,*) '       Switch for vertical diffusion                     ln_sppt_trazdf :', ln_sppt_trazdf
+         WRITE(numout,*) '       Switch for pure vertical diffusion               ln_sppt_trazdfp :', ln_sppt_trazdfp
+         WRITE(numout,*) '       Switch for enhanced vertical diffusion            ln_sppt_traevd :', ln_sppt_traevd
+         WRITE(numout,*) '       Switch for bottom boundary condition              ln_sppt_trabbc :', ln_sppt_trabbc
+         WRITE(numout,*) '       Switch for bottom boundary layer                  ln_sppt_trabbl :', ln_sppt_trabbl
+         WRITE(numout,*) '       Switch for non-penetrative convection             ln_sppt_tranpc :', ln_sppt_tranpc
+         WRITE(numout,*) '       Switch for tracer damping                         ln_sppt_tradmp :', ln_sppt_tradmp
+         WRITE(numout,*) '       Switch for solar radiation                        ln_sppt_traqsr :', ln_sppt_traqsr
+         WRITE(numout,*) '       Switch for non-solar rad. / freshwater flx flux   ln_sppt_transr :', ln_sppt_transr
+         WRITE(numout,*) '       Switch for Asselin time-filter                    ln_sppt_traatf :', ln_sppt_traatf
+         WRITE(numout,*)
+         WRITE(numout,*) '       Perturbation on dynamics:'
+         WRITE(numout,*) '       Switch for horiz advection                        ln_sppt_dynkeg :', ln_sppt_dynkeg
+         WRITE(numout,*) '       Switch for z advection                            ln_sppt_dynzad :', ln_sppt_dynzad
+         WRITE(numout,*) '       Switch for wind stress                            ln_sppt_dyntau :', ln_sppt_dyntau
+         WRITE(numout,*) '       Switch for lateral diffusion                      ln_sppt_dynldf :', ln_sppt_dynldf
+         WRITE(numout,*) '       Switch for vertical diffusion                     ln_sppt_dynzdf :', ln_sppt_dynzdf
+         WRITE(numout,*) '       Switch for planet. vorticity                      ln_sppt_dynpvo :', ln_sppt_dynpvo
+         WRITE(numout,*) '       Switch for relative vorticity                     ln_sppt_dynrvo :', ln_sppt_dynrvo
+         WRITE(numout,*) '       Switch for hydrost. press. grad.                  ln_sppt_dynhpg :', ln_sppt_dynhpg
+         WRITE(numout,*) '       Switch for surface  press. grad.                  ln_sppt_dynspg :', ln_sppt_dynspg
+         WRITE(numout,*) '       Switch for bottom friction                        ln_sppt_dynbfr :', ln_sppt_dynbfr
+         WRITE(numout,*) '       Switch for Asselin time-filter                    ln_sppt_dynatf :', ln_sppt_dynatf
+         WRITE(numout,*)
+         WRITE(numout,*) '       Perturbation on sea-ice:'
+         WRITE(numout,*) '       Switch for sea-ice diffusivity                    ln_sppt_icehdf :', ln_sppt_icehdf
+         WRITE(numout,*) '       Switch for sea-ice lateral accretion              ln_sppt_icelat :', ln_sppt_icelat
+         WRITE(numout,*) '       Switch for sea-ice vertical thermodyn.            ln_sppt_icezdf :', ln_sppt_icezdf
+         WRITE(numout,*)
+         WRITE(numout,*) '       Bound for gaussian random numbers                  rn_sppt_bound :', rn_sppt_bound
+         WRITE(numout,*) '       Bound Step (0: nobound; 1: Gaussian; 2: Pert) nn_sppt_step_bound :', nn_sppt_step_bound
+         WRITE(numout,*) '       Definition of Tau (1: days; 2: timesteps)              nn_deftau :', nn_deftau
+         WRITE(numout,*) '       Smoothing of perturbation close to coast            ln_distcoast :', ln_distcoast
+         WRITE(numout,*) '       Spatial scale of the smoothing near coasts (m)      rn_distcoast :', rn_distcoast
+         WRITE(numout,*) '       Type of vertical weight:                                 nn_vwei :', nn_vwei
+         WRITE(numout,*) '                            0 : No weight '
+         WRITE(numout,*) '                            1 : First/Last level smoothing '
+         WRITE(numout,*) '                            2 : Top/Bottom smoothing'
+         WRITE(numout,*) '                            3 : Bottom smoothing'
+         WRITE(numout,*)
+         WRITE(numout,*) '  ***  SPP schemes (0: off ; 1: normal; 2:lognormal, mean as unpert.; 3: lognormal, median as unpert.'
+         WRITE(numout,*) '                   (the meaning of standard dev. depends on the distribution and parametr.)'
+         WRITE(numout,*)
+         WRITE(numout,*) '       Number of passes for spatial filter (AR1 field)     spp_filter_pass:', spp_filter_pass
+         WRITE(numout,*) '       Standard deviation of random generator (AR1 field)  rn_spp_stdev :', rn_spp_stdev
+         WRITE(numout,*) '       Decorr. time scale                     (AR1 field)  rn_spp_tau   :', rn_spp_tau
+         WRITE(numout,*)
+         WRITE(numout,*) '       SPP for bottom friction coeff                       nn_spp_bfr   :', nn_spp_bfr
+         WRITE(numout,*) '                                            STDEV          rn_bfr_sd    :', rn_bfr_sd
+         WRITE(numout,*) '       SPP for SST relaxation  coeff                       nn_spp_dqdt  :', nn_spp_dqdt
+         WRITE(numout,*) '                                            STDEV          rn_dqdt_sd   :', rn_dqdt_sd
+         WRITE(numout,*) '       SPP for SSS relaxation  coeff                       nn_spp_dedt  :', nn_spp_dedt
+         WRITE(numout,*) '                                            STDEV          rn_dedt_sd   :', rn_dedt_sd
+         WRITE(numout,*) '       SPP for vertical tra mixing coeff (only TKE, GLS)   nn_spp_avt   :', nn_spp_avt
+         WRITE(numout,*) '                                            STDEV          rn_avt_sd    :', rn_avt_sd
+         WRITE(numout,*) '       SPP for vertical dyn mixing coeff (only TKE, GLS)   nn_spp_avm   :', nn_spp_avm
+         WRITE(numout,*) '                                            STDEV          rn_avm_sd    :', rn_avm_sd
+         WRITE(numout,*) '       SPP for solar penetration scheme  (only RGB)        nn_spp_qsi0  :', nn_spp_qsi0
+         WRITE(numout,*) '                                            STDEV          rn_qsi0_sd   :', rn_qsi0_sd
+         WRITE(numout,*) '       SPP for horiz. diffusivity  U                       nn_spp_ahtu  :', nn_spp_ahtu
+         WRITE(numout,*) '                                            STDEV          rn_ahtu_sd   :', rn_ahtu_sd
+         WRITE(numout,*) '       SPP for horiz. diffusivity  V                       nn_spp_ahtv  :', nn_spp_ahtv
+         WRITE(numout,*) '                                            STDEV          rn_ahtv_sd   :', rn_ahtv_sd
+         WRITE(numout,*) '       SPP for horiz. diffusivity  W                       nn_spp_ahtw  :', nn_spp_ahtw
+         WRITE(numout,*) '                                            STDEV          rn_ahtw_sd   :', rn_ahtw_sd
+         WRITE(numout,*) '       SPP for horiz. diffusivity  T                       nn_spp_ahtt  :', nn_spp_ahtt
+         WRITE(numout,*) '                                            STDEV          rn_ahtt_sd   :', rn_ahtt_sd
+         WRITE(numout,*) '       SPP for horiz. viscosity (1/3)                      nn_spp_ahm1  :', nn_spp_ahm1
+         WRITE(numout,*) '                                            STDEV          rn_ahm1_sd   :', rn_ahm1_sd
+         WRITE(numout,*) '       SPP for horiz. viscosity (2/4)                      nn_spp_ahm2  :', nn_spp_ahm2
+         WRITE(numout,*) '                                            STDEV          rn_ahm2_sd   :', rn_ahm2_sd
+         WRITE(numout,*) '       SPP for relative wind factor                        nn_spp_relw  :', nn_spp_relw
+         WRITE(numout,*) '       (use 4, 5, 6 for nn_spp_relw to have options 1, 2, 3 with limits bounded to [0,1]'
+         WRITE(numout,*) '                                            STDEV          rn_relw_sd   :', rn_relw_sd
+         WRITE(numout,*) '       SPP for mixing close to river mouth                 nn_spp_arnf  :', nn_spp_arnf
+         WRITE(numout,*) '                                            STDEV          rn_arnf_sd   :', rn_arnf_sd
+         WRITE(numout,*) '       SPP for geothermal heating                          nn_spp_geot  :', nn_spp_geot
+         WRITE(numout,*) '                                            STDEV          rn_geot_sd   :', rn_geot_sd
+         WRITE(numout,*) '       SPP for enhanced vertical diffusion                 nn_spp_aevd  :', nn_spp_aevd
+         WRITE(numout,*) '                                            STDEV          rn_aevd_sd   :', rn_aevd_sd
+         WRITE(numout,*) '       SPP for TKE rn_lc    Langmuir cell coefficient      nn_spp_tkelc :', nn_spp_tkelc
+         WRITE(numout,*) '                                            STDEV          rn_tkelc_sd  :', rn_tkelc_sd
+         WRITE(numout,*) '       SPP for TKE rn_ediff Eddy diff. coefficient         nn_spp_tkedf :', nn_spp_tkedf
+         WRITE(numout,*) '                                            STDEV          rn_tkedf_sd  :', rn_tkedf_sd
+         WRITE(numout,*) '       SPP for TKE rn_ediss Kolmogoroff dissipation coeff. nn_spp_tkeds :', nn_spp_tkeds
+         WRITE(numout,*) '                                            STDEV          rn_tkeds_sd  :', rn_tkeds_sd
+         WRITE(numout,*) '       SPP for TKE rn_ebb   Surface input of tke           nn_spp_tkebb :', nn_spp_tkebb
+         WRITE(numout,*) '                                            STDEV          rn_tkebb_sd  :', rn_tkebb_sd
+         WRITE(numout,*) '       SPP for TKE rn_efr   Fraction of srf TKE below ML   nn_spp_tkefr :', nn_spp_tkefr
+         WRITE(numout,*) '                                            STDEV          rn_tkefr_sd  :', rn_tkefr_sd
+         WRITE(numout,*) '       SPP for BBL U  diffusivity                          nn_spp_ahubbl:', nn_spp_ahubbl
+         WRITE(numout,*) '                                            STDEV          rn_ahubbl_sd :', rn_ahubbl_sd
+         WRITE(numout,*) '       SPP for BBL V  diffusivity                          nn_spp_ahvbbl:', nn_spp_ahvbbl
+         WRITE(numout,*) '                                            STDEV          rn_ahvbbl_sd :', rn_ahvbbl_sd
+         WRITE(numout,*)
+         WRITE(numout,*) '  ***  SPP schemes for sea-ice '
+         WRITE(numout,*) '       Albedo                                              nn_spp_icealb:', nn_spp_icealb
+         WRITE(numout,*) '            St. dev. for ice albedo                        rn_icealb_sd :', rn_icealb_sd
+         WRITE(numout,*) '       Ice Strength                                        nn_spp_icestr:', nn_spp_icestr
+         WRITE(numout,*) '            St. dev. for ice strength                      rn_icestr_sd :', rn_icestr_sd
+         WRITE(numout,*)
+         WRITE(numout,*) ' SKEB Perturbation scheme '
+         WRITE(numout,*) '       SKEB switch                                         ln_skeb      :', ln_skeb
+         WRITE(numout,*) '       SKEB ratio of backscattered energy                  rn_skeb      :', rn_skeb
+         WRITE(numout,*) '       Frequency update for dissipation mask               nn_dcom_freq :', nn_dcom_freq
+         WRITE(numout,*) '       Numerical dissipation factor (resolut. dependent)   rn_kh        :', rn_kh
+         WRITE(numout,*) '       Number of passes for spatial filter (AR1 field)     skeb_filter_pass:', skeb_filter_pass
+         WRITE(numout,*) '       Standard deviation of random generator (AR1 field)  rn_skeb_stdev:', rn_skeb_stdev
+         WRITE(numout,*) '       Decorr. time scale                     (AR1 field)  rn_skeb_tau  :', rn_skeb_tau
+         WRITE(numout,*) '       Option of convection energy dissipation             nn_dconv     :', nn_dconv
+         WRITE(numout,*) '       Convection dissipation factor (resolut. dependent)  rn_kc        :', rn_kc
+         WRITE(numout,*) '       Multiplier for numerical dissipation                rn_beta_num  :', rn_beta_num
+         WRITE(numout,*) '       Multiplier for convection dissipation               rn_beta_con  :', rn_beta_con
+
+         WRITE(numout,*)
+         IF(lflush) CALL flush(numout)
+      ENDIF
+
+      IF( .NOT. ln_stopack ) THEN
+         IF(lwp) WRITE(numout,*) '     STOPACK is switched off'
+         IF(lflush) CALL flush(numout)
+         RETURN
+      ENDIF
+
+      IF( MOD( nitend - nit000 + 1, nn_rndm_freq) /= 0 .OR.   &
+          ( MOD( nstock, nn_rndm_freq) /= 0 .AND. nstock .GT. 0 ) ) THEN
+         WRITE(ctmp1,*) 'experiment length (', nitend - nit000 + 1, ') or nstock (', nstock,   &
+            &           ' is NOT a multiple of nn_rndm_freq (', nn_rndm_freq, ')'
+         CALL ctl_stop( ctmp1, 'Impossible to properly setup STOPACK restart' )
+      ENDIF
+
+      nn_sppt_tra = COUNT( (/ln_sppt_traxad, ln_sppt_trayad, ln_sppt_trazad, &
+                             ln_sppt_trasad, ln_sppt_traldf, ln_sppt_trazdf, &
+                            ln_sppt_trazdfp, ln_sppt_traevd, ln_sppt_trabbc, &
+                             ln_sppt_trabbl, ln_sppt_tranpc, ln_sppt_tradmp, &
+                             ln_sppt_traqsr, ln_sppt_transr, ln_sppt_traatf/) )
+      nn_sppt_dyn = COUNT( (/ln_sppt_dynhpg, ln_sppt_dynspg, ln_sppt_dynkeg, &
+                             ln_sppt_dynrvo, ln_sppt_dynpvo, ln_sppt_dynzad, &
+                             ln_sppt_dynldf, ln_sppt_dynzdf, ln_sppt_dynbfr, &
+                             ln_sppt_dynatf, ln_sppt_dyntau/) )
+      nn_sppt_ice = COUNT( (/ln_sppt_icehdf, ln_sppt_icelat, ln_sppt_icezdf/) )
+
+      ln_sppt_tra = ( nn_sppt_tra > 0 )
+      ln_sppt_dyn = ( nn_sppt_dyn > 0 )
+      ln_sppt_ice = ( nn_sppt_ice > 0 )
+
+      nn_spp = nn_spp_bfr+nn_spp_dqdt+nn_spp_dedt+nn_spp_avt+nn_spp_avm+nn_spp_qsi0+&
+      & nn_spp_ahtu+nn_spp_ahtv+nn_spp_ahtw+nn_spp_ahtt+nn_spp_relw+nn_spp_arnf+nn_spp_geot+nn_spp_aevd+&
+      & nn_spp_tkelc+nn_spp_tkedf+nn_spp_tkeds+nn_spp_tkebb+nn_spp_tkefr+nn_spp_ahubbl+nn_spp_ahvbbl+&
+      & nn_spp_ahm1+nn_spp_ahm2
+
+#ifdef NEMO_V34
+
+#ifndef key_trdtra
+      IF( ln_sppt_tra ) &
+         & CALL ctl_stop( ' SPPT on tracers on .AND. .NOT. key_trdtra ', &
+         &                ' SPPT cannot work without tracer tendency computation')
+#endif
+#ifndef key_trddyn
+      IF( ln_sppt_dyn ) &
+         & CALL ctl_stop( ' SPPT on momentum on .AND. .NOT. key_trddyn ', &
+         &                ' SPPT cannot work without dynamic tendency computation')
+#endif
+
+#else
+      IF( ln_sppt_tra .AND. .NOT.  ln_tra_trd ) &
+         & CALL ctl_stop( ' SPPT on tracers on .AND. .NOT. ln_tra_trd ', &
+         &                ' SPPT cannot work without tracer tendency computation')
+
+      IF( ln_sppt_dyn .AND. .NOT.  ln_dyn_trd ) &
+         & CALL ctl_stop( ' SPPT on momentum on .AND. .NOT. ln_dyn_trd ', &
+         &                ' SPPT cannot work without dynamic tendency computation')
+#endif
+
+      IF( ln_sppt_glocon .AND. lk_vvl ) &
+         & CALL ctl_stop( ' ln_sppt_glocal .AND. lk_vvl ', &
+         &                ' SPPT conservation not coded yet for VVL')
+
+      IF( nn_deftau .NE. 1 .AND. nn_deftau .NE. 2 ) &
+         & CALL ctl_stop( ' nn_deftau must be 1 or 2 ')
+
+      nn_spp_aht = nn_spp_ahtu + nn_spp_ahtv + nn_spp_ahtw + nn_spp_ahtt
+      IF(nn_spp_aht .GT. 0) THEN
+#if defined key_traldf_c3d
+        IF(lwp) WRITE(numout,*) 'SPP : diffusivity perturbation with 3D coefficients'
+#elif defined key_traldf_c2d
+        IF(lwp) WRITE(numout,*) 'SPP : diffusivity perturbation with 2D coefficients'
+#else
+        CALL ctl_stop( 'SPP : diffusivity perturbation requires key_traldf_c3d or key_traldf_c2d')
+#endif
+      ENDIF
+
+      IF(nn_spp_ahm1+nn_spp_ahm2 .GT. 0) THEN
+#if defined key_dynldf_c3d
+        IF(lwp) WRITE(numout,*) 'SPP : viscosity perturbation with 3D coefficients'
+#elif defined key_dynldf_c2d
+        IF(lwp) WRITE(numout,*) 'SPP : viscosity perturbation with 2D coefficients'
+#else
+        CALL ctl_stop( 'SPP : viscosity perturbation requires key_dynldf_c3d or key_dynldf_c2d')
+#endif
+      ENDIF
+
+      ln_skeb_own_gauss = .FALSE.
+      IF( ln_skeb ) THEN
+        IF( skeb_filter_pass > 0 .AND. skeb_filter_pass .NE. sppt_filter_pass ) ln_skeb_own_gauss = .TRUE.
+        IF( rn_skeb_tau > 0._wp .AND. rn_skeb_tau .NE. rn_sppt_tau ) ln_skeb_own_gauss = .TRUE.
+      ENDIF
+
+      ln_spp_own_gauss = .FALSE.
+      IF( nn_spp > 0 ) THEN
+        IF( spp_filter_pass > 0 .AND. spp_filter_pass .NE. sppt_filter_pass ) ln_spp_own_gauss = .TRUE.
+        IF( rn_spp_tau > 0._wp .AND. rn_spp_tau .NE. rn_sppt_tau ) ln_spp_own_gauss = .TRUE.
+      ENDIF
+
+      IF(lwp) THEN
+         WRITE(numout,*) '    SPPT on tracers     : ',ln_sppt_tra
+         WRITE(numout,*) '    SPPT on dynamics    : ',ln_sppt_dyn
+         WRITE(numout,*) '    SPPT on sea-ice     : ',ln_sppt_ice
+         WRITE(numout,*) '    SPP perturbed params: ',nn_spp
+         WRITE(numout,*) '    SKEB scheme         : ',ln_skeb
+         WRITE(numout,*) '    SPP with own scales : ',ln_spp_own_gauss
+         WRITE(numout,*) '    SKEB with own scales: ',ln_skeb_own_gauss
+         IF(lflush) CALL flush(numout)         
+      ENDIF
+
+      IF( sppt_tra_alloc() /= 0) CALL ctl_stop( 'STOP', 'sppt_alloc: unable to allocate arrays' )
+
+      spptt = 0._wp  ; sppts = 0._wp
+      spptu = 0._wp  ; spptv = 0._wp
+
+      ! Find filter attenuation factor
+
+      flt_fac = sppt_fltfac( sppt_filter_pass )
+      rdt_sppt = nn_rndm_freq * rn_rdt
+
+      IF( ln_sppt_taumap ) THEN
+         CALL iom_open ( 'sppt_tau_map', inum )
+         CALL iom_get  ( inum, jpdom_data, 'tau', sppt_tau )
+         CALL iom_close( inum )
+      ELSE
+         sppt_tau(:,:) = rn_sppt_tau
+      ENDIF
+
+      IF( nn_deftau .EQ. 1 ) THEN
+         ! Decorrelation time-scale defined in days
+         sppt_tau(:,:) = exp( -rdt_sppt / (sppt_tau(:,:)*86400._wp) )
+      ELSE
+         ! Decorrelation time-scale defined in timesteps
+         sppt_tau(:,:) = exp( -REAL( nn_rndm_freq, wp) / sppt_tau(:,:) )
+      ENDIF
+
+      IF( ln_distcoast ) THEN
+        CALL iom_open('dist.coast', inum )
+        CALL iom_get(inum,jpdom_data,'Tcoast',zdc)
+        CALL iom_close( inum )
+        zdc = 1._wp - exp(-zdc/rn_distcoast)
+        CALL lbc_lnk( zdc , 'T', 1._wp)
+      ELSE
+        zdc = 1._wp
+      ENDIF
+
+      ! Initialize
+      sppt_a = sppt_tau
+      sppt_b = sqrt ( 1._wp - sppt_tau*sppt_tau )
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '    **** SPPT SCHEME'
+         WRITE(numout,*) '    Definit. time-scale : ',nn_deftau
+         WRITE(numout,*) '     Decorr. time-scale : ',rn_sppt_tau
+         WRITE(numout,*) '        Mean AR1 a term : ',SUM(sppt_a)/REAL(jpi*jpj)
+         WRITE(numout,*) '        Mean AR1 b term : ',SUM(sppt_b)/REAL(jpi*jpj)
+         WRITE(numout,*)
+         IF(lflush) CALL flush(numout)         
+      ENDIF
+
+      gauss_b = 0._wp
+      ! Weigths
+      gauss_w(:)    = 1.0_wp
+      IF( nn_vwei .eq. 1 ) THEN
+        gauss_w(1)    = 0.0_wp
+        gauss_w(2)    = 0.5_wp
+        gauss_w(jpk)  = 0.0_wp
+        gauss_w(jpkm1)= 0.5_wp
+      ENDIF
+
+      IF( ln_spp_own_gauss ) THEN
+        IF( spp_alloc() /= 0) CALL ctl_stop( 'STOP', 'spp_alloc: unable to allocate arrays' )
+        flt_fac_p = sppt_fltfac( spp_filter_pass )
+        spp_tau (:, :) = rn_spp_tau
+        IF( nn_deftau .EQ. 1 ) THEN
+          spp_tau(:,:) = spp_tau(:,:) * 86400._wp
+          spp_tau(:,:) = exp( -rdt_sppt / (spp_tau) )
+        ELSE
+          spp_tau(:,:) = exp( -1._wp / spp_tau )
+        ENDIF
+        spp_a = spp_tau
+        spp_b = sqrt ( 1._wp - spp_tau*spp_tau )
+        gauss_bp = 0._wp
+        IF(lwp) THEN
+          WRITE(numout,*)
+          WRITE(numout,*) '    **** SPP  SCHEME'
+          WRITE(numout,*) '    Definit. time-scale : ',nn_deftau
+          WRITE(numout,*) '     Decorr. time-scale : ',rn_spp_tau
+          WRITE(numout,*) '        Mean AR1 a term : ',SUM(spp_a)/REAL(jpi*jpj)
+          WRITE(numout,*) '        Mean AR1 b term : ',SUM(spp_b)/REAL(jpi*jpj)
+          WRITE(numout,*)
+          IF(lflush) CALL flush(numout)          
+        ENDIF
+      ENDIF
+
+      IF( ln_skeb_own_gauss ) THEN
+        IF( skeb_alloc() /= 0) CALL ctl_stop( 'STOP', 'skeb_alloc: unable to allocate arrays' )
+        flt_fac_k = sppt_fltfac( skeb_filter_pass )
+        skeb_tau (:, :) = rn_skeb_tau
+        IF( nn_deftau .EQ. 1 ) THEN
+          skeb_tau(:,:) = skeb_tau(:,:) * 86400._wp
+          skeb_tau(:,:) = exp( -rdt_sppt / (skeb_tau) )
+        ELSE
+          skeb_tau(:,:) = exp( -1._wp / skeb_tau )
+        ENDIF
+        skeb_a = skeb_tau
+        skeb_b = sqrt ( 1._wp - skeb_tau*skeb_tau )
+        gauss_bk = 0._wp
+        IF(lwp) THEN
+          WRITE(numout,*)
+          WRITE(numout,*) '    **** SEB  SCHEME'
+          WRITE(numout,*) '    Definit. time-scale : ',nn_deftau
+          WRITE(numout,*) '     Decorr. time-scale : ',rn_skeb_tau
+          WRITE(numout,*) '        Mean AR1 a term : ',SUM(skeb_a)/REAL(jpi*jpj)
+          WRITE(numout,*) '        Mean AR1 b term : ',SUM(skeb_b)/REAL(jpi*jpj)
+          WRITE(numout,*)
+          IF(lflush) CALL flush(numout)          
+        ENDIF
+      ENDIF
+
+      IF( ln_skeb_own_gauss .OR. ln_spp_own_gauss ) &
+      & ALLOCATE ( g2d_save(jpi,jpj) )
+
+      CALL stopack_rst( nit000, 'READ' )
+
+      IF(lwp .and. ln_stopack_diags) &
+      CALL ctl_opn(numdiag, 'stopack.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
+
+   END SUBROUTINE stopack_init
+   !
+   SUBROUTINE stopack_rst( kt, cdrw )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE stopack_rst ***
+      !!
+      !! ** Purpose :   Read/write from/to restarsts seed and perturbation field
+      !!----------------------------------------------------------------------
+      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
+      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
+      INTEGER :: id1, jseed
+      CHARACTER(LEN=10)   ::   clseed='spsd0_0000'
+      INTEGER(KIND=8)     ::   ziseed(4)           ! RNG seeds in integer type
+      INTEGER(KIND=8)     ::   ivals(8)
+      REAL(wp)            ::   zrseed4(4)           ! RNG seeds in integer type
+      REAL(wp)            ::   zrseed2d(jpi,jpj)
+      !
+      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise
+         !                                   ! ---------------
+         IF(lwp) WRITE(numout,*) ' *** stopack-rst ***'
+         IF( ln_rstart ) THEN !* Read the restart file
+            id1 = iom_varid( numror, 'sppt_b', ldstop = .FALSE. )
+            !
+            IF( id1 > 0 ) THEN
+                CALL iom_get( numror, jpdom_autoglo, 'sppt_b', gauss_b )
+                DO jseed = 1 , 4
+                   WRITE(clseed(5:5) ,'(i1.1)') jseed
+                   CALL iom_get( numror, jpdom_autoglo, clseed(1:5) , zrseed2d )
+                   zrseed4(jseed) = zrseed2d(2,2)
+                   ziseed(jseed) = TRANSFER( zrseed4(jseed) , ziseed(jseed) )
+               END DO
+               IF (lwp) THEN
+                  WRITE(numout,*) 'Read ziseed4 = ',zrseed4(:)
+                  WRITE(numout,*) 'Read ziseed  = ',ziseed(:)
+               ENDIF
+               CALL kiss_seed( ziseed(1) , ziseed(2) , ziseed(3) , ziseed(4) )
+            ELSE
+               IF( lwp ) WRITE(numout,*) ' ===>>>> : previous run without sppt_b'
+               IF( ln_stopack_restart ) CALL ctl_stop( ' ln_stopack_restart TRUE :',&
+               & ' variable not found in restart file ')
+               IF(lwp) WRITE(numout,*) ' ===>>>> : Initialisation of sppt_b to 0.'
+               gauss_b = 0._wp
+               IF ( .NOT. ln_stopack_repr ) THEN
+                  CALL date_and_time(VALUES=ivals)
+                  DO jseed=1,4
+                    nn_stopack_seed(jseed) = nn_stopack_seed(jseed) + INT(ivals(4+jseed))
+                  ENDDO
+               ENDIF
+               DO jseed=1,4
+                 ziseed(jseed) = TRANSFER(nn_stopack_seed(jseed)+narea, ziseed(jseed))
+               ENDDO
+               IF(lwp) WRITE(numout,*) ' ===>>>> Seed, nn_stopack_seed+narea',nn_stopack_seed+narea
+               IF(lwp) WRITE(numout,*) ' ===>>>> Seed, ziseed',ziseed
+               CALL kiss_seed( ziseed(1) , ziseed(2) , ziseed(3) , ziseed(4) )
+            ENDIF
+            IF( ln_spp_own_gauss ) THEN
+              id1 = iom_varid( numror, 'spp_b', ldstop = .FALSE. )
+              IF( id1 > 0 ) THEN
+                 CALL iom_get( numror, jpdom_autoglo, 'spp_b', gauss_bp )
+              ELSE
+                 IF(lwp) WRITE(numout,*) ' ===>>>> : Initialisation of spp_b to 0.'
+                 gauss_bp = 0._wp
+              ENDIF
+            ENDIF
+            IF( ln_skeb_own_gauss ) THEN
+              id1 = iom_varid( numror, 'skeb_b', ldstop = .FALSE. )
+              IF( id1 > 0 ) THEN
+                 CALL iom_get( numror, jpdom_autoglo, 'skeb_b', gauss_bk )
+              ELSE
+                 IF(lwp) WRITE(numout,*) ' ===>>>> : Initialisation of skeb_b to 0.'
+                 gauss_bk = 0._wp
+              ENDIF
+            ENDIF
+         ELSE
+            gauss_b = 0._wp
+            gauss_bp = 0._wp
+            gauss_bk = 0._wp
+            IF(lwp) WRITE(numout,*) ' ===>>>> : Initialisation of STOPACK to 0.'
+            IF ( .NOT. ln_stopack_repr ) THEN
+                CALL date_and_time(VALUES=ivals)
+                DO jseed=1,4
+                   nn_stopack_seed(jseed) = nn_stopack_seed(jseed) + INT(ivals(4+jseed))
+                ENDDO
+            ENDIF
+            DO jseed=1,4
+               ziseed(jseed) = TRANSFER(nn_stopack_seed(jseed)+narea, ziseed(jseed))
+            ENDDO
+            IF(lwp) WRITE(numout,*) ' ===>>>> Seed, nn_stopack_seed+narea',nn_stopack_seed+narea
+            IF(lwp) WRITE(numout,*) ' ===>>>> Seed, ziseed',ziseed
+            CALL kiss_seed( ziseed(1) , ziseed(2) , ziseed(3) , ziseed(4) )
+         ENDIF
+         !
+      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file
+         !                                   ! -------------------
+         IF(lwp) WRITE(numout,*) '---- stopack-rst ----'
+         CALL iom_rstput( kt, nitrst, numrow, 'sppt_b', gauss_b )
+         IF(ln_spp_own_gauss) CALL iom_rstput( kt, nitrst, numrow, 'spp_b', gauss_bp )
+         IF(ln_skeb_own_gauss) CALL iom_rstput( kt, nitrst, numrow, 'skeb_b', gauss_bk )
+         CALL kiss_state( ziseed(1) , ziseed(2) , ziseed(3) , ziseed(4) )
+         DO jseed=1,4
+            zrseed4(jseed) = TRANSFER(ziseed(jseed), zrseed4(jseed))
+         ENDDO
+         IF (lwp) THEN
+            WRITE(numout,*) 'Write ziseed4 = ',zrseed4(:)
+            WRITE(numout,*) 'Write ziseed  = ',ziseed(:)
+         ENDIF
+         DO jseed = 1 , 4
+            WRITE(clseed(5:5) ,'(i1.1)') jseed
+            zrseed2d(:,:) = zrseed4(jseed)
+            CALL iom_rstput( kt, nitrst, numrow, clseed(1:5) , zrseed2d )
+         END DO
+         !
+      ENDIF
+      !
+   END SUBROUTINE stopack_rst
+   !
+   INTEGER FUNCTION sppt_tra_alloc()
+      !!---------------------------------------------------------------------
+      !!                  ***  FUNCTION sppt_tra_alloc  ***
+      !!---------------------------------------------------------------------
+      !
+      ALLOCATE( spptt(jpi,jpj,jpk) , sppts(jpi,jpj,jpk) , gauss_n(jpi,jpj,jpk) ,&
+      gauss_nu(jpi,jpj,jpk) , gauss_nv(jpi,jpj,jpk) , &
+      spptu(jpi,jpj,jpk) , spptv(jpi,jpj,jpk) , gauss_n_2d(jpi,jpj) ,&
+      gauss_b (jpi,jpj), sppt_tau(jpi,jpj), sppt_a(jpi,jpj), sppt_b(jpi,jpj), gauss_w(jpk),&
+      zdc(jpi,jpj,jpk), STAT= sppt_tra_alloc )
+      !
+      IF( lk_mpp             )   CALL mpp_sum ( sppt_tra_alloc )
+      IF( sppt_tra_alloc /= 0)   CALL ctl_warn('sppt_tra_alloc: failed to allocate arrays')
+
+      IF(nn_spp_bfr>0) THEN
+        ALLOCATE(coeff_bfr(jpi,jpj), STAT= sppt_tra_alloc )
+        IF( lk_mpp             )   CALL mpp_sum ( sppt_tra_alloc )
+        IF( sppt_tra_alloc /= 0)   CALL ctl_warn('sppt_tra_alloc: failed to allocate arrays')
+        coeff_bfr = 0._wp
+      ENDIF
+      gauss_b = 0._wp
+      gauss_n = 0._wp
+      gauss_nu= 0._wp
+      gauss_nv= 0._wp
+      gauss_n_2d = 0._wp
+
+   END FUNCTION sppt_tra_alloc
+
+   INTEGER FUNCTION skeb_alloc()
+      !!---------------------------------------------------------------------
+      !!                  ***  FUNCTION skeb_alloc  ***
+      !!---------------------------------------------------------------------
+      !
+      ALLOCATE( gauss_n_2d_k(jpi,jpj) , gauss_bk (jpi,jpj),skeb_tau(jpi,jpj),&
+      skeb_a(jpi,jpj), skeb_b(jpi,jpj), STAT= skeb_alloc )
+      !
+      IF( lk_mpp             )   CALL mpp_sum ( skeb_alloc )
+      IF( skeb_alloc /= 0)   CALL ctl_warn('sppt_tra_alloc: failed to allocate arrays')
+      gauss_n_2d_k = 0._wp
+      gauss_bk = 0._wp
+
+   END FUNCTION skeb_alloc
+
+   INTEGER FUNCTION spp_alloc()
+      !!---------------------------------------------------------------------
+      !!                  ***  FUNCTION spp_alloc  ***
+      !!---------------------------------------------------------------------
+      !
+      ALLOCATE( gauss_n_2d_p(jpi,jpj), gauss_bp (jpi,jpj),spp_tau(jpi,jpj), &
+      spp_a(jpi,jpj), spp_b(jpi,jpj), STAT= spp_alloc )
+      !
+      IF( lk_mpp             )   CALL mpp_sum ( spp_alloc )
+      IF( spp_alloc /= 0)   CALL ctl_warn('sppt_tra_alloc: failed to allocate arrays')
+      gauss_n_2d_p = 0._wp
+      gauss_bp = 0._wp
+
+   END FUNCTION spp_alloc
+
+   SUBROUTINE sppt_flt( psto )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sppt_flt  ***
+      !!
+      !! ** Purpose :   apply horizontal Laplacian filter to input array
+      !!                Adapted from STO package
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psto
+      REAL(wp), DIMENSION(jpi,jpj)                ::   pstm
+      !!
+      INTEGER  :: ji, jj
+
+      pstm = psto
+      DO jj = 2, jpj-1
+         DO ji = 2, jpi-1
+            psto(ji,jj) = 0.5_wp * pstm(ji,jj) + 0.125_wp * &
+                              &  ( pstm(ji-1,jj) + pstm(ji+1,jj) +  &
+                              &    pstm(ji,jj-1) + pstm(ji,jj+1) )
+         END DO
+      END DO
+      CALL lbc_lnk( psto , 'T', 1._wp )
+
+   END SUBROUTINE sppt_flt
+
+   SUBROUTINE sppt_rand2d( psto )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sppt_rand2d ***
+      !!
+      !! ** Purpose :   fill input array with white Gaussian noise
+      !!                Adapted from STO package
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(out)           ::   psto
+      !!
+      INTEGER  :: ji, jj
+      REAL(KIND=8) :: gran   ! Gaussian random number (forced KIND=8 as in kiss_gaussian)
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            CALL kiss_gaussian( gran )
+            psto(ji,jj) = gran*rn_sppt_stdev
+         END DO
+      END DO
+
+   END SUBROUTINE sppt_rand2d
+
+   FUNCTION sppt_fltfac( kpasses )
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION sppt_fltfac  ***
+      !!
+      !! ** Purpose :   compute factor to restore standard deviation
+      !!                as a function of the number of passes
+      !!                of the Laplacian filter
+      !!                From STO package
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: kpasses
+      REAL(wp) :: sppt_fltfac
+      !!
+      INTEGER :: jpasses, ji, jj, jflti, jfltj
+      INTEGER, DIMENSION(-1:1,-1:1) :: pflt0
+      ! 16-b reals to avoid overflows
+      INTEGER,  PARAMETER ::   qp = SELECTED_REAL_KIND(33,4931)
+      REAL(qp), DIMENSION(:,:), ALLOCATABLE :: pfltb
+      REAL(qp), DIMENSION(:,:), ALLOCATABLE :: pflta
+      REAL(qp) :: ratio
+      REAL(qp) :: aux0, aux1
+      pflt0(-1,-1) = 0 ; pflt0(-1,0) = 1 ; pflt0(-1,1) = 0
+      pflt0( 0,-1) = 1 ; pflt0( 0,0) = 4 ; pflt0( 0,1) = 1
+      pflt0( 1,-1) = 0 ; pflt0( 1,0) = 1 ; pflt0( 1,1) = 0
+      ALLOCATE(pfltb(-kpasses-1:kpasses+1,-kpasses-1:kpasses+1))
+      ALLOCATE(pflta(-kpasses-1:kpasses+1,-kpasses-1:kpasses+1))
+      pfltb(:,:) = 0
+      pfltb(0,0) = 1
+      DO jpasses = 1, kpasses
+        pflta(:,:) = 0._qp
+        DO jflti= -1, 1
+        DO jfltj= -1, 1
+          DO ji= -kpasses, kpasses
+          DO jj= -kpasses, kpasses
+            pflta(ji,jj) = pflta(ji,jj) + pfltb(ji+jflti,jj+jfltj) * pflt0(jflti,jfltj)
+          ENDDO
+          ENDDO
+        ENDDO
+        ENDDO
+        pfltb(:,:) = pflta(:,:)
+      ENDDO
+      ratio = SUM(pfltb(:,:))
+      aux0  = SUM(pfltb(:,:)*pfltb(:,:))
+      aux1  = ratio*ratio
+      ratio = aux1 / aux0
+      ratio = SQRT(ratio)
+      DEALLOCATE(pfltb,pflta)
+      sppt_fltfac = REAL(ratio, wp)
+   END FUNCTION sppt_fltfac
+
+   SUBROUTINE skeb_comp( lt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE skeb_comp  ***
+      !!
+      !! ** Purpose :   Computation of energy dissipation terms
+      !!                This is a wrapper to the enrgy terms computation
+      !!                routines
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(IN)  :: lt
+      CALL skeb_dnum ( lt )
+      CALL skeb_dcon ( lt )
+   END SUBROUTINE skeb_comp
+
+   SUBROUTINE bsfcomp( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE bsfcomp  ***
+      !!
+      !! ** Purpose :   Online computation of barotropic streamfunction
+      !!                For diagnostics purposes
+      !!                This routine is not explicitly called anywhere
+      !!                and utilizes low-level MPI routines
+      !!----------------------------------------------------------------------
+      USE MPI
+      !
+      INTEGER, INTENT(IN)  :: kt
+      !
+      REAL(wp) :: dtrpv(jpi,jpj)
+      INTEGER  :: jk,ji,jj
+      !
+#if defined key_mpp_mpi
+      INTEGER, DIMENSION(1) ::   ish
+      INTEGER, DIMENSION(2) ::   ish2
+      INTEGER               ::   ijp,tag,ierr,jp,isend,irecv
+      REAL(wp), DIMENSION(jpj) ::   zwrk    ! mask flux array at V-point
+      REAL(wp), DIMENSION(jpi) ::   zwr2    ! mask flux array at V-point
+      INTEGER :: istatus(MPI_STATUS_SIZE)
+#endif
+      IF(kt .EQ. nit000 ) THEN
+#ifdef NEMO_V34
+        ln_dpsiu = .FALSE.
+        ln_dpsiv = .FALSE.
+#else
+        IF (iom_use('bsft') ) ln_dpsiu = .TRUE.
+        IF (iom_use('bsftv') ) ln_dpsiv = .TRUE.
+#endif
+        IF( ln_dpsiv ) ALLOCATE ( dpsiv(jpi,jpj) )
+        IF( ln_dpsiu ) ALLOCATE ( dpsiu(jpi,jpj) )
+        IF( ln_dpsiv .OR. ln_dpsiu ) THEN
+          jpri = nint ( REAL(nimpp) / REAL(jpi) ) + 1
+          jprj = nint ( REAL(njmpp) / REAL(jpj) ) + 1
+        ENDIF
+      ENDIF
+
+      IF( ln_dpsiv ) THEN
+       dtrpv = 0._wp
+       DO jk = 1,jpkm1
+           dtrpv = dtrpv + fse3v(:,:,jk) * e1v(:,:) * vn(:,:,jk)
+       ENDDO
+       dpsiv(1,:)=0._wp
+       DO ji = 2,jpi
+          dpsiv(ji,:) = dpsiv(ji-1,:) + dtrpv(ji,:)
+       END DO
+      ENDIF
+
+      IF( ln_dpsiu ) THEN
+       dtrpv = 0._wp
+       DO jk = 1,jpkm1
+           dtrpv = dtrpv + fse3u(:,:,jk) * e2u(:,:) * un(:,:,jk)
+       ENDDO
+       dpsiu(:,1)=0._wp
+       DO jj = 2,jpj
+          dpsiu(:,jj) = dpsiu(:,jj-1) + dtrpv(:,jj)
+       END DO
+      ENDIF
+
+#if defined key_mpp_mpi
+      IF ( ln_dpsiv ) THEN
+       DO jp=1,jpni-1
+         IF( jpri == jp ) THEN ! SEND TO EAST
+          zwrk(1:jpj) = dpsiv(jpi-1,:)
+          tag=2000+narea
+          CALL mpi_isend(zwrk, jpj, mpi_double_precision, noea, tag, mpi_comm_opa, isend,ierr)
+         ELSEIF ( jpri == jp+1 ) THEN ! RECEIVE FROM WEST
+          CALL mpi_irecv(zwrk, jpj, mpi_double_precision, nowe, mpi_any_tag, mpi_comm_opa, irecv,ierr)
+         ENDIF
+         IF(jpri == jp) CALL mpi_wait(isend, istatus, ierr)
+         IF(jpri == jp+1 ) THEN
+          CALL mpi_wait(irecv, istatus, ierr)
+          DO ji=1,jpi
+            dpsiv(ji,:) = dpsiv(ji,:) + zwrk(:)
+          ENDDO
+         ENDIF
+       ENDDO
+      ENDIF
+
+      IF ( ln_dpsiv ) THEN
+       DO jp=1,jpnj-1
+         IF( jprj == jp ) THEN ! SEND TO NORTH
+          zwr2(1:jpi) = dpsiu(:,jpj-1)
+          tag=3000+narea
+          CALL mpi_isend(zwr2, jpi, mpi_double_precision, nono, tag, mpi_comm_opa, isend,ierr)
+         ELSEIF ( jprj == jp+1 ) THEN ! RECEIVE FROM SOUTH
+          CALL mpi_irecv(zwr2, jpi, mpi_double_precision, noso, mpi_any_tag, mpi_comm_opa, irecv,ierr)
+         ENDIF
+         IF(jprj == jp) CALL mpi_wait(isend, istatus, ierr)
+         IF(jprj == jp+1 ) THEN
+          CALL mpi_wait(irecv, istatus, ierr)
+          DO ji=1,jpj
+            dpsiu(:,ji) = dpsiu(:,ji) + zwr2(:)
+          ENDDO
+         ENDIF
+       ENDDO
+      ENDIF
+#endif
+      IF (ln_dpsiu ) THEN
+          CALL lbc_lnk(dpsiu,'T',1._wp)
+      ENDIF
+      IF (ln_dpsiv ) THEN
+          CALL lbc_lnk(dpsiv,'T',1._wp)
+      ENDIF
+
+      IF(kt == nitend ) THEN
+        IF (ln_dpsiv ) DEALLOCATE ( dpsiv )
+        IF (ln_dpsiu ) DEALLOCATE ( dpsiu )
+      ENDIF
+
+   END SUBROUTINE
+
+   SUBROUTINE skeb_dnum ( mt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE skeb_dnum  ***
+      !!
+      !! ** Purpose :   Computation of numerical energy dissipation
+      !!                For later use in the SKEB scheme
+      !!----------------------------------------------------------------------
+   INTEGER, INTENT(IN)  :: mt
+   REAL :: ds,dt,dtot,kh2
+   INTEGER :: ji,jj,jk
+
+   IF ( mt .eq. nit000 ) THEN
+        ALLOCATE ( dnum(jpi,jpj,jpk) )
+        dnum (:,:,: ) = 0._wp
+   ENDIF
+
+   kh2 = rn_kh * rn_kh
+
+   IF( mt .eq. nit000 .OR. MOD( mt - 1, nn_dcom_freq ) == 0 ) THEN
+
+     DO jk=1,jpkm1
+      DO jj=2,jpj
+       DO ji=2,jpi
+          ! Shear
+          ds = (vn(ji,jj,jk)-vn(ji-1,jj,jk))*vmask(ji,jj,jk)*vmask(ji-1,jj,jk)/ e1v(ji,jj) + &
+               (un(ji,jj,jk)-un(ji,jj-1,jk))*umask(ji,jj,jk)*umask(ji,jj-1,jk)/ e2u(ji,jj)
+          ! Tension
+          dt = (vn(ji,jj,jk)-vn(ji-1,jj,jk))*vmask(ji,jj,jk)*vmask(ji-1,jj,jk)/ e2v(ji,jj) + &
+               (un(ji,jj,jk)-un(ji,jj-1,jk))*umask(ji,jj,jk)*umask(ji,jj-1,jk)/ e1u(ji,jj)
+
+          dtot = sqrt( ds*ds + dt*dt ) * tmask(ji,jj,jk)
+          dnum(ji,jj,jk) = dtot*dtot*dtot*kh2*e1t(ji,jj)*e2t(ji,jj)
+       ENDDO
+      ENDDO
+     ENDDO
+
+     CALL lbc_lnk(dnum,'T',1._wp)
+
+   ENDIF
+
+   END SUBROUTINE
+
+   SUBROUTINE skeb_dcon ( mt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE skeb_dcon  ***
+      !!
+      !! ** Purpose :   Computation of convective energy dissipation
+      !!                For later use in the SKEB scheme
+      !!                Two formulation are implemented, based on buoyancy or
+      !!                convective mass flux formulations, respectively
+      !!----------------------------------------------------------------------
+   INTEGER, INTENT(IN)  :: mt
+   REAL(wp) :: zz, mf1,mf2,kc2
+   INTEGER  :: ji,jj,jk
+
+   IF ( mt .eq. nit000 ) THEN
+        ALLOCATE ( dcon(jpi,jpj,jpk) )
+        dcon (:,:,: ) = 0._wp
+   ENDIF
+
+   kc2 = rn_kc * rn_kc
+
+   IF( mt .eq. nit000 .OR. MOD( mt - 1, nn_dcom_freq ) == 0 ) THEN
+
+    IF(nn_dconv  .eq. 1 ) THEN
+
+     DO jk=2,jpkm1
+      DO jj=1,jpj
+       DO ji=1,jpi
+
+           zz = - grav*avt(ji,jj,jk) * ( rhd(ji,jj,jk)-rhd(ji,jj,jk-1) ) * wmask(ji,jj,jk) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) &
+              & / ( rau0 * fse3w(ji,jj,jk) )
+
+           dcon(ji,jj,jk) = kc2*zz*e1t(ji,jj)*e2t(ji,jj)*rau0 / fse3w(ji,jj,jk)
+
+       ENDDO
+      ENDDO
+     ENDDO
+
+    ELSEIF (nn_dconv .eq. 2 ) THEN
+
+     DO jk=2,jpkm1
+      DO jj=1,jpj
+       DO ji=1,jpi
+
+           mf1 = wn(ji,jj,jk+1)*e1t(ji,jj)*e2t(ji,jj)
+           mf2 = wn(ji,jj,jk-1)*e1t(ji,jj)*e2t(ji,jj)
+           dcon(ji,jj,jk) = rn_kc * (mf1-mf2)*(mf1-mf2) * tmask(ji,jj,jk+1) / (fse3w(ji,jj,jk)*rau0*rau0)
+
+       ENDDO
+      ENDDO
+     ENDDO
+
+    ENDIF
+
+     CALL lbc_lnk(dcon,'T',1._wp)
+
+   ENDIF
+
+   END SUBROUTINE
+
+   SUBROUTINE skeb_apply ( mt)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE skeb_apply  ***
+      !!
+      !! ** Purpose :   Application of SKEB perturbation
+      !!                Convective and Numerical energy dissipation are
+      !!                multiplied by the beta terms
+      !!----------------------------------------------------------------------
+
+   INTEGER, INTENT(IN)  :: mt
+   INTEGER :: ji,jj,jk
+   REAL(wp), DIMENSION(jpi,jpj,jpk) :: ustar,vstar,psi
+   REAL(wp) :: mi,ma
+
+   IF( ln_stopack_diags ) THEN
+
+     psi = 0._wp
+     IF(ln_skeb_own_gauss) THEN
+       DO jk=1,jpkm1
+         psi(:,:,jk) = rn_skeb * sqrt( rn_beta_num * dnum(:,:,jk) ) * gauss_n_2d_k(:,:)
+       ENDDO
+     ELSE
+       DO jk=1,jpkm1
+         psi(:,:,jk) = rn_skeb_stdev * rn_skeb * sqrt( rn_beta_num * dnum(:,:,jk) ) &
+         & * gauss_n_2d(:,:) / rn_sppt_stdev
+       ENDDO
+     ENDIF
+     ustar = 0._wp
+     vstar = 0._wp
+     DO jk=1,jpkm1
+      DO jj=2,jpj
+       DO ji=2,jpi
+          ustar(ji,jj,jk) =   ( psi(ji,jj,jk)-psi(ji,jj-1,jk) )*umask(ji,jj,jk)*umask(ji,jj-1,jk)/ e2u(ji,jj)
+          vstar(ji,jj,jk) = - ( psi(ji,jj,jk)-psi(ji-1,jj,jk) )*vmask(ji,jj,jk)*vmask(ji-1,jj,jk)/ e1v(ji,jj)
+       ENDDO
+      ENDDO
+     ENDDO
+     mi = MAXVAL(ABS(ustar))
+     ma = MAXVAL(ABS(vstar))
+     IF(lk_mpp) CALL mpp_max(mi)
+     IF(lk_mpp) CALL mpp_max(ma)
+     IF(lwp) WRITE(numdiag,9304) lkt,'DNUM ABS CURRENT' ,mi,ma
+
+     rn_mmax ( jk_skeb_dnum ) =  MAX ( MAX( mi, ma), rn_mmax ( jk_skeb_dnum ) )
+
+     psi = 0._wp
+     IF(ln_skeb_own_gauss) THEN
+       DO jk=1,jpkm1
+         psi(:,:,jk) = rn_skeb * sqrt( rn_beta_con * dcon(:,:,jk) ) * gauss_n_2d_k(:,:)
+       ENDDO
+     ELSE
+       DO jk=1,jpkm1
+         psi(:,:,jk) = rn_skeb_stdev * rn_skeb * sqrt( rn_beta_con * dcon(:,:,jk) ) &
+         & * gauss_n_2d(:,:) / rn_sppt_stdev
+       ENDDO
+     ENDIF
+     ustar = 0._wp
+     vstar = 0._wp
+     DO jk=1,jpkm1
+      DO jj=2,jpj
+       DO ji=2,jpi
+          ustar(ji,jj,jk) =   ( psi(ji,jj,jk)-psi(ji,jj-1,jk) )*umask(ji,jj,jk)*umask(ji,jj-1,jk)/ e2u(ji,jj)
+          vstar(ji,jj,jk) = - ( psi(ji,jj,jk)-psi(ji-1,jj,jk) )*vmask(ji,jj,jk)*vmask(ji-1,jj,jk)/ e1v(ji,jj)
+       ENDDO
+      ENDDO
+     ENDDO
+     mi = MAXVAL(ABS(ustar))
+     ma = MAXVAL(ABS(vstar))
+     IF(lk_mpp) CALL mpp_max(mi)
+     IF(lk_mpp) CALL mpp_max(ma)
+     IF(lwp) WRITE(numdiag,9304) lkt,'DCON ABS CURRENT' ,mi,ma
+
+     rn_mmax ( jk_skeb_dcon ) =  MAX ( MAX( mi, ma), rn_mmax ( jk_skeb_dcon ) )
+
+9304 FORMAT(' it :', i8, ' ', A16, ' Min: ',d10.3 , ' Max: ',d10.3)
+
+   ENDIF
+
+   psi = 0._wp
+   IF(ln_skeb_own_gauss) THEN
+     DO jk=1,jpkm1
+       psi(:,:,jk) = rn_skeb * sqrt( rn_beta_num * dnum(:,:,jk)+ rn_beta_con * dcon(:,:,jk) ) * gauss_n_2d_k(:,:)
+     ENDDO
+   ELSE
+     DO jk=1,jpkm1
+       psi(:,:,jk) = rn_skeb_stdev * rn_skeb * sqrt( rn_beta_num * dnum(:,:,jk)+ rn_beta_con * dcon(:,:,jk) ) &
+       & * gauss_n_2d(:,:) / rn_sppt_stdev
+     ENDDO
+   ENDIF
+
+   ustar = 0._wp
+   vstar = 0._wp
+
+   DO jk=1,jpkm1
+    DO jj=2,jpj
+     DO ji=2,jpi
+        ustar(ji,jj,jk) =   ( psi(ji,jj,jk)-psi(ji,jj-1,jk) )*umask(ji,jj,jk)*umask(ji,jj-1,jk)/ e2u(ji,jj)
+        vstar(ji,jj,jk) = - ( psi(ji,jj,jk)-psi(ji-1,jj,jk) )*vmask(ji,jj,jk)*vmask(ji-1,jj,jk)/ e1v(ji,jj)
+     ENDDO
+    ENDDO
+   ENDDO
+
+   IF( ln_stopack_diags ) THEN
+
+      mi = MAXVAL(ABS(dnum))
+      ma = MAXVAL(ABS(dcon))
+      IF(lk_mpp) CALL mpp_max(mi)
+      IF(lk_mpp) CALL mpp_max(ma)
+      IF(lwp) WRITE(numdiag,9302) lkt,'DNUM AND DCON MX' ,mi,ma
+
+      mi = MINVAL(ustar)
+      ma = MAXVAL(ustar)
+      IF(lk_mpp) CALL mpp_min(mi)
+      IF(lk_mpp) CALL mpp_max(ma)
+      IF(lwp) WRITE(numdiag,9302) lkt,'SKEB U-CURRENT  ' ,mi,ma
+
+      rn_mmax ( jk_skeb_tot ) =  MAX ( MAX( abs(mi), ma), rn_mmax ( jk_skeb_tot ) )
+
+      mi = MINVAL(vstar)
+      ma = MAXVAL(vstar)
+      IF(lk_mpp) CALL mpp_min(mi)
+      IF(lk_mpp) CALL mpp_max(ma)
+      IF(lwp) WRITE(numdiag,9302) lkt,'SKEB V-CURRENT  ' ,mi,ma
+9302  FORMAT(' it :', i8, ' ', A16, ' Min: ',d10.3 , ' Max: ',d10.3)
+
+      rn_mmax ( jk_skeb_tot ) =  MAX ( MAX( abs(mi), ma), rn_mmax ( jk_skeb_tot ) )
+
+   ENDIF
+
+   CALL lbc_lnk(ustar,'U',-1._wp)
+   CALL lbc_lnk(vstar,'V',-1._wp)
+
+   DO jk=1,jpkm1
+    DO jj=1,jpj
+     DO ji=1,jpi
+        un(ji,jj,jk)    = un(ji,jj,jk) + ustar(ji,jj,jk)
+        vn(ji,jj,jk)    = vn(ji,jj,jk) + vstar(ji,jj,jk)
+     ENDDO
+    ENDDO
+   ENDDO
+
+#ifdef key_iomput
+   IF (iom_use('ustar_skeb') ) CALL iom_put( "ustar_skeb" , ustar)
+   IF (iom_use('vstar_skeb') ) CALL iom_put( "vstar_skeb" , vstar)
+#endif
+
+   IF ( mt .eq. nitend ) THEN
+     IF(ALLOCATED(dnum)) DEALLOCATE ( dnum )
+     IF(ALLOCATED(dcon)) DEALLOCATE ( dcon )
+     IF (ln_stopack_diags .AND. lwp) CALL stopack_report
+   ENDIF
+
+   END SUBROUTINE
+
+   !!======================================================================
+   !! Random number generator, used in NEMO stochastic parameterization
+   !!
+   !!=====================================================================
+   !! History :  3.3  ! 2011-10 (J.-M. Brankart)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !! The module is based on (and includes) the
+   !! 64-bit KISS (Keep It Simple Stupid) random number generator
+   !! distributed by George Marsaglia :
+   !! http://groups.google.com/group/comp.lang.fortran/
+   !!        browse_thread/thread/a85bf5f2a97f5a55
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   kiss          : 64-bit KISS random number generator (period ~ 2^250)
+   !!   kiss_seed     : Define seeds for KISS random number generator
+   !!   kiss_state    : Get current state of KISS random number generator
+   !!   kiss_save     : Save current state of KISS (for future restart)
+   !!   kiss_load     : Load the saved state of KISS
+   !!   kiss_reset    : Reset the default seeds
+   !!   kiss_check    : Check the KISS pseudo-random sequence
+   !!   kiss_uniform  : Real random numbers with uniform distribution in [0,1]
+   !!   kiss_gaussian : Real random numbers with Gaussian distribution N(0,1)
+   !!   kiss_gamma    : Real random numbers with Gamma distribution Gamma(k,1)
+   !!   kiss_sample   : Select a random sample from a set of integers
+   !!
+   !!   ---CURRENTLY NOT USED IN NEMO :
+   !!   kiss_save, kiss_load, kiss_check, kiss_gamma, kiss_sample
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: dynhpg.F90 2528 2010-12-27 17:33:53Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   FUNCTION kiss()
+      !! --------------------------------------------------------------------
+      !!                  ***  FUNCTION kiss  ***
+      !!
+      !! ** Purpose :   64-bit KISS random number generator
+      !!
+      !! ** Method  :   combine several random number generators:
+      !!                (1) Xorshift (XSH), period 2^64-1,
+      !!                (2) Multiply-with-carry (MWC), period (2^121+2^63-1)
+      !!                (3) Congruential generator (CNG), period 2^64.
+      !!
+      !!                overall period:
+      !!                (2^250+2^192+2^64-2^186-2^129)/6
+      !!                            ~= 2^(247.42) or 10^(74.48)
+      !!
+      !!                set your own seeds with 'kiss_seed'
+      ! --------------------------------------------------------------------
+      IMPLICIT NONE
+      INTEGER(KIND=i8) :: kiss, t
+
+      t = ISHFT(x,58) + w
+      IF (s(x).eq.s(t)) THEN
+         w = ISHFT(x,-6) + s(x)
+      ELSE
+         w = ISHFT(x,-6) + 1 - s(x+t)
+      ENDIF
+      x = t + x
+      y = m( m( m(y,13_8), -17_8 ), 43_8 )
+      z = 6906969069_8 * z + 1234567_8
+
+      kiss = x + y + z
+
+      CONTAINS
+
+         FUNCTION s(k)
+            INTEGER(KIND=i8) :: s, k
+            s = ISHFT(k,-63)
+         END FUNCTION s
+
+         FUNCTION m(k, n)
+            INTEGER(KIND=i8) :: m, k, n
+            m =  IEOR(k, ISHFT(k, n) )
+         END FUNCTION m
+
+   END FUNCTION kiss
+
+
+   SUBROUTINE kiss_seed(ix, iy, iz, iw)
+      !! --------------------------------------------------------------------
+      !!                  ***  ROUTINE kiss_seed  ***
+      !!
+      !! ** Purpose :   Define seeds for KISS random number generator
+      !!
+      !! --------------------------------------------------------------------
+      IMPLICIT NONE
+      INTEGER(KIND=i8) :: ix, iy, iz, iw
+
+      IF(lwp) WRITE(numout,*) ' *** kiss_seed called with args:'
+      IF(lwp) WRITE(numout,*) ' *** ix = ',ix
+      IF(lwp) WRITE(numout,*) ' *** iy = ',iy
+      IF(lwp) WRITE(numout,*) ' *** iz = ',iz
+      IF(lwp) WRITE(numout,*) ' *** iw = ',iw
+
+      x = ix
+      y = iy
+      z = iz
+      w = iw
+
+   END SUBROUTINE kiss_seed
+
+
+   SUBROUTINE kiss_state(ix, iy, iz, iw)
+      !! --------------------------------------------------------------------
+      !!                  ***  ROUTINE kiss_state  ***
+      !!
+      !! ** Purpose :   Get current state of KISS random number generator
+      !!
+      !! --------------------------------------------------------------------
+      IMPLICIT NONE
+      INTEGER(KIND=i8) :: ix, iy, iz, iw
+
+      ix = x
+      iy = y
+      iz = z
+      iw = w
+
+   END SUBROUTINE kiss_state
+
+
+   SUBROUTINE kiss_reset()
+      !! --------------------------------------------------------------------
+      !!                  ***  ROUTINE kiss_reset  ***
+      !!
+      !! ** Purpose :   Reset the default seeds for KISS random number generator
+      !!
+      !! --------------------------------------------------------------------
+      IMPLICIT NONE
+
+      x=1234567890987654321_8
+      y=362436362436362436_8
+      z=1066149217761810_8
+      w=123456123456123456_8
+
+    END SUBROUTINE kiss_reset
+
+   SUBROUTINE kiss_uniform(uran)
+      !! --------------------------------------------------------------------
+      !!                  ***  ROUTINE kiss_uniform  ***
+      !!
+      !! ** Purpose :   Real random numbers with uniform distribution in [0,1]
+      !!
+      !! --------------------------------------------------------------------
+      IMPLICIT NONE
+      REAL(KIND=wp) :: uran
+
+      uran = half * ( one + REAL(kiss(),wp) / huge64 )
+
+   END SUBROUTINE kiss_uniform
+
+
+   SUBROUTINE kiss_gaussian(gran)
+      !! --------------------------------------------------------------------
+      !!                  ***  ROUTINE kiss_gaussian  ***
+      !!
+      !! ** Purpose :   Real random numbers with Gaussian distribution N(0,1)
+      !!
+      !! ** Method  :   Generate 2 new Gaussian draws (gran1 and gran2)
+      !!                from 2 uniform draws on [-1,1] (u1 and u2),
+      !!                using the Marsaglia polar method
+      !!                (see Devroye, Non-Uniform Random Variate Generation, p. 235-236)
+      !!
+      !! --------------------------------------------------------------------
+      IMPLICIT NONE
+      REAL(KIND=wp) :: gran, u1, u2, rsq, fac
+
+      IF (ig.EQ.1) THEN
+         rsq = two
+         DO WHILE ( (rsq.GE.one).OR. (rsq.EQ.zero) )
+            u1 = REAL(kiss(),wp) / huge64
+            u2 = REAL(kiss(),wp) / huge64
+            rsq = u1*u1 + u2*u2
+         ENDDO
+         fac = SQRT(-two*LOG(rsq)/rsq)
+         gran1 = u1 * fac
+         gran2 = u2 * fac
+      ENDIF
+
+      ! Output one of the 2 draws
+      IF (ig.EQ.1) THEN
+         gran = gran1 ; ig = 2
+      ELSE
+         gran = gran2 ; ig = 1
+      ENDIF
+
+   END SUBROUTINE kiss_gaussian
+
+
+   SUBROUTINE kiss_gamma(gamr,k)
+      !! --------------------------------------------------------------------
+      !!                  ***  ROUTINE kiss_gamma  ***
+      !!
+      !! ** Purpose :   Real random numbers with Gamma distribution Gamma(k,1)
+      !!
+      !! --------------------------------------------------------------------
+      IMPLICIT NONE
+      REAL(KIND=wp), PARAMETER :: p1 = 4.5_8
+      REAL(KIND=wp), PARAMETER :: p2 = 2.50407739677627_8  ! 1+LOG(9/2)
+      REAL(KIND=wp), PARAMETER :: p3 = 1.38629436111989_8  ! LOG(4)
+      REAL(KIND=wp) :: gamr, k, u1, u2, b, c, d, xx, yy, zz, rr, ee
+      LOGICAL :: accepted
+
+      IF (k.GT.one) THEN
+         ! Cheng's rejection algorithm
+         ! (see Devroye, Non-Uniform Random Variate Generation, p. 413)
+         b = k - p3 ; d = SQRT(two*k-one) ; c = k + d
+
+         accepted=.FALSE.
+         DO WHILE (.NOT.accepted)
+            CALL kiss_uniform(u1)
+            yy = LOG(u1/(one-u1)) / d  ! Mistake in Devroye: "* k" instead of "/ d"
+            xx = k * EXP(yy)
+            rr = b + c * yy - xx
+            CALL kiss_uniform(u2)
+            zz = u1 * u1 * u2
+
+            accepted = rr .GE. (zz*p1-p2)
+            IF (.NOT.accepted) accepted =  rr .GE. LOG(zz)
+         ENDDO
+
+         gamr = xx
+
+      ELSEIF (k.LT.one) THEN
+        ! Rejection from the Weibull density
+        ! (see Devroye, Non-Uniform Random Variate Generation, p. 415)
+        c = one/k ; d = (one-k) * EXP( (k/(one-k)) * LOG(k) )
+
+        accepted=.FALSE.
+        DO WHILE (.NOT.accepted)
+           CALL kiss_uniform(u1)
+           zz = -LOG(u1)
+           xx = EXP( c * LOG(zz) )
+           CALL kiss_uniform(u2)
+           ee = -LOG(u2)
+
+           accepted = (zz+ee) .GE. (d+xx)  ! Mistake in Devroye: "LE" instead of "GE"
+        ENDDO
+
+        gamr = xx
+
+      ELSE
+         ! Exponential distribution
+         CALL kiss_uniform(u1)
+         gamr = -LOG(u1)
+
+      ENDIF
+
+   END SUBROUTINE kiss_gamma
+
+
+   SUBROUTINE kiss_sample(a,n,k)
+      !! --------------------------------------------------------------------
+      !!                  ***  ROUTINE kiss_sample  ***
+      !!
+      !! ** Purpose :   Select a random sample of size k from a set of n integers
+      !!
+      !! ** Method  :   The sample is output in the first k elements of a
+      !!                Set k equal to n to obtain a random permutation
+      !!                  of the whole set of integers
+      !!
+      !! --------------------------------------------------------------------
+      IMPLICIT NONE
+      INTEGER(KIND=i8), DIMENSION(:) :: a
+      INTEGER(KIND=i8) :: n, k, i, j, atmp
+      REAL(KIND=wp) :: uran
+
+      ! Select the sample using the swapping method
+      ! (see Devroye, Non-Uniform Random Variate Generation, p. 612)
+      DO i=1,k
+         ! Randomly select the swapping element between i and n (inclusive)
+         CALL kiss_uniform(uran)
+         j = i - 1 + CEILING( REAL(n-i+1,8) * uran )
+         ! Swap elements i and j
+         atmp = a(i) ; a(i) = a(j) ; a(j) = atmp
+      ENDDO
+
+   END SUBROUTINE kiss_sample
+
+#ifdef NEMO_V34
+SUBROUTINE ctl_nam(ier,cstr,lout)
+INTEGER, INTENT(IN)            :: ier
+LOGICAL, INTENT(IN)            :: lout
+CHARACTER(LEN=*),INTENT(IN)    :: cstr
+IF(lout) WRITE(numout,'(A,I4,X,A)') 'Error ',ier,TRIM(cstr)
+END SUBROUTINE
+#endif
+
+END MODULE stopack
Index: branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90	(revision 15582)
+++ branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90	(revision 15603)
@@ -12,5 +12,5 @@
 
    !!----------------------------------------------------------------------
-   !!   tra_bbc      : update the tracer trend at ocean bottom 
+   !!   tra_bbc      : update the tracer trend at ocean bottom
    !!   tra_bbc_init : initialization of geothermal heat flux trend
    !!----------------------------------------------------------------------
@@ -19,5 +19,5 @@
    USE phycst          ! physical constants
    USE trd_oce         ! trends: ocean variables
-   USE trdtra          ! trends manager: tracers 
+   USE trdtra          ! trends manager: tracers
    USE in_out_manager  ! I/O manager
    USE iom             ! I/O manager
@@ -28,4 +28,5 @@
    USE wrk_nemo        ! Memory Allocation
    USE timing          ! Timing
+   USE stopack
 
    IMPLICIT NONE
@@ -41,6 +42,7 @@
 
    REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   qgh_trd0   ! geothermal heating trend
+   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   qgh_trd1   ! geothermal heating trend
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_qgh              ! structure of input qgh (file informations, fields read)
- 
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -56,9 +58,9 @@
       !!                  ***  ROUTINE tra_bbc  ***
       !!
-      !! ** Purpose :   Compute the bottom boundary contition on temperature 
-      !!              associated with geothermal heating and add it to the 
+      !! ** 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 
+      !! ** 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
@@ -89,8 +91,21 @@
       !
       !                             !  Add the geothermal heat flux trend on temperature
+
+#if defined key_traldf_c2d || key_traldf_c3d
+      IF( ln_stopack .AND. nn_spp_geot > 0) THEN
+          qgh_trd1(:,:) = qgh_trd0(:,:)
+          CALL spp_gen(kt, qgh_trd1, nn_spp_geot, rn_geot_sd, jk_spp_geot)
+      ENDIF
+#else
+      IF ( ln_stopack .AND. nn_spp_geot > 0 ) &
+         & CALL ctl_stop( 'tra_bbc: parameter perturbation will only work with '// &
+                          'key_traldf_c2d or key_traldf_c3d')
+#endif
+
+
       DO jj = 2, jpjm1
          DO ji = 2, jpim1
             ik = mbkt(ji,jj)
-            zqgh_trd = qgh_trd0(ji,jj) / fse3t(ji,jj,ik)
+            zqgh_trd = qgh_trd1(ji,jj) / fse3t(ji,jj,ik)
             tsa(ji,jj,ik,jp_tem) = tsa(ji,jj,ik,jp_tem) + zqgh_trd
          END DO
@@ -137,5 +152,5 @@
       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 
+      NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst, sn_qgh, cn_dir
       !!----------------------------------------------------------------------
 
@@ -164,4 +179,5 @@
          !
          ALLOCATE( qgh_trd0(jpi,jpj) )    ! allocation
+         ALLOCATE( qgh_trd1(jpi,jpj) )    ! allocation
          !
          SELECT CASE ( nn_geoflx )        ! geothermal heat flux / (rauO * Cp)
@@ -193,4 +209,5 @@
             !
          END SELECT
+         qgh_trd1(:,:) = qgh_trd0(:,:)
          !
       ELSE
Index: branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90	(revision 15582)
+++ branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90	(revision 15603)
@@ -32,5 +32,5 @@
    USE trdtra         ! trends: active tracers
    !
-   USE iom            ! IOM library               
+   USE iom            ! IOM library
    USE in_out_manager ! I/O manager
    USE lbclnk         ! ocean lateral boundary conditions
@@ -38,5 +38,6 @@
    USE wrk_nemo       ! Memory Allocation
    USE timing         ! Timing
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE stopack
 
    IMPLICIT NONE
@@ -67,4 +68,5 @@
    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(:,:)         ::   ahu_bbl_1, ahv_bbl_1   ! 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)
 
@@ -86,4 +88,5 @@
          &      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) ,                                          &
+         &      ahu_bbl_1(jpi,jpj) , ahv_bbl_1(jpi,jpj) ,                                          &
          &      e3u_bbl_0(jpi,jpj) , e3v_bbl_0(jpi,jpj) ,                                      STAT=tra_bbl_alloc )
          !
@@ -195,4 +198,28 @@
       ALLOCATE(zptb(1:jpi, 1:jpj))
       !
+      ahu_bbl_1(:,:) = ahu_bbl(:,:)
+#if defined key_traldf_c2d || key_traldf_c3d
+      IF( ln_stopack .AND. nn_spp_ahubbl > 0 ) THEN
+          CALL spp_gen(1, ahu_bbl_1, nn_spp_ahubbl, rn_ahubbl_sd, jk_spp_ahubbl )
+      ENDIF
+#else
+      IF ( ln_stopack .AND. nn_spp_ahubbl > 0 ) &
+         & CALL ctl_stop( 'tra_bbl_dif: parameter perturbation will only work with '// &
+                          'key_traldf_c2d or key_traldf_c3d')
+#endif
+
+
+      ahv_bbl_1(:,:) = ahv_bbl(:,:)
+#if defined key_traldf_c2d || key_traldf_c3d
+      IF( ln_stopack .AND. nn_spp_ahvbbl > 0 ) THEN
+          CALL spp_gen(1, ahv_bbl_1, nn_spp_ahvbbl, rn_ahvbbl_sd, jk_spp_ahvbbl )
+      ENDIF
+#else
+      IF ( ln_stopack .AND. nn_spp_ahvbbl > 0 ) &
+         & CALL ctl_stop( 'tra_bbl_dif: parameter perturbation will only work with '// &
+                          'key_traldf_c2d or key_traldf_c3d')
+#endif
+
+      !
       DO jn = 1, kjpt                                     ! tracer loop
          !                                                ! ===========
@@ -203,5 +230,5 @@
             END DO
          END DO
-         !               
+         !
          DO jj = 2, jpjm1                                    ! Compute the trend
             DO ji = 2, jpim1
@@ -209,8 +236,8 @@
                zbtr = r1_e12t(ji,jj)  / fse3t(ji,jj,ik)
                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) )   ) * zbtr
+                  &               + (   ahu_bbl_1(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )   &
+                  &                   - ahu_bbl_1(ji-1,jj  ) * ( zptb(ji  ,jj  ) - zptb(ji-1,jj  ) )   &
+                  &                   + ahv_bbl_1(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )   &
+                  &                   - ahv_bbl_1(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )   ) * zbtr
             END DO
          END DO
@@ -415,5 +442,5 @@
                   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 
+                  !                                                          ! 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)
@@ -578,5 +605,5 @@
                gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) )  )
             ENDIF
-            !     
+            !
             IF( gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) /= 0._wp ) THEN
                mgrhv(ji,jj) = INT(  SIGN( 1.e0, &
@@ -598,5 +625,4 @@
       ahu_bbl_0(:,:) = rn_ahtbbl * e2u(:,:) * e3u_bbl_0(:,:) / e1u(:,:)  * umask(:,:,1)
       ahv_bbl_0(:,:) = rn_ahtbbl * e1v(:,:) * e3v_bbl_0(:,:) / e2v(:,:)  * vmask(:,:,1)
-
 
       IF( cp_cfg == "orca" ) THEN   !* ORCA configuration : regional enhancement of ah_bbl
Index: branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90	(revision 15582)
+++ branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90	(revision 15603)
@@ -32,4 +32,5 @@
    USE wrk_nemo        ! Memory allocation
    USE timing          ! Timing
+   USE stopack
 
    IMPLICIT NONE
@@ -43,4 +44,10 @@
    REAL, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   t0_ldf, s0_ldf   !: lateral diffusion trends of T & S for a cst profile
    !                                                               !  (key_traldf_ano only)
+#if defined key_traldf_c3d
+   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: ahtu0, ahtv0, ahtw0, ahtt0
+#endif
+#if defined key_traldf_c2d
+   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:  ) :: ahtu0, ahtv0, ahtw0, ahtt0
+#endif
 
    !! * Substitutions
@@ -75,4 +82,47 @@
          ztrds(:,:,:) = tsa(:,:,:,jp_sal)
       ENDIF
+
+#if defined key_traldf_c3d
+         IF(  ( kt == nit000 ) .AND. &
+            & ( ln_stopack )   .AND. &
+            & ( ( nn_spp_ahtu + nn_spp_ahtv + nn_spp_ahtw + nn_spp_ahtt ) > 0 ) ) THEN
+             ALLOCATE ( ahtu0(jpi,jpj,jpk), ahtv0(jpi,jpj,jpk) )
+             ALLOCATE ( ahtt0(jpi,jpj,jpk), ahtw0(jpi,jpj,jpk) )
+             ahtu0 = ahtu
+             ahtv0 = ahtv
+             ahtw0 = ahtw
+             ahtt0 = ahtt
+         ENDIF
+#endif
+#if defined key_traldf_c2d
+         IF(  ( kt == nit000 ) .AND. &
+            & ( ln_stopack )   .AND. &
+            & ( ( nn_spp_ahtu + nn_spp_ahtv + nn_spp_ahtw + nn_spp_ahtt ) > 0 ) ) THEN
+             ALLOCATE ( ahtu0(jpi,jpj), ahtv0(jpi,jpj) )
+             ALLOCATE ( ahtt0(jpi,jpj), ahtw0(jpi,jpj) )
+             ahtu0 = ahtu
+             ahtv0 = ahtv
+             ahtw0 = ahtw
+             ahtt0 = ahtt
+         ENDIF
+#endif
+#if defined key_traldf_c3d || defined key_traldf_c2d
+         IF( ln_stopack .AND. ( nn_spp_ahtu > 0 ) ) THEN
+             ahtu = ahtu0
+             CALL spp_aht(kt, ahtu, nn_spp_ahtu, rn_ahtu_sd, jk_spp_ahtu)
+         ENDIF
+         IF( ln_stopack .AND. ( nn_spp_ahtv > 0 ) ) THEN
+             ahtv = ahtv0
+             CALL spp_aht(kt, ahtv, nn_spp_ahtv, rn_ahtv_sd, jk_spp_ahtv)
+         ENDIF
+         IF( ln_stopack .AND. ( nn_spp_ahtw > 0 ) ) THEN
+             ahtw = ahtw0
+             CALL spp_aht(kt, ahtw, nn_spp_ahtw, rn_ahtw_sd, jk_spp_ahtw)
+         ENDIF
+         IF( ln_stopack .AND. ( nn_spp_ahtt > 0 ) ) THEN
+             ahtt = ahtt0
+             CALL spp_aht(kt, ahtt, nn_spp_ahtt, rn_ahtt_sd, jk_spp_ahtt)
+         ENDIF
+#endif
 
       SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend
Index: branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 15582)
+++ branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 15603)
@@ -9,6 +9,6 @@
    !!   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.4  !  2012-05  (C. Rousset) store attenuation coef for use in ice model 
+   !!            3.2  !  2009-04  (G. Madec & NEMO team)
+   !!            3.4  !  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
    !!----------------------------------------------------------------------
@@ -33,4 +33,5 @@
    USE wrk_nemo       ! Memory Allocation
    USE timing         ! Timing
+   USE stopack
 
    IMPLICIT NONE
@@ -42,5 +43,5 @@
    !                                 !!* 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_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
@@ -50,7 +51,7 @@
    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)
- 
+
    ! Module variables
-   REAL(wp) ::   xsi0r                           !: inverse of rn_si0
+   REAL(wp), ALLOCATABLE ::   xsi0r(:,:)         !: inverse of rn_si0
    REAL(wp) ::   xsi1r                           !: inverse of rn_si1
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_chl   ! structure of input Chl (file informations, fields read)
@@ -79,5 +80,5 @@
       !!      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 
+      !!         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 :
@@ -85,5 +86,5 @@
       !!      in the last ocean level.
       !!         In z-coordinate case, the computation is only done down to the
-      !!      level where I(k) < 1.e-15 W/m2. In addition, the coefficients 
+      !!      level where I(k) < 1.e-15 W/m2. In addition, the coefficients
       !!      used for the computation are calculated one for once as they
       !!      depends on k only.
@@ -105,5 +106,5 @@
       REAL(wp) ::   zz0, zz1, z1_e3t     !    -         -
       REAL(wp) ::   zCb, zCmax, zze, zpsi, zpsimax, zdelpsi, zCtot, zCze
-      REAL(wp) ::   zlogc, zlogc2, zlogc3 
+      REAL(wp) ::   zlogc, zlogc2, zlogc3
       REAL(wp), POINTER, DIMENSION(:,:  ) :: zekb, zekg, zekr
       REAL(wp), POINTER, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt, zchl3d
@@ -112,6 +113,6 @@
       IF( nn_timing == 1 )  CALL timing_start('tra_qsr')
       !
-      CALL wrk_alloc( jpi, jpj,      zekb, zekg, zekr        ) 
-      CALL wrk_alloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea, zchl3d ) 
+      CALL wrk_alloc( jpi, jpj,      zekb, zekg, zekr        )
+      CALL wrk_alloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea, zchl3d )
       !
       IF( kt == nit000 ) THEN
@@ -124,5 +125,5 @@
 
       IF( l_trdtra ) THEN      ! Save ta and sa trends
-         CALL wrk_alloc( jpi, jpj, jpk, ztrdt ) 
+         CALL wrk_alloc( jpi, jpj, jpk, ztrdt )
          ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
       ENDIF
@@ -153,5 +154,5 @@
       !                                        Compute now qsr tracer content field
       !                                        ************************************
-      
+
       !                                           ! ============================================== !
       IF( lk_qsr_bio .AND. ln_qsr_bio ) THEN      !  bio-model fluxes  : all vertical coordinates  !
@@ -162,5 +163,5 @@
          !                                        Add to the general trend
          DO jk = 1, jpkm1
-            DO jj = 2, jpjm1 
+            DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   z1_e3t = zfact / fse3t(ji,jj,jk)
@@ -183,8 +184,21 @@
          ENDIF
          !                                        ! ============================================== !
-      ELSE                                        !  Ocean alone : 
+      ELSE                                        !  Ocean alone :
          !                                        ! ============================================== !
          !
-         !                                                ! ------------------------- !
+         !
+#if defined key_traldf_c2d || key_traldf_c3d
+         IF( ln_stopack .AND. ( nn_spp_qsi0 > 0 ) ) THEN
+            xsi0r = rn_si0
+            CALL spp_gen(kt, xsi0r, nn_spp_qsi0, rn_qsi0_sd, jk_spp_qsi0 )
+            xsi0r = 1.e0 / xsi0r
+         ENDIF
+#else
+         IF ( ln_stopack .AND. nn_spp_qsi0 > 0 ) &
+            & CALL ctl_stop( 'tra_qsr: parameter perturbation will only work with '// &
+                             'key_traldf_c2d or key_traldf_c3d')
+#endif
+
+         !                                               ! ------------------------- !
          IF( ln_qsr_rgb) THEN                             !  R-G-B  light penetration !
             !                                             ! ------------------------- !
@@ -196,5 +210,5 @@
                   CALL fld_read( kt, 1, sf_chl )            ! Read Chl data and provides it at the current time step
                   DO jk = 1, nksr + 1
-                     zchl3d(:,:,jk) = sf_chl(1)%fnow(:,:,1) 
+                     zchl3d(:,:,jk) = sf_chl(1)%fnow(:,:,1)
                   ENDDO
                   !
@@ -217,5 +231,5 @@
                         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 
+                        zCze    = 1.12  * (zchl)**0.803
                         DO jk = 1, nksr + 1
                            zpsi = fsdept(ji,jj,jk) / zze
@@ -228,5 +242,5 @@
                ELSE                              !* Variable ocean volume but constant chrlorophyll
                   DO jk = 1, nksr + 1
-                     zchl3d(:,:,jk) = 0.05 
+                     zchl3d(:,:,jk) = 0.05
                   ENDDO
                ENDIF
@@ -253,7 +267,7 @@
 !CDIR NOVERRCHK
                   DO jj = 1, jpj
-!CDIR NOVERRCHK   
-                     DO ji = 1, jpi
-                        zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * xsi0r     )
+!CDIR NOVERRCHK
+                     DO ji = 1, jpi
+                        zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * xsi0r(ji,jj) )
                         zc1 = ze1(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekb(ji,jj) )
                         zc2 = ze2(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekg(ji,jj) )
@@ -286,12 +300,12 @@
                      END DO
                   END DO
-                  ! 
+                  !
                   DO jj = 1, jpj
                      DO ji = 1, jpi
-                        zc0 = rn_abs * EXP( - fse3t(ji,jj,1) * xsi0r     )
+                        zc0 = rn_abs * EXP( - fse3t(ji,jj,1) * xsi0r(ji,jj) )
                         zc1 = zcoef  * EXP( - fse3t(ji,jj,1) * zekb(ji,jj) )
                         zc2 = zcoef  * EXP( - fse3t(ji,jj,1) * zekg(ji,jj) )
                         zc3 = zcoef  * EXP( - fse3t(ji,jj,1) * zekr(ji,jj) )
-                        fraqsr_1lev(ji,jj) = 1.0 - ( zc0 + zc1 + zc2  + zc3  ) * tmask(ji,jj,2) 
+                        fraqsr_1lev(ji,jj) = 1.0 - ( zc0 + zc1 + zc2  + zc3  ) * tmask(ji,jj,2)
                      END DO
                   END DO
@@ -314,13 +328,14 @@
             !                                             ! ------------------------- !
             !
-            IF( lk_vvl ) THEN                                  !* variable volume
+            IF( lk_vvl .OR. ( ln_stopack .AND. ( nn_spp_qsi0 > 0 ) ) ) THEN        !* variable volume
+
                zz0   =        rn_abs   * r1_rau0_rcp
                zz1   = ( 1. - rn_abs ) * r1_rau0_rcp
-               DO jk = 1, nksr                    ! solar heat absorbed at T-point in the top 400m 
+               DO jk = 1, nksr                    ! solar heat absorbed at T-point in the top 400m
                   DO jj = 1, jpj
                      DO ji = 1, jpi
-                        zc0 = zz0 * EXP( -fsdepw(ji,jj,jk  )*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk  )*xsi1r )
-                        zc1 = zz0 * EXP( -fsdepw(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r )
-                        qsr_hc(ji,jj,jk) = qsr(ji,jj) * ( zc0*tmask(ji,jj,jk) - zc1*tmask(ji,jj,jk+1) ) 
+                        zc0 = zz0 * EXP( -fsdepw(ji,jj,jk  )*xsi0r(ji,jj) ) + zz1 * EXP( -fsdepw(ji,jj,jk  )*xsi1r )
+                        zc1 = zz0 * EXP( -fsdepw(ji,jj,jk+1)*xsi0r(ji,jj) ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r )
+                        qsr_hc(ji,jj,jk) = qsr(ji,jj) * ( zc0*tmask(ji,jj,jk) - zc1*tmask(ji,jj,jk+1) )
                      END DO
                   END DO
@@ -330,6 +345,6 @@
                   DO jj = 1, jpj
                      DO ji = 1, jpi
-                        zc0 = zz0 * EXP( -fsdepw(ji,jj,1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,1)*xsi1r )
-                        zc1 = zz0 * EXP( -fsdepw(ji,jj,2)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,2)*xsi1r )
+                        zc0 = zz0 * EXP( -fsdepw(ji,jj,1)*xsi0r(ji,jj) ) + zz1 * EXP( -fsdepw(ji,jj,1)*xsi1r )
+                        zc1 = zz0 * EXP( -fsdepw(ji,jj,2)*xsi0r(ji,jj) ) + zz1 * EXP( -fsdepw(ji,jj,2)*xsi1r )
                         fraqsr_1lev(ji,jj) = ( zc0*tmask(ji,jj,1) - zc1*tmask(ji,jj,2) ) / r1_rau0_rcp
                      END DO
@@ -340,5 +355,5 @@
                   DO jj = 2, jpjm1
                      DO ji = fs_2, fs_jpim1   ! vector opt.
-                        ! (ISF) no light penetration below the ice shelves         
+                        ! (ISF) no light penetration below the ice shelves
                         qsr_hc(ji,jj,jk) =  etot3(ji,jj,jk) * qsr(ji,jj) * tmask(ji,jj,1)
                      END DO
@@ -356,5 +371,5 @@
          !                                        Add to the general trend
          DO jk = 1, nksr
-            DO jj = 2, jpjm1 
+            DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   z1_e3t = zfact / fse3t(ji,jj,jk)
@@ -375,7 +390,7 @@
             IF(lflush) CALL flush(numout)
          ENDIF
-         IF(nn_timing == 2)  CALL timing_start('iom_rstput') 
+         IF(nn_timing == 2)  CALL timing_start('iom_rstput')
          CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b'   , qsr_hc      )
-         CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev )   ! default definition in sbcssm 
+         CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev )   ! default definition in sbcssm
          IF(nn_timing == 2)  CALL timing_stop('iom_rstput')
          !
@@ -385,11 +400,11 @@
          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
          CALL trd_tra( kt, 'TRA', jp_tem, jptra_qsr, ztrdt )
-         CALL wrk_dealloc( jpi, jpj, jpk, 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' )
       !
-      CALL wrk_dealloc( jpi, jpj,      zekb, zekg, zekr        ) 
-      CALL wrk_dealloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea, zchl3d ) 
+      CALL wrk_dealloc( jpi, jpj,      zekb, zekg, zekr        )
+      CALL wrk_dealloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea, zchl3d )
       !
       IF( nn_timing == 1 )  CALL timing_stop('tra_qsr')
@@ -407,5 +422,5 @@
       !!      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' 
+      !!      default values correspond to clear water (type I in Jerlov'
       !!      (1968) classification.
       !!         called by tra_qsr at the first timestep (nit000)
@@ -434,6 +449,6 @@
       IF( nn_timing == 1 )  CALL timing_start('tra_qsr_init')
       !
-      CALL wrk_alloc( jpi, jpj,      zekb, zekg, zekr        ) 
-      CALL wrk_alloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea ) 
+      CALL wrk_alloc( jpi, jpj,      zekb, zekg, zekr        )
+      CALL wrk_alloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea )
       !
 
@@ -465,5 +480,5 @@
 
       IF( ln_traqsr ) THEN     ! control consistency
-         !                      
+         !
          IF( .NOT.lk_qsr_bio .AND. ln_qsr_bio )   THEN
             CALL ctl_warn( 'No bio model : force ln_qsr_bio = FALSE ' )
@@ -480,5 +495,5 @@
             &              ' 2 bands, 3 RGB bands or bio-model light penetration' )
          !
-         IF( ln_qsr_rgb .AND. nn_chldta == 0 )   nqsr =  1 
+         IF( ln_qsr_rgb .AND. nn_chldta == 0 )   nqsr =  1
          IF( ln_qsr_rgb .AND. nn_chldta == 1 )   nqsr =  2
          IF( ln_qsr_rgb .AND. nn_chldta == 2 )   nqsr =  3
@@ -498,7 +513,8 @@
       ENDIF
       !                          ! ===================================== !
-      IF( ln_traqsr  ) THEN      !  Initialisation of Light Penetration  !  
+      IF( ln_traqsr  ) THEN      !  Initialisation of Light Penetration  !
          !                       ! ===================================== !
          !
+         ALLOCATE( xsi0r(jpi,jpj) )
          xsi0r = 1.e0 / rn_si0
          xsi1r = 1.e0 / rn_si1
@@ -539,5 +555,5 @@
                   zchl = 0.05                                 ! constant chlorophyll
                   irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 )
-                  zekb(:,:) = rkrgb(1,irgb)                   ! Separation in R-G-B depending of the chlorophyll 
+                  zekb(:,:) = rkrgb(1,irgb)                   ! Separation in R-G-B depending of the chlorophyll
                   zekg(:,:) = rkrgb(2,irgb)
                   zekr(:,:) = rkrgb(3,irgb)
@@ -546,14 +562,14 @@
                   ze0(:,:,1) = rn_abs
                   ze1(:,:,1) = zcoef
-                  ze2(:,:,1) = zcoef 
+                  ze2(:,:,1) = zcoef
                   ze3(:,:,1) = zcoef
                   zea(:,:,1) = tmask(:,:,1)                   ! = ( ze0+ze1+z2+ze3 ) * tmask
-               
+
                   DO jk = 2, nksr+1
 !CDIR NOVERRCHK
                      DO jj = 1, jpj
-!CDIR NOVERRCHK   
+!CDIR NOVERRCHK
                         DO ji = 1, jpi
-                           zc0 = ze0(ji,jj,jk-1) * EXP( - e3t_0(ji,jj,jk-1) * xsi0r     )
+                           zc0 = ze0(ji,jj,jk-1) * EXP( - e3t_0(ji,jj,jk-1) * xsi0r(ji,jj) )
                            zc1 = ze1(ji,jj,jk-1) * EXP( - e3t_0(ji,jj,jk-1) * zekb(ji,jj) )
                            zc2 = ze2(ji,jj,jk-1) * EXP( - e3t_0(ji,jj,jk-1) * zekg(ji,jj) )
@@ -566,5 +582,5 @@
                         END DO
                      END DO
-                  END DO 
+                  END DO
                   !
                   DO jk = 1, nksr
@@ -600,7 +616,7 @@
                   DO jj = 1, jpj                              ! top 400 meters
                      DO ji = 1, jpi
-                        zc0 = zz0 * EXP( -fsdepw(ji,jj,jk  )*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk  )*xsi1r )
-                        zc1 = zz0 * EXP( -fsdepw(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r )
-                        etot3(ji,jj,jk) = (  zc0 * tmask(ji,jj,jk) - zc1 * tmask(ji,jj,jk+1)  ) * tmask(ji,jj,1) 
+                        zc0 = zz0 * EXP( -fsdepw(ji,jj,jk  )*xsi0r(ji,jj) ) + zz1 * EXP( -fsdepw(ji,jj,jk  )*xsi1r )
+                        zc1 = zz0 * EXP( -fsdepw(ji,jj,jk+1)*xsi0r(ji,jj) ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r )
+                        etot3(ji,jj,jk) = (  zc0 * tmask(ji,jj,jk) - zc1 * tmask(ji,jj,jk+1)  ) * tmask(ji,jj,1)
                      END DO
                   END DO
@@ -611,5 +627,5 @@
          ENDIF
          !                       ! ===================================== !
-      ELSE                       !        No light penetration           !                   
+      ELSE                       !        No light penetration           !
          !                       ! ===================================== !
          IF(lwp) THEN
@@ -617,5 +633,5 @@
             WRITE(numout,*) 'tra_qsr_init : NO solar flux penetration'
             WRITE(numout,*) '~~~~~~~~~~~~'
-            IF(lflush) CALL flush(numout)
+            IF(lflush) CALL flush(numout)            
          ENDIF
       ENDIF
@@ -630,6 +646,6 @@
       ENDIF
       !
-      CALL wrk_dealloc( jpi, jpj,      zekb, zekg, zekr        ) 
-      CALL wrk_dealloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea ) 
+      CALL wrk_dealloc( jpi, jpj,      zekb, zekg, zekr        )
+      CALL wrk_dealloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea )
       !
       IF( nn_timing == 1 )  CALL timing_stop('tra_qsr_init')
Index: branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/TRD/trddyn.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/TRD/trddyn.F90	(revision 15582)
+++ branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/TRD/trddyn.F90	(revision 15603)
@@ -29,4 +29,5 @@
    USE lib_mpp        ! MPP library
    USE wrk_nemo       ! Memory allocation
+   USE stopack     
 
    IMPLICIT NONE
@@ -68,4 +69,6 @@
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
       IF( ln_dyn_trd )   CALL trd_dyn_iom( putrd, pvtrd, ktrd, kt )
+      IF( ln_dyn_trd .AND. ln_stopack .AND. ln_sppt_dyn ) &
+         & CALL dyn_sppt_collect( putrd, pvtrd, ktrd, kt )
          
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Index: branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90	(revision 15582)
+++ branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90	(revision 15603)
@@ -32,4 +32,5 @@
    USE iom            ! I/O manager library
    USE lib_mpp        ! MPP library
+   USE stopack
    USE wrk_nemo       ! Memory allocation
 
@@ -271,6 +272,8 @@
       !                   ! 3D output of tracers trends using IOM interface
       IF( ln_tra_trd )   CALL trd_tra_iom ( ptrdx, ptrdy, ktrd, kt )
-
-      !                   ! Integral Constraints Properties for tracers trends                                       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF( ln_tra_trd .AND. ln_stopack .AND. ln_sppt_tra )  &
+         & CALL tra_sppt_collect( ptrdx, ptrdy, ktrd, kt )
+
+      !  Integral Constraints Properties for tracers trends                                       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
       IF( ln_glo_trd )   CALL trd_glo( ptrdx, ptrdy, ktrd, 'TRA', kt )
 
Index: branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90	(revision 15582)
+++ branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90	(revision 15603)
@@ -26,4 +26,5 @@
    USE wrk_nemo        ! Memory Allocation
    USE phycst, ONLY: vkarmn
+   USE stopack
 
    IMPLICIT NONE
@@ -52,5 +53,5 @@
    REAL(wp), PUBLIC ::   rn_tfrz0     ! bottom roughness for loglayer bfr coeff (PUBLIC for TAM)
    LOGICAL , PUBLIC ::   ln_bfrimp    ! logical switch for implicit bottom friction
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::  bfrcoef2d, tfrcoef2d   ! 2D bottom/top drag coefficient (PUBLIC for TAM)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::  bfrcoef2d, tfrcoef2d,bfrcoef2d0   ! 2D bottom/top drag coefficient (PUBLIC for TAM)
 
    !! * Substitutions
@@ -68,5 +69,5 @@
       !!                ***  FUNCTION zdf_bfr_alloc  ***
       !!----------------------------------------------------------------------
-      ALLOCATE( bfrcoef2d(jpi,jpj), tfrcoef2d(jpi,jpj), STAT=zdf_bfr_alloc )
+      ALLOCATE( bfrcoef2d(jpi,jpj), tfrcoef2d(jpi,jpj), bfrcoef2d0(jpi,jpj),STAT=zdf_bfr_alloc )
       !
       IF( lk_mpp             )   CALL mpp_sum ( zdf_bfr_alloc )
@@ -107,4 +108,15 @@
          IF(lflush) CALL flush(numout)
       ENDIF
+      !
+#if defined key_traldf_c2d || key_traldf_c3d
+      IF( ln_stopack .AND. ( nn_spp_bfr > 0 ) ) THEN
+         bfrcoef2d = bfrcoef2d0
+         CALL spp_gen(kt, bfrcoef2d, nn_spp_bfr, rn_bfr_sd, jk_spp_bfr)
+      ENDIF
+#else
+      IF ( ln_stopack .AND. ( nn_spp_bfr > 0 ) ) &
+         & CALL ctl_stop( 'zdf_bfr: parameter perturbation will only work with '// &
+                          'key_traldf_c2d or key_traldf_c3d')
+#endif
       !
       IF( nn_bfr == 2 ) THEN                 ! quadratic bottom friction only
@@ -135,5 +147,5 @@
                END DO
             END IF
-         !   
+         !
          ELSE
             zbfrt(:,:) = bfrcoef2d(:,:)
@@ -178,5 +190,5 @@
                DO ji = 2, jpim1
                   ! (ISF) ========================================================================
-                  ikbu = miku(ji,jj)         ! ocean top level at u- and v-points 
+                  ikbu = miku(ji,jj)         ! ocean top level at u- and v-points
                   ikbv = mikv(ji,jj)         ! (1st wet ocean u- and v-points)
                   !
@@ -359,5 +371,5 @@
             bfrcoef2d(:,:) = rn_bfri2  ! initialize bfrcoef2d to the namelist variable
          ENDIF
-         
+
          IF ( ln_isfcav ) THEN
             IF(ln_tfr2d) THEN
@@ -494,4 +506,5 @@
       ENDIF
       !
+      bfrcoef2d0(:,:) = bfrcoef2d(:,:)
       IF( nn_timing == 1 )  CALL timing_stop('zdf_bfr_init')
       !
Index: branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90	(revision 15582)
+++ branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90	(revision 15603)
@@ -20,9 +20,10 @@
    USE zdfkpp          ! KPP vertical mixing
    USE trd_oce         ! trends: ocean variables
-   USE trdtra          ! trends manager: tracers 
+   USE trdtra          ! trends manager: tracers
    USE in_out_manager  ! I/O manager
    USE iom             ! for iom_put
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE timing          ! Timing
+   USE stopack
 
    IMPLICIT NONE
@@ -30,4 +31,5 @@
 
    PUBLIC   zdf_evd    ! called by step.F90
+   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: rn_avevd0
 
    !! * Substitutions
@@ -43,10 +45,10 @@
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE zdf_evd  ***
-      !!                   
+      !!
       !! ** Purpose :   Local increased the vertical eddy viscosity and diffu-
       !!      sivity coefficients when a static instability is encountered.
       !!
       !! ** Method  :   avt, avm, and the 4 neighbouring avmu, avmv coefficients
-      !!      are set to avevd (namelist parameter) if the water column is 
+      !!      are set to avevd (namelist parameter) if the water column is
       !!      statically unstable (i.e. if rn2 < -1.e-12 )
       !!
@@ -70,7 +72,20 @@
          IF(lwp) WRITE(numout,*)
          IF(lwp .AND. lflush) CALL flush(numout)
+         ALLOCATE ( rn_avevd0(jpi,jpj) )
+         rn_avevd0(:,:) = rn_avevd
       ENDIF
 
       zavt_evd(:,:,:) = avt(:,:,:)           ! set avt prior to evd application
+
+#if defined key_traldf_c2d || key_traldf_c3d
+      IF( ln_stopack .AND. ( nn_spp_aevd > 0 ) ) THEN
+         rn_avevd0(:,:) = rn_avevd
+         CALL spp_gen(kt, rn_avevd0, nn_spp_aevd, rn_aevd_sd, jk_spp_aevd)
+      ENDIF
+#else
+      IF ( ln_stopack .AND. ( nn_spp_aevd > 0 ) ) &
+         & CALL ctl_stop( 'zdf_evd: parameter perturbation will only work with '// &
+                          'key_traldf_c2d or key_traldf_c3d')
+#endif
 
       SELECT CASE ( nn_evdm )
@@ -80,5 +95,5 @@
          zavm_evd(:,:,:) = avm(:,:,:)           ! set avm prior to evd application
          !
-         DO jk = 1, jpkm1 
+         DO jk = 1, jpkm1
             DO jj = 2, jpj             ! no vector opt.
                DO ji = 2, jpi
@@ -89,14 +104,14 @@
                   IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) THEN
 #endif
-                     avt (ji  ,jj  ,jk) = rn_avevd * tmask(ji  ,jj  ,jk)
-                     avm (ji  ,jj  ,jk) = rn_avevd * tmask(ji  ,jj  ,jk)
-                     avmu(ji  ,jj  ,jk) = rn_avevd * umask(ji  ,jj  ,jk)
-                     avmu(ji-1,jj  ,jk) = rn_avevd * umask(ji-1,jj  ,jk)
-                     avmv(ji  ,jj  ,jk) = rn_avevd * vmask(ji  ,jj  ,jk)
-                     avmv(ji  ,jj-1,jk) = rn_avevd * vmask(ji  ,jj-1,jk)
+                     avt (ji  ,jj  ,jk) = rn_avevd0(ji,jj) * tmask(ji  ,jj  ,jk)
+                     avm (ji  ,jj  ,jk) = rn_avevd0(ji,jj) * tmask(ji  ,jj  ,jk)
+                     avmu(ji  ,jj  ,jk) = rn_avevd0(ji,jj) * umask(ji  ,jj  ,jk)
+                     avmu(ji-1,jj  ,jk) = rn_avevd0(ji,jj) * umask(ji-1,jj  ,jk)
+                     avmv(ji  ,jj  ,jk) = rn_avevd0(ji,jj) * vmask(ji  ,jj  ,jk)
+                     avmv(ji  ,jj-1,jk) = rn_avevd0(ji,jj) * vmask(ji  ,jj-1,jk)
                   ENDIF
                END DO
             END DO
-         END DO 
+         END DO
          CALL lbc_lnk( avt , 'W', 1. )   ;   CALL lbc_lnk( avm , 'W', 1. )   ! Lateral boundary conditions
          CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. )
@@ -105,21 +120,21 @@
          CALL iom_put( "avm_evd", zavm_evd )              ! output this change
          !
-      CASE DEFAULT         ! enhance vertical eddy diffusivity only (if rn2<-1.e-12) 
+      CASE DEFAULT         ! enhance vertical eddy diffusivity only (if rn2<-1.e-12)
          DO jk = 1, jpkm1
-!!!         WHERE( rn2(:,:,jk) <= -1.e-12 ) avt(:,:,jk) = tmask(:,:,jk) * avevd   ! agissant sur T SEUL! 
+!!!         WHERE( rn2(:,:,jk) <= -1.e-12 ) avt(:,:,jk) = tmask(:,:,jk) * avevd   ! agissant sur T SEUL!
             DO jj = 1, jpj             ! loop over the whole domain (no lbc_lnk call)
                DO ji = 1, jpi
 #if defined key_zdfkpp
                   ! no evd mixing in the boundary layer with KPP
-                  IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12  .AND.  fsdepw(ji,jj,jk) > hkpp(ji,jj)  )   &          
+                  IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12  .AND.  fsdepw(ji,jj,jk) > hkpp(ji,jj)  )   &
 #else
                   IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 )   &
 #endif
-                     avt(ji,jj,jk) = rn_avevd * tmask(ji,jj,jk)
+                     avt(ji,jj,jk) = rn_avevd0(ji,jj) * tmask(ji,jj,jk)
                END DO
             END DO
          END DO
          !
-      END SELECT 
+      END SELECT
 
       zavt_evd(:,:,:) = avt(:,:,:) - zavt_evd(:,:,:)   ! change in avt due to evd
Index: branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90	(revision 15582)
+++ branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90	(revision 15603)
@@ -2,5 +2,5 @@
    !!======================================================================
    !!                       ***  MODULE  zdfgls  ***
-   !! Ocean physics:  vertical mixing coefficient computed from the gls 
+   !! Ocean physics:  vertical mixing coefficient computed from the gls
    !!                 turbulent closure parameterization
    !!======================================================================
@@ -16,5 +16,5 @@
    !!   gls_rst       : read/write gls restart in ocean restart file
    !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and active tracers 
+   USE oce            ! ocean dynamics and active tracers
    USE dom_oce        ! ocean space and time domain
    USE domvvl         ! ocean space and time domain : variable volume layer
@@ -31,5 +31,6 @@
    USE iom            ! I/O manager library
    USE timing         ! Timing
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE stopack
 
    IMPLICIT NONE
@@ -61,9 +62,9 @@
    REAL(wp) ::   rn_crban          ! Craig and Banner constant for surface breaking waves mixing
    REAL(wp) ::   rn_hsro           ! Minimum surface roughness
-   REAL(wp) ::   rn_frac_hs        ! Fraction of wave height as surface roughness (if nn_z0_met > 1) 
+   REAL(wp) ::   rn_frac_hs        ! Fraction of wave height as surface roughness (if nn_z0_met > 1)
 
    REAL(wp) ::   rcm_sf        =  0.73_wp     ! Shear free turbulence parameters
-   REAL(wp) ::   ra_sf         = -2.0_wp      ! Must be negative -2 < ra_sf < -1 
-   REAL(wp) ::   rl_sf         =  0.2_wp      ! 0 <rl_sf<vkarmn    
+   REAL(wp) ::   ra_sf         = -2.0_wp      ! Must be negative -2 < ra_sf < -1
+   REAL(wp) ::   rl_sf         =  0.2_wp      ! 0 <rl_sf<vkarmn
    REAL(wp) ::   rghmin        = -0.28_wp
    REAL(wp) ::   rgh0          =  0.0329_wp
@@ -72,6 +73,6 @@
    REAL(wp) ::   ra2           =  0.74_wp
    REAL(wp) ::   rb1           = 16.60_wp
-   REAL(wp) ::   rb2           = 10.10_wp         
-   REAL(wp) ::   re2           =  1.33_wp         
+   REAL(wp) ::   rb2           = 10.10_wp
+   REAL(wp) ::   re2           =  1.33_wp
    REAL(wp) ::   rl1           =  0.107_wp
    REAL(wp) ::   rl2           =  0.0032_wp
@@ -133,5 +134,5 @@
       INTEGER  ::   ji, jj, jk, ibot, ibotm1, dir  ! dummy loop arguments
       REAL(wp) ::   zesh2, zsigpsi, zcoef, zex1, zex2   ! local scalars
-      REAL(wp) ::   ztx2, zty2, zup, zdown, zcof        !   -      - 
+      REAL(wp) ::   ztx2, zty2, zup, zdown, zcof        !   -      -
       REAL(wp) ::   zratio, zrn2, zflxb, sh             !   -      -
       REAL(wp) ::   prod, buoy, diss, zdiss, sm         !   -      -
@@ -139,5 +140,5 @@
       REAL(wp), POINTER, DIMENSION(:,:  ) ::   zdep
       REAL(wp), POINTER, DIMENSION(:,:  ) ::   zkar
-      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zflxs       ! Turbulence fluxed induced by internal waves 
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zflxs       ! Turbulence fluxed induced by internal waves
       REAL(wp), POINTER, DIMENSION(:,:  ) ::   zhsro       ! Surface roughness (surface waves)
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   eb          ! tke at time before
@@ -156,5 +157,5 @@
       CALL wrk_alloc( jpi,jpj, zdep, zkar, zflxs, zhsro )
       CALL wrk_alloc( jpi,jpj,jpk, eb, mxlb, shear, eps, zwall_psi, z_elem_a, z_elem_b, z_elem_c, psi  )
-      
+
       ! Preliminary computing
 
@@ -165,30 +166,30 @@
          avm (:,:,:) = avm_k (:,:,:)
          avmu(:,:,:) = avmu_k(:,:,:)
-         avmv(:,:,:) = avmv_k(:,:,:) 
+         avmv(:,:,:) = avmv_k(:,:,:)
       ENDIF
 
       ! Compute surface and bottom friction at T-points
-!CDIR NOVERRCHK          
-      DO jj = 2, jpjm1          
-!CDIR NOVERRCHK         
-         DO ji = fs_2, fs_jpim1   ! vector opt.         
+!CDIR NOVERRCHK
+      DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+         DO ji = fs_2, fs_jpim1   ! vector opt.
             !
             ! surface friction
             ustars2(ji,jj) = r1_rau0 * taum(ji,jj) * tmask(ji,jj,1)
-            !   
-            ! bottom friction (explicit before friction)        
-            ! Note that we chose here not to bound the friction as in dynbfr)   
-            ztx2 = (  bfrua(ji,jj)  * ub(ji,jj,mbku(ji,jj)) + bfrua(ji-1,jj) * ub(ji-1,jj,mbku(ji-1,jj))  )   &         
-               & * ( 1._wp - 0.5_wp * umask(ji,jj,1) * umask(ji-1,jj,1)  )      
-            zty2 = (  bfrva(ji,jj)  * vb(ji,jj,mbkv(ji,jj)) + bfrva(ji,jj-1) * vb(ji,jj-1,mbkv(ji,jj-1))  )   &         
-               & * ( 1._wp - 0.5_wp * vmask(ji,jj,1) * vmask(ji,jj-1,1)  )      
-            ustarb2(ji,jj) = SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask(ji,jj,1)         
-         END DO         
-      END DO    
+            !
+            ! bottom friction (explicit before friction)
+            ! Note that we chose here not to bound the friction as in dynbfr)
+            ztx2 = (  bfrua(ji,jj)  * ub(ji,jj,mbku(ji,jj)) + bfrua(ji-1,jj) * ub(ji-1,jj,mbku(ji-1,jj))  )   &
+               & * ( 1._wp - 0.5_wp * umask(ji,jj,1) * umask(ji-1,jj,1)  )
+            zty2 = (  bfrva(ji,jj)  * vb(ji,jj,mbkv(ji,jj)) + bfrva(ji,jj-1) * vb(ji,jj-1,mbkv(ji,jj-1))  )   &
+               & * ( 1._wp - 0.5_wp * vmask(ji,jj,1) * vmask(ji,jj-1,1)  )
+            ustarb2(ji,jj) = SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask(ji,jj,1)
+         END DO
+      END DO
 
       ! Set surface roughness length
       SELECT CASE ( nn_z0_met )
       !
-      CASE ( 0 )             ! Constant roughness          
+      CASE ( 0 )             ! Constant roughness
          zhsro(:,:) = rn_hsro
       CASE ( 1 )             ! Standard Charnock formula
@@ -226,5 +227,5 @@
       IF( nn_clos == 0 ) THEN    ! Mellor-Yamada
          DO jk = 2, jpkm1
-            DO jj = 2, jpjm1 
+            DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   zup   = mxln(ji,jj,jk) * fsdepw(ji,jj,mbkt(ji,jj)+1)
@@ -275,5 +276,5 @@
                IF( ln_sigpsi ) THEN
                   zsigpsi = MIN( 1._wp, zesh2 / eps(ji,jj,jk) )     ! 0. <= zsigpsi <= 1.
-                  zwall_psi(ji,jj,jk) = rsc_psi /   & 
+                  zwall_psi(ji,jj,jk) = rsc_psi /   &
                      &     (  zsigpsi * rsc_psi + (1._wp-zsigpsi) * rsc_psi0 / MAX( zwall(ji,jj,jk), 1._wp )  )
                ELSE
@@ -294,5 +295,5 @@
                ! diagonal
                z_elem_b(ji,jj,jk) = 1._wp - z_elem_a(ji,jj,jk) - z_elem_c(ji,jj,jk)  &
-                  &                       + rdt * zdiss * tmask(ji,jj,jk) 
+                  &                       + rdt * zdiss * tmask(ji,jj,jk)
                !
                ! right hand side in en
@@ -316,14 +317,14 @@
       ! First level
       en(:,:,1) = rc02r * ustars2(:,:) * (1._wp + rsbc_tke1)**(2._wp/3._wp)
-      en(:,:,1) = MAX(en(:,:,1), rn_emin) 
+      en(:,:,1) = MAX(en(:,:,1), rn_emin)
       z_elem_a(:,:,1) = en(:,:,1)
       z_elem_c(:,:,1) = 0._wp
       z_elem_b(:,:,1) = 1._wp
-      ! 
+      !
       ! One level below
       en(:,:,2) = rc02r * ustars2(:,:) * (1._wp + rsbc_tke1 * ((zhsro(:,:)+fsdepw(:,:,2)) &
           &            / zhsro(:,:) )**(1.5_wp*ra_sf))**(2._wp/3._wp)
       en(:,:,2) = MAX(en(:,:,2), rn_emin )
-      z_elem_a(:,:,2) = 0._wp 
+      z_elem_a(:,:,2) = 0._wp
       z_elem_c(:,:,2) = 0._wp
       z_elem_b(:,:,2) = 1._wp
@@ -334,5 +335,5 @@
       ! Dirichlet conditions at k=1
       en(:,:,1)       = rc02r * ustars2(:,:) * (1._wp + rsbc_tke1)**(2._wp/3._wp)
-      en(:,:,1)       = MAX(en(:,:,1), rn_emin)      
+      en(:,:,1)       = MAX(en(:,:,1), rn_emin)
       z_elem_a(:,:,1) = en(:,:,1)
       z_elem_c(:,:,1) = 0._wp
@@ -357,5 +358,5 @@
       SELECT CASE ( nn_bc_bot )
       !
-      CASE ( 0 )             ! Dirichlet 
+      CASE ( 0 )             ! Dirichlet
          !                      ! en(ibot) = u*^2 / Co2 and mxln(ibot) = rn_lmin
          !                      ! Balance between the production and the dissipation terms
@@ -377,10 +378,10 @@
                z_elem_c(ji,jj,ibotm1) = 0._wp
                z_elem_b(ji,jj,ibotm1) = 1._wp
-               en(ji,jj,ibotm1) = MAX( rc02r * ustarb2(ji,jj), rn_emin ) 
+               en(ji,jj,ibotm1) = MAX( rc02r * ustarb2(ji,jj), rn_emin )
             END DO
          END DO
          !
       CASE ( 1 )             ! Neumman boundary condition
-         !                      
+         !
 !CDIR NOVERRCHK
          DO jj = 2, jpjm1
@@ -428,5 +429,5 @@
          END DO
       END DO
-      !                                            ! set the minimum value of tke 
+      !                                            ! set the minimum value of tke
       en(:,:,:) = MAX( en(:,:,:), rn_emin )
 
@@ -470,5 +471,5 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  psi(ji,jj,jk)  = rc02 * eb(ji,jj,jk) * mxlb(ji,jj,jk)**rnn 
+                  psi(ji,jj,jk)  = rc02 * eb(ji,jj,jk) * mxlb(ji,jj,jk)**rnn
                END DO
             END DO
@@ -489,5 +490,5 @@
                !
                ! psi / k
-               zratio = psi(ji,jj,jk) / eb(ji,jj,jk) 
+               zratio = psi(ji,jj,jk) / eb(ji,jj,jk)
                !
                ! psi3+ : stable : B=-KhN²<0 => N²>0 if rn2>0 dir = 1 (stable) otherwise dir = 0 (unstable)
@@ -509,5 +510,5 @@
                zesh2 = dir * ( prod + buoy )          + (1._wp - dir ) * prod                        ! production term
                zdiss = dir * ( diss / psi(ji,jj,jk) ) + (1._wp - dir ) * (diss-buoy) / psi(ji,jj,jk) ! dissipation term
-               !                                                        
+               !
                ! building the matrix
                zcof = rfact_psi * zwall_psi(ji,jj,jk) * tmask(ji,jj,jk)
@@ -551,5 +552,5 @@
       z_elem_c(:,:,2) = 0._wp
       z_elem_b(:,:,2) = 1._wp
-      ! 
+      !
       !
       CASE ( 1 )             ! Neumann boundary condition on d(psi)/dz
@@ -575,5 +576,5 @@
       psi(:,:,2) = psi(:,:,2) + zflxs(:,:) / fse3w(:,:,2)
 
-      !   
+      !
       !
       END SELECT
@@ -585,5 +586,5 @@
       !
       !
-      CASE ( 0 )             ! Dirichlet 
+      CASE ( 0 )             ! Dirichlet
          !                      ! en(ibot) = u*^2 / Co2 and mxln(ibot) = vkarmn * rn_bfrz0
          !                      ! Balance between the production and the dissipation terms
@@ -610,5 +611,5 @@
          !
       CASE ( 1 )             ! Neumman boundary condition
-         !                      
+         !
 !CDIR NOVERRCHK
          DO jj = 2, jpjm1
@@ -692,5 +693,5 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  eps(ji,jj,jk) = rc04 * en(ji,jj,jk) * psi(ji,jj,jk) 
+                  eps(ji,jj,jk) = rc04 * en(ji,jj,jk) * psi(ji,jj,jk)
                END DO
             END DO
@@ -719,10 +720,10 @@
                eps(ji,jj,jk)  = MAX( eps(ji,jj,jk), rn_epsmin )
                mxln(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / eps(ji,jj,jk)
-               ! Galperin criterium (NOTE : Not required if the proper value of C3 in stable cases is calculated) 
+               ! Galperin criterium (NOTE : Not required if the proper value of C3 in stable cases is calculated)
                zrn2 = MAX( rn2(ji,jj,jk), rsmall )
                IF (ln_length_lim) mxln(ji,jj,jk) = MIN(  rn_clim_galp * SQRT( 2._wp * en(ji,jj,jk) / zrn2 ), mxln(ji,jj,jk) )
             END DO
          END DO
-      END DO 
+      END DO
 
       !
@@ -806,4 +807,14 @@
             END DO
          END DO
+#if defined key_traldf_c2d || key_traldf_c3d
+         IF( ln_stopack) THEN
+            IF( nn_spp_avt > 0 ) CALL spp_gen(kt, avt(:,:,jk), nn_spp_avt, rn_avt_sd,jk)
+            IF( nn_spp_avm > 0 ) CALL spp_gen(kt, avm(:,:,jk), nn_spp_avm, rn_avm_sd,jk)
+         ENDIF
+#else
+         IF ( ln_stopack ) &
+            & CALL ctl_stop( 'zdf_gls: parameter perturbation will only work with '// &
+                             'key_traldf_c2d or key_traldf_c3d')
+#endif
       END DO
       !
@@ -846,6 +857,6 @@
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE zdf_gls_init  ***
-      !!                     
-      !! ** Purpose :   Initialization of the vertical eddy diffivity and 
+      !!
+      !! ** Purpose :   Initialization of the vertical eddy diffivity and
       !!      viscosity when using a gls turbulent closure scheme
       !!
@@ -881,5 +892,5 @@
       READ  ( numnam_cfg, namzdf_gls, IOSTAT = ios, ERR = 902 )
 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_gls in configuration namelist', lwp )
-      IF(lwm .AND. nprint > 2) WRITE ( numond, namzdf_gls )
+      IF(lwm) WRITE ( numond, namzdf_gls )
 
       IF(lwp) THEN                     !* Control print
@@ -1069,10 +1080,10 @@
       END SELECT
       !
-      IF(lwp .AND. lflush) CALL flush(numout) 
+      IF(lwp .AND. lflush) CALL flush(numout)
       !                                !* Set Schmidt number for psi diffusion in the wave breaking case
       !                                     ! See Eq. (13) of Carniel et al, OM, 30, 225-239, 2009
       !                                     !  or Eq. (17) of Burchard, JPO, 31, 3133-3145, 2001
       IF( ln_sigpsi ) THEN
-         ra_sf = -1.5 ! Set kinetic energy slope, then deduce rsc_psi and rl_sf 
+         ra_sf = -1.5 ! Set kinetic energy slope, then deduce rsc_psi and rl_sf
          ! Verification: retrieve Burchard (2001) results by uncomenting the line below:
          ! Note that the results depend on the value of rn_cm_sf which is constant (=rc0) in his work
@@ -1082,5 +1093,5 @@
          rsc_psi0 = rsc_psi
       ENDIF
- 
+
       !                                !* Shear free turbulence parameters
       !
@@ -1129,11 +1140,11 @@
       rc04  = rc03 * rc0
       rsbc_tke1 = -3._wp/2._wp*rn_crban*ra_sf*rl_sf                      ! Dirichlet + Wave breaking
-      rsbc_tke2 = rdt * rn_crban / rl_sf                                 ! Neumann + Wave breaking 
+      rsbc_tke2 = rdt * rn_crban / rl_sf                                 ! Neumann + Wave breaking
       zcr = MAX(rsmall, rsbc_tke1**(1./(-ra_sf*3._wp/2._wp))-1._wp )
-      rtrans = 0.2_wp / zcr                                              ! Ad. inverse transition length between log and wave layer 
+      rtrans = 0.2_wp / zcr                                              ! Ad. inverse transition length between log and wave layer
       rsbc_zs1  = rn_charn/grav                                          ! Charnock formula for surface roughness
-      rsbc_zs2  = rn_frac_hs / 0.85_wp / grav * 665._wp                  ! Rascle formula for surface roughness 
+      rsbc_zs2  = rn_frac_hs / 0.85_wp / grav * 665._wp                  ! Rascle formula for surface roughness
       rsbc_psi1 = -0.5_wp * rdt * rc0**(rpp-2._wp*rmm) / rsc_psi
-      rsbc_psi2 = -0.5_wp * rdt * rc0**rpp * rnn * vkarmn**rnn / rsc_psi ! Neumann + NO Wave breaking 
+      rsbc_psi2 = -0.5_wp * rdt * rc0**rpp * rnn * vkarmn**rnn / rsc_psi ! Neumann + NO Wave breaking
 
       rfact_tke = -0.5_wp / rsc_tke * rdt                                ! Cst used for the Diffusion term of tke
@@ -1150,5 +1161,5 @@
          avmv(:,:,jk) = avmb(jk) * vmask(:,:,jk)
       END DO
-      !                              
+      !
       CALL gls_rst( nit000, 'READ' )   !* read or initialize all required files
       !
@@ -1161,9 +1172,9 @@
       !!---------------------------------------------------------------------
       !!                   ***  ROUTINE ts_rst  ***
-      !!                     
+      !!
       !! ** Purpose :   Read or write TKE file (en) in restart file
       !!
       !! ** Method  :   use of IOM library
-      !!                if the restart does not contain TKE, en is either 
+      !!                if the restart does not contain TKE, en is either
       !!                set to rn_emin or recomputed (nn_igls/=0)
       !!----------------------------------------------------------------------
@@ -1177,5 +1188,5 @@
       !!----------------------------------------------------------------------
       !
-      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise 
+      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise
          !                                   ! ---------------
          IF( ln_rstart ) THEN                   !* Read the restart file
@@ -1196,9 +1207,9 @@
                CALL iom_get( numror, jpdom_autoglo, 'mxln'  , mxln   )
                IF(nn_timing == 2)  CALL timing_stop('iom_rstget')
-            ELSE                        
+            ELSE
                IF(lwp) WRITE(numout,*) ' ===>>>> : previous run without gls scheme, en and mxln computed by iterative loop'
                IF(lwp .AND. lflush) CALL flush(numout)
                en  (:,:,:) = rn_emin
-               mxln(:,:,:) = 0.05        
+               mxln(:,:,:) = 0.05
                avt_k (:,:,:) = avt (:,:,:)
                avm_k (:,:,:) = avm (:,:,:)
@@ -1211,5 +1222,5 @@
             IF(lwp .AND. lflush) CALL flush(numout)
             en  (:,:,:) = rn_emin
-            mxln(:,:,:) = 0.05       
+            mxln(:,:,:) = 0.05
          ENDIF
          !
@@ -1219,8 +1230,8 @@
          IF(lwp .AND. lflush) CALL flush(numout)
          IF(nn_timing == 2)  CALL timing_start('iom_rstput')
-         CALL iom_rstput( kt, nitrst, numrow, 'en'   , en     ) 
+         CALL iom_rstput( kt, nitrst, numrow, 'en'   , en     )
          CALL iom_rstput( kt, nitrst, numrow, 'avt'  , avt_k  )
          CALL iom_rstput( kt, nitrst, numrow, 'avm'  , avm_k  )
-         CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu_k ) 
+         CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu_k )
          CALL iom_rstput( kt, nitrst, numrow, 'avmv' , avmv_k )
          CALL iom_rstput( kt, nitrst, numrow, 'mxln' , mxln   )
@@ -1241,11 +1252,11 @@
       WRITE(*,*) 'zdf_gls_init: You should not have seen this print! error?'
    END SUBROUTINE zdf_gls_init
-   
+
    SUBROUTINE zdf_gls( kt )          ! Empty routine
    IMPLICIT NONE
-      INTEGER, INTENT(in) ::   kt ! ocean time step   
+      INTEGER, INTENT(in) ::   kt ! ocean time step
       WRITE(*,*) 'zdf_gls: You should not have seen this print! error?', kt
    END SUBROUTINE zdf_gls
-   
+
    SUBROUTINE gls_rst( kt, cdrw )          ! Empty routine
    IMPLICIT NONE
@@ -1258,3 +1269,2 @@
    !!======================================================================
 END MODULE zdfgls
-
Index: branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90	(revision 15582)
+++ branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90	(revision 15603)
@@ -2,5 +2,5 @@
    !!======================================================================
    !!                       ***  MODULE  zdftke  ***
-   !! Ocean physics:  vertical mixing coefficient computed from the tke 
+   !! Ocean physics:  vertical mixing coefficient computed from the tke
    !!                 turbulent closure parameterization
    !!=====================================================================
@@ -22,6 +22,6 @@
    !!             -   !  2008-05  (J.-M. Molines, G. Madec)  2D form of avtb
    !!             -   !  2008-06  (G. Madec)  style + DOCTOR name for namelist parameters
-   !!             -   !  2008-12  (G. Reffray) stable discretization of the production term 
-   !!            3.2  !  2009-06  (G. Madec, S. Masson) TKE restart compatible with key_cpl 
+   !!             -   !  2008-12  (G. Reffray) stable discretization of the production term
+   !!            3.2  !  2009-06  (G. Madec, S. Masson) TKE restart compatible with key_cpl
    !!                 !                                + cleaning of the parameters + bugs correction
    !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
@@ -52,11 +52,10 @@
    USE wrk_nemo       ! work arrays
    USE timing         ! Timing
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
 #if defined key_agrif
    USE agrif_opa_interp
    USE agrif_opa_update
 #endif
-
-
+   USE stopack
 
    IMPLICIT NONE
@@ -75,5 +74,5 @@
    INTEGER  ::   nn_pdl    ! Prandtl number or not (ratio avt/avm) (=0/1)
    REAL(wp) ::   rn_ediff  ! coefficient for avt: avt=rn_ediff*mxl*sqrt(e)
-   REAL(wp) ::   rn_ediss  ! coefficient of the Kolmogoroff dissipation 
+   REAL(wp) ::   rn_ediss  ! coefficient of the Kolmogoroff dissipation
    REAL(wp) ::   rn_ebb    ! coefficient of the surface input of tke
    REAL(wp) ::   rn_emin   ! minimum value of tke           [m2/s2]
@@ -94,6 +93,4 @@
 
    REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   htau           ! depth of tke penetration (nn_htau)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e_niw          !: TKE budget- near-inertial waves term
-   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   efr            ! surface boundary condition for nn_etau = 4
    REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dissl          ! now mixing lenght of dissipation
 #if defined key_c1d
@@ -102,4 +99,7 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e_pdl, e_ric   !: prandl and local Richardson numbers
 #endif
+   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rn_lc0, rn_ediff0, rn_ediss0, rn_ebb0, rn_efr0
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e_niw          !: TKE budget- near-inertial waves term
+   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   efr            ! surface boundary condition for nn_etau = 4
 
    !! * Substitutions
@@ -118,5 +118,5 @@
       !!----------------------------------------------------------------------
       ALLOCATE(                                                                    &
-         &      efr  (jpi,jpj)     , e_niw(jpi,jpj,jpk) ,                         &      
+         &      efr  (jpi,jpj)     , e_niw(jpi,jpj,jpk) ,                         &
 #if defined key_c1d
          &      e_dis(jpi,jpj,jpk) , e_mix(jpi,jpj,jpk) ,                          &
@@ -147,10 +147,10 @@
       !!         surface: en = max( rn_emin0, rn_ebb * taum )
       !!         bottom : en = rn_emin
-      !!      The associated critical Richardson number is: ri_cri = 2/(2+rn_ediss/rn_ediff) 
-      !!
-      !!        The now Turbulent kinetic energy is computed using the following 
+      !!      The associated critical Richardson number is: ri_cri = 2/(2+rn_ediss/rn_ediff)
+      !!
+      !!        The now Turbulent kinetic energy is computed using the following
       !!      time stepping: implicit for vertical diffusion term, linearized semi
-      !!      implicit for kolmogoroff dissipation term, and explicit forward for 
-      !!      both buoyancy and shear production terms. Therefore a tridiagonal 
+      !!      implicit for kolmogoroff dissipation term, and explicit forward for
+      !!      both buoyancy and shear production terms. Therefore a tridiagonal
       !!      linear system is solved. Note that buoyancy and shear terms are
       !!      discretized in a energy conserving form (Bruchard 2002).
@@ -160,10 +160,10 @@
       !!
       !!        The now vertical eddy vicosity and diffusivity coefficients are
-      !!      given by: 
+      !!      given by:
       !!              avm = max( avtb, rn_ediff * zmxlm * en^1/2 )
-      !!              avt = max( avmb, pdl * avm                 )  
+      !!              avt = max( avmb, pdl * avm                 )
       !!              eav = max( avmb, avm )
       !!      where pdl, the inverse of the Prandtl number is 1 if nn_pdl=0 and
-      !!      given by an empirical funtion of the localRichardson number if nn_pdl=1 
+      !!      given by an empirical funtion of the localRichardson number if nn_pdl=1
       !!
       !! ** Action  :   compute en (now turbulent kinetic energy)
@@ -180,9 +180,38 @@
       !
       IF( kt /= nit000 ) THEN   ! restore before value to compute tke
-         avt (:,:,:) = avt_k (:,:,:) 
-         avm (:,:,:) = avm_k (:,:,:) 
-         avmu(:,:,:) = avmu_k(:,:,:) 
-         avmv(:,:,:) = avmv_k(:,:,:) 
-      ENDIF 
+         avt (:,:,:) = avt_k (:,:,:)
+         avm (:,:,:) = avm_k (:,:,:)
+         avmu(:,:,:) = avmu_k(:,:,:)
+         avmv(:,:,:) = avmv_k(:,:,:)
+      ENDIF
+      !
+#if defined key_traldf_c2d || key_traldf_c3d
+      IF( ln_stopack) THEN
+         IF( nn_spp_tkelc > 0 ) THEN
+             rn_lc0 = rn_lc
+             CALL spp_gen( kt, rn_lc0, nn_spp_tkelc, rn_tkelc_sd, jk_spp_tkelc )
+         ENDIF
+         IF( nn_spp_tkedf > 0 ) THEN
+             rn_ediff0 = rn_ediff
+             CALL spp_gen( kt, rn_ediff0, nn_spp_tkedf, rn_tkedf_sd, jk_spp_tkedf )
+         ENDIF
+         IF( nn_spp_tkeds > 0 ) THEN
+             rn_ediss0 = rn_ediss
+             CALL spp_gen( kt, rn_ediss0, nn_spp_tkeds, rn_tkeds_sd, jk_spp_tkeds )
+         ENDIF
+         IF( nn_spp_tkebb > 0 ) THEN
+             rn_ebb0 = rn_ebb
+             CALL spp_gen( kt, rn_ebb0, nn_spp_tkebb, rn_tkebb_sd, jk_spp_tkebb )
+        ENDIF
+         IF( nn_spp_tkefr > 0 ) THEN
+             rn_efr0 = rn_efr
+             CALL spp_gen( kt, rn_efr0, nn_spp_tkefr, rn_tkefr_sd, jk_spp_tkefr )
+         ENDIF
+      ENDIF
+#else
+      IF ( ln_stopack ) &
+         & CALL ctl_stop( 'zdf_tke: parameter perturbation will only work with '// &
+                          'key_traldf_c2d or key_traldf_c3d')
+#endif
       !
       CALL tke_tke      ! now tke (en)
@@ -190,14 +219,18 @@
       CALL tke_avn      ! now avt, avm, avmu, avmv
       !
-      avt_k (:,:,:) = avt (:,:,:) 
-      avm_k (:,:,:) = avm (:,:,:) 
-      avmu_k(:,:,:) = avmu(:,:,:) 
-      avmv_k(:,:,:) = avmv(:,:,:) 
+      avt_k (:,:,:) = avt (:,:,:)
+      avm_k (:,:,:) = avm (:,:,:)
+      avmu_k(:,:,:) = avmu(:,:,:)
+      avmv_k(:,:,:) = avmv(:,:,:)
       !
 #if defined key_agrif
-      ! Update child grid f => parent grid 
+      ! Update child grid f => parent grid
       IF( .NOT.Agrif_Root() )   CALL Agrif_Update_Tke( kt )      ! children only
-#endif      
-     ! 
+#endif
+      IF (  kt == nitend ) THEN
+        DEALLOCATE ( rn_lc0, rn_ediff0, rn_ediss0, rn_ebb0, rn_efr0 )
+      ENDIF
+      !
+
    END SUBROUTINE zdf_tke
 
@@ -225,6 +258,6 @@
       REAL(wp) ::   zrhoa  = 1.22                   ! Air density kg/m3
       REAL(wp) ::   zcdrag = 1.5e-3                 ! drag coefficient
-      REAL(wp) ::   zbbrau, zesh2                   ! temporary scalars
-      REAL(wp) ::   zfact1, zfact2, zfact3          !    -         -
+      REAL(wp) ::   zesh2                           ! temporary scalars
+      REAL(wp) ::   zfact1                          !    -         -
       REAL(wp) ::   ztx2  , zty2  , zcof            !    -         -
       REAL(wp) ::   ztau  , zdif                    !    -         -
@@ -233,5 +266,5 @@
 !!bfr      REAL(wp) ::   zebot                           !    -         -
       INTEGER , POINTER, DIMENSION(:,:  ) :: imlc
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: zhlc
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zhlc, zbbrau,zfact2,zfact3
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zpelc, zdiag, zd_up, zd_lw
       !!--------------------------------------------------------------------
@@ -240,11 +273,14 @@
       !
       CALL wrk_alloc( jpi,jpj, imlc )    ! integer
-      CALL wrk_alloc( jpi,jpj, zhlc ) 
-      CALL wrk_alloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw ) 
-      !
-      zbbrau = rn_ebb / rau0       ! Local constant initialisation
-      zfact1 = -.5_wp * rdt 
-      zfact2 = 1.5_wp * rdt * rn_ediss
-      zfact3 = 0.5_wp       * rn_ediss
+      CALL wrk_alloc( jpi,jpj, zhlc )
+      CALL wrk_alloc( jpi,jpj, zbbrau )
+      CALL wrk_alloc( jpi,jpj, zfact2 )
+      CALL wrk_alloc( jpi,jpj, zfact3 )
+      CALL wrk_alloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw )
+      !
+      zbbrau = rn_ebb0 / rau0       ! Local constant initialisation
+      zfact1 = -.5_wp * rdt
+      zfact2 = 1.5_wp * rdt * rn_ediss0
+      zfact3 = 0.5_wp       * rn_ediss0
       !
       !
@@ -261,8 +297,8 @@
       DO jj = 2, jpjm1            ! en(1)   = rn_ebb taum / rau0  (min value rn_emin0)
          DO ji = fs_2, fs_jpim1   ! vector opt.
-            en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1)
-         END DO
-      END DO
-      
+            en(ji,jj,1) = MAX( rn_emin0, zbbrau(ji,jj) * taum(ji,jj) ) * tmask(ji,jj,1)
+         END DO
+      END DO
+
 !!bfr   - start commented area
       !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
@@ -303,5 +339,5 @@
          imlc(:,:) = mbkt(:,:) + 1       ! Initialization to the number of w ocean point (=2 over land)
          DO jk = jpkm1, 2, -1
-            DO jj = 1, jpj               ! Last w-level at which zpelc>=0.5*us*us 
+            DO jj = 1, jpj               ! Last w-level at which zpelc>=0.5*us*us
                DO ji = 1, jpi            !      with us=0.016*wind(starting from jpk-1)
                   zus  = zcof * taum(ji,jj)
@@ -311,5 +347,5 @@
          END DO
          !                               ! finite LC depth
-         DO jj = 1, jpj 
+         DO jj = 1, jpj
             DO ji = 1, jpi
                zhlc(ji,jj) = fsdepw(ji,jj,imlc(ji,jj))
@@ -326,8 +362,9 @@
                   !                                           ! vertical velocity due to LC
                   zind = 0.5 - SIGN( 0.5, fsdepw(ji,jj,jk) - zhlc(ji,jj) )
-                  zwlc = zind * rn_lc * zus * SIN( rpi * fsdepw(ji,jj,jk) / zhlc(ji,jj) )
+                  zwlc = zind * rn_lc0(ji,jj) * zus * SIN( rpi * fsdepw(ji,jj,jk) / zhlc(ji,jj) )
                   !                                           ! TKE Langmuir circulation source term
-                  en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( 1._wp - fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc ) /   &
+                  en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( 1._wp - fr_i(ji,jj) )* ( zwlc * zwlc * zwlc ) /   &
                      &   zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1)
+
                END DO
             END DO
@@ -347,5 +384,5 @@
             DO ji = 1, jpi
                avmu(ji,jj,jk) = avmu(ji,jj,jk) * ( un(ji,jj,jk-1) - un(ji,jj,jk) )   &
-                  &                            * ( ub(ji,jj,jk-1) - ub(ji,jj,jk) )   & 
+                  &                            * ( ub(ji,jj,jk-1) - ub(ji,jj,jk) )   &
                   &                            / (  fse3uw_n(ji,jj,jk)               &
                   &                              *  fse3uw_b(ji,jj,jk)  )
@@ -376,13 +413,13 @@
                   !                                                           ! shear prod. at w-point weightened by mask
                zesh2  =  ( avmu(ji-1,jj,jk) + avmu(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   &
-                  &    + ( avmv(ji,jj-1,jk) + avmv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) )    
+                  &    + ( avmv(ji,jj-1,jk) + avmv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) )
                   !
                zd_up(ji,jj,jk) = zzd_up            ! Matrix (zdiag, zd_up, zd_lw)
                zd_lw(ji,jj,jk) = zzd_lw
-               zdiag(ji,jj,jk) = 1._wp - zzd_lw - zzd_up + zfact2 * dissl(ji,jj,jk) * tmask(ji,jj,jk)
+               zdiag(ji,jj,jk) = 1._wp - zzd_lw - zzd_up + zfact2(ji,jj) * dissl(ji,jj,jk) * tmask(ji,jj,jk)
                !
                !                                   ! right hand side in en
                en(ji,jj,jk) = en(ji,jj,jk) + rdt * (  zesh2  -   avt(ji,jj,jk) * rn2(ji,jj,jk)    &
-                  &                                 + zfact3 * dissl(ji,jj,jk) * en (ji,jj,jk)  ) &
+                  &                                 + zfact3(ji,jj) * dissl(ji,jj,jk) * en (ji,jj,jk)  ) &
                   &                                 * wmask(ji,jj,jk)
             END DO
@@ -433,7 +470,7 @@
       END DO
 
-      !                                 ! Save TKE prior to nn_etau addition  
-      e_niw(:,:,:) = en(:,:,:)  
-      !  
+      !                                 ! Save TKE prior to nn_etau addition
+      e_niw(:,:,:) = en(:,:,:)
+      !
       !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
       !                            !  TKE due to surface and internal wave breaking
@@ -455,5 +492,5 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   &
+                  en(ji,jj,jk) = en(ji,jj,jk) + rn_efr0(ji,jj) * en(ji,jj,1) * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   &
                      &                                 * ( 1._wp - fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1)
                END DO
@@ -464,5 +501,5 @@
             DO ji = fs_2, fs_jpim1   ! vector opt.
                jk = nmln(ji,jj)
-               en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   &
+               en(ji,jj,jk) = en(ji,jj,jk) + rn_efr0(ji,jj) * en(ji,jj,1) * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   &
                   &                                 * ( 1._wp - fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1)
             END DO
@@ -477,8 +514,8 @@
                   ztx2 = utau(ji-1,jj  ) + utau(ji,jj)
                   zty2 = vtau(ji  ,jj-1) + vtau(ji,jj)
-                  ztau = 0.5_wp * SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask(ji,jj,1)    ! module of the mean stress 
-                  zdif = taum(ji,jj) - ztau                            ! mean of modulus - modulus of the mean 
+                  ztau = 0.5_wp * SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask(ji,jj,1)    ! module of the mean stress
+                  zdif = taum(ji,jj) - ztau                            ! mean of modulus - modulus of the mean
                   zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add )  ! apply some modifications...
-                  en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   &
+                  en(ji,jj,jk) = en(ji,jj,jk) + zbbrau(ji,jj) * zdif * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   &
                      &                        * ( 1._wp - fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1)
                END DO
@@ -486,5 +523,5 @@
          END DO
       ELSEIF( nn_etau == 4 ) THEN       !* column integral independant of htau (rn_efr must be scaled up)
-         IF( nn_htau == 2 ) THEN        ! efr dependant on time-varying htau 
+         IF( nn_htau == 2 ) THEN        ! efr dependant on time-varying htau
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
@@ -504,17 +541,20 @@
       CALL lbc_lnk( en, 'W', 1. )      ! Lateral boundary conditions (sign unchanged)
       !
-      DO jk = 2, jpkm1                             ! TKE budget: near-inertial waves term  
-         DO jj = 2, jpjm1  
-            DO ji = fs_2, fs_jpim1   ! vector opt.  
-               e_niw(ji,jj,jk) = en(ji,jj,jk) - e_niw(ji,jj,jk)  
-            END DO  
-         END DO  
-      END DO  
-      !  
-      CALL lbc_lnk( e_niw, 'W', 1. )  
+      DO jk = 2, jpkm1                             ! TKE budget: near-inertial waves term
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               e_niw(ji,jj,jk) = en(ji,jj,jk) - e_niw(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      CALL lbc_lnk( e_niw, 'W', 1. )
       !
       CALL wrk_dealloc( jpi,jpj, imlc )    ! integer
-      CALL wrk_dealloc( jpi,jpj, zhlc ) 
-      CALL wrk_dealloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw ) 
+      CALL wrk_dealloc( jpi,jpj, zhlc )
+      CALL wrk_dealloc( jpi,jpj, zbbrau )
+      CALL wrk_dealloc( jpi,jpj, zfact2 )
+      CALL wrk_dealloc( jpi,jpj, zfact3 )
+      CALL wrk_dealloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw )
       !
       IF( nn_timing == 1 )  CALL timing_stop('tke_tke')
@@ -529,28 +569,28 @@
       !! ** Purpose :   Compute the vertical eddy viscosity and diffusivity
       !!
-      !! ** Method  :   At this stage, en, the now TKE, is known (computed in 
-      !!              the tke_tke routine). First, the now mixing lenth is 
+      !! ** Method  :   At this stage, en, the now TKE, is known (computed in
+      !!              the tke_tke routine). First, the now mixing lenth is
       !!      computed from en and the strafification (N^2), then the mixings
       !!      coefficients are computed.
       !!              - Mixing length : a first evaluation of the mixing lengh
       !!      scales is:
-      !!                      mxl = sqrt(2*en) / N  
+      !!                      mxl = sqrt(2*en) / N
       !!      where N is the brunt-vaisala frequency, with a minimum value set
       !!      to rmxl_min (rn_mxl0) in the interior (surface) ocean.
-      !!        The mixing and dissipative length scale are bound as follow : 
+      !!        The mixing and dissipative length scale are bound as follow :
       !!         nn_mxl=0 : mxl bounded by the distance to surface and bottom.
       !!                        zmxld = zmxlm = mxl
       !!         nn_mxl=1 : mxl bounded by the e3w and zmxld = zmxlm = mxl
-      !!         nn_mxl=2 : mxl bounded such that the vertical derivative of mxl is 
+      !!         nn_mxl=2 : mxl bounded such that the vertical derivative of mxl is
       !!                    less than 1 (|d/dz(mxl)|<1) and zmxld = zmxlm = mxl
       !!         nn_mxl=3 : mxl is bounded from the surface to the bottom usings
-      !!                    |d/dz(xml)|<1 to obtain lup, and from the bottom to 
-      !!                    the surface to obtain ldown. the resulting length 
+      !!                    |d/dz(xml)|<1 to obtain lup, and from the bottom to
+      !!                    the surface to obtain ldown. the resulting length
       !!                    scales are:
-      !!                        zmxld = sqrt( lup * ldown ) 
+      !!                        zmxld = sqrt( lup * ldown )
       !!                        zmxlm = min ( lup , ldown )
       !!              - Vertical eddy viscosity and diffusivity:
       !!                      avm = max( avtb, rn_ediff * zmxlm * en^1/2 )
-      !!                      avt = max( avmb, pdlr * avm )  
+      !!                      avt = max( avmb, pdlr * avm )
       !!      with pdlr=1 if nn_pdl=0, pdlr=1/pdl=F(Ri) otherwise.
       !!
@@ -567,5 +607,5 @@
       IF( nn_timing == 1 )  CALL timing_start('tke_avn')
 
-      CALL wrk_alloc( jpi,jpj,jpk, zmpdl, zmxlm, zmxld ) 
+      CALL wrk_alloc( jpi,jpj,jpk, zmpdl, zmxlm, zmxld )
 
       !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
@@ -576,5 +616,5 @@
       !
       ! initialisation of interior minimum value (avoid a 2d loop with mikt)
-      zmxlm(:,:,:)  = rmxl_min    
+      zmxlm(:,:,:)  = rmxl_min
       zmxld(:,:,:)  = rmxl_min
       !
@@ -586,5 +626,5 @@
             END DO
          END DO
-      ELSE 
+      ELSE
          zmxlm(:,:,1) = rn_mxl0
       ENDIF
@@ -604,5 +644,5 @@
       !                     !* Physical limits for the mixing length
       !
-      zmxld(:,:,1  ) = zmxlm(:,:,1)   ! surface set to the minimum value 
+      zmxld(:,:,1  ) = zmxlm(:,:,1)   ! surface set to the minimum value
       zmxld(:,:,jpk) = rmxl_min       ! last level  set to the minimum value
       !
@@ -698,5 +738,5 @@
             DO ji = fs_2, fs_jpim1   ! vector opt.
                zsqen = SQRT( en(ji,jj,jk) )
-               zav   = rn_ediff * zmxlm(ji,jj,jk) * zsqen
+               zav   = rn_ediff0(ji,jj) * zmxlm(ji,jj,jk) * zsqen
                avm  (ji,jj,jk) = MAX( zav,                  avmb(jk) ) * wmask(ji,jj,jk)
                avt  (ji,jj,jk) = MAX( zav, avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk)
@@ -704,4 +744,14 @@
             END DO
          END DO
+#if defined key_traldf_c2d || key_traldf_c3d
+         IF( ln_stopack) THEN
+            IF(nn_spp_avt > 0 ) CALL spp_gen( 1, avt(:,:,jk), nn_spp_avt, rn_avt_sd, jk_spp_avt, jk)
+            IF(nn_spp_avm > 0 ) CALL spp_gen( 1, avm(:,:,jk), nn_spp_avm, rn_avm_sd, jk_spp_avm, jk)
+         ENDIF
+#else
+         IF ( ln_stopack  ) &
+            & CALL ctl_stop( 'tke_avn: parameter perturbation will only work with '// &
+                             'key_traldf_c2d or key_traldf_c3d')
+#endif
       END DO
       CALL lbc_lnk( avm, 'W', 1. )      ! Lateral boundary conditions (sign unchanged)
@@ -749,5 +799,5 @@
       ENDIF
       !
-      CALL wrk_dealloc( jpi,jpj,jpk, zmpdl, zmxlm, zmxld ) 
+      CALL wrk_dealloc( jpi,jpj,jpk, zmpdl, zmxlm, zmxld )
       !
       IF( nn_timing == 1 )  CALL timing_stop('tke_avn')
@@ -759,6 +809,6 @@
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE zdf_tke_init  ***
-      !!                     
-      !! ** Purpose :   Initialization of the vertical eddy diffivity and 
+      !!
+      !! ** Purpose :   Initialization of the vertical eddy diffivity and
       !!              viscosity when using a tke turbulent closure scheme
       !!
@@ -776,5 +826,5 @@
          &                 rn_emin0, rn_bshear, nn_mxl , ln_mxl0  ,   &
          &                 rn_mxl0 , nn_pdl   , ln_lc  , rn_lc    ,   &
-         &                 nn_etau , nn_htau  , rn_efr , rn_c   
+         &                 nn_etau , nn_htau  , rn_efr , rn_c
       !!----------------------------------------------------------------------
 
@@ -843,5 +893,11 @@
          rn_mxl0 = rmxl_min
       ENDIF
-      
+
+      ALLOCATE( rn_lc0   (jpi,jpj) ) ; rn_lc0    = rn_lc
+      ALLOCATE( rn_ediff0(jpi,jpj) ) ; rn_ediff0 = rn_ediff
+      ALLOCATE( rn_ediss0(jpi,jpj) ) ; rn_ediss0 = rn_ediss
+      ALLOCATE( rn_ebb0  (jpi,jpj) ) ; rn_ebb0   = rn_ebb
+      ALLOCATE( rn_efr0  (jpi,jpj) ) ; rn_efr0   = rn_efr
+
       IF( nn_etau == 2  ) THEN
           ierr = zdf_mxl_alloc()
@@ -855,5 +911,5 @@
 
       !                               !* depth of penetration of surface tke
-      IF( nn_etau /= 0 ) THEN      
+      IF( nn_etau /= 0 ) THEN
          htau(:,:) = 0._wp
          SELECT CASE( nn_htau )             ! Choice of the depth of penetration
@@ -861,5 +917,5 @@
             htau(:,:) = 10._wp
          CASE( 1 )                                 ! F(latitude) : 0.5m to 30m poleward of 40 degrees
-            htau(:,:) = MAX(  0.5_wp, MIN( 30._wp, 45._wp* ABS( SIN( rpi/180._wp * gphit(:,:) ) ) )   )            
+            htau(:,:) = MAX(  0.5_wp, MIN( 30._wp, 45._wp* ABS( SIN( rpi/180._wp * gphit(:,:) ) ) )   )
          CASE( 2 )                                 ! fraction of depth-integrated TKE within mixed-layer
             rhtau = -1._wp / LOG( 1._wp - rn_c )
@@ -904,5 +960,5 @@
       END DO
       dissl(:,:,:) = 1.e-12_wp
-      !                              
+      !
       CALL tke_rst( nit000, 'READ' )  !* read or initialize all required files
       !
@@ -913,10 +969,10 @@
      !!---------------------------------------------------------------------
      !!                   ***  ROUTINE tke_rst  ***
-     !!                     
+     !!
      !! ** Purpose :   Read or write TKE file (en) in restart file
      !!
      !! ** Method  :   use of IOM library
-     !!                if the restart does not contain TKE, en is either 
-     !!                set to rn_emin or recomputed 
+     !!                if the restart does not contain TKE, en is either
+     !!                set to rn_emin or recomputed
      !!----------------------------------------------------------------------
      INTEGER         , INTENT(in) ::   kt     ! ocean time-step
@@ -927,5 +983,5 @@
      !!----------------------------------------------------------------------
      !
-     IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise 
+     IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise
         !                                   ! ---------------
         IF( ln_rstart ) THEN                   !* Read the restart file
@@ -956,21 +1012,15 @@
               CALL tke_avn                               ! recompute avt, avm, avmu, avmv and dissl (approximation)
               !
-              avt_k (:,:,:) = avt (:,:,:)
-              avm_k (:,:,:) = avm (:,:,:)
-              avmu_k(:,:,:) = avmu(:,:,:)
-              avmv_k(:,:,:) = avmv(:,:,:)
-              !
               DO jit = nit000 + 1, nit000 + 10   ;   CALL zdf_tke( jit )   ;   END DO
            ENDIF
         ELSE                                   !* Start from rest
            en(:,:,:) = rn_emin * tmask(:,:,:)
-           DO jk = 1, jpk                           ! set the Kz to the background value
-              avt (:,:,jk) = avtb(jk) * wmask (:,:,jk)
-              avm (:,:,jk) = avmb(jk) * wmask (:,:,jk)
-              avmu(:,:,jk) = avmb(jk) * wumask(:,:,jk)
-              avmv(:,:,jk) = avmb(jk) * wvmask(:,:,jk)
-           END DO
         ENDIF
         !
+        avt_k (:,:,:) = avt (:,:,:)
+        avm_k (:,:,:) = avm (:,:,:)
+        avmu_k(:,:,:) = avmu(:,:,:)
+        avmv_k(:,:,:) = avmv(:,:,:)
+
      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file
         !                                   ! -------------------
Index: branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 15582)
+++ branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 15603)
@@ -85,4 +85,5 @@
    USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 
    USE sbc_oce, ONLY: lk_oasis
+   USE stopack
    USE stopar
    USE stopts
@@ -498,5 +499,6 @@
                             CALL dia_hsb_init   ! heat content, salt content and volume budgets
                             CALL     trd_init   ! Mixed-layer/Vorticity/Integral constraints trends
-                            CALL     bias_init  ! Pressure correction bias
+	                          CALL stopack_init   ! STOPACK scheme                            
+                            CALL    bias_init   ! Pressure correction bias
       IF( lk_diaobs     ) THEN                  ! Observation & model comparison
                             CALL dia_obs_init            ! Initialize observational data
Index: branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/step.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/step.F90	(revision 15582)
+++ branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/step.F90	(revision 15603)
@@ -110,5 +110,5 @@
       IF( lk_tide    )   CALL sbc_tide( kstp )
       IF( lk_bdy     )  THEN
-         IF( ln_apr_dyn) CALL sbc_apr( kstp )   ! bdy_dta needs ssh_ib 
+         IF( ln_apr_dyn) CALL sbc_apr( kstp )   ! bdy_dta needs ssh_ib
                          CALL bdy_dta ( kstp, time_offset=+1 )   ! update dynamic & tracer data at open boundaries
       ENDIF
@@ -119,11 +119,15 @@
       END DO
 
+      IF( ln_stopack )   CALL stopack_pert( kstp )
                          CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice)
                                                       ! clem: moved here for bdy ice purpose
+
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
       ! 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
+
+      IF( ln_sto_eos )                 CALL sto_par( kstp )   ! Stochastic parameters
+      IF( ln_sto_eos )                 CALL sto_pts( tsn  )   ! Random T/S fluctuations
+      IF( ln_stopack .AND. ln_skeb  )  CALL skeb_comp( kstp ) ! Stochastic Energy Backscatter
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -149,5 +153,15 @@
       ENDIF
       IF( ln_rnf_mouth ) THEN                         ! increase diffusivity at rivers mouths
-         DO jk = 2, nkrnf   ;   avt(:,:,jk) = avt(:,:,jk) + 2.e0 * rn_avt_rnf * rnfmsk(:,:) * tmask(:,:,jk)   ;   END DO
+#if defined key_traldf_c2d || key_traldf_c3d
+         IF ( ln_stopack .AND. ( nn_spp_arnf > 0 ) ) THEN
+              rn_avt_rnf0 = rn_avt_rnf
+              CALL spp_gen( kstp, rn_avt_rnf0,nn_spp_arnf,rn_arnf_sd,jk_spp_arnf )
+         ENDIF
+#else
+         IF ( ln_stopack .AND. ( nn_spp_arnf > 0 ) ) &
+            & CALL ctl_stop( 'stp: parameter perturbation will only work with '// &
+                             'key_traldf_c2d or key_traldf_c3d')
+#endif
+         DO jk = 2, nkrnf   ;   avt(:,:,jk) = avt(:,:,jk) + 2.e0 * rn_avt_rnf0(:,:) * rnfmsk(:,:) * tmask(:,:,jk)   ;   END DO
       ENDIF
       IF( ln_zdfevd  )   CALL zdf_evd( kstp )         ! enhanced vertical eddy diffusivity
@@ -163,4 +177,5 @@
       IF( lrst_oce .AND. lk_zdftke )   CALL tke_rst( kstp, 'WRITE' )
       IF( lrst_oce .AND. lk_zdfgls )   CALL gls_rst( kstp, 'WRITE' )
+      IF( lrst_oce .AND. ln_stopack)   CALL stopack_rst( kstp, 'WRITE' )
       !
       !  LATERAL  PHYSICS
@@ -195,11 +210,12 @@
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
                          CALL ssh_nxt       ( kstp )  ! after ssh (includes call to div_cur)
-      IF( lk_vvl     )   CALL dom_vvl_sf_nxt( kstp )  ! after vertical scale factors 
-                         CALL wzv           ( kstp )  ! now cross-level velocity 
-
-      IF( lk_dynspg_ts ) THEN 
+      IF( lk_vvl     )   CALL dom_vvl_sf_nxt( kstp )  ! after vertical scale factors
+                         CALL wzv           ( kstp )  ! now cross-level velocity
+
+      IF( lk_dynspg_ts ) THEN
           ! In case the time splitting case, update almost all momentum trends here:
           ! Note that the computation of vertical velocity above, hence "after" sea level
           ! is necessary to compute momentum advection for the rhs of barotropic loop:
+            IF(ln_sto_eos ) CALL sto_pts( tsn )                             ! Random T/S fluctuations
                             CALL eos    ( tsn, rhd, rhop, fsdept_n(:,:,:) ) ! now in situ density for hpg computation
             IF( ln_zps .AND. .NOT. ln_isfcav)                               &
@@ -214,11 +230,13 @@
                                   va(:,:,:) = 0.e0
           IF(  lk_asminc .AND. ln_asmiau .AND. &
-             & ln_dyninc       )  CALL dyn_asm_inc  ( kstp )   ! apply dynamics assimilation increment
-          IF( ln_neptsimp )       CALL dyn_nept_cor ( kstp )   ! subtract Neptune velocities (simplified)
-          IF( lk_bdy           )  CALL bdy_dyn3d_dmp( kstp )   ! bdy damping trends
-                                  CALL dyn_adv      ( kstp )   ! advection (vector or flux form)
-                                  CALL dyn_vor      ( kstp )   ! vorticity term including Coriolis
-                                  CALL dyn_ldf      ( kstp )   ! lateral mixing
-          IF( ln_neptsimp )       CALL dyn_nept_cor ( kstp )   ! add Neptune velocities (simplified)
+             & ln_dyninc       )  CALL dyn_asm_inc   ( kstp )   ! apply dynamics assimilation increment
+          IF( ln_stopack .AND. ln_sppt_dyn ) &
+             &                    CALL dyn_sppt_apply( kstp, 0 )
+          IF( ln_neptsimp )       CALL dyn_nept_cor  ( kstp )   ! subtract Neptune velocities (simplified)
+          IF( lk_bdy           )  CALL bdy_dyn3d_dmp ( kstp )   ! bdy damping trends
+                                  CALL dyn_adv       ( kstp )   ! advection (vector or flux form)
+                                  CALL dyn_vor       ( kstp )   ! vorticity term including Coriolis
+                                  CALL dyn_ldf       ( kstp )   ! lateral mixing
+          IF( ln_neptsimp )       CALL dyn_nept_cor  ( kstp )   ! add Neptune velocities (simplified)
 #if defined key_agrif
           IF(.NOT. Agrif_Root())  CALL Agrif_Sponge_dyn        ! momentum sponge
@@ -232,5 +250,5 @@
                                   CALL div_cur( kstp )         ! Horizontal divergence & Relative vorticity (2nd call in time-split case)
           IF( lk_vvl     )        CALL dom_vvl_sf_nxt( kstp, kcall=2 )  ! after vertical scale factors (update depth average component)
-                                  CALL wzv           ( kstp )  ! now cross-level velocity 
+                                  CALL wzv           ( kstp )  ! now cross-level velocity
       ENDIF
 
@@ -262,6 +280,8 @@
                              tsa(:,:,:,:) = 0.e0            ! set tracer trends to zero
 
-      IF(  lk_asminc .AND. ln_asmiau .AND. &
-         & ln_trainc     )   CALL tra_asm_inc( kstp )       ! apply tracer assimilation increment
+      IF( ln_stopack .AND. ln_sppt_tra ) &
+         &                   CALL tra_sppt_apply ( kstp, 0 )
+      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
@@ -280,4 +300,6 @@
       IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_tra          ! tracers sponge
 #endif
+      IF( ln_stopack .AND. ln_sppt_tra ) &
+         &                   CALL tra_sppt_apply ( kstp, 1 )
                              CALL tra_zdf    ( kstp )       ! vertical mixing and after tracer fields
 
@@ -285,4 +307,6 @@
          IF( ln_zdfnpc   )   CALL tra_npc( kstp )                ! update after fields by non-penetrative convection
                              CALL tra_nxt( kstp )                ! tracer fields at next time step
+         IF( ln_stopack .AND. ln_sppt_tra ) &
+            &                CALL tra_sppt_apply ( kstp, 2 )
                              CALL eos    ( tsa, rhd, rhop, fsdept_n(:,:,:) )  ! Time-filtered in situ density for hpg computation
             IF( ln_zps .AND. .NOT. ln_isfcav)                                &
@@ -300,5 +324,5 @@
                &             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)                                   & 
+         IF( ln_zps .AND.       ln_isfcav)                                   &
                &             CALL zps_hde_isf( kstp, jpts, tsn, gtsu, gtsv,  &    ! Partial steps for top cell (ISF)
                &                                           rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   &
@@ -308,4 +332,15 @@
                              CALL tra_nxt( kstp )                ! tracer fields at next time step
          IF( ln_bias )       CALL dyn_bias( kstp )
+         IF( ln_stopack .AND. ln_sppt_tra )   THEN
+                                CALL tra_sppt_apply ( kstp, 2 )
+                                CALL eos    ( tsn, rhd, rhop, fsdept_n(:,:,:) )  ! now in situ density for hpg computation
+                                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,  &    ! Partial steps for top cell (ISF)
+                                &                   rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   &
+                                &                   gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the last ocean level
+         ENDIF
       ENDIF
 
@@ -318,10 +353,12 @@
                                ua(:,:,:) = ua_sv(:,:,:)
                                va(:,:,:) = va_sv(:,:,:)
-                                                             ! Revert now divergence and rotational to previously computed ones 
+                                                             ! Revert now divergence and rotational to previously computed ones
                                                              !(needed because of the time swap in div_cur, at the beginning of each time step)
                                hdivn(:,:,:) = hdivb(:,:,:)
-                               rotn(:,:,:)  = rotb(:,:,:) 
+                               rotn(:,:,:)  = rotb(:,:,:)
 
                                CALL dyn_bfr( kstp )         ! bottom friction
+            IF( ln_stopack .AND. ln_sppt_dyn ) &
+               &               CALL dyn_sppt_apply ( kstp, 1 )
                                CALL dyn_zdf( kstp )         ! vertical diffusion
       ELSE
@@ -331,4 +368,6 @@
         IF(  lk_asminc .AND. ln_asmiau .AND. &
            & ln_dyninc      )  CALL dyn_asm_inc( kstp )     ! apply dynamics assimilation increment
+        IF( ln_stopack .AND. ln_sppt_dyn ) &
+           &                   CALL dyn_sppt_apply ( kstp, 0 )
         IF( ln_bkgwri )        CALL asm_bkg_wri( kstp )     ! output background fields
         IF( ln_neptsimp )      CALL dyn_nept_cor( kstp )    ! subtract Neptune velocities (simplified)
@@ -343,8 +382,14 @@
                                CALL dyn_hpg( kstp )         ! horizontal gradient of Hydrostatic pressure
                                CALL dyn_bfr( kstp )         ! bottom friction
+            IF( ln_stopack .AND. ln_sppt_dyn ) &
+               &               CALL dyn_sppt_apply ( kstp, 1 )
                                CALL dyn_zdf( kstp )         ! vertical diffusion
                                CALL dyn_spg( kstp, indic )  ! surface pressure gradient
       ENDIF
                                CALL dyn_nxt( kstp )         ! lateral velocity at next time step
+            IF( ln_stopack .AND. ln_sppt_dyn ) &
+               &               CALL dyn_sppt_apply ( kstp, 2 )
+            IF( ln_stopack .AND. ln_skeb ) &
+               &               CALL skeb_apply ( kstp )
 
                                CALL ssh_swp( kstp )         ! swap of sea surface height
@@ -352,7 +397,7 @@
       !
 
-      ! Moved bias _wrt to before rst_write as used restart parameters for nn_stocklist option that are changed by rst_wrt   
+      ! Moved bias write to before rst_write
       IF( lrst_bias )          CALL bias_wrt     ( kstp )
-
+      
       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
@@ -361,6 +406,6 @@
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
       ! AGRIF
-      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<      
-                               CALL Agrif_Integrate_ChildGrids( stp )  
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                               CALL Agrif_Integrate_ChildGrids( stp )
 
       IF ( Agrif_NbStepint().EQ.0 ) THEN
@@ -393,12 +438,12 @@
       !
 #if defined key_iomput
-      IF( kstp == nitend .OR. indic < 0 ) THEN 
+      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" ) ! 
+         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
Index: branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/step_oce.F90	(revision 15582)
+++ branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/step_oce.F90	(revision 15603)
@@ -96,4 +96,5 @@
    USE diahsb           ! heat, salt and volume budgets    (dia_hsb routine)
    USE diaharm
+   USE diaprod          ! ocean model: product diagnostics
    USE flo_oce          ! floats variables
    USE floats           ! floats computation               (flo_stp routine)
@@ -113,4 +114,6 @@
    USE timing           ! Timing
 
+   USE stopack          ! Stochastic physics
+
 #if defined key_agrif
    USE agrif_opa_sponge ! Momemtum and tracers sponges
