Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90	(revision 10249)
@@ -50,8 +50,19 @@
    USE ice
 #endif
+   USE asminc, ONLY: ln_avgbkg
    IMPLICIT NONE
    PRIVATE
    
    PUBLIC   asm_bkg_wri   !: Write out the background state
+
+  !! * variables for calculating time means
+   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   tn_tavg  , sn_tavg  
+   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   un_tavg  , vn_tavg
+   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   avt_tavg
+#if defined key_zdfgls || key_zdftke
+   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   en_tavg
+#endif
+   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:)   ::   sshn_tavg
+   REAL(wp),SAVE :: numtimes_tavg     ! No of times to average over
 
    !!----------------------------------------------------------------------
@@ -81,9 +92,73 @@
       INTEGER :: inum          ! File unit number
       REAL(wp) :: zdate        ! Date
+      INTEGER :: ierror
       !!-----------------------------------------------------------------------
 
-      !                                !-------------------------------------------
-      IF( kt == nitbkg_r ) THEN        ! Write out background at time step nitbkg_r
-         !                             !-----------------------------------========
+      ! If creating an averaged assim bkg, initialise on first timestep
+      IF ( ln_avgbkg .AND. kt == ( nn_it000 - 1) ) THEN
+         ! Allocate memory 
+         ALLOCATE( tn_tavg(jpi,jpj,jpk), STAT=ierror )
+         IF( ierror > 0 ) THEN
+            CALL ctl_stop( 'asm_wri_bkg: unable to allocate tn_tavg' )   ;   RETURN
+         ENDIF
+         tn_tavg(:,:,:)=0
+         ALLOCATE( sn_tavg(jpi,jpj,jpk), STAT=ierror )
+         IF( ierror > 0 ) THEN
+            CALL ctl_stop( 'asm_wri_bkg: unable to allocate sn_tavg' )   ;   RETURN
+         ENDIF
+         sn_tavg(:,:,:)=0
+         ALLOCATE( un_tavg(jpi,jpj,jpk), STAT=ierror )
+         IF( ierror > 0 ) THEN
+            CALL ctl_stop( 'asm_wri_bkg: unable to allocate un_tavg' )   ;   RETURN
+         ENDIF
+         un_tavg(:,:,:)=0
+         ALLOCATE( vn_tavg(jpi,jpj,jpk), STAT=ierror )
+         IF( ierror > 0 ) THEN
+            CALL ctl_stop( 'asm_wri_bkg: unable to allocate vn_tavg' )   ;   RETURN
+         ENDIF
+         vn_tavg(:,:,:)=0
+         ALLOCATE( sshn_tavg(jpi,jpj), STAT=ierror )
+         IF( ierror > 0 ) THEN
+            CALL ctl_stop( 'asm_wri_bkg: unable to allocate sshn_tavg' )   ;   RETURN
+         ENDIF
+         sshn_tavg(:,:)=0
+#if defined key_zdftke
+         ALLOCATE( en_tavg(jpi,jpj,jpk), STAT=ierror )
+         IF( ierror > 0 ) THEN
+            CALL ctl_stop( 'asm_wri_bkg: unable to allocate en_tavg' )   ;   RETURN
+         ENDIF
+         en_tavg(:,:,:)=0
+#endif
+         ALLOCATE( avt_tavg(jpi,jpj,jpk), STAT=ierror )
+         IF( ierror > 0 ) THEN
+            CALL ctl_stop( 'asm_wri_bkg: unable to allocate avt_tavg' )   ;   RETURN
+         ENDIF
+         avt_tavg(:,:,:)=0
+         
+         numtimes_tavg = REAL ( nitavgbkg_r -  nn_it000 + 1 )
+      ENDIF   
+
+      ! If creating an averaged assim bkg, sum the contribution every timestep
+      IF ( ln_avgbkg ) THEN 
+         IF (lwp) THEN
+              WRITE(numout,*) 'asm_wri_bkg : Summing assim bkg fields at timestep ',kt
+              WRITE(numout,*) '~~~~~~~~~~~~ '
+         ENDIF
+
+         tn_tavg(:,:,:)        = tn_tavg(:,:,:) + tsn(:,:,:,jp_tem) / numtimes_tavg
+         sn_tavg(:,:,:)        = sn_tavg(:,:,:) + tsn(:,:,:,jp_sal) / numtimes_tavg
+         sshn_tavg(:,:)        = sshn_tavg(:,:) + sshn (:,:) / numtimes_tavg
+         un_tavg(:,:,:)        = un_tavg(:,:,:) + un(:,:,:) / numtimes_tavg
+         vn_tavg(:,:,:)        = vn_tavg(:,:,:) + vn(:,:,:) / numtimes_tavg
+         avt_tavg(:,:,:)        = avt_tavg(:,:,:) + avt(:,:,:) / numtimes_tavg
+#if defined key_zdftke
+         en_tavg(:,:,:)       = en_tavg(:,:,:) + en(:,:,:) / numtimes_tavg
+#endif
+      ENDIF
+     
+
+      ! Write out background at time step nitbkg_r or nitavgbkg_r
+      IF ( ( .NOT. ln_avgbkg .AND. (kt == nitbkg_r) ) .OR. &
+      &          ( ln_avgbkg .AND. (kt == nitavgbkg_r) ) ) THEN
          !
          WRITE(cl_asmbkg, FMT='(A,".nc")' ) TRIM( c_asmbkg )
@@ -97,29 +172,56 @@
             CALL iom_open( c_asmbkg, inum, ldwrt = .TRUE., kiolib = jprstlib)
             !
-            IF( nitbkg_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0
-               zdate = REAL( ndastp )
-#if defined key_zdftke
-               ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
-               IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...'
-               CALL tke_rst( nit000, 'READ' )               ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
-
-#endif
+            !
+            ! Write the information
+            IF ( ln_avgbkg ) THEN
+               IF( nitavgbkg_r == nit000 - 1 ) THEN      ! Treat special case when nitavgbkg = 0
+                  zdate = REAL( ndastp )
+#if defined key_zdftke
+                  ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
+                  IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...'
+                  CALL tke_rst( nit000, 'READ' )               ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
+
+#endif
+               ELSE
+                  zdate = REAL( ndastp )
+               ENDIF
+               CALL iom_rstput( kt, nitavgbkg_r, inum, 'rdastp' , zdate   )
+               CALL iom_rstput( kt, nitavgbkg_r, inum, 'un'     , un_tavg )
+               CALL iom_rstput( kt, nitavgbkg_r, inum, 'vn'     , vn_tavg )
+               CALL iom_rstput( kt, nitavgbkg_r, inum, 'tn'     , tn_tavg )
+               CALL iom_rstput( kt, nitavgbkg_r, inum, 'sn'     , sn_tavg )
+               CALL iom_rstput( kt, nitavgbkg_r, inum, 'sshn'   , sshn_tavg)
+#if defined key_zdftke
+               CALL iom_rstput( kt, nitavgbkg_r, inum, 'en'     , en_tavg )
+#endif
+               CALL iom_rstput( kt, nitavgbkg_r, inum, 'avt'    , avt_tavg)
+               !
             ELSE
-               zdate = REAL( ndastp )
+               IF( nitbkg_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0
+                  zdate = REAL( ndastp )
+#if defined key_zdftke
+                  ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
+                  IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...'
+                  CALL tke_rst( nit000, 'READ' )               ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
+
+#endif
+               ELSE
+                  zdate = REAL( ndastp )
+               ENDIF
+               CALL iom_rstput( kt, nitbkg_r, inum, 'rdastp' , zdate   )
+               CALL iom_rstput( kt, nitbkg_r, inum, 'un'     , un                )
+               CALL iom_rstput( kt, nitbkg_r, inum, 'vn'     , vn                )
+               CALL iom_rstput( kt, nitbkg_r, inum, 'tn'     , tsn(:,:,:,jp_tem) )
+               CALL iom_rstput( kt, nitbkg_r, inum, 'sn'     , tsn(:,:,:,jp_sal) )
+               CALL iom_rstput( kt, nitbkg_r, inum, 'sshn'   , sshn              )
+#if defined key_zdftke
+               CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en                )
+#endif
+               CALL iom_rstput( kt, nitbkg_r, inum, 'avt'    , avt               )
+               !
             ENDIF
-            !
-            !                                      ! Write the information
-            CALL iom_rstput( kt, nitbkg_r, inum, 'rdastp' , zdate             )
-            CALL iom_rstput( kt, nitbkg_r, inum, 'un'     , un                )
-            CALL iom_rstput( kt, nitbkg_r, inum, 'vn'     , vn                )
-            CALL iom_rstput( kt, nitbkg_r, inum, 'tn'     , tsn(:,:,:,jp_tem) )
-            CALL iom_rstput( kt, nitbkg_r, inum, 'sn'     , tsn(:,:,:,jp_sal) )
-            CALL iom_rstput( kt, nitbkg_r, inum, 'sshn'   , sshn              )
-#if defined key_zdftke
-            CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en                )
-#endif
-            CALL iom_rstput( kt, nitbkg_r, inum, 'gcx'    , gcx               )
-            !
+            
             CALL iom_close( inum )
+
          ENDIF
          !
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90	(revision 10249)
@@ -40,4 +40,16 @@
 #endif
    USE sbc_oce          ! Surface boundary condition variables.
+   USE zdfmxl, ONLY :  &  
+   &  hmld_tref,       &   
+#if defined key_karaml
+   &  hmld_kara,       &
+   &  ln_kara,         &
+#endif   
+   &  hmld,            & 
+   &  hmlp,            &
+   &  hmlpt
+#if defined key_bdy 
+   USE bdy_oce, ONLY: bdytmask  
+#endif  
 
    IMPLICIT NONE
@@ -57,4 +69,5 @@
 #endif
    LOGICAL, PUBLIC :: ln_bkgwri = .FALSE.      !: No output of the background state fields
+   LOGICAL, PUBLIC :: ln_avgbkg = .FALSE.      !: No output of the mean background state fields
    LOGICAL, PUBLIC :: ln_asmiau = .FALSE.      !: No applying forcing with an assimilation increment
    LOGICAL, PUBLIC :: ln_asmdin = .FALSE.      !: No direct initialization
@@ -78,4 +91,5 @@
    INTEGER , PUBLIC ::   nitiaustr   !: Time step of the start of the IAU interval 
    INTEGER , PUBLIC ::   nitiaufin   !: Time step of the end of the IAU interval
+   INTEGER , PUBLIC ::   nitavgbkg   !: Number of timesteps to average assim bkg [0,nitavgbkg]
    ! 
    INTEGER , PUBLIC ::   niaufn      !: Type of IAU weighing function: = 0   Constant weighting
@@ -85,4 +99,11 @@
    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   ssh_bkg, ssh_bkginc   ! Background sea surface height and its increment
    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   seaice_bkginc         ! Increment to the background sea ice conc
+
+   INTEGER :: mld_choice        = 4   !: choice of mld criteria to use for physics assimilation
+                                      !: 1) hmld      - Turbocline/mixing depth                           [W points]
+                                      !: 2) hmlp      - Density criterion (0.01 kg/m^3 change from 10m)   [W points]
+                                      !: 3) hmld_kara - Kara MLD                                          [Interpolated]
+                                      !: 4) hmld_tref - Temperature criterion (0.2 K change from surface) [T points]
+
 
    !! * Substitutions
@@ -117,4 +138,6 @@
       INTEGER :: iitiaustr_date  ! Date YYYYMMDD of IAU interval start time step
       INTEGER :: iitiaufin_date  ! Date YYYYMMDD of IAU interval final time step
+      INTEGER :: isurfstat       ! Local integer for status of reading surft variable
+      INTEGER :: iitavgbkg_date  ! Date YYYYMMDD of end of assim bkg averaging period
       !
       REAL(wp) :: znorm        ! Normalization factor for IAU weights
@@ -125,11 +148,20 @@
       REAL(wp) :: zdate_inc    ! Time axis in increments file
       !
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: & 
+          &       t_bkginc_2d  ! file for reading in 2D  
+      !                        ! temperature increments 
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: & 
+          &       z_mld     ! Mixed layer depth 
+          
       REAL(wp), POINTER, DIMENSION(:,:) ::   hdiv   ! 2D workspace
-      !!
-      NAMELIST/nam_asminc/ ln_bkgwri,                                      &
+      !
+      LOGICAL :: lk_surft      ! Logical: T => Increments file contains surft variable 
+                               !               so only apply surft increments.
+      !!
+      NAMELIST/nam_asminc/ ln_bkgwri, ln_avgbkg,                           &
          &                 ln_trainc, ln_dyninc, ln_sshinc,                &
          &                 ln_asmdin, ln_asmiau,                           &
          &                 nitbkg, nitdin, nitiaustr, nitiaufin, niaufn,   &
-         &                 ln_salfix, salfixmin, nn_divdmp
+         &                 ln_salfix, salfixmin, nn_divdmp, nitavgbkg, mld_choice
       !!----------------------------------------------------------------------
 
@@ -137,6 +169,23 @@
       ! Read Namelist nam_asminc : assimilation increment interface
       !-----------------------------------------------------------------------
+
+      ! Set default values
+      ln_bkgwri = .FALSE.
+      ln_avgbkg = .FALSE.
+      ln_trainc = .FALSE.
+      ln_dyninc = .FALSE.
+      ln_sshinc = .FALSE.
       ln_seaiceinc = .FALSE.
+      ln_asmdin = .FALSE.
+      ln_asmiau = .TRUE.
+      ln_salfix = .FALSE.
       ln_temnofreeze = .FALSE.
+      salfixmin = -9999
+      nitbkg    = 0
+      nitdin    = 0      
+      nitiaustr = 1
+      nitiaufin = 150
+      niaufn    = 0
+      nitavgbkg = 1
 
       REWIND( numnam_ref )              ! Namelist nam_asminc in reference namelist : Assimilation increment
@@ -156,4 +205,5 @@
          WRITE(numout,*) '   Namelist namasm : set assimilation increment parameters'
          WRITE(numout,*) '      Logical switch for writing out background state          ln_bkgwri = ', ln_bkgwri
+         WRITE(numout,*) '      Logical switch for writing mean background state         ln_avgbkg = ', ln_avgbkg
          WRITE(numout,*) '      Logical switch for applying tracer increments            ln_trainc = ', ln_trainc
          WRITE(numout,*) '      Logical switch for applying velocity increments          ln_dyninc = ', ln_dyninc
@@ -166,7 +216,9 @@
          WRITE(numout,*) '      Timestep of start of IAU interval in [0,nitend-nit000-1] nitiaustr = ', nitiaustr
          WRITE(numout,*) '      Timestep of end of IAU interval in [0,nitend-nit000-1]   nitiaufin = ', nitiaufin
+         WRITE(numout,*) '      Number of timesteps to average assim bkg [0,nitavgbkg]   nitavgbkg = ', nitavgbkg
          WRITE(numout,*) '      Type of IAU weighting function                           niaufn    = ', niaufn
          WRITE(numout,*) '      Logical switch for ensuring that the sa > salfixmin      ln_salfix = ', ln_salfix
          WRITE(numout,*) '      Minimum salinity after applying the increments           salfixmin = ', salfixmin
+         WRITE(numout,*) '      Choice of MLD for physics assimilation                  mld_choice = ', mld_choice
       ENDIF
 
@@ -175,4 +227,5 @@
       nitiaustr_r = nitiaustr + nit000 - 1  ! Start of IAU interval referenced to nit000
       nitiaufin_r = nitiaufin + nit000 - 1  ! End of IAU interval referenced to nit000
+      nitavgbkg_r = nitavgbkg + nit000 - 1  ! Averaging period referenced to nit000
 
       iiauper = nitiaufin_r - nitiaustr_r + 1  ! IAU interval length
@@ -184,4 +237,5 @@
       CALL calc_date( nit000, nitiaustr_r, ndate0, iitiaustr_date )     ! IAU start time referenced to ndate0
       CALL calc_date( nit000, nitiaufin_r, ndate0, iitiaufin_date )     ! IAU end time referenced to ndate0
+      CALL calc_date( nit000, nitavgbkg_r, ndate0, iitavgbkg_date )     ! End of assim bkg averaging period referenced to ndate0
       !
       IF(lwp) THEN
@@ -195,4 +249,5 @@
          WRITE(numout,*) '       nitiaustr_r = ', nitiaustr_r
          WRITE(numout,*) '       nitiaufin_r = ', nitiaufin_r
+         WRITE(numout,*) '       nitavgbkg_r = ', nitavgbkg_r
          WRITE(numout,*)
          WRITE(numout,*) '   Dates referenced to current cycle:'
@@ -204,4 +259,5 @@
          WRITE(numout,*) '       iitiaustr_date = ', iitiaustr_date
          WRITE(numout,*) '       iitiaufin_date = ', iitiaufin_date
+         WRITE(numout,*) '       iitavgbkg_date = ', iitavgbkg_date
       ENDIF
 
@@ -246,4 +302,9 @@
          & CALL ctl_stop( ' nitdin :',  &
          &                ' Background time step for Direct Initialization is outside', &
+         &                ' the cycle interval')
+
+      IF ( nitavgbkg_r > nitend ) &
+         & CALL ctl_stop( ' nitavgbkg_r :',  &
+         &                ' Assim bkg averaging period is outside', &
          &                ' the cycle interval')
 
@@ -325,20 +386,26 @@
       !--------------------------------------------------------------------
 
-      ALLOCATE( t_bkginc(jpi,jpj,jpk) )
-      ALLOCATE( s_bkginc(jpi,jpj,jpk) )
-      ALLOCATE( u_bkginc(jpi,jpj,jpk) )
-      ALLOCATE( v_bkginc(jpi,jpj,jpk) )
-      ALLOCATE( ssh_bkginc(jpi,jpj)   )
-      ALLOCATE( seaice_bkginc(jpi,jpj))
+      IF ( ln_trainc ) THEN
+         ALLOCATE( t_bkginc(jpi,jpj,jpk) )
+         ALLOCATE( s_bkginc(jpi,jpj,jpk) )
+         t_bkginc(:,:,:) = 0.0
+         s_bkginc(:,:,:) = 0.0
+      ENDIF
+      IF ( ln_dyninc ) THEN 
+         ALLOCATE( u_bkginc(jpi,jpj,jpk) )
+         ALLOCATE( v_bkginc(jpi,jpj,jpk) )
+         u_bkginc(:,:,:) = 0.0
+         v_bkginc(:,:,:) = 0.0
+      ENDIF
+      IF ( ln_sshinc ) THEN
+         ALLOCATE( ssh_bkginc(jpi,jpj)   )
+         ssh_bkginc(:,:) = 0.0
+      ENDIF
+      IF ( ln_seaiceinc ) THEN 
+         ALLOCATE( seaice_bkginc(jpi,jpj))
+         seaice_bkginc(:,:) = 0.0
+      ENDIF
 #if defined key_asminc
       ALLOCATE( ssh_iau(jpi,jpj)      )
-#endif
-      t_bkginc(:,:,:) = 0.0
-      s_bkginc(:,:,:) = 0.0
-      u_bkginc(:,:,:) = 0.0
-      v_bkginc(:,:,:) = 0.0
-      ssh_bkginc(:,:) = 0.0
-      seaice_bkginc(:,:) = 0.0
-#if defined key_asminc
       ssh_iau(:,:)    = 0.0
 #endif
@@ -376,13 +443,72 @@
 
          IF ( ln_trainc ) THEN   
-            CALL iom_get( inum, jpdom_autoglo, 'bckint', t_bkginc, 1 )
-            CALL iom_get( inum, jpdom_autoglo, 'bckins', s_bkginc, 1 )
-            ! Apply the masks
-            t_bkginc(:,:,:) = t_bkginc(:,:,:) * tmask(:,:,:)
-            s_bkginc(:,:,:) = s_bkginc(:,:,:) * tmask(:,:,:)
-            ! Set missing increments to 0.0 rather than 1e+20
-            ! to allow for differences in masks
-            WHERE( ABS( t_bkginc(:,:,:) ) > 1.0e+10 ) t_bkginc(:,:,:) = 0.0
-            WHERE( ABS( s_bkginc(:,:,:) ) > 1.0e+10 ) s_bkginc(:,:,:) = 0.0
+
+            !Test if the increments file contains the surft variable.
+            isurfstat = iom_varid( inum, 'bckinsurft', ldstop = .FALSE. )
+            IF ( isurfstat == -1 ) THEN
+               lk_surft = .FALSE.
+            ELSE
+               lk_surft = .TRUE.
+               CALL ctl_warn( ' Applying 2D temperature increment to bottom of ML: ', &
+            &                 ' bckinsurft found in increments file.' )
+            ENDIF             
+
+            IF (lk_surft) THEN 
+                
+               ALLOCATE(z_mld(jpi,jpj)) 
+               SELECT CASE(mld_choice) 
+               CASE(1) 
+                  z_mld = hmld 
+               CASE(2) 
+                  z_mld = hmlp 
+               CASE(3) 
+#if defined key_karaml
+                  IF ( ln_kara ) THEN
+                     z_mld = hmld_kara
+                  ELSE
+                     CALL ctl_stop("Kara mixed layer not calculated as ln_kara=.false.")
+                  ENDIF
+#else
+                  CALL ctl_stop("Kara mixed layer not defined in current version of NEMO")  ! JW: Safety feature, should be removed
+                                                                                            ! once the Kara mixed layer is available 
+#endif
+               CASE(4) 
+                  z_mld = hmld_tref 
+               END SELECT       
+                      
+               ALLOCATE( t_bkginc_2d(jpi,jpj) ) 
+               CALL iom_get( inum, jpdom_autoglo, 'bckinsurft', t_bkginc_2d, 1) 
+#if defined key_bdy                
+               DO jk = 1,jpkm1 
+                  WHERE( z_mld(:,:) > fsdepw(:,:,jk) ) 
+                     t_bkginc(:,:,jk) = t_bkginc_2d(:,:) * 0.5 * &
+                     &       ( 1 + cos( (fsdept(:,:,jk)/z_mld(:,:) ) * rpi ) )
+                     
+                     t_bkginc(:,:,jk) = t_bkginc(:,:,jk) * bdytmask(:,:) 
+                  ELSEWHERE 
+                     t_bkginc(:,:,jk) = 0. 
+                  ENDWHERE 
+               ENDDO 
+#else 
+               t_bkginc(:,:,:) = 0. 
+#endif                
+               s_bkginc(:,:,:) = 0. 
+                
+               DEALLOCATE(z_mld, t_bkginc_2d) 
+            
+            ELSE 
+               
+               CALL iom_get( inum, jpdom_autoglo, 'bckint', t_bkginc, 1 )
+               CALL iom_get( inum, jpdom_autoglo, 'bckins', s_bkginc, 1 )
+               ! Apply the masks
+               t_bkginc(:,:,:) = t_bkginc(:,:,:) * tmask(:,:,:)
+               s_bkginc(:,:,:) = s_bkginc(:,:,:) * tmask(:,:,:)
+               ! Set missing increments to 0.0 rather than 1e+20
+               ! to allow for differences in masks
+               WHERE( ABS( t_bkginc(:,:,:) ) > 1.0e+10 ) t_bkginc(:,:,:) = 0.0
+               WHERE( ABS( s_bkginc(:,:,:) ) > 1.0e+10 ) s_bkginc(:,:,:) = 0.0
+         
+            ENDIF
+
          ENDIF
 
@@ -890,4 +1016,8 @@
             ENDIF
 
+#if defined key_asminc
+         ELSE
+            ssh_iau(:,:) = 0._wp
+#endif
          ENDIF
 
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ASM/asmpar.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ASM/asmpar.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ASM/asmpar.F90	(revision 10249)
@@ -29,4 +29,5 @@
    INTEGER, PUBLIC :: nitiaufin_r   !: IAU final time step referenced to nit000
    INTEGER, PUBLIC :: nittrjfrq     !: Frequency of trajectory output for 4D-VAR
+   INTEGER, PUBLIC :: nitavgbkg_r   !: Averaging period for assim bkg referenced to nit000
 
    !!----------------------------------------------------------------------
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90	(revision 10249)
@@ -71,4 +71,11 @@
       REAL, POINTER, DIMENSION(:,:)   ::  ht_s  !: now snow thickness
 #endif
+#if defined key_top
+      CHARACTER(LEN=20)                   :: cn_obc  !: type of boundary condition to apply
+      REAL(wp)                            :: rn_fac  !: multiplicative scaling factor
+      REAL(wp), POINTER, DIMENSION(:,:)   :: trc     !: now field of the tracer
+      LOGICAL                             :: dmp     !: obc damping term
+#endif
+
    END TYPE OBC_DATA
 
@@ -101,4 +108,9 @@
    LOGICAL, DIMENSION(jp_bdy) ::   ln_tra_dmp               !: =T Tracer damping
    LOGICAL, DIMENSION(jp_bdy) ::   ln_dyn3d_dmp             !: =T Baroclinic velocity damping
+   
+!   !JT
+   LOGICAL, DIMENSION(jp_bdy) ::   ln_ssh_bdy               !: =T USE SSH BDY - name list switch
+!   !JT
+   
    REAL(wp),    DIMENSION(jp_bdy) ::   rn_time_dmp              !: Damping time scale in days
    REAL(wp),    DIMENSION(jp_bdy) ::   rn_time_dmp_out          !: Damping time scale in days at radiation outflow points
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90	(revision 10249)
@@ -37,4 +37,8 @@
 #endif
    USE sbcapr
+#if defined key_top
+   USE par_trc
+   USE trc, ONLY: trn
+#endif
 
    IMPLICIT NONE
@@ -394,4 +398,22 @@
 #endif
       ! end jchanut tschanges
+      
+      
+      !JT use sshn (ssh now) if ln_ssh_bdy set to false in the name list
+      DO ib_bdy = 1, nb_bdy   
+        nblen => idx_bdy(ib_bdy)%nblen
+        dta => dta_bdy(ib_bdy)
+         
+        ilen1(:) = nblen(:)
+        !JT IF( .NOT. dta%ll_ssh ) THEN 
+        IF( .NOT. ln_ssh_bdy(ib_bdy) ) THEN 
+          igrd = 1 ! t Grid
+          DO ib = 1, ilen1(igrd)
+              ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
+              ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
+              dta_bdy(ib_bdy)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1)         
+          END DO 
+        END IF
+      END DO 
 
       IF ( ln_apr_obc ) THEN
@@ -782,10 +804,20 @@
             IF( dta%ll_v2d ) ALLOCATE( dta%v2d(nblen(3)) )
          ENDIF
-         IF ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) THEN
-            IF( dta%ll_ssh ) THEN
-               if(lwp) write(numout,*) '++++++ dta%ssh pointing to fnow'
-               jfld = jfld + 1
-               dta%ssh => bf(jfld)%fnow(:,1,1)
-            ENDIF
+         IF ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) THEN         
+            !JT 
+            !JT allocate ssh if dta%ll_ssh set too false, as may still use it
+            IF (dta%ll_ssh) THEN
+                IF( dta%ll_ssh ) THEN
+                  if(lwp) write(numout,*) '++++++ dta%ssh pointing to fnow'
+                  jfld = jfld + 1
+                  dta%ssh => bf(jfld)%fnow(:,1,1)
+                ENDIF
+            ELSE
+              if(lwp) write(numout,*) '++++++ dta%ssh allocated space'
+              !ALLOCATE( dta_bdy(ib_bdy)%ssh(nblen(1)) )            
+              ALLOCATE( dta%ssh(nblen(1)) )            
+            ENDIF
+            !JT if 
+            
             IF ( dta%ll_u2d ) THEN
                IF ( ln_full_vel_array(ib_bdy) ) THEN
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90	(revision 10249)
@@ -61,4 +61,8 @@
          CASE('zero')
             CALL bdy_dyn3d_zro( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )
+         CASE('zerograd') 
+            CALL bdy_dyn3d_zgrad( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )       
+         CASE('neumann') 
+            CALL bdy_dyn3d_nmn( idx_bdy(ib_bdy), ib_bdy )
          CASE('orlanski')
             CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.false. )
@@ -117,4 +121,54 @@
 
    END SUBROUTINE bdy_dyn3d_spe
+
+   SUBROUTINE bdy_dyn3d_zgrad( idx, dta, kt , ib_bdy ) 
+      !!---------------------------------------------------------------------- 
+      !!                  ***  SUBROUTINE bdy_dyn3d_zgrad  *** 
+      !! 
+      !! ** Purpose : - Enforce a zero gradient of normal velocity 
+      !! 
+      !!---------------------------------------------------------------------- 
+      INTEGER                     ::   kt 
+      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
+      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
+      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index 
+      !! 
+      INTEGER  ::   jb, jk         ! dummy loop indices 
+      INTEGER  ::   ii, ij, igrd   ! local integers 
+      REAL(wp) ::   zwgt           ! boundary weight 
+      INTEGER  ::   fu, fv 
+      !!---------------------------------------------------------------------- 
+      ! 
+      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_zgrad') 
+      ! 
+      igrd = 2                      ! Copying tangential velocity into bdy points 
+      DO jb = 1, idx%nblenrim(igrd) 
+         DO jk = 1, jpkm1 
+            ii   = idx%nbi(jb,igrd) 
+            ij   = idx%nbj(jb,igrd) 
+            fu   = ABS( ABS (NINT( idx%flagu(jb,igrd) ) ) - 1 ) 
+            ua(ii,ij,jk) = ua(ii,ij,jk) * REAL( 1 - fu) + ( ua(ii,ij+fu,jk) * umask(ii,ij+fu,jk) & 
+                        &+ ua(ii,ij-fu,jk) * umask(ii,ij-fu,jk) ) * umask(ii,ij,jk) * REAL( fu ) 
+         END DO 
+      END DO 
+      ! 
+      igrd = 3                      ! Copying tangential velocity into bdy points 
+      DO jb = 1, idx%nblenrim(igrd) 
+         DO jk = 1, jpkm1 
+            ii   = idx%nbi(jb,igrd) 
+            ij   = idx%nbj(jb,igrd) 
+            fv   = ABS( ABS (NINT( idx%flagv(jb,igrd) ) ) - 1 ) 
+            va(ii,ij,jk) = va(ii,ij,jk) * REAL( 1 - fv ) + ( va(ii+fv,ij,jk) * vmask(ii+fv,ij,jk) & 
+                        &+ va(ii-fv,ij,jk) * vmask(ii-fv,ij,jk) ) * vmask(ii,ij,jk) * REAL( fv ) 
+         END DO 
+      END DO 
+      CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )   ! Boundary points should be updated   
+      CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy )    
+      ! 
+      IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
+ 
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_zgrad') 
+ 
+   END SUBROUTINE bdy_dyn3d_zgrad 
 
    SUBROUTINE bdy_dyn3d_zro( idx, dta, kt, ib_bdy )
@@ -303,4 +357,39 @@
    END SUBROUTINE bdy_dyn3d_dmp
 
+   SUBROUTINE bdy_dyn3d_nmn( idx, ib_bdy ) 
+      !!---------------------------------------------------------------------- 
+      !!                 ***  SUBROUTINE bdy_dyn3d_nmn  *** 
+      !!              
+      !!              - Apply Neumann condition to baroclinic velocities.  
+      !!              - Wrapper routine for bdy_nmn 
+      !!  
+      !! 
+      !!---------------------------------------------------------------------- 
+      TYPE(OBC_INDEX),              INTENT(in) ::   idx  ! OBC indices 
+      INTEGER,                      INTENT(in) ::   ib_bdy  ! BDY set index 
+ 
+      INTEGER  ::   jb, igrd                               ! dummy loop indices 
+      !!---------------------------------------------------------------------- 
+ 
+      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_nmn') 
+      ! 
+      !! Note that at this stage the ub and ua arrays contain the baroclinic velocities.  
+      ! 
+      igrd = 2      ! Neumann bc on u-velocity;  
+      !             
+      CALL bdy_nmn( idx, igrd, ua ) 
+ 
+      igrd = 3      ! Neumann bc on v-velocity 
+      !   
+      CALL bdy_nmn( idx, igrd, va ) 
+      ! 
+      CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )    ! Boundary points should be updated 
+      CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy ) 
+      ! 
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_nmn') 
+      ! 
+   END SUBROUTINE bdy_dyn3d_nmn 
+ 
+
 #else
    !!----------------------------------------------------------------------
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90	(revision 10249)
@@ -105,4 +105,9 @@
       !!
       NAMELIST/nambdy_index/ ctypebdy, nbdyind, nbdybeg, nbdyend
+      
+      
+!      ! JT
+      NAMELIST/nambdy_ssh/ ln_ssh_bdy
+!      ! JT
       INTEGER  ::   ios                 ! Local integer output status for namelist read
       !!----------------------------------------------------------------------
@@ -132,4 +137,24 @@
 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, nambdy )
+      !JT Read nambdy_ssh namelist 
+      REWIND( numnam_ref )              ! Namelist nambdy in reference namelist :Unstructured open boundaries  
+      READ  ( numnam_ref, nambdy_ssh, IOSTAT = ios, ERR = 905)
+905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_ssh in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist :Unstructured open boundaries
+      READ  ( numnam_cfg, nambdy_ssh, IOSTAT = ios, ERR = 906)
+906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_ssh in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, nambdy_ssh )
+      
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'nambdy_ssh : use of ssh boundaries'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~'
+      IF(lwp) WRITE(numout,*) '      ln_ssh_bdy: '
+      DO ib_bdy = 1,nb_bdy
+        IF(lwp) WRITE(numout,*) '      ln_ssh_bdy(',ib_bdy,'): ',ln_ssh_bdy(ib_bdy)
+      ENDDO
+      IF(lwp) WRITE(numout,*) '~~~~~~~~'
+      IF(lwp) WRITE(numout,*) 
+      !JT
 
       ! -----------------------------------------
@@ -185,4 +210,20 @@
           CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_dyn2d' )
         END SELECT
+        
+        !JT override dta_bdy(ib_bdy)%ll_ssh with namelist value (ln_ssh_bdy)
+        IF(lwp) WRITE(numout,*) 'nambdy_ssh : use of ssh boundaries'
+        IF(lwp) WRITE(numout,*) '~~~~~~~~'
+        IF(lwp) WRITE(numout,*) '      ib_bdy: ',ib_bdy
+        IF(lwp) WRITE(numout,*) '      Prior to Implementation of nambdy_ssh'
+        IF(lwp) WRITE(numout,*) '      dta_bdy(ib_bdy)%ll_ssh: ',dta_bdy(ib_bdy)%ll_ssh
+        
+        dta_bdy(ib_bdy)%ll_ssh = ln_ssh_bdy(ib_bdy)
+        
+        IF(lwp) WRITE(numout,*) '      After to Implementation of nambdy_ssh'
+        IF(lwp) WRITE(numout,*) '      dta_bdy(ib_bdy)%ll_ssh: ',dta_bdy(ib_bdy)%ll_ssh
+        IF(lwp) WRITE(numout,*) '~~~~~~~~'
+        
+        !JT         
+        
         IF( cn_dyn2d(ib_bdy) /= 'none' ) THEN
            SELECT CASE( nn_dyn2d_dta(ib_bdy) )                   ! 
@@ -213,4 +254,12 @@
              dta_bdy(ib_bdy)%ll_u3d = .true.
              dta_bdy(ib_bdy)%ll_v3d = .true.
+          CASE('neumann') 
+             IF(lwp) WRITE(numout,*) '      Neumann conditions' 
+             dta_bdy(ib_bdy)%ll_u3d = .false. 
+             dta_bdy(ib_bdy)%ll_v3d = .false. 
+          CASE('zerograd') 
+             IF(lwp) WRITE(numout,*) '      Zero gradient for baroclinic velocities' 
+             dta_bdy(ib_bdy)%ll_u3d = .false. 
+             dta_bdy(ib_bdy)%ll_v3d = .false.
           CASE('zero')
              IF(lwp) WRITE(numout,*) '      Zero baroclinic velocities (runoff case)'
@@ -1087,5 +1136,7 @@
             DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
                nbr => idx_bdy(ib_bdy)%nbr(ib,igrd)
-               idx_bdy(ib_bdy)%nbw(ib,igrd) = 1.- TANH( FLOAT( nbr - 1 ) *0.5 )      ! tanh formulation
+               idx_bdy(ib_bdy)%nbw(ib,igrd) = 1.- TANH( FLOAT( nbr - 1 ) * 0.5 &
+                                            &  *(10./ FLOAT(nn_rimwidth(ib_bdy))) ) ! JGraham:modified for rim=15
+!               idx_bdy(ib_bdy)%nbw(ib,igrd) = 1.- TANH( FLOAT( nbr - 1 ) *0.5 )      ! tanh formulation
 !               idx_bdy(ib_bdy)%nbw(ib,igrd) = (FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy)))**2.  ! quadratic
 !               idx_bdy(ib_bdy)%nbw(ib,igrd) =  FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy))       ! linear
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdylib.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdylib.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdylib.F90	(revision 10249)
@@ -26,4 +26,5 @@
    PUBLIC   bdy_orlanski_2d     ! routine called where?
    PUBLIC   bdy_orlanski_3d     ! routine called where?
+   PUBLIC   bdy_nmn     ! routine called where? 
 
    !!----------------------------------------------------------------------
@@ -354,4 +355,77 @@
    END SUBROUTINE bdy_orlanski_3d
 
+   SUBROUTINE bdy_nmn( idx, igrd, phia ) 
+      !!---------------------------------------------------------------------- 
+      !!                 ***  SUBROUTINE bdy_nmn  *** 
+      !!                     
+      !! ** Purpose : Duplicate the value at open boundaries, zero gradient. 
+      !!  
+      !!---------------------------------------------------------------------- 
+      INTEGER,                    INTENT(in)     ::   igrd     ! grid index 
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout)  ::   phia     ! model after 3D field (to be updated) 
+      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
+      !!  
+      REAL(wp) ::   zcoef, zcoef1, zcoef2 
+      REAL(wp), POINTER, DIMENSION(:,:,:)        :: pmask      ! land/sea mask for field 
+      REAL(wp), POINTER, DIMENSION(:,:)        :: bdypmask      ! land/sea mask for field 
+      INTEGER  ::   ib, ik   ! dummy loop indices 
+      INTEGER  ::   ii, ij, ip, jp   ! 2D addresses 
+      !!---------------------------------------------------------------------- 
+      ! 
+      IF( nn_timing == 1 ) CALL timing_start('bdy_nmn') 
+      ! 
+      SELECT CASE(igrd) 
+         CASE(1) 
+            pmask => tmask(:,:,:) 
+            bdypmask => bdytmask(:,:) 
+         CASE(2) 
+            pmask => umask(:,:,:) 
+            bdypmask => bdyumask(:,:) 
+         CASE(3) 
+            pmask => vmask(:,:,:) 
+            bdypmask => bdyvmask(:,:) 
+         CASE DEFAULT ;   CALL ctl_stop( 'unrecognised value for igrd in bdy_nmn' ) 
+      END SELECT 
+      DO ib = 1, idx%nblenrim(igrd) 
+         ii = idx%nbi(ib,igrd) 
+         ij = idx%nbj(ib,igrd) 
+         DO ik = 1, jpkm1 
+            ! search the sense of the gradient 
+            zcoef1 = bdypmask(ii-1,ij  )*pmask(ii-1,ij,ik) +  bdypmask(ii+1,ij  )*pmask(ii+1,ij,ik) 
+            zcoef2 = bdypmask(ii  ,ij-1)*pmask(ii,ij-1,ik) +  bdypmask(ii  ,ij+1)*pmask(ii,ij+1,ik) 
+            IF ( nint(zcoef1+zcoef2) == 0) THEN 
+               ! corner **** we probably only want to set the tangentail component for the dynamics here 
+               zcoef = pmask(ii-1,ij,ik) + pmask(ii+1,ij,ik) +  pmask(ii,ij-1,ik) +  pmask(ii,ij+1,ik) 
+               IF (zcoef > .5_wp) THEN ! Only set none isolated points. 
+                 phia(ii,ij,ik) = phia(ii-1,ij  ,ik) * pmask(ii-1,ij  ,ik) + & 
+                   &              phia(ii+1,ij  ,ik) * pmask(ii+1,ij  ,ik) + & 
+                   &              phia(ii  ,ij-1,ik) * pmask(ii  ,ij-1,ik) + & 
+                   &              phia(ii  ,ij+1,ik) * pmask(ii  ,ij+1,ik) 
+                 phia(ii,ij,ik) = ( phia(ii,ij,ik) / zcoef ) * pmask(ii,ij,ik) 
+               ELSE 
+                 phia(ii,ij,ik) = phia(ii,ij  ,ik) * pmask(ii,ij  ,ik) 
+               ENDIF 
+            ELSEIF ( nint(zcoef1+zcoef2) == 2) THEN 
+               ! oblique corner **** we probably only want to set the normal component for the dynamics here 
+               zcoef = pmask(ii-1,ij,ik)*bdypmask(ii-1,ij  ) + pmask(ii+1,ij,ik)*bdypmask(ii+1,ij  ) + & 
+                   &   pmask(ii,ij-1,ik)*bdypmask(ii,ij -1 ) +  pmask(ii,ij+1,ik)*bdypmask(ii,ij+1  ) 
+               phia(ii,ij,ik) = phia(ii-1,ij  ,ik) * pmask(ii-1,ij  ,ik)*bdypmask(ii-1,ij  ) + & 
+                   &            phia(ii+1,ij  ,ik) * pmask(ii+1,ij  ,ik)*bdypmask(ii+1,ij  )  + & 
+                   &            phia(ii  ,ij-1,ik) * pmask(ii  ,ij-1,ik)*bdypmask(ii,ij -1 ) + & 
+                   &            phia(ii  ,ij+1,ik) * pmask(ii  ,ij+1,ik)*bdypmask(ii,ij+1  ) 
+   
+               phia(ii,ij,ik) = ( phia(ii,ij,ik) / MAX(1._wp, zcoef) ) * pmask(ii,ij,ik) 
+            ELSE 
+               ip = nint(bdypmask(ii+1,ij  )*pmask(ii+1,ij,ik) - bdypmask(ii-1,ij  )*pmask(ii-1,ij,ik)) 
+               jp = nint(bdypmask(ii  ,ij+1)*pmask(ii,ij+1,ik) - bdypmask(ii  ,ij-1)*pmask(ii,ij-1,ik)) 
+               phia(ii,ij,ik) = phia(ii+ip,ij+jp,ik) * pmask(ii+ip,ij+jp,ik) 
+            ENDIF 
+         END DO 
+      END DO 
+      ! 
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_nmn') 
+      ! 
+   END SUBROUTINE bdy_nmn 
+
 
 #else
@@ -366,4 +440,7 @@
       WRITE(*,*) 'bdy_orlanski_3d: You should not have seen this print! error?', kt
    END SUBROUTINE bdy_orlanski_3d
+   SUBROUTINE bdy_nmn( idx, igrd, phia )      ! Empty routine 
+      WRITE(*,*) 'bdy_nmn: You should not have seen this print! error?', kt 
+   END SUBROUTINE bdy_nmn 
 #endif
 
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90	(revision 10249)
@@ -50,4 +50,9 @@
       REAL(wp), POINTER, DIMENSION(:,:,:)    ::   v          !: Tidal constituents : V    (after nodal cor.)
    END TYPE TIDES_DATA
+   INTEGER, PUBLIC, PARAMETER                  ::   jptides_max = 15      !: Max number of tidal contituents
+      LOGICAL, PUBLIC                           ::   ln_harm_ana_store    !: =T Stores data for  harmonic Analysis
+      LOGICAL, PUBLIC                           ::   ln_harm_ana_compute     !: =T  Compute harmonic Analysis
+      LOGICAL, PUBLIC                           ::   ln_harmana_read         !: =T  Decide to do the analysis 
+                                                                             !from scratch or continue previous run
 
 !$AGRIF_DO_NOT_TREAT
@@ -90,5 +95,5 @@
       TYPE(MAP_POINTER), DIMENSION(jpbgrd)      ::   ibmap_ptr           !: array of pointers to nbmap
       !!
-      NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta, ln_bdytide_conj
+      NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta, ln_bdytide_conj, ln_harm_ana_store, ln_harm_ana_compute, ln_harmana_read
       !!----------------------------------------------------------------------
 
@@ -102,4 +107,5 @@
 
       REWIND(numnam_cfg)
+      REWIND(numnam_ref)   ! slwa
 
       DO ib_bdy = 1, nb_bdy
@@ -125,4 +131,7 @@
             IF(lwp) WRITE(numout,*) '             assume complex conjugate   : ', ln_bdytide_conj
             IF(lwp) WRITE(numout,*) '             Number of tidal components to read: ', nb_harmo
+            IF(lwp) WRITE(numout,*) '             Use PCOMS harmonic ananalysis or not: ', ln_harm_ana_store
+            IF(lwp) WRITE(numout,*) '             Compute Final  harmonic ananalysis or not: ', ln_harm_ana_compute
+            IF(lwp) WRITE(numout,*) '             Read in previous days harmonic data or start afresh: ', ln_harmana_read
             IF(lwp) THEN 
                     WRITE(numout,*) '             Tidal components: ' 
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90	(revision 10249)
@@ -91,6 +91,7 @@
       !! 
       REAL(wp) ::   zwgt           ! boundary weight
-      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
-      INTEGER  ::   ii, ij         ! 2D addresses
+      REAL(wp) ::   zcoef, zcoef1,zcoef2 
+      INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
+      INTEGER  ::   ii, ij, ip, jp   ! 2D addresses 
       !!----------------------------------------------------------------------
       !
@@ -160,6 +161,7 @@
       !! 
       REAL(wp) ::   zwgt           ! boundary weight
-      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
-      INTEGER  ::   ii, ij,zcoef, zcoef1,zcoef2, ip, jp   ! 2D addresses
+      REAL(wp) ::   zcoef, zcoef1,zcoef2 
+      INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
+      INTEGER  ::   ii, ij, ip, jp   ! 2D addresses 
       !!----------------------------------------------------------------------
       !
@@ -174,5 +176,5 @@
             zcoef1 = bdytmask(ii-1,ij  ) +  bdytmask(ii+1,ij  )
             zcoef2 = bdytmask(ii  ,ij-1) +  bdytmask(ii  ,ij+1)
-            IF ( zcoef1+zcoef2 == 0) THEN
+            IF ( NINT(zcoef1+zcoef2) == 0) THEN 
                ! corner
                zcoef = tmask(ii-1,ij,ik) + tmask(ii+1,ij,ik) +  tmask(ii,ij-1,ik) +  tmask(ii,ij+1,ik)
@@ -181,13 +183,13 @@
                  &                    tsa(ii  ,ij-1,ik,jp_tem) * tmask(ii  ,ij-1,ik) + &
                  &                    tsa(ii  ,ij+1,ik,jp_tem) * tmask(ii  ,ij+1,ik)
-               tsa(ii,ij,ik,jp_tem) = ( tsa(ii,ij,ik,jp_tem) / MAX( 1, zcoef) ) * tmask(ii,ij,ik)
+               tsa(ii,ij,ik,jp_tem) = ( tsa(ii,ij,ik,jp_tem) / MAX( 1._wp, zcoef) ) * tmask(ii,ij,ik) 
                tsa(ii,ij,ik,jp_sal) = tsa(ii-1,ij  ,ik,jp_sal) * tmask(ii-1,ij  ,ik) + &
                  &                    tsa(ii+1,ij  ,ik,jp_sal) * tmask(ii+1,ij  ,ik) + &
                  &                    tsa(ii  ,ij-1,ik,jp_sal) * tmask(ii  ,ij-1,ik) + &
                  &                    tsa(ii  ,ij+1,ik,jp_sal) * tmask(ii  ,ij+1,ik)
-               tsa(ii,ij,ik,jp_sal) = ( tsa(ii,ij,ik,jp_sal) / MAX( 1, zcoef) ) * tmask(ii,ij,ik)
+               tsa(ii,ij,ik,jp_sal) = ( tsa(ii,ij,ik,jp_sal) / MAX( 1._wp, zcoef) ) * tmask(ii,ij,ik)
             ELSE
-               ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  )
-               jp = bdytmask(ii  ,ij+1) - bdytmask(ii  ,ij-1)
+               ip = NINT(bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  )) 
+               jp = NINT(bdytmask(ii  ,ij+1) - bdytmask(ii  ,ij-1)) 
                tsa(ii,ij,ik,jp_tem) = tsa(ii+ip,ij+jp,ik,jp_tem) * tmask(ii+ip,ij+jp,ik)
                tsa(ii,ij,ik,jp_sal) = tsa(ii+ip,ij+jp,ik,jp_sal) * tmask(ii+ip,ij+jp,ik)
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90	(revision 10249)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90	(revision 10249)
@@ -0,0 +1,373 @@
+MODULE dia25h 
+   !!======================================================================
+   !!                       ***  MODULE  diaharm  ***
+   !! Harmonic analysis of tidal constituents 
+   !!======================================================================
+   !! History :  3.6  !  2014  (E O'Dea)  Original code
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain
+   USE diainsitutem, ONLY: rinsitu_t, theta2t
+   USE in_out_manager  ! I/O units
+   USE iom             ! I/0 library
+   USE wrk_nemo        ! working arrays
+#if defined key_zdftke 
+   USE zdftke, ONLY: en
+#endif
+   USE zdf_oce, ONLY: avt, avm
+#if defined key_zdfgls
+   USE zdfgls, ONLY: mxln
+   USE zdf_oce, ONLY: en
+#endif
+   USE diatmb
+
+   IMPLICIT NONE
+   PRIVATE
+
+   LOGICAL , PUBLIC ::   ln_dia25h     !:  25h mean output
+   PUBLIC   dia_25h_init               ! routine called by nemogcm.F90
+   PUBLIC   dia_25h                    ! routine called by diawri.F90
+
+  !! * variables for calculating 25-hourly means
+   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   tn_25h  , sn_25h, rinsitu_t_25h  
+   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:)   ::   sshn_25h, insitu_bot_25h, temp_bot_25h 
+   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   un_25h  , vn_25h  , wn_25h
+   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   avt_25h , avm_25h
+#if defined key_zdfgls || key_zdftke
+   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   en_25h
+#endif
+#if defined key_zdfgls 
+   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   rmxln_25h
+#endif
+   INTEGER, SAVE :: cnt_25h     ! Counter for 25 hour means
+
+
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.6 , NEMO Consortium (2014)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dia_25h_init 
+      !!---------------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_25h_init  ***
+      !!     
+      !! ** Purpose: Initialization of 25h mean namelist 
+      !!        
+      !! ** Method : Read namelist
+      !!   History
+      !!   3.6  !  08-14  (E. O'Dea) Routine to initialize dia_25h
+      !!---------------------------------------------------------------------------
+      !!
+      INTEGER ::   ios                 ! Local integer output status for namelist read
+      INTEGER ::   ierror              ! Local integer for memory allocation
+      REAL(wp), DIMENSION(jpi,jpj,3)   ::   zwtmb                                 ! temporary workspace
+      !
+      NAMELIST/nam_dia25h/ ln_dia25h
+      !!----------------------------------------------------------------------
+      !
+      REWIND ( numnam_ref )              ! Read Namelist nam_dia25h in reference namelist : 25hour mean diagnostics
+      READ   ( numnam_ref, nam_dia25h, IOSTAT=ios, ERR= 901 )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_dia25h in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist nam_dia25h in configuration namelist  25hour diagnostics
+      READ  ( numnam_cfg, nam_dia25h, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_dia25h in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, nam_dia25h )
+
+      IF(lwp) THEN                   ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dia_25h_init : Output 25 hour mean diagnostics'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) 'Namelist nam_dia25h : set 25h outputs '
+         WRITE(numout,*) 'Switch for 25h diagnostics (T) or not (F)  ln_dia25h  = ', ln_dia25h
+      ENDIF
+      IF( .NOT. ln_dia25h )   RETURN
+      ! ------------------- !
+      ! 1 - Allocate memory !
+      ! ------------------- !
+      ALLOCATE( tn_25h(jpi,jpj,jpk), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate tn_25h' )   ;   RETURN
+      ENDIF
+      ALLOCATE( sn_25h(jpi,jpj,jpk), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate sn_25h' )   ;   RETURN
+      ENDIF
+      ALLOCATE( rinsitu_t_25h(jpi,jpj,jpk), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate rinsitu_t_25h' )   ;   RETURN
+      ENDIF
+      ALLOCATE( insitu_bot_25h(jpi,jpj), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate insitu_bot_25h' )   ;   RETURN
+      ENDIF      
+      ALLOCATE( temp_bot_25h(jpi,jpj), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate temp_bot_25h' )   ;   RETURN
+      ENDIF                           
+      ALLOCATE( un_25h(jpi,jpj,jpk), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate un_25h' )   ;   RETURN
+      ENDIF
+      ALLOCATE( vn_25h(jpi,jpj,jpk), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate vn_25h' )   ;   RETURN
+      ENDIF
+      ALLOCATE( wn_25h(jpi,jpj,jpk), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate wn_25h' )   ;   RETURN
+      ENDIF
+      ALLOCATE( avt_25h(jpi,jpj,jpk), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate avt_25h' )   ;   RETURN
+      ENDIF
+      ALLOCATE( avm_25h(jpi,jpj,jpk), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate avm_25h' )   ;   RETURN
+      ENDIF
+# if defined key_zdfgls || defined key_zdftke
+      ALLOCATE( en_25h(jpi,jpj,jpk), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate en_25h' )   ;   RETURN
+      ENDIF
+#endif
+# if defined key_zdfgls 
+      ALLOCATE( rmxln_25h(jpi,jpj,jpk), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate rmxln_25h' )   ;   RETURN
+      ENDIF
+#endif
+      ALLOCATE( sshn_25h(jpi,jpj), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate sshn_25h' )   ;   RETURN
+      ENDIF
+      ! ------------------------- !
+      ! 2 - Assign Initial Values !
+      ! ------------------------- !
+      cnt_25h = 1  ! sets the first value of sum at timestep 1 (note - should strictly be at timestep zero so before values used where possible) 
+      tn_25h(:,:,:) = tsb(:,:,:,jp_tem)
+      sn_25h(:,:,:) = tsb(:,:,:,jp_sal)
+      CALL theta2t
+      rinsitu_t_25h(:,:,:) = rinsitu_t(:,:,:)
+      CALL dia_calctmb( rinsitu_t(:,:,:),zwtmb )
+      insitu_bot_25h(:,:) = zwtmb(:,:,3)
+      CALL dia_calctmb( tn_25h(:,:,:),zwtmb )
+      temp_bot_25h(:,:) = zwtmb(:,:,3)
+      sshn_25h(:,:) = sshb(:,:)
+      un_25h(:,:,:) = ub(:,:,:)
+      vn_25h(:,:,:) = vb(:,:,:)
+      wn_25h(:,:,:) = wn(:,:,:)
+      avt_25h(:,:,:) = avt(:,:,:)
+      avm_25h(:,:,:) = avm(:,:,:)
+# if defined key_zdfgls || defined key_zdftke
+         en_25h(:,:,:) = en(:,:,:)
+#endif
+# if defined key_zdfgls
+         rmxln_25h(:,:,:) = mxln(:,:,:)
+#endif
+#if defined key_lim3 || defined key_lim2
+         CALL ctl_stop('STOP', 'dia_25h not setup yet to do tidemean ice')
+#endif 
+
+      ! -------------------------- !
+      ! 3 - Return to dia_wri      !
+      ! -------------------------- !
+
+
+   END SUBROUTINE dia_25h_init
+
+
+   SUBROUTINE dia_25h( kt )  
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE dia_25h  ***
+      !!         
+      !!
+      !!--------------------------------------------------------------------
+      !!                   
+      !! ** Purpose :   Write diagnostics with M2/S2 tide removed
+      !!
+      !! ** Method  :   
+      !!      25hr mean outputs for shelf seas
+      !!
+      !! History :
+      !!   ?.0  !  07-04  (A. Hines) New routine, developed from dia_wri_foam
+      !!   3.4  !  02-13  (J. Siddorn) Routine taken from old dia_wri_foam
+      !!   3.6  !  08-14  (E. O'Dea) adapted for VN3.6
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk
+
+      LOGICAL ::   ll_print = .FALSE.    ! =T print and flush numout
+      REAL(wp)                         ::   zsto, zout, zmax, zjulian, zdt, zmdi  ! temporary reals
+      INTEGER                          ::   i_steps                               ! no of timesteps per hour
+      REAL(wp), DIMENSION(jpi,jpj    ) ::   zw2d, un_dm, vn_dm                    ! temporary workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zw3d                                  ! temporary workspace
+      REAL(wp), DIMENSION(jpi,jpj,3)   ::   zwtmb                                 ! temporary workspace
+      INTEGER                          ::   iyear0, nimonth0,iday0                ! start year,imonth,day
+
+      !!----------------------------------------------------------------------
+
+      ! 0. Initialisation
+      ! -----------------
+      ! Define frequency of summing to create 25 h mean
+      zdt = rdt
+      IF( nacc == 1 ) zdt = rdtmin
+
+      IF( MOD( 3600,INT(zdt) ) == 0 ) THEN
+         i_steps = 3600/INT(zdt)
+      ELSE
+         CALL ctl_stop('STOP', 'dia_wri_tide: timestep must give MOD(3600,rdt) = 0 otherwise no hourly values are possible')
+      ENDIF
+
+#if defined key_lim3 || defined key_lim2
+      CALL ctl_stop('STOP', 'dia_wri_tide not setup yet to do tidemean ice')
+#endif
+
+      ! local variable for debugging
+      ll_print = ll_print .AND. lwp
+
+      ! Sum of 25 hourly instantaneous values to give a 25h mean from 24hours
+      ! every day
+      IF( MOD( kt, i_steps ) == 0  .and. kt .ne. nn_it000 ) THEN
+
+         IF (lwp) THEN
+              WRITE(numout,*) 'dia_wri_tide : Summing instantaneous hourly diagnostics at timestep ',kt
+              WRITE(numout,*) '~~~~~~~~~~~~ '
+         ENDIF
+
+         tn_25h(:,:,:)        = tn_25h(:,:,:) + tsn(:,:,:,jp_tem)
+         sn_25h(:,:,:)        = sn_25h(:,:,:) + tsn(:,:,:,jp_sal)
+         CALL theta2t
+         rinsitu_t_25h(:,:,:)  = rinsitu_t_25h(:,:,:) + rinsitu_t(:,:,:)
+         CALL dia_calctmb( rinsitu_t(:,:,:),zwtmb )
+         insitu_bot_25h(:,:)  = insitu_bot_25h(:,:) + zwtmb(:,:,3)
+         zw3d(:,:,:)          = tsn(:,:,:,jp_tem)
+         CALL dia_calctmb( zw3d,zwtmb )
+         temp_bot_25h(:,:)    = temp_bot_25h(:,:) + zwtmb(:,:,3)
+         sshn_25h(:,:)        = sshn_25h(:,:) + sshn (:,:)
+         un_25h(:,:,:)        = un_25h(:,:,:) + un(:,:,:)
+         vn_25h(:,:,:)        = vn_25h(:,:,:) + vn(:,:,:)
+         wn_25h(:,:,:)        = wn_25h(:,:,:) + wn(:,:,:)
+         avt_25h(:,:,:)       = avt_25h(:,:,:) + avt(:,:,:)
+         avm_25h(:,:,:)       = avm_25h(:,:,:) + avm(:,:,:)
+# if defined key_zdfgls || defined key_zdftke
+         en_25h(:,:,:)        = en_25h(:,:,:) + en(:,:,:)
+#endif
+# if defined key_zdfgls
+         rmxln_25h(:,:,:)      = rmxln_25h(:,:,:) + mxln(:,:,:)
+#endif
+         cnt_25h = cnt_25h + 1
+
+         IF (lwp) THEN
+            WRITE(numout,*) 'dia_tide : Summed the following number of hourly values so far',cnt_25h
+         ENDIF
+
+      ENDIF ! MOD( kt, i_steps ) == 0
+
+         ! Write data for 25 hour mean output streams
+      IF( cnt_25h .EQ. 25 .AND.  MOD( kt, i_steps*24) == 0 .AND. kt .NE. nn_it000 ) THEN
+
+            IF(lwp) THEN
+               WRITE(numout,*) 'dia_wri_tide : Writing 25 hour mean tide diagnostics at timestep', kt
+               WRITE(numout,*) '~~~~~~~~~~~~ '
+            ENDIF
+
+            tn_25h(:,:,:)        = tn_25h(:,:,:) / 25.0_wp
+            sn_25h(:,:,:)        = sn_25h(:,:,:) / 25.0_wp
+            rinsitu_t_25h(:,:,:)  = rinsitu_t_25h(:,:,:) / 25.0_wp
+            insitu_bot_25h(:,:)  = insitu_bot_25h(:,:) / 25.0_wp 
+            temp_bot_25h(:,:)    = temp_bot_25h(:,:) /25.0_wp
+            sshn_25h(:,:)        = sshn_25h(:,:) / 25.0_wp
+            un_25h(:,:,:)        = un_25h(:,:,:) / 25.0_wp
+            vn_25h(:,:,:)        = vn_25h(:,:,:) / 25.0_wp
+            wn_25h(:,:,:)        = wn_25h(:,:,:) / 25.0_wp
+            avt_25h(:,:,:)       = avt_25h(:,:,:) / 25.0_wp
+            avm_25h(:,:,:)       = avm_25h(:,:,:) / 25.0_wp
+# if defined key_zdfgls || defined key_zdftke
+            en_25h(:,:,:)        = en_25h(:,:,:) / 25.0_wp
+#endif
+# if defined key_zdfgls
+            rmxln_25h(:,:,:)       = rmxln_25h(:,:,:) / 25.0_wp
+#endif
+
+            IF (lwp)  WRITE(numout,*) 'dia_wri_tide : Mean calculated by dividing 25 hour sums and writing output'
+            zmdi=1.e+20 !missing data indicator for masking
+            ! write tracers (instantaneous)
+            zw3d(:,:,:) = tn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
+            CALL iom_put("temper25h", zw3d)   ! potential temperature
+            CALL theta2t                                                                    ! calculate insitu temp
+            zw3d(:,:,:) = rinsitu_t_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
+            CALL iom_put("tempis25h", zw3d)   ! in-situ temperature
+            zw2d(:,:) = insitu_bot_25h(:,:)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1))
+            CALL iom_put("tempisbot25h", zw2d) ! bottom in-situ temperature
+            zw2d(:,:) = temp_bot_25h(:,:)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1))
+            CALL iom_put("temperbot25h",zw2d) ! bottom potential temperature
+            zw3d(:,:,:) = sn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
+            CALL iom_put( "salin25h", zw3d  )   ! salinity
+            zw2d(:,:) = sshn_25h(:,:)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1))
+            CALL iom_put( "ssh25h", zw2d )   ! sea surface 
+
+
+            ! Write velocities (instantaneous)
+            zw3d(:,:,:) = un_25h(:,:,:)*umask(:,:,:) + zmdi*(1.0-umask(:,:,:))
+            CALL iom_put("vozocrtx25h", zw3d)    ! i-current
+            zw3d(:,:,:) = vn_25h(:,:,:)*vmask(:,:,:) + zmdi*(1.0-vmask(:,:,:))
+            CALL iom_put("vomecrty25h", zw3d  )   ! j-current
+
+            zw3d(:,:,:) = wn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
+            CALL iom_put("vomecrtz25h", zw3d )   ! k-current
+            zw3d(:,:,:) = avt_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
+            CALL iom_put("avt25h", zw3d )   ! diffusivity
+            zw3d(:,:,:) = avm_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
+            CALL iom_put("avm25h", zw3d)   ! viscosity
+#if defined key_zdftke || defined key_zdfgls 
+!           zw3d(:,:,:) = en_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
+!           CALL iom_put("tke25h", zw3d)   ! tke
+#endif
+#if defined key_zdfgls 
+!           zw3d(:,:,:) = rmxln_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
+!           CALL iom_put( "mxln25h",zw3d)
+#endif
+
+            ! After the write reset the values to cnt=1 and sum values equal current value 
+            tn_25h(:,:,:) = tsn(:,:,:,jp_tem)
+            sn_25h(:,:,:) = tsn(:,:,:,jp_sal)
+            CALL theta2t
+            rinsitu_t_25h(:,:,:) = rinsitu_t(:,:,:)
+            CALL dia_calctmb( rinsitu_t(:,:,:),zwtmb )
+            insitu_bot_25h(:,:) = zwtmb(:,:,3)
+            CALL dia_calctmb( tn_25h(:,:,:),zwtmb)
+            temp_bot_25h(:,:) = zwtmb(:,:,3)
+            sshn_25h(:,:) = sshn (:,:)
+            un_25h(:,:,:) = un(:,:,:)
+            vn_25h(:,:,:) = vn(:,:,:)
+            wn_25h(:,:,:) = wn(:,:,:)
+            avt_25h(:,:,:) = avt(:,:,:)
+            avm_25h(:,:,:) = avm(:,:,:)
+# if defined key_zdfgls || defined key_zdftke
+            en_25h(:,:,:) = en(:,:,:)
+#endif
+# if defined key_zdfgls
+            rmxln_25h(:,:,:) = mxln(:,:,:)
+#endif
+            cnt_25h = 1
+            IF (lwp)  WRITE(numout,*) 'dia_wri_tide : After 25hr mean write, reset sum to current value and cnt_25h to one for overlapping average',cnt_25h
+
+      ENDIF !  cnt_25h .EQ. 25 .AND.  MOD( kt, i_steps * 24) == 0 .AND. kt .NE. nn_it000
+
+
+   END SUBROUTINE dia_25h 
+
+   !!======================================================================
+END MODULE dia25h
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90	(revision 10249)
@@ -59,4 +59,5 @@
   PRIVATE  transport
   PRIVATE  dia_dct_wri
+  PRIVATE  dia_dct_wri_NOOS
 
 #include "domzgr_substitute.h90"
@@ -66,14 +67,16 @@
 
   !! * Module variables
-  INTEGER :: nn_dct        ! Frequency of computation
-  INTEGER :: nn_dctwri     ! Frequency of output
-  INTEGER :: nn_secdebug   ! Number of the section to debug
+  INTEGER :: nn_dct      = 1     ! Frequency of computation
+  INTEGER :: nn_dctwri   = 1     ! Frequency of output
+  INTEGER :: nn_secdebug = 0     ! Number of the section to debug
+  INTEGER :: nn_dct_h    = 1     ! Frequency of computation for NOOS hourly files
+  INTEGER :: nn_dctwri_h = 1     ! Frequency of output for NOOS hourly files
    
-  INTEGER, PARAMETER :: nb_class_max  = 10
-  INTEGER, PARAMETER :: nb_sec_max    = 150
-  INTEGER, PARAMETER :: nb_point_max  = 2000
-  INTEGER, PARAMETER :: nb_type_class = 10
-  INTEGER, PARAMETER :: nb_3d_vars    = 3 
-  INTEGER, PARAMETER :: nb_2d_vars    = 2 
+  INTEGER, PARAMETER :: nb_class_max  = 12   ! maximum number of classes, i.e. depth levels or density classes
+  INTEGER, PARAMETER :: nb_sec_max    = 30   ! maximum number of sections
+  INTEGER, PARAMETER :: nb_point_max  = 300  ! maximum number of points in a single section
+  INTEGER, PARAMETER :: nb_type_class       = 14   ! types of calculations, i.e. pos transport, neg transport, heat transport, salt transport
+  INTEGER, PARAMETER :: nb_3d_vars    = 5
+  INTEGER, PARAMETER :: nb_2d_vars    = 2
   INTEGER            :: nb_sec 
 
@@ -102,4 +105,5 @@
                                                      zlay              ! level classes      (99 if you don't want)
      REAL(wp), DIMENSION(nb_type_class,nb_class_max)  :: transport     ! transport output
+     REAL(wp), DIMENSION(nb_type_class,nb_class_max)  :: transport_h   ! transport output
      REAL(wp)                                         :: slopeSection  ! slope of the section
      INTEGER                                          :: nb_point      ! number of points in the section
@@ -111,4 +115,7 @@
   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::  transports_3d 
   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   ::  transports_2d  
+  REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::  transports_3d_h
+  REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   ::  transports_2d_h
+  REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   ::  z_hr_output
 
    !! $Id$
@@ -120,9 +127,12 @@
      !!                   ***  FUNCTION diadct_alloc  *** 
      !!---------------------------------------------------------------------- 
-     INTEGER :: ierr(2) 
+     INTEGER :: ierr(5) 
      !!---------------------------------------------------------------------- 
 
-     ALLOCATE(transports_3d(nb_3d_vars,nb_sec_max,nb_point_max,jpk), STAT=ierr(1) ) 
-     ALLOCATE(transports_2d(nb_2d_vars,nb_sec_max,nb_point_max)    , STAT=ierr(2) ) 
+     ALLOCATE(transports_3d(nb_3d_vars,nb_sec_max,nb_point_max,jpk)  , STAT=ierr(1) ) 
+     ALLOCATE(transports_2d(nb_2d_vars,nb_sec_max,nb_point_max)      , STAT=ierr(2) ) 
+     ALLOCATE(transports_3d_h(nb_3d_vars,nb_sec_max,nb_point_max,jpk), STAT=ierr(3) )
+     ALLOCATE(transports_2d_h(nb_2d_vars,nb_sec_max,nb_point_max)    , STAT=ierr(4) )
+     ALLOCATE(z_hr_output(nb_sec_max,168,nb_class_max)               , STAT=ierr(5) ) ! 168 = 24 * 7days
 
      diadct_alloc = MAXVAL( ierr ) 
@@ -153,10 +163,24 @@
      IF(lwm) WRITE ( numond, namdct )
 
+     IF( ln_NOOS ) THEN
+        nn_dct=3600./rdt         ! hard coded for NOOS transects, to give 25 hour means 
+        nn_dctwri=86400./rdt
+        nn_dct_h=1       ! hard coded for NOOS transects, to give hourly data
+        nn_dctwri_h=3600./rdt
+     ENDIF
+
      IF( lwp ) THEN
         WRITE(numout,*) " "
         WRITE(numout,*) "diadct_init: compute transports through sections "
         WRITE(numout,*) "~~~~~~~~~~~~~~~~~~~~~"
-        WRITE(numout,*) "       Frequency of computation: nn_dct    = ",nn_dct
-        WRITE(numout,*) "       Frequency of write:       nn_dctwri = ",nn_dctwri
+        IF( ln_NOOS ) THEN
+           WRITE(numout,*) "       Frequency of computation hard coded to be every hour: nn_dct    = ",nn_dct
+           WRITE(numout,*) "       Frequency of write hard coded to average 25 instantaneous hour values: nn_dctwri = ",nn_dctwri
+           WRITE(numout,*) "       Frequency of hourly computation hard coded to be every timestep: nn_dct_h  = ",nn_dct_h
+           WRITE(numout,*) "       Frequency of hourly write hard coded to every hour: nn_dctwri_h = ",nn_dctwri_h
+        ELSE
+           WRITE(numout,*) "       Frequency of computation: nn_dct    = ",nn_dct
+           WRITE(numout,*) "       Frequency of write:       nn_dctwri = ",nn_dctwri
+        ENDIF
 
         IF      ( nn_secdebug .GE. 1 .AND. nn_secdebug .LE. nb_sec_max )THEN
@@ -177,12 +201,20 @@
      !open output file
      IF( lwm ) THEN
-        CALL ctl_opn( numdct_vol,  'volume_transport', 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. )
-        CALL ctl_opn( numdct_heat, 'heat_transport'  , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. )
-        CALL ctl_opn( numdct_salt, 'salt_transport'  , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. )
+        IF( ln_NOOS ) THEN
+           CALL ctl_opn( numdct_NOOS  ,'NOOS_transport'  , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. )
+           CALL ctl_opn( numdct_NOOS_h,'NOOS_transport_h', 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. )
+        ELSE
+           CALL ctl_opn( numdct_vol,  'volume_transport', 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. )
+           CALL ctl_opn( numdct_heat, 'heat_transport'  , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. )
+           CALL ctl_opn( numdct_salt, 'salt_transport'  , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. )
+        ENDIF
      ENDIF
 
      ! Initialise arrays to zero 
-     transports_3d(:,:,:,:)=0.0 
-     transports_2d(:,:,:)  =0.0 
+     transports_3d(:,:,:,:)  =0.0 
+     transports_2d(:,:,:)    =0.0 
+     transports_3d_h(:,:,:,:)=0._wp
+     transports_2d_h(:,:,:)  =0._wp
+     z_hr_output(:,:,:)      =0._wp
 
      IF( nn_timing == 1 )   CALL timing_stop('dia_dct_init')
@@ -229,5 +261,5 @@
         CALL wrk_alloc( nb_sec_max,nb_type_class,nb_class_max , zsum  )
      ENDIF    
- 
+     lldebug=.TRUE.
      ! Initialise arrays
      zwork(:) = 0.0 
@@ -243,10 +275,10 @@
  
      ! Compute transport and write only at nn_dctwri
-     IF( MOD(kt,nn_dct)==0 ) THEN 
+     IF( MOD(kt,nn_dct)==0 .or. &                ! compute transport every nn_dct time steps
+         (ln_NOOS .and. kt==nn_it000 ) )  THEN   ! also include first time step when calculating NOOS 25 hour averages
 
         DO jsec=1,nb_sec
 
            !debug this section computing ?
-           lldebug=.FALSE.
            IF( (jsec==nn_secdebug .OR. nn_secdebug==-1) .AND.  kt==nit000+nn_dct-1 .AND. lwp ) lldebug=.TRUE. 
 
@@ -271,4 +303,5 @@
            !Sum on all procs 
            IF( lk_mpp )THEN
+              zsum(:,:,:)=0.0_wp
               ish(1)  =  nb_sec_max*nb_type_class*nb_class_max 
               ish2    = (/nb_sec_max,nb_type_class,nb_class_max/)
@@ -283,10 +316,12 @@
            DO jsec=1,nb_sec
 
-              IF( lwm )CALL dia_dct_wri(kt,jsec,secs(jsec))
+              IF( lwm .and. .not. ln_NOOS )CALL dia_dct_wri(kt,jsec,secs(jsec))
+              IF( lwm .and.       ln_NOOS )CALL dia_dct_wri_NOOS(kt,jsec,secs(jsec))   ! use NOOS specific formatting
             
               !nullify transports values after writing
               transports_3d(:,jsec,:,:)=0.
               transports_2d(:,jsec,:  )=0.
-              secs(jsec)%transport(:,:)=0.  
+              secs(jsec)%transport(:,:)=0. 
+              IF ( ln_NOOS ) CALL transport(secs(jsec),lldebug,jsec)  ! reinitialise for next 25 hour instantaneous average (overlapping values)
 
            ENDDO
@@ -295,4 +330,57 @@
 
      ENDIF
+
+     IF ( MOD(kt,nn_dct_h)==0 ) THEN            ! compute transport every nn_dct_h time steps
+
+        DO jsec=1,nb_sec
+
+           !lldebug=.FALSE.
+           IF( (jsec==nn_secdebug .OR. nn_secdebug==-1) .AND.  kt==nit000+nn_dct_h-1 .AND. lwp ) lldebug=.TRUE. 
+
+           !Compute transport through section  
+           CALL transport_h(secs(jsec),lldebug,jsec) 
+
+        ENDDO
+             
+        IF( MOD(kt,nn_dctwri_h)==0 )THEN
+
+           IF( lwp .AND. kt==nit000+nn_dctwri_h-1 )WRITE(numout,*)"      diadct: average and write hourly files at kt = ",kt         
+  
+           !! divide arrays by nn_dctwri/nn_dct to obtain average
+           transports_3d_h(:,:,:,:)=transports_3d_h(:,:,:,:)/(nn_dctwri_h/nn_dct_h)
+           transports_2d_h(:,:,:)  =transports_2d_h(:,:,:)  /(nn_dctwri_h/nn_dct_h)
+
+           ! Sum over each class
+           DO jsec=1,nb_sec
+              CALL dia_dct_sum_h(secs(jsec),jsec)
+           ENDDO
+ 
+           !Sum on all procs 
+          IF( lk_mpp )THEN
+              ish(1)  =  nb_sec_max*nb_type_class*nb_class_max 
+              ish2    = (/nb_sec_max,nb_type_class,nb_class_max/)
+              DO jsec=1,nb_sec ; zsum(jsec,:,:) = secs(jsec)%transport_h(:,:) ; ENDDO
+              zwork(:)= RESHAPE(zsum(:,:,:), ish )
+              CALL mpp_sum(zwork, ish(1))
+              zsum(:,:,:)= RESHAPE(zwork,ish2)
+              DO jsec=1,nb_sec ; secs(jsec)%transport_h(:,:) = zsum(jsec,:,:) ; ENDDO
+           ENDIF
+
+           !Write the transport
+           DO jsec=1,nb_sec
+
+              IF( lwp .and.       ln_NOOS )CALL dia_dct_wri_NOOS_h(kt/nn_dctwri_h,jsec,secs(jsec))   ! use NOOS specific formatting
+            
+              !nullify transports values after writing
+              transports_3d_h(:,jsec,:,:)=0.0
+              transports_2d_h(:,jsec,:)=0.0
+              secs(jsec)%transport_h(:,:)=0.  
+              IF ( ln_NOOS ) CALL transport_h(secs(jsec),lldebug,jsec)  ! reinitialise for next 25 hour instantaneous average (overlapping values)
+
+           ENDDO
+
+        ENDIF 
+
+     ENDIF    
 
      IF( lk_mpp )THEN
@@ -356,11 +444,12 @@
         secs(jsec)%zlay         = 99._wp         
         secs(jsec)%transport    =  0._wp   ; secs(jsec)%nb_point       = 0
+        secs(jsec)%transport_h  =  0._wp   ; secs(jsec)%nb_point       = 0
 
         !read section's number / name / computing choices / classes / slopeSection / points number
         !-----------------------------------------------------------------------------------------
         READ(numdct_in,iostat=iost)isec
-        IF (iost .NE. 0 )EXIT !end of file 
+        IF (iost .NE. 0 )EXIT !end of file
         WRITE(cltmp,'(a,i4.4,a,i4.4)')'diadct: read sections : Problem of section number: isec= ',isec,' and jsec= ',jsec
-        IF( jsec .NE. isec )  CALL ctl_stop( cltmp )
+        IF( jsec .NE. isec )CALL ctl_stop( cltmp )
 
         IF( lwp .AND. ( jsec==nn_secdebug .OR. nn_secdebug==-1 ) )WRITE(numout,*)"isec ",isec 
@@ -380,4 +469,10 @@
         READ(numdct_in)iptglo
 
+        IF ( ln_NOOS ) THEN
+           WRITE(numout,*) 'Section name = ',TRIM(secs(jsec)%name)
+           WRITE(numout,*) 'coordSec = ',secs(jsec)%coordSec
+           WRITE(numout,*) 'iptglo = ',iptglo
+        ENDIF
+
         !debug
         !-----
@@ -405,4 +500,8 @@
            !read points'coordinates and directions 
            !--------------------------------------
+           IF ( ln_NOOS ) THEN
+              WRITE(numout,*) 'Coords and direction read'
+           ENDIF
+
            coordtemp(:) = POINT_SECTION(0,0) !list of points read
            directemp(:) = 0                  !value of directions of each points
@@ -422,5 +521,5 @@
               ENDDO                  
            ENDIF
- 
+
            !Now each proc selects only points that are in its domain:
            !--------------------------------------------------------
@@ -624,5 +723,5 @@
      !!--------------------------------------------------------
 
-     IF( ld_debug )WRITE(numout,*)'      Compute transport'
+     !!NIALL IF( ld_debug )WRITE(numout,*)'      Compute transport'
 
      !---------------------------!
@@ -710,14 +809,14 @@
               SELECT CASE( sec%direction(jseg) ) 
               CASE(0,1) 
-                 ztn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_tem) ) 
-                 zsn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_sal) ) 
-                 zrhop = interp(k%I,k%J,jk,'V',rhop) 
-                 zrhoi = interp(k%I,k%J,jk,'V',rhd*rau0+rau0) 
+                 ztn   = interp(k%I,k%J,jk,'V',0 ) 
+                 zsn   = interp(k%I,k%J,jk,'V',1 ) 
+                 zrhop = interp(k%I,k%J,jk,'V',2 ) 
+                 zrhoi = interp(k%I,k%J,jk,'V',3 ) 
                  zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I,k%J+1)    ) * vmask(k%I,k%J,1) 
               CASE(2,3) 
-                 ztn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_tem) ) 
-                 zsn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_sal) ) 
-                 zrhop = interp(k%I,k%J,jk,'U',rhop) 
-                 zrhoi = interp(k%I,k%J,jk,'U',rhd*rau0+rau0) 
+                 ztn   = interp(k%I,k%J,jk,'U',0 ) 
+                 zsn   = interp(k%I,k%J,jk,'U',1 ) 
+                 zrhop = interp(k%I,k%J,jk,'U',2 ) 
+                 zrhoi = interp(k%I,k%J,jk,'U',3 ) 
                  zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I+1,k%J)    ) * umask(k%I,k%J,1)  
               END SELECT 
@@ -754,4 +853,6 @@
                  transports_3d(2,jsec,jseg,jk) = transports_3d(2,jsec,jseg,jk)  + zTnorm * ztn * zrhop * rcp
                  transports_3d(3,jsec,jseg,jk) = transports_3d(3,jsec,jseg,jk)  + zTnorm * zsn * zrhop * 0.001
+                 transports_3d(4,jsec,jseg,jk) = transports_3d(4,jsec,jseg,jk)  + zTnorm * 4.e+3_wp * (ztn+273.15) * 1026._wp
+                 transports_3d(5,jsec,jseg,jk) = transports_3d(5,jsec,jseg,jk)  + zTnorm * 0.001 * zsn * 1026._wp
               ENDIF
    
@@ -809,4 +910,218 @@
   END SUBROUTINE transport
   
+  SUBROUTINE transport_h(sec,ld_debug,jsec)
+     !!-------------------------------------------------------------------------------------------
+     !!                     ***  ROUTINE hourly_transport  ***
+     !!
+     !!              Exactly as routine transport but for data summed at
+     !!              each time step and averaged each hour
+     !!
+     !!  Purpose ::  Compute the transport for each point in a section
+     !!
+     !!  Method  ::  Loop over each segment, and each vertical level and add the transport
+     !!              Be aware :          
+     !!              One section is a sum of segments
+     !!              One segment is defined by 2 consecutive points in sec%listPoint
+     !!              All points of sec%listPoint are positioned on the F-point of the cell
+     !! 
+     !!              There are two loops:                 
+     !!              loop on the segment between 2 nodes
+     !!              loop on the level jk
+     !!
+     !! ** Output: Arrays containing the volume,density,salinity,temperature etc
+     !!            transports for each point in a section, summed over each nn_dct.
+     !!
+     !!-------------------------------------------------------------------------------------------
+     !! * Arguments
+     TYPE(SECTION),INTENT(INOUT) :: sec
+     LOGICAL      ,INTENT(IN)    :: ld_debug
+     INTEGER      ,INTENT(IN)    :: jsec        ! numeric identifier of section
+    
+     !! * Local variables
+     INTEGER             :: jk,jseg,jclass,    &!loop on level/segment/classes 
+                            isgnu  , isgnv      !
+     REAL(wp):: zumid        , zvmid        ,  &!U/V velocity on a cell segment
+                zumid_ice    , zvmid_ice    ,  &!U/V ice velocity
+                zTnorm                          !transport of velocity through one cell's sides
+     REAL(wp):: ztn, zsn, zrhoi, zrhop, zsshn, zfsdep ! temperature/salinity/ssh/potential density /depth at u/v point
+
+     TYPE(POINT_SECTION) :: k
+     !!--------------------------------------------------------
+
+     !!NIALL IF( ld_debug )WRITE(numout,*)'      Compute transport'
+
+     !---------------------------!
+     !  COMPUTE TRANSPORT        !
+     !---------------------------!
+     IF(sec%nb_point .NE. 0)THEN   
+
+        !----------------------------------------------------------------------------------------------------
+        !Compute sign for velocities:
+        !
+        !convention:
+        !   non horizontal section: direction + is toward left hand of section
+        !       horizontal section: direction + is toward north of section
+        !
+        !
+        !       slopeSection < 0     slopeSection > 0       slopeSection=inf            slopeSection=0
+        !       ----------------      -----------------     ---------------             --------------
+        !
+        !   isgnv=1         direction +      
+        !  ______         _____             ______                                                   
+        !        |           //|            |                  |                         direction +   
+        !        | isgnu=1  // |            |isgnu=1           |isgnu=1                     /|\
+        !        |_______  //         ______|    \\            | ---\                        |
+        !               |             | isgnv=-1  \\ |         | ---/ direction +       ____________
+        !               |             |          __\\|         |                    
+        !               |             |     direction +        |                      isgnv=1                                 
+        !                                                      
+        !----------------------------------------------------------------------------------------------------
+        isgnu = 1
+        IF( sec%slopeSection .GT. 0 ) THEN  ; isgnv = -1 
+        ELSE                                ; isgnv =  1
+        ENDIF
+
+        IF( ld_debug )write(numout,*)"isgnu isgnv ",isgnu,isgnv
+
+        !--------------------------------------!
+        ! LOOP ON THE SEGMENT BETWEEN 2 NODES  !
+        !--------------------------------------!
+        DO jseg=1,MAX(sec%nb_point-1,0)
+              
+           !-------------------------------------------------------------------------------------------
+           ! Select the appropriate coordinate for computing the velocity of the segment
+           !
+           !                      CASE(0)                                    Case (2)
+           !                      -------                                    --------
+           !  listPoint(jseg)                 listPoint(jseg+1)       listPoint(jseg)  F(i,j)      
+           !      F(i,j)----------V(i+1,j)-------F(i+1,j)                               |
+           !                                                                            |
+           !                                                                            |
+           !                                                                            |
+           !                      Case (3)                                            U(i,j)
+           !                      --------                                              |
+           !                                                                            |
+           !  listPoint(jseg+1) F(i,j+1)                                                |
+           !                        |                                                   |
+           !                        |                                                   |
+           !                        |                                 listPoint(jseg+1) F(i,j-1)
+           !                        |                                            
+           !                        |                                            
+           !                     U(i,j+1)                                            
+           !                        |                                       Case(1)     
+           !                        |                                       ------      
+           !                        |                                            
+           !                        |                 listPoint(jseg+1)             listPoint(jseg)                           
+           !                        |                 F(i-1,j)-----------V(i,j) -------f(jseg)                           
+           ! listPoint(jseg)     F(i,j)
+           ! 
+           !-------------------------------------------------------------------------------------------
+
+           SELECT CASE( sec%direction(jseg) )
+           CASE(0)  ;   k = sec%listPoint(jseg)
+           CASE(1)  ;   k = POINT_SECTION(sec%listPoint(jseg)%I+1,sec%listPoint(jseg)%J)
+           CASE(2)  ;   k = sec%listPoint(jseg)
+           CASE(3)  ;   k = POINT_SECTION(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J+1)
+           END SELECT
+
+           !---------------------------|
+           !     LOOP ON THE LEVEL     |
+           !---------------------------|
+           !Sum of the transport on the vertical 
+           DO jk=1,mbathy(k%I,k%J)
+
+              ! compute temparature, salinity, insitu & potential density, ssh and depth at U/V point
+              SELECT CASE( sec%direction(jseg) )
+              CASE(0,1)
+                 ztn   = interp(k%I,k%J,jk,'V',0 )
+                 zsn   = interp(k%I,k%J,jk,'V',1)
+                 zrhop = interp(k%I,k%J,jk,'V',2)
+                 zrhoi = interp(k%I,k%J,jk,'V',3)
+                 zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I,k%J+1)    ) * vmask(k%I,k%J,1)
+              CASE(2,3)
+                 ztn   = interp(k%I,k%J,jk,'U',0)
+                 zsn   = interp(k%I,k%J,jk,'U',1)
+                 zrhop = interp(k%I,k%J,jk,'U',2)
+                 zrhoi = interp(k%I,k%J,jk,'U',3)
+                 zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I+1,k%J)    ) * umask(k%I,k%J,1) 
+              END SELECT
+
+              zfsdep= fsdept(k%I,k%J,jk)
+ 
+              !compute velocity with the correct direction
+              SELECT CASE( sec%direction(jseg) )
+              CASE(0,1)  
+                 zumid=0.
+                 zvmid=isgnv*vn(k%I,k%J,jk)*vmask(k%I,k%J,jk)
+              CASE(2,3)
+                 zumid=isgnu*un(k%I,k%J,jk)*umask(k%I,k%J,jk)
+                 zvmid=0.
+              END SELECT
+
+              !zTnorm=transport through one cell;
+              !velocity* cell's length * cell's thickness
+              zTnorm=zumid*e2u(k%I,k%J)*  fse3u(k%I,k%J,jk)+     &
+                     zvmid*e1v(k%I,k%J)*  fse3v(k%I,k%J,jk)
+
+#if ! defined key_vvl
+              !add transport due to free surface
+              IF( jk==1 )THEN
+                 zTnorm = zTnorm + zumid* e2u(k%I,k%J) * zsshn * umask(k%I,k%J,jk) + &
+                                   zvmid* e1v(k%I,k%J) * zsshn * vmask(k%I,k%J,jk)
+              ENDIF
+#endif
+              !COMPUTE TRANSPORT 
+
+              transports_3d_h(1,jsec,jseg,jk) = transports_3d_h(1,jsec,jseg,jk) + zTnorm
+ 
+              IF ( sec%llstrpond ) THEN
+                 transports_3d_h(2,jsec,jseg,jk) = transports_3d_h(2,jsec,jseg,jk)  + zTnorm * zrhoi
+                 transports_3d_h(3,jsec,jseg,jk) = transports_3d_h(3,jsec,jseg,jk)  + zTnorm * zrhop
+                 transports_3d_h(4,jsec,jseg,jk) = transports_3d_h(4,jsec,jseg,jk)  + zTnorm * 4.e+3_wp * (ztn+273.15) * 1026._wp
+                 transports_3d_h(5,jsec,jseg,jk) = transports_3d_h(5,jsec,jseg,jk)  + zTnorm * 0.001 * zsn * 1026._wp
+              ENDIF
+
+           ENDDO !end of loop on the level
+
+#if defined key_lim2 || defined key_lim3
+
+           !ICE CASE    
+           !------------
+           IF( sec%ll_ice_section )THEN
+              SELECT CASE (sec%direction(jseg))
+              CASE(0)
+                 zumid_ice = 0
+                 zvmid_ice =  isgnv*0.5*(v_ice(k%I,k%J+1)+v_ice(k%I+1,k%J+1))
+              CASE(1)
+                 zumid_ice = 0
+                 zvmid_ice =  isgnv*0.5*(v_ice(k%I,k%J+1)+v_ice(k%I+1,k%J+1))
+              CASE(2)
+                 zvmid_ice = 0
+                 zumid_ice =  isgnu*0.5*(u_ice(k%I+1,k%J)+u_ice(k%I+1,k%J+1))
+              CASE(3)
+                 zvmid_ice = 0
+                 zumid_ice =  isgnu*0.5*(u_ice(k%I+1,k%J)+u_ice(k%I+1,k%J+1))
+              END SELECT
+   
+              zTnorm=zumid_ice*e2u(k%I,k%J)+zvmid_ice*e1v(k%I,k%J)
+   
+              transports_2d_h(1,jsec,jseg) = transports_2d_h(1,jsec,jseg) + (zTnorm)*   &
+                                   (1.0 - frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J))  &
+                                  *(hsnif(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J) +  &
+                                    hicif(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J)) &
+                                   +zice_vol_pos
+              transports_2d_h(2,jsec,jseg) = transports_2d_h(2,jsec,jseg) + (zTnorm)*   &
+                                    (1.0 -  frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J))  &
+                                   +zice_surf_pos
+   
+           ENDIF !end of ice case
+#endif
+ 
+        ENDDO !end of loop on the segment
+
+     ENDIF   !end of sec%nb_point =0 case
+     !
+  END SUBROUTINE transport_h
+ 
   SUBROUTINE dia_dct_sum(sec,jsec) 
      !!------------------------------------------------------------- 
@@ -890,14 +1205,14 @@
               SELECT CASE( sec%direction(jseg) ) 
               CASE(0,1) 
-                 ztn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_tem) ) 
-                 zsn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_sal) ) 
-                 zrhop = interp(k%I,k%J,jk,'V',rhop) 
-                 zrhoi = interp(k%I,k%J,jk,'V',rhd*rau0+rau0) 
+                 ztn   = interp(k%I,k%J,jk,'V',0 ) 
+                 zsn   = interp(k%I,k%J,jk,'V',1 ) 
+                 zrhop = interp(k%I,k%J,jk,'V',2) 
+                 zrhoi = interp(k%I,k%J,jk,'V',3) 
 
               CASE(2,3) 
-                 ztn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_tem) ) 
-                 zsn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_sal) ) 
-                 zrhop = interp(k%I,k%J,jk,'U',rhop) 
-                 zrhoi = interp(k%I,k%J,jk,'U',rhd*rau0+rau0) 
+                 ztn   = interp(k%I,k%J,jk,'U',0 ) 
+                 zsn   = interp(k%I,k%J,jk,'U',1 ) 
+                 zrhop = interp(k%I,k%J,jk,'U',2 ) 
+                 zrhoi = interp(k%I,k%J,jk,'U',3 ) 
                  zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I+1,k%J)    ) * umask(k%I,k%J,1)  
               END SELECT 
@@ -957,4 +1272,16 @@
                           sec%transport(6,jclass) = sec%transport(6,jclass)+transports_3d(3,jsec,jseg,jk) 
                        ENDIF 
+
+                       IF ( transports_3d(4,jsec,jseg,jk) .GE. 0.0 ) THEN
+                          sec%transport(7,jclass) = sec%transport(7,jclass)+transports_3d(4,jsec,jseg,jk)
+                       ELSE
+                          sec%transport(8,jclass) = sec%transport(8,jclass)+transports_3d(4,jsec,jseg,jk)
+                       ENDIF
+
+                       IF ( transports_3d(5,jsec,jseg,jk) .GE. 0.0 ) THEN
+                          sec%transport( 9,jclass) = sec%transport( 9,jclass)+transports_3d(5,jsec,jseg,jk)
+                       ELSE
+                          sec%transport(10,jclass) = sec%transport(10,jclass)+transports_3d(5,jsec,jseg,jk)
+                       ENDIF
  
                     ELSE 
@@ -963,4 +1290,8 @@
                        sec%transport( 5,jclass) = 0._wp 
                        sec%transport( 6,jclass) = 0._wp 
+                       sec%transport( 7,jclass) = 0._wp
+                       sec%transport( 8,jclass) = 0._wp
+                       sec%transport( 9,jclass) = 0._wp
+                       sec%transport(10,jclass) = 0._wp
                     ENDIF 
  
@@ -977,13 +1308,13 @@
  
               IF ( transports_2d(1,jsec,jseg) .GE. 0.0 ) THEN 
-                 sec%transport( 7,1) = sec%transport( 7,1)+transports_2d(1,jsec,jseg)*1.E-6 
+                 sec%transport(11,1) = sec%transport(11,1)+transports_2d(1,jsec,jseg)*1.E-6 
               ELSE 
-                 sec%transport( 8,1) = sec%transport( 8,1)+transports_2d(1,jsec,jseg)*1.E-6 
+                 sec%transport(12,1) = sec%transport(12,1)+transports_2d(1,jsec,jseg)*1.E-6 
               ENDIF 
  
               IF ( transports_2d(3,jsec,jseg) .GE. 0.0 ) THEN 
-                 sec%transport( 9,1) = sec%transport( 9,1)+transports_2d(2,jsec,jseg)*1.E-6 
+                 sec%transport(13,1) = sec%transport(13,1)+transports_2d(2,jsec,jseg)*1.E-6 
               ELSE 
-                 sec%transport(10,1) = sec%transport(10,1)+transports_2d(2,jsec,jseg)*1.E-6 
+                 sec%transport(14,1) = sec%transport(14,1)+transports_2d(2,jsec,jseg)*1.E-6 
               ENDIF 
  
@@ -995,10 +1326,397 @@
      ELSE  !if sec%nb_point =0 
         sec%transport(1:2,:)=0. 
-        IF (sec%llstrpond) sec%transport(3:6,:)=0. 
-        IF (sec%ll_ice_section) sec%transport(7:10,:)=0. 
+        IF (sec%llstrpond) sec%transport(3:10,:)=0. 
+        IF (sec%ll_ice_section) sec%transport(11:14,:)=0. 
      ENDIF !end of sec%nb_point =0 case 
  
   END SUBROUTINE dia_dct_sum 
+
+  SUBROUTINE dia_dct_sum_h(sec,jsec)
+     !!-------------------------------------------------------------
+     !! Exactly as dia_dct_sum but for hourly files containing data summed at each time step
+     !!
+     !! Purpose: Average the transport over nn_dctwri time steps 
+     !! and sum over the density/salinity/temperature/depth classes
+     !!
+     !! Method: 
+     !!           Sum over relevant grid cells to obtain values
+     !!           for each
+     !!              There are several loops:                 
+     !!              loop on the segment between 2 nodes
+     !!              loop on the level jk
+     !!              loop on the density/temperature/salinity/level classes
+     !!              test on the density/temperature/salinity/level
+     !!
+     !!  ** Method  :Transport through a given section is equal to the sum of transports
+     !!              computed on each proc.
+     !!              On each proc,transport is equal to the sum of transport computed through
+     !!              segments linking each point of sec%listPoint  with the next one.   
+     !!
+     !!-------------------------------------------------------------
+     !! * arguments
+     TYPE(SECTION),INTENT(INOUT) :: sec
+     INTEGER      ,INTENT(IN)    :: jsec        ! numeric identifier of section
+
+     TYPE(POINT_SECTION) :: k
+     INTEGER  :: jk,jseg,jclass                        !loop on level/segment/classes 
+     REAL(wp) :: ztn, zsn, zrhoi, zrhop, zsshn, zfsdep ! temperature/salinity/ssh/potential density /depth at u/v point
+     !!-------------------------------------------------------------
+
+     !! Sum the relevant segments to obtain values for each class
+     IF(sec%nb_point .NE. 0)THEN   
+
+        !--------------------------------------!
+        ! LOOP ON THE SEGMENT BETWEEN 2 NODES  !
+        !--------------------------------------!
+        DO jseg=1,MAX(sec%nb_point-1,0)
+           
+           !-------------------------------------------------------------------------------------------
+           ! Select the appropriate coordinate for computing the velocity of the segment
+           !
+           !                      CASE(0)                                    Case (2)
+           !                      -------                                    --------
+           !  listPoint(jseg)                 listPoint(jseg+1)       listPoint(jseg)  F(i,j)      
+           !      F(i,j)----------V(i+1,j)-------F(i+1,j)                               |
+           !                                                                            |
+           !                                                                            |
+           !                                                                            |
+           !                      Case (3)                                            U(i,j)
+           !                      --------                                              |
+           !                                                                            |
+           !  listPoint(jseg+1) F(i,j+1)                                                |
+           !                        |                                                   |
+           !                        |                                                   |
+           !                        |                                 listPoint(jseg+1) F(i,j-1)
+           !                        |                                            
+           !                        |                                            
+           !                     U(i,j+1)                                            
+           !                        |                                       Case(1)     
+           !                        |                                       ------      
+           !                        |                                            
+           !                        |                 listPoint(jseg+1)             listPoint(jseg)                           
+           !                        |                 F(i-1,j)-----------V(i,j) -------f(jseg)                           
+           ! listPoint(jseg)     F(i,j)
+           ! 
+           !-------------------------------------------------------------------------------------------
+
+           SELECT CASE( sec%direction(jseg) )
+           CASE(0)  ;   k = sec%listPoint(jseg)
+           CASE(1)  ;   k = POINT_SECTION(sec%listPoint(jseg)%I+1,sec%listPoint(jseg)%J)
+           CASE(2)  ;   k = sec%listPoint(jseg)
+           CASE(3)  ;   k = POINT_SECTION(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J+1)
+           END SELECT
+
+           !---------------------------|
+           !     LOOP ON THE LEVEL     |
+           !---------------------------|
+           !Sum of the transport on the vertical 
+           DO jk=1,mbathy(k%I,k%J)
+
+              ! compute temperature, salinity, insitu & potential density, ssh and depth at U/V point
+              SELECT CASE( sec%direction(jseg) )
+              CASE(0,1)
+                 ztn   = interp(k%I,k%J,jk,'V',0 )
+                 zsn   = interp(k%I,k%J,jk,'V',1 )
+                 zrhop = interp(k%I,k%J,jk,'V',2 )
+                 zrhoi = interp(k%I,k%J,jk,'V',3 )
+                 zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I,k%J+1)    ) * vmask(k%I,k%J,1)
+              CASE(2,3)
+                 ztn   = interp(k%I,k%J,jk,'U',0 )
+                 zsn   = interp(k%I,k%J,jk,'U',1 )
+                 zrhop = interp(k%I,k%J,jk,'U',2 )
+                 zrhoi = interp(k%I,k%J,jk,'U',3 )
+                 zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I+1,k%J)    ) * umask(k%I,k%J,1) 
+              END SELECT
+
+              zfsdep= fsdept(k%I,k%J,jk)
+ 
+              !-------------------------------
+              !  LOOP ON THE DENSITY CLASSES |
+              !-------------------------------
+              !The computation is made for each density/heat/salt/... class
+              DO jclass=1,MAX(1,sec%nb_class-1)
+
+                 !----------------------------------------------!
+                 !TEST ON THE DENSITY/SALINITY/TEMPERATURE/LEVEL! 
+                 !----------------------------------------------!
+ 
+                 IF ( (                                                    &
+                    ((( zrhop .GE. (sec%zsigp(jclass)+1000.  )) .AND.      &
+                    (   zrhop .LE. (sec%zsigp(jclass+1)+1000. ))) .OR.     &
+                    ( sec%zsigp(jclass) .EQ. 99.)) .AND.                   &
+
+                    ((( zrhoi .GE. (sec%zsigi(jclass) + 1000.  )) .AND.    &
+                    (   zrhoi .LE. (sec%zsigi(jclass+1)+1000. ))) .OR.     &
+                    ( sec%zsigi(jclass) .EQ. 99.)) .AND.                   &
+
+                    ((( zsn .GT. sec%zsal(jclass)) .AND.                   &
+                    (   zsn .LE. sec%zsal(jclass+1))) .OR.                 &
+                    ( sec%zsal(jclass) .EQ. 99.)) .AND.                    &
+
+                    ((( ztn .GE. sec%ztem(jclass)) .AND.                   &
+                    (   ztn .LE. sec%ztem(jclass+1))) .OR.                 &
+                    ( sec%ztem(jclass) .EQ.99.)) .AND.                     &
+
+                    ((( zfsdep .GE. sec%zlay(jclass)) .AND.                &
+                    (   zfsdep .LE. sec%zlay(jclass+1))) .OR.              &
+                    ( sec%zlay(jclass) .EQ. 99. ))                         &
+                                                                   ))   THEN
+
+                    !SUM THE TRANSPORTS FOR EACH CLASSES FOR THE POSITIVE AND NEGATIVE DIRECTIONS
+                    !----------------------------------------------------------------------------
+                    IF (transports_3d_h(1,jsec,jseg,jk) .GE. 0.0) THEN 
+                       sec%transport_h(1,jclass) = sec%transport_h(1,jclass)+transports_3d_h(1,jsec,jseg,jk)
+                    ELSE
+                       sec%transport_h(2,jclass) = sec%transport_h(2,jclass)+transports_3d_h(1,jsec,jseg,jk)
+                    ENDIF
+                    IF( sec%llstrpond )THEN
+
+                       IF ( transports_3d_h(2,jsec,jseg,jk) .GE. 0.0 ) THEN 
+                          sec%transport_h(3,jclass) = sec%transport_h(3,jclass)+transports_3d_h(2,jsec,jseg,jk) 
+                       ELSE 
+                          sec%transport_h(4,jclass) = sec%transport_h(4,jclass)+transports_3d_h(2,jsec,jseg,jk) 
+                       ENDIF 
+ 
+                       IF ( transports_3d_h(3,jsec,jseg,jk) .GE. 0.0 ) THEN 
+                          sec%transport_h(5,jclass) = sec%transport_h(5,jclass)+transports_3d_h(3,jsec,jseg,jk) 
+                       ELSE 
+                          sec%transport_h(6,jclass) = sec%transport_h(6,jclass)+transports_3d_h(3,jsec,jseg,jk) 
+                       ENDIF 
+
+                       IF ( transports_3d_h(4,jsec,jseg,jk) .GE. 0.0 ) THEN
+                          sec%transport_h(7,jclass) = sec%transport_h(7,jclass)+transports_3d_h(4,jsec,jseg,jk)
+                       ELSE
+                          sec%transport_h(8,jclass) = sec%transport_h(8,jclass)+transports_3d_h(4,jsec,jseg,jk)
+                       ENDIF
+
+                       IF ( transports_3d_h(5,jsec,jseg,jk) .GE. 0.0 ) THEN
+                          sec%transport_h( 9,jclass) = sec%transport_h( 9,jclass)+transports_3d_h(5,jsec,jseg,jk)
+                       ELSE
+                          sec%transport_h(10,jclass) = sec%transport_h(10,jclass)+transports_3d_h(5,jsec,jseg,jk)
+                       ENDIF
+
+                    ELSE
+                       sec%transport_h( 3,jclass) = 0._wp
+                       sec%transport_h( 4,jclass) = 0._wp
+                       sec%transport_h( 5,jclass) = 0._wp
+                       sec%transport_h( 6,jclass) = 0._wp
+                       sec%transport_h( 7,jclass) = 0._wp
+                       sec%transport_h( 8,jclass) = 0._wp
+                       sec%transport_h( 9,jclass) = 0._wp
+                       sec%transport_h(10,jclass) = 0._wp
+                    ENDIF
+
+                 ENDIF ! end of test if point is in class
+   
+              ENDDO ! end of loop on the classes
+
+           ENDDO ! loop over jk
+
+#if defined key_lim2 || defined key_lim3
+
+           !ICE CASE    
+           IF( sec%ll_ice_section )THEN
+
+              IF ( transports_2d_h(1,jsec,jseg) .GE. 0.0 ) THEN
+                 sec%transport_h(11,1) = sec%transport_h(11,1)+transports_2d_h(1,jsec,jseg)
+              ELSE
+                 sec%transport_h(12,1) = sec%transport_h(12,1)+transports_2d_h(1,jsec,jseg)
+              ENDIF
+
+              IF ( transports_2d_h(3,jsec,jseg) .GE. 0.0 ) THEN
+                 sec%transport_h(13,1) = sec%transport_h(13,1)+transports_2d_h(2,jsec,jseg)
+              ELSE
+                 sec%transport_h(14,1) = sec%transport_h(14,1)+transports_2d_h(2,jsec,jseg)
+              ENDIF
+
+           ENDIF !end of ice case
+#endif
+ 
+        ENDDO !end of loop on the segment
+
+     ELSE  !if sec%nb_point =0
+        sec%transport_h(1:2,:)=0.
+        IF (sec%llstrpond) sec%transport_h(3:10,:)=0.
+        IF (sec%ll_ice_section) sec%transport_h( 11:14,:)=0.
+     ENDIF !end of sec%nb_point =0 case
+
+  END SUBROUTINE dia_dct_sum_h
   
+  SUBROUTINE dia_dct_wri_NOOS(kt,ksec,sec)
+     !!-------------------------------------------------------------
+     !! Write transport output in numdct using NOOS formatting 
+     !! 
+     !! Purpose: Write  transports in ascii files
+     !! 
+     !! Method:
+     !!        1. Write volume transports in "volume_transport"
+     !!           Unit: Sv : area * Velocity / 1.e6 
+     !! 
+     !!        2. Write heat transports in "heat_transport"
+     !!           Unit: Peta W : area * Velocity * T * rhau * Cp / 1.e15
+     !! 
+     !!        3. Write salt transports in "salt_transport"
+     !!           Unit: 10^9 g m^3 / s : area * Velocity * S / 1.e6
+     !!
+     !!------------------------------------------------------------- 
+     !!arguments
+     INTEGER, INTENT(IN)          :: kt          ! time-step
+     TYPE(SECTION), INTENT(INOUT) :: sec         ! section to write   
+     INTEGER ,INTENT(IN)          :: ksec        ! section number
+
+     !!local declarations
+     INTEGER               :: jclass,ji             ! Dummy loop
+     CHARACTER(len=2)      :: classe             ! Classname 
+     REAL(wp)              :: zbnd1,zbnd2        ! Class bounds
+     REAL(wp)              :: zslope             ! section's slope coeff
+     !
+     REAL(wp), POINTER, DIMENSION(:):: zsumclasses ! 1D workspace 
+     !!------------------------------------------------------------- 
+     CALL wrk_alloc(nb_type_class , zsumclasses )  
+
+     zsumclasses(:)=0._wp
+     zslope = sec%slopeSection       
+
+     WRITE(numdct_NOOS,'(I4,a1,I2,a1,I2,a12,i3,a17,i3,a10,a25)') nyear,'.',nmonth,'.',nday,'   Transect:',ksec-1,'   No. of layers:',sec%nb_class-1,'   Name: ',sec%name
+
+     DO jclass=1,MAX(1,sec%nb_class-1)
+        zsumclasses(1:nb_type_class)=zsumclasses(1:nb_type_class)+sec%transport(1:nb_type_class,jclass)
+     ENDDO
+ 
+     classe   = 'total   '
+     zbnd1   = 0._wp
+     zbnd2   = 0._wp
+
+     IF ( zslope .gt. 0._wp .and. zslope .ne. 10000._wp ) THEN
+        WRITE(numdct_NOOS,'(9e12.4E2)') -(zsumclasses( 1)+zsumclasses( 2)), -zsumclasses( 2),-zsumclasses( 1),   &
+                                        -(zsumclasses( 7)+zsumclasses( 8)), -zsumclasses( 8),-zsumclasses( 7),   &
+                                        -(zsumclasses( 9)+zsumclasses(10)), -zsumclasses(10),-zsumclasses( 9)
+     ELSE
+        WRITE(numdct_NOOS,'(9e12.4E2)')   zsumclasses( 1)+zsumclasses( 2) ,  zsumclasses( 1), zsumclasses( 2),   &
+                                          zsumclasses( 7)+zsumclasses( 8) ,  zsumclasses( 7), zsumclasses( 8),   &
+                                          zsumclasses( 9)+zsumclasses(10) ,  zsumclasses( 9), zsumclasses(10)
+     ENDIF 
+
+     DO jclass=1,MAX(1,sec%nb_class-1)
+   
+        classe   = 'N       '
+        zbnd1   = 0._wp
+        zbnd2   = 0._wp
+
+        !insitu density classes transports
+        IF( ( sec%zsigi(jclass)   .NE. 99._wp ) .AND. &
+            ( sec%zsigi(jclass+1) .NE. 99._wp )       )THEN
+           classe = 'DI       '
+           zbnd1 = sec%zsigi(jclass)
+           zbnd2 = sec%zsigi(jclass+1)
+        ENDIF
+        !potential density classes transports
+        IF( ( sec%zsigp(jclass)   .NE. 99._wp ) .AND. &
+            ( sec%zsigp(jclass+1) .NE. 99._wp )       )THEN
+           classe = 'DP      '
+           zbnd1 = sec%zsigp(jclass)
+           zbnd2 = sec%zsigp(jclass+1)
+        ENDIF
+        !depth classes transports
+        IF( ( sec%zlay(jclass)    .NE. 99._wp ) .AND. &
+            ( sec%zlay(jclass+1)  .NE. 99._wp )       )THEN 
+           classe = 'Z       '
+           zbnd1 = sec%zlay(jclass)
+           zbnd2 = sec%zlay(jclass+1)
+        ENDIF
+        !salinity classes transports
+        IF( ( sec%zsal(jclass) .NE. 99._wp    ) .AND. &
+            ( sec%zsal(jclass+1) .NE. 99._wp  )       )THEN
+           classe = 'S       '
+           zbnd1 = sec%zsal(jclass)
+           zbnd2 = sec%zsal(jclass+1)   
+        ENDIF
+        !temperature classes transports
+        IF( ( sec%ztem(jclass) .NE. 99._wp     ) .AND. &
+            ( sec%ztem(jclass+1) .NE. 99._wp     )       ) THEN
+           classe = 'T       '
+           zbnd1 = sec%ztem(jclass)
+           zbnd2 = sec%ztem(jclass+1)
+        ENDIF
+                  
+        !write volume transport per class
+        IF ( zslope .gt. 0._wp .and. zslope .ne. 10000._wp ) THEN
+           WRITE(numdct_NOOS,'(9e12.4E2)') -(sec%transport( 1,jclass)+sec%transport( 2,jclass)),-sec%transport( 2,jclass),-sec%transport( 1,jclass), &
+                                           -(sec%transport( 7,jclass)+sec%transport( 8,jclass)),-sec%transport( 8,jclass),-sec%transport( 7,jclass), &
+                                           -(sec%transport( 9,jclass)+sec%transport(10,jclass)),-sec%transport(10,jclass),-sec%transport( 9,jclass)
+        ELSE
+           WRITE(numdct_NOOS,'(9e12.4E2)')   sec%transport( 1,jclass)+sec%transport( 2,jclass) , sec%transport( 1,jclass), sec%transport( 2,jclass), &
+                                             sec%transport( 7,jclass)+sec%transport( 8,jclass) , sec%transport( 7,jclass), sec%transport( 8,jclass), &
+                                             sec%transport( 9,jclass)+sec%transport(10,jclass) , sec%transport( 9,jclass), sec%transport(10,jclass)
+        ENDIF
+
+     ENDDO
+
+     CALL wrk_dealloc(nb_type_class , zsumclasses )  
+
+  END SUBROUTINE dia_dct_wri_NOOS
+
+  SUBROUTINE dia_dct_wri_NOOS_h(hr,ksec,sec)
+     !!-------------------------------------------------------------
+     !! As routine dia_dct_wri_NOOS but for hourly output files
+     !!
+     !! Write transport output in numdct using NOOS formatting 
+     !! 
+     !! Purpose: Write  transports in ascii files
+     !! 
+     !! Method:
+     !!        1. Write volume transports in "volume_transport"
+     !!           Unit: Sv : area * Velocity / 1.e6 
+     !!
+     !!------------------------------------------------------------- 
+     !!arguments
+     INTEGER, INTENT(IN)          :: hr          ! hour
+     TYPE(SECTION), INTENT(INOUT) :: sec         ! section to write   
+     INTEGER ,INTENT(IN)          :: ksec        ! section number
+
+     !!local declarations
+     INTEGER               :: jclass,jhr            ! Dummy loop
+     CHARACTER(len=2)      :: classe             ! Classname 
+     REAL(wp)              :: zbnd1,zbnd2        ! Class bounds
+     REAL(wp)              :: zslope             ! section's slope coeff
+     !
+     REAL(wp), POINTER, DIMENSION(:):: zsumclasses ! 1D workspace 
+     !!------------------------------------------------------------- 
+
+     CALL wrk_alloc(nb_type_class , zsumclasses ) 
+
+     zsumclasses(:)=0._wp
+     zslope = sec%slopeSection       
+
+     DO jclass=1,MAX(1,sec%nb_class-1)
+        zsumclasses(1:nb_type_class)=zsumclasses(1:nb_type_class)+sec%transport_h(1:nb_type_class,jclass)
+     ENDDO
+ 
+     !write volume transport per class
+     IF ( zslope .gt. 0._wp .and. zslope .ne. 10000._wp ) THEN
+        z_hr_output(ksec,hr,1)=-(zsumclasses(1)+zsumclasses(2))
+     ELSE
+        z_hr_output(ksec,hr,1)= (zsumclasses(1)+zsumclasses(2))
+     ENDIF
+
+     DO jclass=1,MAX(1,sec%nb_class-1)
+        IF ( zslope .gt. 0._wp .and. zslope .ne. 10000._wp ) THEN
+           z_hr_output(ksec,hr,jclass+1)=-(sec%transport_h(1,jclass)+sec%transport_h(2,jclass))
+        ELSE
+           z_hr_output(ksec,hr,jclass+1)= (sec%transport_h(1,jclass)+sec%transport_h(2,jclass))
+        ENDIF
+     ENDDO
+
+     IF ( hr .eq. 48._wp ) THEN
+        WRITE(numdct_NOOS_h,'(I4,a1,I2,a1,I2,a12,i3,a17,i3)') nyear,'.',nmonth,'.',nday,'   Transect:',ksec-1,'   No. of layers:',sec%nb_class-1
+        DO jhr=25,48
+           WRITE(numdct_NOOS_h,'(11F12.1)')  z_hr_output(ksec,jhr,1), (z_hr_output(ksec,jhr,jclass+1), jclass=1,MAX(1,10) )
+        ENDDO
+     ENDIF
+
+     CALL wrk_dealloc(nb_type_class , zsumclasses )
+
+  END SUBROUTINE dia_dct_wri_NOOS_h
+
   SUBROUTINE dia_dct_wri(kt,ksec,sec)
      !!-------------------------------------------------------------
@@ -1092,11 +1810,11 @@
            WRITE(numdct_heat,119) ndastp,kt,ksec,sec%name,zslope,  &
                               jclass,classe,zbnd1,zbnd2,&
-                              sec%transport(3,jclass)*1.e-15,sec%transport(4,jclass)*1.e-15, &
-                              ( sec%transport(3,jclass)+sec%transport(4,jclass) )*1.e-15
+                              sec%transport(7,jclass)*1.e-15,sec%transport(8,jclass)*1.e-15, &
+                              ( sec%transport(7,jclass)+sec%transport(8,jclass) )*1.e-15
            !write salt transport per class
            WRITE(numdct_salt,119) ndastp,kt,ksec,sec%name,zslope,  &
                               jclass,classe,zbnd1,zbnd2,&
-                              sec%transport(5,jclass)*1.e-9,sec%transport(6,jclass)*1.e-9,&
-                              (sec%transport(5,jclass)+sec%transport(6,jclass))*1.e-9
+                              sec%transport(9,jclass)*1.e-9,sec%transport(10,jclass)*1.e-9,&
+                              (sec%transport(9,jclass)+sec%transport(10,jclass))*1.e-9
         ENDIF
 
@@ -1117,11 +1835,11 @@
         WRITE(numdct_heat,119) ndastp,kt,ksec,sec%name,zslope, &
                            jclass,"total",zbnd1,zbnd2,&
-                           zsumclasses(3)*1.e-15,zsumclasses(4)*1.e-15,&
-                           (zsumclasses(3)+zsumclasses(4) )*1.e-15
+                           zsumclasses(7)*1.e-15,zsumclasses(8)*1.e-15,&
+                           (zsumclasses(7)+zsumclasses(8) )*1.e-15
         !write total salt transport
         WRITE(numdct_salt,119) ndastp,kt,ksec,sec%name,zslope, &
                            jclass,"total",zbnd1,zbnd2,&
-                           zsumclasses(5)*1.e-9,zsumclasses(6)*1.e-9,&
-                           (zsumclasses(5)+zsumclasses(6))*1.e-9
+                           zsumclasses(9)*1.e-9,zsumclasses(10)*1.e-9,&
+                           (zsumclasses(9)+zsumclasses(10))*1.e-9
      ENDIF
 
@@ -1131,11 +1849,11 @@
         WRITE(numdct_vol,118) ndastp,kt,ksec,sec%name,zslope,&
                               jclass,"ice_vol",zbnd1,zbnd2,&
-                              sec%transport(7,1),sec%transport(8,1),&
-                              sec%transport(7,1)+sec%transport(8,1)
+                              sec%transport(11,1),sec%transport(12,1),&
+                              sec%transport(11,1)+sec%transport(12,1)
         !write total ice surface transport
         WRITE(numdct_vol,118) ndastp,kt,ksec,sec%name,zslope,&
                               jclass,"ice_surf",zbnd1,zbnd2,&
-                              sec%transport(9,1),sec%transport(10,1), &
-                              sec%transport(9,1)+sec%transport(10,1) 
+                              sec%transport(13,1),sec%transport(14,1), &
+                              sec%transport(13,1)+sec%transport(14,1) 
      ENDIF
                                               
@@ -1146,5 +1864,5 @@
   END SUBROUTINE dia_dct_wri
 
-  FUNCTION interp(ki, kj, kk, cd_point, ptab)
+   PURE  FUNCTION interp(ki, kj, kk, cd_point,var) 
   !!----------------------------------------------------------------------
   !!
@@ -1208,6 +1926,6 @@
   !*arguments
   INTEGER, INTENT(IN)                          :: ki, kj, kk   ! coordinate of point
+  INTEGER, INTENT(IN)                          :: var   !  which variable
   CHARACTER(len=1), INTENT(IN)                 :: cd_point     ! type of point (U, V)
-  REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN) :: ptab         ! variable to compute at (ki, kj, kk )
   REAL(wp)                                     :: interp       ! interpolated variable 
 
@@ -1220,4 +1938,6 @@
   !!----------------------------------------------------------------------
 
+ 
+
   IF( cd_point=='U' )THEN 
      ii1 = ki    ; ij1 = kj 
@@ -1250,6 +1970,10 @@
   
      ! result
-     interp = zmsk * ( zwgt2 *  ptab(ii1,ij1,kk) + zwgt1 *  ptab(ii1,ij1,kk) ) / ( zwgt2 + zwgt1 )   
-
+           SELECT CASE( var )
+              CASE(0)  ;    interp = zmsk * ( zwgt2 *  tsn(ii1,ij1,kk,jp_tem) + zwgt1 *  tsn(ii1,ij1,kk,jp_tem) ) / ( zwgt2 + zwgt1 )
+              CASE(1)  ;    interp = zmsk * ( zwgt2 *  tsn(ii1,ij1,kk,jp_sal) + zwgt1 *  tsn(ii1,ij1,kk,jp_sal) ) / ( zwgt2 + zwgt1 )
+              CASE(2)  ;    interp = zmsk * ( zwgt2 *  rhop(ii1,ij1,kk) + zwgt1 *  rhop(ii1,ij1,kk) ) / ( zwgt2 + zwgt1 )
+              CASE(3)  ;    interp = zmsk * ( zwgt2 *  (rhd(ii1,ij1,kk)*rau0+rau0) + zwgt1 *  (rhd(ii1,ij1,kk)*rau0+rau0) ) / ( zwgt2 + zwgt1 )
+           END SELECT
 
   ELSE       ! full step or partial step case 
@@ -1273,20 +1997,51 @@
         IF( ze3t >= 0. )THEN 
            ! zbis
-           zbis = ptab(ii2,ij2,kk) + zwgt1 * ( ptab(ii2,ij2,kk-1) - ptab(ii2,ij2,kk) ) 
+           SELECT CASE( var )
+           CASE(0)  
+                     zbis   =  tsn(ii2,ij2,kk,jp_tem) + zwgt1 *  (tsn(ii2,ij2,kk-1,jp_tem)-tsn(ii2,ij2,kk,jp_tem)   )
+                     interp =  zmsk * ( zet2 * tsn(ii1,ij1,kk,jp_tem) + zet1 * zbis )/( zet1 + zet2 )
+           CASE(1)  
+                     zbis   =  tsn(ii2,ij2,kk,jp_sal) + zwgt1 *  (tsn(ii2,ij2,kk-1,jp_sal)-tsn(ii2,ij2,kk,jp_sal)   )
+                     interp =  zmsk * ( zet2 * tsn(ii1,ij1,kk,jp_sal) + zet1 * zbis )/( zet1 + zet2 )
+           CASE(2)  
+                     zbis   =  rhop(ii2,ij2,kk) + zwgt1 *  (rhop(ii2,ij2,kk-1)-rhop(ii2,ij2,kk)   )
+                     interp =  zmsk * ( zet2 * rhop(ii1,ij1,kk) + zet1 * zbis )/( zet1 + zet2 )
+           CASE(3)  
+                     zbis   =  (rhd(ii2,ij2,kk)*rau0+rau0) + zwgt1 *  ( (rhd(ii2,ij2,kk-1)*rau0+rau0)-(rhd(ii2,ij2,kk)*rau0+rau0)   )
+                     interp =  zmsk * ( zet2 * (rhd(ii1,ij1,kk)*rau0+rau0) + zet1 * zbis )/( zet1 + zet2 )
+           END SELECT
            ! result
-            interp = zmsk * ( zet2 * ptab(ii1,ij1,kk) + zet1 * zbis )/( zet1 + zet2 )
         ELSE
            ! zbis
-           zbis = ptab(ii1,ij1,kk) + zwgt2 * ( ptab(ii1,ij1,kk-1) - ptab(ii1,ij2,kk) )
-           ! result
-           interp = zmsk * ( zet2 * zbis + zet1 * ptab(ii2,ij2,kk) )/( zet1 + zet2 )
+           SELECT CASE( var )
+           CASE(0)  
+                 zbis   = tsn(ii1,ij1,kk,jp_tem) + zwgt2 * ( tsn(ii1,ij1,kk-1,jp_tem) - tsn(ii1,ij2,kk,jp_tem) )
+                 interp = zmsk * ( zet2 * zbis + zet1 * tsn(ii2,ij2,kk,jp_tem) )/( zet1 + zet2 )
+           CASE(1)  
+                 zbis   = tsn(ii1,ij1,kk,jp_sal) + zwgt2 * ( tsn(ii1,ij1,kk-1,jp_sal) - tsn(ii1,ij2,kk,jp_sal) )
+                 interp = zmsk * ( zet2 * zbis + zet1 * tsn(ii2,ij2,kk,jp_sal) )/( zet1 + zet2 )
+           CASE(2)  
+                 zbis   = rhop(ii1,ij1,kk) + zwgt2 * ( rhop(ii1,ij1,kk-1) - rhop(ii1,ij2,kk) )
+                 interp = zmsk * ( zet2 * zbis + zet1 * rhop(ii2,ij2,kk) )/( zet1 + zet2 )
+           CASE(3)  
+                 zbis   = (rhd(ii1,ij1,kk)*rau0+rau0) + zwgt2 * ( (rhd(ii1,ij1,kk-1)*rau0+rau0) - (rhd(ii1,ij2,kk)*rau0+rau0) )
+                 interp = zmsk * ( zet2 * zbis + zet1 * (rhd(ii2,ij2,kk)*rau0+rau0) )/( zet1 + zet2 )
+           END SELECT
         ENDIF    
 
      ELSE
-        interp = zmsk * (  zet2 * ptab(ii1,ij1,kk) + zet1 * ptab(ii2,ij2,kk) )/( zet1 + zet2 )
+        SELECT CASE( var )
+        CASE(0)  
+           interp = zmsk * (  zet2 * tsn(ii1,ij1,kk,jp_tem) + zet1 * tsn(ii2,ij2,kk,jp_tem) )/( zet1 + zet2 )
+        CASE(1)  
+           interp = zmsk * (  zet2 * tsn(ii1,ij1,kk,jp_sal) + zet1 * tsn(ii2,ij2,kk,jp_sal) )/( zet1 + zet2 )
+        CASE(2)  
+           interp = zmsk * (  zet2 * rhop(ii1,ij1,kk) + zet1 * rhop(ii2,ij2,kk) )/( zet1 + zet2 )
+        CASE(3)  
+           interp = zmsk * (  zet2 * (rhd(ii1,ij1,kk)*rau0+rau0) + zet1 * (rhd(ii2,ij2,kk)*rau0+rau0) )/( zet1 + zet2 )
+        END SELECT
      ENDIF
 
   ENDIF
-
 
   END FUNCTION interp
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diaharmana.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diaharmana.F90	(revision 10249)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diaharmana.F90	(revision 10249)
@@ -0,0 +1,667 @@
+MODULE harmonic_analysis
+   !!======================================================================
+   !!                       ***  MODULE  example  ***
+   !! Ocean physics:  On line harmonic analyser
+   !!                 
+   !!=====================================================================
+
+#if defined key_harm_ana
+   !!----------------------------------------------------------------------
+   !!   'key_harm_ana'  :                Calculate harmonic analysis
+   !!----------------------------------------------------------------------
+   !!   harm_ana        :
+   !!   harm_ana_init   :
+   !!----------------------------------------------------------------------
+
+   USE oce             ! ocean dynamics and tracers 
+   USE dom_oce         ! ocean space and time domain
+   USE iom
+   USE in_out_manager  ! I/O units
+   USE phycst          ! physical constants
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE bdy_par         ! Unstructured boundary parameters
+   USE bdy_oce         ! ocean open boundary conditions
+   USE bdytides        ! tidal bdy forcing
+   USE daymod          ! calendar
+   USE tideini
+   USE restart
+   USE ioipsl, ONLY : ju2ymds    ! for calendar
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! *  Routine accessibility
+   PUBLIC harm_ana    ! routine called in step.F90 module
+
+   !! * Module variables
+   INTEGER, PARAMETER ::  nharm_max  =   jptides_max ! max number of harmonics to be analysed 
+   INTEGER, PARAMETER ::  nhm_max    =   2*jptides_max+1 
+   INTEGER, PARAMETER ::  nvab       = 2 ! number of 3D variables
+   INTEGER            ::  nharm
+   INTEGER            ::  nhm 
+   INTEGER ::                 & !!! ** toto namelist (namtoto) **
+      nflag  =  1                ! default value of nflag 
+   REAL(wp), DIMENSION(nharm_max) ::                & 
+      om_tide                     ! tidal frequencies ( rads/sec)
+   REAL(wp), ALLOCATABLE,SAVE,DIMENSION(:)   ::                & 
+      bzz,c,x    ! work arrays
+   REAL(wp) :: cca,ssa,zm,bt
+   REAL(wp) :: ccau,ccav,ssau,ssav
+   REAL(wp), PUBLIC, ALLOCATABLE,DIMENSION(:) :: anau, anav, anaf   ! nodel/phase corrections used by diaharmana
+!
+   REAL(wp), ALLOCATABLE,SAVE,DIMENSION(:,:,:) ::   &
+      bssh,bubar,bvbar        ! work array for ssh anaylsis
+   REAL(wp), ALLOCATABLE,SAVE, DIMENSION(:,:,:) ::   &
+      cosampz, cosampu,cosampv,      &
+      sinampz, sinampu,sinampv
+   REAL(WP), ALLOCATABLE,SAVE,DIMENSION(:,:) :: cc,a
+!
+   REAL(wp), ALLOCATABLE,SAVE,DIMENSION(:,:) ::   &
+      gout,hout        ! arrays for output
+   REAL(wp), ALLOCATABLE,SAVE,DIMENSION(:,:) ::   &
+      huout,hvout,guout,gvout        ! arrays for output
+   REAL(wp), PUBLIC ::   fjulday_startharm       !: Julian Day since start of harmonic analysis
+
+   !! * Substitutions
+
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! or LIM 2.0 , UCL-LOCEAN-IPSL (2005)
+   !! or  TOP 1.0 , LOCEAN-IPSL (2005)
+   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/module_example,v 1.3 2005/03/27 18:34:47 opalod Exp $ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE harm_ana( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE harm_ana  ***
+      !!
+      !! ** Purpose :   Harmonic analyser
+      !!
+      !! ** Method  :   
+      !!
+      !! ** Action  : - first action (share memory array/varible modified
+      !!                in this routine
+      !!              - second action .....
+      !!              - .....
+      !!
+      !! References :
+      !!   Give references if exist otherwise suppress these lines
+      !!
+      !! History :
+      !!   9.0  !  03-08  (Autor Names)  Original code
+      !!        !  02-08  (Author names)  brief description of modifications
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   &  
+         kt                          ! describe it!!!
+
+      !! * local declarations
+      INTEGER ::   ji, jj, jk,  &        ! dummy loop arguments
+                   ih,i1,i2,iv,jgrid
+
+
+      !!--------------------------------------------------------------------
+
+
+
+      IF( kt == nit000  )   CALL harm_ana_init    ! Initialization (first time-step only)
+
+! this bit done every time step
+        !nharm=ncpt_anal
+        nharm=nb_harmo
+        nhm=2*nb_harmo+1
+       
+        c(1)=1.0
+
+        do ih=1,nb_harmo
+             c(2*ih)=    cos((fjulday-fjulday_startharm)*86400._wp*om_tide(ih)  )
+             c(2*ih+1)=  sin((fjulday-fjulday_startharm)*86400._wp*om_tide(ih)  )
+        enddo
+
+
+         do ji=1,jpi
+          do jj=1,jpj
+            do ih=1,nhm
+            bssh (ih,ji,jj)=bssh (ih,ji,jj)+c(ih)*sshn(ji,jj)
+            bubar(ih,ji,jj)=bubar(ih,ji,jj)+c(ih)*un_b(ji,jj)
+            bvbar(ih,ji,jj)=bvbar(ih,ji,jj)+c(ih)*vn_b(ji,jj)
+            enddo
+          enddo
+        enddo
+!  
+!        IF(lwp) WRITE(666,'(4E15.5)') adatrj*86400._wp, sshn(10,10),bssh(2,10,10),bssh(3,10,10)
+!
+         do i1=1,nhm
+           do i2=1,nhm
+             cc(i1,i2)=cc(i1,i2)+c(i1)*c(i2)
+            enddo
+         enddo
+!
+! At End of run
+
+      IF (kt ==  nitend  ) then
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'harm_ana : harmonic analysis of tides at end of run'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
+      CALL harm_rst_write(kt)     ! Dump out data for a restarted run
+
+
+      if(ln_harm_ana_compute) then
+               WRITE(numout,*) "Computing harmonics at last step"
+!
+        cosampu=0.0_wp
+        sinampu=0.0_wp
+        cosampv=0.0_wp
+        sinampv=0.0_wp
+        cosampz=0.0_wp
+        sinampz=0.0_wp
+!
+     do jgrid=1,3 ! elevation, Ubar,Vbar
+        do ji=1,jpi
+            do jj=1,jpj
+               bt=1.0
+               do ih=1,nhm
+                   if(jgrid .eq. 1) then
+                     bzz(ih)=bssh(ih,ji,jj)
+                   endif
+                   if(jgrid .eq. 2) then
+                     bzz(ih)=bubar(ih,ji,jj)
+                   endif
+                   if(jgrid .eq. 3) then
+                     bzz(ih)=bvbar(ih,ji,jj)
+                   endif
+                   bt=bt*bzz(ih)
+               enddo
+
+               do i1=1,nhm
+                   do i2=1,nhm
+                       a(i1,i2)=cc(i1,i2)
+                   enddo
+               enddo
+!	now do gaussian elimination of the system
+!	a * x = b
+! 	the matrix x is (a0,a1,b1,a2,b2 ...)
+!	the matrix a and rhs b solved here for x
+              x=0.0d0
+              if(bt.ne.0.) then
+                  if(lwp .and. ji == 10 .and. ji == 10) then
+              endif
+              call gelim(a,bzz,x,nhm)
+
+              do ih=1,nb_harmo
+                if(jgrid .eq. 1) then
+                   cosampz(ih,ji,jj)=x(ih*2)
+                   sinampz(ih,ji,jj)=x(ih*2+1)
+                endif
+                if(jgrid .eq. 2) then
+                   cosampu(ih,ji,jj)=x(ih*2)
+                   sinampu(ih,ji,jj)=x(ih*2+1)
+                endif
+                if(jgrid .eq. 3) then
+                   cosampv(ih,ji,jj)=x(ih*2)
+                   sinampv(ih,ji,jj)=x(ih*2+1)
+                endif
+              enddo
+                if(jgrid .eq. 1) then
+                  cosampz(0,ji,jj)=x(1)
+                  sinampz(0,ji,jj)=0.0_wp
+                endif
+                if(jgrid .eq. 2) then
+                  cosampu(0,ji,jj)=x(1)
+                  sinampu(0,ji,jj)=0.0_wp
+                endif
+                if(jgrid .eq. 3) then
+                  cosampv(0,ji,jj)=x(1)
+                  sinampv(0,ji,jj)=0.0_wp
+                endif
+              endif
+           enddo
+        enddo
+      enddo ! jgrid
+!
+!
+        CALL harm_ana_out     ! output analysis (last time step)
+     ELSE ! ln_harmana_compute 
+         WRITE(numout,*) "Skipping Computing harmonics at last step"
+     ENDIF
+       
+    ENDIF
+   END SUBROUTINE harm_ana
+
+   SUBROUTINE harm_ana_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE harm_ana_init  ***
+      !!                   
+      !! ** Purpose :   initialization of ....
+      !!
+      !! ** Method  :   blah blah blah ...
+      !!
+      !! ** input   :   Namlist namexa
+      !!
+      !! ** Action  :   ...  
+      !!
+      !! history :
+      !!   9.0  !  03-08  (Autor Names)  Original code
+      !!----------------------------------------------------------------------
+      !! * local declarations
+      INTEGER ::   ji, jj, jk, jit,ih   ! dummy loop indices
+
+      !!----------------------------------------------------------------------
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'harm_init : initialization of harmonic analysis of tides'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
+     ! DO ALLOCATIONS
+
+      ALLOCATE( bubar(nb_harmo*2+1,jpi,jpj) )
+      ALLOCATE( bvbar(nb_harmo*2+1,jpi,jpj) )
+      ALLOCATE( bssh (nb_harmo*2+1,jpi,jpj) )
+
+      ALLOCATE( cosampz(0:nb_harmo*2+1,jpi,jpj))
+      ALLOCATE( cosampu(0:nb_harmo*2+1,jpi,jpj))
+      ALLOCATE( cosampv(0:nb_harmo*2+1,jpi,jpj))
+
+      ALLOCATE( sinampz(0:nb_harmo*2+1,jpi,jpj))
+      ALLOCATE( sinampu(0:nb_harmo*2+1,jpi,jpj))
+      ALLOCATE( sinampv(0:nb_harmo*2+1,jpi,jpj))
+
+      ALLOCATE( cc(nb_harmo*2+1,nb_harmo*2+1) )
+
+      ALLOCATE( a(nb_harmo*2+1,nb_harmo*2+1) )
+
+      ALLOCATE( anau(nb_harmo) )
+      ALLOCATE( anav(nb_harmo) )
+      ALLOCATE( anaf(nb_harmo) )
+
+      ALLOCATE( bzz(nb_harmo*2+1) )
+      ALLOCATE( x(nb_harmo*2+1) )
+      ALLOCATE( c(nb_harmo*2+1) )
+
+      ALLOCATE( gout(jpi,jpj))
+      ALLOCATE( hout(jpi,jpj))
+
+      ALLOCATE( guout(jpi,jpj))
+      ALLOCATE( huout(jpi,jpj))
+
+      ALLOCATE( gvout(jpi,jpj))
+      ALLOCATE( hvout(jpi,jpj))
+
+        ! END ALLOCATE 
+
+                 do ih=1,nb_harmo
+                  om_tide(ih)= omega_tide(ih) 
+                 enddo
+       if(ln_harmana_read) then
+               WRITE(numout,*) "Reading previous harmonic data from previous run"
+               ! Need to read in  bssh bz, cc anau anav and anaf 
+               call harm_rst_read  ! This reads in from the previous day
+                                   ! Currrently the data in in assci format
+       else
+               WRITE(numout,*) "Starting harmonic analysis from Fresh "
+         bssh(:,:,:)  = 0.0_wp
+         bubar(:,:,:) = 0.0_wp
+         bvbar(:,:,:) = 0.0_wp
+
+         cc=0.0_wp
+
+         anau(:) = 0.0_wp
+         anav(:) = 0.0_wp
+         anaf(:) = 0.0_wp
+         bzz(:) = 0.0_wp
+         x(:) = 0.0_wp
+         c(:) = 0.0_wp
+
+         DO ih = 1, nb_harmo
+            anau(ih) = utide(ih)
+            anav(ih) = v0tide(ih)
+            anaf(ih) = ftide(ih)
+
+         END DO
+         fjulday_startharm=fjulday !Set this at very start and store
+      endif
+
+   END SUBROUTINE harm_ana_init
+!
+   SUBROUTINE gelim (a,b,x,n)
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE harm_ana  ***
+      !!
+      !! ** Purpose :   Guassian elimination
+      !!
+      !! ** Method  :   
+      !!
+      !! ** Action  : - first action (share memory array/varible modified
+      !!                in this routine
+      !!              - second action .....
+      !!              - .....
+      !!
+      !! References :
+      !!   Give references if exist otherwise suppress these lines
+      !!
+      !! History :
+        implicit none
+!
+        integer  :: n
+   REAL(WP) :: b(nb_harmo*2+1),a(nb_harmo*2+1,nb_harmo*2+1)
+   REAL(WP) :: x(nb_harmo*2+1)
+        INTEGER  :: row,col,prow,pivrow,rrow,ntemp
+   REAL(WP) ::  atemp
+   REAL(WP) ::  pivot
+   REAL(WP) ::  m
+   REAL(WP) ::  tempsol(nb_harmo*2+1)
+
+
+        do row=1,n-1
+           pivrow=row
+           pivot=a(row,n-row+1)
+           do prow=row+1,n
+              if (abs(a(prow,n-row+1)).gt.abs(pivot)  ) then
+                 pivot=a(prow,n-row+1)
+                 pivrow=prow
+              endif
+           enddo
+!	swap row and prow
+           if ( pivrow .ne. row ) then
+              atemp=b(pivrow)
+              b(pivrow)=b(row)
+              b(row)=atemp
+              do col=1,n
+                 atemp=a(pivrow,col)
+                 a(pivrow,col)=a(row,col)
+                 a(row,col)=atemp
+              enddo
+           endif
+
+           do rrow=row+1,n
+              if (a(row,row).ne.0) then
+   
+                 m=-a(rrow,n-row+1)/a(row,n-row+1)
+                 do col=1,n
+                    a(rrow,col)=m*a(row,col)+a(rrow,col)
+                 enddo
+                 b(rrow)=m*b(row)+b(rrow)
+              endif
+           enddo
+        enddo
+!	back substitution now
+
+        x(1)=b(n)/a(n,1)
+        do row=n-1,1,-1
+           x(n-row+1)=b(row)
+           do col=1,(n-row)
+              x(n-row+1)=(x(n-row+1)-a(row,col)*x(col)) 
+           enddo
+
+           x(n-row+1)=(x(n-row+1)/a(row,(n-row)+1))
+        enddo
+
+        return
+        END SUBROUTINE gelim
+
+   SUBROUTINE harm_ana_out
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE harm_ana_init  ***
+      !!                   
+      !! ** Purpose :   initialization of ....
+      !!
+      !! ** Method  :   blah blah blah ...
+      !!
+      !! ** input   :   Namlist namexa
+      !!
+      !! ** Action  :   ...  
+      !!
+      !! history :
+      !!   9.0  !  03-08  (Autor Names)  Original code
+      !!----------------------------------------------------------------------
+        USE dianam          ! build name of file (routine)
+ 
+      !! * local declarations
+      INTEGER ::   ji, jj, jk, jgrid,jit, ih, jjk   ! dummy loop indices
+      INTEGER :: nh_T
+      INTEGER :: nid_harm
+      CHARACTER (len=40) ::           &
+         clhstnamt, clop1, clop2          ! temporary names 
+      CHARACTER (len=40) ::           &
+         clhstnamu, clhstnamv   ! temporary names 
+      REAL(wp) ::   &
+         zsto1, zsto2, zout, zmax,            &  ! temporary scalars
+         zjulian, zdt, zmdi  
+         
+        do jgrid=1,3
+          do ih=1,nb_harmo
+            hout = 0.0
+            gout = 0.0
+            do jj=1,nlcj
+                do ji=1,nlci
+                    if(jgrid .eq. 1) then ! SSH 
+                       cca=cosampz(ih,ji,jj)
+                       ssa=sinampz(ih,ji,jj)
+                    endif
+                    if(jgrid .eq. 2) then ! UBAR
+                       cca=cosampu(ih,ji,jj)
+                       ssa=sinampu(ih,ji,jj)
+                    endif
+                    if(jgrid .eq. 3) then ! VBAR
+                       cca=cosampv(ih,ji,jj)
+                       ssa=sinampv(ih,ji,jj)
+                    endif
+
+                    hout(ji,jj)=sqrt(cca**2+ssa**2)
+        
+                    if (cca.ne.0.0) then
+                         gout(ji,jj)=(180.0/rpi)*atan(ssa/cca)
+                    else
+                        if (ssa.ne.0.0) then
+                            if (ssa.gt. 0.0) then
+                                 gout(ji,jj)=90.0
+                            else
+                                 gout(ji,jj)=270.0
+                            endif
+                        else
+                            gout(ji,jj)=0.0
+                        endif
+                    endif
+
+                    if (gout(ji,jj).lt.0) then
+                        gout(ji,jj)=gout(ji,jj)+180.0
+                    endif
+                    if (ssa.lt.0) then
+                        gout(ji,jj)=gout(ji,jj)+180.0
+                    endif
+                    
+                    if (hout(ji,jj).ne.0) then
+                        hout(ji,jj)=hout(ji,jj)/anaf(ih)
+                    endif
+                    if (gout(ji,jj).ne.0) then
+                                                !Convert Rad to degree and take
+                                                !modulus
+                         gout(ji,jj)=gout(ji,jj)+MOD( (anau(ih)+anav(ih))/rad , 360.0)
+                        if (gout(ji,jj).gt.360.0) then
+                            gout(ji,jj)=gout(ji,jj)-360.0
+                        else if (gout(ji,jj).lt.0) then
+                            gout(ji,jj)=gout(ji,jj)+360.0
+                        endif
+                    endif
+                enddo
+            enddo
+!NETCDF OUTPUT
+            if(jgrid==1) then
+             WRITE(numout,*) TRIM(Wave(ntide(ih))%cname_tide)//'amp'
+             WRITE(numout,*) TRIM(Wave(ntide(ih))%cname_tide)//'phase'
+             CALL iom_put( TRIM(Wave(ntide(ih))%cname_tide)//'amp', hout(:,:) )
+             CALL iom_put( TRIM(Wave(ntide(ih))%cname_tide)//'phase', gout(:,:) )
+            endif
+            if(jgrid==2) then
+             CALL iom_put( TRIM(Wave(ntide(ih))%cname_tide)//'amp_u', hout(:,:) )
+             CALL iom_put( TRIM(Wave(ntide(ih))%cname_tide)//'phase_u', gout(:,:) )
+            endif
+            if(jgrid==3) then
+             CALL iom_put( TRIM(Wave(ntide(ih))%cname_tide)//'amp_v', hout(:,:) )
+             CALL iom_put( TRIM(Wave(ntide(ih))%cname_tide)//'phase_v', gout(:,:) )
+            endif
+          enddo
+        enddo
+ 
+!
+   END SUBROUTINE harm_ana_out
+
+   SUBROUTINE harm_rst_write(kt)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE harm_ana_init  ***
+      !!                   
+      !! ** Purpose :  To write out cummulated Tidal Harmomnic data to file for
+      !!               restarting
+      !!
+      !! ** Method  :   restart files will be dated by default
+      !!
+      !! ** input   :   
+      !!
+      !! ** Action  :   ...  
+      !!
+      !! history :
+      !!   0.0  !  01-16  (Enda O'Dea)  Original code
+      !! ASSUMES  dated file for rose  , can change later to be more generic
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt     ! ocean time-step
+      INTEGER             ::   iyear, imonth, iday,ih
+      REAL (wp)           ::   zsec
+      !!
+      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character
+      CHARACTER(LEN=50)   ::   clname   ! ocean output restart file name
+      CHARACTER(LEN=150)  ::   clpath   ! full path to ocean output restart file
+      CHARACTER(LEN=250)  ::   clfinal   ! full name
+
+      CALL ju2ymds( fjulday , iyear, imonth, iday, zsec)
+
+      WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday
+      ! create the file
+      clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_restart_harm_ana"
+      clpath = TRIM(cn_ocerst_outdir)
+      IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
+      WRITE(numout,*) 'Open tidal harmonics restart file for writing: ',TRIM(clpath)//clname
+
+
+
+
+!!      clhstnam=TRIM(cexper)//'.restart_harm_ana'
+      ! Open a file to write the data into
+         write (clfinal,'(a,''_'',i4.4)') trim(clpath)//trim(clname),nproc
+         open(66,file=TRIM(clfinal))
+         write(66,'(1e20.9)') cc
+         !These Three which contain the most data can be moved to a regular
+         !restart file
+
+            CALL iom_rstput( kt, nitrst, numrow, 'Mean_bssh'     , bssh(1,:,:)       )
+            CALL iom_rstput( kt, nitrst, numrow, 'Mean_bubar'    , bubar(1,:,:)       )
+            CALL iom_rstput( kt, nitrst, numrow, 'Mean_bvbar'    , bvbar(1,:,:)       )
+         do ih=1,nb_harmo
+            CALL iom_rstput( kt, nitrst, numrow, TRIM(Wave(ntide(ih))%cname_tide)//'bssh_cos'    , bssh (ih*2  , : , : )     )
+            CALL iom_rstput( kt, nitrst, numrow, TRIM(Wave(ntide(ih))%cname_tide)//'bssh_sin'    , bssh (ih*2+1, : , : )     )
+
+            CALL iom_rstput( kt, nitrst, numrow, TRIM(Wave(ntide(ih))%cname_tide)//'bubar_cos'   , bubar(ih*2  , : , : )    )
+            CALL iom_rstput( kt, nitrst, numrow, TRIM(Wave(ntide(ih))%cname_tide)//'bubar_sin'   , bubar(ih*2+1, : , : )    )
+
+            CALL iom_rstput( kt, nitrst, numrow, TRIM(Wave(ntide(ih))%cname_tide)//'bvbar_cos'   , bvbar(ih*2  , : , : )    )
+            CALL iom_rstput( kt, nitrst, numrow, TRIM(Wave(ntide(ih))%cname_tide)//'bvbar_sin'   , bvbar(ih*2+1, : , : )    )
+         enddo
+
+         write(66,'(1e20.9)') anau
+         write(66,'(1e20.9)') anav
+         write(66,'(1e20.9)') anaf
+         write(66,'(1e25.20)') fjulday_startharm
+         close(66)
+ 
+   END SUBROUTINE harm_rst_write
+
+   SUBROUTINE harm_rst_read
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE harm_ana_init  ***
+      !!                   
+      !! ** Purpose :  To read in  cummulated Tidal Harmomnic data to file for
+      !!               restarting
+      !!
+      !! ** Method  :   
+      !!
+      !! ** input   :   
+      !!
+      !! ** Action  :   ...  
+      !!
+      !! history :
+      !!   0.0  !  01-16  (Enda O'Dea)  Original code
+      !! ASSUMES  dated file for rose  , can change later to be more generic
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=50)   ::   clname   ! ocean output restart file name
+      CHARACTER(LEN=150)  ::   clpath   ! full path to ocean output restart file
+      CHARACTER(LEN=250)  ::   clfinal   ! full name
+      INTEGER             ::   ih
+
+      ! create the file
+      clname = "restart_harm_ana"
+      clpath = TRIM(cn_ocerst_indir)
+      IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
+      WRITE(numout,*) 'Open tidal harmonics restart file for reading: ',TRIM(clpath)//clname
+
+
+
+
+!!      clhstnam=TRIM(cexper)//'.restart_harm_ana'
+      ! Open a file to read the data ifrom
+         write (clfinal,'(a,''_'',i4.4)') trim(clpath)//trim(clname),nproc
+         open(66,file=TRIM(clfinal),status='old')
+         read(66,'(1e20.9)') cc
+!2D regular fields can be read from normal restart this saves space and handy to
+!view in netcdf format also.
+         CALL iom_get( numror,jpdom_autoglo, 'Mean_bssh'     , bssh(1,:,:)       )
+         CALL iom_get( numror,jpdom_autoglo, 'Mean_bubar'    , bubar(1,:,:)       )
+         CALL iom_get( numror,jpdom_autoglo, 'Mean_bvbar'    , bvbar(1,:,:)       )
+          
+         do ih=1,nb_harmo
+
+            CALL iom_get(   numror,jpdom_autoglo, TRIM(Wave(ntide(ih))%cname_tide)//'bssh_cos'    , bssh (ih*2  , : , : )     )
+            CALL iom_get(   numror,jpdom_autoglo, TRIM(Wave(ntide(ih))%cname_tide)//'bssh_sin'    , bssh (ih*2+1, : , : )     )
+
+            CALL iom_get(   numror,jpdom_autoglo, TRIM(Wave(ntide(ih))%cname_tide)//'bubar_cos'   , bubar(ih*2  , : , : )    )
+            CALL iom_get(   numror,jpdom_autoglo, TRIM(Wave(ntide(ih))%cname_tide)//'bubar_sin'   , bubar(ih*2+1, : , : )    )
+
+            CALL iom_get(   numror,jpdom_autoglo, TRIM(Wave(ntide(ih))%cname_tide)//'bvbar_cos'   , bvbar(ih*2  , : , : )    )
+            CALL iom_get(   numror,jpdom_autoglo, TRIM(Wave(ntide(ih))%cname_tide)//'bvbar_sin'   , bvbar(ih*2+1, : , : )    )
+         enddo
+         read(66,'(1e20.9)') anau
+         read(66,'(1e20.9)') anav
+         read(66,'(1e20.9)') anaf
+         read(66,'(1e25.20)') fjulday_startharm
+      WRITE(numout,*) 'Checking anaf is correct'
+      WRITE(numout,*) anaf
+      WRITE(numout,*) '---end of anaf checking----'
+
+         close(66)
+
+   END SUBROUTINE harm_rst_read
+
+   !!======================================================================
+#else
+!!---------------------------------------------------------------------------------
+!!   Dummy module                                   NO harmonic Analysis
+!!---------------------------------------------------------------------------------
+        CONTAINS
+           SUBROUTINE harm_rst_write(kt)     ! Dummy routine
+           END SUBROUTINE harm_rst_write
+           SUBROUTINE harm_rst_read    ! Dummy routine
+           END SUBROUTINE harm_rst_read
+           SUBROUTINE harm_ana_out      ! Dummy routine
+           END SUBROUTINE harm_ana_out
+           SUBROUTINE harm_ana_init
+           END SUBROUTINE harm_ana_init
+           SUBROUTINE harm_ana( kt )
+           END SUBROUTINE harm_ana
+           SUBROUTINE gelim (a,b,x,n)
+           END SUBROUTINE gelim
+           
+#endif
+
+END MODULE harmonic_analysis
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diainsitutem.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diainsitutem.F90	(revision 10249)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diainsitutem.F90	(revision 10249)
@@ -0,0 +1,124 @@
+MODULE diainsitutem
+   !!======================================================================
+   !!                       ***  MODULE  diaharm  ***
+   !! Harmonic analysis of tidal constituents
+   !!======================================================================
+   !! Initial version: D. Acreman June 2006 Original Code
+   !! History :  3.6  !  2014  (E O'Dea) for 3.6 25hour mean output
+   !!----------------------------------------------------------------------
+
+  USE dom_oce  ! ocean space and time domain
+  USE oce,            ONLY: tsn
+  USE par_oce,        ONLY: jpi, jpj, jpk, jpkm1
+  USE lbclnk,         ONLY: lbc_lnk
+  USE lib_mpp         ! MPP library
+
+  IMPLICIT NONE
+  PRIVATE
+
+  PUBLIC theta2t
+
+  !! * Accessibility
+  PUBLIC insitu_tem_alloc          ! routines called by step.F90
+
+  REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: rinsitu_t
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+
+CONTAINS
+
+   REAL FUNCTION insitu_tem_alloc()
+      !!----------------------------------------------------------------------
+      INTEGER, DIMENSION(2) :: ierr
+      !!----------------------------------------------------------------------
+      !
+      ierr = 0
+      !
+      ALLOCATE( rinsitu_t(jpi,jpj,jpk), STAT=ierr(1) )
+         !
+      insitu_tem_alloc = MAXVAL(ierr)
+      IF( lk_mpp )   CALL mpp_sum( insitu_tem_alloc )
+      !
+  END FUNCTION insitu_tem_alloc
+
+!-----------------------------------------------------------------------------------
+!
+! Calculate the insitu temperature by integrating the adiabatic lapse rate from zero 
+! to pressure at depth of tracer level. Based on UM subroutine POTTEM and function ATG
+!
+! Initial version: D. Acreman June 2006
+!
+!-----------------------------------------------------------------------------------
+
+  SUBROUTINE theta2t()
+
+    INTEGER, PARAMETER :: inum_steps=10                ! number of steps in integration
+    INTEGER            :: jstep                        ! iteration counter
+    INTEGER            :: ji, jj, jk                  ! loop indices
+    REAL(wp), DIMENSION(jpi,jpj,jpk) :: zP            ! pressure (decibars)
+    REAL(wp), DIMENSION(jpi,jpj,jpk) :: zT            ! temperature at pressure p
+    REAL(wp), DIMENSION(jpi,jpj,jpk) :: zTB           ! temperature at p-dp
+    REAL(wp), DIMENSION(jpi,jpj,jpk) :: zTA           ! temperature at p+dp
+    REAL(wp), DIMENSION(jpi,jpj,jpk) :: zDP           ! pressure step
+    REAL(wp), DIMENSION(jpi,jpj,jpk) :: zSS           ! salinity(PSU) - 35.0
+    REAL(wp), DIMENSION(jpi,jpj,jpk) :: zLAPSE        ! adiabatic lapse rate
+
+!CDIR IEXPAND (ATG)
+
+! Set the pressure interval for the integration. The integration is carried out from 
+! zero (pressure at the surface) to the pressure at the depth of the tracer point. The
+! pressure in decibars is represented by the depth in metres. Pressures are "Oceanographic"
+! pressures equal to absolute pressure minus one atmosphere
+     zDP(:,:,:) = 0.0
+     DO jk = 1, jpkm1
+        DO jj = 1, jpj
+           DO ji = 1, jpi
+              ! These loops expanded for case where fsdept may be 1D
+              zDP(ji,jj,jk) = fsdept(ji,jj,jk) / real(inum_steps)
+           END DO
+        END DO
+     END DO
+
+! Salinity at each point
+     zSS(:,:,:)      = tsn(:,:,:,jp_sal) - 35.0 
+
+! Set initial values of temperature and pressure. zT is the temperature at pressure zP, 
+! zTB is the temperature at pressure zP-zdP and zTA is the temperature at pressure zP+zdP
+     zT(:,:,:)  = tsn(:,:,:,jp_tem)
+     zP(:,:,:)  = 0.0         ! Pressure at surface
+     CALL ATG(zP, zT, zSS, zLAPSE)
+     zTB(:,:,:) = zT(:,:,:)  - zLAPSE(:,:,:) * zDP(:,:,:)
+
+     interation: DO jstep=1, inum_steps
+        ! Calculate lapse rate (dT/dP) and hence TA
+        CALL ATG(zP, zT, zSS, zLAPSE)
+        zTA(:,:,:) = zTB(:,:,:) + 2.0 * zLAPSE(:,:,:) * zDP(:,:,:)
+        ! Have calculated TB, T and TA for this pressure, now advance solution by dP
+        zP(:,:,:)  = zP(:,:,:)  + zDP
+        zTB(:,:,:) = zT(:,:,:)
+        zT(:,:,:)  = zTA(:,:,:)
+
+     END DO interation
+
+     rinsitu_t(:,:,:) = zT(:,:,:) * tmask(:,:,:)
+     CALL lbc_lnk( rinsitu_t,  'T', 1.0)
+
+   END SUBROUTINE theta2t
+
+   SUBROUTINE ATG(P,T,DS,zLAPSE)
+
+     REAL, INTENT(IN   ) :: P(jpi,jpj,jpk)        ! PRESSURE (DECIBARS)
+     REAL, INTENT(IN   ) :: T(jpi,jpj,jpk)        ! TEMPERATURE (DEG C)
+     REAL, INTENT(IN   ) :: DS(jpi,jpj,jpk)       ! SALINITY (PSU) -35.0
+     REAL, INTENT(  OUT) :: zLAPSE(jpi,jpj,jpk)   ! LAPSE RATE
+
+       zLAPSE = ((( -2.1687E-16*T+1.8676E-14)*T-4.6206E-13)*P &
+           + ((2.7759E-12*T-1.1351E-10)*DS+((-5.4481E-14*T    &
+           + 8.733E-12)*T-6.7795E-10)*T+1.8741E-8))*P         &
+           + (-4.2393E-8*T+1.8932E-6)*DS                      &
+           + ((6.6228E-10*T-6.836E-8)*T+8.5258E-6)*T+3.5803E-5 
+
+   END SUBROUTINE ATG
+
+END MODULE diainsitutem
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diaopfoam.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diaopfoam.F90	(revision 10249)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diaopfoam.F90	(revision 10249)
@@ -0,0 +1,182 @@
+MODULE diaopfoam
+   !!======================================================================
+   !!                       ***  MODULE  diaopfoam  ***
+   !! Output stream for operational use
+   !!======================================================================
+   !! History :  3.6  !  2016  (P Sykes)  Original code
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain
+   USE diainsitutem, ONLY: rinsitu_t, theta2t
+   USE in_out_manager  ! I/O units
+   USE iom             ! I/0 library
+   USE wrk_nemo        ! working arrays
+   USE diatmb
+   USE diurnal_bulk
+   USE cool_skin
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   LOGICAL , PUBLIC ::   ln_diaopfoam     !: Diaopfoam output 
+   PUBLIC   dia_diaopfoam_init            ! routine called by nemogcm.F90
+   PUBLIC   dia_diaopfoam                 ! routine called by diawri.F90
+   PUBLIC   calc_max_cur                  ! routine called by diaopfoam.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.6 , NEMO Consortium (2014)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dia_diaopfoam_init
+      !!---------------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_wri_diaop_init  ***
+      !!     
+      !! ** Purpose: Initialization of diaopfoam namelist 
+      !!        
+      !! ** Method : Read namelist
+      !!   History
+      !!   3.4  !  03-14  (P. Sykes) Routine to initialize dia_wri_diaop
+      !!---------------------------------------------------------------------------
+      !!
+      INTEGER            ::   ios      ! Local integer output status for namelist read
+      INTEGER            ::   ierror   ! local integer
+      !!
+      NAMELIST/nam_diadiaop/ ln_diaopfoam
+      !!
+      !!----------------------------------------------------------------------
+      !
+      ln_diaopfoam = .false.         ! default value for diaopfoam stream
+      REWIND ( numnam_ref )              ! Read Namelist nam_diadiaop in reference namelist : 3D hourly diagnostics
+      READ   ( numnam_ref, nam_diadiaop, IOSTAT=ios, ERR= 901 )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diadiaop in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist nam_diadiaop in configuration namelist  3D hourly diagnostics
+      READ  ( numnam_cfg, nam_diadiaop, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diadiaop in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, nam_diadiaop )
+      !
+      IF(lwp) THEN                   ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dia_diaopfoam_init : Output Diaopfoam Diagnostics'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist nam_diadiaop : set diaopfoam outputs '
+         WRITE(numout,*) '      Switch for diaopfoam diagnostics (T) or not (F)  ln_diaopfoam  = ', ln_diaopfoam
+      ENDIF
+    END SUBROUTINE dia_diaopfoam_init
+
+    SUBROUTINE dia_diaopfoam
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE dia_diaopfoam  ***
+      !! ** Purpose :   Write 3D hourly diagnostics for operational use
+      !!
+      !!
+      !! History :
+      !!   3.6  !  11-16  (P. Sykes) 
+      !!         
+      !!--------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj)   :: zw2d       ! 2D workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d       ! 3D workspace
+      REAL(wp) :: zmdi
+      REAL(wp), POINTER, DIMENSION(:,:)   :: zwu
+      REAL(wp), POINTER, DIMENSION(:,:)   :: zwv
+      REAL(wp), POINTER, DIMENSION(:,:)   :: zwz
+
+      CALL wrk_alloc( jpi , jpj      , zwu )
+      CALL wrk_alloc( jpi , jpj      , zwv )
+      CALL wrk_alloc( jpi , jpj      , zwz )
+
+      zmdi=1.e+20                               !  missing data indicator for masking
+      ! Diaopfoam stream if needed
+      IF (ln_diaopfoam) THEN
+         CALL theta2t
+         CALL iom_put( "insitut_op" , rinsitu_t(:,:,:)                      )    ! insitu temperature
+         CALL iom_put( "toce_op"   , tsn(:,:,:,jp_tem)                     )    ! temperature
+         CALL iom_put( "soce_op"   , tsn(:,:,:,jp_sal)                     )    ! salinity
+         IF (ln_diurnal) THEN
+            CALL iom_put( "sst_wl_op"   , x_dsst                    )    ! warm layer 
+            CALL iom_put( "sst_cs_op"   , x_csdsst                  )    ! cool skin 
+         ENDIF
+         zw2d(:,:)=sshn(:,:)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1))
+         CALL iom_put( "ssh_op"  , zw2d(:,:)                          ) ! sea surface height
+         CALL iom_put( "uoce_op"   , un                                    )    ! i-current      
+         CALL iom_put( "voce_op"   , vn                                    )    ! j-current
+         !CALL iom_put( "woce_op"   , wn                                    )    ! k-current
+#if defined key_spm
+         cltra = TRIM(ctrc3d(5))//"_op"
+         zw3d(:,:,:) = trc3d(:,:,:,5)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) ! Visibility
+         CALL iom_put( cltra, zw3d  )
+#endif
+         CALL calc_max_cur(zwu,zwv,zwz,zmdi)
+         CALL iom_put( "maxu" , zwu                                     ) ! max u current
+         CALL iom_put( "maxv" , zwv                                     ) ! max v current
+         CALL iom_put( "maxz" , zwz                                     ) ! max current depth
+      ENDIF
+   END SUBROUTINE dia_diaopfoam
+
+   SUBROUTINE calc_max_cur(zmax_u, zmax_v, zmax_z, inmdi)
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE calc_max_cur  ***
+      !!
+      !! ** Purpose :   To locate within the water column the magnitude and
+      !!                vertical location of the strongest horizontal
+      !!                current. The vertical component is ignored since it
+      !!                is an order of magnitude smaller than the horizontal
+      !!                flow, in general. 
+      !!
+      !! ** Method :    A. Map U,V to T-grid.
+      !!                B. Calculate the magnitude of the current for every
+      !!                   grid cell.
+      !!                C. Locate the vertical index using FORTRAN's builtin
+      !!                   MAXLOC function.
+      !!                D. Copy the U,V,Z components of the relevant
+      !!                   indices.
+      !!
+      !! ** Returns :   Value of u, v component and depth of maximum
+      !!                horizontal current on T-grid.
+      !!
+      !!---------------------------------------------------------------------
+      IMPLICIT NONE
+      REAL(wp), DIMENSION(jpi, jpj), INTENT(  OUT) :: zmax_u, zmax_v, zmax_z
+      REAL(wp), DIMENSION(jpi, jpj, jpk)           :: zmax_u_t, zmax_v_t
+      REAL(wp), DIMENSION(jpi, jpj, jpk)           :: zcmag
+      REAL(wp), DIMENSION(jpi, jpj)                :: zmaxk
+      REAL(wp),                      INTENT(IN   ) :: inmdi
+      INTEGER :: ji, jj, jk
+
+      ! Initialise output arrays
+      zmax_u(:, :) = inmdi
+      zmax_v(:, :) = inmdi
+      zmax_z(:, :) = inmdi
+      ! Map to T-grid
+      zmax_u_t(:, :, :) = 0._wp
+      zmax_v_t(:, :, :) = 0._wp
+      DO jk = 1,jpk
+         DO jj = 2,jpj
+            DO ji = 2,jpi
+               zmax_u_t(ji, jj, jk) = 0.5 * (un(ji, jj, jk) + un(ji-1, jj, jk))
+               zmax_v_t(ji, jj, jk) = 0.5 * (vn(ji, jj, jk) + vn(ji, jj-1, jk))
+            END DO
+         END DO
+      END DO
+      ! Calculate absolute velocity
+      zcmag = sqrt((zmax_u_t)**2 + (zmax_v_t)**2)
+      ! Find max. current
+      zmaxk = maxloc(zcmag, dim=3)
+      ! Output values
+      DO jj = 1,jpj
+         DO ji = 1,jpi
+             zmax_u(ji, jj) = zmax_u_t(ji, jj, INT(zmaxk(ji, jj)))
+             zmax_v(ji, jj) = zmax_v_t(ji, jj, INT(zmaxk(ji, jj)))
+             zmax_z(ji, jj) = fsdept(ji, jj, INT(zmaxk(ji, jj)))
+         END DO
+      END DO      
+   END SUBROUTINE calc_max_cur
+
+END MODULE diaopfoam
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90	(revision 10249)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90	(revision 10249)
@@ -0,0 +1,170 @@
+MODULE diatmb 
+   !!======================================================================
+   !!                       ***  MODULE  diaharm  ***
+   !! Harmonic analysis of tidal constituents 
+   !!======================================================================
+   !! History :  3.6  !  2014  (E O'Dea)  Original code
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager  ! I/O units
+   USE iom             ! I/0 library
+   USE wrk_nemo        ! working arrays
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   LOGICAL , PUBLIC ::   ln_diatmb     !: Top Middle and Bottom output 
+   PUBLIC   dia_tmb_init            ! routine called by nemogcm.F90
+   PUBLIC   dia_tmb                 ! routine called by diawri.F90
+   PUBLIC   dia_calctmb             ! routine called by dia25h.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.6 , NEMO Consortium (2014)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dia_tmb_init 
+      !!---------------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_tmb_init  ***
+      !!     
+      !! ** Purpose: Initialization of tmb namelist 
+      !!        
+      !! ** Method : Read namelist
+      !!   History
+      !!   3.6  !  08-14  (E. O'Dea) Routine to initialize dia_tmb
+      !!---------------------------------------------------------------------------
+      !!
+      INTEGER ::   ios                 ! Local integer output status for namelist read
+      !
+      NAMELIST/nam_diatmb/ ln_diatmb
+      !!----------------------------------------------------------------------
+      !
+      REWIND ( numnam_ref )              ! Read Namelist nam_diatmb in reference namelist : TMB diagnostics
+      READ   ( numnam_ref, nam_diatmb, IOSTAT=ios, ERR= 901 )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diatmb in reference namelist', lwp )
+ 
+      REWIND( numnam_cfg )              ! Namelist nam_diatmb in configuration namelist  TMB diagnostics
+      READ  ( numnam_cfg, nam_diatmb, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diatmb in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, nam_diatmb )
+
+      IF(lwp) THEN                   ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dia_tmb_init : Output Top, Middle, Bottom Diagnostics'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) 'Namelist nam_diatmb : set tmb outputs '
+         WRITE(numout,*) 'Switch for TMB diagnostics (T) or not (F)  ln_diatmb  = ', ln_diatmb
+      ENDIF
+
+   END SUBROUTINE dia_tmb_init
+
+   SUBROUTINE dia_calctmb( pinfield,pouttmb )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_tmb  ***
+      !!                   
+      !! ** Purpose :    Find the Top, Mid and Bottom fields of water Column
+      !!
+      !! ** Method  :   
+      !!      use mbathy to find surface, mid and bottom of model levels
+      !!
+      !! History :
+      !!   3.6  !  08-14  (E. O'Dea) Routine based on dia_wri_foam
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      ! Routine to map 3d field to top, middle, bottom
+      IMPLICIT NONE
+
+
+      ! Routine arguments
+      REAL(wp), DIMENSION(jpi, jpj, jpk), INTENT(IN   ) :: pinfield    ! Input 3d field and mask
+      REAL(wp), DIMENSION(jpi, jpj, 3  ), INTENT(  OUT) :: pouttmb     ! Output top, middle, bottom
+
+
+
+      ! Local variables
+      INTEGER :: ji,jj,jk  ! Dummy loop indices
+
+      ! Local Real
+      REAL(wp)                         ::   zmdi  !  set masked values
+
+      zmdi=1.e+20 !missing data indicator for masking
+
+      ! Calculate top
+      pouttmb(:,:,1) = pinfield(:,:,1)*tmask(:,:,1)  + zmdi*(1.0-tmask(:,:,1))
+
+      ! Calculate middle
+      DO jj = 1,jpj
+         DO ji = 1,jpi
+            jk              = max(1,mbathy(ji,jj)/2)
+            pouttmb(ji,jj,2) = pinfield(ji,jj,jk)*tmask(ji,jj,jk)  + zmdi*(1.0-tmask(ji,jj,jk))
+         END DO
+      END DO
+
+      ! Calculate bottom
+      DO jj = 1,jpj
+         DO ji = 1,jpi
+            jk              = max(1,mbathy(ji,jj) )
+            pouttmb(ji,jj,3) = pinfield(ji,jj,jk)*tmask(ji,jj,jk)  + zmdi*(1.0-tmask(ji,jj,jk))
+         END DO
+      END DO
+
+   END SUBROUTINE dia_calctmb
+
+
+
+   SUBROUTINE dia_tmb
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE dia_tmb  ***
+      !! ** Purpose :   Write diagnostics for Top, Mid and Bottom of water Column
+      !!
+      !! ** Method  :   
+      !!      use mbathy to find surface, mid and bottom of model levels
+      !!      calls calctmb to retrieve TMB values before sending to iom_put
+      !!
+      !! History :
+      !!   3.6  !  08-14  (E. O'Dea) 
+      !!         
+      !!--------------------------------------------------------------------
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwtmb    ! temporary workspace 
+      REAL(wp)                         ::   zmdi      ! set masked values
+
+      zmdi=1.e+20 !missing data indicator for maskin
+
+      IF (ln_diatmb) THEN
+         CALL wrk_alloc( jpi , jpj, 3 , zwtmb )
+         CALL dia_calctmb(  tsn(:,:,:,jp_tem),zwtmb )
+         !ssh already output but here we output it masked
+         CALL iom_put( "sshnmasked" , sshn(:,:)*tmask(:,:,1) + zmdi*(1.0 - tmask(:,:,1)) )   ! tmb Temperature
+         CALL iom_put( "top_temp" , zwtmb(:,:,1) )    ! tmb Temperature
+         CALL iom_put( "mid_temp" , zwtmb(:,:,2) )    ! tmb Temperature
+         CALL iom_put( "bot_temp" , zwtmb(:,:,3) )    ! tmb Temperature
+!         CALL iom_put( "sotrefml" , hmld_tref(:,:) )    ! "T criterion Mixed Layer Depth
+
+         CALL dia_calctmb(  tsn(:,:,:,jp_sal),zwtmb )
+         CALL iom_put( "top_sal" , zwtmb(:,:,1) )    ! tmb Salinity 
+         CALL iom_put( "mid_sal" , zwtmb(:,:,2) )    ! tmb Salinity
+         CALL iom_put( "bot_sal" , zwtmb(:,:,3) )    ! tmb Salinity
+
+         CALL dia_calctmb(  un(:,:,:),zwtmb )
+         CALL iom_put( "top_u" , zwtmb(:,:,1) )    ! tmb  U Velocity
+         CALL iom_put( "mid_u" , zwtmb(:,:,2) )    ! tmb  U Velocity
+         CALL iom_put( "bot_u" , zwtmb(:,:,3) )    ! tmb  U Velocity
+!Called in  dynspg_ts.F90        CALL iom_put( "baro_u" , un_b )    ! Barotropic  U Velocity
+
+         CALL dia_calctmb(  vn(:,:,:),zwtmb )
+         CALL iom_put( "top_v" , zwtmb(:,:,1) )    ! tmb  V Velocity
+         CALL iom_put( "mid_v" , zwtmb(:,:,2) )    ! tmb  V Velocity
+         CALL iom_put( "bot_v" , zwtmb(:,:,3) )    ! tmb  V Velocity
+!Called in  dynspg_ts.F90       CALL iom_put( "baro_v" , vn_b )    ! Barotropic  V Velocity
+      ELSE
+         CALL ctl_warn('dia_tmb: tmb diagnostic is set to false you should not have seen this')
+      ENDIF
+
+   END SUBROUTINE dia_tmb
+   !!======================================================================
+END MODULE diatmb
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90	(revision 10249)
@@ -44,7 +44,12 @@
    USE in_out_manager  ! I/O manager
    USE diadimg         ! dimg direct access file format output
+   USE diatmb          ! Top,middle,bottom output
+   USE dia25h          ! 25h Mean output
+   USE diaopfoam       ! Diaopfoam output
    USE iom
    USE ioipsl
    USE dynspg_oce, ONLY: un_adv, vn_adv ! barotropic velocities     
+   USE eosbn2         ! equation of state                (eos_bn2 routine)
+
 
 #if defined key_lim2
@@ -132,4 +137,5 @@
       REAL(wp), POINTER, DIMENSION(:,:)   :: z2d      ! 2D workspace
       REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d      ! 3D workspace
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zrhd , zrhop  ! 3D workspace
       !!----------------------------------------------------------------------
       ! 
@@ -138,4 +144,5 @@
       CALL wrk_alloc( jpi , jpj      , z2d )
       CALL wrk_alloc( jpi , jpj, jpk , z3d )
+      CALL wrk_alloc( jpi , jpj, jpk , zrhd , zrhop )
       !
       ! Output the initial state and forcings
@@ -376,7 +383,27 @@
          CALL iom_put( "v_salttr", 0.5 * z2d )            !  heat transport in j-direction
       ENDIF
+
+      IF( iom_use("rhop") ) THEN
+         CALL eos( tsn, zrhd, zrhop, fsdept_n(:,:,:) )       ! now in situ and potential density
+         zrhop(:,:,jpk) = 0._wp
+         CALL iom_put( 'rhop', zrhop )
+      ENDIF
+
       !
       CALL wrk_dealloc( jpi , jpj      , z2d )
       CALL wrk_dealloc( jpi , jpj, jpk , z3d )
+      CALL wrk_dealloc( jpi , jpj, jpk , zrhd , zrhop )
+      !
+      ! If we want tmb values 
+
+      IF (ln_diatmb) THEN
+         CALL dia_tmb
+      ENDIF
+      IF (ln_dia25h) THEN
+         CALL dia_25h( kt )
+      ENDIF
+      IF (ln_diaopfoam) THEN
+         CALL dia_diaopfoam
+      ENDIF
       !
       IF( nn_timing == 1 )   CALL timing_stop('dia_wri')
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIU/cool_skin.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIU/cool_skin.F90	(revision 10249)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIU/cool_skin.F90	(revision 10249)
@@ -0,0 +1,149 @@
+MODULE cool_skin
+   !!======================================================================
+   !!                    ***  MODULE  cool_skin  ***
+   !!     Cool skin thickness and delta T correction using Artele et al. (2002)
+   !!     [see also Tu and Tsuang (2005)]
+   !!
+   !!=====================================================================
+   !! History :        !  2012-01  (P. Sykes)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   diurnal_sst_coolskin_step  : timestep the cool skin corrections
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE phycst
+   USE dom_oce
+   USE in_out_manager
+   USE sbc_oce
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   
+   IMPLICIT NONE
+   
+   !Namelist parameters
+
+   !Parameters
+   REAL(wp), PRIVATE, PARAMETER :: pp_k = 0.596_wp          !Thermal conductivity of seawater
+   REAL(wp), PRIVATE, PARAMETER :: pp_v = 1.05e-6_wp        !Kinematic viscosity of seawater
+   REAL(wp), PRIVATE, PARAMETER :: pp_C = 86400             !seconds [see Tu and Tsuang (2005)]
+   REAL(wp), PRIVATE, PARAMETER :: pp_cw = 3993._wp         !specific heat capacity of seawater
+   REAL(wp), PRIVATE, PARAMETER :: pp_h = 10._wp            !reference depth [using 10m from Artale et al. (2002)]
+   REAL(wp), PRIVATE, PARAMETER :: pp_rhoa = 1.20421_wp     !density of air (at 20C)
+   REAL(wp), PRIVATE, PARAMETER :: pp_cda = 1.45e-3_wp      !assumed air-sea drag coefficient for calculating wind speed
+   
+   !Key variables
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: x_csdsst     !Cool skin delta SST
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: x_csthick  !Cool skin thickness
+
+   PRIVATE
+   PUBLIC diurnal_sst_coolskin_step, diurnal_sst_coolskin_init
+
+      !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   
+   CONTAINS 
+   
+   SUBROUTINE diurnal_sst_coolskin_init
+      !!----------------------------------------------------------------------
+      !! *** ROUTINE diurnal_sst_coolskin_init ***
+      !!
+      !! ** Purpose :   initalise the coolskin model
+      !!
+      !! ** Method : 
+      !!
+      !! ** Reference :
+      !! 
+      !!----------------------------------------------------------------------
+      
+      IMPLICIT NONE
+      
+      ALLOCATE( x_csdsst(jpi,jpj), x_csthick(jpi,jpj) )
+      x_csdsst = 0.
+      x_csthick = 0.
+      
+   END SUBROUTINE diurnal_sst_coolskin_init
+ 
+   SUBROUTINE diurnal_sst_coolskin_step(psqflux, pstauflux, psrho, rdt)
+      !!----------------------------------------------------------------------
+      !! *** ROUTINE diurnal_sst_takaya_step ***
+      !!
+      !! ** Purpose :   Timestep the Artale cool skin model
+      !!
+      !! ** Method : 
+      !!
+      !! ** Reference : 
+      !!----------------------------------------------------------------------
+     
+      IMPLICIT NONE
+     
+      !Dummy variables
+      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: psqflux     !Heat (non-solar)(Watts)
+      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: pstauflux   !Wind stress (kg/ m s^2)
+      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: psrho       !Water density (kg/m^3)
+      REAL(wp), INTENT(IN) :: rdt                             !Timestep
+     
+      !Local variables
+      REAL(wp), DIMENSION(jpi,jpj) :: z_fv                    !Friction velocity     
+      REAL(wp), DIMENSION(jpi,jpj) :: z_gamma                 !Dimensionless function of windspeed
+      REAL(wp), DIMENSION(jpi,jpj) :: z_lamda                 !Sauders (dimensionless) proportionality constant
+      REAL(wp), DIMENSION(jpi,jpj) :: z_wspd                  !Windspeed (m/s)
+      REAL(wp) :: z_ztx                                       !Temporary u wind stress
+      REAL(wp) :: z_zty                                       !Temporary v wind stress
+      REAL(wp) :: z_zmod                                      !Temporary total wind stress
+     
+      INTEGER :: ji,jj
+      
+      DO jj = 1,jpj
+         DO ji = 1,jpi
+            
+            !Calcualte wind speed from wind stress and friction velocity
+            IF( tmask(ji,jj,1) == 1. .AND. pstauflux(ji,jj) /= 0 .AND. psrho(ji,jj) /=0 ) THEN
+               z_fv(ji,jj) = SQRT( pstauflux(ji,jj) / psrho(ji,jj) )
+               z_wspd(ji,jj) = SQRT( pstauflux(ji,jj) / ( pp_cda * pp_rhoa ) )
+            ELSE
+               z_fv(ji,jj) = 0.
+               z_wspd(ji,jj) = 0.     
+            ENDIF
+
+ 
+            !Calculate gamma function which is dependent upon wind speed
+            IF( tmask(ji,jj,1) == 1. ) THEN
+               IF( ( z_wspd(ji,jj) <= 7.5 ) ) z_gamma(ji,jj) = ( 0.2 * z_wspd(ji,jj) ) + 0.5
+               IF( ( z_wspd(ji,jj) > 7.5 ) .AND. ( z_wspd(ji,jj) < 10. ) ) z_gamma(ji,jj) = ( 1.6 * z_wspd(ji,jj) ) - 10.
+               IF( ( z_wspd(ji,jj) >= 10. ) ) z_gamma(ji,jj) = 6.
+            ENDIF
+
+
+            !Calulate lamda function
+            IF( tmask(ji,jj,1) == 1. .AND. z_fv(ji,jj) /= 0 ) THEN
+               z_lamda(ji,jj) = ( z_fv(ji,jj) * pp_k * pp_C ) / ( z_gamma(ji,jj) * psrho(ji,jj) * pp_cw * pp_h * pp_v )
+            ELSE
+               z_lamda(ji,jj) = 0.
+            ENDIF
+
+
+
+            !Calculate the cool skin thickness - only when heat flux is out of the ocean
+            IF( tmask(ji,jj,1) == 1. .AND. z_fv(ji,jj) /= 0 .AND. psqflux(ji,jj) < 0 ) THEN
+                x_csthick(ji,jj) = ( z_lamda(ji,jj) * pp_v ) / z_fv(ji,jj)
+            ELSE
+                x_csthick(ji,jj) = 0.
+            ENDIF
+
+
+
+            !Calculate the cool skin correction - only when the heat flux is out of the ocean
+            IF( tmask(ji,jj,1) == 1. .AND. x_csthick(ji,jj) /= 0. .AND. psqflux(ji,jj) < 0. ) THEN
+               x_csdsst(ji,jj) = ( psqflux(ji,jj) * x_csthick(ji,jj) ) / pp_k
+             ELSE
+               x_csdsst(ji,jj) = 0.
+            ENDIF
+
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE diurnal_sst_coolskin_step
+
+
+END MODULE cool_skin
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIU/diurnal_bulk.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIU/diurnal_bulk.F90	(revision 10249)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIU/diurnal_bulk.F90	(revision 10249)
@@ -0,0 +1,312 @@
+MODULE diurnal_bulk
+   !!======================================================================
+   !!                    ***  MODULE  diurnal_bulk  ***
+   !!     Takaya model of diurnal warming (Takaya, 2010)
+   !!=====================================================================
+   !! History :        !  11-10  (J. While)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   diurnal_sst_bulk_init  : initalise diurnal model
+   !!   diurnal_sst_bulk_step  : timestep the diurnal model
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE phycst
+   USE dom_oce
+   USE lib_mpp
+   USE solfrac_mod
+   USE in_out_manager
+   
+   IMPLICIT NONE
+   
+   !Namelist parameters
+   LOGICAL, PUBLIC :: ln_diurnal = .FALSE.
+   LOGICAL, PUBLIC :: ln_diurnal_only = .FALSE.
+
+   !Parameters
+   REAL(wp), PRIVATE, PARAMETER :: pp_alpha = 2.0e-4_wp
+   REAL(wp), PRIVATE, PARAMETER :: pp_veltol = 0._wp
+   REAL(wp), PRIVATE, PARAMETER :: pp_min_fvel = 1.e-10_wp 
+   
+   !Key variables
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: x_dsst     !Delta SST
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: x_solfrac  !Fraction of 
+                                                      !absorbed 
+                                                      !radiation
+
+   PRIVATE
+   PUBLIC diurnal_sst_bulk_init, diurnal_sst_takaya_step
+   
+   CONTAINS 
+   
+   SUBROUTINE diurnal_sst_bulk_init
+      !!----------------------------------------------------------------------
+      !! *** ROUTINE diurnal_sst_init ***
+      !!
+      !! ** Purpose : Initalise the Takaya diurnal model
+      
+      !!----------------------------------------------------------------------
+      
+      IMPLICIT NONE
+
+      INTEGER ::   ios                 ! Local integer output status for namelist read
+      
+      NAMELIST /namdiu/ ln_diurnal, ln_diurnal_only
+      
+      !Read the namelist
+      REWIND ( numnam_ref )              ! Read Namelist namdiu in reference namelist
+      READ   ( numnam_ref, namdiu, IOSTAT=ios, ERR= 901 )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdiu in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namdiu in configuration namelist
+      READ  ( numnam_cfg, namdiu, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdiu in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namdiu )
+     
+      IF(lwp) THEN                   ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'namdiu_init : Diurnal Model settings are:'
+         WRITE(numout,*)    'ln_diurnal = ', ln_diurnal
+         WRITE(numout,*)    'ln_diurnal_only = ', ln_diurnal_only
+      ENDIF
+
+      IF ( ln_diurnal_only .AND. ( .NOT. ln_diurnal ) ) THEN
+         CALL ctl_stop( "ln_diurnal_only set, but ln_diurnal = FALSE !" )
+      ENDIF
+      
+      IF ( ln_diurnal ) THEN      
+         
+         !Allocate arrays
+         ALLOCATE( x_dsst(jpi,jpj), x_solfrac(jpi,jpj) )
+         
+         !Initalise the solar fraction
+         x_solfrac=0._wp
+
+         IF ( ln_diurnal_only ) THEN
+            CALL ctl_warn( "ln_diurnal_only set; only the diurnal component of SST will be calculated" )
+         ENDIF
+      ENDIF
+      
+   END SUBROUTINE diurnal_sst_bulk_init
+   
+   SUBROUTINE diurnal_sst_takaya_step(psolflux, pqflux, ptauflux, prho, p_rdt,&
+            &                  pla, pthick, pcoolthick, pmu, ld_calcfrac, &
+            &                  p_fvel_bkginc, p_hflux_bkginc)
+      !!----------------------------------------------------------------------
+      !! *** ROUTINE diurnal_sst_takaya_step ***
+      !!
+      !! ** Purpose :   Timestep the Takaya diurnal model
+      !!
+      !! ** Method :    1) Calculate the Obukhov length
+      !!                2) Calculate the Simularity function
+      !!                2) Calculate the increment to dsst
+      !!                3) Apply the increment
+      !! ** Reference : Refinements to a prognostic scheme of skin sea surface
+      !!                temperature, Takaya et al, JGR, 2010 
+      !!----------------------------------------------------------------------
+      
+      IMPLICIT NONE
+      
+      !Dummy variables
+      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: psolflux  !solar flux (Watts)
+      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: pqflux    !heat (non-solar) 
+                                                            !flux (Watts)
+      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: ptauflux  !wind stress 
+                                                            !(kg/ m s^2)
+      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: prho      !water density 
+                                                            !(kg/m^3)
+      REAL(wp), OPTIONAL, INTENT(IN), DIMENSION(jpi,jpj) :: pLa    
+                                                     !Langmuir number
+      REAL(wp), OPTIONAL, INTENT(IN), DIMENSION(jpi,jpj) :: pthick 
+                                                     !warm layer thickness (m)
+      REAL(wp), OPTIONAL, INTENT(IN), DIMENSION(jpi,jpj) :: pcoolthick 
+                                                     !cool skin thickness (m)
+      REAL(wp), OPTIONAL, INTENT(IN), DIMENSION(jpi,jpj) :: pmu    
+                                                     !mu parameter
+      REAL(wp), OPTIONAL, INTENT(IN), DIMENSION(jpi,jpj) :: p_hflux_bkginc  
+                                                     !optional increment to the
+                                                     !heat flux
+      REAL(wp), OPTIONAL, INTENT(IN), DIMENSION(jpi,jpj) :: p_fvel_bkginc  
+                                                     !optional increment to the
+                                                     !friction velocity
+      REAL(wp), INTENT(IN) :: p_rdt              !timestep
+      
+      LOGICAL, OPTIONAL, &
+      &     INTENT(IN)  :: ld_calcfrac !Set TRUE to recalculate the 
+                                               !solar fraction
+      
+      !Local variables 
+      REAL(wp), DIMENSION(jpi,jpj) :: z_fvel              ! friction velocity     
+      REAL(wp), DIMENSION(jpi,jpj) :: zthick, zcoolthick, zmu, zla
+      REAL(wp), DIMENSION(jpi,jpj) :: z_abflux            ! absorbed flux           
+      REAL(wp), DIMENSION(jpi,jpj) :: z_fla               !Langmuir fuction value 
+      
+      LOGICAL  :: ll_calcfrac
+      
+      INTEGER :: ji,jj
+
+      !Set optional arguments to their defualts
+      IF ( .NOT. PRESENT(pthick) ) THEN 
+         zthick(:,:) = 3._wp
+      ELSE
+         zthick(:,:) = pthick(:,:)
+      ENDIF
+      IF ( .NOT. PRESENT(pcoolthick) ) THEN 
+         zcoolthick(:,:) = 0._wp
+      ELSE
+         zcoolthick(:,:) = pcoolthick(:,:)
+      ENDIF
+      IF ( .NOT. PRESENT(pmu) ) THEN
+         zmu(:,:) = 0.3_wp
+      ELSE
+         zmu(:,:) = pmu(:,:)
+      ENDIF
+      IF ( .NOT. PRESENT(pla) ) THEN
+         zla(:,:) = 0.3_wp
+      ELSE
+         zla(:,:) = pla(:,:)
+      ENDIF
+      IF ( .NOT. PRESENT(ld_calcfrac) ) THEN
+         ll_calcfrac = .FALSE.
+      ELSE
+         ll_calcfrac = ld_calcfrac
+      ENDIF     
+      
+      !If not done already, calculate the solar fraction
+      IF (ll_calcfrac ) THEN
+         DO jj = 1,jpj
+            DO ji = 1, jpi
+               IF(  ( x_solfrac(ji,jj) == 0. ) .AND. ( tmask(ji,jj,1) == 1. ) ) &
+               &   x_solfrac(ji,jj) = solfrac( zcoolthick(ji,jj),zthick(ji,jj) )
+            END DO
+         END DO   
+      ENDIF   
+
+      !convert solar flux and heat flux to absorbed flux   
+      WHERE ( tmask(:,:,1) == 1.) 
+         z_abflux(:,:) = (  x_solfrac(:,:) *  psolflux (:,:)) + pqflux(:,:)     
+      ELSEWHERE
+         z_abflux(:,:) = 0._wp
+      ENDWHERE
+      IF( PRESENT(p_hflux_bkginc) ) z_abflux(:,:) = z_abflux(:,:) + p_hflux_bkginc !Optional increment
+      WHERE ( ABS( z_abflux(:,:) ) < rsmall )
+         z_abflux(:,:) = rsmall
+      ENDWHERE 
+      
+      !Calculate the friction velocity
+      WHERE ( (ptauflux /= 0) .AND. ( tmask(:,:,1) == 1.) )   
+         z_fvel(:,:) = SQRT( ptauflux(:,:) / prho(:,:) )
+      ELSEWHERE
+         z_fvel(:,:) = 0.
+      ENDWHERE
+      IF( PRESENT(p_hflux_bkginc) ) z_fvel(:,:) = z_fvel(:,:) + p_fvel_bkginc !Optional increment
+      
+       
+       
+      !Calculate the Langmuir function value
+      WHERE ( tmask(:,:,1) == 1.)
+         z_fla(:,:) = MAX( 1._wp, zla(:,:)**( -2._wp / 3._wp ) )  
+      ENDWHERE     
+      
+      !!Increment the temperature using the implicit solution
+      x_dsst(:,:) = t_imp( x_dsst(:,:), p_rdt, z_abflux(:,:), z_fvel(:,:), &
+                                 z_fla(:,:), zmu(:,:), zthick(:,:), prho(:,:))
+      
+                                
+      
+   END SUBROUTINE diurnal_sst_takaya_step
+
+   
+   FUNCTION t_imp(p_dsst, p_rdt, p_abflux, p_fvel, &
+                          p_fla, pmu, pthick, prho )
+                          
+      IMPLICIT NONE
+      
+      !Function definition
+      REAL(wp), DIMENSION(jpi,jpj) :: t_imp
+      !Dummy variables
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_dsst    !Delta SST
+      REAL(wp), INTENT(IN) ::                 p_rdt           !Timestep
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_abflux  !Heat forcing
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_fvel    !Friction velocity
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_fla     !Langmuir number
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: pmu       !Structure parameter
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: pthick    !Layer thickness
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: prho      !Water density
+   
+      !Local variables
+      REAL(wp) :: z_olength          ! Obukhov length
+      REAL(wp) :: z_sigma, z_sigma2
+      REAL(wp) :: z_term1, z_term2     
+      REAL(wp) :: z_stabfunc         ! stability function value
+      REAL(wp) :: z_fvel      
+      
+      CHARACTER(200) :: warn_string
+       
+      INTEGER :: ji,jj
+                     
+      DO jj = 1, jpj
+         DO ji = 1, jpi   
+            
+            !Only calculate outside tmask
+            IF ( tmask(ji,jj,1) /= 1. ) THEN
+               t_imp(ji,jj) = 0._wp
+               CYCLE   
+            END IF
+            
+            IF (p_fvel(ji,jj) < pp_min_fvel) THEN
+               z_fvel = pp_min_fvel
+               WRITE(warn_string,*) "diurnal_sst_takaya step: "&
+               &//"friction velocity < minimum\n" &
+               &//"Setting friction velocity =",pp_min_fvel
+               CALL ctl_warn(warn_string)
+               
+            ELSE
+               z_fvel = p_fvel(ji,jj)
+            ENDIF
+                 
+            !Calculate the Obukhov length
+            IF ( (z_fvel < pp_veltol ) .AND. &
+            &    (p_dsst(ji,jj) > 0.) ) THEN
+               z_olength =  z_fvel  / &
+               &     SQRT( p_dsst(ji,jj) * vkarmn * grav * &
+               &             pp_alpha / ( 5._wp * pthick(ji,jj) ) )
+            ELSE
+               z_olength = &
+               &   ( prho(ji,jj) * rcp * z_fvel**3._wp ) / &
+               &   ( vkarmn * grav * pp_alpha *&
+               &     p_abflux(ji,jj) )
+            ENDIF
+             
+            !Calculate the stability function          
+            z_sigma = pthick(ji,jj) / z_olength
+            z_sigma2 = z_sigma * z_sigma
+  
+            IF ( z_sigma >= 0 ) THEN
+               z_stabfunc = 1._wp + &
+               &  ( ( 5._wp * z_sigma + 4._wp * z_sigma2 ) / &
+               &  ( 1._wp + 3._wp * z_sigma + 0.25_wp * &
+               &    z_sigma2 ) )
+            ELSE
+               z_stabfunc = 1._wp / &
+               &                   SQRT( 1._wp - 16._wp * z_sigma )
+            ENDIF
+
+            !Calculate the T increment
+            z_term1 = ( p_abflux(ji,jj) * ( pmu(ji,jj) + 1._wp)  / &
+            & ( pmu(ji,jj) * pthick(ji,jj) * prho(ji,jj) * rcp ) )
+            
+             
+            z_term2 = -( ( pmu(ji,jj) + 1._wp) * &
+            &                       ( vkarmn * z_fvel * p_fla(ji,jj) ) / &
+            &      ( pthick(ji,jj) * z_stabfunc ) )     
+          
+            t_imp(ji,jj) = ( p_dsst(ji,jj) + p_rdt * z_term1 ) / &
+                           ( 1._wp - p_rdt * z_term2 )
+
+         END DO
+      END DO
+      
+      END FUNCTION t_imp
+
+END MODULE diurnal_bulk
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIU/solfrac_mod.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIU/solfrac_mod.F90	(revision 10249)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIU/solfrac_mod.F90	(revision 10249)
@@ -0,0 +1,56 @@
+MODULE solfrac_mod
+   !!======================================================================
+   !!                    ***  MODULE  solfrac  ***
+   !!     POSH representation of solar absorbtion (Gntermann, 2009)
+   !!=====================================================================
+   !! History :        !  11-10  (J. While)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   solfrac  : function to calculate the solar fraction
+   !!----------------------------------------------------------------------
+   
+   USE par_kind
+   IMPLICIT NONE
+     
+   !Parameters 
+   REAL(wp), PRIVATE, PARAMETER, DIMENSION(9) :: &
+   &                                     pp_wgt = (/0.2370, 0.36,  0.1790, &
+   &                                                0.087,  0.08,  0.025,  &
+   &                                                0.025,  0.007, 0.0004/)
+   REAL(wp), PRIVATE, PARAMETER, DIMENSION(9) :: &
+   &                                    pp_len = (/34.84,   2.266,   0.0315,  &
+   &                                               0.0055,  8.32e-4, 1.26e-4, &
+   &                                                3.13e-4, 7.82e-4, 1.44e-5/)
+   
+   PUBLIC solfrac
+                                                   
+CONTAINS
+
+   REAL(dp) FUNCTION solfrac(ptop,pbottom)
+       !!----------------------------------------------------------------------
+      !! *** ROUTINE solfrac ***
+      !!
+      !! ** Purpose :   Calculate the solar fraction absorbed between two 
+      !!                layers
+      !!
+      !! ** Reference : POSH a model of diurnal warming, Gentemann et al, 
+      !!                 JGR, 2009 
+      !!----------------------------------------------------------------------
+      
+      !Dummy variabes
+      REAL(wp), INTENT(IN) :: ptop, pbottom  !Top and bottom of layer
+      
+      !local variables
+      INTEGER :: jt
+      
+      !Calculate the solar fraction absorbed between the two layers
+      solfrac = 0._wp
+      DO jt = 1, 9
+           solfrac = solfrac + pp_wgt(jt) * ( exp ( -ptop / pp_len(jt) ) &
+            &                                 - exp ( -pbottom / pp_len(jt) ) )
+      END DO
+      
+   END FUNCTION
+   
+END MODULE solfrac_mod
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90	(revision 10249)
@@ -135,6 +135,7 @@
       !!----------------------------------------------------------------------
       USE ioipsl
+      NAMELIST/namrun/ ln_NOOS
       NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,               &
-         &             nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   &
+         &             nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstdate, ln_rstart , nn_rstctl,   &
          &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   &
          &             nn_write, ln_dimgnnn, ln_mskland  , ln_cfmeta    , ln_clobber, nn_chunksz, nn_euler
@@ -174,4 +175,5 @@
          WRITE(numout,*) '      restart output directory        cn_ocerst_outdir= ', cn_ocerst_outdir
          WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
+         WRITE(numout,*) '      datestamping of restarts        ln_rstdate  = ', ln_rstdate
          WRITE(numout,*) '      start with forward time step    nn_euler   = ', nn_euler
          WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
@@ -192,4 +194,5 @@
          WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
          WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
+         WRITE(numout,*) '      NOOS transect diagnostics       ln_NOOS    = ', ln_NOOS
       ENDIF
 
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90	(revision 10249)
@@ -31,4 +31,5 @@
    USE wrk_nemo        ! Memory allocation
    USE timing          ! Timing
+   USE iom    ! slwa
 
    IMPLICIT NONE
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90	(revision 10249)
@@ -209,5 +209,5 @@
       ptsd(:,:,:,jp_sal) = sf_tsd(jp_sal)%fnow(:,:,:) 
       !
-      IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==!
+      IF( ln_sco .and. 1==0) THEN                   !==   s- or mixed s-zps-coordinate   ==!
          !
          CALL wrk_alloc( jpk, ztp, zsp )
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90	(revision 10249)
@@ -24,4 +24,7 @@
    USE wrk_nemo        ! Memory Allocation
    USE timing          ! Timing
+#if defined key_bdy 
+   USE bdy_oce         ! ocean open boundary conditions 
+#endif 
 
    IMPLICIT NONE
@@ -78,4 +81,9 @@
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zhke
       REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv 
+#if defined key_bdy 
+      INTEGER  ::   jb                 ! dummy loop indices 
+      INTEGER  ::   ii, ij, igrd, ib_bdy   ! local integers 
+      INTEGER  ::   fu, fv 
+#endif 
       !!----------------------------------------------------------------------
       !
@@ -97,5 +105,33 @@
       
       zhke(:,:,jpk) = 0._wp
-      
+
+#if defined key_bdy 
+      ! Maria Luneva & Fred Wobus: July-2016 
+      ! compensate for lack of turbulent kinetic energy on liquid bdy points 
+      DO ib_bdy = 1, nb_bdy 
+         IF( cn_dyn3d(ib_bdy) /= 'none' ) THEN 
+            igrd = 2           ! Copying normal velocity into points outside bdy 
+            DO jb = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 
+               DO jk = 1, jpkm1 
+                  ii   = idx_bdy(ib_bdy)%nbi(jb,igrd) 
+                  ij   = idx_bdy(ib_bdy)%nbj(jb,igrd) 
+                  fu   = NINT( idx_bdy(ib_bdy)%flagu(jb,igrd) ) 
+                  un(ii-fu,ij,jk) = un(ii,ij,jk) * umask(ii,ij,jk) 
+               END DO 
+            END DO 
+            ! 
+            igrd = 3           ! Copying normal velocity into points outside bdy 
+            DO jb = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 
+               DO jk = 1, jpkm1 
+                  ii   = idx_bdy(ib_bdy)%nbi(jb,igrd) 
+                  ij   = idx_bdy(ib_bdy)%nbj(jb,igrd) 
+                  fv   = NINT( idx_bdy(ib_bdy)%flagv(jb,igrd) ) 
+                  vn(ii,ij-fv,jk) = vn(ii,ij,jk) * vmask(ii,ij,jk) 
+               END DO 
+            END DO 
+         ENDIF 
+      ENDDO  
+#endif       
+
       SELECT CASE ( kscheme )             !== Horizontal kinetic energy at T-point  ==!
       !
@@ -112,4 +148,6 @@
             END DO
          END DO
+         !
+         CALL lbc_lnk( zhke, 'T', 1. )
          !
       CASE ( nkeg_HW )                          !--  Hollingsworth scheme  --!
@@ -134,4 +172,11 @@
       END SELECT
       !
+
+#if defined key_bdy 
+      ! restore velocity masks at points outside boundary 
+      un(:,:,:) = un(:,:,:) * umask(:,:,:) 
+      vn(:,:,:) = vn(:,:,:) * vmask(:,:,:) 
+#endif  
+
       DO jk = 1, jpkm1                    !==  grad( KE ) added to the general momentum trends  ==!
          DO jj = 2, jpjm1
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90	(revision 10249)
@@ -41,10 +41,8 @@
    USE timing          ! Timing    
    USE sbcapr          ! surface boundary condition: atmospheric pressure
+   USE diatmb          ! Top,middle,bottom output
    USE dynadv, ONLY: ln_dynadv_vec
 #if defined key_agrif
    USE agrif_opa_interp ! agrif
-#endif
-#if defined key_asminc   
-   USE asminc          ! Assimilation increment
 #endif
 
@@ -144,4 +142,5 @@
       INTEGER  ::   ji, jj, jk, jn   		! dummy loop indices
       INTEGER  ::   ikbu, ikbv, noffset    	! local integers
+      REAL(wp) ::   zmdi
       REAL(wp) ::   zraur, z1_2dt_b, z2dt_bf  	! local scalars
       REAL(wp) ::   zx1, zy1, zx2, zy2         !   -      -
@@ -169,4 +168,5 @@
       CALL wrk_alloc( jpi, jpj, zhf )
       !
+      zmdi=1.e+20                               !  missing data indicator for masking
       !                                         !* Local constant initialization
       z1_12 = 1._wp / 12._wp 
@@ -459,10 +459,4 @@
                 &                        + fwfisf(:,:) + fwfisf_b(:,:)                     )
       ENDIF
-#if defined key_asminc
-      !                                         ! Include the IAU weighted SSH increment
-      IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN
-         zssh_frc(:,:) = zssh_frc(:,:) - ssh_iau(:,:)
-      ENDIF
-#endif
       !                                   !* Fill boundary data arrays for AGRIF
       !                                   ! ------------------------------------
@@ -926,4 +920,8 @@
       CALL wrk_dealloc( jpi, jpj, zhf )
       !
+      IF ( ln_diatmb ) THEN
+         CALL iom_put( "baro_u" , un_b*umask(:,:,1)+zmdi*(1-umask(:,:,1 ) ) )  ! Barotropic  U Velocity
+         CALL iom_put( "baro_v" , vn_b*vmask(:,:,1)+zmdi*(1-vmask(:,:,1 ) ) )  ! Barotropic  V Velocity
+      ENDIF
       IF( nn_timing == 1 )  CALL timing_stop('dyn_spg_ts')
       !
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90	(revision 10249)
@@ -74,5 +74,5 @@
       INTEGER, INTENT(in) ::   kt                      ! time step
       ! 
-      INTEGER             ::   jk                      ! dummy loop indice
+      INTEGER             ::   ji, jj, jk              ! dummy loop indices
       REAL(wp)            ::   z2dt, z1_rau0           ! local scalars
       !!----------------------------------------------------------------------
@@ -94,4 +94,19 @@
       z2dt = 2._wp * rdt                              ! set time step size (Euler/Leapfrog)
       IF( neuler == 0 .AND. kt == nit000 )   z2dt = rdt
+
+#if defined key_asminc
+      !                                                ! Include the IAU weighted SSH increment
+      IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN
+         CALL ssh_asm_inc( kt )
+#if defined key_vvl
+! Don't directly adjust ssh but change hdivn at all levels instead
+! In trasbc also add in the heat and salt content associated with these changes at each level  
+        DO jk = 1, jpkm1                                 
+                 hdivn(:,:,jk) = hdivn(:,:,jk) - ( ssh_iau(:,:) / ( ht_0(:,:) + 1.0 - ssmask(:,:) ) ) * ( e3t_0(:,:,jk) / fse3t_n(:,:,jk) ) * tmask(:,:,jk) 
+        END DO
+        CALL lbc_lnk( hdivn, 'T', 1. ) ! Not sure that's necessary
+      ENDIF
+#endif
+#endif
 
       !                                           !------------------------------!
@@ -123,12 +138,4 @@
 #endif
 
-#if defined key_asminc
-      !                                                ! Include the IAU weighted SSH increment
-      IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN
-         CALL ssh_asm_inc( kt )
-         ssha(:,:) = ssha(:,:) + z2dt * ssh_iau(:,:)
-      ENDIF
-#endif
-
       !                                           !------------------------------!
       !                                           !           outputs            !
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90	(revision 10249)
@@ -18,6 +18,8 @@
    !!----------------------------------------------------------------------
    USE par_oce        ! NEMO parameters
+   USE phycst         ! for rday
    USE dom_oce        ! NEMO domain
    USE in_out_manager ! NEMO IO routines
+   USE ioipsl, ONLY : ju2ymds    ! for calendar
    USE lib_mpp        ! NEMO MPI library, lk_mpp in particular
    USE netcdf         ! netcdf routines for IO
@@ -231,6 +233,10 @@
       INTEGER ::   jn   ! dummy loop index
       INTEGER ::   ix_dim, iy_dim, ik_dim, in_dim
-      CHARACTER(len=256)     :: cl_path
-      CHARACTER(len=256)     :: cl_filename
+      INTEGER             ::   iyear, imonth, iday
+      REAL (wp)           ::   zsec
+      REAL (wp)           ::   zfjulday
+      CHARACTER(len=256)  :: cl_path
+      CHARACTER(len=256)  :: cl_filename
+      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character
       TYPE(iceberg), POINTER :: this
       TYPE(point)  , POINTER :: pt
@@ -240,8 +246,18 @@
       cl_path = TRIM(cn_ocerst_outdir)
       IF( cl_path(LEN_TRIM(cl_path):) /= '/' ) cl_path = TRIM(cl_path) // '/'
+      IF ( ln_rstdate ) THEN
+         zfjulday = fjulday + rdttra(1) / rday
+         IF( ABS(zfjulday - REAL(NINT(zfjulday),wp)) < 0.1 / rday )   zfjulday = REAL(NINT(zfjulday),wp)   ! avoid truncation error
+         CALL ju2ymds( zfjulday, iyear, imonth, iday, zsec )           
+         WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday
+      ELSE
+         IF( kt > 999999999 ) THEN   ;   WRITE(clkt, *       ) kt
+         ELSE                        ;   WRITE(clkt, '(i8.8)') kt
+         ENDIF
+      ENDIF
       IF( lk_mpp ) THEN
-         WRITE(cl_filename,'(A,"_icebergs_",I8.8,"_restart_",I4.4,".nc")') TRIM(cexper), kt, narea-1
+         WRITE(cl_filename,'(A,"_icebergs_",A,"_restart_",I4.4,".nc")') TRIM(cexper), TRIM(ADJUSTL(clkt)), narea-1
       ELSE
-         WRITE(cl_filename,'(A,"_icebergs_",I8.8,"_restart.nc")') TRIM(cexper), kt
+         WRITE(cl_filename,'(A,"_icebergs_",A,"_restart.nc")') TRIM(cexper), TRIM(ADJUSTL(clkt))
       ENDIF
       IF (nn_verbose_level >= 0) WRITE(numout,'(2a)') 'icebergs, write_restart: creating ',TRIM(cl_path)//TRIM(cl_filename)
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90	(revision 10249)
@@ -30,4 +30,5 @@
    CHARACTER(lc) ::   cn_ocerst_outdir !: restart output directory
    LOGICAL       ::   ln_rstart        !: start from (F) rest or (T) a restart file
+   LOGICAL       ::   ln_rstdate       !: datestamping of restarts 
    LOGICAL       ::   ln_rst_list      !: output restarts at list of times (T) or by frequency (F)
    INTEGER       ::   nn_no            !: job number
@@ -48,4 +49,5 @@
    LOGICAL       ::   ln_clobber       !: clobber (overwrite) an existing file
    INTEGER       ::   nn_chunksz       !: chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
+   LOGICAL       ::   ln_NOOS = .FALSE.                !: NOOS transects  diagnostics
 #if defined key_netcdf4
    !!----------------------------------------------------------------------
@@ -133,6 +135,11 @@
    INTEGER ::   numdct_heat     =   -1      !: logical unit for heat    transports output
    INTEGER ::   numdct_salt     =   -1      !: logical unit for salt    transports output
+   INTEGER ::   numdct_NOOS     =   -1      !: logical unit for NOOS    transports output
+   INTEGER ::   numdct_NOOS_h   =   -1      !: logical unit for NOOS hourly transports output
    INTEGER ::   numfl           =   -1      !: logical unit for floats ascii output
    INTEGER ::   numflo          =   -1      !: logical unit for floats ascii output
+   
+   INTEGER ::   numdct_reg_bin  =   -1      !: logical unit for NOOS    transports output
+   INTEGER ::   numdct_reg_txt  =   -1      !: logical unit for NOOS hourly transports output
 
    !!----------------------------------------------------------------------
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90	(revision 10249)
@@ -43,5 +43,5 @@
    INTEGER, PARAMETER, PUBLIC ::   jp_i1    = 204      !: write INTEGER(1)
 
-   INTEGER, PARAMETER, PUBLIC ::   jpmax_files  = 100   !: maximum number of simultaneously opened file
+   INTEGER, PARAMETER, PUBLIC ::   jpmax_files  = 200   !: maximum number of simultaneously opened file
    INTEGER, PARAMETER, PUBLIC ::   jpmax_vars   = 600  !: maximum number of variables in one file
    INTEGER, PARAMETER, PUBLIC ::   jpmax_dims   =  4   !: maximum number of dimensions for one variable
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90	(revision 10249)
@@ -21,4 +21,5 @@
    USE in_out_manager  ! I/O manager
    USE iom             ! I/O module
+   USE ioipsl, ONLY : ju2ymds    ! for calendar
    USE eosbn2          ! equation of state            (eos bn2 routine)
    USE trdmxl_oce      ! ocean active mixed layer tracers trends variables
@@ -54,8 +55,11 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt     ! ocean time-step
+      INTEGER             ::   iyear, imonth, iday
+      REAL (wp)           ::   zsec
+      REAL (wp)           ::   zfjulday
       !!
       CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character
       CHARACTER(LEN=50)   ::   clname   ! ocean output restart file name
-      CHARACTER(lc)       ::   clpath   ! full path to ocean output restart file
+      CHARACTER(LEN=150)  ::   clpath   ! full path to ocean output restart file
       !!----------------------------------------------------------------------
       !
@@ -81,7 +85,14 @@
       IF( kt == nitrst - 1 .OR. nstock == 1 .OR. ( kt == nitend .AND. .NOT. lrst_oce ) ) THEN
          IF( nitrst <= nitend .AND. nitrst > 0 ) THEN 
-            ! beware of the format used to write kt (default is i8.8, that should be large enough...)
-            IF( nitrst > 999999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
-            ELSE                            ;   WRITE(clkt, '(i8.8)') nitrst
+            IF ( ln_rstdate ) THEN
+               zfjulday = fjulday + rdttra(1) / rday
+               IF( ABS(zfjulday - REAL(NINT(zfjulday),wp)) < 0.1 / rday )   zfjulday = REAL(NINT(zfjulday),wp)   ! avoid truncation error
+               CALL ju2ymds( zfjulday, iyear, imonth, iday, zsec )           
+               WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday
+            ELSE
+               ! beware of the format used to write kt (default is i8.8, that should be large enough...)
+               IF( nitrst > 999999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
+               ELSE                            ;   WRITE(clkt, '(i8.8)') nitrst
+               ENDIF
             ENDIF
             ! create the file
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90	(revision 10249)
@@ -121,4 +121,7 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sprecip           !: solid precipitation                          [Kg/m2/s]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fr_i              !: ice fraction = 1 - lead fraction      (between 0 to 1)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   pressnow          !: UKMO SHELF pressure
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   apgu              !: UKMO SHELF pressure forcing
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   apgv              !: UKMO SHELF pressure forcing
 #if defined key_cpl_carbon_cycle
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   atm_co2           !: atmospheric pCO2                             [ppm]
@@ -171,4 +174,5 @@
 #endif
          &      ssu_m  (jpi,jpj) , sst_m(jpi,jpj) , frq_m(jpi,jpj) ,      &
+         &      pressnow(jpi,jpj), apgu(jpi,jpj)    , apgv(jpi,jpj) ,     &
          &      ssv_m  (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) )
          !
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90	(revision 10249)
@@ -22,4 +22,5 @@
    USE lib_mpp         ! distribued memory computing library
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE wrk_nemo        ! work arrays
 
    IMPLICIT NONE
@@ -28,5 +29,5 @@
    PUBLIC sbc_flx       ! routine called by step.F90
 
-   INTEGER , PARAMETER ::   jpfld   = 5   ! maximum number of files to read 
+   INTEGER , PARAMETER ::   jpfld   = 6   ! maximum number of files to read 
    INTEGER , PARAMETER ::   jp_utau = 1   ! index of wind stress (i-component) file
    INTEGER , PARAMETER ::   jp_vtau = 2   ! index of wind stress (j-component) file
@@ -34,5 +35,10 @@
    INTEGER , PARAMETER ::   jp_qsr  = 4   ! index of solar heat file
    INTEGER , PARAMETER ::   jp_emp  = 5   ! index of evaporation-precipation file
+   INTEGER , PARAMETER ::   jp_press = 6  ! index of pressure for UKMO shelf fluxes
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf    ! structure of input fields (file informations, fields read)
+   LOGICAL , PUBLIC    ::   ln_shelf_flx = .FALSE. ! UKMO SHELF specific flux flag
+   LOGICAL , PUBLIC    ::   ln_rel_wind = .FALSE.  ! UKMO SHELF specific flux flag - relative winds
+   REAL(wp)            ::   rn_wfac                ! multiplication factor for ice/ocean velocity in the calculation of wind stress (clem)
+   INTEGER             ::   jpfld_local   ! maximum number of files to read (locally modified depending on ln_shelf_flx) 
 
    !! * Substitutions
@@ -82,9 +88,18 @@
       REAL(wp) ::   zcdrag = 1.5e-3       ! drag coefficient
       REAL(wp) ::   ztx, zty, zmod, zcoef ! temporary variables
+      REAL     ::   cs                    ! UKMO SHELF: Friction co-efficient at surface
+      REAL     ::   totwindspd            ! UKMO SHELF: Magnitude of wind speed vector
+      REAL(wp), DIMENSION(:,:), POINTER ::   zwnd_i, zwnd_j    ! wind speed components at T-point
+
+      REAL(wp) ::   rhoa  = 1.22         ! Air density kg/m3
+      REAL(wp) ::   cdrag = 1.5e-3       ! drag coefficient 
       !!
       CHARACTER(len=100) ::  cn_dir                               ! Root directory for location of flx files
       TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                    ! array of namelist information structures
-      TYPE(FLD_N) ::   sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp  ! informations about the fields to be read
-      NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp
+      TYPE(FLD_N) ::   sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp, sn_press  !  informations about the fields to be read 
+      LOGICAL     ::   ln_foam_flx  = .FALSE.                     ! UKMO FOAM specific flux flag 
+      NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp,   & 
+      &                    ln_foam_flx, sn_press, ln_shelf_flx, ln_rel_wind,    &
+      &                    rn_wfac
       !!---------------------------------------------------------------------
       !
@@ -109,9 +124,18 @@
          slf_i(jp_emp ) = sn_emp
          !
-         ALLOCATE( sf(jpfld), STAT=ierror )        ! set sf structure
+            ALLOCATE( sf(jpfld), STAT=ierror )        ! set sf structure
+            IF( ln_shelf_flx ) slf_i(jp_press) = sn_press
+   
+            ! define local jpfld depending on shelf_flx logical
+            IF( ln_shelf_flx ) THEN
+               jpfld_local = jpfld
+            ELSE
+               jpfld_local = jpfld-1
+            ENDIF
+            !
          IF( ierror > 0 ) THEN   
             CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' )   ;   RETURN  
          ENDIF
-         DO ji= 1, jpfld
+         DO ji= 1, jpfld_local
             ALLOCATE( sf(ji)%fnow(jpi,jpj,1) )
             IF( slf_i(ji)%ln_tint ) ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) )
@@ -128,14 +152,60 @@
       IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN                        ! update ocean fluxes at each SBC frequency
 
+         !!UKMO SHELF wind speed relative to surface currents - put here to allow merging with coupling branch
+         IF( ln_shelf_flx ) THEN
+            CALL wrk_alloc( jpi,jpj, zwnd_i, zwnd_j )
+
+            IF( ln_rel_wind ) THEN
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zwnd_i(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) - rn_wfac * ssu_m(ji,jj)
+                     zwnd_j(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) - rn_wfac * ssv_m(ji,jj)
+                  END DO
+               END DO
+            ELSE
+               zwnd_i(:,:) = sf(jp_utau)%fnow(:,:,1)
+               zwnd_j(:,:) = sf(jp_vtau)%fnow(:,:,1)
+            ENDIF
+         ENDIF
+
          IF( ln_dm2dc ) THEN   ;   qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) )   ! modify now Qsr to include the diurnal cycle
          ELSE                  ;   qsr(:,:) =          sf(jp_qsr)%fnow(:,:,1)
          ENDIF
 !CDIR COLLAPSE
+            !!UKMO SHELF effect of atmospheric pressure on SSH
+            ! If using ln_apr_dyn, this is done there so don't repeat here.
+            IF( ln_shelf_flx .AND. .NOT. ln_apr_dyn) THEN
+               DO jj = 1, jpjm1
+                  DO ji = 1, jpim1
+                     apgu(ji,jj) = (-1.0/rau0)*(sf(jp_press)%fnow(ji+1,jj,1)-sf(jp_press)%fnow(ji,jj,1))/e1u(ji,jj)
+                     apgv(ji,jj) = (-1.0/rau0)*(sf(jp_press)%fnow(ji,jj+1,1)-sf(jp_press)%fnow(ji,jj,1))/e2v(ji,jj)
+                  END DO
+               END DO
+            ENDIF ! ln_shelf_flx
+
          DO jj = 1, jpj                                           ! set the ocean fluxes from read fields
             DO ji = 1, jpi
-               utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1)
-               vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1)
-               qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1)
-               emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1)
+                   IF( ln_shelf_flx ) THEN
+                      !! UKMO SHELF - need atmospheric pressure to calculate Haney forcing
+                      pressnow(ji,jj) = sf(jp_press)%fnow(ji,jj,1)
+                      !! UKMO SHELF flux files contain wind speed not wind stress
+                      totwindspd = sqrt(zwnd_i(ji,jj)*zwnd_i(ji,jj) + zwnd_j(ji,jj)*zwnd_j(ji,jj))
+                      cs = 0.63 + (0.066 * totwindspd)
+                      utau(ji,jj) = cs * (rhoa/rau0) * zwnd_i(ji,jj) * totwindspd
+                      vtau(ji,jj) = cs * (rhoa/rau0) * zwnd_j(ji,jj) * totwindspd
+                   ELSE
+                      utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1)
+                      vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1)
+                   ENDIF
+                   qsr (ji,jj) = sf(jp_qsr )%fnow(ji,jj,1)
+                   IF( ln_foam_flx .OR. ln_shelf_flx ) THEN
+                      !! UKMO FOAM flux files contain non-solar heat flux (qns) rather than total heat flux (qtot)
+                      qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1)
+                      !! UKMO FOAM flux files contain the net DOWNWARD freshwater flux P-E rather then E-P
+                      emp (ji,jj) = -1. * sf(jp_emp )%fnow(ji,jj,1)
+                   ELSE
+                      qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1)
+                      emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1)
+                   ENDIF
             END DO
          END DO
@@ -143,4 +213,11 @@
          qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp        ! mass flux is at SST
          !
+   
+            !! UKMO FOAM wind fluxes need lbc_lnk calls owing to a bug in interp.exe
+            IF( ln_foam_flx ) THEN
+               CALL lbc_lnk( utau(:,:), 'U', -1. )
+               CALL lbc_lnk( vtau(:,:), 'V', -1. )
+            ENDIF
+    
          !                                                        ! module of wind stress and wind speed at T-point
          zcoef = 1. / ( zrhoa * zcdrag )
@@ -162,5 +239,5 @@
             WRITE(numout,*) 
             WRITE(numout,*) '        read daily momentum, heat and freshwater fluxes OK'
-            DO jf = 1, jpfld
+            DO jf = 1, jpfld_local
                IF( jf == jp_utau .OR. jf == jp_vtau )   zfact =     1.
                IF( jf == jp_qtot .OR. jf == jp_qsr  )   zfact =     0.1
@@ -173,4 +250,8 @@
          ENDIF
          !
+         IF( ln_shelf_flx ) THEN
+            CALL wrk_dealloc( jpi,jpj, zwnd_i, zwnd_j )
+         ENDIF
+         !
       ENDIF
       !
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90	(revision 10249)
@@ -42,4 +42,5 @@
    LOGICAL         ::   ln_sssr_bnd     ! flag to bound erp term 
    REAL(wp)        ::   rn_sssr_bnd     ! ABS(Max./Min.) value of erp term [mm/day]
+   LOGICAL         ::   ln_UKMO_haney   ! UKMO specific flag to calculate Haney forcing  
 
    REAL(wp) , ALLOCATABLE, DIMENSION(:) ::   buffer   ! Temporary buffer for exchange
@@ -79,4 +80,12 @@
       INTEGER  ::   ierror   ! return error code
       !!
+      REAL(wp) ::   sst1,sst2                      ! sea surface temperature
+      REAL(wp) ::   e_sst1, e_sst2                 ! saturation vapour pressure
+      REAL(wp) ::   qs1,qs2                        ! specific humidity
+      REAL(wp) ::   pr_tmp                         ! temporary variable for pressure
+ 
+      REAL(wp), DIMENSION(jpi,jpj) ::  hny_frc1    ! Haney forcing for sensible heat, correction for latent heat   
+      REAL(wp), DIMENSION(jpi,jpj) ::  hny_frc2    ! Haney forcing for sensible heat, correction for latent heat   
+      !!
       CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files
       TYPE(FLD_N) ::   sn_sst, sn_sss        ! informations about the fields to be read
@@ -95,11 +104,32 @@
             !
             IF( nn_sstr == 1 ) THEN                                   !* Temperature restoring term
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) )
-                     qns(ji,jj) = qns(ji,jj) + zqrp
-                     qrp(ji,jj) = zqrp
-                  END DO
-               END DO
+                  IF( ln_UKMO_haney ) THEN
+                     DO jj = 1, jpj
+                        DO ji = 1, jpi
+                           sst1   =  sst_m(ji,jj)
+                           sst2   =  sf_sst(1)%fnow(ji,jj,1)   
+                           e_sst1 = 10**((0.7859+0.03477*sst1)/(1.+0.00412*sst1))
+                           e_sst2 = 10**((0.7859+0.03477*sst2)/(1.+0.00412*sst2))         
+                           pr_tmp = 0.01*pressnow(ji,jj)  !pr_tmp = 1012.0
+                           qs1    = (0.62197*e_sst1)/(pr_tmp-0.378*e_sst1)
+                           qs2    = (0.62197*e_sst2)/(pr_tmp-0.378*e_sst2)
+                           hny_frc1(ji,jj) = sst1-sst2                   
+                           hny_frc2(ji,jj) = qs1-qs2                     
+                          !Might need to mask off land points.
+                           hny_frc1(ji,jj)=-hny_frc1(ji,jj)*wndm(ji,jj)*1.42
+                           hny_frc2(ji,jj)=-hny_frc2(ji,jj)*wndm(ji,jj)*4688.0
+                           qns(ji,jj)=qns(ji,jj)+hny_frc1(ji,jj)+hny_frc2(ji,jj)   
+                           qrp(ji,jj) = 0.e0
+                        END DO
+                     END DO
+                  ELSE
+                     DO jj = 1, jpj
+                        DO ji = 1, jpi
+                           zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) )
+                           qns(ji,jj) = qns(ji,jj) + zqrp
+                           qrp(ji,jj) = zqrp
+                        END DO
+                     END DO
+                  ENDIF
                CALL iom_put( "qrp", qrp )                             ! heat flux damping
             ENDIF
@@ -163,5 +193,5 @@
       CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files
       TYPE(FLD_N) ::   sn_sst, sn_sss        ! informations about the fields to be read
-      NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd
+      NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd, ln_UKMO_haney
       INTEGER     ::  ios
       !!----------------------------------------------------------------------
@@ -189,4 +219,5 @@
          WRITE(numout,*) '      flag to bound erp term                 ln_sssr_bnd = ', ln_sssr_bnd
          WRITE(numout,*) '      ABS(Max./Min.) erp threshold           rn_sssr_bnd = ', rn_sssr_bnd, ' mm/day'
+         WRITE(numout,*) '      Haney forcing                          ln_UKMO_haney = ', ln_UKMO_haney
       ENDIF
       !
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/tide.h90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/tide.h90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/tide.h90	(revision 10249)
@@ -28,2 +28,16 @@
    Wave(18) = tide(  'L2'     , 0.006694 ,    2   ,  2 , -1 ,  2 , -1 ,  0  , +180  ,  2   , -2   ,  0   ,  0   , 0 ,  215    )
    Wave(19) = tide(  'T2'     , 0.006614 ,    2   ,  2 ,  0 , -1 ,  0 ,  1  ,    0  ,  0   ,  0   ,  0   ,  0   , 0 ,    0    )
+   !
+   !             !! name_tide , equitide , nutide , nt , ns , nh , np , np1 , shift , nksi , nnu0 , nnu1 , nnu2 , R , formula !!
+   Wave(20) = tide(  'MNS2'   , 0.000000 ,    2   ,  2 , -5 ,  4 ,  1 ,  0  ,    0  ,  4   , -4   ,  0   ,  0   , 0 ,    6    )
+   Wave(21) = tide(  'Lam2'   , 0.001760 ,    2   ,  2 , -1 ,  0 ,  1 ,  0  , +180  ,  2   , -2   ,  0   ,  0   , 0 ,   78    )
+   Wave(22) = tide(  'MSN2'   , 0.000000 ,    2   ,  2 ,  1 ,  0 ,  1 ,  0  ,    0  ,  2   , -2   ,  0   ,  2   , 0 ,    6    )
+   Wave(23) = tide(  '2SM2'   , 0.000000 ,    2   ,  2 ,  2 , -2 ,  0 ,  0  ,    0  , -2   ,  2   ,  0   ,  0   , 0 ,   16    )
+   Wave(24) = tide(  'MO3'    , 0.000000 ,    3   ,  3 , -4 ,  1 ,  0 ,  0  ,  +90  ,  2   , -2   ,  0   ,  0   , 0 ,   13    )
+   Wave(25) = tide(  'MK3'    , 0.000000 ,    3   ,  3 , -2 ,  3 ,  0 ,  0  ,  -90  ,  2   , -2   , -1   ,  0   , 0 ,   10    )
+   Wave(26) = tide(  'MN4'    , 0.000000 ,    4   ,  4 , -5 ,  4 ,  1 ,  0  ,    0  ,  4   , -4   ,  0   ,  0   , 0 ,    1    )
+   Wave(27) = tide(  'MS4'    , 0.000000 ,    4   ,  4 , -2 ,  2 ,  0 ,  0  ,    0  ,  2   , -2   ,  0   ,  0   , 0 ,    2    )
+   Wave(28) = tide(  'M6'     , 0.000000 ,    6   ,  6 , -6 ,  6 ,  0 ,  0  ,    0  ,  6   , -6   ,  0   ,  0   , 0 ,    4    )
+   Wave(29) = tide(  '2MS6'   , 0.000000 ,    6   ,  6 , -4 ,  4 ,  0 ,  0  ,    0  ,  4   , -4   ,  0   ,  0   , 0 ,    6    )
+   Wave(30) = tide(  '2MK6'   , 0.000000 ,    6   ,  6 , -4 ,  6 ,  0 ,  0  ,    0  ,  4   , -4   ,  0   , -2   , 0 ,    5    )
+   Wave(31) = tide(  '3M2S2'  , 0.000000 ,    2   , 2  , -6 ,  6 ,  0 ,  0  ,    0  ,  6   , -6   ,  0   ,  0   , 0 ,   12    )
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/tide_mod.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/tide_mod.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/tide_mod.F90	(revision 10249)
@@ -16,8 +16,8 @@
    PUBLIC   tide_init_Wave   ! called by tideini and diaharm modules
 
-   INTEGER, PUBLIC, PARAMETER ::   jpmax_harmo = 19   !: maximum number of harmonic
+   INTEGER, PUBLIC, PARAMETER ::   jpmax_harmo = 31   !: maximum number of harmonic
 
    TYPE, PUBLIC ::    tide
-      CHARACTER(LEN=4) ::   cname_tide
+      CHARACTER(LEN=5) ::   cname_tide
       REAL(wp)         ::   equitide
       INTEGER          ::   nutide
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90	(revision 10249)
@@ -1241,5 +1241,6 @@
       IF(lwm) WRITE( numond, nameos )
       !
-      rau0        = 1026._wp                 !: volumic mass of reference     [kg/m3]
+      rau0        = 1020._wp                 !: volumic mass of reference     [kg/m3]
+!     rau0        = 1026._wp                 !: volumic mass of reference     [kg/m3]
       rcp         = 3991.86795711963_wp      !: heat capacity     [J/K]
       !
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90	(revision 10249)
@@ -100,4 +100,8 @@
          IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
       ENDIF
+! slwa unless you use l_trdtra too, the above switches off trend calculations for l_trdtrc
+         l_trd = .FALSE.
+         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
+!slwa
       !
       IF( l_trd )  THEN
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/tradwl.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/tradwl.F90	(revision 10249)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/tradwl.F90	(revision 10249)
@@ -0,0 +1,238 @@
+MODULE tradwl
+   !!======================================================================
+   !!                       ***  MODULE  tradwl  ***
+   !! Ocean physics: solar radiation penetration in the top ocean levels
+   !!======================================================================
+   !! History :  POLCOMS  !  1996-10  (J. Holt)  Original code
+   !!   NEMO     3.2  !  2010-03  (E. O'Dea)  Import to Nemo for use in Shelf Model
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_dwl      : trend due to the solar radiation penetration
+   !!   tra_dwl_init : solar radiation penetration initialization
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE sbc_oce         ! surface boundary condition: ocean
+   USE trc_oce         ! share SMS/Ocean variables
+   USE trd_oce         ! trends: ocean variables
+   USE trdtra          ! ocean active tracers trends 
+   USE in_out_manager  ! I/O manager
+   USE phycst          ! physical constants
+   USE prtctl          ! Print control
+   USE iom             ! I/O manager
+   USE fldread         ! read input fields
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_dwl        ! routine called by step.F90 (ln_tradwl=T)
+
+   !                                           !!* Namelist namtra_qsr: penetrative solar radiation
+   LOGICAL , PUBLIC ::   ln_tradwl  = .TRUE.    ! light absorption (dwl) flag
+   LOGICAL , PUBLIC ::   ln_vary_lambda  = .TRUE.    ! vary Lambda or not flag
+   
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE tra_dwl( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_qsr  ***
+      !!
+      !! ** Purpose :   Compute the temperature trend due to the solar radiation
+      !!      penetration and add it to the general temperature trend.
+      !!
+      !! ** Method  : The profile of the solar radiation within the ocean is defined
+      !!
+      !!          Jason Holt Oct 96
+      !!
+      !!          Calculates change in temperature due to penetrating
+      !!          radiation, with cooling at the surface layer
+      !!
+      !!          rad=rad0*exp(lambda*z)
+      !!
+      !!       Heat input into box is between z=K and z=K+1 is RAD(K)-RAD(K+1)
+      !!
+      !!
+      !! ** Action  : - update ta with the penetrative solar radiation trend
+      !!              - save the trend in ttrd ('key_trdtra')
+      !!
+      !!----------------------------------------------------------------------
+      USE oce, ONLY :   ztrdt => ua   ! use ua as 3D workspace   
+      USE oce, ONLY :   ztrds => va   ! use va as 3D workspace   
+      !!
+      INTEGER, INTENT(in) ::   kt     ! ocean time-step
+      !!
+      INTEGER  ::   ji, jj, jk           ! dummy loop indices
+      INTEGER  ::   irgb                 ! temporary integers
+      REAL(wp) ::   zchl, zcoef, zsi0r   ! temporary scalars
+      REAL(wp) ::   zc0, zc1, zc2, zc3   !    -         -
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zekb, zekg, zekr            ! 2D workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze0, ze1 , ze2, ze3, zea    ! 3D workspace
+      !!----------------------------------------------------------------------
+      !! HERE GO VARIABLES USED IN POLCOMS CLEAN UP LATER
+
+      integer i,j,k
+!      real*8 dtmp(n-1)
+      real*8 dtmp(jpkm1)
+      real*8 z1,z2,Rad0,Rad1,Rad2,rD,SurfOut,cp
+      logical first
+      save first
+      data first/.true./
+      !!--------------------------End of POLCOMS variables Note instead of using saves
+      !!--------------------------Could shift this into initial code
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_dwl : penetration of the surface solar radiation'
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+         CALL tra_dwl_init
+         IF( .NOT.ln_tradwl )   RETURN
+      ENDIF
+
+      IF( l_trdtra ) THEN      ! Save ta and sa trends
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
+         ztrds(:,:,:) = 0.e0
+      ENDIF
+!--------------------------------------------------------------------
+!  Set transmissivity
+!--------------------------------------------------------------------
+!
+!  Normal value
+!
+!---------------------------------------------------------------------------
+!
+!  Convert Heat fluxes to units used in POL subroutine dwl
+!
+!---------------------------------------------------------------------------
+      cp=3986.0d0
+
+    DO jj = 2, jpj
+         DO ji = fs_2, fs_jpim1
+           qsr(ji,jj)  = qsr(ji,jj)  * (r1_rau0_rcp)
+         ENDDO       !ji
+    ENDDO            !jj
+!--------------------------------------------------------------------------------
+      if ( first ) then
+        rlambda2(:,:) = 0.0
+        first=.false.
+           if ( ln_vary_lambda ) then
+!        do j=1,jesub    ! Original Polcoms style Loop
+!          do i=1,iesub  ! Original Polcoms style Loop
+
+        do jj=2,jpjm1
+          do ji = fs_2, fs_jpim1   ! vector opt.
+
+!            if(ipexb(i,j).ne. 0) then  (Mask, use Tmask instead)
+
+              rlambda2(ji,jj)=-0.033*log(hbatt(ji,jj))+0.2583    ! JIAs formula
+              rlambda2(ji,jj)=max(0.05,rlambda2(ji,jj))     ! limit in deep water
+          enddo ! ji
+        enddo ! jj
+      rlambda = 0.0
+       else
+      rLambda=0.154
+       endif ! If vary lambda
+      endif ! If first
+
+!      do j=1,jesub      ! Original Polcoms Style Loop
+!        do i=1,iesub    ! Original Polcoms Style Loop
+              do jk=2,jpk
+        DO jj=2,jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+
+!--------------------------------------------------------------------
+! Calculate change in temperature
+!--------------------------------------------------------------------
+!
+!        rad0 = hfl_in(i,j)   ! change hfl_in to qsr I assume
+
+               rad0 = qsr(ji,jj)
+                     rD = rLambda2(ji,jj)  +rLambda      !  Transmissivity to be used here
+!       if rlambda 0 then rlambda2 not zer and vica versa 
+
+                z2=gdepw_0(ji,jj,jk-1)    ! grid box is from z=z1 to z=z2
+                z1=gdepw_0(ji,jj,jk)
+
+                Rad2=Rad0*(exp(-z2*rD)) ! radiation entering box
+                Rad1=Rad0*(exp(-z1*rD)) ! radiation leaving box
+
+
+                dtmp(jk)=1.0/(e3t_0(ji,jj,jk))*(Rad2-Rad1) !change in temperature
+                tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + dtmp(jk)
+         enddo  ! ji
+         enddo  ! jj
+             enddo !jk
+
+
+      IF( l_trdtra ) THEN     ! qsr tracers trends saved for diagnostics
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
+         !CEODCALL trd_mod( ztrdt, ztrds, jptra_trd_qsr, 'TRA', kt )
+      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' )
+      !
+   END SUBROUTINE tra_dwl
+
+
+   SUBROUTINE tra_dwl_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_dwl_init  ***
+      !!
+      !! ** Purpose :   Initialization for the penetrative solar radiation for Downwell routine
+      !!
+      !! ** Method  :   The profile of solar radiation within the ocean is set
+      !!      from two length scale of penetration (rn_si0,rn_si1) and a ratio
+      !!      (rn_abs). These parameters are read in the namtra_qsr namelist. The
+      !!      default values correspond to clear water (type I in Jerlov' 
+      !!      (1968) classification.
+      !!         called by tra_qsr at the first timestep (nit000)
+      !!
+      !! ** Action  : - initialize rn_si0, rn_si1 and rn_abs
+      !!
+      !! Reference : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp.
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk            ! dummy loop indices
+      INTEGER  ::   ios                   ! Local integer output status for namelist read
+      INTEGER  ::   irgb, ierror          ! temporary integer
+      INTEGER  ::   ioptio, nqsr          ! temporary integer
+      REAL(wp) ::   zc0  , zc1            ! temporary scalars
+      REAL(wp) ::   zc2  , zc3  , zchl    !    -         -
+      REAL(wp) ::   zsi0r, zsi1r, zcoef   !    -         -
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zekb, zekg, zekr              ! 2D workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze0 , ze1 , ze2 , ze3 , zea   ! 3D workspace
+      !!
+      CHARACTER(len=100) ::   cn_dir   ! Root directory for location of ssr files
+      TYPE(FLD_N)        ::   sn_chl   ! informations about the chlorofyl field to be read
+      NAMELIST/namtra_dwl/  ln_tradwl, ln_vary_lambda
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam_ref )            ! Read Namelist namtra_dwl in reference namelist :
+      READ  ( numnam_ref, namtra_dwl, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_qsr in reference namelist', lwp )
+      
+      REWIND( numnam_cfg )            ! Read Namelist namtra_dwl in configuration namelist :
+      READ  ( numnam_cfg, namtra_dwl, IOSTAT = ios, ERR = 902)
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_qsr in configuration namelist', lwp )
+      !
+      IF(lwp) THEN                ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_dwl_init : '
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namtra_dwl : set the parameter of penetration'
+         WRITE(numout,*) '      Light penetration (T) or not (F)         ln_tradwl  = ', ln_tradwl
+         WRITE(numout,*) '      Vary Lambda  (T) or not (F))             ln_vary_lambda  = ', ln_vary_lambda
+      ENDIF
+
+   END SUBROUTINE tra_dwl_init
+
+   !!======================================================================
+END MODULE tradwl
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 10249)
@@ -58,4 +58,5 @@
 
    REAL(wp) ::   rbcp   ! Brown & Campana parameters for semi-implicit hpg
+   INTEGER  ::   warn_1, warn_2   ! indicators for warning statement
 
    !! * Substitutions
@@ -93,6 +94,6 @@
       INTEGER, INTENT(in) ::   kt    ! ocean time-step index
       !!
-      INTEGER  ::   jk, jn    ! dummy loop indices
-      REAL(wp) ::   zfact     ! local scalars
+      INTEGER  ::   jk, jn, ji, jj     ! dummy loop indices
+      REAL(wp) ::   zfact, zfreeze     ! local scalars
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds
       !!----------------------------------------------------------------------
@@ -125,4 +126,33 @@
       ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dtra(:) = 2._wp* rdttra(:)      ! at nit000 or nit000+1 (Leapfrog)
       ENDIF
+
+#if ( ! defined key_lim3 && ! defined key_lim2 && ! key_cice )
+      IF ( kt == nit000 ) warn_1=0
+      warn_2=0
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF ( tsa(ji,jj,jk,jp_tem) .lt. 0.0 ) THEN
+                  ! calculate freezing point
+                  zfreeze = ( -0.0575_wp + 1.710523E-3 * Sqrt(Abs(tsn(ji,jj,jk,jp_sal)))   & 
+                            - 2.154996E-4 * tsn(ji,jj,jk,jp_sal) ) * tsn(ji,jj,jk,jp_sal) - 7.53E-4 * ( 10.0_wp + fsdept(ji,jj,jk) )
+                  IF ( tsa(ji,jj,jk,jp_tem) .lt. zfreeze ) THEN
+                     tsa(ji,jj,jk,jp_tem)=zfreeze
+                     warn_2=1
+                  ENDIF
+               ENDIF
+            END DO
+         END DO
+      END DO
+      CALL mpp_max(warn_1)
+      CALL mpp_max(warn_2)
+      IF ( (warn_1 == 0) .and. (warn_2 /= 0) ) THEN
+         IF(lwp) THEN
+            CALL ctl_warn( ' Temperatures dropping below freezing point, ', &
+                      &    ' being forced to freezing point, no longer conservative' ) 
+         ENDIF
+         warn_1=1
+      ENDIF
+#endif
 
       ! trends computation initialisation
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 10249)
@@ -46,4 +46,5 @@
    LOGICAL , PUBLIC ::   ln_qsr_ice   !: light penetration for ice-model LIM3 (clem)
    INTEGER , PUBLIC ::   nn_chldta    !: use Chlorophyll data (=1) or not (=0)
+   INTEGER , PUBLIC ::   nn_kd490dta  !: use kd490dta data (=1) or not (=0)
    REAL(wp), PUBLIC ::   rn_abs       !: fraction absorbed in the very near surface (RGB & 2 bands)
    REAL(wp), PUBLIC ::   rn_si0       !: very near surface depth of extinction      (RGB & 2 bands)
@@ -54,4 +55,5 @@
    REAL(wp) ::   xsi1r                           !: inverse of rn_si1
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_chl   ! structure of input Chl (file informations, fields read)
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_kd490 ! structure of input kd490 (file informations, fields read)
    INTEGER, PUBLIC ::   nksr              ! levels below which the light cannot penetrate ( depth larger than 391 m)
    REAL(wp), DIMENSION(3,61) ::   rkrgb   !: tabulated attenuation coefficients for RGB absorption
@@ -306,4 +308,48 @@
             !
          ENDIF
+! slwa
+         IF( nn_kd490dta == 1 ) THEN                      !  use KD490 data read in   !
+            !                                             ! ------------------------- !
+               nksr = jpk - 1
+               !
+               CALL fld_read( kt, 1, sf_kd490 )     ! Read kd490 data and provide it at the current time step
+               !
+               zcoef  = ( 1. - rn_abs )
+               ze0(:,:,1) = rn_abs  * qsr(:,:)
+               ze1(:,:,1) = zcoef * qsr(:,:)
+               zea(:,:,1) =         qsr(:,:)
+               !
+               DO jk = 2, nksr+1
+!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     )
+                        zc1 = ze1(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * sf_kd490(1)%fnow(ji,jj,1) )
+                        ze0(ji,jj,jk) = zc0
+                        ze1(ji,jj,jk) = zc1
+                        zea(ji,jj,jk) = ( zc0 + zc1 ) * tmask(ji,jj,jk)
+                     END DO
+                  END DO
+               END DO
+               ! clem: store attenuation coefficient of the first ocean level
+               IF ( ln_qsr_ice ) THEN
+                  DO jj = 1, jpj
+                     DO ji = 1, jpi
+                        zzc0 = rn_abs * EXP( - fse3t(ji,jj,1) * xsi0r     )
+                        zzc1 = zcoef  * EXP( - fse3t(ji,jj,1) * sf_kd490(1)%fnow(ji,jj,1) )
+                        fraqsr_1lev(ji,jj) = 1.0 - ( zzc0 + zzc1 ) * tmask(ji,jj,2) 
+                     END DO
+                  END DO
+               ENDIF
+               !
+               DO jk = 1, nksr                                        ! compute and add qsr trend to ta
+                  qsr_hc(:,:,jk) = r1_rau0_rcp * ( zea(:,:,jk) - zea(:,:,jk+1) )
+               END DO
+               zea(:,:,nksr+1:jpk) = 0.e0     ! 
+               CALL iom_put( 'qsr3d', zea )   ! Shortwave Radiation 3D distribution
+               !
+        ENDIF   ! use KD490 data
+!slwa
          !
          !                                        Add to the general trend
@@ -374,7 +420,8 @@
       CHARACTER(len=100) ::   cn_dir   ! Root directory for location of ssr files
       TYPE(FLD_N)        ::   sn_chl   ! informations about the chlorofyl field to be read
-      !!
-      NAMELIST/namtra_qsr/  sn_chl, cn_dir, ln_traqsr, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, ln_qsr_ice,  &
-         &                  nn_chldta, rn_abs, rn_si0, rn_si1
+      TYPE(FLD_N)        ::   sn_kd490 ! informations about the kd490 field to be read
+      !!
+      NAMELIST/namtra_qsr/  sn_chl, sn_kd490, cn_dir, ln_traqsr, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, ln_qsr_ice,  &
+         &                  nn_chldta, rn_abs, rn_si0, rn_si1, nn_kd490dta
       !!----------------------------------------------------------------------
 
@@ -409,4 +456,5 @@
          WRITE(numout,*) '      RGB & 2 bands: shortess depth of extinction  rn_si0 = ', rn_si0
          WRITE(numout,*) '      2 bands: longest depth of extinction         rn_si1 = ', rn_si1
+         WRITE(numout,*) '      read in KD490 data                       nn_kd490dta  = ', nn_kd490dta
       ENDIF
 
@@ -422,4 +470,5 @@
          IF( ln_qsr_2bd  )   ioptio = ioptio + 1
          IF( ln_qsr_bio  )   ioptio = ioptio + 1
+         IF( nn_kd490dta == 1 )   ioptio = ioptio + 1
          !
          IF( ioptio /= 1 ) &
@@ -431,4 +480,5 @@
          IF( ln_qsr_2bd                      )   nqsr =  3
          IF( ln_qsr_bio                      )   nqsr =  4
+         IF( nn_kd490dta == 1                )   nqsr =  5
          !
          IF(lwp) THEN                   ! Print the choice
@@ -438,4 +488,5 @@
             IF( nqsr ==  3 )   WRITE(numout,*) '         2 bands light penetration'
             IF( nqsr ==  4 )   WRITE(numout,*) '         bio-model light penetration'
+            IF( nqsr ==  5 )   WRITE(numout,*) '         KD490 light penetration'
          ENDIF
          !
@@ -447,6 +498,18 @@
          xsi0r = 1.e0 / rn_si0
          xsi1r = 1.e0 / rn_si1
+         IF( nn_kd490dta == 1 ) THEN           !* KD490 data : set sf_kd490 structure
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '        KD490 read in a file'
+            ALLOCATE( sf_kd490(1), STAT=ierror )
+            IF( ierror > 0 ) THEN
+               CALL ctl_stop( 'tra_qsr_init: unable to allocate sf_kd490 structure' )   ;   RETURN
+            ENDIF
+            ALLOCATE( sf_kd490(1)%fnow(jpi,jpj,1)   )
+            IF( sn_kd490%ln_tint )ALLOCATE( sf_kd490(1)%fdta(jpi,jpj,1,2) )
+            !                                        ! fill sf_kd490 with sn_kd490 and control print
+            CALL fld_fill( sf_kd490, (/ sn_kd490 /), cn_dir, 'tra_qsr_init',   &
+               &                                         'Solar penetration function of read KD490', 'namtra_qsr' )
          !                                ! ---------------------------------- !
-         IF( ln_qsr_rgb ) THEN            !  Red-Green-Blue light penetration  !
+         ELSEIF( ln_qsr_rgb ) THEN            !  Red-Green-Blue light penetration  !
             !                             ! ---------------------------------- !
             !
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90	(revision 10249)
@@ -25,4 +25,5 @@
    USE trd_oce         ! trends: ocean variables
    USE trdtra          ! trends manager: tracers 
+   USE tradwl          ! solar radiation penetration (downwell method)
    !
    USE in_out_manager  ! I/O manager
@@ -33,4 +34,7 @@
    USE timing          ! Timing
    USE eosbn2
+#if defined key_asminc   
+   USE asminc          ! Assimilation increment
+#endif
 
    IMPLICIT NONE
@@ -138,5 +142,5 @@
 
 !!gm      IF( .NOT.ln_traqsr )   qsr(:,:) = 0.e0   ! no solar radiation penetration
-      IF( .NOT.ln_traqsr ) THEN     ! no solar radiation penetration
+      IF( .NOT.ln_traqsr .and. .NOT.ln_tradwl ) THEN     ! no solar radiation penetration
          qns(:,:) = qns(:,:) + qsr(:,:)      ! total heat flux in qns
          qsr(:,:) = 0.e0                     ! qsr set to zero
@@ -278,4 +282,23 @@
          END DO  
       ENDIF
+
+#if defined key_asminc
+! WARNING: THIS MAY WELL NOT BE REQUIRED - WE DON'T WANT TO CHANGE T&S BUT THIS MAY COMPENSATE ANOTHER TERM...
+! Rate of change in e3t for each level is ssh_iau*e3t_0/ht_0
+! Contribution to tsa should be rate of change in level / per m of ocean? (hence the division by fse3t_n)
+      IF( ln_sshinc ) THEN         ! input of heat and salt due to assimilation
+         DO jj = 2, jpj 
+            DO ji = fs_2, fs_jpim1
+               zdep = ssh_iau(ji,jj) / ( ht_0(ji,jj) + 1.0 - ssmask(ji, jj) )
+               DO jk = 1, jpkm1
+                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
+                                        &            + tsn(ji,jj,jk,jp_tem) * zdep * ( e3t_0(ji,jj,jk) / fse3t_n(ji,jj,jk) )
+                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   &
+                                        &            + tsn(ji,jj,jk,jp_sal) * zdep * ( e3t_0(ji,jj,jk) / fse3t_n(ji,jj,jk) )
+               END DO
+            END DO  
+         END DO  
+      ENDIF
+#endif
  
       IF( l_trdtra )   THEN                      ! send trends for further diagnostics
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90	(revision 10249)
@@ -203,7 +203,12 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+#if defined key_tracer_budget
+!              ptrd(ji,jj,jk) = - (     pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik)  )  * tmask(ji,jj,jk)
+               ptrd(ji,jj,jk) = -      pf (ji,jj,jk) * tmask(ji,jj,jk)
+#else
                ptrd(ji,jj,jk) = - (     pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik)                        &
                  &                  - ( pun(ji,jj,jk) - pun(ji-ii,jj-ij,jk-ik) ) * ptn(ji,jj,jk)  )   &
                  &              / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )  * tmask(ji,jj,jk)
+#endif
             END DO
          END DO
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90	(revision 10249)
@@ -18,4 +18,5 @@
    USE phycst          ! physical constants
    USE iom             ! I/O library
+   USE eosbn2          ! for zdf_mxl_zint
    USE lib_mpp         ! MPP library
    USE wrk_nemo        ! work arrays
@@ -26,14 +27,37 @@
    PRIVATE
 
+   PUBLIC   zdf_mxl_tref  ! called by asminc.F90
    PUBLIC   zdf_mxl       ! called by step.F90
-   PUBLIC   zdf_mxl_alloc ! Used in zdf_tke_init
-
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmld_tref  !: mixed layer depth at t-points - temperature criterion [m]
    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   nmln    !: number of level in the mixed layer (used by TOP)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmld    !: mixing layer depth (turbocline)      [m]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmlp    !: mixed layer depth  (rho=rho0+zdcrit) [m]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmlpt   !: mixed layer depth at t-points        [m]
+   REAL(wp), PUBLIC, ALLOCATABLE,       DIMENSION(:,:) ::   hmld_zint  !: vertically-interpolated mixed layer depth   [m] 
+   REAL(wp), PUBLIC, ALLOCATABLE,       DIMENSION(:,:) ::   htc_mld    ! Heat content of hmld_zint
+   LOGICAL, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)    :: ll_found   ! Is T_b to be found by interpolation ? 
+   LOGICAL, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  :: ll_belowml ! Flag points below mixed layer when ll_found=F
 
    REAL(wp), PUBLIC ::   rho_c = 0.01_wp    !: density criterion for mixed layer depth
    REAL(wp)         ::   avt_c = 5.e-4_wp   ! Kz criterion for the turbocline depth
+
+   TYPE, PUBLIC :: MXL_ZINT   !: Structure for MLD defs
+      INTEGER   :: mld_type   ! mixed layer type     
+      REAL(wp)  :: zref       ! depth of initial T_ref
+      REAL(wp)  :: dT_crit    ! Critical temp diff
+      REAL(wp)  :: iso_frac   ! Fraction of rn_dT_crit used
+   END TYPE MXL_ZINT
+
+!Used for 25h mean
+   LOGICAL, PRIVATE :: mld_25h_init = .TRUE.    !Logical used to initalise 25h
+                                                !outputs. Necassary, because we need to
+                                                !initalise the mld_25h on the zeroth
+                                                !timestep (i.e in the nemogcm_init call)
+   LOGICAL, PRIVATE :: mld_25h_write = .FALSE.  !Logical confirm 25h calculating/processing
+
+   INTEGER, SAVE :: i_cnt_25h                   ! Counter for 25 hour means
+
+   REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   hmld_zint_25h
 
    !! * Substitutions
@@ -52,6 +76,9 @@
       zdf_mxl_alloc = 0      ! set to zero if no array to be allocated
       IF( .NOT. ALLOCATED( nmln ) ) THEN
-         ALLOCATE( nmln(jpi,jpj), hmld(jpi,jpj), hmlp(jpi,jpj), hmlpt(jpi,jpj), STAT= zdf_mxl_alloc )
+         ALLOCATE( nmln(jpi,jpj), hmld(jpi,jpj), hmlp(jpi,jpj), hmlpt(jpi,jpj), hmld_zint(jpi,jpj),       &
+        &          htc_mld(jpi,jpj),                                                                    &
+        &          ll_found(jpi,jpj), ll_belowml(jpi,jpj,jpk), STAT= zdf_mxl_alloc )
          !
+         ALLOCATE(hmld_tref(jpi,jpj))
          IF( lk_mpp             )   CALL mpp_sum ( zdf_mxl_alloc )
          IF( zdf_mxl_alloc /= 0 )   CALL ctl_warn('zdf_mxl_alloc: failed to allocate arrays.')
@@ -60,4 +87,46 @@
    END FUNCTION zdf_mxl_alloc
 
+   SUBROUTINE zdf_mxl_tref() 
+      !!---------------------------------------------------------------------- 
+      !!                  ***  ROUTINE zdf_mxl_tref  *** 
+      !!                    
+      !! ** Purpose :   Compute the mixed layer depth with temperature criteria. 
+      !! 
+      !! ** Method  :   The temperature-defined mixed layer depth is required 
+      !!                   when assimilating SST in a 2D analysis.  
+      !! 
+      !! ** Action  :   hmld_tref 
+      !!---------------------------------------------------------------------- 
+      ! 
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
+      REAL(wp) ::   t_ref               ! Reference temperature   
+      REAL(wp) ::   temp_c = 0.2        ! temperature criterion for mixed layer depth   
+      !!---------------------------------------------------------------------- 
+      ! 
+      ! Initialise array 
+      IF( zdf_mxl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_mxl_tref : unable to allocate arrays' ) 
+       
+      !For the AMM model assimiation uses a temperature based mixed layer depth   
+      !This is defined here   
+      DO jj = 1, jpj   
+         DO ji = 1, jpi   
+           hmld_tref(ji,jj)=fsdept(ji,jj,1  )    
+           IF(ssmask(ji,jj) > 0.)THEN   
+             t_ref=tsn(ji,jj,1,jp_tem)  
+             DO jk=2,jpk   
+               IF(ssmask(ji,jj)==0.)THEN   
+                  hmld_tref(ji,jj)=fsdept(ji,jj,jk )   
+                  EXIT   
+               ELSEIF( ABS(tsn(ji,jj,jk,jp_tem)-t_ref) < temp_c)THEN   
+                  hmld_tref(ji,jj)=fsdept(ji,jj,jk )   
+               ELSE   
+                  EXIT   
+               ENDIF   
+             ENDDO   
+           ENDIF   
+         ENDDO   
+      ENDDO 
+   
+   END SUBROUTINE zdf_mxl_tref 
 
    SUBROUTINE zdf_mxl( kt )
@@ -128,7 +197,7 @@
             iikn = nmln(ji,jj)
             imkt = mikt(ji,jj)
-            hmld (ji,jj) = ( fsdepw(ji,jj,iiki  ) - fsdepw(ji,jj,imkt ) ) * ssmask(ji,jj)    ! Turbocline depth 
-            hmlp (ji,jj) = ( fsdepw(ji,jj,iikn  ) - fsdepw(ji,jj,imkt ) ) * ssmask(ji,jj)    ! Mixed layer depth
-            hmlpt(ji,jj) = ( fsdept(ji,jj,iikn-1) - fsdepw(ji,jj,imkt ) ) * ssmask(ji,jj)    ! depth of the last T-point inside the mixed layer
+            hmld (ji,jj) = ( fsdepw(ji,jj,iiki  ) - fsdepw(ji,jj,imkt )            )   * ssmask(ji,jj)    ! Turbocline depth 
+            hmlp (ji,jj) = ( fsdepw(ji,jj,iikn  ) - fsdepw(ji,jj,MAX( imkt,nla10 ) ) ) * ssmask(ji,jj)    ! Mixed layer depth
+            hmlpt(ji,jj) = ( fsdept(ji,jj,iikn-1) - fsdepw(ji,jj,imkt )            )   * ssmask(ji,jj)    ! depth of the last T-point inside the mixed layer
          END DO
       END DO
@@ -138,4 +207,7 @@
       ENDIF
       
+      ! Vertically-interpolated mixed-layer depth diagnostic
+      CALL zdf_mxl_zint( kt )
+
       IF(ln_ctl)   CALL prt_ctl( tab2d_1=REAL(nmln,wp), clinfo1=' nmln : ', tab2d_2=hmlp, clinfo2=' hmlp : ', ovlap=1 )
       !
@@ -145,4 +217,392 @@
       !
    END SUBROUTINE zdf_mxl
+
+   SUBROUTINE zdf_mxl_zint_mld( sf ) 
+      !!---------------------------------------------------------------------------------- 
+      !!                    ***  ROUTINE zdf_mxl_zint_mld  *** 
+      !                                                                        
+      !   Calculate vertically-interpolated mixed layer depth diagnostic. 
+      !            
+      !   This routine can calculate the mixed layer depth diagnostic suggested by
+      !   Kara et al, 2000, JGR, 105, 16803, but is more general and can calculate
+      !   vertically-interpolated mixed-layer depth diagnostics with other parameter
+      !   settings set in the namzdf_mldzint namelist.  
+      ! 
+      !   If mld_type=1 the mixed layer depth is calculated as the depth at which the  
+      !   density has increased by an amount equivalent to a temperature difference of  
+      !   0.8C at the surface. 
+      ! 
+      !   For other values of mld_type the mixed layer is calculated as the depth at  
+      !   which the temperature differs by 0.8C from the surface temperature.  
+      !                                                                        
+      !   David Acreman, Daley Calvert                                      
+      ! 
+      !!----------------------------------------------------------------------------------- 
+
+      TYPE(MXL_ZINT), INTENT(in)  :: sf
+
+      ! Diagnostic criteria
+      INTEGER   :: nn_mld_type   ! mixed layer type     
+      REAL(wp)  :: rn_zref       ! depth of initial T_ref
+      REAL(wp)  :: rn_dT_crit    ! Critical temp diff
+      REAL(wp)  :: rn_iso_frac   ! Fraction of rn_dT_crit used
+
+      ! Local variables
+      REAL(wp), PARAMETER :: zepsilon = 1.e-30          ! local small value
+      INTEGER, POINTER, DIMENSION(:,:) :: ikmt          ! number of active tracer levels 
+      INTEGER, POINTER, DIMENSION(:,:) :: ik_ref        ! index of reference level 
+      INTEGER, POINTER, DIMENSION(:,:) :: ik_iso        ! index of last uniform temp level 
+      REAL, POINTER, DIMENSION(:,:,:)  :: zT            ! Temperature or density 
+      REAL, POINTER, DIMENSION(:,:)    :: ppzdep        ! depth for use in calculating d(rho) 
+      REAL, POINTER, DIMENSION(:,:)    :: zT_ref        ! reference temperature 
+      REAL    :: zT_b                                   ! base temperature 
+      REAL, POINTER, DIMENSION(:,:,:)  :: zdTdz         ! gradient of zT 
+      REAL, POINTER, DIMENSION(:,:,:)  :: zmoddT        ! Absolute temperature difference 
+      REAL    :: zdz                                    ! depth difference 
+      REAL    :: zdT                                    ! temperature difference 
+      REAL, POINTER, DIMENSION(:,:)    :: zdelta_T      ! difference critereon 
+      REAL, POINTER, DIMENSION(:,:)    :: zRHO1, zRHO2  ! Densities 
+      INTEGER :: ji, jj, jk                             ! loop counter 
+
+      !!------------------------------------------------------------------------------------- 
+      !  
+      CALL wrk_alloc( jpi, jpj, ikmt, ik_ref, ik_iso) 
+      CALL wrk_alloc( jpi, jpj, ppzdep, zT_ref, zdelta_T, zRHO1, zRHO2 ) 
+      CALL wrk_alloc( jpi, jpj, jpk, zT, zdTdz, zmoddT ) 
+
+      ! Unpack structure
+      nn_mld_type = sf%mld_type
+      rn_zref     = sf%zref
+      rn_dT_crit  = sf%dT_crit
+      rn_iso_frac = sf%iso_frac
+
+      ! Set the mixed layer depth criterion at each grid point 
+      IF( nn_mld_type == 0 ) THEN
+         zdelta_T(:,:) = rn_dT_crit
+         zT(:,:,:) = rhop(:,:,:)
+      ELSE IF( nn_mld_type == 1 ) THEN
+         ppzdep(:,:)=0.0 
+         call eos ( tsn(:,:,1,:), ppzdep(:,:), zRHO1(:,:) ) 
+! Use zT temporarily as a copy of tsn with rn_dT_crit added to SST 
+! [assumes number of tracers less than number of vertical levels] 
+         zT(:,:,1:jpts)=tsn(:,:,1,1:jpts) 
+         zT(:,:,jp_tem)=zT(:,:,1)+rn_dT_crit 
+         CALL eos( zT(:,:,1:jpts), ppzdep(:,:), zRHO2(:,:) ) 
+         zdelta_T(:,:) = abs( zRHO1(:,:) - zRHO2(:,:) ) * rau0 
+         ! RHO from eos (2d version) doesn't calculate north or east halo: 
+         CALL lbc_lnk( zdelta_T, 'T', 1. ) 
+         zT(:,:,:) = rhop(:,:,:) 
+      ELSE 
+         zdelta_T(:,:) = rn_dT_crit                      
+         zT(:,:,:) = tsn(:,:,:,jp_tem)                           
+      END IF 
+
+      ! Calculate the gradient of zT and absolute difference for use later 
+      DO jk = 1 ,jpk-2 
+         zdTdz(:,:,jk)  =    ( zT(:,:,jk+1) - zT(:,:,jk) ) / fse3w(:,:,jk+1) 
+         zmoddT(:,:,jk) = abs( zT(:,:,jk+1) - zT(:,:,jk) ) 
+      END DO 
+
+      ! Find density/temperature at the reference level (Kara et al use 10m).          
+      ! ik_ref is the index of the box centre immediately above or at the reference level 
+      ! Find rn_zref in the array of model level depths and find the ref    
+      ! density/temperature by linear interpolation.                                   
+      DO jk = jpkm1, 2, -1 
+         WHERE ( fsdept(:,:,jk) > rn_zref ) 
+           ik_ref(:,:) = jk - 1 
+           zT_ref(:,:) = zT(:,:,jk-1) + zdTdz(:,:,jk-1) * ( rn_zref - fsdept(:,:,jk-1) ) 
+         END WHERE 
+      END DO 
+
+      ! If the first grid box centre is below the reference level then use the 
+      ! top model level to get zT_ref 
+      WHERE ( fsdept(:,:,1) > rn_zref )  
+         zT_ref = zT(:,:,1) 
+         ik_ref = 1 
+      END WHERE 
+
+      ! The number of active tracer levels is 1 less than the number of active w levels 
+      ikmt(:,:) = mbathy(:,:) - 1 
+
+      ! Initialize / reset
+      ll_found(:,:) = .false.
+
+      IF ( rn_iso_frac - zepsilon > 0. ) THEN
+         ! Search for a uniform density/temperature region where adjacent levels          
+         ! differ by less than rn_iso_frac * deltaT.                                      
+         ! ik_iso is the index of the last level in the uniform layer  
+         ! ll_found indicates whether the mixed layer depth can be found by interpolation 
+         ik_iso(:,:)   = ik_ref(:,:) 
+         DO jj = 1, nlcj 
+            DO ji = 1, nlci 
+!CDIR NOVECTOR 
+               DO jk = ik_ref(ji,jj), ikmt(ji,jj)-1 
+                  IF ( zmoddT(ji,jj,jk) > ( rn_iso_frac * zdelta_T(ji,jj) ) ) THEN 
+                     ik_iso(ji,jj)   = jk 
+                     ll_found(ji,jj) = ( zmoddT(ji,jj,jk) > zdelta_T(ji,jj) ) 
+                     EXIT 
+                  END IF 
+               END DO 
+            END DO 
+         END DO 
+
+         ! Use linear interpolation to find depth of mixed layer base where possible 
+         hmld_zint(:,:) = rn_zref 
+         DO jj = 1, jpj 
+            DO ji = 1, jpi 
+               IF (ll_found(ji,jj) .and. tmask(ji,jj,1) == 1.0) THEN 
+                  zdz =  abs( zdelta_T(ji,jj) / zdTdz(ji,jj,ik_iso(ji,jj)) ) 
+                  hmld_zint(ji,jj) = fsdept(ji,jj,ik_iso(ji,jj)) + zdz 
+               END IF 
+            END DO 
+         END DO 
+      END IF
+
+      ! If ll_found = .false. then calculate MLD using difference of zdelta_T    
+      ! from the reference density/temperature 
+ 
+! Prevent this section from working on land points 
+      WHERE ( tmask(:,:,1) /= 1.0 ) 
+         ll_found = .true. 
+      END WHERE 
+ 
+      DO jk=1, jpk 
+         ll_belowml(:,:,jk) = abs( zT(:,:,jk) - zT_ref(:,:) ) >= zdelta_T(:,:)  
+      END DO 
+ 
+! Set default value where interpolation cannot be used (ll_found=false)  
+      DO jj = 1, jpj 
+         DO ji = 1, jpi 
+            IF ( .not. ll_found(ji,jj) )  hmld_zint(ji,jj) = fsdept(ji,jj,ikmt(ji,jj)) 
+         END DO 
+      END DO 
+
+      DO jj = 1, jpj 
+         DO ji = 1, jpi 
+!CDIR NOVECTOR 
+            DO jk = ik_ref(ji,jj)+1, ikmt(ji,jj) 
+               IF ( ll_found(ji,jj) ) EXIT 
+               IF ( ll_belowml(ji,jj,jk) ) THEN                
+                  zT_b = zT_ref(ji,jj) + zdelta_T(ji,jj) * SIGN(1.0, zdTdz(ji,jj,jk-1) ) 
+                  zdT  = zT_b - zT(ji,jj,jk-1)                                      
+                  zdz  = zdT / zdTdz(ji,jj,jk-1)                                       
+                  hmld_zint(ji,jj) = fsdept(ji,jj,jk-1) + zdz 
+                  EXIT                                                   
+               END IF 
+            END DO 
+         END DO 
+      END DO 
+
+      hmld_zint(:,:) = hmld_zint(:,:)*tmask(:,:,1) 
+      !  
+      CALL wrk_dealloc( jpi, jpj, ikmt, ik_ref, ik_iso) 
+      CALL wrk_dealloc( jpi, jpj, ppzdep, zT_ref, zdelta_T, zRHO1, zRHO2 ) 
+      CALL wrk_dealloc( jpi,jpj, jpk, zT, zdTdz, zmoddT ) 
+      ! 
+   END SUBROUTINE zdf_mxl_zint_mld
+
+   SUBROUTINE zdf_mxl_zint_htc( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_mxl_zint_htc  ***
+      !! 
+      !! ** Purpose :   
+      !!
+      !! ** Method  :   
+      !!----------------------------------------------------------------------
+
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+
+      INTEGER :: ji, jj, jk
+      INTEGER :: ikmax
+      REAL(wp) :: zc, zcoef
+      !
+      INTEGER,  ALLOCATABLE, DIMENSION(:,:) ::   ilevel
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zthick_0, zthick
+
+      !!----------------------------------------------------------------------
+
+      IF( .NOT. ALLOCATED(ilevel) ) THEN
+         ALLOCATE( ilevel(jpi,jpj), zthick_0(jpi,jpj), &
+         &         zthick(jpi,jpj), STAT=ji )
+         IF( lk_mpp  )   CALL mpp_sum(ji)
+         IF( ji /= 0 )   CALL ctl_stop( 'STOP', 'zdf_mxl_zint_htc : unable to allocate arrays' )
+      ENDIF
+
+      ! Find last whole model T level above the MLD
+      ilevel(:,:)   = 0
+      zthick_0(:,:) = 0._wp
+
+      DO jk = 1, jpkm1  
+         DO jj = 1, jpj
+            DO ji = 1, jpi                    
+               zthick_0(ji,jj) = zthick_0(ji,jj) + fse3t(ji,jj,jk)
+               IF( zthick_0(ji,jj) < hmld_zint(ji,jj) )   ilevel(ji,jj) = jk
+            END DO
+         END DO
+         WRITE(numout,*) 'zthick_0(jk =',jk,') =',zthick_0(2,2)
+         WRITE(numout,*) 'fsdepw(jk+1 =',jk+1,') =',fsdepw(2,2,jk+1)
+      END DO
+
+      ! Surface boundary condition
+      IF( lk_vvl ) THEN   ;   zthick(:,:) = 0._wp       ;   htc_mld(:,:) = 0._wp                                   
+      ELSE                ;   zthick(:,:) = sshn(:,:)   ;   htc_mld(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) * tmask(:,:,1)   
+      ENDIF
+
+      ! Deepest whole T level above the MLD
+      ikmax = MIN( MAXVAL( ilevel(:,:) ), jpkm1 )
+
+      ! Integration down to last whole model T level
+      DO jk = 1, ikmax
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zc = fse3t(ji,jj,jk) * REAL( MIN( MAX( 0, ilevel(ji,jj) - jk + 1 ) , 1  )  )    ! 0 below ilevel
+               zthick(ji,jj) = zthick(ji,jj) + zc
+               htc_mld(ji,jj) = htc_mld(ji,jj) + zc * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+
+      ! Subsequent partial T level
+      zthick(:,:) = hmld_zint(:,:) - zthick(:,:)   !   remaining thickness to reach MLD
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            htc_mld(ji,jj) = htc_mld(ji,jj) + tsn(ji,jj,ilevel(ji,jj)+1,jp_tem)  & 
+      &                      * MIN( fse3t(ji,jj,ilevel(ji,jj)+1), zthick(ji,jj) ) * tmask(ji,jj,ilevel(ji,jj)+1)
+         END DO
+      END DO
+
+      WRITE(numout,*) 'htc_mld(after) =',htc_mld(2,2)
+
+      ! Convert to heat content
+      zcoef = rau0 * rcp
+      htc_mld(:,:) = zcoef * htc_mld(:,:)
+
+   END SUBROUTINE zdf_mxl_zint_htc
+
+   SUBROUTINE zdf_mxl_zint( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_mxl_zint  ***
+      !! 
+      !! ** Purpose :   
+      !!
+      !! ** Method  :   
+      !!----------------------------------------------------------------------
+
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+
+      INTEGER :: ios
+      INTEGER :: jn
+
+      INTEGER :: nn_mld_diag = 0    ! number of diagnostics
+
+      INTEGER :: i_steps          ! no of timesteps per hour
+      INTEGER :: ierror             ! logical error message   
+
+      REAL(wp) :: zdt             ! timestep variable  
+
+      CHARACTER(len=1) :: cmld
+
+      TYPE(MXL_ZINT) :: sn_mld1, sn_mld2, sn_mld3, sn_mld4, sn_mld5
+      TYPE(MXL_ZINT), SAVE, DIMENSION(5) ::   mld_diags
+
+      NAMELIST/namzdf_mldzint/ nn_mld_diag, sn_mld1, sn_mld2, sn_mld3, sn_mld4, sn_mld5
+
+      !!----------------------------------------------------------------------
+      
+      IF( kt == nit000 ) THEN
+         REWIND( numnam_ref )              ! Namelist namzdf_mldzint in reference namelist 
+         READ  ( numnam_ref, namzdf_mldzint, IOSTAT = ios, ERR = 901)
+901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_mldzint in reference namelist', lwp )
+
+         REWIND( numnam_cfg )              ! Namelist namzdf_mldzint in configuration namelist 
+         READ  ( numnam_cfg, namzdf_mldzint, IOSTAT = ios, ERR = 902 )
+902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_mldzint in configuration namelist', lwp )
+         IF(lwm) WRITE ( numond, namzdf_mldzint )
+
+         IF( nn_mld_diag > 5 )   CALL ctl_stop( 'STOP', 'zdf_mxl_ini: Specify no more than 5 MLD definitions' )
+
+         mld_diags(1) = sn_mld1
+         mld_diags(2) = sn_mld2
+         mld_diags(3) = sn_mld3
+         mld_diags(4) = sn_mld4
+         mld_diags(5) = sn_mld5
+
+         IF( nn_mld_diag > 0 ) THEN
+            WRITE(numout,*) '=============== Vertically-interpolated mixed layer ================'
+            WRITE(numout,*) '(Diagnostic number, nn_mld_type, rn_zref, rn_dT_crit, rn_iso_frac)'
+            DO jn = 1, nn_mld_diag
+               WRITE(numout,*) 'MLD criterion',jn,':'
+               WRITE(numout,*) '    nn_mld_type =', mld_diags(jn)%mld_type
+               WRITE(numout,*) '    rn_zref ='    , mld_diags(jn)%zref
+               WRITE(numout,*) '    rn_dT_crit =' , mld_diags(jn)%dT_crit
+               WRITE(numout,*) '    rn_iso_frac =', mld_diags(jn)%iso_frac
+            END DO
+            WRITE(numout,*) '===================================================================='
+         ENDIF
+      ENDIF
+
+      IF( nn_mld_diag > 0 ) THEN
+         DO jn = 1, nn_mld_diag
+            WRITE(cmld,'(I1)') jn
+            IF( iom_use( "mldzint_"//cmld ) .OR. iom_use( "mldhtc_"//cmld ) ) THEN
+               CALL zdf_mxl_zint_mld( mld_diags(jn) )
+
+               IF( iom_use( "mldzint_"//cmld ) ) THEN
+                  CALL iom_put( "mldzint_"//cmld, hmld_zint(:,:) )
+               ENDIF
+
+               IF( iom_use( "mldhtc_"//cmld ) )  THEN
+                  CALL zdf_mxl_zint_htc( kt )
+                  CALL iom_put( "mldhtc_"//cmld , htc_mld(:,:)   )
+               ENDIF
+
+               IF( iom_use( "mldzint25h_"//cmld ) ) THEN
+                  IF( .NOT. mld_25h_write ) mld_25h_write = .TRUE.
+                  zdt = rdt
+                  IF( nacc == 1 ) zdt = rdtmin
+                  IF( MOD( 3600,INT(zdt) ) == 0 ) THEN
+                     i_steps = 3600/INT(zdt)
+                  ELSE
+                     CALL ctl_stop('STOP', 'zdf_mxl_zint 25h: timestep must give MOD(3600,rdt) = 0 otherwise no hourly values are possible')
+                  ENDIF
+                  IF( ( mld_25h_init ) .OR. ( kt == nit000 ) ) THEN
+                     i_cnt_25h = 1
+                     IF( .NOT. ALLOCATED(hmld_zint_25h) ) THEN
+                        ALLOCATE( hmld_zint_25h(jpi,jpj,nn_mld_diag), STAT=ierror )
+                        IF( ierror > 0 )  CALL ctl_stop( 'zdf_mxl_zint 25h: unable to allocate hmld_zint_25h' )   
+                     ENDIF
+                     hmld_zint_25h(:,:,jn) = hmld_zint(:,:)
+                  ENDIF
+                  IF( MOD( kt, i_steps ) == 0 .AND.  kt .NE. nn_it000 ) THEN
+                     hmld_zint_25h(:,:,jn) = hmld_zint_25h(:,:,jn) + hmld_zint(:,:)
+                  ENDIF
+                  IF( i_cnt_25h .EQ. 25 .AND.  MOD( kt, i_steps*24) == 0 .AND. kt .NE. nn_it000 ) THEN
+                     CALL iom_put( "mldzint25h_"//cmld , hmld_zint_25h(:,:,jn) / 25._wp   )
+                  ENDIF
+               ENDIF
+
+            ENDIF
+         END DO
+                  
+         IF(  mld_25h_write  ) THEN
+            IF( ( MOD( kt, i_steps ) == 0 ) .OR.  mld_25h_init ) THEN
+               IF (lwp) THEN
+                  WRITE(numout,*) 'zdf_mxl_zint (25h) : Summed the following number of hourly values so far',i_cnt_25h
+	       ENDIF
+               i_cnt_25h = i_cnt_25h + 1
+               IF( mld_25h_init ) mld_25h_init = .FALSE.
+            ENDIF
+            IF( i_cnt_25h .EQ. 25 .AND.  MOD( kt, i_steps*24) == 0 .AND. kt .NE. nn_it000 ) THEN
+               i_cnt_25h = 1 
+               DO jn = 1, nn_mld_diag 
+                     hmld_zint_25h(:,:,jn) = hmld_zint(:,:) 
+               ENDDO 
+            ENDIF
+         ENDIF
+                  
+      ENDIF
+
+   END SUBROUTINE zdf_mxl_zint
 
    !!======================================================================
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 10249)
@@ -85,4 +85,8 @@
    USE stopar
    USE stopts
+   USE diatmb          ! Top,middle,bottom output
+   USE dia25h          ! 25h mean output
+   USE diaopfoam       ! FOAM operational output
+   USE diurnal_bulk    ! diurnal bulk SST 
 
    IMPLICIT NONE
@@ -403,4 +407,7 @@
                             CALL  istate_init   ! ocean initial state (Dynamics and tracers)
 
+      CALL diurnal_sst_bulk_init                ! diurnal sst
+      IF ( ln_diurnal ) CALL diurnal_sst_coolskin_init   ! cool skin  
+
       IF( lk_tide       )   CALL    tide_init( nit000 )    ! Initialisation of the tidal harmonics
 
@@ -473,6 +480,15 @@
 
       !                                     ! Assimilation increments
-      IF( lk_asminc     )   CALL asm_inc_init   ! Initialize assimilation increments
+      IF( lk_asminc ) THEN 
+#if defined key_shelf 
+         CALL  zdf_mxl_tref()     ! Initialization of hmld_tref
+#endif 
+         CALL asm_inc_init     ! Initialize assimilation increments 
+      ENDIF
+
       IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler
+                            CALL dia_tmb_init  ! TMB outputs
+                            CALL dia_25h_init  ! 25h mean  outputs
+                            CALL dia_diaopfoam_init  ! FOAM operational output
       !
    END SUBROUTINE nemo_init
@@ -630,4 +646,5 @@
       USE ldftra_oce, ONLY: ldftra_oce_alloc
       USE trc_oce   , ONLY: trc_oce_alloc
+      USE diainsitutem, ONLY: insitu_tem_alloc
 #if defined key_diadct 
       USE diadct    , ONLY: diadct_alloc 
@@ -646,4 +663,5 @@
       ierr = ierr + ldftra_oce_alloc()          ! ocean lateral  physics : tracers
       ierr = ierr + zdf_oce_alloc   ()          ! ocean vertical physics
+      ierr = ierr + insitu_tem_alloc()
       !
       ierr = ierr + trc_oce_alloc   ()          ! shared TRC / TRA arrays
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/step.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/step.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/step.F90	(revision 10249)
@@ -225,4 +225,15 @@
       ENDIF
 
+      ! Cool skin
+      IF ( ln_diurnal ) THEN  
+         IF ( ln_blk_core ) THEN
+            CALL diurnal_sst_coolskin_step( &  
+                    qns(:,:)+(rn_abs*qsr(:,:)), taum, rhop(:,:,1), rdt) 
+         ELSE
+            CALL diurnal_sst_coolskin_step( &  
+                    qns, taum, rhop(:,:,1), rdt) 
+         ENDIF
+      ENDIF
+
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
       ! diagnostics and outputs             (ua, va, tsa used as workspace)
@@ -238,4 +249,29 @@
       IF( ln_crs     )      CALL crs_fld( kstp )         ! ocean model: online field coarsening & output
 
+      !Diurnal warm layer model        
+      IF ( ln_diurnal ) THEN
+         IF ( ln_blk_core ) THEN
+            IF( kstp == nit000 )THEN  
+               CALL diurnal_sst_takaya_step( &  
+               &    qsr(:,:)-(rn_abs*qsr(:,:)), qns(:,:)+(rn_abs*qsr(:,:)), &
+               &    taum, rhop(:,:,1), &
+               &    rdt, ld_calcfrac = .TRUE.)  
+            ELSE  
+               CALL diurnal_sst_takaya_step( &  
+               &    qsr(:,:)-(rn_abs*qsr(:,:)), qns(:,:)+(rn_abs*qsr(:,:)), &
+               &    taum, rhop(:,:,1), rdt )  
+            ENDIF 
+         ELSE
+            IF( kstp == nit000 )THEN  
+               CALL diurnal_sst_takaya_step( &  
+               &    qsr, qns, taum, rhop(:,:,1), &
+               &    rdt, ld_calcfrac = .TRUE.)  
+            ELSE  
+               CALL diurnal_sst_takaya_step( &  
+               &    qsr, qns, taum, rhop(:,:,1), rdt )  
+            ENDIF 
+         ENDIF
+      ENDIF
+
 #if defined key_top
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -255,4 +291,5 @@
                              CALL tra_sbc    ( kstp )       ! surface boundary condition
       IF( ln_traqsr      )   CALL tra_qsr    ( kstp )       ! penetrative solar radiation qsr
+      IF( ln_tradwl      )   CALL tra_dwl    ( kstp )       ! Polcoms Style Short Wave Radiation 
       IF( ln_trabbc      )   CALL tra_bbc    ( kstp )       ! bottom heat flux
       IF( lk_trabbl      )   CALL tra_bbl    ( kstp )       ! advective (and/or diffusive) bottom boundary layer scheme
@@ -299,4 +336,7 @@
       ! Dynamics                                    (tsa used as workspace)
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+      IF( ln_bkgwri )        CALL asm_bkg_wri( kstp )     ! output background fields
+
       IF( lk_dynspg_ts   )  THEN
                                                              ! revert to previously computed momentum tendencies
@@ -317,5 +357,4 @@
         IF(  lk_asminc .AND. ln_asmiau .AND. &
            & ln_dyninc      )  CALL dyn_asm_inc( kstp )     ! apply dynamics assimilation increment
-        IF( ln_bkgwri )        CALL asm_bkg_wri( kstp )     ! output background fields
         IF( ln_neptsimp )      CALL dyn_nept_cor( kstp )    ! subtract Neptune velocities (simplified)
         IF( lk_bdy          )  CALL bdy_dyn3d_dmp(kstp )    ! bdy damping trends
@@ -336,6 +375,4 @@
                                CALL ssh_swp( kstp )         ! swap of sea surface height
       IF( lk_vvl           )   CALL dom_vvl_sf_swp( kstp )  ! swap of vertical scale factors
-      !
-      IF( lrst_oce         )   CALL rst_write( kstp )       ! write output ocean restart file
 
 #if defined key_agrif
@@ -361,4 +398,5 @@
                                CALL dia_wri_state( 'output.abort', kstp )
       ENDIF
+      IF( ln_harm_ana_store   )   CALL harm_ana( kstp )        ! Harmonic analysis of tides 
       IF( kstp == nit000   )   THEN
                  CALL iom_close( numror )     ! close input  ocean restart file
@@ -366,4 +404,5 @@
          IF( lwm.AND.numoni /= -1 ) CALL FLUSH    ( numoni )     ! flush output namelist ice
       ENDIF
+      IF( lrst_oce         )   CALL rst_write    ( kstp )   ! write output ocean restart file
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/step_oce.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/step_oce.F90	(revision 10249)
@@ -25,4 +25,5 @@
    USE sbcrnf           ! surface boundary condition: runoff variables
    USE sbccpl           ! surface boundary condition: coupled formulation (call send at end of step)
+   USE sbcflx           ! surface boundary condition: Fluxes
    USE sbc_oce          ! surface boundary condition: ocean
    USE sbctide          ! Tide initialisation
@@ -30,4 +31,5 @@
 
    USE traqsr           ! solar radiation penetration      (tra_qsr routine)
+   USE tradwl           ! POLCOMS style solar radiation    (tra_dwl routine) 
    USE trasbc           ! surface boundary condition       (tra_sbc routine)
    USE trabbc           ! bottom boundary condition        (tra_bbc routine)
@@ -106,5 +108,10 @@
    USE prtctl           ! Print control                    (prt_ctl routine)
 
+   USE harmonic_analysis ! harmonic analysis of tides (harm_ana routine) 
+   USE bdytides          ! harmonic analysis of tides (harm_ana routine) 
    USE diaobs           ! Observation operator
+
+   USE diurnal_bulk    ! diurnal SST bulk routines  (diurnal_sst_takaya routine)  
+   USE cool_skin       ! diurnal cool skin correction (diurnal_sst_coolskin routine)
 
    USE timing           ! Timing
Index: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90
===================================================================
--- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90	(revision 10248)
+++ branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90	(revision 10249)
@@ -27,4 +27,6 @@
    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   etot3         !: light absortion coefficient
    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   facvol        !: volume for degraded regions
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   rlambda2      !: Lambda2 for downwell version of Short wave Radiation
+   REAL(wp), PUBLIC                                      ::   rlambda       !: Lambda  for downwell version of Short wave Radiation
 
 #if defined key_top 
@@ -78,12 +80,14 @@
       !!                  ***  trc_oce_alloc  ***
       !!----------------------------------------------------------------------
-      INTEGER ::   ierr(2)        ! Local variables
+      INTEGER ::   ierr(3)        ! Local variables
       !!----------------------------------------------------------------------
       ierr(:) = 0
                      ALLOCATE( etot3 (jpi,jpj,jpk), STAT=ierr(1) )
       IF( lk_degrad) ALLOCATE( facvol(jpi,jpj,jpk), STAT=ierr(2) )
+                    ALLOCATE( rlambda2(jpi,jpj),   STAT=ierr(3) )
       trc_oce_alloc  = MAXVAL( ierr )
       !
       IF( trc_oce_alloc /= 0 )   CALL ctl_warn('trc_oce_alloc: failed to allocate etot3 array')
+      IF( trc_oce_alloc /= 0 )   CALL ctl_warn('trc_oce_alloc: failed to allocate etot3, facvol or rlambda2 array')
    END FUNCTION trc_oce_alloc
 
