Changeset 6736

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/CONFIG/cfg.txt

r3769	r6736
9	9	ORCA2_LIM_CFC_C14b OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC
10	10	ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC
	11	NNA_R12 OPA_SRC LIM_SRC_2

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90

-                      r3625
+                      r6736
    PUBLIC    ice_alloc_2  !  Called in iceini_2.F90
    INTEGER , PUBLIC ::   numit        !: ice iteration index
    REAL(wp), PUBLIC ::   rdt_ice      !: ice time step
+   INTEGER , PUBLIC ::   numit     !: ice iteration index
+   REAL(wp), PUBLIC ::   rdt_ice   !: ice time step
    !                                                                     !!* namicerun read in iceini  *
 …
    LOGICAL               , PUBLIC ::   ln_limdyn     = .TRUE.             !: flag for ice dynamics (T) or not (F)
    LOGICAL               , PUBLIC ::   ln_limdmp     = .FALSE.            !: Ice damping
+   LOGICAL               , PUBLIC ::   ln_vp2evp     = .FALSE.            !: restart from a vp file in an evp run
    LOGICAL               , PUBLIC ::   ln_nicep      = .TRUE.             !: flag grid points output (T) or not (F)
    REAL(wp)              , PUBLIC ::   hsndif        = 0._wp              !: snow temp. computation (0) or not (9999)
 …
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qstoif        !: Energy stored in the brine pockets
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fbif          !: Heat flux at the ice base
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdm_snw       !: Variation of snow mass over 1 time step           [Kg/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdq_snw       !: Heat content associated with rdm_snw              [J/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdm_ice       !: Variation of ice  mass over 1 time step           [Kg/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdq_ice       !: Heat content associated with rdm_ice              [J/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdmsnif       !: Variation of snow mass
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdmicif       !: Variation of ice mass
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qldif         !: heat balance of the lead (or of the open ocean)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qcmif         !: Energy needed to freeze the ocean surface layer
 …
       ALLOCATE(phicif(jpi,jpj) , pfrld  (jpi,jpj) , qstoif (jpi,jpj) ,     &
+         &     fbif  (jpi,jpj) , rdm_snw(jpi,jpj) , rdq_snw(jpi,jpj) ,     &
+         &                       rdm_ice(jpi,jpj) , rdq_ice(jpi,jpj) ,     &
+         &     fbif  (jpi,jpj) , rdmsnif(jpi,jpj) , rdmicif(jpi,jpj) ,     &
          &     qldif (jpi,jpj) , qcmif  (jpi,jpj) , fdtcn  (jpi,jpj) ,     &
          &     qdtcn (jpi,jpj) , thcm   (jpi,jpj)                    , STAT=ierr(4) )

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90

-                      r3625
+                      r6736
    !!   'key_lim2' :                                  LIM 2.0 sea-ice model
    !!----------------------------------------------------------------------
    !!   ice_init_2    : sea-ice model initialization
    !!   ice_run_2     : Definition some run parameter for ice model
+   !!   ice_init_2       : sea-ice model initialization
+   !!   ice_run_2        : Definition some run parameter for ice model
    !!----------------------------------------------------------------------
+   USE phycst         ! physical constants
+   USE dom_oce        ! ocean domain
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE sbc_ice        ! LIM2 surface boundary condition
+   USE dom_ice_2      ! LIM2 ice domain
+   USE par_ice_2      ! LIM2 parameters
+   USE thd_ice_2      ! LIM2 thermodynamical variables
+   USE ice_2          ! LIM2 ice variable
+   USE limmsh_2       ! LIM2 mesh
+   USE limistate_2    ! LIM2 initial state
+   USE limrst_2       ! LIM2 restart
+   USE limsbc_2       ! LIM2 surface boundary condition
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE phycst           ! physical constants
+   USE dom_oce          ! ocean domain
+   USE sbc_oce          ! surface boundary condition: ocean
+   USE sbc_ice          ! LIM2 surface boundary condition
+   USE dom_ice_2        ! LIM2 ice domain
+   USE par_ice_2        ! LIM2 parameters
+   USE thd_ice_2        ! LIM2 thermodynamical variables
+   USE ice_2            ! LIM2 ice variable
+   USE limmsh_2         ! LIM2 mesh
+   USE limistate_2      ! LIM2 initial state
+   USE limrst_2         ! LIM2 restart
+   USE limsbc_2         ! LIM2 surface boundary condition
+   USE in_out_manager   ! I/O manager
+   USE lib_mpp          ! MPP library
    IMPLICIT NONE
 …
       !! ** input   :   Namelist namicerun
       !!-------------------------------------------------------------------
       NAMELIST/namicerun/ cn_icerst_in, cn_icerst_out, ln_limdyn, ln_limdmp, acrit, hsndif, hicdif
+      NAMELIST/namicerun/ cn_icerst_in, cn_icerst_out, ln_limdyn, ln_limdmp, acrit, hsndif, hicdif, ln_vp2evp
       !!-------------------------------------------------------------------
+      !
 …
          WRITE(numout,*) '   computation of temp. in snow (=0) or not (=9999) hsndif = ', hsndif
          WRITE(numout,*) '   computation of temp. in ice  (=0) or not (=9999) hicdif = ', hicdif
+         WRITE(numout,*) '   Restart EVP run from VP restart file (set stresses to 0)= ', ln_vp2evp
       ENDIF
+      !

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/LIM_SRC_2/limadv_2.F90

-                      r3625
+                      r6736
    !!   'key_lim2'                                    LIM 2.0 sea-ice model
    !!----------------------------------------------------------------------
    !!   lim_adv_x_2   : advection of sea ice on x axis
    !!   lim_adv_y_2   : advection of sea ice on y axis
+   !!   lim_adv_x_2  : advection of sea ice on x axis
+   !!   lim_adv_y_2  : advection of sea ice on y axis
    !!----------------------------------------------------------------------
    USE dom_oce
 …
    USE ice_2
    USE lbclnk
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! work arrays
+   USE prtctl         ! Print control
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE in_out_manager     ! I/O manager
+   USE lib_mpp            ! MPP library
+   USE wrk_nemo           ! work arrays
+   USE prtctl             ! Print control
+   USE lib_fortran        ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
    IMPLICIT NONE

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/LIM_SRC_2/limdia_2.F90

r3625	r6736
24	24	USE in_out_manager ! I/O manager
25	25	USE lib_mpp ! MPP library
26		~~USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)~~
27	26
28	27	IMPLICIT NONE

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/LIM_SRC_2/limdmp_2.F90

r3635	r6736
19	19	USE in_out_manager ! I/O manager
20	20	USE lib_mpp ! MPP library
21		~~USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)~~
22	21
23	22	IMPLICIT NONE

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90

r3625	r6736
31	31	USE in_out_manager ! I/O manager
32	32	USE prtctl ! Print control
33		~~USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)~~
34	33
35	34	IMPLICIT NONE

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/LIM_SRC_2/limhdf_2.F90

r3625	r6736
21	21	USE prtctl ! Print control
22	22	USE in_out_manager ! I/O manager
23		~~USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)~~
24	23
25	24	IMPLICIT NONE

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90

-                      r3625
+                      r6736
    USE iom
    USE in_out_manager
-   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
    IMPLICIT NONE
 …
             IF(lwp) WRITE(numout,*) '                  ice state initialization with : Ice_initialization.nc'
+#if defined key_lim2_initcd_alt1
+            CALL iom_get( inum_ice, jpdom_data, 'hicif', hicif )
+            CALL iom_get( inum_ice, jpdom_data, 'hsnif', hsnif )
+            CALL iom_get( inum_ice, jpdom_data, 'frld' , frld  )
+            CALL iom_get( inum_ice, jpdom_data, 'tbif1'   , tbif(:,:,1)  )
+            CALL iom_get( inum_ice, jpdom_data, 'tbif2'   , tbif(:,:,2)  )
+            CALL iom_get( inum_ice, jpdom_data, 'tbif3'   , tbif(:,:,3)  )
+            CALL iom_get( inum_ice, jpdom_data, 'sist'   , sist  )
+#elif defined key_lim2_initcd_alt2
+            CALL iom_get( inum_ice, jpdom_data, 'iicethic', hicif )
+            CALL iom_get( inum_ice, jpdom_data, 'isnowthi', hsnif )
+            CALL iom_get( inum_ice, jpdom_data, 'ileadfra' , frld  )
+            CALL iom_get( inum_ice, jpdom_data, 'isstempe'   , sist  )
+            CALL iom_get( inum_ice, jpdom_unknown, 'iicetemp', tbif(1:nlci,1:nlcj,:),   &
+                 &        kstart = (/ mig(1),mjg(1),1 /), kcount = (/ nlci,nlcj,jplayersp1 /) )
+#else
             CALL iom_get( inum_ice, jpdom_data, 'hicif', hicif )
             CALL iom_get( inum_ice, jpdom_data, 'hsnif', hsnif )
 …
             CALL iom_get( inum_ice, jpdom_unknown, 'tbif', tbif(1:nlci,1:nlcj,:),   &
                  &        kstart = (/ mig(1),mjg(1),1 /), kcount = (/ nlci,nlcj,jplayersp1 /) )
+#endif
             ! put some values in the extra-halo...
             DO jj = nlcj+1, jpj   ;   tbif(1:nlci,jj,:) = tbif(1:nlci,nlej,:)   ;   END DO

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/LIM_SRC_2/limmsh_2.F90

r3625	r6736
23	23	USE wrk_nemo ! work arrays
24	24	#endif
25		~~USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)~~
26	25
27	26	IMPLICIT NONE

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90

-                      r3680
+                      r6736
    USE in_out_manager ! I/O manager
    USE prtctl         ! Print control
+   USE oce     , ONLY : snwice_mass, snwice_mass_b
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+#if defined key_agrif
+   USE agrif_lim2_interp ! nesting
+#endif
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
    IMPLICIT NONE
 …
       REAL(wp) ::   zs21_11, zs21_12, zs21_21, zs21_22
       REAL(wp) ::   zs22_11, zs22_12, zs22_21, zs22_22
-      REAL(wp) ::   zintb, zintn
       REAL(wp), POINTER, DIMENSION(:,:) ::   zfrld, zmass, zcorl
       REAL(wp), POINTER, DIMENSION(:,:) ::   za1ct, za2ct, zresr
       REAL(wp), POINTER, DIMENSION(:,:) ::   zc1u, zc1v, zc2u, zc2v
       REAL(wp), POINTER, DIMENSION(:,:) ::   zsang, zpice
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zsang
       REAL(wp), POINTER, DIMENSION(:,:) ::   zu0, zv0
       REAL(wp), POINTER, DIMENSION(:,:) ::   zu_n, zv_n
 …
       CALL wrk_alloc( jpi,jpj, zfrld, zmass, zcorl, za1ct, za2ct, zresr )
       CALL wrk_alloc( jpi,jpj, zc1u , zc1v , zc2u , zc2v , zsang, zpice )
+      CALL wrk_alloc( jpi,jpj, zc1u , zc1v , zc2u , zc2v , zsang )
       CALL wrk_alloc( jpi,jpj+2, zu0, zv0, zu_n, zv_n, zu_a, zv_a, zviszeta, zviseta, kjstart = 0 )
       CALL wrk_alloc( jpi,jpj+2, zzfrld, zztms, zi1, zi2, zmasst, zpresh, kjstart = 0 )
 …
 !i    zviszeta(:,jpj+1) = 0._wp    ;    zviseta(:,jpj+1) = 0._wp
-      IF( nn_ice_embd == 2 ) THEN             !== embedded sea ice: compute representative ice top surface ==!
+          !
-          ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1}
-          !                                               = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1}
-         zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp
+          !
-          ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1}
-          !                                               = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1})
-         zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp
+          !
-         zpice(:,:) = ssh_m(:,:) + (  zintn * snwice_mass(:,:) +  zintb * snwice_mass_b(:,:)  ) * r1_rau0
+          !
+         !
-      ELSE                                    !== non-embedded sea ice: use ocean surface for slope calculation ==!
-         zpice(:,:) = ssh_m(:,:)
-      ENDIF
-#if defined key_agrif
-      ! load the boundary value of velocity in special array zuive and zvice
-      CALL agrif_rhg_lim2_load
-#endif
       ! Ice mass, ice strength, and wind stress at the center            |
 …
             ! Gradient of the sea surface height
             zgsshx =  (   (zpice(ji  ,jj  ) - zpice(ji-1,jj  ))/e1u(ji-1,jj  )   &
                &       +  (zpice(ji  ,jj-1) - zpice(ji-1,jj-1))/e1u(ji-1,jj-1)   ) * 0.5_wp
             zgsshy =  (   (zpice(ji  ,jj  ) - zpice(ji  ,jj-1))/e2v(ji  ,jj-1)   &
                &       +  (zpice(ji-1,jj  ) - zpice(ji-1,jj-1))/e2v(ji-1,jj-1)   ) * 0.5_wp
+            zgsshx =  (   (ssh_m(ji  ,jj  ) - ssh_m(ji-1,jj  ))/e1u(ji-1,jj  )   &
+               &       +  (ssh_m(ji  ,jj-1) - ssh_m(ji-1,jj-1))/e1u(ji-1,jj-1)   ) * 0.5_wp
+            zgsshy =  (   (ssh_m(ji  ,jj  ) - ssh_m(ji  ,jj-1))/e2v(ji  ,jj-1)   &
+               &       +  (ssh_m(ji-1,jj  ) - ssh_m(ji-1,jj-1))/e2v(ji-1,jj-1)   ) * 0.5_wp
             ! Computation of the velocity field taking into account the ice-ice interaction.
 …
             CALL lbc_lnk( zv_n(:,1:jpj), 'I', -1. )
-#if defined key_agrif
-            ! copy the boundary value from u_ice_nst and v_ice_nst to u_ice and v_ice
-            ! before next interations
-            CALL agrif_rhg_lim2(zu_n,zv_n)
-#endif
             ! Test of Convergence
             DO jj = k_j1+1 , k_jpj-1
 …
       CALL wrk_dealloc( jpi,jpj, zfrld, zmass, zcorl, za1ct, za2ct, zresr )
       CALL wrk_dealloc( jpi,jpj, zc1u , zc1v , zc2u , zc2v , zsang, zpice )
+      CALL wrk_dealloc( jpi,jpj, zc1u , zc1v , zc2u , zc2v , zsang )
       CALL wrk_dealloc( jpi,jpj+2, zu0, zv0, zu_n, zv_n, zu_a, zv_a, zviszeta, zviseta, kjstart = 0 )
       CALL wrk_dealloc( jpi,jpj+2, zzfrld, zztms, zi1, zi2, zmasst, zpresh, kjstart = 0 )

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/LIM_SRC_2/limrst_2.F90

-                      r2528
+                      r6736
       CALL iom_get( numrir, jpdom_autoglo, 'fsbbq'      , fsbbq  )
 #if ! defined key_lim2_vp
+      IF ( ln_vp2evp ) THEN
+      stress1_i (:,:) = 0._wp                          ! EVP rheology
+      stress2_i (:,:) = 0._wp
+      stress12_i(:,:) = 0._wp
+      ELSE
       CALL iom_get( numrir, jpdom_autoglo, 'stress1_i'  , stress1_i  )
       CALL iom_get( numrir, jpdom_autoglo, 'stress2_i'  , stress2_i  )
       CALL iom_get( numrir, jpdom_autoglo, 'stress12_i' , stress12_i )
+      ENDIF
 #endif
       CALL iom_get( numrir, jpdom_autoglo, 'sxice'      , sxice  )

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90

-                      r3625
+                      r6736
    !!            3.3  ! 2009-05 (G. Garric, C. Bricaud) addition of the lim2_evp case
    !!             -   ! 2010-11 (G. Madec) ice-ocean stress computed at each ocean time-step
+   !!           3.3.1 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation
+   !!            3.5  ! 2012-11 ((G. Madec, Y. Aksenov, A. Coward) salt and heat fluxes associated with e-p
+   !!            4.0  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
    !!----------------------------------------------------------------------
 #if defined key_lim2
 …
    USE sbc_oce          ! surface boundary condition: ocean
    USE sbccpl
+   USE cpl_oasis3, ONLY : lk_cpl
+   USE oce       , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass
    USE albedo           ! albedo parameters
    USE lbclnk           ! ocean lateral boundary condition - MPP exchanges
 …
    USE iom              ! I/O library
    USE prtctl           ! Print control
+   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE cpl_oasis3, ONLY : lk_cpl
    IMPLICIT NONE
 …
       !!              - Update the fluxes provided to the ocean
       !!
       !! ** Outputs : - qsr     : sea heat flux    : solar
       !!              - qns     : sea heat flux    : non solar (including heat content of the mass flux)
       !!              - emp     : freshwater budget: mass flux
       !!              - sfx     : freshwater budget: salt flux due to Freezing/Melting
+      !! ** Outputs : - qsr     : sea heat flux:     solar
+      !!              - qns     : sea heat flux: non solar
+      !!              - emp     : freshwater budget: volume flux
+      !!              - emps    : freshwater budget: concentration/dillution
       !!              - utau    : sea surface i-stress (ocean referential)
       !!              - vtau    : sea surface j-stress (ocean referential)
 …
       INTEGER  ::   ifvt, i1mfr, idfr, iflt    !   -       -
       INTEGER  ::   ial, iadv, ifral, ifrdv    !   -       -
+      REAL(wp) ::   zqsr,     zqns,   zfmm     ! local scalars
+      REAL(wp) ::   zinda,    zfsalt, zemp     !   -      -
+      REAL(wp) ::   zemp_snw, zqhc,   zcd      !   -      -
+      REAL(wp) ::   zswitch                    !   -      -
+      REAL(wp) ::   zqsr, zqns, zfm            ! local scalars
+      REAL(wp) ::   zinda, zfons, zemp         !   -      -
       REAL(wp), POINTER, DIMENSION(:,:)   ::   zqnsoce       ! 2D workspace
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb, zalbp   ! 2D/3D workspace
 …
       CALL wrk_alloc( jpi, jpj, zqnsoce )
       CALL wrk_alloc( jpi, jpj, 1, zalb, zalbp )
-      SELECT CASE( nn_ice_embd )                 ! levitating or embedded sea-ice option
-        CASE( 0    )   ;   zswitch = 1           ! (0) standard levitating sea-ice : salt exchange only
-        CASE( 1, 2 )   ;   zswitch = 0           ! (1) levitating sea-ice: salt and volume exchange but no pressure effect
-                                                 ! (2) embedded sea-ice : salt and volume fluxes and pressure
-      END SELECT                                 !
       !------------------------------------------!
 …
             ifrdv   = ( 1  - ifral * ( 1 - ial ) ) * iadv
 !!$            attempt to explain the tricky flags set above....
 !!$            zinda   = 1.0 - AINT( pfrld(ji,jj) )                   ! = 0. if ice-free ocean else 1. (after ice adv, but before ice thermo)
 !!$            i1mfr   = 1.0 - AINT(  frld(ji,jj) )                   ! = 0. if ice-free ocean else 1. (after ice thermo)
 !!$
 !!$            IF( phicif(ji,jj) <= 0. ) THEN   ;   ifvt = zinda      ! = zinda if previous thermodynamic step overmelted the ice???
 !!$            ELSE                             ;   ifvt = 0.         !
+!!$            zinda   = 1.0 - AINT( pfrld(ji,jj) )                   !   = 0. if pure ocean else 1. (at previous time)
+!!$
+!!$            i1mfr   = 1.0 - AINT(  frld(ji,jj) )                   !   = 0. if pure ocean else 1. (at current  time)
+!!$
+!!$            IF( phicif(ji,jj) <= 0. ) THEN   ;   ifvt = zinda      !   = 1. if (snow and no ice at previous time) else 0. ???
+!!$            ELSE                             ;   ifvt = 0.
 !!$            ENDIF
 !!$
 !!$            IF( frld(ji,jj) >= pfrld(ji,jj) ) THEN   ;   idfr = 0.  !   = 0. if lead fraction increases due to ice thermodynamics
+!!$            IF( frld(ji,jj) >= pfrld(ji,jj) ) THEN   ;   idfr = 0.  !   = 0. if lead fraction increases from previous to current
 !!$            ELSE                                     ;   idfr = 1.
 !!$            ENDIF
 !!$
 !!$            iflt    = zinda  * (1 - i1mfr) * (1 - ifvt )    !   = 1. if ice (not only snow) at previous time and ice-free ocean currently
+!!$            iflt    = zinda  * (1 - i1mfr) * (1 - ifvt )    !   = 1. if ice (not only snow) at previous and pure ocean at current
 !!$
 !!$            ial     = ifvt   * i1mfr    +    ( 1 - ifvt ) * idfr
-!!$                    = i1mfr if ifvt = 1 i.e.
-!!$                    = idfr  if ifvt = 0
 !!$!                 snow no ice   ice         ice or nothing  lead fraction increases
 !!$!                 at previous   now           at previous
 !!$!                -> ice area increases  ???         -> ice area decreases ???
+!!$!                -> ice aera increases  ???         -> ice aera decreases ???
 !!$
 !!$            iadv    = ( 1  - i1mfr ) * zinda
 …
 #endif
             !  computation the non solar heat flux at ocean surface
+            zqns    =  - ( 1. - thcm(ji,jj) ) * zqsr                                              &   ! part of the solar energy used in leads
+               &       + iflt    * ( fscmbq(ji,jj) + ffltbif(ji,jj) )                             &
+               &       + ifral   * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice  &
+               &       + ifrdv   * (       qfvbq(ji,jj) +             qdtcn(ji,jj) ) * r1_rdtice
+            fsbbq(ji,jj) = ( 1.0 - ( ifvt + iflt ) ) * fscmbq(ji,jj)     ! store residual heat flux (to put into the ocean at the next time-step)
+            zqhc = ( rdq_snw(ji,jj)                                     &
+                 & + rdq_ice(ji,jj) * ( 1.- zswitch) ) * r1_rdtice       ! heat flux due to snow ( & ice heat content,
+            !                                                            !           if ice/ocean mass exchange active)
+            zqns    =  - ( 1. - thcm(ji,jj) ) * zqsr   &   ! part of the solar energy used in leads
+               &       + iflt    * ( fscmbq(ji,jj) + ffltbif(ji,jj) )                            &
+               &       + ifral   * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice    &
+               &       + ifrdv   * ( qfvbq(ji,jj) + qdtcn(ji,jj) )                   * r1_rdtice
+            fsbbq(ji,jj) = ( 1.0 - ( ifvt + iflt ) ) * fscmbq(ji,jj)     ! ???
+            !
             qsr  (ji,jj) = zqsr                                          ! solar heat flux
+            qns  (ji,jj) = zqns - fdtcn(ji,jj) + zqhc                    ! non solar heat flux
+            !
+            !                          !------------------------------------------!
+            !                          !  mass and salt flux at the ocean surface !
+            !                          !------------------------------------------!
+            !
+            ! mass flux at the ocean-atmosphere interface (open ocean fraction = leads area)
+#if defined key_coupled
+            !                                                  ! coupled mode:
+            zemp = + emp_tot(ji,jj)                            &     ! net mass flux over the grid cell (ice+ocean area)
+               &   - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )          ! minus the mass flux intercepted by sea-ice
+#else
+            !                                                  ! forced  mode:
+            zemp = + emp(ji,jj)     *         frld(ji,jj)      &     ! mass flux over open ocean fraction
+               &   - tprecip(ji,jj) * ( 1. -  frld(ji,jj) )    &     ! liquid precip. over ice reaches directly the ocean
+               &   + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) )          ! snow is intercepted by sea-ice (previous frld)
+#endif
+            !
+            ! mass flux at the ocean/ice interface (sea ice fraction)
+            zemp_snw = rdm_snw(ji,jj) * r1_rdtice                    ! snow melting = pure water that enters the ocean
+            zfmm     = rdm_ice(ji,jj) * r1_rdtice                    ! Freezing minus Melting (F-M)
+            ! salt flux at the ice/ocean interface (sea ice fraction) [PSU*kg/m2/s]
+            zfsalt = - sice_0(ji,jj) * zfmm                          ! F-M salt exchange
+            zcd    =   soce_0(ji,jj) * zfmm                          ! concentration/dilution term due to F-M
+            !
+            ! salt flux only       : add concentration dilution term in salt flux  and no  F-M term in volume flux
+            ! salt and mass fluxes : non concentration dilution term in salt flux  and add F-M term in volume flux
+            sfx (ji,jj) = zfsalt +                  zswitch  * zcd   ! salt flux (+ C/D if no ice/ocean mass exchange)
+            emp (ji,jj) = zemp   + zemp_snw + ( 1.- zswitch) * zfmm  ! mass flux (+ F/M mass flux if ice/ocean mass exchange)
+            !
+            qns  (ji,jj) = zqns - fdtcn(ji,jj)                           ! non solar heat flux
          END DO
       END DO
-      !                                !------------------------------------------!
-      !                                !    mass of snow and ice per unit area    !
-      !                                !------------------------------------------!
-      IF( nn_ice_embd /= 0 ) THEN      ! embedded sea-ice (mass required)
-         snwice_mass_b(:,:) = snwice_mass(:,:)                  ! save mass from the previous ice time step
-         !                                                      ! new mass per unit area
-         snwice_mass  (:,:) = tms(:,:) * ( rhosn * hsnif(:,:) + rhoic * hicif(:,:)  ) * ( 1.0 - frld(:,:) )
-         !                                                      ! time evolution of snow+ice mass
-         snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) / rdt_ice
-      ENDIF
       CALL iom_put( 'hflx_ice_cea', - fdtcn(:,:) )
 …
       CALL iom_put( 'qsr_io_cea', fstric(:,:) * (1.e0 - pfrld(:,:)) )
+      !------------------------------------------!
+      !      mass flux at the ocean surface      !
+      !------------------------------------------!
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            !
+#if defined key_coupled
+            ! freshwater exchanges at the ice-atmosphere / ocean interface (coupled mode)
+            zemp = emp_tot(ji,jj) - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )    &   !
+               &   + rdmsnif(ji,jj) * r1_rdtice                                   !  freshwaterflux due to snow melting
+#else
+            !  computing freshwater exchanges at the ice/ocean interface
+            zemp = + emp(ji,jj)     *         frld(ji,jj)      &   !  e-p budget over open ocean fraction
+               &   - tprecip(ji,jj) * ( 1. -  frld(ji,jj) )    &   !  liquid precipitation reaches directly the ocean
+               &   + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) )    &   !  change in ice cover within the time step
+               &   + rdmsnif(ji,jj) * r1_rdtice                    !  freshwater flux due to snow melting
+#endif
+            !
+            !  computing salt exchanges at the ice/ocean interface
+            zfons = ( soce_0(ji,jj) - sice_0(ji,jj) ) * ( rdmicif(ji,jj) * r1_rdtice )
+            !
+            !  converting the salt flux from ice to a freshwater flux from ocean
+            zfm  = zfons / ( sss_m(ji,jj) + epsi16 )
+            !
+            emps(ji,jj) = zemp + zfm      ! surface ocean concentration/dilution effect (use on SSS evolution)
+            emp (ji,jj) = zemp            ! surface ocean volume flux (use on sea-surface height evolution)
+            !
+         END DO
+      END DO
       IF( lk_diaar5 ) THEN       ! AR5 diagnostics
          CALL iom_put( 'isnwmlt_cea'  ,                 rdm_snw(:,:) * r1_rdtice )
          CALL iom_put( 'fsal_virt_cea',   soce_0(:,:) * rdm_ice(:,:) * r1_rdtice )
          CALL iom_put( 'fsal_real_cea', - sice_0(:,:) * rdm_ice(:,:) * r1_rdtice )
+         CALL iom_put( 'isnwmlt_cea'  ,                 rdmsnif(:,:) * r1_rdtice )
+         CALL iom_put( 'fsal_virt_cea',   soce_0(:,:) * rdmicif(:,:) * r1_rdtice )
+         CALL iom_put( 'fsal_real_cea', - sice_0(:,:) * rdmicif(:,:) * r1_rdtice )
       ENDIF
 …
       IF(ln_ctl) THEN            ! control print
          CALL prt_ctl(tab2d_1=qsr   , clinfo1=' lim_sbc: qsr    : ', tab2d_2=qns   , clinfo2=' qns     : ')
          CALL prt_ctl(tab2d_1=emp   , clinfo1=' lim_sbc: emp    : ', tab2d_2=sfx   , clinfo2=' sfx     : ')
+         CALL prt_ctl(tab2d_1=emp   , clinfo1=' lim_sbc: emp    : ', tab2d_2=emps  , clinfo2=' emps    : ')
          CALL prt_ctl(tab2d_1=utau  , clinfo1=' lim_sbc: utau   : ', mask1=umask,   &
             &         tab2d_2=vtau  , clinfo2=' vtau    : '        , mask2=vmask )
 …
          END WHERE
       ENDIF
-      !                                      ! embedded sea ice
-      IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass
-         snwice_mass  (:,:) = tms(:,:) * ( rhosn * hsnif(:,:) + rhoic * hicif(:,:)  ) * ( 1.0 - frld(:,:) )
-         snwice_mass_b(:,:) = snwice_mass(:,:)
-      ELSE
-         snwice_mass  (:,:) = 0.e0           ! no mass exchanges
-         snwice_mass_b(:,:) = 0.e0           ! no mass exchanges
-      ENDIF
-      IF( nn_ice_embd == 2 .AND.          &  ! full embedment (case 2) & no restart :
-         &   .NOT.ln_rstart ) THEN           ! deplete the initial ssh below sea-ice area
-         sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0
-         sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0
-      ENDIF
+      !
    END SUBROUTINE lim_sbc_init_2

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90

-                      r3625
+                      r6736
    !!   'key_lim2' :                                  LIM 2.0 sea-ice model
    !!----------------------------------------------------------------------
    !!   lim_thd_2       : thermodynamic of sea ice
    !!   lim_thd_init_2  : initialisation of sea-ice thermodynamic
+   !!   lim_thd_2      : thermodynamic of sea ice
+   !!   lim_thd_init_2 : initialisation of sea-ice thermodynamic
    !!----------------------------------------------------------------------
    USE phycst           ! physical constants
    USE dom_oce          ! ocean space and time domain variables
+   USE phycst          ! physical constants
+   USE dom_oce         ! ocean space and time domain variables
    USE domvvl
    USE lbclnk
    USE in_out_manager   ! I/O manager
+   USE in_out_manager  ! I/O manager
    USE lib_mpp
    USE wrk_nemo         ! work arrays
    USE iom              ! IOM library
    USE ice_2            ! LIM sea-ice variables
    USE sbc_oce          !
    USE sbc_ice          !
    USE thd_ice_2        ! LIM thermodynamic sea-ice variables
    USE dom_ice_2        ! LIM sea-ice domain
+   USE wrk_nemo        ! work arrays
+   USE iom             ! IOM library
+   USE ice_2           ! LIM sea-ice variables
+   USE sbc_oce         !
+   USE sbc_ice         !
+   USE thd_ice_2       ! LIM thermodynamic sea-ice variables
+   USE dom_ice_2       ! LIM sea-ice domain
    USE limthd_zdf_2
    USE limthd_lac_2
    USE limtab_2
    USE prtctl           ! Print control
    USE cpl_oasis3, ONLY :   lk_cpl
    USE diaar5    , ONLY :   lk_diaar5
    USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE prtctl          ! Print control
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE cpl_oasis3, ONLY : lk_cpl
+   USE diaar5, ONLY :   lk_diaar5
    IMPLICIT NONE
    PRIVATE
 …
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
 …
       REAL(wp) ::   za , zh, zthsnice    !
       REAL(wp) ::   zfric_u              ! friction velocity
+      REAL(wp) ::   zfnsol               ! total non solar heat
+      REAL(wp) ::   zfontn               ! heat flux from snow thickness
       REAL(wp) ::   zfntlat, zpareff     ! test. the val. of lead heat budget
 …
       zdvolif(:,:) = 0.e0   ! total variation of ice volume
       zdvonif(:,:) = 0.e0   ! transformation of snow to sea-ice volume
+!      zdvonif(:,:) = 0.e0   ! lateral variation of ice volume
       zlicegr(:,:) = 0.e0   ! lateral variation of ice volume
       zdvomif(:,:) = 0.e0   ! variation of ice volume at bottom due to melting only
 …
       ffltbif(:,:) = 0.e0   ! linked with fstric
       qfvbq  (:,:) = 0.e0   ! linked with fstric
+      rdm_snw(:,:) = 0.e0   ! variation of snow mass over 1 time step
+      rdq_snw(:,:) = 0.e0   ! heat content associated with rdm_snw
+      rdm_ice(:,:) = 0.e0   ! variation of ice mass over 1 time step
+      rdq_ice(:,:) = 0.e0   ! heat content associated with rdm_ice
+      rdmsnif(:,:) = 0.e0   ! variation of snow mass per unit area
+      rdmicif(:,:) = 0.e0   ! variation of ice mass per unit area
       zmsk (:,:,:) = 0.e0
 …
       !--------------------------------------------------------------------------
+      !CDIR NOVERRCHK
+      DO jj = 1, jpj
+         !CDIR NOVERRCHK
+      sst_m(:,:) = sst_m(:,:) + rt0
+!CDIR NOVERRCHK
+      DO jj = 1, jpj
+!CDIR NOVERRCHK
          DO ji = 1, jpi
             zthsnice       = hsnif(ji,jj) + hicif(ji,jj)
 …
             !  temperature and turbulent mixing (McPhee, 1992)
             zfric_u        = MAX ( MIN( SQRT( ust2s(ji,jj) ) , zfric_umax ) , zfric_umin )  ! friction velocity
             fdtcn(ji,jj)  = zindb * rau0 * rcp * 0.006  * zfric_u * ( sst_m(ji,jj) + rt0 - tfu(ji,jj) )
+            fdtcn(ji,jj)  = zindb * rau0 * rcp * 0.006  * zfric_u * ( sst_m(ji,jj) - tfu(ji,jj) )
             qdtcn(ji,jj)  = zindb * fdtcn(ji,jj) * frld(ji,jj) * rdt_ice
             !  partial computation of the lead energy budget (qldif)
 #if defined key_coupled
             qldif(ji,jj)   = tms(ji,jj) * rdt_ice                                                  &
+            qldif(ji,jj)   = tms(ji,jj) * rdt_ice                                             &
                &    * (   ( qsr_tot(ji,jj) - qsr_ice(ji,jj,1) * zfricp ) * ( 1.0 - thcm(ji,jj) )   &
                &        + ( qns_tot(ji,jj) - qns_ice(ji,jj,1) * zfricp )                           &
                &        + frld(ji,jj) * ( fdtcn(ji,jj) + ( 1.0 - zindb ) * fsbbq(ji,jj) )   )
 #else
+            qldif(ji,jj)   = tms(ji,jj) * rdt_ice * frld(ji,jj)                    &
+               &                        * (  qsr(ji,jj) * ( 1.0 - thcm(ji,jj) )    &
+               &                           + qns(ji,jj)  +  fdtcn(ji,jj)           &
+               &                           + ( 1.0 - zindb ) * fsbbq(ji,jj)      )
+            zfontn         = ( sprecip(ji,jj) / rhosn ) * xlsn  !   energy for melting solid precipitation
+            zfnsol         = qns(ji,jj)                         !  total non solar flux over the ocean
+            qldif(ji,jj)   = tms(ji,jj) * ( qsr(ji,jj) * ( 1.0 - thcm(ji,jj) )   &
+               &                               + zfnsol + fdtcn(ji,jj) - zfontn     &
+               &                               + ( 1.0 - zindb ) * fsbbq(ji,jj) )   &
+               &                        * frld(ji,jj) * rdt_ice
+!!$            qldif(ji,jj)   = tms(ji,jj) * rdt_ice * frld(ji,jj)
+!!$               &           * ( qsr(ji,jj) * ( 1.0 - thcm(ji,jj) )      &
+!!$               &             + qns(ji,jj)  + fdtcn(ji,jj) - zfontn     &
+!!$               &             + ( 1.0 - zindb ) * fsbbq(ji,jj)      )   &
 #endif
             !  parlat : percentage of energy used for lateral ablation (0.0)
 …
             !  energy needed to bring ocean surface layer until its freezing
+            qcmif  (ji,jj) =  rau0 * rcp * fse3t_m(ji,jj,1) * ( tfu(ji,jj) - sst_m(ji,jj) - rt0 ) * ( 1 - zinda )
+            qcmif  (ji,jj) =  rau0 * rcp * fse3t_m(ji,jj,1)   &
+                &          * ( tfu(ji,jj) - sst_m(ji,jj) ) * ( 1 - zinda )
             !  calculate oceanic heat flux.
 …
       END DO
+      sst_m(:,:) = sst_m(:,:) - rt0
       !         Select icy points and fulfill arrays for the vectorial grid.
       !----------------------------------------------------------------------
 …
          CALL tab_2d_1d_2( nbpb, qldif_1d   (1:nbpb)     , qldif      , jpi, jpj, npb(1:nbpb) )
          CALL tab_2d_1d_2( nbpb, qstbif_1d  (1:nbpb)     , qstoif     , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d_2( nbpb, rdm_ice_1d (1:nbpb)     , rdm_ice    , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d_2( nbpb, rdq_ice_1d (1:nbpb)     , rdq_ice    , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d_2( nbpb, rdmicif_1d (1:nbpb)     , rdmicif    , jpi, jpj, npb(1:nbpb) )
          CALL tab_2d_1d_2( nbpb, dmgwi_1d   (1:nbpb)     , dmgwi      , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d_2( nbpb, rdm_snw_1d (1:nbpb)     , rdm_snw    , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d_2( nbpb, rdq_snw_1d (1:nbpb)     , rdq_snw    , jpi, jpj, npb(1:nbpb) )
          CALL tab_2d_1d_2( nbpb, qlbbq_1d   (1:nbpb)     , zqlbsbq    , jpi, jpj, npb(1:nbpb) )
+         !
 …
          CALL tab_1d_2d_2( nbpb, qfvbq      , npb, qfvbq_1d  (1:nbpb)     , jpi, jpj )
          CALL tab_1d_2d_2( nbpb, qstoif     , npb, qstbif_1d (1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpb, rdm_ice    , npb, rdm_ice_1d(1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpb, rdq_ice    , npb, rdq_ice_1d(1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpb, rdmicif    , npb, rdmicif_1d(1:nbpb)     , jpi, jpj )
          CALL tab_1d_2d_2( nbpb, dmgwi      , npb, dmgwi_1d  (1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpb, rdm_snw    , npb, rdm_snw_1d(1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpb, rdq_snw    , npb, rdq_snw_1d(1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpb, rdmsnif    , npb, rdmsnif_1d(1:nbpb)     , jpi, jpj )
          CALL tab_1d_2d_2( nbpb, zdvosif    , npb, dvsbq_1d  (1:nbpb)     , jpi, jpj )
          CALL tab_1d_2d_2( nbpb, zdvobif    , npb, dvbbq_1d  (1:nbpb)     , jpi, jpj )
 …
       IF( nbpac > 0 ) THEN
+         !
          zlicegr(:,:) = rdm_ice(:,:)      ! to output the lateral sea-ice growth
+         zlicegr(:,:) = rdmicif(:,:)      ! to output the lateral sea-ice growth
          !...Put the variable in a 1-D array for lateral accretion
          CALL tab_2d_1d_2( nbpac, frld_1d   (1:nbpac)     , frld       , jpi, jpj, npac(1:nbpac) )
 …
          CALL tab_2d_1d_2( nbpac, qcmif_1d  (1:nbpac)     , qcmif      , jpi, jpj, npac(1:nbpac) )
          CALL tab_2d_1d_2( nbpac, qstbif_1d (1:nbpac)     , qstoif     , jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d_2( nbpac, rdm_ice_1d(1:nbpac)     , rdm_ice    , jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d_2( nbpac, rdq_ice_1d(1:nbpac)     , rdq_ice    , jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d_2( nbpac, rdmicif_1d(1:nbpac)     , rdmicif    , jpi, jpj, npac(1:nbpac) )
          CALL tab_2d_1d_2( nbpac, dvlbq_1d  (1:nbpac)     , zdvolif    , jpi, jpj, npac(1:nbpac) )
          CALL tab_2d_1d_2( nbpac, tfu_1d    (1:nbpac)     , tfu        , jpi, jpj, npac(1:nbpac) )
 …
          CALL tab_1d_2d_2( nbpac, tbif(:,:,3), npac(1:nbpac), tbif_1d   (1:nbpac , 3 ), jpi, jpj )
          CALL tab_1d_2d_2( nbpac, qstoif     , npac(1:nbpac), qstbif_1d (1:nbpac)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpac, rdm_ice    , npac(1:nbpac), rdm_ice_1d(1:nbpac)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpac, rdq_ice    , npac(1:nbpac), rdq_ice_1d(1:nbpac)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpac, rdmicif    , npac(1:nbpac), rdmicif_1d(1:nbpac)     , jpi, jpj )
          CALL tab_1d_2d_2( nbpac, zdvolif    , npac(1:nbpac), dvlbq_1d  (1:nbpac)     , jpi, jpj )
+         !
 …
       CALL iom_put( 'iceprod_cea' , hicifp (:,:) * zztmp     )   ! Ice produced               [m/s]
       IF( lk_diaar5 ) THEN
          CALL iom_put( 'snowmel_cea' , rdm_snw(:,:) * zztmp     )   ! Snow melt                  [kg/m2/s]
+         CALL iom_put( 'snowmel_cea' , rdmsnif(:,:) * zztmp     )   ! Snow melt                  [kg/m2/s]
          zztmp = rhoic / rdt_ice
          CALL iom_put( 'sntoice_cea' , zdvonif(:,:) * zztmp     )   ! Snow to Ice transformation [kg/m2/s]
          CALL iom_put( 'ticemel_cea' , zdvosif(:,:) * zztmp     )   ! Melt at Sea Ice top        [kg/m2/s]
          CALL iom_put( 'bicemel_cea' , zdvomif(:,:) * zztmp     )   ! Melt at Sea Ice bottom     [kg/m2/s]
          zlicegr(:,:) = MAX( 0.e0, rdm_ice(:,:)-zlicegr(:,:) )
          CALL iom_put( 'licepro_cea' , zlicegr(:,:) * zztmp     )   ! Lateral sea ice growth     [kg/m2/s]
+         zlicegr(:,:) = MAX( 0.e0, rdmicif(:,:)-zlicegr(:,:) )
+         CALL iom_put( 'licepro_cea' , zlicegr(:,:) * zztmp     )   ! Latereal sea ice growth    [kg/m2/s]
       ENDIF
+      !

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/LIM_SRC_2/limthd_lac_2.F90

-                      r3625
+                      r6736
    !!----------------------------------------------------------------------
    !!   lim_lat_acr_2 : lateral accretion of ice
    !!----------------------------------------------------------------------
    USE par_oce        ! ocean parameters
+   !!   lim_lat_acr_2   : lateral accretion of ice
+   !!----------------------------------------------------------------------
+   USE par_oce          ! ocean parameters
    USE phycst
    USE thd_ice_2
    USE ice_2
    USE limistate_2
    USE lib_mpp        ! MPP library
    USE wrk_nemo       ! work arrays
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE lib_mpp          ! MPP library
+   USE wrk_nemo         ! work arrays
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
    IMPLICIT NONE
 …
          frld_1d   (ji) = MAX( zfrlnew , zfrlmin(ji) )
          !--computation of the remaining part of ice thickness which has been already used
          zdhicbot(ji) =  ( frld_1d(ji) - zfrlnew ) * zhice0(ji) / ( 1.0 - zfrlmin(ji) )   &
             &         -  (  ( 1.0 - zfrrate ) / ( 1.0 - frld_1d(ji) ) )  * ( zqbgow(ji) / xlic )
+         zdhicbot(ji) =  ( frld_1d(ji) - zfrlnew ) * zhice0(ji) / ( 1.0 - zfrlmin(ji) ) &
+                      -  (  ( 1.0 - zfrrate ) / ( 1.0 - frld_1d(ji) ) )  * ( zqbgow(ji) / xlic )
       END DO
 …
             &          ) / zah
          tbif_1d(ji,3) =     ( iiceform * ( zhnews2 - zdh3 )                                           * zta1  &
+         tbif_1d(ji,3) =     (  iiceform * ( zhnews2 - zdh3 )                                          * zta1  &
             &              + ( iiceform * zdh3 + ( 1 - iiceform ) * zdh1 )                             * zta2  &
             &              + ( iiceform * ( zhnews2 - zdh5 ) + ( 1 - iiceform ) * ( zhnews2 - zdh1 ) ) * zta3  &
 …
       DO ji = kideb , kiut
          dvlbq_1d  (ji) = ( 1. - frld_1d(ji) ) * h_ice_1d(ji) - ( 1. - zfrl_old(ji) ) * zhice_old(ji)
+         rdm_ice_1d(ji) = rdm_ice_1d(ji) + rhoic * dvlbq_1d(ji)
+         rdq_ice_1d(ji) = rdq_ice_1d(ji) + rcpic * dvlbq_1d(ji) * ( tfu_1d(ji) - rt0 )      ! heat content relative to rt0
+         rdmicif_1d(ji) = rdmicif_1d(ji) + rhoic * dvlbq_1d(ji)
       END DO

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90

-                      r3625
+                      r6736
    USE ice_2
    USE limistate_2
-   USE cpl_oasis3, ONLY : lk_cpl
    USE in_out_manager
    USE lib_mpp          ! MPP library
    USE wrk_nemo         ! work arrays
+   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE cpl_oasis3, ONLY : lk_cpl
    IMPLICIT NONE
    PRIVATE
 …
       REAL(wp), POINTER, DIMENSION(:) ::   zrcpdt         ! h_su*rho_su*cp_su/dt(h_su being the thick. of surf. layer)
       REAL(wp), POINTER, DIMENSION(:) ::   zts_old        ! previous surface temperature
       REAL(wp), POINTER, DIMENSION(:) ::   zidsn , z1midsn , zidsnic ! temporary variables
+      REAL(wp), POINTER, DIMENSION(:) ::   zidsn , z1midsn , zidsnic ! tempory variables
       REAL(wp), POINTER, DIMENSION(:) ::   zfnet          ! net heat flux at the top surface( incl. conductive heat flux)
       REAL(wp), POINTER, DIMENSION(:) ::   zsprecip       ! snow accumulation
 …
       REAL(wp), POINTER, DIMENSION(:) ::   zep            ! internal temperature of the 2nd layer of the snow/ice system
       REAL(wp), DIMENSION(3) :: &
             zplediag  &    ! principle diagonal, subdiag. and supdiag. of the
+          zplediag  &    ! principle diagonal, subdiag. and supdiag. of the
           , zsubdiag  &    ! tri-diagonal matrix coming from the computation
           , zsupdiag  &    ! of the temperatures inside the snow-ice system
           , zsmbr          ! second member
+       REAL(wp) ::    &
+            zhsu      &    ! thickness of surface layer
+          , zhe       &    ! effective thickness for compu. of equ. thermal conductivity
+          , zheshth   &    ! = zhe / thth
+          , zghe      &    ! correction factor of the thermal conductivity
+          , zumsb     &    ! parameter for numerical method to solve heat-diffusion eq.
+          , zkhsn     &    ! conductivity at the snow layer
+          , zkhic     &    ! conductivity at the ice layers
+          , zkint     &    ! equivalent conductivity at the snow-ice interface
+          , zkhsnint  &    ! = zkint*dt / (hsn*rhosn*cpsn)
+          , zkhicint  &    ! = 2*zkint*dt / (hic*rhoic*cpic)
+          , zpiv1, zpiv2 & ! temporary scalars used to solve the tri-diagonal system
+          , zb2, zd2  &    ! temporary scalars used to solve the tri-diagonal system
+          , zb3, zd3  &    ! temporary scalars used to solve the tri-diagonal system
+       REAL(wp) :: &
+          zhsu     &     ! thickness of surface layer
+          , zhe      &     ! effective thickness for compu. of equ. thermal conductivity
+          , zheshth  &     ! = zhe / thth
+          , zghe     &     ! correction factor of the thermal conductivity
+          , zumsb    &     ! parameter for numerical method to solve heat-diffusion eq.
+          , zkhsn    &     ! conductivity at the snow layer
+          , zkhic    &     ! conductivity at the ice layers
+          , zkint    &     ! equivalent conductivity at the snow-ice interface
+          , zkhsnint &     ! = zkint*dt / (hsn*rhosn*cpsn)
+          , zkhicint &     ! = 2*zkint*dt / (hic*rhoic*cpic)
+          , zpiv1 , zpiv2  &       ! tempory scalars used to solve the tri-diagonal system
+          , zb2 , zd2 , zb3 , zd3 &
           , ztint          ! equivalent temperature at the snow-ice interface
        REAL(wp) ::    &
             zexp      &    ! exponential function of the ice thickness
           , zfsab     &    ! part of solar radiation stored in brine pockets
           , zfts      &    ! value of energy balance function when the temp. equal surf. temp.
           , zdfts     &    ! value of derivative of ztfs when the temp. equal surf. temp.
           , zdts      &    ! surface temperature increment
           , zqsnw_mlt &    ! energy needed to melt snow
           , zdhsmlt   &    ! change in snow thickness due to melt
           , zhsn      &    ! snow thickness (previous+accumulation-melt)
           , zqsn_mlt_rem & ! remaining heat coming from snow melting
           , zqice_top_mlt &! energy used to melt ice at top surface
           , zdhssub   &    ! change in snow thick. due to sublimation or evaporation
           , zdhisub   &    ! change in ice thick. due to sublimation or evaporation
           , zdhsn     &    ! snow ice thickness increment
           , zdtsn     &    ! snow internal temp. increment
           , zdtic     &    ! ice internal temp. increment
+       REAL(wp) :: &
+          zexp      &     ! exponential function of the ice thickness
+          , zfsab     &     ! part of solar radiation stored in brine pockets
+          , zfts      &     ! value of energy balance function when the temp. equal surf. temp.
+          , zdfts     &     ! value of derivative of ztfs when the temp. equal surf. temp.
+          , zdts      &     ! surface temperature increment
+          , zqsnw_mlt &     ! energy needed to melt snow
+          , zdhsmlt   &     ! change in snow thickness due to melt
+          , zhsn      &     ! snow thickness (previous+accumulation-melt)
+          , zqsn_mlt_rem &  ! remaining heat coming from snow melting
+          , zqice_top_mlt & ! energy used to melt ice at top surface
+          , zdhssub      &  ! change in snow thick. due to sublimation or evaporation
+          , zdhisub      &  ! change in ice thick. due to sublimation or evaporation
+          , zdhsn        &  ! snow ice thickness increment
+          , zdtsn        &  ! snow internal temp. increment
+          , zdtic        &  ! ice internal temp. increment
           , zqnes          ! conductive energy due to ice melting in the first ice layer
+       REAL(wp) ::    &
+            ztbot     &    ! temperature at the bottom surface
+          , zfcbot    &    ! conductive heat flux at bottom surface
+          , zqice_bot &    ! energy used for bottom melting/growing
+          , zqice_bot_mlt &! energy used for bottom melting
+          , zqstbif_bot  & ! part of energy stored in brine pockets used for bottom melting
+          , zqstbif_old  & ! temporary var. for zqstbif_bot
+          , zdhicmlt  &    ! change in ice thickness due to bottom melting
+          , zdhicm    &    ! change in ice thickness var.
+          , zdhsnm    &    ! change in snow thickness var.
+          , zhsnfi    &    ! snow thickness var.
+          , zc1, zpc1 &    ! temporary variables
+          , zc2, zpc2 &    ! temporary variables
+          , zp1, zp2  &    ! temporary variables
+          , ztb2, ztb3     ! temporary variables
+       REAL(wp) ::    &
+            zdrmh     &    ! change in snow/ice thick. after snow-ice formation
+          , zhicnew   &    ! new ice thickness
+          , zhsnnew   &    ! new snow thickness
+          , zquot     &
+          , ztneq     &    ! temporary temp. variables
+          , zqice     &
+          , zqicetot  &    ! total heat inside the snow/ice system
+          , zdfrl     &    ! change in ice concentration
+          , zdvsnvol  &    ! change in snow volume
+          , zdrfrl1, zdrfrl2, zihsn, zidhb, zihic &  ! temporary scalars
+          , zihe, zihq, ziexp, ziqf, zihnf        &  ! temporary scalars
+          , zibmlt, ziqr, zihgnew, zind, ztmp        ! temporary scalars
+       REAL(wp) :: &
+          ztbot     &      ! temperature at the bottom surface
+          , zfcbot    &      ! conductive heat flux at bottom surface
+          , zqice_bot &      ! energy used for bottom melting/growing
+          , zqice_bot_mlt &  ! energy used for bottom melting
+          , zqstbif_bot  &  ! part of energy stored in brine pockets used for bottom melting
+          , zqstbif_old  &  ! tempory var. for zqstbif_bot
+          , zdhicmlt      &  ! change in ice thickness due to bottom melting
+          , zdhicm        &  ! change in ice thickness var.
+          , zdhsnm        &  ! change in snow thickness var.
+          , zhsnfi        &  ! snow thickness var.
+          , zc1, zpc1, zc2, zpc2, zp1, zp2 & ! tempory variables
+          , ztb2, ztb3
+       REAL(wp) :: &
+          zdrmh         &   ! change in snow/ice thick. after snow-ice formation
+          , zhicnew       &   ! new ice thickness
+          , zhsnnew       &   ! new snow thickness
+          , zquot , ztneq &   ! tempory temp. variables
+          , zqice, zqicetot & ! total heat inside the snow/ice system
+          , zdfrl         &   ! change in ice concentration
+          , zdvsnvol      &   ! change in snow volume
+          , zdrfrl1, zdrfrl2 &  ! tempory scalars
+          , zihsn, zidhb, zihic, zihe, zihq, ziexp, ziqf, zihnf, zibmlt, ziqr, zihgnew, zind
        !!----------------------------------------------------------------------
        CALL wrk_alloc( jpij, ztsmlt, ztbif  , zksn    , zkic    , zksndh , zfcsu  , zfcsudt , zi0      , z1mi0   , zqmax    )
 …
        DO ji = kideb , kiut
-          ! do nothing if the snow (ice) thickness falls below its minimum thickness
           zihsn = MAX( zzero , SIGN( zone , hsndif - h_snow_1d(ji) ) )
           zihic = MAX( zzero , SIGN( zone , hicdif - h_ice_1d(ji) ) )
+          !--energy required to bring snow to its melting point (rt0_snow)
+          zqcmlts(ji) = ( MAX ( zzero , rcpsn * h_snow_1d(ji) * ( tbif_1d(ji,1) - rt0_snow ) ) ) * ( 1.0 - zihsn )
+          !--energy required to bring ice to its melting point (rt0_ice)
+          zqcmltb(ji) = ( MAX( zzero , rcpic * ( tbif_1d(ji,2) - rt0_ice ) * ( h_ice_1d(ji) / 2. ) )  &
+             &          + MAX( zzero , rcpic * ( tbif_1d(ji,3) - rt0_ice ) * ( h_ice_1d(ji) / 2. ) )  &
+             &          ) * ( 1.0 - zihic  )
+          !--limitation of snow/ice system internal temperature
+          !--computation of energy due to surface melting
+          zqcmlts(ji) = ( MAX ( zzero ,  &
+             &                   rcpsn * h_snow_1d(ji) * ( tbif_1d(ji,1) - rt0_snow ) ) ) * ( 1.0 - zihsn )
+          !--computation of energy due to bottom melting
+          zqcmltb(ji) = ( MAX( zzero , &
+             &                  rcpic * ( tbif_1d(ji,2) - rt0_ice ) * ( h_ice_1d(ji) / 2. ) ) &
+             &           + MAX( zzero , &
+             &                  rcpic * ( tbif_1d(ji,3) - rt0_ice ) * ( h_ice_1d(ji) / 2. ) ) &
+             &           ) * ( 1.0 - zihic  )
+          !--limitation of  snow/ice system internal temperature
           tbif_1d(ji,1)   = MIN( rt0_snow, tbif_1d(ji,1) )
           tbif_1d(ji,2)   = MIN( rt0_ice , tbif_1d(ji,2) )
 …
           dvsbq_1d(ji) =  ( 1.0 - frld_1d(ji) ) * ( h_snow_1d(ji) - zhsnw_old(ji) - zsprecip(ji) )
           dvsbq_1d(ji) =  MIN( zzero , dvsbq_1d(ji) )
+          ztmp = rhosn * dvsbq_1d(ji)
+          rdm_snw_1d(ji) =  ztmp
+          !--heat content of the water provided to the ocean (referenced to rt0)
+          rdq_snw_1d(ji) =  cpic * ztmp * ( rt0_snow - rt0 )
+          rdmsnif_1d(ji) =  rhosn * dvsbq_1d(ji)
           !-- If the snow is completely melted the remaining heat is used to melt ice
           zqsn_mlt_rem  = MAX( zzero , -zhsn ) * xlsn
 …
           !---updating new ice thickness and computing the newly formed ice mass
           zhicnew   =  zihgnew * zhicnew
+          ztmp    =  ( 1.0 - frld_1d(ji) ) * ( zhicnew - h_ice_1d(ji) ) * rhoic
+          rdm_ice_1d(ji) =  rdm_ice_1d(ji) + ztmp
+          !---heat content of the water provided to the ocean (referenced to rt0)
+          !   use of rt0_ice is OK for melting ice; in the case of freezing, tfu_1d should be used.
+          !   This is done in 9.5 section (see below)
+          rdq_ice_1d(ji) =  cpic * ztmp * ( rt0_ice - rt0 )
+          rdmicif_1d(ji) =  rdmicif_1d(ji) + ( 1.0 - frld_1d(ji) ) * ( zhicnew - h_ice_1d(ji) ) * rhoic
           !---updating new snow thickness and computing the newly formed snow mass
           zhsnfi   = zhsn + zdhsnm
           h_snow_1d(ji) = MAX( zzero , zhsnfi )
+          ztmp = ( 1.0 - frld_1d(ji) ) * ( h_snow_1d(ji) - zhsn ) * rhosn
+          rdm_snw_1d(ji) = rdm_snw_1d(ji) + ztmp
+          !---updating the heat content of the water provided to the ocean (referenced to rt0)
+          rdq_snw_1d(ji) = rdq_snw_1d(ji) + cpic * ztmp * ( rt0_snow - rt0 )
+          rdmsnif_1d(ji) =  rdmsnif_1d(ji) + ( 1.0 - frld_1d(ji) ) * ( h_snow_1d(ji) - zhsn ) * rhosn
           !--remaining energy in case of total ablation
           zqocea(ji) = - ( zihsn * xlic * zdhicm + xlsn * ( zhsnfi - h_snow_1d(ji) ) ) * ( 1.0 - frld_1d(ji) )
 …
           tbif_1d(ji,3) =  zihgnew * ztb3 + ( 1.0 - zihgnew ) * tfu_1d(ji)
           h_ice_1d(ji)  =  zhicnew
-          ! update the ice heat content given to the ocean in freezing case
-          ! (part due to difference between rt0_ice and tfu_1d)
-          ztmp = ( 1. - zidhb ) * rhoic * dvbbq_1d(ji)
-          rdq_ice_1d(ji) = rdq_ice_1d(ji) + cpic * ztmp * ( tfu_1d(ji) - rt0_ice )
        END DO
 …
           dmgwi_1d(ji) = dmgwi_1d(ji) + ( 1.0 -frld_1d(ji) ) * ( h_snow_1d(ji) - zhsnnew ) * rhosn
           !---  volume change of ice and snow (used for ocean-ice freshwater flux computation)
+          ztmp = ( 1.0 - frld_1d(ji) ) * ( zhicnew - h_ice_1d (ji) ) * rhoic
+          rdm_ice_1d(ji) = rdm_ice_1d(ji) + ztmp
+          rdq_ice_1d(ji) = rdq_ice_1d(ji) + cpic * ztmp * ( tfu_1d(ji) - rt0 )
+          !!gm BUG ??   snow ==>  only needed for nn_ice_embd == 0  (standard levitating sea-ice)
+          ztmp = ( 1.0 - frld_1d(ji) )   * ( zhsnnew - h_snow_1d(ji) ) * rhosn
+          rdm_snw_1d(ji) = rdm_snw_1d(ji) + ztmp
+          rdq_snw_1d(ji) = rdq_snw_1d(ji) + cpic * ztmp * ( rt0_snow - rt0 )
+          rdmicif_1d(ji) = rdmicif_1d(ji) + ( 1.0 - frld_1d(ji) )   * ( zhicnew - h_ice_1d (ji) ) * rhoic
+          rdmsnif_1d(ji) = rdmsnif_1d(ji) + ( 1.0 - frld_1d(ji) )   * ( zhsnnew - h_snow_1d(ji) ) * rhosn
           !---  Actualize new snow and ice thickness.
 …
           !--variation of ice volume and ice mass
           dvlbq_1d(ji)   = zihic * ( zfrl_old(ji) - frld_1d(ji) ) * h_ice_1d(ji)
+          ztmp = dvlbq_1d(ji) * rhoic
+          rdm_ice_1d(ji) = rdm_ice_1d(ji) + ztmp
+!!gm
+!!gm   This should be split in two parts:
+!!gm         1-  heat required to bring sea-ice to tfu  : this part should be added to the heat flux taken from the ocean
+!!gm                 cpic * ztmp * 0.5 * ( tbif_1d(ji,2) + tbif_1d(ji,3) - 2.* rt0_ice )
+!!gm         2-  heat content of lateral ablation referenced to rt0 : this part only put in rdq_ice_1d
+!!gm                 cpic * ztmp * ( rt0_ice - rt0 )
+!!gm   Currently we put all the heat in rdq_ice_1d
+          rdq_ice_1d(ji) = rdq_ice_1d(ji) + cpic * ztmp * 0.5 * ( tbif_1d(ji,2) + tbif_1d(ji,3) - 2.* rt0 )
+          !
+          rdmicif_1d(ji) = rdmicif_1d(ji) + dvlbq_1d(ji) * rhoic
           !--variation of snow volume and snow mass
+          zdvsnvol = zihsn * ( zfrl_old(ji) - frld_1d(ji) ) * h_snow_1d(ji)
+          ztmp     = zdvsnvol * rhosn
+          rdm_snw_1d(ji) = rdm_snw_1d(ji) + ztmp
+!!gm
+!!gm   This should be split in two parts:
+!!gm         1-  heat required to bring snow to tfu  : this part should be added to the heat flux taken from the ocean
+!!gm                 cpic * ztmp * ( tbif_1d(ji,1) - rt0_snow )
+!!gm         2-  heat content of lateral ablation referenced to rt0 : this part only put in rdq_snw_1d
+!!gm                 cpic * ztmp * ( rt0_snow - rt0 )
+!!gm   Currently we put all the heat in rdq_snw_1d
+          rdq_snw_1d(ji) = rdq_snw_1d(ji) + cpic * ztmp * ( tbif_1d(ji,1) - rt0 )
+          zdvsnvol    = zihsn * ( zfrl_old(ji) - frld_1d(ji) ) * h_snow_1d(ji)
+          rdmsnif_1d(ji) = rdmsnif_1d(ji) + zdvsnvol * rhosn
           h_snow_1d(ji)  = ziqf * h_snow_1d(ji)

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/LIM_SRC_2/limtrp_2.F90

-                      r3764
+                      r6736
    USE lib_mpp         ! MPP library
    USE wrk_nemo        ! work arrays
-# if defined key_agrif
-   USE agrif_lim2_interp ! nesting
-# endif
    USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
 …
       IF( kt == nit000  )   CALL lim_trp_init_2      ! Initialization (first time-step only)
-# if defined key_agrif
-      CALL agrif_trp_lim2_load      ! First interpolation
-# endif
       zsm(:,:) = area(:,:)
 …
       ENDIF
+      !
-# if defined key_agrif
-      CALL agrif_trp_lim2      ! Fill boundaries of the fine grid
-# endif
+      !
       CALL wrk_dealloc( jpi, jpj, zui_u , zvi_v , zsm, zs0ice, zs0sn , zs0a, zs0c0 , zs0c1 , zs0c2 , zs0st )
+      !

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90

-                      r3764
+                      r6736
    !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
    !!   lim_wri_2       : write of the diagnostics variables in ouput file
    !!   lim_wri_init_2  : initialization and namelist read
+   !!   lim_wri_2      : write of the diagnostics variables in ouput file
+   !!   lim_wri_init_2 : initialization and namelist read
    !!   lim_wri_state_2 : write for initial state or/and abandon:
    !!                     > output.init.nc (if ninist = 1 in namelist)
 …
    USE ice_2
    USE dianam           ! build name of file (routine)
+   USE dianam          ! build name of file (routine)
    USE lbclnk
    USE in_out_manager
    USE lib_mpp          ! MPP library
    USE wrk_nemo         ! work arrays
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! work arrays
    USE iom
    USE ioipsl
-   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
    IMPLICIT NONE
 …
             zcmo(ji,jj,13) = qns(ji,jj)
             ! See thersf for the coefficient
             zcmo(ji,jj,14) = - sfx (ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce    !!gm ???
+            zcmo(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce    !!gm ???
             zcmo(ji,jj,15) = utau_ice(ji,jj)
             zcmo(ji,jj,16) = vtau_ice(ji,jj)

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/LIM_SRC_2/limwri_dimg_2.h90

-                      r3764
+                      r6736
           zcmo(ji,jj,13) = qns(ji,jj)
           ! See thersf for the coefficient
           zcmo(ji,jj,14) = - sfx (ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce
+          zcmo(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce
           zcmo(ji,jj,15) = utau_ice(ji,jj)
           zcmo(ji,jj,16) = vtau_ice(ji,jj)
 …
                 rcmoy(ji,jj,13) = qns(ji,jj)
                 ! See thersf for the coefficient
                 rcmoy(ji,jj,14) = - sfx (ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce
+                rcmoy(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce
                 rcmoy(ji,jj,15) = utau_ice(ji,jj)
                 rcmoy(ji,jj,16) = vtau_ice(ji,jj)

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/LIM_SRC_2/thd_ice_2.F90

-                      r3625
+                      r6736
       qstbif_1d   ,     &  !:    "                  "      qstoif
       fbif_1d     ,     &  !:    "                  "      fbif
+      rdm_ice_1d  ,     &  !:    "                  "      rdm_ice
+      rdq_ice_1d  ,     &  !:    "                  "      rdq_ice
+      rdm_snw_1d  ,     &  !:    "                  "      rdm_snw
+      rdq_snw_1d  ,     &  !:    "                  "      rdq_snw
+      rdmicif_1d  ,     &  !:    "                  "      rdmicif
+      rdmsnif_1d  ,     &  !:    "                  "      rdmsnif
       qlbbq_1d    ,     &  !:    "                  "      qlbsbq
       dmgwi_1d    ,     &  !:    "                  "      dmgwi
 …
          &      qstbif_1d(jpij),  fbif_1d(jpij),  Stat=ierr(2))
+         !
+      ALLOCATE( rdm_ice_1d(jpij), rdq_ice_1d(jpij)                  , &
+         &      rdm_snw_1d(jpij), rdq_snw_1d(jpij), qlbbq_1d(jpij)  , &
+      ALLOCATE( rdmicif_1d(jpij), rdmsnif_1d(jpij), qlbbq_1d(jpij),   &
          &      dmgwi_1d(jpij)  , dvsbq_1d(jpij)  , rdvomif_1d(jpij), &
          &      dvbbq_1d(jpij)  , dvlbq_1d(jpij)  , dvnbq_1d(jpij)  , &

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90

-                      r3791
+                      r6736
    !!             -   !  2008-11  (M. Vancoppenolle, S. Bouillon, Y. Aksenov) add surface tilt in ice rheolohy
    !!            3.3  !  2009-05  (G.Garric) addition of the lim2_evp cas
+   !!            3.4  !  2011-01  (A. Porter)  dynamical allocation
+   !!            3.5  !  2012-08  (R. Benshila)  AGRIF
+   !!            3.4  !  2011-01  (A Porter)  dynamical allocation
    !!----------------------------------------------------------------------
 #if defined key_lim3 || (  defined key_lim2 && ! defined key_lim2_vp )
 …
    !!   'key_lim2' AND NOT 'key_lim2_vp'            EVP LIM-2 sea-ice model
    !!----------------------------------------------------------------------
    !!   lim_rhg       : computes ice velocities
+   !!   lim_rhg   : computes ice velocities
    !!----------------------------------------------------------------------
+   USE phycst         ! Physical constant
+   USE oce     , ONLY :  snwice_mass, snwice_mass_b
+   USE par_oce        ! Ocean parameters
+   USE dom_oce        ! Ocean domain
+   USE sbc_oce        ! Surface boundary condition: ocean fields
+   USE sbc_ice        ! Surface boundary condition: ice fields
+   USE phycst           ! Physical constant
+   USE par_oce          ! Ocean parameters
+   USE dom_oce          ! Ocean domain
+   USE sbc_oce          ! Surface boundary condition: ocean fields
+   USE sbc_ice          ! Surface boundary condition: ice fields
+   USE lbclnk           ! Lateral Boundary Condition / MPP link
+   USE lib_mpp          ! MPP library
+   USE wrk_nemo         ! work arrays
+   USE in_out_manager   ! I/O manager
+   USE prtctl           ! Print control
+   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
 #if defined key_lim3
    USE ice            ! LIM-3: ice variables
    USE dom_ice        ! LIM-3: ice domain
    USE limitd_me      ! LIM-3:
+   USE ice              ! LIM-3: ice variables
+   USE dom_ice          ! LIM-3: ice domain
+   USE limitd_me        ! LIM-3:
 #else
+   USE ice_2          ! LIM-2: ice variables
+   USE dom_ice_2      ! LIM-2: ice domain
+#endif
+   USE lbclnk         ! Lateral Boundary Condition / MPP link
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! work arrays
+   USE in_out_manager ! I/O manager
+   USE prtctl         ! Print control
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+#if defined key_agrif && defined key_lim2
+   USE agrif_lim2_interp
+   USE ice_2            ! LIM2: ice variables
+   USE dom_ice_2        ! LIM2: ice domain
 #endif
 …
       REAL(wp) ::   zindb         ! ice (1) or not (0)
       REAL(wp) ::   zdummy        ! dummy argument
-      REAL(wp) ::   zintb, zintn  ! dummy argument
       REAL(wp), POINTER, DIMENSION(:,:) ::   zpresh           ! temporary array for ice strength
 …
       REAL(wp), POINTER, DIMENSION(:,:) ::   zs12             ! Non-diagonal stress tensor component zs12
       REAL(wp), POINTER, DIMENSION(:,:) ::   zu_ice, zv_ice, zresr   ! Local error on velocity
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zpice            ! array used for the calculation of ice surface slope:
-                                                              !   ocean surface (ssh_m) if ice is not embedded
-                                                              !   ice top surface if ice is embedded
       !!-------------------------------------------------------------------
 …
       CALL wrk_alloc( jpi,jpj, zc1   , u_oce1, u_oce2, u_ice2, zusw  , v_oce1 , v_oce2, v_ice1                )
       CALL wrk_alloc( jpi,jpj, zf1   , deltat, zu_ice, zf2   , deltac, zv_ice , zdd   , zdt    , zds  , zdst  )
       CALL wrk_alloc( jpi,jpj, zdd   , zdt   , zds   , zs1   , zs2   , zs12   , zresr , zpice                 )
+      CALL wrk_alloc( jpi,jpj, zdd   , zdt   , zds   , zs1   , zs2   , zs12   , zresr                         )
 #if  defined key_lim2 && ! defined key_lim2_vp
 …
 # endif
      at_i(:,:) = 1. - frld(:,:)
-#endif
-#if defined key_agrif && defined key_lim2
-    CALL agrif_rhg_lim2_load      ! First interpolation of coarse values
 #endif
+      !
 …
       !  v_oce2: ocean v component on v points
-      IF( nn_ice_embd == 2 ) THEN             !== embedded sea ice: compute representative ice top surface ==!
+          !
-          ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1}
-          !                                               = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1}
-         zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp
+          !
-          ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1}
-          !                                               = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1})
-         zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp
+          !
-         zpice(:,:) = ssh_m(:,:) + (  zintn * snwice_mass(:,:) +  zintb * snwice_mass_b(:,:)  ) * r1_rau0
+          !
-      ELSE                                    !== non-embedded sea ice: use ocean surface for slope calculation ==!
-         zpice(:,:) = ssh_m(:,:)
-      ENDIF
       DO jj = k_j1+1, k_jpj-1
          DO ji = fs_2, fs_jpim1
 …
             ! include it later
             zdsshx =  ( zpice(ji+1,jj) - zpice(ji,jj) ) / e1u(ji,jj)
             zdsshy =  ( zpice(ji,jj+1) - zpice(ji,jj) ) / e2v(ji,jj)
+            zdsshx =  ( ssh_m(ji+1,jj) - ssh_m(ji,jj) ) / e1u(ji,jj)
+            zdsshy =  ( ssh_m(ji,jj+1) - ssh_m(ji,jj) ) / e2v(ji,jj)
             za1ct(ji,jj) = ztagnx - zmass1(ji,jj) * grav * zdsshx
 …
             CALL lbc_lnk( u_ice(:,:), 'U', -1. )
-#if defined key_agrif
-            CALL agrif_rhg_lim2( jter, nevp, 'U' )
-#endif
 !CDIR NOVERRCHK
 …
             CALL lbc_lnk( v_ice(:,:), 'V', -1. )
-#if defined key_agrif
-            CALL agrif_rhg_lim2( jter, nevp, 'V' )
-#endif
          ELSE
 …
             CALL lbc_lnk( v_ice(:,:), 'V', -1. )
-#if defined key_agrif
-            CALL agrif_rhg_lim2( jter, nevp , 'V' )
-#endif
 !CDIR NOVERRCHK
 …
             CALL lbc_lnk( u_ice(:,:), 'U', -1. )
-#if defined key_agrif
-            CALL agrif_rhg_lim2( jter, nevp, 'U' )
-#endif
          ENDIF
 …
       CALL lbc_lnk( u_ice(:,:), 'U', -1. )
       CALL lbc_lnk( v_ice(:,:), 'V', -1. )
-#if defined key_agrif
-      CALL agrif_rhg_lim2( nevp , nevp, 'U' )
-      CALL agrif_rhg_lim2( nevp , nevp, 'V' )
-#endif
       DO jj = k_j1+1, k_jpj-1
 …
       CALL wrk_dealloc( jpi,jpj, zc1   , u_oce1, u_oce2, u_ice2, zusw  , v_oce1 , v_oce2, v_ice1                )
       CALL wrk_dealloc( jpi,jpj, zf1   , deltat, zu_ice, zf2   , deltac, zv_ice , zdd   , zdt    , zds  , zdst  )
       CALL wrk_dealloc( jpi,jpj, zdd   , zdt   , zds   , zs1   , zs2   , zs12   , zresr , zpice                 )
+      CALL wrk_dealloc( jpi,jpj, zdd   , zdt   , zds   , zs1   , zs2   , zs12   , zresr                         )
    END SUBROUTINE lim_rhg

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90

-                      r3785
+                      r6736
    !!----------------------------------------------------------------------
    !!   'key_asminc'   : Switch on the assimilation increment interface
+   !!   'key_asminc' : Switch on the assimilation increment interface
    !!----------------------------------------------------------------------
    !!   asm_inc_init   : Initialize the increment arrays and IAU weights
    !!   calc_date      : Compute the calendar date YYYYMMDD on a given step
    !!   tra_asm_inc    : Apply the tracer (T and S) increments
    !!   dyn_asm_inc    : Apply the dynamic (u and v) increments
    !!   ssh_asm_inc    : Apply the SSH increment
    !!   seaice_asm_inc : Apply the seaice increment
+   !!   asm_inc_init : Initialize the increment arrays and IAU weights
+   !!   calc_date    : Compute the calendar date YYYYMMDD on a given step
+   !!   tra_asm_inc  : Apply the tracer (T and S) increments
+   !!   dyn_asm_inc  : Apply the dynamic (u and v) increments
+   !!   ssh_asm_inc  : Apply the SSH increment
+   !!   seaice_asm_inc  : Apply the seaice increment
    !!----------------------------------------------------------------------
    USE wrk_nemo         ! Memory Allocation
    USE par_oce          ! Ocean space and time domain variables
    USE dom_oce          ! Ocean space and time domain
-   USE domvvl           ! domain: variable volume level
    USE oce              ! Dynamics and active tracers defined in memory
    USE ldfdyn_oce       ! ocean dynamics: lateral physics
 …
 #endif
    USE sbc_oce          ! Surface boundary condition variables.
+   USE domvvl
    IMPLICIT NONE
 …
 #  include "ldfdyn_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
 …
       !! ** Action  :
       !!----------------------------------------------------------------------
+      INTEGER :: ji, jj, jk
+      !!
+      !!
+      INTEGER :: ji,jj,jk
       INTEGER :: jt
       INTEGER :: imid
 …
             ! Update before fields
             sshb(:,:) = sshn(:,:)
+#if ! defined key_jth_fix
             IF( lk_vvl ) THEN
                DO jk = 1, jpk
 …
                END DO
             ENDIF
+#endif
             DEALLOCATE( ssh_bkg    )
             DEALLOCATE( ssh_bkginc )
 …
    END SUBROUTINE ssh_asm_inc
    SUBROUTINE seaice_asm_inc( kt, kindic )
       !!----------------------------------------------------------------------
 …
       !! ** Action  :
       !!
+      !!----------------------------------------------------------------------
+      !! History :
+      !!        !  07-2011  (D. Lea)  Initial version based on ssh_asm_inc
+      !!----------------------------------------------------------------------
       IMPLICIT NONE
+      !
+      INTEGER, INTENT(in)           ::   kt   ! Current time step
+      INTEGER, INTENT(in), OPTIONAL ::   kindic   ! flag for disabling the deallocation
+      !
+      INTEGER  ::   it
+      REAL(wp) ::   zincwgt   ! IAU weight for current time step
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kt   ! Current time step
+      INTEGER, OPTIONAL, INTENT(IN) :: kindic ! flag for disabling the deallocation
+      !! * Local declarations
+      INTEGER :: it
+      REAL(wp) :: zincwgt  ! IAU weight for current time step
 #if defined key_lim2
+      REAL(wp), DIMENSION(jpi,jpj) ::   zofrld, zohicif, zseaicendg, zhicifinc  ! LIM
+      REAL(wp) ::   zhicifmin = 0.5_wp      ! ice minimum depth in metres
+#endif
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj) :: zofrld, zohicif, zseaicendg, zhicifinc  ! LIM
+      REAL(wp) :: zhicifmin=0.5_wp      ! ice minimum depth in metres
+#endif
       IF ( ln_asmiau ) THEN
 …
             ENDIF
-            ! Sea-ice : LIM-3 case (to add)
 #if defined key_lim2
+            ! Sea-ice : LIM-2 case
             zofrld (:,:) = frld(:,:)
             zohicif(:,:) = hicif(:,:)
+            !
             frld  = MIN( MAX( frld (:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp)
+            zofrld(:,:)=frld(:,:)
+            zohicif(:,:)=hicif(:,:)
+            frld = MIN( MAX( frld(:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp)
             pfrld = MIN( MAX( pfrld(:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp)
             fr_i(:,:) = 1.0_wp - frld(:,:)        ! adjust ice fraction
+            !
             zseaicendg(:,:) = zofrld(:,:) - frld(:,:)   ! find out actual sea ice nudge applied
+            !
+            zseaicendg(:,:)=zofrld(:,:) - frld(:,:)         ! find out actual sea ice nudge applied
             ! Nudge sea ice depth to bring it up to a required minimum depth
             WHERE( zseaicendg(:,:) > 0.0_wp .AND. hicif(:,:) < zhicifmin )
                zhicifinc(:,:) = (zhicifmin - hicif(:,:)) * zincwgt
 …
                zhicifinc(:,:) = 0.0_wp
             END WHERE
+            !
+            ! nudge ice depth
+            hicif (:,:) = hicif (:,:) + zhicifinc(:,:)
+            phicif(:,:) = phicif(:,:) + zhicifinc(:,:)
+            !
+            ! seaice salinity balancing (to add)
+! nudge ice depth
+            hicif(:,:)=hicif(:,:) + zhicifinc(:,:)
+            phicif(:,:)=phicif(:,:) + zhicifinc(:,:)
+! seaice salinity balancing (to add)
 #endif
 #if defined key_cice
+            ! Sea-ice : CICE case. Pass ice increment tendency into CICE
+! Pass ice increment tendency into CICE
             ndaice_da(:,:) = seaice_bkginc(:,:) * zincwgt / rdt
 #endif
 …
 #if defined key_cice
+            ! Sea-ice : CICE case. Zero ice increment tendency into CICE
+! Zero ice increment tendency into CICE
             ndaice_da(:,:) = 0.0_wp
 #endif
 …
             neuler = 0                    ! Force Euler forward step
-            ! Sea-ice : LIM-3 case (to add)
 #if defined key_lim2
+            ! Sea-ice : LIM-2 case.
             zofrld(:,:)=frld(:,:)
             zohicif(:,:)=hicif(:,:)
+            !
             ! Initialize the now fields the background + increment
+            frld (:,:) = MIN( MAX( frld(:,:) - seaice_bkginc(:,:), 0.0_wp), 1.0_wp)
+            frld(:,:) = MIN( MAX( frld(:,:) - seaice_bkginc(:,:), 0.0_wp), 1.0_wp)
             pfrld(:,:) = frld(:,:)
+            fr_i (:,:) = 1.0_wp - frld(:,:)                ! adjust ice fraction
+            zseaicendg(:,:) = zofrld(:,:) - frld(:,:)      ! find out actual sea ice nudge applied
+            !
+            fr_i(:,:) = 1.0_wp - frld(:,:)        ! adjust ice fraction
+            zseaicendg(:,:)=zofrld(:,:) - frld(:,:)         ! find out actual sea ice nudge applied
             ! Nudge sea ice depth to bring it up to a required minimum depth
             WHERE( zseaicendg(:,:) > 0.0_wp .AND. hicif(:,:) < zhicifmin )
                zhicifinc(:,:) = (zhicifmin - hicif(:,:)) * zincwgt
 …
                zhicifinc(:,:) = 0.0_wp
             END WHERE
+            !
+            ! nudge ice depth
+            hicif (:,:) = hicif (:,:) + zhicifinc(:,:)
+            phicif(:,:) = phicif(:,:)
+            !
+            ! seaice salinity balancing (to add)
+! nudge ice depth
+            hicif(:,:)=hicif(:,:) + zhicifinc(:,:)
+            phicif(:,:)=phicif(:,:)
+! seaice salinity balancing (to add)
 #endif
 #if defined key_cice
+            ! Sea-ice : CICE case. Pass ice increment tendency into CICE - is this correct?
+! Pass ice increment tendency into CICE - is this correct?
            ndaice_da(:,:) = seaice_bkginc(:,:) / rdt
 #endif
            IF ( .NOT. PRESENT(kindic) ) THEN
 …
 #if defined key_cice
+            ! Sea-ice : CICE case. Zero ice increment tendency into CICE
+! Zero ice increment tendency into CICE
             ndaice_da(:,:) = 0.0_wp
 #endif
          ENDIF
 !#if defined defined key_lim2 || defined key_cice
+!#if defined key_lim2 || defined key_cice
+!
 !            IF (ln_seaicebal ) THEN
 …
 !#endif
       ENDIF
    END SUBROUTINE seaice_asm_inc
    !!======================================================================
 END MODULE asminc

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90

-                      r3651
+                      r6736
       INTEGER, POINTER, DIMENSION(:,:)   ::  nbmap
       REAL   , POINTER, DIMENSION(:,:)   ::  nbw
       REAL   , POINTER, DIMENSION(:,:)   ::  nbd
+      REAL   , POINTER, DIMENSION(:,:,:)   ::  nbz
       REAL   , POINTER, DIMENSION(:)     ::  flagu
       REAL   , POINTER, DIMENSION(:)     ::  flagv
 …
       REAL, POINTER, DIMENSION(:)     ::  hsnif
 #endif
    END TYPE OBC_DATA
+   END TYPE OBC_DATA
    !!----------------------------------------------------------------------
 …
    INTEGER, DIMENSION(jp_bdy) ::   nn_tra_dta             !: = 0 use the initial state as bdy dta ;
                                                             !: = 1 read it in a NetCDF file
+   LOGICAL, DIMENSION(jp_bdy) ::   ln_tra_dmp               !: =T Tracer damping
+   LOGICAL, DIMENSION(jp_bdy) ::   ln_dyn3d_dmp             !: =T Baroclinic velocity damping
+   REAL,    DIMENSION(jp_bdy) ::   rn_time_dmp              !: Damping time scale in days
+   INTEGER                    ::   nb_jpk              ! Number of levels in the bdy data (set < 0 if consistent with planned run)
 #if defined key_lim2
    INTEGER, DIMENSION(jp_bdy) ::   nn_ice_lim2              ! Choice of boundary condition for sea ice variables
 …
    INTEGER,  DIMENSION(jp_bdy)                     ::   nn_dta            !: =0 => *all* data is set to initial conditions
                                                                           !: =1 => some data to be read in from data files
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global        !: workspace for reading in global data arrays (unstr.  bdy)
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global2       !: workspace for reading in global data arrays (struct. bdy)
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global        !: workspace for reading in global data arrays
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global_1      !: workspace for reading in global data arrays
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:  ), TARGET ::   dta_global_2      !: workspace for reading in global data arrays
    TYPE(OBC_INDEX), DIMENSION(jp_bdy), TARGET      ::   idx_bdy           !: bdy indices (local process)
    TYPE(OBC_DATA) , DIMENSION(jp_bdy)              ::   dta_bdy           !: bdy external data (local process)

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90

-                      r3851
+                      r6736
    !!            3.3  !  2010-09  (D.Storkey) add ice boundary conditions
    !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge
+   !!            3.4  !  2013-04  (J. Harle) add in option to read bdy data with
+   !!                                        different vertical coordinates
    !!----------------------------------------------------------------------
 #if defined key_bdy
 …
    USE ice_2
 #endif
-   USE sbcapr
    IMPLICIT NONE
 …
             IF( nn_dyn2d(ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .eq. 0 ) THEN
+               ilen1(:) = nblen(:)
+               IF( nn_dyn2d(ib_bdy) .eq. jp_frs ) THEN
+                  ilen1(:) = nblen(:)
+               ELSE
+                  ilen1(:) = nblenrim(:)
+               ENDIF
                igrd = 1
                DO ib = 1, ilen1(igrd)
 …
             IF( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN
+               ilen1(:) = nblen(:)
+               IF( nn_dyn3d(ib_bdy) .eq. jp_frs ) THEN
+                  ilen1(:) = nblen(:)
+               ELSE
+                  ilen1(:) = nblenrim(:)
+               ENDIF
                igrd = 2
                DO ib = 1, ilen1(igrd)
 …
             IF( nn_tra(ib_bdy) .gt. 0 .and. nn_tra_dta(ib_bdy) .eq. 0 ) THEN
+               ilen1(:) = nblen(:)
+               IF( nn_tra(ib_bdy) .eq. jp_frs ) THEN
+                  ilen1(:) = nblen(:)
+               ELSE
+                  ilen1(:) = nblenrim(:)
+               ENDIF
                igrd = 1                       ! Everything is at T-points here
                DO ib = 1, ilen1(igrd)
 …
 #if defined key_lim2
             IF( nn_ice_lim2(ib_bdy) .gt. 0 .and. nn_ice_lim2_dta(ib_bdy) .eq. 0 ) THEN
+               ilen1(:) = nblen(:)
+               IF( nn_ice_lim2(ib_bdy) .eq. jp_frs ) THEN
+                  ilen1(:) = nblen(:)
+               ELSE
+                  ilen1(:) = nblenrim(:)
+               ENDIF
                igrd = 1                       ! Everything is at T-points here
                DO ib = 1, ilen1(igrd)
 …
             IF( PRESENT(jit) ) THEN
                ! Update barotropic boundary conditions only
                ! jit is optional argument for fld_read and bdytide_update
+               ! jit is optional argument for fld_read and tide_update
                IF( nn_dyn2d(ib_bdy) .gt. 0 ) THEN
                   IF( nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays
 …
                      dta_bdy(ib_bdy)%v2d(:) = 0.0
                   ENDIF
+                  IF (nn_tra(ib_bdy).ne.4) THEN
+                     IF( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 .OR.  &
+                       & (ln_full_vel_array(ib_bdy) .AND. nn_dyn3d_dta(ib_bdy).eq.1) )THEN
+                        ! For the runoff case, no need to update the forcing (already done in the baroclinic part)
+                        jend = nb_bdy_fld(ib_bdy)
+                        IF ( nn_tra(ib_bdy) .GT. 0 .AND. nn_tra_dta(ib_bdy) .GE. 1 ) jend = jend - 2
+                        CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend),  &
+                                     & kit=jit, kt_offset=time_offset )
+                        IF ( nn_tra(ib_bdy) .GT. 0 .AND. nn_tra_dta(ib_bdy) .GE. 1 ) jend = jend + 2
+                        ! If full velocities in boundary data then split into barotropic and baroclinic data
+                        IF( ln_full_vel_array(ib_bdy) .AND.                                             &
+                          &    ( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 .OR.  &
+                          &      nn_dyn3d_dta(ib_bdy) .EQ. 1 ) )THEN
+                           igrd = 2                      ! zonal velocity
+                           dta_bdy(ib_bdy)%u2d(:) = 0.0
+                           DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
+                              ii   = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                              ij   = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                              DO ik = 1, jpkm1
+                                 dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) &
+                       &                          + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta_bdy(ib_bdy)%u3d(ib,ik)
+                              END DO
+                              dta_bdy(ib_bdy)%u2d(ib) =  dta_bdy(ib_bdy)%u2d(ib) * hur(ii,ij)
+                              DO ik = 1, jpkm1
+                                 dta_bdy(ib_bdy)%u3d(ib,ik) = dta_bdy(ib_bdy)%u3d(ib,ik) - dta_bdy(ib_bdy)%u2d(ib)
+                              END DO
+                           END DO
+                           igrd = 3                      ! meridional velocity
+                           dta_bdy(ib_bdy)%v2d(:) = 0.0
+                           DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
+                              ii   = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                              ij   = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                              DO ik = 1, jpkm1
+                                 dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) &
+                       &                       + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta_bdy(ib_bdy)%v3d(ib,ik)
+                              END DO
+                              dta_bdy(ib_bdy)%v2d(ib) =  dta_bdy(ib_bdy)%v2d(ib) * hvr(ii,ij)
+                              DO ik = 1, jpkm1
+                                 dta_bdy(ib_bdy)%v3d(ib,ik) = dta_bdy(ib_bdy)%v3d(ib,ik) - dta_bdy(ib_bdy)%v2d(ib)
+                              END DO
+                           END DO
+                        ENDIF
+                     ENDIF
+                     IF( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN ! update tidal harmonic forcing
+                        CALL bdytide_update( kt=kt, idx=idx_bdy(ib_bdy), dta=dta_bdy(ib_bdy), td=tides(ib_bdy),   &
+                          &                 jit=jit, time_offset=time_offset )
+                     ENDIF
+                  IF( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) THEN ! update external data
+                     jend = jstart + 2
+                     CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend),   &
+                     &              jit=jit, time_offset=time_offset )
                   ENDIF
+                  IF( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN ! update tidal harmonic forcing
+                     CALL tide_update( kt=kt, idx=idx_bdy(ib_bdy), dta=dta_bdy(ib_bdy), td=tides(ib_bdy),   &
+                     &                 jit=jit, time_offset=time_offset )
+                  ENDIF
                ENDIF
             ELSE
+               IF (nn_tra(ib_bdy).eq.4) then      ! runoff condition
+                  jend = nb_bdy_fld(ib_bdy)
+                  CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend),  &
+                               & map=nbmap_ptr(jstart:jend), kt_offset=time_offset )
+                  !
+                  igrd = 2                      ! zonal velocity
+                  DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
+                     ii   = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                     ij   = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                     dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) )
+               IF( nn_dyn2d(ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays
+                  dta_bdy(ib_bdy)%ssh(:) = 0.0
+                  dta_bdy(ib_bdy)%u2d(:) = 0.0
+                  dta_bdy(ib_bdy)%v2d(:) = 0.0
+               ENDIF
+               IF( nb_bdy_fld(ib_bdy) .gt. 0 ) THEN ! update external data
+                  jend = jstart + nb_bdy_fld(ib_bdy) - 1
+                  CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend), time_offset=time_offset,&
+                &                                                                                          jpk_1=nb_jpk )
+               ENDIF
+               IF( nn_dyn2d(ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN ! update tidal harmonic forcing
+                  CALL tide_update( kt=kt, idx=idx_bdy(ib_bdy), dta=dta_bdy(ib_bdy), td=tides(ib_bdy), time_offset=time_offset )
+               ENDIF
+            ENDIF
+            jstart = jend+1
+            ! If full velocities in boundary data then split into barotropic and baroclinic data
+            ! (Note that we have already made sure that you can't use ln_full_vel = .true. at the same
+            ! time as the dynspg_ts option).
+            IF( ln_full_vel_array(ib_bdy) .and.                                             &
+           &    ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 .or. nn_dyn3d_dta(ib_bdy) .eq. 1 ) ) THEN
+               igrd = 2                      ! zonal velocity
+               dta_bdy(ib_bdy)%u2d(:) = 0.0
+               DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
+                  ii   = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                  ij   = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                  DO ik = 1, jpkm1
+                     dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) &
+              &                                + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta_bdy(ib_bdy)%u3d(ib,ik)
                   END DO
+                  !
+                  igrd = 3                      ! meridional velocity
+                  DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
+                     ii   = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                     ij   = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                     dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) )
+                  dta_bdy(ib_bdy)%u2d(ib) =  dta_bdy(ib_bdy)%u2d(ib) * hur(ii,ij)
+                  DO ik = 1, jpkm1
+                     dta_bdy(ib_bdy)%u3d(ib,ik) = dta_bdy(ib_bdy)%u3d(ib,ik) - dta_bdy(ib_bdy)%u2d(ib)
                   END DO
+               ELSE
+                  IF( nn_dyn2d(ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays
+                     dta_bdy(ib_bdy)%ssh(:) = 0.0
+                     dta_bdy(ib_bdy)%u2d(:) = 0.0
+                     dta_bdy(ib_bdy)%v2d(:) = 0.0
+                  ENDIF
+                  IF( nb_bdy_fld(ib_bdy) .gt. 0 ) THEN ! update external data
+                     jend = nb_bdy_fld(ib_bdy)
+                     CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), &
+                                  & map=nbmap_ptr(jstart:jend), kt_offset=time_offset )
+                  ENDIF
+                  ! If full velocities in boundary data then split into barotropic and baroclinic data
+                  IF( ln_full_vel_array(ib_bdy) .and.                                             &
+                    & ( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 .OR. &
+                    &   nn_dyn3d_dta(ib_bdy) .EQ. 1 ) ) THEN
+                     igrd = 2                      ! zonal velocity
+                     dta_bdy(ib_bdy)%u2d(:) = 0.0
+                     DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
+                        ii   = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                        ij   = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                        DO ik = 1, jpkm1
+                           dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) &
+                 &                       + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta_bdy(ib_bdy)%u3d(ib,ik)
+                        END DO
+                        dta_bdy(ib_bdy)%u2d(ib) =  dta_bdy(ib_bdy)%u2d(ib) * hur(ii,ij)
+                        DO ik = 1, jpkm1
+                           dta_bdy(ib_bdy)%u3d(ib,ik) = dta_bdy(ib_bdy)%u3d(ib,ik) - dta_bdy(ib_bdy)%u2d(ib)
+                        END DO
+                     END DO
+                     igrd = 3                      ! meridional velocity
+                     dta_bdy(ib_bdy)%v2d(:) = 0.0
+                     DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
+                        ii   = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                        ij   = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                        DO ik = 1, jpkm1
+                           dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) &
+                 &                       + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta_bdy(ib_bdy)%v3d(ib,ik)
+                        END DO
+                        dta_bdy(ib_bdy)%v2d(ib) =  dta_bdy(ib_bdy)%v2d(ib) * hvr(ii,ij)
+                        DO ik = 1, jpkm1
+                           dta_bdy(ib_bdy)%v3d(ib,ik) = dta_bdy(ib_bdy)%v3d(ib,ik) - dta_bdy(ib_bdy)%v2d(ib)
+                        END DO
+                     END DO
+                  ENDIF
+                  IF( nn_dyn2d(ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN ! update tidal harmonic forcing
+                     CALL bdytide_update( kt=kt, idx=idx_bdy(ib_bdy), dta=dta_bdy(ib_bdy),  &
+                                        & td=tides(ib_bdy), time_offset=time_offset )
+                  ENDIF
+               ENDIF
+            ENDIF
+            jstart = jend+1
+               END DO
+               igrd = 3                      ! meridional velocity
+               dta_bdy(ib_bdy)%v2d(:) = 0.0
+               DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
+                  ii   = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                  ij   = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                  DO ik = 1, jpkm1
+                     dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) &
+              &                                + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta_bdy(ib_bdy)%v3d(ib,ik)
+                  END DO
+                  dta_bdy(ib_bdy)%v2d(ib) =  dta_bdy(ib_bdy)%v2d(ib) * hvr(ii,ij)
+                  DO ik = 1, jpkm1
+                     dta_bdy(ib_bdy)%v3d(ib,ik) = dta_bdy(ib_bdy)%v3d(ib,ik) - dta_bdy(ib_bdy)%v2d(ib)
+                  END DO
+               END DO
+            ENDIF
          END IF ! nn_dta(ib_bdy) = 1
       END DO  ! ib_bdy
-      IF ( ln_apr_obc ) THEN
-         DO ib_bdy = 1, nb_bdy
-            IF (nn_tra(ib_bdy).NE.4)THEN
-               igrd = 1                      ! meridional velocity
-               DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)
-                  ii   = idx_bdy(ib_bdy)%nbi(ib,igrd)
-                  ij   = idx_bdy(ib_bdy)%nbj(ib,igrd)
-                  dta_bdy(ib_bdy)%ssh(ib) = dta_bdy(ib_bdy)%ssh(ib) + ssh_ib(ii,ij)
-               ENDDO
-            ENDIF
-         ENDDO
-      ENDIF
       IF( nn_timing == 1 ) CALL timing_stop('bdy_dta')
 …
       IF( nn_timing == 1 ) CALL timing_start('bdy_dta_init')
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'bdy_dta_ini : initialization of data at the open boundaries'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
-      IF(lwp) WRITE(numout,*) ''
       ! Set nn_dta
       DO ib_bdy = 1, nb_bdy
 …
          ENDIF
 #endif
-         IF(lwp) WRITE(numout,*) 'Maximum number of files to open =',nb_bdy_fld(ib_bdy)
       ENDDO
 …
             ln_full_vel_array(ib_bdy) = ln_full_vel
+            IF( ln_full_vel_array(ib_bdy) .and. lk_dynspg_ts )  THEN
+               CALL ctl_stop( 'bdy_dta_init: ERROR, cannot specify full velocities in boundary data',&
+            &                  'with dynspg_ts option' )   ;   RETURN
+            ENDIF
             nblen => idx_bdy(ib_bdy)%nblen
             nblenrim => idx_bdy(ib_bdy)%nblenrim
 …
             IF( nn_dyn2d(ib_bdy) .gt. 0 .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) THEN
                IF( nn_tra(ib_bdy) .ne. 4 ) THEN ! runoff condition : no ssh reading
+               IF( nn_dyn2d(ib_bdy) .ne. jp_frs ) THEN
                   jfld = jfld + 1
                   blf_i(jfld) = bn_ssh
                   ibdy(jfld) = ib_bdy
                   igrid(jfld) = 1
                   ilen1(jfld) = nblen(igrid(jfld))
+                  ilen1(jfld) = nblenrim(igrid(jfld))
                   ilen3(jfld) = 1
                ENDIF
                IF( .not. ln_full_vel_array(ib_bdy) ) THEN
                   jfld = jfld + 1
                   blf_i(jfld) = bn_u2d
                   ibdy(jfld) = ib_bdy
                   igrid(jfld) = 2
+                  ilen1(jfld) = nblen(igrid(jfld))
+                  IF( nn_dyn2d(ib_bdy) .eq. jp_frs ) THEN
+                     ilen1(jfld) = nblen(igrid(jfld))
+                  ELSE
+                     ilen1(jfld) = nblenrim(igrid(jfld))
+                  ENDIF
                   ilen3(jfld) = 1
 …
                   ibdy(jfld) = ib_bdy
                   igrid(jfld) = 3
+                  ilen1(jfld) = nblen(igrid(jfld))
+                  IF( nn_dyn2d(ib_bdy) .eq. jp_frs ) THEN
+                     ilen1(jfld) = nblen(igrid(jfld))
+                  ELSE
+                     ilen1(jfld) = nblenrim(igrid(jfld))
+                  ENDIF
                   ilen3(jfld) = 1
                ENDIF
 …
                ibdy(jfld) = ib_bdy
                igrid(jfld) = 2
+               ilen1(jfld) = nblen(igrid(jfld))
+               IF( nn_dyn3d(ib_bdy) .eq. jp_frs ) THEN
+                  ilen1(jfld) = nblen(igrid(jfld))
+               ELSE
+                  ilen1(jfld) = nblenrim(igrid(jfld))
+               ENDIF
                ilen3(jfld) = jpk
 …
                ibdy(jfld) = ib_bdy
                igrid(jfld) = 3
+               ilen1(jfld) = nblen(igrid(jfld))
+               IF( nn_dyn3d(ib_bdy) .eq. jp_frs ) THEN
+                  ilen1(jfld) = nblen(igrid(jfld))
+               ELSE
+                  ilen1(jfld) = nblenrim(igrid(jfld))
+               ENDIF
                ilen3(jfld) = jpk
 …
                ibdy(jfld) = ib_bdy
                igrid(jfld) = 1
+               ilen1(jfld) = nblen(igrid(jfld))
+               IF( nn_tra(ib_bdy) .eq. jp_frs ) THEN
+                  ilen1(jfld) = nblen(igrid(jfld))
+               ELSE
+                  ilen1(jfld) = nblenrim(igrid(jfld))
+               ENDIF
                ilen3(jfld) = jpk
 …
                ibdy(jfld) = ib_bdy
                igrid(jfld) = 1
+               ilen1(jfld) = nblen(igrid(jfld))
+               IF( nn_tra(ib_bdy) .eq. jp_frs ) THEN
+                  ilen1(jfld) = nblen(igrid(jfld))
+               ELSE
+                  ilen1(jfld) = nblenrim(igrid(jfld))
+               ENDIF
                ilen3(jfld) = jpk
 …
                ibdy(jfld) = ib_bdy
                igrid(jfld) = 1
+               ilen1(jfld) = nblen(igrid(jfld))
+               IF( nn_ice_lim2(ib_bdy) .eq. jp_frs ) THEN
+                  ilen1(jfld) = nblen(igrid(jfld))
+               ELSE
+                  ilen1(jfld) = nblenrim(igrid(jfld))
+               ENDIF
                ilen3(jfld) = 1
 …
                ibdy(jfld) = ib_bdy
                igrid(jfld) = 1
+               ilen1(jfld) = nblen(igrid(jfld))
+               IF( nn_ice_lim2(ib_bdy) .eq. jp_frs ) THEN
+                  ilen1(jfld) = nblen(igrid(jfld))
+               ELSE
+                  ilen1(jfld) = nblenrim(igrid(jfld))
+               ENDIF
                ilen3(jfld) = 1
 …
                ibdy(jfld) = ib_bdy
                igrid(jfld) = 1
+               ilen1(jfld) = nblen(igrid(jfld))
+               IF( nn_ice_lim2(ib_bdy) .eq. jp_frs ) THEN
+                  ilen1(jfld) = nblen(igrid(jfld))
+               ELSE
+                  ilen1(jfld) = nblenrim(igrid(jfld))
+               ENDIF
                ilen3(jfld) = 1
 …
       ENDDO ! ib_bdy
       DO jfld = 1, nb_bdy_fld_sum
          ALLOCATE( bf(jfld)%fnow(ilen1(jfld),1,ilen3(jfld)) )
 …
       jstart = 1
       DO ib_bdy = 1, nb_bdy
          jend = nb_bdy_fld(ib_bdy)
+         jend = jstart + nb_bdy_fld(ib_bdy) - 1
          CALL fld_fill( bf(jstart:jend), blf_i(jstart:jend), cn_dir_array(ib_bdy), 'bdy_dta',   &
          &              'open boundary conditions', 'nambdy_dta' )
 …
          IF (nn_dyn2d(ib_bdy) .gt. 0) THEN
             IF( nn_dyn2d_dta(ib_bdy) .eq. 0 .or. nn_dyn2d_dta(ib_bdy) .eq. 2 .or. ln_full_vel_array(ib_bdy) ) THEN
+               ilen0(1:3) = nblen(1:3)
+               IF( nn_dyn2d(ib_bdy) .eq. jp_frs ) THEN
+                  ilen0(1:3) = nblen(1:3)
+               ELSE
+                  ilen0(1:3) = nblenrim(1:3)
+               ENDIF
+               ALLOCATE( dta_bdy(ib_bdy)%ssh(ilen0(1)) )
                ALLOCATE( dta_bdy(ib_bdy)%u2d(ilen0(2)) )
                ALLOCATE( dta_bdy(ib_bdy)%v2d(ilen0(3)) )
-               IF (nn_dyn2d_dta(ib_bdy).eq.1.or.nn_dyn2d_dta(ib_bdy).eq.3) THEN
-                  jfld = jfld + 1
-                  dta_bdy(ib_bdy)%ssh => bf(jfld)%fnow(:,1,1)
-               ELSE
-                  ALLOCATE( dta_bdy(ib_bdy)%ssh(nblen(1)) )
-               ENDIF
             ELSE
                IF( nn_dyn2d(ib_bdy) .ne. jp_frs ) THEN
 …
          IF ( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN
+            ilen0(1:3) = nblen(1:3)
+            IF( nn_dyn3d(ib_bdy) .eq. jp_frs ) THEN
+               ilen0(1:3) = nblen(1:3)
+            ELSE
+               ilen0(1:3) = nblenrim(1:3)
+            ENDIF
             ALLOCATE( dta_bdy(ib_bdy)%u3d(ilen0(2),jpk) )
             ALLOCATE( dta_bdy(ib_bdy)%v3d(ilen0(3),jpk) )
 …
          IF (nn_tra(ib_bdy) .gt. 0) THEN
             IF( nn_tra_dta(ib_bdy) .eq. 0 ) THEN
+               ilen0(1:3) = nblen(1:3)
+               IF( nn_tra(ib_bdy) .eq. jp_frs ) THEN
+                  ilen0(1:3) = nblen(1:3)
+               ELSE
+                  ilen0(1:3) = nblenrim(1:3)
+               ENDIF
                ALLOCATE( dta_bdy(ib_bdy)%tem(ilen0(1),jpk) )
                ALLOCATE( dta_bdy(ib_bdy)%sal(ilen0(1),jpk) )
 …
          IF (nn_ice_lim2(ib_bdy) .gt. 0) THEN
             IF( nn_ice_lim2_dta(ib_bdy) .eq. 0 ) THEN
+               ilen0(1:3) = nblen(1:3)
+               IF( nn_ice_lim2(ib_bdy) .eq. jp_frs ) THEN
+                  ilen0(1:3) = nblen(1:3)
+               ELSE
+                  ilen0(1:3) = nblenrim(1:3)
+               ENDIF
                ALLOCATE( dta_bdy(ib_bdy)%frld(ilen0(1)) )
                ALLOCATE( dta_bdy(ib_bdy)%hicif(ilen0(1)) )

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90

-                      r3680
+                      r6736
    !!======================================================================
    !! History :  3.4  !  2011     (D. Storkey) new module as part of BDY rewrite
-   !!            3.5  !  2012     (S. Mocavero, I. Epicoco) Optimization of BDY communications
    !!----------------------------------------------------------------------
 #if defined key_bdy
 …
             CYCLE
          CASE(jp_frs)
             CALL bdy_dyn2d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy )
+            CALL bdy_dyn2d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy) )
          CASE(jp_flather)
             CALL bdy_dyn2d_fla( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy )
+            CALL bdy_dyn2d_fla( idx_bdy(ib_bdy), dta_bdy(ib_bdy) )
          CASE DEFAULT
             CALL ctl_stop( 'bdy_dyn2d : unrecognised option for open boundaries for barotropic variables' )
 …
    END SUBROUTINE bdy_dyn2d
    SUBROUTINE bdy_dyn2d_frs( idx, dta, ib_bdy )
+   SUBROUTINE bdy_dyn2d_frs( idx, dta )
       !!----------------------------------------------------------------------
       !!                  ***  SUBROUTINE bdy_dyn2d_frs  ***
 …
       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
 …
          pv2d(ii,ij) = ( pv2d(ii,ij) + zwgt * ( dta%v2d(jb) - pv2d(ii,ij) ) ) * vmask(ii,ij,1)
       END DO
       CALL lbc_bdy_lnk( pu2d, 'U', -1., ib_bdy )
       CALL lbc_bdy_lnk( pv2d, 'V', -1., ib_bdy)   ! Boundary points should be updated
+      CALL lbc_lnk( pu2d, 'U', -1. )
+      CALL lbc_lnk( pv2d, 'V', -1. )   ! Boundary points should be updated
+      !
       IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn2d_frs')
 …
    SUBROUTINE bdy_dyn2d_fla( idx, dta, ib_bdy )
+   SUBROUTINE bdy_dyn2d_fla( idx, dta )
       !!----------------------------------------------------------------------
       !!                 ***  SUBROUTINE bdy_dyn2d_fla  ***
 …
       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, igrd                         ! dummy loop indices
 …
          pv2d(ii,ij) = zforc + zcorr * vmask(ii,ij,1)
       END DO
       CALL lbc_bdy_lnk( pu2d, 'U', -1., ib_bdy )   ! Boundary points should be updated
       CALL lbc_bdy_lnk( pv2d, 'V', -1., ib_bdy )   !
+      CALL lbc_lnk( pu2d, 'U', -1. )   ! Boundary points should be updated
+      CALL lbc_lnk( pv2d, 'V', -1. )   !
+      !
       IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn2d_fla')

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90

-                      r3703
+                      r6736
    !!======================================================================
    !! History :  3.4  !  2011     (D. Storkey) new module as part of BDY rewrite
-   !!            3.5  !  2012     (S. Mocavero, I. Epicoco) Optimization of BDY communications
    !!----------------------------------------------------------------------
 #if defined key_bdy
 …
    !!----------------------------------------------------------------------
    USE timing          ! Timing
-   USE wrk_nemo        ! Memory Allocation
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
 …
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE in_out_manager  !
-   Use phycst
    IMPLICIT NONE
 …
    PUBLIC   bdy_dyn3d     ! routine called by bdy_dyn
-   PUBLIC   bdy_dyn3d_dmp ! routine called by step
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
 …
             CYCLE
          CASE(jp_frs)
+            CALL bdy_dyn3d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )
+         CASE(2)
+            CALL bdy_dyn3d_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )
+         CASE(3)
+            CALL bdy_dyn3d_zro( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )
+            CALL bdy_dyn3d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt )
          CASE DEFAULT
             CALL ctl_stop( 'bdy_dyn3d : unrecognised option for open boundaries for baroclinic velocities' )
 …
    END SUBROUTINE bdy_dyn3d
+   SUBROUTINE bdy_dyn3d_spe( idx, dta, kt , ib_bdy )
+      !!----------------------------------------------------------------------
+      !!                  ***  SUBROUTINE bdy_dyn3d_spe  ***
+      !!
+      !! ** Purpose : - Apply a specified value for baroclinic velocities
+      !!                at open boundaries.
+      !!
+      !!----------------------------------------------------------------------
+      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
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_spe')
+      !
+      igrd = 2                      ! Relaxation of zonal velocity
+      DO jb = 1, idx%nblenrim(igrd)
+         DO jk = 1, jpkm1
+            ii   = idx%nbi(jb,igrd)
+            ij   = idx%nbj(jb,igrd)
+            ua(ii,ij,jk) = dta%u3d(jb,jk) * umask(ii,ij,jk)
+         END DO
+      END DO
+      !
+      igrd = 3                      ! Relaxation of meridional velocity
+      DO jb = 1, idx%nblenrim(igrd)
+         DO jk = 1, jpkm1
+            ii   = idx%nbi(jb,igrd)
+            ij   = idx%nbj(jb,igrd)
+            va(ii,ij,jk) = dta%v3d(jb,jk) * vmask(ii,ij,jk)
+         END DO
+      END DO
+      CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )   ;   CALL lbc_bdy_lnk( va, 'V', -1.,ib_bdy )   ! Boundary points should be updated
+      !
+      IF( kt .eq. nit000 ) CLOSE( unit = 102 )
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_spe')
+   END SUBROUTINE bdy_dyn3d_spe
+   SUBROUTINE bdy_dyn3d_zro( idx, dta, kt, ib_bdy )
+      !!----------------------------------------------------------------------
+      !!                  ***  SUBROUTINE bdy_dyn3d_zro  ***
+      !!
+      !! ** Purpose : - baroclinic velocities = 0. at open boundaries.
+      !!
+      !!----------------------------------------------------------------------
+      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  ::   ib, ik         ! dummy loop indices
+      INTEGER  ::   ii, ij, igrd, zcoef   ! local integers
+      REAL(wp) ::   zwgt           ! boundary weight
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_zro')
+      !
+      igrd = 2                       ! Everything is at T-points here
+      DO ib = 1, idx%nblenrim(igrd)
+         ii = idx%nbi(ib,igrd)
+         ij = idx%nbj(ib,igrd)
+         DO ik = 1, jpkm1
+            ua(ii,ij,ik) = 0._wp
+         END DO
+      END DO
+      igrd = 3                       ! Everything is at T-points here
+      DO ib = 1, idx%nblenrim(igrd)
+         ii = idx%nbi(ib,igrd)
+         ij = idx%nbj(ib,igrd)
+         DO ik = 1, jpkm1
+            va(ii,ij,ik) = 0._wp
+         END DO
+      END DO
+      !
+      CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )   ;   CALL lbc_bdy_lnk( va, 'V', -1.,ib_bdy )   ! Boundary points should be updated
+      !
+      IF( kt .eq. nit000 ) CLOSE( unit = 102 )
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_zro')
+   END SUBROUTINE bdy_dyn3d_zro
+   SUBROUTINE bdy_dyn3d_frs( idx, dta, kt, ib_bdy )
+   SUBROUTINE bdy_dyn3d_frs( idx, dta, kt )
       !!----------------------------------------------------------------------
       !!                  ***  SUBROUTINE bdy_dyn3d_frs  ***
 …
       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
 …
          END DO
       END DO
       CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )   ;   CALL lbc_bdy_lnk( va, 'V', -1.,ib_bdy )   ! Boundary points should be updated
+      CALL lbc_lnk( ua, 'U', -1. )   ;   CALL lbc_lnk( va, 'V', -1. )   ! Boundary points should be updated
+      !
       IF( kt .eq. nit000 ) CLOSE( unit = 102 )
 …
    END SUBROUTINE bdy_dyn3d_frs
-   SUBROUTINE bdy_dyn3d_dmp( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  SUBROUTINE bdy_dyn3d_dmp  ***
-      !!
-      !! ** Purpose : Apply damping for baroclinic velocities at open boundaries.
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER                     ::   kt
-      !!
-      INTEGER  ::   jb, jk         ! dummy loop indices
-      INTEGER  ::   ii, ij, igrd   ! local integers
-      REAL(wp) ::   zwgt           ! boundary weight
-      INTEGER  ::  ib_bdy          ! loop index
-      !!----------------------------------------------------------------------
+      !
-      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_dmp')
+      !
-      !-------------------------------------------------------
-      ! Remove barotropic part from before velocity
-      !-------------------------------------------------------
-      CALL wrk_alloc(jpi,jpj,pu2d,pv2d)
-      pu2d(:,:) = 0.e0
-      pv2d(:,:) = 0.e0
-      DO jk = 1, jpkm1
-#if defined key_vvl
-         pu2d(:,:) = pu2d(:,:) + fse3u_b(:,:,jk)* ub(:,:,jk)   *umask(:,:,jk)
-         pv2d(:,:) = pv2d(:,:) + fse3v_b(:,:,jk)* vb(:,:,jk)   *vmask(:,:,jk)
-#else
-         pu2d(:,:) = pu2d(:,:) + fse3u_0(:,:,jk) * ub(:,:,jk)  * umask(:,:,jk)
-         pv2d(:,:) = pv2d(:,:) + fse3v_0(:,:,jk) * vb(:,:,jk)  * vmask(:,:,jk)
-#endif
-      END DO
-      IF( lk_vvl ) THEN
-         pu2d(:,:) = pu2d(:,:) * umask(:,:,1) / ( hu_0(:,:) + sshu_b(:,:) + 1._wp - umask(:,:,1) )
-         pv2d(:,:) = pv2d(:,:) * vmask(:,:,1) / ( hv_0(:,:) + sshv_b(:,:) + 1._wp - vmask(:,:,1) )
-      ELSE
-         pu2d(:,:) = pv2d(:,:) * hur(:,:)
-         pv2d(:,:) = pu2d(:,:) * hvr(:,:)
-      ENDIF
-      DO ib_bdy=1, nb_bdy
-         IF ( ln_dyn3d_dmp(ib_bdy).and.nn_dyn3d(ib_bdy).gt.0 ) THEN
-            igrd = 2                      ! Relaxation of zonal velocity
-            DO jb = 1, idx_bdy(ib_bdy)%nblen(igrd)
-               ii   = idx_bdy(ib_bdy)%nbi(jb,igrd)
-               ij   = idx_bdy(ib_bdy)%nbj(jb,igrd)
-               zwgt = idx_bdy(ib_bdy)%nbd(jb,igrd)
-               DO jk = 1, jpkm1
-                  ua(ii,ij,jk) = ( ua(ii,ij,jk) + zwgt * ( dta_bdy(ib_bdy)%u3d(jb,jk) - &
-                                   ub(ii,ij,jk) + pu2d(ii,ij)) ) * umask(ii,ij,jk)
-               END DO
-            END DO
+            !
-            igrd = 3                      ! Relaxation of meridional velocity
-            DO jb = 1, idx_bdy(ib_bdy)%nblen(igrd)
-               ii   = idx_bdy(ib_bdy)%nbi(jb,igrd)
-               ij   = idx_bdy(ib_bdy)%nbj(jb,igrd)
-               zwgt = idx_bdy(ib_bdy)%nbd(jb,igrd)
-               DO jk = 1, jpkm1
-                  va(ii,ij,jk) = ( va(ii,ij,jk) + zwgt * ( dta_bdy(ib_bdy)%v3d(jb,jk) -  &
-                                   vb(ii,ij,jk) + pv2d(ii,ij)) ) * vmask(ii,ij,jk)
-               END DO
-            END DO
-         ENDIF
-      ENDDO
+      !
-      CALL wrk_dealloc(jpi,jpj,pu2d,pv2d)
+      !
-      CALL lbc_lnk( ua, 'U', -1. )   ;   CALL lbc_lnk( va, 'V', -1. )   ! Boundary points should be updated
+      !
-      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_dmp')
-   END SUBROUTINE bdy_dyn3d_dmp
 #else
 …
 CONTAINS
    SUBROUTINE bdy_dyn3d( kt )      ! Empty routine
       WRITE(*,*) 'bdy_dyn3d: You should not have seen this print! error?', kt
+      WRITE(*,*) 'bdy_dyn_frs: You should not have seen this print! error?', kt
    END SUBROUTINE bdy_dyn3d
-   SUBROUTINE bdy_dyn3d_dmp( kt )      ! Empty routine
-      WRITE(*,*) 'bdy_dyn3d_dmp: You should not have seen this print! error?', kt
-   END SUBROUTINE bdy_dyn3d_dmp
 #endif

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim2.F90

-                      r3680
+                      r6736
    !!  History :  3.3  !  2010-09 (D. Storkey)  Original code
    !!             3.4  !  2011    (D. Storkey) rewrite in preparation for OBC-BDY merge
-   !!             3.5  !  2012    (S. Mocavero, I. Epicoco) Optimization of BDY communications
    !!----------------------------------------------------------------------
 #if defined   key_bdy   &&   defined key_lim2
 …
             CYCLE
          CASE(jp_frs)
             CALL bdy_ice_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy )
+            CALL bdy_ice_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy) )
          CASE DEFAULT
             CALL ctl_stop( 'bdy_ice_lim_2 : unrecognised option for open boundaries for ice fields' )
 …
    END SUBROUTINE bdy_ice_lim_2
    SUBROUTINE bdy_ice_frs( idx, dta, ib_bdy )
+   SUBROUTINE bdy_ice_frs( idx, dta )
       !!------------------------------------------------------------------------------
       !!                 ***  SUBROUTINE bdy_ice_frs  ***
 …
       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, jgrd   ! dummy loop indices
+      INTEGER  ::   jb, jgrd   ! dummy loop indices
       INTEGER  ::   ii, ij         ! local scalar
       REAL(wp) ::   zwgt, zwgt1    ! local scalar
 …
+      !
       DO jb = 1, idx%nblen(jgrd)
-         DO jk = 1, jpkm1
             ii    = idx%nbi(jb,jgrd)
             ij    = idx%nbj(jb,jgrd)
             zwgt  = idx%nbw(jb,jgrd)
             zwgt1 = 1.e0 - idx%nbw(jb,jgrd)
+#if defined key_lim2_iceconc
+            frld (ii,ij) = ( frld (ii,ij) * zwgt1 + ( 1._wp - dta%frld (jb) ) * zwgt ) * tmask(ii,ij,1)     ! Leads fraction from ice fraction
+#else
             frld (ii,ij) = ( frld (ii,ij) * zwgt1 + dta%frld (jb) * zwgt ) * tmask(ii,ij,1)     ! Leads fraction
+#endif
             hicif(ii,ij) = ( hicif(ii,ij) * zwgt1 + dta%hicif(jb) * zwgt ) * tmask(ii,ij,1)     ! Ice depth
             hsnif(ii,ij) = ( hsnif(ii,ij) * zwgt1 + dta%hsnif(jb) * zwgt ) * tmask(ii,ij,1)     ! Snow depth
-         END DO
       END DO
       CALL lbc_bdy_lnk( frld, 'T', 1., ib_bdy )                                         ! lateral boundary conditions
       CALL lbc_bdy_lnk( hicif, 'T', 1., ib_bdy )   ;   CALL lbc_bdy_lnk( hsnif, 'T', 1., ib_bdy )
+      CALL lbc_lnk( frld, 'T', 1. )                                         ! lateral boundary conditions
+      CALL lbc_lnk( hicif, 'T', 1. )   ;   CALL lbc_lnk( hsnif, 'T', 1. )
+      !
       IF( nn_timing == 1 ) CALL timing_stop('bdy_ice_frs')

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90

-                      r3703
+                      r6736
    !!            3.3  !  2010-09  (D.Storkey) add ice boundary conditions
    !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge
-   !!            3.4  !  2012     (J. Chanut) straight open boundary case update
-   !!            3.5  !  2012     (S. Mocavero, I. Epicoco) Updates for the
-   !!                             optimization of BDY communications
    !!----------------------------------------------------------------------
 #if defined key_bdy
 …
    USE lib_mpp         ! for mpp_sum
    USE iom             ! I/O
+   USE sbctide, ONLY: lk_tide ! Tidal forcing or not
+   USE phycst, ONLY: rday
+   IMPLICIT NONE
+   IMPLICIT NONE
    PRIVATE
    PUBLIC   bdy_init   ! routine called in nemo_init
-   INTEGER, PARAMETER          :: jp_nseg = 100
-   INTEGER, PARAMETER          :: nrimmax = 20 ! maximum rimwidth in structured
-                                               ! open boundary data files
-   ! Straight open boundary segment parameters:
-   INTEGER  :: nbdysege, nbdysegw, nbdysegn, nbdysegs
-   INTEGER, DIMENSION(jp_nseg) :: jpieob, jpjedt, jpjeft, npckge
-   INTEGER, DIMENSION(jp_nseg) :: jpiwob, jpjwdt, jpjwft, npckgw
-   INTEGER, DIMENSION(jp_nseg) :: jpjnob, jpindt, jpinft, npckgn
-   INTEGER, DIMENSION(jp_nseg) :: jpjsob, jpisdt, jpisft, npckgs
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011)
 …
       ! namelist variables
       !-------------------
+      CHARACTER(LEN=80),DIMENSION(jpbgrd)  ::   clfile
+      CHARACTER(LEN=1)   ::   ctypebdy
+      INTEGER :: nbdyind, nbdybeg, nbdyend
+      INTEGER, PARAMETER          :: jp_nseg = 100
+      INTEGER                     :: nbdysege, nbdysegw, nbdysegn, nbdysegs
+      INTEGER, DIMENSION(jp_nseg) :: jpieob, jpjedt, jpjeft
+      INTEGER, DIMENSION(jp_nseg) :: jpiwob, jpjwdt, jpjwft
+      INTEGER, DIMENSION(jp_nseg) :: jpjnob, jpindt, jpinft
+      INTEGER, DIMENSION(jp_nseg) :: jpjsob, jpisdt, jpisft
       ! local variables
 …
       INTEGER  ::   iw, ie, is, in, inum, id_dummy         !   -       -
       INTEGER  ::   igrd_start, igrd_end, jpbdta           !   -       -
-      INTEGER  ::   jpbdtau, jpbdtas                       !   -       -
-      INTEGER  ::   ib_bdy1, ib_bdy2, ib1, ib2             !   -       -
       INTEGER, POINTER  ::  nbi, nbj, nbr                  ! short cuts
       REAL   , POINTER  ::  flagu, flagv                   !    -   -
       REAL(wp) ::   zefl, zwfl, znfl, zsfl                 ! local scalars
       INTEGER, DIMENSION (2)                  ::   kdimsz
+      INTEGER, DIMENSION (2)                ::   kdimsz
       INTEGER, DIMENSION(jpbgrd,jp_bdy)       ::   nblendta         ! Length of index arrays
       INTEGER, ALLOCATABLE, DIMENSION(:,:,:)  ::   nbidta, nbjdta   ! Index arrays: i and j indices of bdy dta
       INTEGER, ALLOCATABLE, DIMENSION(:,:,:)  ::   nbrdta           ! Discrete distance from rim points
+      CHARACTER(LEN=1),DIMENSION(jpbgrd)      ::   cgrid
+      INTEGER :: com_east, com_west, com_south, com_north          ! Flags for boundaries sending
+      INTEGER :: com_east_b, com_west_b, com_south_b, com_north_b  ! Flags for boundaries receiving
+      INTEGER :: iw_b(4), ie_b(4), is_b(4), in_b(4)                ! Arrays for neighbours coordinates
+      CHARACTER(LEN=80),DIMENSION(jpbgrd)  ::   clfile
+      CHARACTER(LEN=1),DIMENSION(jpbgrd)   ::   cgrid
       !!
       NAMELIST/nambdy/ nb_bdy, ln_coords_file, cn_coords_file,             &
          &             ln_mask_file, cn_mask_file, nn_dyn2d, nn_dyn2d_dta, &
+         &             nn_dyn3d, nn_dyn3d_dta, nn_tra, nn_tra_dta,         &
+         &             ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp,              &
+         &             nn_dyn3d, nn_dyn3d_dta, nn_tra, nn_tra_dta, nb_jpk, &
 #if defined key_lim2
          &             nn_ice_lim2, nn_ice_lim2_dta,                       &
 …
          &             ln_vol, nn_volctl, nn_rimwidth
       !!
+      NAMELIST/nambdy_index/ ctypebdy, nbdyind, nbdybeg, nbdyend
+      NAMELIST/nambdy_index/ nbdysege, jpieob, jpjedt, jpjeft,             &
+                             nbdysegw, jpiwob, jpjwdt, jpjwft,             &
+                             nbdysegn, jpjnob, jpindt, jpinft,             &
+                             nbdysegs, jpjsob, jpisdt, jpisft
       !!----------------------------------------------------------------------
 …
       cgrid= (/'t','u','v'/)
       ! -----------------------------------------
       ! Initialise and read namelist parameters
 …
       nn_tra(:)         = 0
       nn_tra_dta(:)     = -1  ! uninitialised flag
+      ln_tra_dmp(:)     = .false.
+      ln_dyn3d_dmp(:)   = .false.
+      rn_time_dmp(:)    = 1.
+      nb_jpk            = -1
 #if defined key_lim2
       nn_ice_lim2(:)    = 0
 …
       ! Check and write out namelist parameters
       ! -----------------------------------------
       !                                   ! control prints
       IF(lwp) WRITE(numout,*) '         nambdy'
 …
         IF(lwp) WRITE(numout,*) 'Boundary conditions for barotropic solution:  '
         SELECT CASE( nn_dyn2d(ib_bdy) )
           CASE(jp_none)         ;   IF(lwp) WRITE(numout,*) '      no open boundary condition'
           CASE(jp_frs)          ;   IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme'
           CASE(jp_flather)      ;   IF(lwp) WRITE(numout,*) '      Flather radiation condition'
+          CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      no open boundary condition'
+          CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme'
+          CASE( 2 )      ;   IF(lwp) WRITE(numout,*) '      Flather radiation condition'
           CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_dyn2d' )
         END SELECT
 …
               CASE DEFAULT   ;   CALL ctl_stop( 'nn_dyn2d_dta must be between 0 and 3' )
            END SELECT
-           IF (( nn_dyn2d_dta(ib_bdy) .ge. 2 ).AND.(.NOT.lk_tide)) THEN
-             CALL ctl_stop( 'You must activate key_tide to add tidal forcing at open boundaries' )
-           ENDIF
         ENDIF
         IF(lwp) WRITE(numout,*)
 …
         IF(lwp) WRITE(numout,*) 'Boundary conditions for baroclinic velocities:  '
         SELECT CASE( nn_dyn3d(ib_bdy) )
+          CASE(jp_none)  ;   IF(lwp) WRITE(numout,*) '      no open boundary condition'
+          CASE(jp_frs)   ;   IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme'
+          CASE( 2 )      ;   IF(lwp) WRITE(numout,*) '      Specified value'
+          CASE( 3 )      ;   IF(lwp) WRITE(numout,*) '      Zero baroclinic velocities (runoff case)'
+          CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      no open boundary condition'
+          CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme'
           CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_dyn3d' )
         END SELECT
 …
            END SELECT
         ENDIF
-        IF ( ln_dyn3d_dmp(ib_bdy) ) THEN
-           IF ( nn_dyn3d(ib_bdy).EQ.0 ) THEN
-              IF(lwp) WRITE(numout,*) 'No open boundary condition for baroclinic velocities: ln_dyn3d_dmp is set to .false.'
-              ln_dyn3d_dmp(ib_bdy)=.false.
-           ELSEIF ( nn_dyn3d(ib_bdy).EQ.1 ) THEN
-              CALL ctl_stop( 'Use FRS OR relaxation' )
-           ELSE
-              IF(lwp) WRITE(numout,*) '      + baroclinic velocities relaxation zone'
-              IF(lwp) WRITE(numout,*) '      Damping time scale: ',rn_time_dmp(ib_bdy),' days'
-              IF((lwp).AND.rn_time_dmp(ib_bdy)<0) CALL ctl_stop( 'Time scale must be positive' )
-           ENDIF
-        ELSE
-           IF(lwp) WRITE(numout,*) '      NO relaxation on baroclinic velocities'
-        ENDIF
         IF(lwp) WRITE(numout,*)
         IF(lwp) WRITE(numout,*) 'Boundary conditions for temperature and salinity:  '
         SELECT CASE( nn_tra(ib_bdy) )
+          CASE(jp_none)  ;   IF(lwp) WRITE(numout,*) '      no open boundary condition'
+          CASE(jp_frs)   ;   IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme'
+          CASE( 2 )      ;   IF(lwp) WRITE(numout,*) '      Specified value'
+          CASE( 3 )      ;   IF(lwp) WRITE(numout,*) '      Neumann conditions'
+          CASE( 4 )      ;   IF(lwp) WRITE(numout,*) '      Runoff conditions : Neumann for T and specified to 0.1 for salinity'
+          CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      no open boundary condition'
+          CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme'
           CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_tra' )
         END SELECT
 …
               CASE DEFAULT   ;   CALL ctl_stop( 'nn_tra_dta must be 0 or 1' )
            END SELECT
-        ENDIF
-        IF ( ln_tra_dmp(ib_bdy) ) THEN
-           IF ( nn_tra(ib_bdy).EQ.0 ) THEN
-              IF(lwp) WRITE(numout,*) 'No open boundary condition for tracers: ln_tra_dmp is set to .false.'
-              ln_tra_dmp(ib_bdy)=.false.
-           ELSEIF ( nn_tra(ib_bdy).EQ.1 ) THEN
-              CALL ctl_stop( 'Use FRS OR relaxation' )
-           ELSE
-              IF(lwp) WRITE(numout,*) '      + T/S relaxation zone'
-              IF(lwp) WRITE(numout,*) '      Damping time scale: ',rn_time_dmp(ib_bdy),' days'
-              IF((lwp).AND.rn_time_dmp(ib_bdy)<0) CALL ctl_stop( 'Time scale must be positive' )
-           ENDIF
-        ELSE
-           IF(lwp) WRITE(numout,*) '      NO T/S relaxation'
         ENDIF
         IF(lwp) WRITE(numout,*)
 …
 #endif
         IF(lwp) WRITE(numout,*) '      Width of relaxation zone = ', nn_rimwidth(ib_bdy)
+        IF(lwp) WRITE(numout,*) 'Boundary rim width for the FRS scheme = ', nn_rimwidth(ib_bdy)
         IF(lwp) WRITE(numout,*)
       ENDDO
+     IF (nb_bdy .gt. 0) THEN
+        IF( ln_vol ) THEN                     ! check volume conservation (nn_volctl value)
+          IF(lwp) WRITE(numout,*) 'Volume correction applied at open boundaries'
+          IF(lwp) WRITE(numout,*)
+          SELECT CASE ( nn_volctl )
+            CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      The total volume will be constant'
+            CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      The total volume will vary according to the surface E-P flux'
+            CASE DEFAULT   ;   CALL ctl_stop( 'nn_volctl must be 0 or 1' )
+          END SELECT
+          IF(lwp) WRITE(numout,*)
+        ELSE
+          IF(lwp) WRITE(numout,*) 'No volume correction applied at open boundaries'
+          IF(lwp) WRITE(numout,*)
+        ENDIF
+     IF( ln_vol ) THEN                     ! check volume conservation (nn_volctl value)
+       IF(lwp) WRITE(numout,*) 'Volume correction applied at open boundaries'
+       IF(lwp) WRITE(numout,*)
+       SELECT CASE ( nn_volctl )
+         CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      The total volume will be constant'
+         CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      The total volume will vary according to the surface E-P flux'
+         CASE DEFAULT   ;   CALL ctl_stop( 'nn_volctl must be 0 or 1' )
+       END SELECT
+       IF(lwp) WRITE(numout,*)
+     ELSE
+       IF(lwp) WRITE(numout,*) 'No volume correction applied at open boundaries'
+       IF(lwp) WRITE(numout,*)
      ENDIF
 …
       ! ---------------------------------------------
       REWIND( numnam )
-      nblendta(:,:) = 0
-      nbdysege = 0
-      nbdysegw = 0
-      nbdysegn = 0
-      nbdysegs = 0
-      icount   = 0 ! count user defined segments
-      ! Dimensions below are used to allocate arrays to read external data
-      jpbdtas = 1 ! Maximum size of boundary data (structured case)
-      jpbdtau = 1 ! Maximum size of boundary data (unstructured case)
       DO ib_bdy = 1, nb_bdy
+         jpbdta = 1
          IF( .NOT. ln_coords_file(ib_bdy) ) THEN ! Work out size of global arrays from namelist parameters
-            icount = icount + 1
             ! No REWIND here because may need to read more than one nambdy_index namelist.
             READ  ( numnam, nambdy_index )
+            SELECT CASE ( TRIM(ctypebdy) )
+              CASE( 'N' )
+                 IF( nbdyind == -1 ) THEN  ! Automatic boundary definition: if nbdysegX = -1
+                    nbdyind  = jpjglo - 2  ! set boundary to whole side of model domain.
+                    nbdybeg  = 2
+                    nbdyend  = jpiglo - 1
+                 ENDIF
+                 nbdysegn = nbdysegn + 1
+                 npckgn(nbdysegn) = ib_bdy ! Save bdy package number
+                 jpjnob(nbdysegn) = nbdyind
+                 jpindt(nbdysegn) = nbdybeg
+                 jpinft(nbdysegn) = nbdyend
+                 !
+              CASE( 'S' )
+                 IF( nbdyind == -1 ) THEN  ! Automatic boundary definition: if nbdysegX = -1
+                    nbdyind  = 2           ! set boundary to whole side of model domain.
+                    nbdybeg  = 2
+                    nbdyend  = jpiglo - 1
+                 ENDIF
+                 nbdysegs = nbdysegs + 1
+                 npckgs(nbdysegs) = ib_bdy ! Save bdy package number
+                 jpjsob(nbdysegs) = nbdyind
+                 jpisdt(nbdysegs) = nbdybeg
+                 jpisft(nbdysegs) = nbdyend
+                 !
+              CASE( 'E' )
+                 IF( nbdyind == -1 ) THEN  ! Automatic boundary definition: if nbdysegX = -1
+                    nbdyind  = jpiglo - 2  ! set boundary to whole side of model domain.
+                    nbdybeg  = 2
+                    nbdyend  = jpjglo - 1
+                 ENDIF
+                 nbdysege = nbdysege + 1
+                 npckge(nbdysege) = ib_bdy ! Save bdy package number
+                 jpieob(nbdysege) = nbdyind
+                 jpjedt(nbdysege) = nbdybeg
+                 jpjeft(nbdysege) = nbdyend
+                 !
+              CASE( 'W' )
+                 IF( nbdyind == -1 ) THEN  ! Automatic boundary definition: if nbdysegX = -1
+                    nbdyind  = 2           ! set boundary to whole side of model domain.
+                    nbdybeg  = 2
+                    nbdyend  = jpjglo - 1
+                 ENDIF
+                 nbdysegw = nbdysegw + 1
+                 npckgw(nbdysegw) = ib_bdy ! Save bdy package number
+                 jpiwob(nbdysegw) = nbdyind
+                 jpjwdt(nbdysegw) = nbdybeg
+                 jpjwft(nbdysegw) = nbdyend
+                 !
+              CASE DEFAULT   ;   CALL ctl_stop( 'ctypebdy must be N, S, E or W' )
+            END SELECT
+            ! For simplicity we assume that in case of straight bdy, arrays have the same length
+            ! (even if it is true that last tangential velocity points
+            ! are useless). This simplifies a little bit boundary data format (and agrees with format
+            ! used so far in obc package)
+            nblendta(1:jpbgrd,ib_bdy) =  (nbdyend - nbdybeg + 1) * nn_rimwidth(ib_bdy)
+            jpbdtas = MAX(jpbdtas, (nbdyend - nbdybeg + 1))
+            IF (lwp.and.(nn_rimwidth(ib_bdy)>nrimmax)) &
+            & CALL ctl_stop( 'rimwidth must be lower than nrimmax' )
+            ! Automatic boundary definition: if nbdysegX = -1
+            ! set boundary to whole side of model domain.
+            IF( nbdysege == -1 ) THEN
+               nbdysege = 1
+               jpieob(1) = jpiglo - 1
+               jpjedt(1) = 2
+               jpjeft(1) = jpjglo - 1
+            ENDIF
+            IF( nbdysegw == -1 ) THEN
+               nbdysegw = 1
+               jpiwob(1) = 2
+               jpjwdt(1) = 2
+               jpjwft(1) = jpjglo - 1
+            ENDIF
+            IF( nbdysegn == -1 ) THEN
+               nbdysegn = 1
+               jpjnob(1) = jpjglo - 1
+               jpindt(1) = 2
+               jpinft(1) = jpiglo - 1
+            ENDIF
+            IF( nbdysegs == -1 ) THEN
+               nbdysegs = 1
+               jpjsob(1) = 2
+               jpisdt(1) = 2
+               jpisft(1) = jpiglo - 1
+            ENDIF
+            nblendta(:,ib_bdy) = 0
+            DO iseg = 1, nbdysege
+               igrd = 1
+               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpjeft(iseg) - jpjedt(iseg) + 1
+               igrd = 2
+               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpjeft(iseg) - jpjedt(iseg) + 1
+               igrd = 3
+               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpjeft(iseg) - jpjedt(iseg)
+            ENDDO
+            DO iseg = 1, nbdysegw
+               igrd = 1
+               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpjwft(iseg) - jpjwdt(iseg) + 1
+               igrd = 2
+               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpjwft(iseg) - jpjwdt(iseg) + 1
+               igrd = 3
+               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpjwft(iseg) - jpjwdt(iseg)
+            ENDDO
+            DO iseg = 1, nbdysegn
+               igrd = 1
+               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpinft(iseg) - jpindt(iseg) + 1
+               igrd = 2
+               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpinft(iseg) - jpindt(iseg)
+               igrd = 3
+               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpinft(iseg) - jpindt(iseg) + 1
+            ENDDO
+            DO iseg = 1, nbdysegs
+               igrd = 1
+               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpisft(iseg) - jpisdt(iseg) + 1
+               igrd = 2
+               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpisft(iseg) - jpisdt(iseg)
+               igrd = 3
+               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpisft(iseg) - jpisdt(iseg) + 1
+            ENDDO
+            nblendta(:,ib_bdy) = nblendta(:,ib_bdy) * nn_rimwidth(ib_bdy)
+            jpbdta = MAXVAL(nblendta(:,ib_bdy))
          ELSE            ! Read size of arrays in boundary coordinates file.
             CALL iom_open( cn_coords_file(ib_bdy), inum )
+            jpbdta = 1
             DO igrd = 1, jpbgrd
                id_dummy = iom_varid( inum, 'nbi'//cgrid(igrd), kdimsz=kdimsz )
                nblendta(igrd,ib_bdy) = kdimsz(1)
+               jpbdtau = MAX(jpbdtau, kdimsz(1))
+            ENDDO
+            CALL iom_close( inum )
+               jpbdta = MAX(jpbdta, kdimsz(1))
+            ENDDO
          ENDIF
 …
       ENDDO ! ib_bdy
+      IF (nb_bdy>0) THEN
+         jpbdta = MAXVAL(nblendta(1:jpbgrd,1:nb_bdy))
+         ! Allocate arrays
+         !---------------
+         ALLOCATE( nbidta(jpbdta, jpbgrd, nb_bdy), nbjdta(jpbdta, jpbgrd, nb_bdy),    &
+            &      nbrdta(jpbdta, jpbgrd, nb_bdy) )
+         ALLOCATE( dta_global(jpbdtau, 1, jpk) )
+         IF ( icount>0 ) ALLOCATE( dta_global2(jpbdtas, nrimmax, jpk) )
+         !
+      ENDIF
+      ! Now look for crossings in user (namelist) defined open boundary segments:
+      !--------------------------------------------------------------------------
+      IF ( icount>0 ) CALL bdy_ctl_seg
+      ! Allocate arrays
+      !---------------
+      ALLOCATE( nbidta(jpbdta, jpbgrd, nb_bdy), nbjdta(jpbdta, jpbgrd, nb_bdy),    &
+         &      nbrdta(jpbdta, jpbgrd, nb_bdy) )
+      ALLOCATE( dta_global(jpbdta, 1, jpk) )
+      ALLOCATE( dta_global_1(jpbdta, 1, jpk) )
+      ALLOCATE( dta_global_2(jpbdta, jpk) )
       ! Calculate global boundary index arrays or read in from file
       !------------------------------------------------------------
       ! 1. Read global index arrays from boundary coordinates file.
+      !------------------------------------------------------------
+      REWIND( numnam )
       DO ib_bdy = 1, nb_bdy
+         IF( ln_coords_file(ib_bdy) ) THEN
+            CALL iom_open( cn_coords_file(ib_bdy), inum )
+         IF( .NOT. ln_coords_file(ib_bdy) ) THEN ! Calculate global index arrays from namelist parameters
+            ! No REWIND here because may need to read more than one nambdy_index namelist.
+            READ  ( numnam, nambdy_index )
+            ! Automatic boundary definition: if nbdysegX = -1
+            ! set boundary to whole side of model domain.
+            IF( nbdysege == -1 ) THEN
+               nbdysege = 1
+               jpieob(1) = jpiglo - 1
+               jpjedt(1) = 2
+               jpjeft(1) = jpjglo - 1
+            ENDIF
+            IF( nbdysegw == -1 ) THEN
+               nbdysegw = 1
+               jpiwob(1) = 2
+               jpjwdt(1) = 2
+               jpjwft(1) = jpjglo - 1
+            ENDIF
+            IF( nbdysegn == -1 ) THEN
+               nbdysegn = 1
+               jpjnob(1) = jpjglo - 1
+               jpindt(1) = 2
+               jpinft(1) = jpiglo - 1
+            ENDIF
+            IF( nbdysegs == -1 ) THEN
+               nbdysegs = 1
+               jpjsob(1) = 2
+               jpisdt(1) = 2
+               jpisft(1) = jpiglo - 1
+            ENDIF
+            ! ------------ T points -------------
+            igrd = 1
+            icount = 0
+            DO ir = 1, nn_rimwidth(ib_bdy)
+               ! east
+               DO iseg = 1, nbdysege
+                  DO ij = jpjedt(iseg), jpjeft(iseg)
+                     icount = icount + 1
+                     nbidta(icount, igrd, ib_bdy) = jpieob(iseg) - ir + 1
+                     nbjdta(icount, igrd, ib_bdy) = ij
+                     nbrdta(icount, igrd, ib_bdy) = ir
+                  ENDDO
+               ENDDO
+               ! west
+               DO iseg = 1, nbdysegw
+                  DO ij = jpjwdt(iseg), jpjwft(iseg)
+                     icount = icount + 1
+                     nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1
+                     nbjdta(icount, igrd, ib_bdy) = ij
+                     nbrdta(icount, igrd, ib_bdy) = ir
+                  ENDDO
+               ENDDO
+               ! north
+               DO iseg = 1, nbdysegn
+                  DO ii = jpindt(iseg), jpinft(iseg)
+                     icount = icount + 1
+                     nbidta(icount, igrd, ib_bdy) = ii
+                     nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) - ir + 1
+                     nbrdta(icount, igrd, ib_bdy) = ir
+                  ENDDO
+               ENDDO
+               ! south
+               DO iseg = 1, nbdysegs
+                  DO ii = jpisdt(iseg), jpisft(iseg)
+                     icount = icount + 1
+                     nbidta(icount, igrd, ib_bdy) = ii
+                     nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1
+                     nbrdta(icount, igrd, ib_bdy) = ir
+                  ENDDO
+               ENDDO
+            ENDDO
+            ! ------------ U points -------------
+            igrd = 2
+            icount = 0
+            DO ir = 1, nn_rimwidth(ib_bdy)
+               ! east
+               DO iseg = 1, nbdysege
+                  DO ij = jpjedt(iseg), jpjeft(iseg)
+                     icount = icount + 1
+                     nbidta(icount, igrd, ib_bdy) = jpieob(iseg) - ir
+                     nbjdta(icount, igrd, ib_bdy) = ij
+                     nbrdta(icount, igrd, ib_bdy) = ir
+                  ENDDO
+               ENDDO
+               ! west
+               DO iseg = 1, nbdysegw
+                  DO ij = jpjwdt(iseg), jpjwft(iseg)
+                     icount = icount + 1
+                     nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1
+                     nbjdta(icount, igrd, ib_bdy) = ij
+                     nbrdta(icount, igrd, ib_bdy) = ir
+                  ENDDO
+               ENDDO
+               ! north
+               DO iseg = 1, nbdysegn
+                  DO ii = jpindt(iseg), jpinft(iseg) - 1
+                     icount = icount + 1
+                     nbidta(icount, igrd, ib_bdy) = ii
+                     nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) - ir + 1
+                     nbrdta(icount, igrd, ib_bdy) = ir
+                  ENDDO
+               ENDDO
+               ! south
+               DO iseg = 1, nbdysegs
+                  DO ii = jpisdt(iseg), jpisft(iseg) - 1
+                     icount = icount + 1
+                     nbidta(icount, igrd, ib_bdy) = ii
+                     nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1
+                     nbrdta(icount, igrd, ib_bdy) = ir
+                  ENDDO
+               ENDDO
+            ENDDO
+            ! ------------ V points -------------
+            igrd = 3
+            icount = 0
+            DO ir = 1, nn_rimwidth(ib_bdy)
+               ! east
+               DO iseg = 1, nbdysege
+                  DO ij = jpjedt(iseg), jpjeft(iseg) - 1
+                     icount = icount + 1
+                     nbidta(icount, igrd, ib_bdy) = jpieob(iseg) - ir + 1
+                     nbjdta(icount, igrd, ib_bdy) = ij
+                     nbrdta(icount, igrd, ib_bdy) = ir
+                  ENDDO
+               ENDDO
+               ! west
+               DO iseg = 1, nbdysegw
+                  DO ij = jpjwdt(iseg), jpjwft(iseg) - 1
+                     icount = icount + 1
+                     nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1
+                     nbjdta(icount, igrd, ib_bdy) = ij
+                     nbrdta(icount, igrd, ib_bdy) = ir
+                  ENDDO
+               ENDDO
+               ! north
+               DO iseg = 1, nbdysegn
+                  DO ii = jpindt(iseg), jpinft(iseg)
+                     icount = icount + 1
+                     nbidta(icount, igrd, ib_bdy) = ii
+                     nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) - ir
+                     nbrdta(icount, igrd, ib_bdy) = ir
+                  ENDDO
+               ENDDO
+               ! south
+               DO iseg = 1, nbdysegs
+                  DO ii = jpisdt(iseg), jpisft(iseg)
+                     icount = icount + 1
+                     nbidta(icount, igrd, ib_bdy) = ii
+                     nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1
+                     nbrdta(icount, igrd, ib_bdy) = ir
+                  ENDDO
+               ENDDO
+            ENDDO
+         ELSE            ! Read global index arrays from boundary coordinates file.
             DO igrd = 1, jpbgrd
                CALL iom_get( inum, jpdom_unknown, 'nbi'//cgrid(igrd), dta_global(1:nblendta(igrd,ib_bdy),:,1) )
 …
                IF (ibr_max < nn_rimwidth(ib_bdy))   &
                      CALL ctl_stop( 'nn_rimwidth is larger than maximum rimwidth in file',cn_coords_file(ib_bdy) )
             END DO
             CALL iom_close( inum )
 …
          ENDIF
+      ENDDO
+      ! 2. Now fill indices corresponding to straight open boundary arrays:
+      ! East
+      !-----
+      DO iseg = 1, nbdysege
+         ib_bdy = npckge(iseg)
+         !
+         ! ------------ T points -------------
+         igrd=1
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+            DO ij = jpjedt(iseg), jpjeft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 2 - ir
+               nbjdta(icount, igrd, ib_bdy) = ij
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+         ENDDO
+         !
+         ! ------------ U points -------------
+         igrd=2
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+            DO ij = jpjedt(iseg), jpjeft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 1 - ir
+               nbjdta(icount, igrd, ib_bdy) = ij
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+         ENDDO
+         !
+         ! ------------ V points -------------
+         igrd=3
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+!            DO ij = jpjedt(iseg), jpjeft(iseg) - 1
+            DO ij = jpjedt(iseg), jpjeft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 2 - ir
+               nbjdta(icount, igrd, ib_bdy) = ij
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+            nbidta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point
+            nbjdta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point
+         ENDDO
+      ENDDO
+      !
+      ! West
+      !-----
+      DO iseg = 1, nbdysegw
+         ib_bdy = npckgw(iseg)
+         !
+         ! ------------ T points -------------
+         igrd=1
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+            DO ij = jpjwdt(iseg), jpjwft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1
+               nbjdta(icount, igrd, ib_bdy) = ij
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+         ENDDO
+         !
+         ! ------------ U points -------------
+         igrd=2
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+            DO ij = jpjwdt(iseg), jpjwft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1
+               nbjdta(icount, igrd, ib_bdy) = ij
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+         ENDDO
+         !
+         ! ------------ V points -------------
+         igrd=3
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+!            DO ij = jpjwdt(iseg), jpjwft(iseg) - 1
+            DO ij = jpjwdt(iseg), jpjwft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1
+               nbjdta(icount, igrd, ib_bdy) = ij
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+            nbidta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point
+            nbjdta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point
+         ENDDO
+      ENDDO
+      !
+      ! North
+      !-----
+      DO iseg = 1, nbdysegn
+         ib_bdy = npckgn(iseg)
+         !
+         ! ------------ T points -------------
+         igrd=1
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+            DO ii = jpindt(iseg), jpinft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = ii
+               nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 2 - ir
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+         ENDDO
+         !
+         ! ------------ U points -------------
+         igrd=2
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+!            DO ii = jpindt(iseg), jpinft(iseg) - 1
+            DO ii = jpindt(iseg), jpinft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = ii
+               nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 2 - ir
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+            nbidta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point
+            nbjdta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point
+         ENDDO
+         !
+         ! ------------ V points -------------
+         igrd=3
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+            DO ii = jpindt(iseg), jpinft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = ii
+               nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 1 - ir
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+         ENDDO
+      ENDDO
+      !
+      ! South
+      !-----
+      DO iseg = 1, nbdysegs
+         ib_bdy = npckgs(iseg)
+         !
+         ! ------------ T points -------------
+         igrd=1
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+            DO ii = jpisdt(iseg), jpisft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = ii
+               nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+         ENDDO
+         !
+         ! ------------ U points -------------
+         igrd=2
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+!            DO ii = jpisdt(iseg), jpisft(iseg) - 1
+            DO ii = jpisdt(iseg), jpisft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = ii
+               nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+            nbidta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point
+            nbjdta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point
+         ENDDO
+         !
+         ! ------------ V points -------------
+         igrd=3
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+            DO ii = jpisdt(iseg), jpisft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = ii
+               nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+         ENDDO
+      ENDDO
+      !  Deal with duplicated points
+      !-----------------------------
+      ! We assign negative indices to duplicated points (to remove them from bdy points to be updated)
+      ! if their distance to the bdy is greater than the other
+      ! If their distance are the same, just keep only one to avoid updating a point twice
+      DO igrd = 1, jpbgrd
+         DO ib_bdy1 = 1, nb_bdy
+            DO ib_bdy2 = 1, nb_bdy
+               IF (ib_bdy1/=ib_bdy2) THEN
+                  DO ib1 = 1, nblendta(igrd,ib_bdy1)
+                     DO ib2 = 1, nblendta(igrd,ib_bdy2)
+                        IF ((nbidta(ib1, igrd, ib_bdy1)==nbidta(ib2, igrd, ib_bdy2)).AND. &
+                        &   (nbjdta(ib1, igrd, ib_bdy1)==nbjdta(ib2, igrd, ib_bdy2))) THEN
+!                           IF ((lwp).AND.(igrd==1)) WRITE(numout,*) ' found coincident point ji, jj:', &
+!                                                       &              nbidta(ib1, igrd, ib_bdy1),      &
+!                                                       &              nbjdta(ib2, igrd, ib_bdy2)
+                           ! keep only points with the lowest distance to boundary:
+                           IF (nbrdta(ib1, igrd, ib_bdy1)<nbrdta(ib2, igrd, ib_bdy2)) THEN
+                             nbidta(ib2, igrd, ib_bdy2) =-ib_bdy2
+                             nbjdta(ib2, igrd, ib_bdy2) =-ib_bdy2
+                           ELSEIF (nbrdta(ib1, igrd, ib_bdy1)>nbrdta(ib2, igrd, ib_bdy2)) THEN
+                             nbidta(ib1, igrd, ib_bdy1) =-ib_bdy1
+                             nbjdta(ib1, igrd, ib_bdy1) =-ib_bdy1
+                           ! Arbitrary choice if distances are the same:
+                           ELSE
+                             nbidta(ib1, igrd, ib_bdy1) =-ib_bdy1
+                             nbjdta(ib1, igrd, ib_bdy1) =-ib_bdy1
+                           ENDIF
+                        END IF
+                     END DO
+                  END DO
+               ENDIF
+            END DO
+         END DO
+      END DO
+      ENDDO
       ! Work out dimensions of boundary data on each processor
       ! ------------------------------------------------------
+      ! Rather assume that boundary data indices are given on global domain
+      ! TO BE DISCUSSED ?
+!      iw = mig(1) + 1            ! if monotasking and no zoom, iw=2
+!      ie = mig(1) + nlci-1 - 1   ! if monotasking and no zoom, ie=jpim1
+!      is = mjg(1) + 1            ! if monotasking and no zoom, is=2
+!      in = mjg(1) + nlcj-1 - 1   ! if monotasking and no zoom, in=jpjm1
+      iw = mig(1) - jpizoom + 2         ! if monotasking and no zoom, iw=2
+      ie = mig(1) + nlci - jpizoom - 1  ! if monotasking and no zoom, ie=jpim1
+      is = mjg(1) - jpjzoom + 2         ! if monotasking and no zoom, is=2
+      in = mjg(1) + nlcj - jpjzoom - 1  ! if monotasking and no zoom, in=jpjm1
+      ALLOCATE( nbondi_bdy(nb_bdy))
+      ALLOCATE( nbondj_bdy(nb_bdy))
+      nbondi_bdy(:)=2
+      nbondj_bdy(:)=2
+      ALLOCATE( nbondi_bdy_b(nb_bdy))
+      ALLOCATE( nbondj_bdy_b(nb_bdy))
+      nbondi_bdy_b(:)=2
+      nbondj_bdy_b(:)=2
+      ! Work out dimensions of boundary data on each neighbour process
+      IF(nbondi .eq. 0) THEN
+         iw_b(1) = jpizoom + nimppt(nowe+1)
+         ie_b(1) = jpizoom + nimppt(nowe+1)+nlcit(nowe+1)-3
+         is_b(1) = jpjzoom + njmppt(nowe+1)
+         in_b(1) = jpjzoom + njmppt(nowe+1)+nlcjt(nowe+1)-3
+         iw_b(2) = jpizoom + nimppt(noea+1)
+         ie_b(2) = jpizoom + nimppt(noea+1)+nlcit(noea+1)-3
+         is_b(2) = jpjzoom + njmppt(noea+1)
+         in_b(2) = jpjzoom + njmppt(noea+1)+nlcjt(noea+1)-3
+      ELSEIF(nbondi .eq. 1) THEN
+         iw_b(1) = jpizoom + nimppt(nowe+1)
+         ie_b(1) = jpizoom + nimppt(nowe+1)+nlcit(nowe+1)-3
+         is_b(1) = jpjzoom + njmppt(nowe+1)
+         in_b(1) = jpjzoom + njmppt(nowe+1)+nlcjt(nowe+1)-3
+      ELSEIF(nbondi .eq. -1) THEN
+         iw_b(2) = jpizoom + nimppt(noea+1)
+         ie_b(2) = jpizoom + nimppt(noea+1)+nlcit(noea+1)-3
+         is_b(2) = jpjzoom + njmppt(noea+1)
+         in_b(2) = jpjzoom + njmppt(noea+1)+nlcjt(noea+1)-3
+      ENDIF
+      IF(nbondj .eq. 0) THEN
+         iw_b(3) = jpizoom + nimppt(noso+1)
+         ie_b(3) = jpizoom + nimppt(noso+1)+nlcit(noso+1)-3
+         is_b(3) = jpjzoom + njmppt(noso+1)
+         in_b(3) = jpjzoom + njmppt(noso+1)+nlcjt(noso+1)-3
+         iw_b(4) = jpizoom + nimppt(nono+1)
+         ie_b(4) = jpizoom + nimppt(nono+1)+nlcit(nono+1)-3
+         is_b(4) = jpjzoom + njmppt(nono+1)
+         in_b(4) = jpjzoom + njmppt(nono+1)+nlcjt(nono+1)-3
+      ELSEIF(nbondj .eq. 1) THEN
+         iw_b(3) = jpizoom + nimppt(noso+1)
+         ie_b(3) = jpizoom + nimppt(noso+1)+nlcit(noso+1)-3
+         is_b(3) = jpjzoom + njmppt(noso+1)
+         in_b(3) = jpjzoom + njmppt(noso+1)+nlcjt(noso+1)-3
+      ELSEIF(nbondj .eq. -1) THEN
+         iw_b(4) = jpizoom + nimppt(nono+1)
+         ie_b(4) = jpizoom + nimppt(nono+1)+nlcit(nono+1)-3
+         is_b(4) = jpjzoom + njmppt(nono+1)
+         in_b(4) = jpjzoom + njmppt(nono+1)+nlcjt(nono+1)-3
+      ENDIF
+      iw = mig(1) + 1            ! if monotasking and no zoom, iw=2
+      ie = mig(1) + nlci-1 - 1   ! if monotasking and no zoom, ie=jpim1
+      is = mjg(1) + 1            ! if monotasking and no zoom, is=2
+      in = mjg(1) + nlcj-1 - 1   ! if monotasking and no zoom, in=jpjm1
       DO ib_bdy = 1, nb_bdy
 …
                IF(lwp) THEN         ! Since all procs read global data only need to do this check on one proc...
                   IF( nbrdta(ib,igrd,ib_bdy) < nbrdta(ibm1,igrd,ib_bdy) ) THEN
+                     CALL ctl_stop('bdy_init : ERROR : boundary data in file  &
+                                    must be defined in order of distance from edge nbr.', &
+                                   'A utility for re-ordering boundary coordinates and data &
+                                    files exists in the TOOLS/OBC directory')
+                     CALL ctl_stop('bdy_init : ERROR : boundary data in file must be defined in order of distance from edge nbr.', &
+                    'A utility for re-ordering boundary coordinates and data files exists in the TOOLS/OBC directory')
                   ENDIF
                ENDIF
 …
          ALLOCATE( idx_bdy(ib_bdy)%nbj(ilen1,jpbgrd) )
          ALLOCATE( idx_bdy(ib_bdy)%nbr(ilen1,jpbgrd) )
          ALLOCATE( idx_bdy(ib_bdy)%nbd(ilen1,jpbgrd) )
+         ALLOCATE( idx_bdy(ib_bdy)%nbz(ilen1,jpbgrd,jpk) )     ! jdha addition TODO use this instead of calculating in fldread?
          ALLOCATE( idx_bdy(ib_bdy)%nbmap(ilen1,jpbgrd) )
          ALLOCATE( idx_bdy(ib_bdy)%nbw(ilen1,jpbgrd) )
 …
          ! -----------------------------------------------------------------
-         com_east = 0
-         com_west = 0
-         com_south = 0
-         com_north = 0
-         com_east_b = 0
-         com_west_b = 0
-         com_south_b = 0
-         com_north_b = 0
          DO igrd = 1, jpbgrd
             icount  = 0
 …
+                     !
                      icount = icount  + 1
+                     ! Rather assume that boundary data indices are given on global domain
+                     ! TO BE DISCUSSED ?
+!                     idx_bdy(ib_bdy)%nbi(icount,igrd)   = nbidta(ib,igrd,ib_bdy)- mig(1)+1
+!                     idx_bdy(ib_bdy)%nbj(icount,igrd)   = nbjdta(ib,igrd,ib_bdy)- mjg(1)+1
+                     idx_bdy(ib_bdy)%nbi(icount,igrd)   = nbidta(ib,igrd,ib_bdy)- mig(1)+jpizoom
+                     idx_bdy(ib_bdy)%nbj(icount,igrd)   = nbjdta(ib,igrd,ib_bdy)- mjg(1)+jpjzoom
+                     ! check if point has to be sent
+                     ii = idx_bdy(ib_bdy)%nbi(icount,igrd)
+                     ij = idx_bdy(ib_bdy)%nbj(icount,igrd)
+                     if((com_east .ne. 1) .and. (ii .eq. (nlci-1)) .and. (nbondi .le. 0)) then
+                        com_east = 1
+                     elseif((com_west .ne. 1) .and. (ii .eq. 2) .and. (nbondi .ge. 0) .and. (nbondi .ne. 2)) then
+                        com_west = 1
+                     endif
+                     if((com_south .ne. 1) .and. (ij .eq. 2) .and. (nbondj .ge. 0) .and. (nbondj .ne. 2)) then
+                        com_south = 1
+                     elseif((com_north .ne. 1) .and. (ij .eq. (nlcj-1)) .and. (nbondj .le. 0)) then
+                        com_north = 1
+                     endif
+                     idx_bdy(ib_bdy)%nbi(icount,igrd)   = nbidta(ib,igrd,ib_bdy)- mig(1)+1
+                     idx_bdy(ib_bdy)%nbj(icount,igrd)   = nbjdta(ib,igrd,ib_bdy)- mjg(1)+1
                      idx_bdy(ib_bdy)%nbr(icount,igrd)   = nbrdta(ib,igrd,ib_bdy)
+                     DO ik = 1,jpk
+                        idx_bdy(ib_bdy)%nbz(icount,igrd,ik) =                                  &
+                     &  gdept_1(idx_bdy(ib_bdy)%nbi(icount,igrd),idx_bdy(ib_bdy)%nbj(icount,igrd),ik)   ! if using in step could use fsdept?
+                     ENDDO
                      idx_bdy(ib_bdy)%nbmap(icount,igrd) = ib
                   ENDIF
-                  ! check if point has to be received from a neighbour
-                  IF(nbondi .eq. 0) THEN
-                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(1) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(1) .AND.   &
-                       & nbjdta(ib,igrd,ib_bdy) >= is_b(1) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(1) .AND.   &
-                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
-                       ii = nbidta(ib,igrd,ib_bdy)- iw_b(1)+2
-                       if((com_west_b .ne. 1) .and. (ii .eq. (nlcit(nowe+1)-1))) then
-                          ij = nbjdta(ib,igrd,ib_bdy) - is_b(1)+2
-                          if((ij .eq. 2) .and. (nbondj .eq. 0 .or. nbondj .eq. 1)) then
-                            com_south = 1
-                          elseif((ij .eq. nlcjt(nowe+1)-1) .and. (nbondj .eq. 0 .or. nbondj .eq. -1)) then
-                            com_north = 1
-                          endif
-                          com_west_b = 1
-                       endif
-                     ENDIF
-                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(2) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(2) .AND.   &
-                       & nbjdta(ib,igrd,ib_bdy) >= is_b(2) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(2) .AND.   &
-                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
-                       ii = nbidta(ib,igrd,ib_bdy)- iw_b(2)+2
-                       if((com_east_b .ne. 1) .and. (ii .eq. 2)) then
-                          ij = nbjdta(ib,igrd,ib_bdy) - is_b(2)+2
-                          if((ij .eq. 2) .and. (nbondj .eq. 0 .or. nbondj .eq. 1)) then
-                            com_south = 1
-                          elseif((ij .eq. nlcjt(noea+1)-1) .and. (nbondj .eq. 0 .or. nbondj .eq. -1)) then
-                            com_north = 1
-                          endif
-                          com_east_b = 1
-                       endif
-                     ENDIF
-                  ELSEIF(nbondi .eq. 1) THEN
-                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(1) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(1) .AND.   &
-                       & nbjdta(ib,igrd,ib_bdy) >= is_b(1) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(1) .AND.   &
-                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
-                       ii = nbidta(ib,igrd,ib_bdy)- iw_b(1)+2
-                       if((com_west_b .ne. 1) .and. (ii .eq. (nlcit(nowe+1)-1))) then
-                          ij = nbjdta(ib,igrd,ib_bdy) - is_b(1)+2
-                          if((ij .eq. 2) .and. (nbondj .eq. 0 .or. nbondj .eq. 1)) then
-                            com_south = 1
-                          elseif((ij .eq. nlcjt(nowe+1)-1) .and. (nbondj .eq. 0 .or. nbondj .eq. -1)) then
-                            com_north = 1
-                          endif
-                          com_west_b = 1
-                       endif
-                     ENDIF
-                  ELSEIF(nbondi .eq. -1) THEN
-                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(2) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(2) .AND.   &
-                       & nbjdta(ib,igrd,ib_bdy) >= is_b(2) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(2) .AND.   &
-                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
-                       ii = nbidta(ib,igrd,ib_bdy)- iw_b(2)+2
-                       if((com_east_b .ne. 1) .and. (ii .eq. 2)) then
-                          ij = nbjdta(ib,igrd,ib_bdy) - is_b(2)+2
-                          if((ij .eq. 2) .and. (nbondj .eq. 0 .or. nbondj .eq. 1)) then
-                            com_south = 1
-                          elseif((ij .eq. nlcjt(noea+1)-1) .and. (nbondj .eq. 0 .or. nbondj .eq. -1)) then
-                            com_north = 1
-                          endif
-                          com_east_b = 1
-                       endif
-                     ENDIF
-                  ENDIF
-                  IF(nbondj .eq. 0) THEN
-                     IF(com_north_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(4)-1  &
-                       & .OR. nbidta(ib,igrd,ib_bdy) == ie_b(4)+1) .AND. &
-                       & nbjdta(ib,igrd,ib_bdy) == is_b(4) .AND. nbrdta(ib,igrd,ib_bdy) == ir) THEN
-                       com_north_b = 1
-                     ENDIF
-                     IF(com_south_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(3)-1  &
-                       &.OR. nbidta(ib,igrd,ib_bdy) == ie_b(3)+1) .AND. &
-                       & nbjdta(ib,igrd,ib_bdy) == in_b(3) .AND. nbrdta(ib,igrd,ib_bdy) == ir) THEN
-                       com_south_b = 1
-                     ENDIF
-                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(3) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(3) .AND.   &
-                       & nbjdta(ib,igrd,ib_bdy) >= is_b(3) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(3) .AND.   &
-                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
-                       ij = nbjdta(ib,igrd,ib_bdy)- is_b(3)+2
-                       if((com_south_b .ne. 1) .and. (ij .eq. (nlcjt(noso+1)-1))) then
-                          com_south_b = 1
-                       endif
-                     ENDIF
-                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(4) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(4) .AND.   &
-                       & nbjdta(ib,igrd,ib_bdy) >= is_b(4) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(4) .AND.   &
-                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
-                       ij = nbjdta(ib,igrd,ib_bdy)- is_b(4)+2
-                       if((com_north_b .ne. 1) .and. (ij .eq. 2)) then
-                          com_north_b = 1
-                       endif
-                     ENDIF
-                  ELSEIF(nbondj .eq. 1) THEN
-                     IF( com_south_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(3)-1 .OR. &
-                       & nbidta(ib,igrd,ib_bdy) == ie_b(3)+1) .AND. &
-                       & nbjdta(ib,igrd,ib_bdy) == in_b(3) .AND. nbrdta(ib,igrd,ib_bdy) == ir) THEN
-                       com_south_b = 1
-                     ENDIF
-                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(3) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(3) .AND.   &
-                       & nbjdta(ib,igrd,ib_bdy) >= is_b(3) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(3) .AND.   &
-                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
-                       ij = nbjdta(ib,igrd,ib_bdy)- is_b(3)+2
-                       if((com_south_b .ne. 1) .and. (ij .eq. (nlcjt(noso+1)-1))) then
-                          com_south_b = 1
-                       endif
-                     ENDIF
-                  ELSEIF(nbondj .eq. -1) THEN
-                     IF(com_north_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(4)-1  &
-                       & .OR. nbidta(ib,igrd,ib_bdy) == ie_b(4)+1) .AND. &
-                       & nbjdta(ib,igrd,ib_bdy) == is_b(4) .AND. nbrdta(ib,igrd,ib_bdy) == ir) THEN
-                       com_north_b = 1
-                     ENDIF
-                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(4) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(4) .AND.   &
-                       & nbjdta(ib,igrd,ib_bdy) >= is_b(4) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(4) .AND.   &
-                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
-                       ij = nbjdta(ib,igrd,ib_bdy)- is_b(4)+2
-                       if((com_north_b .ne. 1) .and. (ij .eq. 2)) then
-                          com_north_b = 1
-                       endif
-                     ENDIF
-                  ENDIF
                ENDDO
             ENDDO
          ENDDO
-         ! definition of the i- and j- direction local boundaries arrays
-         ! used for sending the boudaries
-         IF((com_east .eq. 1) .and. (com_west .eq. 1)) THEN
-            nbondi_bdy(ib_bdy) = 0
-         ELSEIF ((com_east .eq. 1) .and. (com_west .eq. 0)) THEN
-            nbondi_bdy(ib_bdy) = -1
-         ELSEIF ((com_east .eq. 0) .and. (com_west .eq. 1)) THEN
-            nbondi_bdy(ib_bdy) = 1
-         ENDIF
-         IF((com_north .eq. 1) .and. (com_south .eq. 1)) THEN
-            nbondj_bdy(ib_bdy) = 0
-         ELSEIF ((com_north .eq. 1) .and. (com_south .eq. 0)) THEN
-            nbondj_bdy(ib_bdy) = -1
-         ELSEIF ((com_north .eq. 0) .and. (com_south .eq. 1)) THEN
-            nbondj_bdy(ib_bdy) = 1
-         ENDIF
-         ! definition of the i- and j- direction local boundaries arrays
-         ! used for receiving the boudaries
-         IF((com_east_b .eq. 1) .and. (com_west_b .eq. 1)) THEN
-            nbondi_bdy_b(ib_bdy) = 0
-         ELSEIF ((com_east_b .eq. 1) .and. (com_west_b .eq. 0)) THEN
-            nbondi_bdy_b(ib_bdy) = -1
-         ELSEIF ((com_east_b .eq. 0) .and. (com_west_b .eq. 1)) THEN
-            nbondi_bdy_b(ib_bdy) = 1
-         ENDIF
-         IF((com_north_b .eq. 1) .and. (com_south_b .eq. 1)) THEN
-            nbondj_bdy_b(ib_bdy) = 0
-         ELSEIF ((com_north_b .eq. 1) .and. (com_south_b .eq. 0)) THEN
-            nbondj_bdy_b(ib_bdy) = -1
-         ELSEIF ((com_north_b .eq. 0) .and. (com_south_b .eq. 1)) THEN
-            nbondj_bdy_b(ib_bdy) = 1
-         ENDIF
          ! Compute rim weights for FRS scheme
 …
                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) = (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
+            END DO
+         END DO
+         ! Compute damping coefficients
+         ! ----------------------------
+         DO igrd = 1, jpbgrd
+            DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
+               nbr => idx_bdy(ib_bdy)%nbr(ib,igrd)
+               idx_bdy(ib_bdy)%nbd(ib,igrd) = 1. / ( rn_time_dmp(ib_bdy) * rday ) &
+               & *(FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy)))**2.   ! quadratic
+!              idx_bdy(ib_bdy)%nbw(ib,igrd) = (FLOAT(nn_rimwidth+1-nbr)/FLOAT(nn_rimwidth))**2      ! quadratic
+!              idx_bdy(ib_bdy)%nbw(ib,igrd) =  FLOAT(nn_rimwidth+1-nbr)/FLOAT(nn_rimwidth)          ! linear
             END DO
          END DO
 …
          CALL iom_close( inum )
+               IF(lwp) WRITE(numout,*) 'get bdytmask', bdytmask
          ! Derive mask on U and V grid from mask on T grid
          bdyumask(:,:) = 0.e0
 …
       bdytmask(:,:) = tmask(:,:,1)
+      IF( .not. ln_mask_file ) THEN
+         ! If .not. ln_mask_file then we need to derive mask on U and V grid
+         ! from mask on T grid here.
+         bdyumask(:,:) = 0.e0
+         bdyvmask(:,:) = 0.e0
+         DO ij=1, jpjm1
+            DO ii=1, jpim1
+               bdyumask(ii,ij)=bdytmask(ii,ij)*bdytmask(ii+1, ij )
+               bdyvmask(ii,ij)=bdytmask(ii,ij)*bdytmask(ii  ,ij+1)
+            END DO
+         END DO
+         CALL lbc_lnk( bdyumask(:,:), 'U', 1. )   ;   CALL lbc_lnk( bdyvmask(:,:), 'V', 1. )      ! Lateral boundary cond.
+      ENDIF
       ! bdy masks and bmask are now set to zero on boundary points:
 …
             END IF
          END DO
          IF( icount /= 0 ) THEN
             IF(lwp) WRITE(numout,*)
 …
       ! Compute total lateral surface for volume correction:
       ! ----------------------------------------------------
-      ! JC: this must be done at each time step with key_vvl
       bdysurftot = 0.e0
       IF( ln_vol ) THEN
 …
       ! Tidy up
       !--------
+      IF (nb_bdy>0) THEN
+         DEALLOCATE(nbidta, nbjdta, nbrdta)
+      ENDIF
+      DEALLOCATE(nbidta, nbjdta, nbrdta)
       IF( nn_timing == 1 ) CALL timing_stop('bdy_init')
    END SUBROUTINE bdy_init
-   SUBROUTINE bdy_ctl_seg
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE bdy_ctl_seg  ***
-      !!
-      !! ** Purpose :   Check straight open boundary segments location
-      !!
-      !! ** Method  :   - Look for open boundary corners
-      !!                - Check that segments start or end on land
-      !!----------------------------------------------------------------------
-      INTEGER  ::   ib, ib1, ib2, ji ,jj, itest
-      INTEGER, DIMENSION(jp_nseg,2) :: icorne, icornw, icornn, icorns
-      REAL(wp), DIMENSION(2) ::   ztestmask
-      !!----------------------------------------------------------------------
+      !
-      IF (lwp) WRITE(numout,*) ' '
-      IF (lwp) WRITE(numout,*) 'bdy_ctl_seg: Check analytical segments'
-      IF (lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+      !
-      IF(lwp) WRITE(numout,*) 'Number of east  segments     : ', nbdysege
-      IF(lwp) WRITE(numout,*) 'Number of west  segments     : ', nbdysegw
-      IF(lwp) WRITE(numout,*) 'Number of north segments     : ', nbdysegn
-      IF(lwp) WRITE(numout,*) 'Number of south segments     : ', nbdysegs
-      ! 1. Check bounds
-      !----------------
-      DO ib = 1, nbdysegn
-         IF (lwp) WRITE(numout,*) '**check north seg bounds pckg: ', npckgn(ib)
-         IF ((jpjnob(ib).ge.jpjglo-1).or.&
-            &(jpjnob(ib).le.1))        CALL ctl_stop( 'nbdyind out of domain' )
-         IF (jpindt(ib).ge.jpinft(ib)) CALL ctl_stop( 'Bdy start index is greater than end index' )
-         IF (jpindt(ib).le.1     )     CALL ctl_stop( 'Start index out of domain' )
-         IF (jpinft(ib).ge.jpiglo)     CALL ctl_stop( 'End index out of domain' )
-      END DO
+      !
-      DO ib = 1, nbdysegs
-         IF (lwp) WRITE(numout,*) '**check south seg bounds pckg: ', npckgs(ib)
-         IF ((jpjsob(ib).ge.jpjglo-1).or.&
-            &(jpjsob(ib).le.1))        CALL ctl_stop( 'nbdyind out of domain' )
-         IF (jpisdt(ib).ge.jpisft(ib)) CALL ctl_stop( 'Bdy start index is greater than end index' )
-         IF (jpisdt(ib).le.1     )     CALL ctl_stop( 'Start index out of domain' )
-         IF (jpisft(ib).ge.jpiglo)     CALL ctl_stop( 'End index out of domain' )
-      END DO
+      !
-      DO ib = 1, nbdysege
-         IF (lwp) WRITE(numout,*) '**check east  seg bounds pckg: ', npckge(ib)
-         IF ((jpieob(ib).ge.jpiglo-1).or.&
-            &(jpieob(ib).le.1))        CALL ctl_stop( 'nbdyind out of domain' )
-         IF (jpjedt(ib).ge.jpjeft(ib)) CALL ctl_stop( 'Bdy start index is greater than end index' )
-         IF (jpjedt(ib).le.1     )     CALL ctl_stop( 'Start index out of domain' )
-         IF (jpjeft(ib).ge.jpjglo)     CALL ctl_stop( 'End index out of domain' )
-      END DO
+      !
-      DO ib = 1, nbdysegw
-         IF (lwp) WRITE(numout,*) '**check west  seg bounds pckg: ', npckgw(ib)
-         IF ((jpiwob(ib).ge.jpiglo-1).or.&
-            &(jpiwob(ib).le.1))        CALL ctl_stop( 'nbdyind out of domain' )
-         IF (jpjwdt(ib).ge.jpjwft(ib)) CALL ctl_stop( 'Bdy start index is greater than end index' )
-         IF (jpjwdt(ib).le.1     )     CALL ctl_stop( 'Start index out of domain' )
-         IF (jpjwft(ib).ge.jpjglo)     CALL ctl_stop( 'End index out of domain' )
-      ENDDO
+      !
+      !
-      ! 2. Look for segment crossings
-      !------------------------------
-      IF (lwp) WRITE(numout,*) '**Look for segments corners  :'
+      !
-      itest = 0 ! corner number
+      !
-      ! flag to detect if start or end of open boundary belongs to a corner
-      ! if not (=0), it must be on land.
-      ! if a corner is detected, save bdy package number for further tests
-      icorne(:,:)=0. ; icornw(:,:)=0. ; icornn(:,:)=0. ; icorns(:,:)=0.
-      ! South/West crossings
-      IF ((nbdysegw > 0).AND.(nbdysegs > 0)) THEN
-         DO ib1 = 1, nbdysegw
-            DO ib2 = 1, nbdysegs
-               IF (( jpisdt(ib2)<=jpiwob(ib1)).AND. &
-                &  ( jpisft(ib2)>=jpiwob(ib1)).AND. &
-                &  ( jpjwdt(ib1)<=jpjsob(ib2)).AND. &
-                &  ( jpjwft(ib1)>=jpjsob(ib2))) THEN
-                  IF ((jpjwdt(ib1)==jpjsob(ib2)).AND.(jpisdt(ib2)==jpiwob(ib1))) THEN
-                     ! We have a possible South-West corner
-!                     WRITE(numout,*) ' Found a South-West corner at (i,j): ', jpisdt(ib2), jpjwdt(ib1)
-!                     WRITE(numout,*) ' between segments: ', npckgw(ib1), npckgs(ib2)
-                     icornw(ib1,1) = npckgs(ib2)
-                     icorns(ib2,1) = npckgw(ib1)
-                  ELSEIF ((jpisft(ib2)==jpiwob(ib1)).AND.(jpjwft(ib1)==jpjsob(ib2))) THEN
-                     IF(lwp) WRITE(numout,*)
-                     IF(lwp) WRITE(numout,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', &
-                     &                                     jpisft(ib2), jpjwft(ib1)
-                     IF(lwp) WRITE(numout,*) ' ==========  Not allowed yet'
-                     IF(lwp) WRITE(numout,*) '             Crossing problem with West segment: ',npckgw(ib1), &
-                     &                                                    ' and South segment: ',npckgs(ib2)
-                     IF(lwp) WRITE(numout,*)
-                     nstop = nstop + 1
-                  ELSE
-                     IF(lwp) WRITE(numout,*)
-                     IF(lwp) WRITE(numout,*) ' E R R O R : Check South and West Open boundary indices'
-                     IF(lwp) WRITE(numout,*) ' ==========  Crossing problem with West segment: ',npckgw(ib1) , &
-                     &                                                    ' and South segment: ',npckgs(ib2)
-                     IF(lwp) WRITE(numout,*)
-                     nstop = nstop+1
-                  END IF
-               END IF
-            END DO
-         END DO
-      END IF
+      !
-      ! South/East crossings
-      IF ((nbdysege > 0).AND.(nbdysegs > 0)) THEN
-         DO ib1 = 1, nbdysege
-            DO ib2 = 1, nbdysegs
-               IF (( jpisdt(ib2)<=jpieob(ib1)+1).AND. &
-                &  ( jpisft(ib2)>=jpieob(ib1)+1).AND. &
-                &  ( jpjedt(ib1)<=jpjsob(ib2)  ).AND. &
-                &  ( jpjeft(ib1)>=jpjsob(ib2)  )) THEN
-                  IF ((jpjedt(ib1)==jpjsob(ib2)).AND.(jpisft(ib2)==jpieob(ib1)+1)) THEN
-                     ! We have a possible South-East corner
-!                     WRITE(numout,*) ' Found a South-East corner at (i,j): ', jpisft(ib2), jpjedt(ib1)
-!                     WRITE(numout,*) ' between segments: ', npckge(ib1), npckgs(ib2)
-                     icorne(ib1,1) = npckgs(ib2)
-                     icorns(ib2,2) = npckge(ib1)
-                  ELSEIF ((jpjeft(ib1)==jpjsob(ib2)).AND.(jpisdt(ib2)==jpieob(ib1)+1)) THEN
-                     IF(lwp) WRITE(numout,*)
-                     IF(lwp) WRITE(numout,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', &
-                     &                                     jpisdt(ib2), jpjeft(ib1)
-                     IF(lwp) WRITE(numout,*) ' ==========  Not allowed yet'
-                     IF(lwp) WRITE(numout,*) '             Crossing problem with East segment: ',npckge(ib1), &
-                     &                                                    ' and South segment: ',npckgs(ib2)
-                     IF(lwp) WRITE(numout,*)
-                     nstop = nstop + 1
-                  ELSE
-                     IF(lwp) WRITE(numout,*)
-                     IF(lwp) WRITE(numout,*) ' E R R O R : Check South and East Open boundary indices'
-                     IF(lwp) WRITE(numout,*) ' ==========  Crossing problem with East segment: ',npckge(ib1), &
-                     &                                                    ' and South segment: ',npckgs(ib2)
-                     IF(lwp) WRITE(numout,*)
-                     nstop = nstop + 1
-                  END IF
-               END IF
-            END DO
-         END DO
-      END IF
+      !
-      ! North/West crossings
-      IF ((nbdysegn > 0).AND.(nbdysegw > 0)) THEN
-         DO ib1 = 1, nbdysegw
-            DO ib2 = 1, nbdysegn
-               IF (( jpindt(ib2)<=jpiwob(ib1)  ).AND. &
-                &  ( jpinft(ib2)>=jpiwob(ib1)  ).AND. &
-                &  ( jpjwdt(ib1)<=jpjnob(ib2)+1).AND. &
-                &  ( jpjwft(ib1)>=jpjnob(ib2)+1)) THEN
-                  IF ((jpjwft(ib1)==jpjnob(ib2)+1).AND.(jpindt(ib2)==jpiwob(ib1))) THEN
-                     ! We have a possible North-West corner
-!                     WRITE(numout,*) ' Found a North-West corner at (i,j): ', jpindt(ib2), jpjwft(ib1)
-!                     WRITE(numout,*) ' between segments: ', npckgw(ib1), npckgn(ib2)
-                     icornw(ib1,2) = npckgn(ib2)
-                     icornn(ib2,1) = npckgw(ib1)
-                  ELSEIF ((jpjwdt(ib1)==jpjnob(ib2)+1).AND.(jpinft(ib2)==jpiwob(ib1))) THEN
-                     IF(lwp) WRITE(numout,*)
-                     IF(lwp) WRITE(numout,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', &
-                     &                                     jpinft(ib2), jpjwdt(ib1)
-                     IF(lwp) WRITE(numout,*) ' ==========  Not allowed yet'
-                     IF(lwp) WRITE(numout,*) '             Crossing problem with West segment: ',npckgw(ib1), &
-                     &                                                    ' and North segment: ',npckgn(ib2)
-                     IF(lwp) WRITE(numout,*)
-                     nstop = nstop + 1
-                  ELSE
-                     IF(lwp) WRITE(numout,*)
-                     IF(lwp) WRITE(numout,*) ' E R R O R : Check North and West Open boundary indices'
-                     IF(lwp) WRITE(numout,*) ' ==========  Crossing problem with West segment: ',npckgw(ib1), &
-                     &                                                    ' and North segment: ',npckgn(ib2)
-                     IF(lwp) WRITE(numout,*)
-                     nstop = nstop + 1
-                  END IF
-               END IF
-            END DO
-         END DO
-      END IF
+      !
-      ! North/East crossings
-      IF ((nbdysegn > 0).AND.(nbdysege > 0)) THEN
-         DO ib1 = 1, nbdysege
-            DO ib2 = 1, nbdysegn
-               IF (( jpindt(ib2)<=jpieob(ib1)+1).AND. &
-                &  ( jpinft(ib2)>=jpieob(ib1)+1).AND. &
-                &  ( jpjedt(ib1)<=jpjnob(ib2)+1).AND. &
-                &  ( jpjeft(ib1)>=jpjnob(ib2)+1)) THEN
-                  IF ((jpjeft(ib1)==jpjnob(ib2)+1).AND.(jpinft(ib2)==jpieob(ib1)+1)) THEN
-                     ! We have a possible North-East corner
-!                     WRITE(numout,*) ' Found a North-East corner at (i,j): ', jpinft(ib2), jpjeft(ib1)
-!                     WRITE(numout,*) ' between segments: ', npckge(ib1), npckgn(ib2)
-                     icorne(ib1,2) = npckgn(ib2)
-                     icornn(ib2,2) = npckge(ib1)
-                  ELSEIF ((jpjedt(ib1)==jpjnob(ib2)+1).AND.(jpindt(ib2)==jpieob(ib1)+1)) THEN
-                     IF(lwp) WRITE(numout,*)
-                     IF(lwp) WRITE(numout,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', &
-                     &                                     jpindt(ib2), jpjedt(ib1)
-                     IF(lwp) WRITE(numout,*) ' ==========  Not allowed yet'
-                     IF(lwp) WRITE(numout,*) '             Crossing problem with East segment: ',npckge(ib1), &
-                     &                                                    ' and North segment: ',npckgn(ib2)
-                     IF(lwp) WRITE(numout,*)
-                     nstop = nstop + 1
-                  ELSE
-                     IF(lwp) WRITE(numout,*)
-                     IF(lwp) WRITE(numout,*) ' E R R O R : Check North and East Open boundary indices'
-                     IF(lwp) WRITE(numout,*) ' ==========  Crossing problem with East segment: ',npckge(ib1), &
-                     &                                                    ' and North segment: ',npckgn(ib2)
-                     IF(lwp) WRITE(numout,*)
-                     nstop = nstop + 1
-                  END IF
-               END IF
-            END DO
-         END DO
-      END IF
+      !
-      ! 3. Check if segment extremities are on land
-      !--------------------------------------------
+      !
-      ! West segments
-      DO ib = 1, nbdysegw
-         ! get mask at boundary extremities:
-         ztestmask(1:2)=0.
-         DO ji = 1, jpi
-            DO jj = 1, jpj
-              IF (((ji + nimpp - 1) == jpiwob(ib)).AND. &
-               &  ((jj + njmpp - 1) == jpjwdt(ib))) ztestmask(1)=tmask(ji,jj,1)
-              IF (((ji + nimpp - 1) == jpiwob(ib)).AND. &
-               &  ((jj + njmpp - 1) == jpjwft(ib))) ztestmask(2)=tmask(ji,jj,1)
-            END DO
-         END DO
-         IF( lk_mpp )   CALL mpp_sum( ztestmask, 2 )   ! sum over the global domain
-         IF (ztestmask(1)==1) THEN
-            IF (icornw(ib,1)==0) THEN
-               IF(lwp) WRITE(numout,*)
-               IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckgw(ib)
-               IF(lwp) WRITE(numout,*) ' ==========  does not start on land or on a corner'
-               IF(lwp) WRITE(numout,*)
-               nstop = nstop + 1
-            ELSE
-               ! This is a corner
-               WRITE(numout,*) 'Found a South-West corner at (i,j): ', jpiwob(ib), jpjwdt(ib)
-               CALL bdy_ctl_corn(npckgw(ib), icornw(ib,1))
-               itest=itest+1
-            ENDIF
-         ENDIF
-         IF (ztestmask(2)==1) THEN
-            IF (icornw(ib,2)==0) THEN
-               IF(lwp) WRITE(numout,*)
-               IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckgw(ib)
-               IF(lwp) WRITE(numout,*) ' ==========  does not end on land or on a corner'
-               IF(lwp) WRITE(numout,*)
-               nstop = nstop + 1
-            ELSE
-               ! This is a corner
-               WRITE(numout,*) 'Found a North-West corner at (i,j): ', jpiwob(ib), jpjwft(ib)
-               CALL bdy_ctl_corn(npckgw(ib), icornw(ib,2))
-               itest=itest+1
-            ENDIF
-         ENDIF
-      END DO
+      !
-      ! East segments
-      DO ib = 1, nbdysege
-         ! get mask at boundary extremities:
-         ztestmask(1:2)=0.
-         DO ji = 1, jpi
-            DO jj = 1, jpj
-              IF (((ji + nimpp - 1) == jpieob(ib)+1).AND. &
-               &  ((jj + njmpp - 1) == jpjedt(ib))) ztestmask(1)=tmask(ji,jj,1)
-              IF (((ji + nimpp - 1) == jpieob(ib)+1).AND. &
-               &  ((jj + njmpp - 1) == jpjeft(ib))) ztestmask(2)=tmask(ji,jj,1)
-            END DO
-         END DO
-         IF( lk_mpp )   CALL mpp_sum( ztestmask, 2 )   ! sum over the global domain
-         IF (ztestmask(1)==1) THEN
-            IF (icorne(ib,1)==0) THEN
-               IF(lwp) WRITE(numout,*)
-               IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckge(ib)
-               IF(lwp) WRITE(numout,*) ' ==========  does not start on land or on a corner'
-               IF(lwp) WRITE(numout,*)
-               nstop = nstop + 1
-            ELSE
-               ! This is a corner
-               WRITE(numout,*) 'Found a South-East corner at (i,j): ', jpieob(ib)+1, jpjedt(ib)
-               CALL bdy_ctl_corn(npckge(ib), icorne(ib,1))
-               itest=itest+1
-            ENDIF
-         ENDIF
-         IF (ztestmask(2)==1) THEN
-            IF (icorne(ib,2)==0) THEN
-               IF(lwp) WRITE(numout,*)
-               IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckge(ib)
-               IF(lwp) WRITE(numout,*) ' ==========  does not end on land or on a corner'
-               IF(lwp) WRITE(numout,*)
-               nstop = nstop + 1
-            ELSE
-               ! This is a corner
-               WRITE(numout,*) 'Found a North-East corner at (i,j): ', jpieob(ib)+1, jpjeft(ib)
-               CALL bdy_ctl_corn(npckge(ib), icorne(ib,2))
-               itest=itest+1
-            ENDIF
-         ENDIF
-      END DO
+      !
-      ! South segments
-      DO ib = 1, nbdysegs
-         ! get mask at boundary extremities:
-         ztestmask(1:2)=0.
-         DO ji = 1, jpi
-            DO jj = 1, jpj
-              IF (((jj + njmpp - 1) == jpjsob(ib)).AND. &
-               &  ((ji + nimpp - 1) == jpisdt(ib))) ztestmask(1)=tmask(ji,jj,1)
-              IF (((jj + njmpp - 1) == jpjsob(ib)).AND. &
-               &  ((ji + nimpp - 1) == jpisft(ib))) ztestmask(2)=tmask(ji,jj,1)
-            END DO
-         END DO
-         IF( lk_mpp )   CALL mpp_sum( ztestmask, 2 )   ! sum over the global domain
-         IF ((ztestmask(1)==1).AND.(icorns(ib,1)==0)) THEN
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckgs(ib)
-            IF(lwp) WRITE(numout,*) ' ==========  does not start on land or on a corner'
-            IF(lwp) WRITE(numout,*)
-            nstop = nstop + 1
-         ENDIF
-         IF ((ztestmask(2)==1).AND.(icorns(ib,2)==0)) THEN
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckgs(ib)
-            IF(lwp) WRITE(numout,*) ' ==========  does not end on land or on a corner'
-            IF(lwp) WRITE(numout,*)
-            nstop = nstop + 1
-         ENDIF
-      END DO
+      !
-      ! North segments
-      DO ib = 1, nbdysegn
-         ! get mask at boundary extremities:
-         ztestmask(1:2)=0.
-         DO ji = 1, jpi
-            DO jj = 1, jpj
-              IF (((jj + njmpp - 1) == jpjnob(ib)+1).AND. &
-               &  ((ji + nimpp - 1) == jpindt(ib))) ztestmask(1)=tmask(ji,jj,1)
-              IF (((jj + njmpp - 1) == jpjnob(ib)+1).AND. &
-               &  ((ji + nimpp - 1) == jpinft(ib))) ztestmask(2)=tmask(ji,jj,1)
-            END DO
-         END DO
-         IF( lk_mpp )   CALL mpp_sum( ztestmask, 2 )   ! sum over the global domain
-         IF ((ztestmask(1)==1).AND.(icornn(ib,1)==0)) THEN
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckgn(ib)
-            IF(lwp) WRITE(numout,*) ' ==========  does not start on land'
-            IF(lwp) WRITE(numout,*)
-            nstop = nstop + 1
-         ENDIF
-         IF ((ztestmask(2)==1).AND.(icornn(ib,2)==0)) THEN
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckgn(ib)
-            IF(lwp) WRITE(numout,*) ' ==========  does not end on land'
-            IF(lwp) WRITE(numout,*)
-            nstop = nstop + 1
-         ENDIF
-      END DO
+      !
-      IF ((itest==0).AND.(lwp)) WRITE(numout,*) 'NO open boundary corner found'
+      !
-      ! Other tests TBD:
-      ! segments completly on land
-      ! optimized open boundary array length according to landmask
-      ! Nudging layers that overlap with interior domain
+      !
-   END SUBROUTINE bdy_ctl_seg
-   SUBROUTINE bdy_ctl_corn( ib1, ib2 )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE bdy_ctl_corn  ***
-      !!
-      !! ** Purpose :   Check numerical schemes consistency between
-      !!                segments having a common corner
-      !!
-      !! ** Method  :
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in)  ::   ib1, ib2
-      INTEGER :: itest
-      !!----------------------------------------------------------------------
-      itest = 0
-      IF (nn_dyn2d(ib1)/=nn_dyn2d(ib2)) itest = itest + 1
-      IF (nn_dyn3d(ib1)/=nn_dyn3d(ib2)) itest = itest + 1
-      IF (nn_tra(ib1)/=nn_tra(ib2)) itest = itest + 1
+      !
-      IF (nn_dyn2d_dta(ib1)/=nn_dyn2d_dta(ib2)) itest = itest + 1
-      IF (nn_dyn3d_dta(ib1)/=nn_dyn3d_dta(ib2)) itest = itest + 1
-      IF (nn_tra_dta(ib1)/=nn_tra_dta(ib2)) itest = itest + 1
+      !
-      IF (nn_rimwidth(ib1)/=nn_rimwidth(ib2)) itest = itest + 1
+      !
-      IF ( itest>0 ) THEN
-         IF(lwp) WRITE(numout,*) ' E R R O R : Segments ', ib1, 'and ', ib2
-         IF(lwp) WRITE(numout,*) ' ==========  have different open bdy schemes'
-         IF(lwp) WRITE(numout,*)
-         nstop = nstop + 1
-      ENDIF
+      !
-   END SUBROUTINE bdy_ctl_corn
 #else

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90

-                      r3651
+                      r6736
    !!            3.0  !  2008-04  (NEMO team)  add in the reference version
    !!            3.3  !  2010-09  (D.Storkey and E.O'Dea)  bug fixes
+   !!            3.4  !  2012-09  (G. Reffray and J. Chanut) New inputs + mods
+   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge
+   !!            3.4  !  2013     (J. Harle) rewite to used tide_mod for phase and nodal
+   !!                             corrections every day
    !!----------------------------------------------------------------------
 #if defined key_bdy
 …
    !!----------------------------------------------------------------------
    !!   PUBLIC
    !!      bdytide_init     : read of namelist and initialisation of tidal harmonics data
+   !!      tide_init     : read of namelist and initialisation of tidal harmonics data
    !!      tide_update   : calculation of tidal forcing at each timestep
    !!----------------------------------------------------------------------
 …
    USE bdy_par         ! Unstructured boundary parameters
    USE bdy_oce         ! ocean open boundary conditions
+   USE fldread, ONLY: fld_map
    USE daymod          ! calendar
+   USE wrk_nemo        ! Memory allocation
+   USE tideini
+!   USE tide_mod       ! Useless ??
+   USE fldread, ONLY: fld_map
+   USE tide_mod
+   USE ioipsl, ONLY :   ymds2ju   ! for calendar
    IMPLICIT NONE
    PRIVATE
    PUBLIC   bdytide_init     ! routine called in bdy_init
    PUBLIC   bdytide_update   ! routine called in bdy_dta
+   PUBLIC   tide_init     ! routine called in nemo_init
+   PUBLIC   tide_update   ! routine called in bdydyn
    TYPE, PUBLIC ::   TIDES_DATA     !: Storage for external tidal harmonics data
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   ssh0       !: Tidal constituents : SSH0 (read in file)
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   u0         !: Tidal constituents : U0   (read in file)
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   v0         !: Tidal constituents : V0   (read in file)
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   ssh        !: Tidal constituents : SSH  (after nodal cor.)
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   u          !: Tidal constituents : U    (after nodal cor.)
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   v          !: Tidal constituents : V    (after nodal cor.)
+      INTEGER                                ::   ncpt       !: Actual number of tidal components
+      REAL(wp), POINTER, DIMENSION(:)        ::   speed      !: Phase speed of tidal constituent (deg/hr)
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   ssh        !: Tidal constituents : SSH
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   u          !: Tidal constituents : U
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   v          !: Tidal constituents : V
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   sshr       !: Tidal constituents : SSH (reference)
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   ur         !: Tidal constituents : U (reference)
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   vr         !: Tidal constituents : V (reference)
    END TYPE TIDES_DATA
+   TYPE(TIDES_DATA), PUBLIC, DIMENSION(jp_bdy), TARGET :: tides  !: External tidal harmonics data
+   TYPE(TIDES_DATA), PUBLIC, DIMENSION(jp_bdy), TARGET ::   tides                 !: External tidal harmonics data
+   INTEGER, ALLOCATABLE, DIMENSION(:)  :: bdy_ntide
+   REAL(wp), ALLOCATABLE, DIMENSION(:) :: bdy_omega_tide
+   REAL(wp), ALLOCATABLE, DIMENSION(:) :: bdy_v0tide,      &
+                                          bdy_blank,       &
+                                          bdy_utide,       &
+                                          bdy_ftide,       &
+                                          rbdy_ftide
+   LOGICAL                             ::   ln_tide_date !: =T correct tide phases and amplitude for model start date
+   LOGICAL                             ::   ln_tide_v0 !: =T correct tide phases and amplitude for model start date
+   INTEGER                             ::   nn_tide_date !: yyyymmdd reference date of tidal data
+   INTEGER ::   bdy_nn_tide
+   INTEGER ::   bdy_kt_tide      ! Main tide timestep counter
+   INTEGER ::   bdy_tide_offset      ! Main tide timestep counter
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
 …
 CONTAINS
    SUBROUTINE bdytide_init
       !!----------------------------------------------------------------------
       !!                    ***  SUBROUTINE bdytide_init  ***
+   SUBROUTINE tide_init
+      !!----------------------------------------------------------------------
+      !!                    ***  SUBROUTINE tide_init  ***
       !!
       !! ** Purpose : - Read in namelist for tides and initialise external
 …
       !! namelist variables
       !!-------------------
+      CHARACTER(len=80)                         ::   filtide             !: Filename root for tidal input files
+      LOGICAL                                   ::   ln_bdytide_2ddta    !: If true, read 2d harmonic data
+      LOGICAL                                   ::   ln_bdytide_conj     !: If true, assume complex conjugate tidal data
+      CHARACTER(len=80)                         ::   filtide      !: Filename root for tidal input files
+      CHARACTER(len= 4), DIMENSION(jpmax_harmo) ::   tide_cpt     !: Names of tidal components used.
       !!
+      INTEGER                                   ::   ib_bdy, itide, ib   !: dummy loop indices
+      INTEGER                                   ::   ii, ij              !: dummy loop indices
+      INTEGER                                   ::   ib_bdy, itide, ib, ji  !: dummy loop indices
       INTEGER                                   ::   inum, igrd
       INTEGER, DIMENSION(3)                     ::   ilen0       !: length of boundary data (from OBC arrays)
       INTEGER, POINTER, DIMENSION(:)            ::   nblen, nblenrim     ! short cuts
       CHARACTER(len=80)                         ::   clfile              !: full file name for tidal input file
       REAL(wp),ALLOCATABLE, DIMENSION(:,:,:)    ::   dta_read            !: work space to read in tidal harmonics data
       REAL(wp), POINTER, DIMENSION(:,:)         ::   ztr, zti            !:  "     "    "   "   "   "        "      "
+      INTEGER  :: lcl_ryear, lcl_rmonth, lcl_rday
+      INTEGER, DIMENSION(3)                     ::   ilen0                  !: length of boundary data (from OBC arrays)
+      CHARACTER(len=80)                         ::   clfile                 !: full file name for tidal input file
+      REAL(wp)                                  ::   z_arg, z_atde, z_btde, z1t, z2t, fdayn, fdayr
+      REAL(wp),ALLOCATABLE, DIMENSION(:,:,:)    ::   dta_read           !: work space to read in tidal harmonics data
       !!
       TYPE(TIDES_DATA),  POINTER                ::   td                  !: local short cut
+      TYPE(TIDES_DATA),  POINTER                ::   td                 !: local short cut
       !!
+      NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta, ln_bdytide_conj
+      !!----------------------------------------------------------------------
+      IF( nn_timing == 1 ) CALL timing_start('bdytide_init')
+      IF (nb_bdy>0) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'bdytide_init : initialization of tidal harmonic forcing at open boundaries'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+      ENDIF
+      ln_bdytide_2ddta = .FALSE.
+      ln_bdytide_conj  = .FALSE.
+      NAMELIST/nambdy_tide/filtide, tide_cpt, ln_tide_date, nn_tide_date, ln_tide_v0
+      !!----------------------------------------------------------------------
+      IF( nn_timing == 1 ) CALL timing_start('tide_init')
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'tide_init : initialization of tidal harmonic forcing at open boundaries'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
       REWIND(numnam)
 …
             td => tides(ib_bdy)
-            nblen => idx_bdy(ib_bdy)%nblen
-            nblenrim => idx_bdy(ib_bdy)%nblenrim
             ! Namelist nambdy_tide : tidal harmonic forcing at open boundaries
+            ln_tide_date = .false.
+            ln_tide_v0 = .false.
             filtide(:) = ''
+            tide_cpt(:) = ''
+            ! Initialise bdy_ky_tide: updated in tide_update if using time correction otherwise defaults to 1
+            bdy_kt_tide=1
             ! Don't REWIND here - may need to read more than one of these namelists.
             READ  ( numnam, nambdy_tide )
+            !                                               ! Count number of components specified
+            td%ncpt = 0
+            DO itide = 1, jpmax_harmo
+              IF( tide_cpt(itide) /= '' ) THEN
+                 td%ncpt = td%ncpt + 1
+              ENDIF
+            END DO
+            CALL tide_init_Wave
+            ! Find constituents in standard list
+            ALLOCATE(bdy_ntide     (td%ncpt))
+            DO itide=1,td%ncpt
+               bdy_ntide(itide)=0
+               DO ji=1,jpmax_harmo
+                  IF ( TRIM( tide_cpt(itide) ) .eq. Wave(ji)%cname_tide) THEN
+                     bdy_ntide(itide) = ji
+                     EXIT
+                  END IF
+               END DO
+               IF (bdy_ntide(itide).eq.0) THEN
+                  CALL ctl_stop( 'BDYTIDE tidal components do not match up with tide.h90' )
+               ENDIF
+            END DO
+            ! Fill in phase speeds from tide_pulse
+            ALLOCATE(bdy_omega_tide(td%ncpt))
+            CALL tide_pulse( bdy_omega_tide, bdy_ntide ,td%ncpt)
+            ALLOCATE( td%speed(td%ncpt) )
+            td%speed = bdy_omega_tide(1:td%ncpt)
             !                                               ! Parameter control and print
+            IF(lwp) WRITE(numout,*) '  '
+            IF(lwp) WRITE(numout,*) '          Namelist nambdy_tide : tidal harmonic forcing at open boundaries'
+            IF(lwp) WRITE(numout,*) '             read tidal data in 2d files: ', ln_bdytide_2ddta
+            IF(lwp) WRITE(numout,*) '             assume complex conjugate   : ', ln_bdytide_conj
+            IF(lwp) WRITE(numout,*) '             Number of tidal components to read: ', nb_harmo
+            IF(lwp) THEN
+                    WRITE(numout,*) '             Tidal cpt name    -     Phase speed (deg/hr)'
+               DO itide = 1, nb_harmo
+                  WRITE(numout,*)  '             ', Wave(ntide(itide))%cname_tide, omega_tide(itide)
+               END DO
+            ENDIF
+            IF(lwp) WRITE(numout,*) ' '
+            ! Allocate space for tidal harmonics data - get size from OBC data arrays
+            ! -----------------------------------------------------------------------
+            ! JC: If FRS scheme is used, we assume that tidal is needed over the whole
+            ! relaxation area
+            IF( nn_dyn2d(ib_bdy) .eq. jp_frs ) THEN
+               ilen0(:)=nblen(:)
+            IF( td%ncpt < 1 ) THEN
+               CALL ctl_stop( '          Did not find any tidal components in namelist nambdy_tide' )
             ELSE
+               ilen0(:)=nblenrim(:)
+               IF(lwp) WRITE(numout,*) '          Namelist nambdy_tide : tidal harmonic forcing at open boundaries'
+               IF(lwp) WRITE(numout,*) '             tidal components specified ', td%ncpt
+               IF(lwp) WRITE(numout,*) '                ', tide_cpt(1:td%ncpt)
+               IF(lwp) WRITE(numout,*) '             associated phase speeds (deg/hr) : '
+               IF(lwp) WRITE(numout,*) '                ', td%speed(1:td%ncpt)
             ENDIF
+            ALLOCATE( td%ssh0( ilen0(1), nb_harmo, 2 ) )
+            ALLOCATE( td%ssh ( ilen0(1), nb_harmo, 2 ) )
+            ALLOCATE( td%u0( ilen0(2), nb_harmo, 2 ) )
+            ALLOCATE( td%u ( ilen0(2), nb_harmo, 2 ) )
+            ALLOCATE( td%v0( ilen0(3), nb_harmo, 2 ) )
+            ALLOCATE( td%v ( ilen0(3), nb_harmo, 2 ) )
+            td%ssh0(:,:,:) = 0.e0
+            td%ssh(:,:,:) = 0.e0
+            td%u0(:,:,:) = 0.e0
+            td%u(:,:,:) = 0.e0
+            td%v0(:,:,:) = 0.e0
+            td%v(:,:,:) = 0.e0
+            IF (ln_bdytide_2ddta) THEN
+               ! It is assumed that each data file contains all complex harmonic amplitudes
+               ! given on the data domain (ie global, jpidta x jpjdta)
+               !
+               CALL wrk_alloc( jpi, jpj, zti, ztr )
+               !
+               ! SSH fields
+               clfile = TRIM(filtide)//'_grid_T.nc'
+               CALL iom_open (clfile , inum )
+               igrd = 1                       ! Everything is at T-points here
+               DO itide = 1, nb_harmo
+                  CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_z1', ztr(:,:) )
+                  CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_z2', zti(:,:) )
+                  DO ib = 1, ilen0(igrd)
+                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                     td%ssh0(ib,itide,1) = ztr(ii,ij)
+                     td%ssh0(ib,itide,2) = zti(ii,ij)
+                  END DO
+               END DO
+            ! Allocate space for tidal harmonics data -
+            ! get size from OBC data arrays
+            ! ---------------------------------------
+            ilen0(1) = SIZE( dta_bdy(ib_bdy)%ssh )
+            ALLOCATE( td%ssh( ilen0(1), td%ncpt, 2 ) )
+            ALLOCATE( td%sshr( ilen0(1), td%ncpt, 2 ) )
+            ilen0(2) = SIZE( dta_bdy(ib_bdy)%u2d )
+            ALLOCATE( td%u( ilen0(2), td%ncpt, 2 ) )
+            ALLOCATE( td%ur( ilen0(2), td%ncpt, 2 ) )
+            ilen0(3) = SIZE( dta_bdy(ib_bdy)%v2d )
+            ALLOCATE( td%v( ilen0(3), td%ncpt, 2 ) )
+            ALLOCATE( td%vr( ilen0(3), td%ncpt, 2 ) )
+            ALLOCATE( dta_read( MAXVAL(ilen0), 1, 1 ) )
+            ! Set day length in timesteps for use if making phase and nodal corrections
+            bdy_nn_tide=NINT(rday/rdt)
+            ALLOCATE(bdy_v0tide   (td%ncpt))
+            ALLOCATE(bdy_blank   (td%ncpt))
+            ALLOCATE(bdy_utide    (td%ncpt))
+            ALLOCATE(bdy_ftide    (td%ncpt))
+            ALLOCATE(rbdy_ftide    (td%ncpt))
+            ! Open files and read in tidal forcing data
+            ! -----------------------------------------
+            DO itide = 1, td%ncpt
+               !                                                              ! SSH fields
+               clfile = TRIM(filtide)//TRIM(tide_cpt(itide))//'_grid_T.nc'
+               IF(lwp) WRITE(numout,*) 'Reading data from file ', clfile
+               CALL iom_open( clfile, inum )
+               CALL fld_map( inum, 'z1' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) )
+               td%ssh(:,itide,1) = dta_read(1:ilen0(1),1,1)
+               CALL fld_map( inum, 'z2' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) )
+               td%ssh(:,itide,2) = dta_read(1:ilen0(1),1,1)
+               CALL iom_close( inum )
+               !                                                              ! U fields
+               clfile = TRIM(filtide)//TRIM(tide_cpt(itide))//'_grid_U.nc'
+               IF(lwp) WRITE(numout,*) 'Reading data from file ', clfile
+               CALL iom_open( clfile, inum )
+               CALL fld_map( inum, 'u1' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) )
+               td%u(:,itide,1) = dta_read(1:ilen0(2),1,1)
+               CALL fld_map( inum, 'u2' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) )
+               td%u(:,itide,2) = dta_read(1:ilen0(2),1,1)
+               CALL iom_close( inum )
+               !                                                              ! V fields
+               clfile = TRIM(filtide)//TRIM(tide_cpt(itide))//'_grid_V.nc'
+               IF(lwp) WRITE(numout,*) 'Reading data from file ', clfile
+               CALL iom_open( clfile, inum )
+               CALL fld_map( inum, 'v1' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) )
+               td%v(:,itide,1) = dta_read(1:ilen0(3),1,1)
+               CALL fld_map( inum, 'v2' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) )
+               td%v(:,itide,2) = dta_read(1:ilen0(3),1,1)
                CALL iom_close( inum )
+               !
+               ! U fields
+               clfile = TRIM(filtide)//'_grid_U.nc'
+               CALL iom_open (clfile , inum )
+               igrd = 2                       ! Everything is at U-points here
+               DO itide = 1, nb_harmo
+                  CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_u1', ztr(:,:) )
+                  CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_u2', zti(:,:) )
+                  DO ib = 1, ilen0(igrd)
+                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                     td%u0(ib,itide,1) = ztr(ii,ij)
+                     td%u0(ib,itide,2) = zti(ii,ij)
+                  END DO
+               END DO
+               CALL iom_close( inum )
+               !
+               ! V fields
+               clfile = TRIM(filtide)//'_grid_V.nc'
+               CALL iom_open (clfile , inum )
+               igrd = 3                       ! Everything is at V-points here
+               DO itide = 1, nb_harmo
+                  CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_v1', ztr(:,:) )
+                  CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_v2', zti(:,:) )
+                  DO ib = 1, ilen0(igrd)
+                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                     td%v0(ib,itide,1) = ztr(ii,ij)
+                     td%v0(ib,itide,2) = zti(ii,ij)
+                  END DO
+               END DO
+               CALL iom_close( inum )
+               !
+               CALL wrk_dealloc( jpi, jpj, ztr, zti )
+               !
+            ELSE
+               !
+               ! Read tidal data only on bdy segments
+               !
+               ALLOCATE( dta_read( MAXVAL(ilen0(1:3)), 1, 1 ) )
+               ! Open files and read in tidal forcing data
+               ! -----------------------------------------
+               DO itide = 1, nb_harmo
+                  !                                                              ! SSH fields
+                  clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_T.nc'
+                  CALL iom_open( clfile, inum )
+                  CALL fld_map( inum, 'z1' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) )
+                  td%ssh0(:,itide,1) = dta_read(1:ilen0(1),1,1)
+                  CALL fld_map( inum, 'z2' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) )
+                  td%ssh0(:,itide,2) = dta_read(1:ilen0(1),1,1)
+                  CALL iom_close( inum )
+                  !                                                              ! U fields
+                  clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_U.nc'
+                  CALL iom_open( clfile, inum )
+                  CALL fld_map( inum, 'u1' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) )
+                  td%u0(:,itide,1) = dta_read(1:ilen0(2),1,1)
+                  CALL fld_map( inum, 'u2' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) )
+                  td%u0(:,itide,2) = dta_read(1:ilen0(2),1,1)
+                  CALL iom_close( inum )
+                  !                                                              ! V fields
+                  clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_V.nc'
+                  CALL iom_open( clfile, inum )
+                  CALL fld_map( inum, 'v1' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) )
+                  td%v0(:,itide,1) = dta_read(1:ilen0(3),1,1)
+                  CALL fld_map( inum, 'v2' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) )
+                  td%v0(:,itide,2) = dta_read(1:ilen0(3),1,1)
+                  CALL iom_close( inum )
+                  !
+               END DO ! end loop on tidal components
+               !
+               DEALLOCATE( dta_read )
+            ENDIF ! ln_bdytide_2ddta=.true.
+            !
+            IF ( ln_bdytide_conj ) THEN ! assume complex conjugate in data files
+               td%ssh0(:,:,2) = - td%ssh0(:,:,2)
+               td%u0  (:,:,2) = - td%u0  (:,:,2)
+               td%v0  (:,:,2) = - td%v0  (:,:,2)
+            END DO ! end loop on tidal components
+            IF( ln_tide_date .and. ln_tide_v0 ) THEN      ! correct for date factors: gather v0
+               CALL tide_harmo(bdy_omega_tide, bdy_v0tide, bdy_utide, bdy_ftide, bdy_ntide, td%ncpt, nn_tide_date)
+               lcl_ryear  = INT(nn_tide_date / 10000  )
+               lcl_rmonth = INT((nn_tide_date  - lcl_ryear * 10000 ) / 100 )
+               lcl_rday   = INT(nn_tide_date  - lcl_ryear * 10000 - lcl_rmonth * 100)
+               nyear  = int(ndate0 / 10000  )                          ! initial year
+               nmonth = int((ndate0 - nyear * 10000 ) / 100 )          ! initial month
+               nday   = int(ndate0 - nyear * 10000 - nmonth * 100)
+               CALL ymds2ju( nyear, nmonth, nday, 0._wp, fdayn )
+               CALL ymds2ju( lcl_ryear, lcl_rmonth, lcl_rday, 0._wp, fdayr )
+               bdy_tide_offset = NINT( fdayn - fdayr ) * 86400
+               IF(lwp) WRITE(numout,*) '             BDYTIDE offset  '
+               IF(lwp) WRITE(numout,*) '                ', lcl_ryear, lcl_rmonth, lcl_rday
+               IF(lwp) WRITE(numout,*) '                ', nyear, nmonth, nday
+               IF(lwp) WRITE(numout,*) '                ', fdayn, fdayr, bdy_tide_offset
+            ELSE
+               bdy_v0tide(:)=0
+               bdy_utide(:)=0
+               bdy_ftide(:)=1
+               bdy_tide_offset = 0
+               IF(lwp) WRITE(numout,*) '             BDYTIDE offset  ', bdy_tide_offset
             ENDIF
+            ! Pass tidal forcing data to reference arrays for date correction to tidal harmonics
+            DO itide = 1, td%ncpt       ! loop on tidal components
+                  !                                         !  elevation
+              igrd = 1
+              DO ib = 1, ilen0(igrd)
+                        td%sshr(ib,itide,1) = td%ssh(ib,itide,1)
+                        td%sshr(ib,itide,2) = td%ssh(ib,itide,2)
+              END DO
+                  !                                         !  u
+              igrd = 2
+              DO ib = 1, ilen0(igrd)
+                        td%ur(ib,itide,1) = td%u(ib,itide,1)
+                        td%ur(ib,itide,2) = td%u(ib,itide,2)
+              END DO
+                  !                                         !  v
+              igrd = 3
+              DO ib = 1, ilen0(igrd)
+                        td%vr(ib,itide,1) = td%v(ib,itide,1)
+                        td%vr(ib,itide,2) = td%v(ib,itide,2)
+              ENDDO
+            ENDDO     ! loop on tidal components
+            IF(lwp) WRITE(numout,*) 'BDYTIDE: summary of mappings'
+            DO itide = 1, td%ncpt       ! loop on tidal components
+               IF(lwp) WRITE(numout,'(2i3,x,a)') itide, bdy_ntide(itide), tide_cpt(itide)
+            ENDDO
+            !
          ENDIF ! nn_dyn2d_dta(ib_bdy) .ge. 2
 …
       END DO ! loop on ib_bdy
+      IF( nn_timing == 1 ) CALL timing_stop('bdytide_init')
+   END SUBROUTINE bdytide_init
+   SUBROUTINE bdytide_update ( kt, idx, dta, td, jit, time_offset )
+      !!----------------------------------------------------------------------
+      !!                 ***  SUBROUTINE bdytide_update  ***
+      IF( nn_timing == 1 ) CALL timing_stop('tide_init')
+   END SUBROUTINE tide_init
+   SUBROUTINE tide_update ( kt, idx, dta, td, jit, time_offset )
+      !!----------------------------------------------------------------------
+      !!                 ***  SUBROUTINE tide_update  ***
       !!
       !! ** Purpose : - Add tidal forcing to ssh, u2d and v2d OBC data arrays.
       !!
       !!----------------------------------------------------------------------
+      INTEGER, INTENT( in )            ::   kt          ! Main timestep counter
+      TYPE(OBC_INDEX), INTENT( in )    ::   idx         ! OBC indices
+      TYPE(OBC_DATA),  INTENT(inout)   ::   dta         ! OBC external data
+      TYPE(TIDES_DATA),INTENT( inout ) ::   td          ! tidal harmonics data
+      INTEGER,INTENT(in),OPTIONAL      ::   jit         ! Barotropic timestep counter (for timesplitting option)
+      INTEGER,INTENT( in ), OPTIONAL   ::   time_offset ! time offset in units of timesteps. NB. if jit
+                                                        ! is present then units = subcycle timesteps.
+                                                        ! time_offset = 0  => get data at "now"    time level
+                                                        ! time_offset = -1 => get data at "before" time level
+                                                        ! time_offset = +1 => get data at "after"  time level
+                                                        ! etc.
+      INTEGER, INTENT( in )          ::   kt      ! Main timestep counter
+!!gm doctor jit ==> kit
+      TYPE(OBC_INDEX), INTENT( in )  ::   idx     ! OBC indices
+      TYPE(OBC_DATA),  INTENT(inout) ::   dta     ! OBC external data
+      TYPE(TIDES_DATA),INTENT(inout) ::   td      ! tidal harmonics data
+      INTEGER,INTENT(in),OPTIONAL    ::   jit     ! Barotropic timestep counter (for timesplitting option)
+      INTEGER,INTENT( in ), OPTIONAL ::   time_offset  ! time offset in units of timesteps. NB. if jit
+                                                       ! is present then units = subcycle timesteps.
+                                                       ! time_offset = 0 => get data at "now" time level
+                                                       ! time_offset = -1 => get data at "before" time level
+                                                       ! time_offset = +1 => get data at "after" time level
+                                                       ! etc.
       !!
+      INTEGER, DIMENSION(3)            ::   ilen0       !: length of boundary data (from OBC arrays)
+      INTEGER                          :: itide, igrd, ib   ! dummy loop indices
+      INTEGER                          :: time_add          ! time offset in units of timesteps
+      REAL(wp)                         :: z_arg, z_sarg, zflag, zramp
+      INTEGER                          :: itide, igrd, ib     ! dummy loop indices
+      INTEGER                          :: time_add            ! time offset in units of timesteps
+      INTEGER                          :: sub_step            ! dummy for jit (probably not required as
+                                                              ! timesplitting always used?)
+      REAL(wp)                         :: z_arg, z_sarg
       REAL(wp), DIMENSION(jpmax_harmo) :: z_sist, z_cost
+      !!----------------------------------------------------------------------
+      IF( nn_timing == 1 ) CALL timing_start('bdytide_update')
+      ilen0(1) =  SIZE(td%ssh(:,1,1))
+      ilen0(2) =  SIZE(td%u(:,1,1))
+      ilen0(3) =  SIZE(td%v(:,1,1))
+      zflag=1
+      IF ( PRESENT(jit) ) THEN
+        IF ( jit /= 1 ) zflag=0
+      ENDIF
+      IF ( nsec_day == NINT(0.5 * rdttra(1)) .AND. zflag==1 ) THEN
+        !
+        kt_tide = kt
+        !
+        IF(lwp) THEN
+           WRITE(numout,*)
+           WRITE(numout,*) 'bdytide_update : (re)Initialization of the tidal bdy forcing at kt=',kt
+           WRITE(numout,*) '~~~~~~~~~~~~~~ '
+        ENDIF
+        !
+        CALL tide_init_elevation ( idx, td )
+        CALL tide_init_velocities( idx, td )
+        !
+      ENDIF
+      REAL(wp)                         :: z_atde, z_btde
+      REAL(wp)                         :: z1t, z2t
+      !!----------------------------------------------------------------------
+      IF( nn_timing == 1 ) CALL timing_start('tide_update')
       time_add = 0
 …
          time_add = time_offset
       ENDIF
+      ! Phase corrections for the current day
+      sub_step = 1
       IF( PRESENT(jit) ) THEN
+         z_arg = ( ((kt-kt_tide)-1) * rdt + (jit+time_add) * rdt / REAL(nn_baro,wp) )
+         sub_step = jit
+      ENDIF
+      IF( ln_tide_date ) THEN      ! correct for date factors
+         IF ( ( MOD( kt - 1, bdy_nn_tide ) == 0 ) .and. (sub_step==1) ) THEN
+           IF ( ln_tide_v0 ) THEN
+              bdy_kt_tide = 1
+              CALL tide_harmo(bdy_omega_tide, bdy_blank, bdy_utide, bdy_ftide, bdy_ntide, td%ncpt, ndastp)
+           ELSE
+              bdy_kt_tide = kt
+              CALL tide_harmo(bdy_omega_tide, bdy_v0tide, bdy_utide, bdy_ftide, bdy_ntide, td%ncpt, ndastp)
+           ENDIF
+           DO itide = 1, td%ncpt       ! loop on tidal components
+               IF(lwp) WRITE(numout,*) 'BDYTIDE CORR:', itide, bdy_omega_tide(itide), bdy_v0tide(itide), &
+                                                 &      bdy_utide(itide), bdy_ftide(itide)
+           ENDDO
+           ! Make adjustment for reference date in tidal harmonic data
+           IF(lwp) WRITE(numout,*) 'BDYTIDE: nodal and phase correction at the start of day ', &
+                            &       (kt-1)*rdt/rday + 1
+           DO itide = 1, td%ncpt       ! loop on tidal components
+                 z_arg = bdy_utide(itide)+bdy_v0tide(itide)
+                 z_atde= bdy_ftide(itide)* cos(z_arg)
+                 z_btde= bdy_ftide(itide)* sin(z_arg)
+                  !                                         !  elevation
+              igrd = 1
+              DO ib = 1, idx%nblenrim(igrd)
+                z1t = z_atde * td%sshr(ib,itide,1) + z_btde * td%sshr(ib,itide,2)
+                z2t = z_atde * td%sshr(ib,itide,2) - z_btde * td%sshr(ib,itide,1)
+                        td%ssh(ib,itide,1) = z1t
+                        td%ssh(ib,itide,2) = z2t
+              END DO
+                  !                                         !  u
+              igrd = 2
+              DO ib = 1, idx%nblenrim(igrd)
+                  z1t = z_atde * td%ur(ib,itide,1) + z_btde * td%ur(ib,itide,2)
+                  z2t = z_atde * td%ur(ib,itide,2) - z_btde * td%ur(ib,itide,1)
+                        td%u(ib,itide,1) = z1t
+                        td%u(ib,itide,2) = z2t
+              END DO
+                  !                                         !  v
+              igrd = 3
+              DO ib = 1, idx%nblenrim(igrd)
+                  z1t = z_atde * td%vr(ib,itide,1) + z_btde * td%vr(ib,itide,2)
+                  z2t = z_atde * td%vr(ib,itide,2) - z_btde * td%vr(ib,itide,1)
+                        td%v(ib,itide,1) = z1t
+                        td%v(ib,itide,2) = z2t
+              ENDDO
+           ENDDO     ! loop on tidal components
+         ENDIF
+      ENDIF ! correct for date factors
+      IF( PRESENT(jit) ) THEN
+         IF( ln_tide_date ) THEN      ! correct for date factors
+            z_arg = ( (kt-bdy_kt_tide) * rdt + bdy_tide_offset + (jit+time_add) * rdt / REAL(nn_baro,wp) )
+         ELSE
+            z_arg = ( (kt-1) * rdt + (jit+time_add) * rdt / REAL(nn_baro,wp) )
+         ENDIF
       ELSE
+         z_arg = ((kt-kt_tide)+time_add) * rdt
+      ENDIF
+      ! Linear ramp on tidal component at open boundaries
+      zramp = 1.
+      IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg + (kt_tide-nit000)*rdt)/(rdttideramp*rday),0.),1.)
+      DO itide = 1, nb_harmo
+         z_sarg = z_arg * omega_tide(itide)
+         IF(lwp) WRITE(numout,*) 'BDYTIDE: should I be in here?'
+         IF( ln_tide_date ) THEN      ! correct for date factors
+            z_arg = (kt+time_add-bdy_kt_tide+1) * rdt + bdy_tide_offset
+         ELSE
+            z_arg = (kt+time_add) * rdt
+         ENDIF
+     ENDIF
+      DO itide = 1, td%ncpt
+         z_sarg = z_arg * td%speed(itide)
          z_cost(itide) = COS( z_sarg )
          z_sist(itide) = SIN( z_sarg )
       END DO
+      DO itide = 1, nb_harmo
+         igrd=1                              ! SSH on tracer grid
+         DO ib = 1, ilen0(igrd)
+            dta%ssh(ib) = dta%ssh(ib) + zramp*(td%ssh(ib,itide,1)*z_cost(itide) + td%ssh(ib,itide,2)*z_sist(itide))
+      DO itide = 1, td%ncpt
+         igrd=1                              ! SSH on tracer grid.
+         DO ib = 1, idx%nblenrim(igrd)
+            dta%ssh(ib) = dta%ssh(ib) + td%ssh(ib,itide,1)*z_cost(itide) + td%ssh(ib,itide,2)*z_sist(itide)
+            IF ( (idx%nbmap(ib,igrd) == 100  .and. (itide==10)) .and. (sub_step==1) ) THEN
+                 write(numout,*) 'z', ib, idx%nbmap(ib,igrd), idx%nbi(ib,igrd), idx%nbj(ib,igrd), &
+                           &  itide, (td%ssh(ib,itide,1)*z_cost(itide) + td%ssh(ib,itide,2)*z_sist(itide))
+            ENDIF
+!           IF ( (idx%nbmap(ib,igrd) == 100 .and. (itide==10)) ) THEN
+!                write(numout,*) 'z', ib, idx%nbmap(ib,igrd), idx%nbi(ib,igrd), idx%nbj(ib,igrd), &
+!                          &  itide, (td%ssh(ib,itide,1)*z_cost(itide) - td%ssh(ib,itide,2)*z_sist(itide))
+!           ENDIF
          END DO
          igrd=2                              ! U grid
+         DO ib = 1, ilen0(igrd)
+            dta%u2d(ib) = dta%u2d(ib) + zramp*(td%u  (ib,itide,1)*z_cost(itide) + td%u  (ib,itide,2)*z_sist(itide))
+         DO ib=1, idx%nblenrim(igrd)
+            dta%u2d(ib) = dta%u2d(ib) + td%u(ib,itide,1)*z_cost(itide) + td%u(ib,itide,2)*z_sist(itide)
+            !    if(lwp) write(numout,*) 'u',ib,itide,utide(ib), td%u(ib,itide,1),td%u(ib,itide,2)
          END DO
          igrd=3                              ! V grid
+         DO ib = 1, ilen0(igrd)
+            dta%v2d(ib) = dta%v2d(ib) + zramp*(td%v  (ib,itide,1)*z_cost(itide) + td%v  (ib,itide,2)*z_sist(itide))
+         DO ib=1, idx%nblenrim(igrd)
+            dta%v2d(ib) = dta%v2d(ib) + td%v(ib,itide,1)*z_cost(itide) + td%v(ib,itide,2)*z_sist(itide)
+            !    if(lwp) write(numout,*) 'v',ib,itide,vtide(ib), td%v(ib,itide,1),td%v(ib,itide,2)
          END DO
       END DO
+      !
       IF( nn_timing == 1 ) CALL timing_stop('bdytide_update')
+      IF( nn_timing == 1 ) CALL timing_stop('tide_update')
+      !
+   END SUBROUTINE bdytide_update
+   SUBROUTINE tide_init_elevation( idx, td )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE tide_init_elevation  ***
+      !!----------------------------------------------------------------------
+      TYPE(OBC_INDEX), INTENT( in )      ::   idx     ! OBC indices
+      TYPE(TIDES_DATA),INTENT( inout )   ::   td      ! tidal harmonics data
+      !! * Local declarations
+      INTEGER, DIMENSION(1)            ::   ilen0       !: length of boundary data (from OBC arrays)
+      REAL(wp),ALLOCATABLE, DIMENSION(:) ::   mod_tide, phi_tide
+      INTEGER                            ::   itide, igrd, ib      ! dummy loop indices
+      igrd=1
+                              ! SSH on tracer grid.
+      ilen0(1) =  SIZE(td%ssh0(:,1,1))
+      ALLOCATE(mod_tide(ilen0(igrd)),phi_tide(ilen0(igrd)))
+      DO itide = 1, nb_harmo
+         DO ib = 1, ilen0(igrd)
+            mod_tide(ib)=SQRT(td%ssh0(ib,itide,1)**2.+td%ssh0(ib,itide,2)**2.)
+            phi_tide(ib)=ATAN2(-td%ssh0(ib,itide,2),td%ssh0(ib,itide,1))
+         END DO
+         DO ib = 1 , ilen0(igrd)
+            mod_tide(ib)=mod_tide(ib)*ftide(itide)
+            phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide)
+         ENDDO
+         DO ib = 1 , ilen0(igrd)
+            td%ssh(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
+            td%ssh(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
+         ENDDO
+      END DO
+      DEALLOCATE(mod_tide,phi_tide)
+   END SUBROUTINE tide_init_elevation
+   SUBROUTINE tide_init_velocities( idx, td )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE tide_init_elevation  ***
+      !!----------------------------------------------------------------------
+      TYPE(OBC_INDEX), INTENT( in )      ::   idx     ! OBC indices
+      TYPE(TIDES_DATA),INTENT( inout )      ::   td      ! tidal harmonics data
+      !! * Local declarations
+      INTEGER, DIMENSION(3)            ::   ilen0       !: length of boundary data (from OBC arrays)
+      REAL(wp),ALLOCATABLE, DIMENSION(:) ::   mod_tide, phi_tide
+      INTEGER                            ::   itide, igrd, ib      ! dummy loop indices
+      ilen0(2) =  SIZE(td%u0(:,1,1))
+      ilen0(3) =  SIZE(td%v0(:,1,1))
+      igrd=2                                 ! U grid.
+      ALLOCATE(mod_tide(ilen0(igrd)),phi_tide(ilen0(igrd)))
+      DO itide = 1, nb_harmo
+         DO ib = 1, ilen0(igrd)
+            mod_tide(ib)=SQRT(td%u0(ib,itide,1)**2.+td%u0(ib,itide,2)**2.)
+            phi_tide(ib)=ATAN2(-td%u0(ib,itide,2),td%u0(ib,itide,1))
+         END DO
+         DO ib = 1, ilen0(igrd)
+            mod_tide(ib)=mod_tide(ib)*ftide(itide)
+            phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide)
+         ENDDO
+         DO ib = 1, ilen0(igrd)
+            td%u(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
+            td%u(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
+         ENDDO
+      END DO
+      DEALLOCATE(mod_tide,phi_tide)
+      igrd=3                                 ! V grid.
+      ALLOCATE(mod_tide(ilen0(igrd)),phi_tide(ilen0(igrd)))
+      DO itide = 1, nb_harmo
+         DO ib = 1, ilen0(igrd)
+            mod_tide(ib)=SQRT(td%v0(ib,itide,1)**2.+td%v0(ib,itide,2)**2.)
+            phi_tide(ib)=ATAN2(-td%v0(ib,itide,2),td%v0(ib,itide,1))
+         END DO
+         DO ib = 1, ilen0(igrd)
+            mod_tide(ib)=mod_tide(ib)*ftide(itide)
+            phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide)
+         ENDDO
+         DO ib = 1, ilen0(igrd)
+            td%v(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
+            td%v(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
+         ENDDO
+      END DO
+      DEALLOCATE(mod_tide,phi_tide)
+  END SUBROUTINE tide_init_velocities
+   END SUBROUTINE tide_update
 #else
    !!----------------------------------------------------------------------
    !!   Dummy module         NO Unstruct Open Boundary Conditions for tides
    !!----------------------------------------------------------------------
+!!gm  are you sure we need to define filtide and tide_cpt ?
+   CHARACTER(len=80), PUBLIC               ::   filtide                !: Filename root for tidal input files
+   CHARACTER(len=4 ), PUBLIC, DIMENSION(1) ::   tide_cpt               !: Names of tidal components used.
 CONTAINS
+   SUBROUTINE bdytide_init             ! Empty routine
+      WRITE(*,*) 'bdytide_init: You should not have seen this print! error?'
+   END SUBROUTINE bdytide_init
+   SUBROUTINE bdytide_update( kt, jit )   ! Empty routine
+      WRITE(*,*) 'bdytide_update: You should not have seen this print! error?', kt, jit
+   END SUBROUTINE bdytide_update
+   SUBROUTINE tide_init                ! Empty routine
+   END SUBROUTINE tide_init
+   SUBROUTINE tide_data                ! Empty routine
+   END SUBROUTINE tide_data
+   SUBROUTINE tide_update( kt, kit )   ! Empty routine
+      WRITE(*,*) 'tide_update: You should not have seen this print! error?', kt, kit
+   END SUBROUTINE tide_update
 #endif

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90

-                      r3777
+                      r6736
    !!            3.0  !  2008-04  (NEMO team)  add in the reference version
    !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge
-   !!            3.5  !  2012     (S. Mocavero, I. Epicoco) Optimization of BDY communications
    !!----------------------------------------------------------------------
 #if defined key_bdy
 …
    USE in_out_manager  ! I/O manager
    IMPLICIT NONE
    PRIVATE
    PUBLIC bdy_tra      ! routine called in tranxt.F90
-   PUBLIC bdy_tra_dmp  ! routine called in step.F90
    !!----------------------------------------------------------------------
 …
          CASE(jp_frs)
             CALL bdy_tra_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt )
-         CASE(2)
-            CALL bdy_tra_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt )
-         CASE(3)
-            CALL bdy_tra_nmn( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt )
-         CASE(4)
-            CALL bdy_tra_rnf( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt )
          CASE DEFAULT
             CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' )
          END SELECT
-         ! Boundary points should be updated
-         CALL lbc_bdy_lnk( tsa(:,:,:,jp_tem), 'T', 1., ib_bdy )
-         CALL lbc_bdy_lnk( tsa(:,:,:,jp_sal), 'T', 1., ib_bdy )
       ENDDO
+      !
    END SUBROUTINE bdy_tra
 …
       END DO
+      !
+      CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )   ; CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )    ! Boundary points should be updated
+      !
       IF( kt .eq. nit000 ) CLOSE( unit = 102 )
+      !
 …
+      !
    END SUBROUTINE bdy_tra_frs
+   SUBROUTINE bdy_tra_spe( idx, dta, kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  SUBROUTINE bdy_tra_frs  ***
+      !!
+      !! ** Purpose : Apply a specified value for tracers at open boundaries.
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER,         INTENT(in) ::   kt
+      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
+      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
+      !!
+      REAL(wp) ::   zwgt           ! boundary weight
+      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
+      INTEGER  ::   ii, ij         ! 2D addresses
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('bdy_tra_spe')
+      !
+      igrd = 1                       ! Everything is at T-points here
+      DO ib = 1, idx%nblenrim(igrd)
+         ii = idx%nbi(ib,igrd)
+         ij = idx%nbj(ib,igrd)
+         DO ik = 1, jpkm1
+            tsa(ii,ij,ik,jp_tem) = dta%tem(ib,ik) * tmask(ii,ij,ik)
+            tsa(ii,ij,ik,jp_sal) = dta%sal(ib,ik) * tmask(ii,ij,ik)
+         END DO
+      END DO
+      !
+      IF( kt .eq. nit000 ) CLOSE( unit = 102 )
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_spe')
+      !
+   END SUBROUTINE bdy_tra_spe
+   SUBROUTINE bdy_tra_nmn( idx, dta, kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  SUBROUTINE bdy_tra_nmn  ***
+      !!
+      !! ** Purpose : Duplicate the value for tracers at open boundaries.
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER,         INTENT(in) ::   kt
+      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
+      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
+      !!
+      REAL(wp) ::   zwgt           ! boundary weight
+      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
+      INTEGER  ::   ii, ij,zcoef, zcoef1,zcoef2, ip, jp   ! 2D addresses
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('bdy_tra_nmn')
+      !
+      igrd = 1                       ! Everything is at T-points here
+      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 = bdytmask(ii-1,ij  ) +  bdytmask(ii+1,ij  )
+            zcoef2 = bdytmask(ii  ,ij-1) +  bdytmask(ii  ,ij+1)
+            IF ( 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)
+               tsa(ii,ij,ik,jp_tem) = tsa(ii-1,ij  ,ik,jp_tem) * tmask(ii-1,ij  ,ik) + &
+                 &                    tsa(ii+1,ij  ,ik,jp_tem) * tmask(ii+1,ij  ,ik) + &
+                 &                    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_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)
+            ELSE
+               ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  )
+               jp = 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)
+            ENDIF
+         END DO
+      END DO
+      !
+      IF( kt .eq. nit000 ) CLOSE( unit = 102 )
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_nmn')
+      !
+   END SUBROUTINE bdy_tra_nmn
+   SUBROUTINE bdy_tra_rnf( idx, dta, kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  SUBROUTINE bdy_tra_rnf  ***
+      !!
+      !! ** Purpose : Apply the runoff values for tracers at open boundaries:
+      !!                  - specified to 0.1 PSU for the salinity
+      !!                  - duplicate the value for the temperature
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER,         INTENT(in) ::   kt
+      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
+      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
+      !!
+      REAL(wp) ::   zwgt           ! boundary weight
+      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
+      INTEGER  ::   ii, ij, ip, jp ! 2D addresses
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('bdy_tra_rnf')
+      !
+      igrd = 1                       ! Everything is at T-points here
+      DO ib = 1, idx%nblenrim(igrd)
+         ii = idx%nbi(ib,igrd)
+         ij = idx%nbj(ib,igrd)
+         DO ik = 1, jpkm1
+            ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  )
+            jp = bdytmask(ii  ,ij+1) - bdytmask(ii  ,ij-1)
+            tsa(ii,ij,ik,jp_tem) = tsa(ii+ip,ij+jp,ik,jp_tem) * tmask(ii,ij,ik)
+            tsa(ii,ij,ik,jp_sal) =                        0.1 * tmask(ii,ij,ik)
+         END DO
+      END DO
+      !
+      IF( kt .eq. nit000 ) CLOSE( unit = 102 )
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_rnf')
+      !
+   END SUBROUTINE bdy_tra_rnf
+   SUBROUTINE bdy_tra_dmp( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  SUBROUTINE bdy_tra_dmp  ***
+      !!
+      !! ** Purpose : Apply damping for tracers at open boundaries.
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER,         INTENT(in) ::   kt
+      !!
+      REAL(wp) ::   zwgt           ! boundary weight
+      REAL(wp) ::   zta, zsa, ztime
+      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
+      INTEGER  ::   ii, ij         ! 2D addresses
+      INTEGER  ::   ib_bdy         ! Loop index
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('bdy_tra_dmp')
+      !
+      DO ib_bdy=1, nb_bdy
+         IF ( ln_tra_dmp(ib_bdy) ) THEN
+            igrd = 1                       ! Everything is at T-points here
+            DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
+               ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
+               ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
+               zwgt = idx_bdy(ib_bdy)%nbd(ib,igrd)
+               DO ik = 1, jpkm1
+                  zta = zwgt * ( dta_bdy(ib_bdy)%tem(ib,ik) - tsb(ii,ij,ik,jp_tem) ) * tmask(ii,ij,ik)
+                  zsa = zwgt * ( dta_bdy(ib_bdy)%sal(ib,ik) - tsb(ii,ij,ik,jp_sal) ) * tmask(ii,ij,ik)
+                  tsa(ii,ij,ik,jp_tem) = tsa(ii,ij,ik,jp_tem) + zta
+                  tsa(ii,ij,ik,jp_sal) = tsa(ii,ij,ik,jp_sal) + zsa
+               END DO
+            END DO
+         ENDIF
+      ENDDO
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_dmp')
+      !
+   END SUBROUTINE bdy_tra_dmp
 #else
    !!----------------------------------------------------------------------
 …
       WRITE(*,*) 'bdy_tra: You should not have seen this print! error?', kt
    END SUBROUTINE bdy_tra
-   SUBROUTINE bdy_tra_dmp(kt)      ! Empty routine
-      WRITE(*,*) 'bdy_tra_dmp: You should not have seen this print! error?', kt
-   END SUBROUTINE bdy_tra_dmp
 #endif

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90

r3680	r6736
19	19	USE dyncor_c1d ! Coriolis term (c1d case) (dyn_cor_1d )
20	20	USE dynnxt_c1d ! time-stepping (dyn_nxt routine)
21		~~USE restart ! restart~~
22	21
23	22	IMPLICIT NONE

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

-                      r3294
+                      r6736
    LOGICAL, PUBLIC, PARAMETER :: lk_diaar5 = .TRUE.   ! coupled flag
    REAL(wp)                         ::   vol0         ! ocean volume (interior domain)
    REAL(wp)                         ::   area_tot     ! total ocean surface (interior domain)
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   area         ! cell surface (interior domain)
+!  REAL(wp)                         ::   vol0         ! ocean volume (interior domain)
+!  REAL(wp)                         ::   area_tot     ! total ocean surface (interior domain)
+!  REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   area         ! cell surface (interior domain)
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   thick0       ! ocean thickness (interior domain)
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sn0          ! initial salinity
+!  REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sn0          ! initial salinity
    !! * Substitutions
 …
       !!----------------------------------------------------------------------
+      !
+      ALLOCATE( area(jpi,jpj), thick0(jpi,jpj) , sn0(jpi,jpj,jpk) , STAT=dia_ar5_alloc )
+!     ALLOCATE( area(jpi,jpj), thick0(jpi,jpj) , sn0(jpi,jpj,jpk) , STAT=dia_ar5_alloc )
+      ALLOCATE( thick0(jpi,jpj) , STAT=dia_ar5_alloc )
+      !
       IF( lk_mpp             )   CALL mpp_sum ( dia_ar5_alloc )
 …
       REAL(wp) ::   zvolssh, zvol, zssh_steric, zztmp, zarho, ztemp, zsal, zmass
+      !
+      REAL(wp), POINTER, DIMENSION(:,:)     :: zarea_ssh , zbotpres       ! 2D workspace
+      REAL(wp), POINTER, DIMENSION(:,:)     :: zbotpres, zbotpresi       ! 2D workspace
+!     INTEGER, POINTER, DIMENSION(:,:)     :: zbotpresi        ! 2D workspace
       REAL(wp), POINTER, DIMENSION(:,:,:)   :: zrhd , zrhop               ! 3D workspace
       REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztsn                       ! 4D workspace
+!     REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztsn                       ! 4D workspace
       !!--------------------------------------------------------------------
       IF( nn_timing == 1 )   CALL timing_start('dia_ar5')
       CALL wrk_alloc( jpi , jpj              , zarea_ssh , zbotpres )
+      CALL wrk_alloc( jpi , jpj              , zbotpres, zbotpresi )
       CALL wrk_alloc( jpi , jpj , jpk        , zrhd      , zrhop    )
       CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn                 )
       CALL iom_put( 'cellthc', fse3t(:,:,:) )
       zarea_ssh(:,:) = area(:,:) * sshn(:,:)
+!     CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn                 )
+!     CALL iom_put( 'cellthc', fse3t(:,:,:) )
+!     zarea_ssh(:,:) = area(:,:) * sshn(:,:)
       !                                         ! total volume of liquid seawater
       zvolssh = SUM( zarea_ssh(:,:) )
       IF( lk_mpp )   CALL mpp_sum( zvolssh )
       zvol = vol0 + zvolssh
       CALL iom_put( 'voltot', zvol               )
       CALL iom_put( 'sshtot', zvolssh / area_tot )
+!     zvolssh = SUM( zarea_ssh(:,:) )
+!     IF( lk_mpp )   CALL mpp_sum( zvolssh )
+!     zvol = vol0 + zvolssh
+!     CALL iom_put( 'voltot', zvol               )
+!     CALL iom_put( 'sshtot', zvolssh / area_tot )
+      !
       ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem)                    ! thermosteric ssh
       ztsn(:,:,:,jp_sal) = sn0(:,:,:)
       CALL eos( ztsn, zrhd )                       ! now in situ density using initial salinity
+      !
       zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice
       DO jk = 1, jpkm1
          zbotpres(:,:) = zbotpres(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk)
       END DO
       IF( .NOT.lk_vvl )   zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1)
+!     ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem)                    ! thermosteric ssh
+!     ztsn(:,:,:,jp_sal) = sn0(:,:,:)
+!     CALL eos( ztsn, zrhd )                       ! now in situ density using initial salinity
+      !
+!     zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice
+!     DO jk = 1, jpkm1
+!        zbotpres(:,:) = zbotpres(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk)
+!     END DO
+!     IF( .NOT.lk_vvl )   zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1)
+      !
       zarho = SUM( area(:,:) * zbotpres(:,:) )
       IF( lk_mpp )   CALL mpp_sum( zarho )
       zssh_steric = - zarho / area_tot
       CALL iom_put( 'sshthster', zssh_steric )
+!     zarho = SUM( area(:,:) * zbotpres(:,:) )
+!     IF( lk_mpp )   CALL mpp_sum( zarho )
+!     zssh_steric = - zarho / area_tot
+!     CALL iom_put( 'sshthster', zssh_steric )
       !                                         ! steric sea surface height
       CALL eos( tsn, zrhd, zrhop )                 ! now in situ and potential density
       zrhop(:,:,jpk) = 0._wp
       CALL iom_put( 'rhop', zrhop )
+!     zrhop(:,:,jpk) = 0._wp
+!     CALL iom_put( 'rhop', zrhop )
+      !
       zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice
 …
       IF( .NOT.lk_vvl )   zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1)
+      !
       zarho = SUM( area(:,:) * zbotpres(:,:) )
       IF( lk_mpp )   CALL mpp_sum( zarho )
       zssh_steric = - zarho / area_tot
       CALL iom_put( 'sshsteric', zssh_steric )
+!     zarho = SUM( area(:,:) * zbotpres(:,:) )
+!     IF( lk_mpp )   CALL mpp_sum( zarho )
+!     zssh_steric = - zarho / area_tot
+!     CALL iom_put( 'sshsteric', zssh_steric )
       !                                         ! ocean bottom pressure
       zztmp = rau0 * grav * 1.e-4_wp               ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa
       zbotpres(:,:) = zztmp * ( zbotpres(:,:) + sshn(:,:) + thick0(:,:) )
+      CALL iom_put( 'botpres', zbotpres )
+      zbotpresi(:,:)= REAL(INT(zbotpres(:,:)))
+      CALL iom_put( 'botpres', zbotpres(:,:) - zbotpresi(:,:) )
+      CALL iom_put( 'botpresi', zbotpresi(:,:) )
       !                                         ! Mean density anomalie, temperature and salinity
       ztemp = 0._wp
       zsal  = 0._wp
       DO jk = 1, jpkm1
          DO jj = 1, jpj
             DO ji = 1, jpi
                zztmp = area(ji,jj) * fse3t(ji,jj,jk)
                ztemp = ztemp + zztmp * tsn(ji,jj,jk,jp_tem)
                zsal  = zsal  + zztmp * tsn(ji,jj,jk,jp_sal)
             END DO
          END DO
       END DO
       IF( .NOT.lk_vvl ) THEN
          ztemp = ztemp + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_tem) )
          zsal  = zsal  + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_sal) )
       ENDIF
       IF( lk_mpp ) THEN
          CALL mpp_sum( ztemp )
          CALL mpp_sum( zsal  )
       END IF
+      !
       zmass = rau0 * ( zarho + zvol )                 ! total mass of liquid seawater
       ztemp = ztemp / zvol                            ! potential temperature in liquid seawater
       zsal  = zsal  / zvol                            ! Salinity of liquid seawater
+      !
       CALL iom_put( 'masstot', zmass )
       CALL iom_put( 'temptot', ztemp )
       CALL iom_put( 'saltot' , zsal  )
+      !
       CALL wrk_dealloc( jpi , jpj              , zarea_ssh , zbotpres )
+!     ztemp = 0._wp
+!     zsal  = 0._wp
+!     DO jk = 1, jpkm1
+!        DO jj = 1, jpj
+!           DO ji = 1, jpi
+!              zztmp = area(ji,jj) * fse3t(ji,jj,jk)
+!              ztemp = ztemp + zztmp * tsn(ji,jj,jk,jp_tem)
+!              zsal  = zsal  + zztmp * tsn(ji,jj,jk,jp_sal)
+!           END DO
+!        END DO
+!     END DO
+!     IF( .NOT.lk_vvl ) THEN
+!        ztemp = ztemp + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_tem) )
+!        zsal  = zsal  + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_sal) )
+!     ENDIF
+!     IF( lk_mpp ) THEN
+!        CALL mpp_sum( ztemp )
+!        CALL mpp_sum( zsal  )
+!     END IF
+      !
+!     zmass = rau0 * ( zarho + zvol )                 ! total mass of liquid seawater
+!     ztemp = ztemp / zvol                            ! potential temperature in liquid seawater
+!     zsal  = zsal  / zvol                            ! Salinity of liquid seawater
+      !
+!     CALL iom_put( 'masstot', zmass )
+!     CALL iom_put( 'temptot', ztemp )
+!     CALL iom_put( 'saltot' , zsal  )
+      !
+      CALL wrk_dealloc( jpi , jpj              , zbotpres, zbotpresi )
       CALL wrk_dealloc( jpi , jpj , jpk        , zrhd      , zrhop    )
       CALL wrk_dealloc( jpi , jpj , jpk , jpts , ztsn                 )
+!     CALL wrk_dealloc( jpi , jpj , jpk , jpts , ztsn                 )
+      !
       IF( nn_timing == 1 )   CALL timing_stop('dia_ar5')
 …
       INTEGER  ::   ji, jj, jk  ! dummy loop indices
       REAL(wp) ::   zztmp
       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zsaldta   ! Jan/Dec levitus salinity
+!     REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zsaldta   ! Jan/Dec levitus salinity
       !!----------------------------------------------------------------------
+      !
       IF( nn_timing == 1 )   CALL timing_start('dia_ar5_init')
+      !
       CALL wrk_alloc( jpi , jpj , jpk, jpts, zsaldta )
+!     CALL wrk_alloc( jpi , jpj , jpk, jpts, zsaldta )
       !                                      ! allocate dia_ar5 arrays
       IF( dia_ar5_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' )
       area(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:)
       area_tot = SUM( area(:,:) )   ;   IF( lk_mpp )   CALL mpp_sum( area_tot )
       vol0        = 0._wp
+!     area(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:)
+!     area_tot = SUM( area(:,:) )   ;   IF( lk_mpp )   CALL mpp_sum( area_tot )
+!     vol0        = 0._wp
       thick0(:,:) = 0._wp
       DO jk = 1, jpkm1
          vol0        = vol0        + SUM( area (:,:) * tmask(:,:,jk) * fse3t_0(:,:,jk) )
+!        vol0        = vol0        + SUM( area (:,:) * tmask(:,:,jk) * fse3t_0(:,:,jk) )
          thick0(:,:) = thick0(:,:) +    tmask_i(:,:) * tmask(:,:,jk) * fse3t_0(:,:,jk)
       END DO
       IF( lk_mpp )   CALL mpp_sum( vol0 )
       CALL iom_open ( 'data_1m_salinity_nomask', inum )
       CALL iom_get  ( inum, jpdom_data, 'vosaline', zsaldta(:,:,:,1), 1  )
       CALL iom_get  ( inum, jpdom_data, 'vosaline', zsaldta(:,:,:,2), 12 )
       CALL iom_close( inum )
       sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) )
       sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:)
       IF( ln_zps ) THEN               ! z-coord. partial steps
          DO jj = 1, jpj               ! interpolation of salinity at the last ocean level (i.e. the partial step)
             DO ji = 1, jpi
                ik = mbkt(ji,jj)
                IF( ik > 1 ) THEN
                   zztmp = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) )
                   sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1)
                ENDIF
             END DO
          END DO
       ENDIF
+      !
       CALL wrk_dealloc( jpi , jpj , jpk, jpts, zsaldta )
+!     IF( lk_mpp )   CALL mpp_sum( vol0 )
+!     CALL iom_open ( 'data_1m_salinity_nomask', inum )
+!     CALL iom_get  ( inum, jpdom_data, 'vosaline', zsaldta(:,:,:,1), 1  )
+!     CALL iom_get  ( inum, jpdom_data, 'vosaline', zsaldta(:,:,:,2), 12 )
+!     CALL iom_close( inum )
+!     sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) )
+!     sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:)
+!     IF( ln_zps ) THEN               ! z-coord. partial steps
+!        DO jj = 1, jpj               ! interpolation of salinity at the last ocean level (i.e. the partial step)
+!           DO ji = 1, jpi
+!              ik = mbkt(ji,jj)
+!              IF( ik > 1 ) THEN
+!                 zztmp = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) )
+!                 sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1)
+!              ENDIF
+!           END DO
+!        END DO
+!     ENDIF
+      !
+!     CALL wrk_dealloc( jpi , jpj , jpk, jpts, zsaldta )
+      !
       IF( nn_timing == 1 )   CALL timing_stop('dia_ar5_init')

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90

-                      r3680
+                      r6736
   !!----------------------------------------------------------------------
   !!----------------------------------------------------------------------
   !!   dia_dct      :  Compute the transport through a sec.
   !!   dia_dct_init :  Read namelist.
   !!   readsec      :  Read sections description and pathway
   !!   removepoints :  Remove points which are common to 2 procs
+  !!   dia_dct      :  compute the transport through a sec.
+  !!   dia_dct_init :  read namelist.
+  !!   readsec      :  read sections description and pathway
+  !!   removepoints :  remove points which are common to 2 procs
   !!   transport    :  Compute transport for each sections
   !!   dia_dct_wri  :  Write tranports results in ascii files
   !!   interp       :  Compute temperature/salinity/density at U-point or V-point
+  !!   dia_dct_wri  :  write tranports results in ascii files
+  !!   interp       :  compute Temperature/Salinity/density on U-point or V-point
   !!
   !!----------------------------------------------------------------------
 …
   !! * Routine accessibility
+  PUBLIC   dia_dct      ! routine called by step.F90
+  PUBLIC   dia_dct_init ! routine called by opa.F90
+  PUBLIC   diadct_alloc ! routine called by nemo_init in nemogcm.F90
+  PUBLIC   dia_dct     ! routine called by step.F90
+  PUBLIC   dia_dct_init! routine called by opa.F90
   PRIVATE  readsec
   PRIVATE  removepoints
 …
   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_type_class = 14
   INTEGER            :: nb_sec
 …
      INTEGER                                      :: nb_class          ! number of boundaries for density classes
      INTEGER, DIMENSION(nb_point_max)             :: direction         ! vector direction of the point in the section
      CHARACTER(len=40),DIMENSION(nb_class_max)    :: classname         ! characteristics of the class
+     CHARACTER(len=40),DIMENSION(nb_class_max)    :: classname         ! caracteristics of the class
      REAL(wp), DIMENSION(nb_class_max)            :: zsigi           ,&! in-situ   density classes    (99 if you don't want)
                                                      zsigp           ,&! potential density classes    (99 if you don't want)
 …
   TYPE(SECTION),DIMENSION(nb_sec_max) :: secs ! Array of sections
+  REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::  transports_3d
+  REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   ::  transports_2d
 CONTAINS
-  INTEGER FUNCTION diadct_alloc()
-     !!----------------------------------------------------------------------
-     !!                   ***  FUNCTION diadct_alloc  ***
-     !!----------------------------------------------------------------------
-     INTEGER :: 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) )
-     diadct_alloc = MAXVAL( ierr )
-     IF( diadct_alloc /= 0 )   CALL ctl_warn('diadct_alloc: failed to allocate arrays')
-  END FUNCTION diadct_alloc
   SUBROUTINE dia_dct_init
 …
      !!               ***  ROUTINE diadct  ***
      !!
      !!  ** Purpose: Read the namelist parameters
+     !!  ** Purpose: Read the namelist parametres
      !!              Open output files
      !!
 …
      ENDIF
-     ! Initialise arrays to zero
-     transports_3d(:,:,:,:)=0.0
-     transports_2d(:,:,:)  =0.0
      IF( nn_timing == 1 )   CALL timing_stop('dia_dct_init')
+     !
 …
      !!               ***  ROUTINE diadct  ***
      !!
+     !!  Purpose :: Compute section transports and write it in numdct files
+     !!
+     !!  Method  :: All arrays initialised to zero in dct_init
+     !!             Each nn_dct time step call subroutine 'transports' for
+     !!               each section to sum the transports over each grid cell.
+     !!             Each nn_dctwri time step:
+     !!               Divide the arrays by the number of summations to gain
+     !!               an average value
+     !!               Call dia_dct_sum to sum relevant grid boxes to obtain
+     !!               totals for each class (density, depth, temp or sal)
+     !!               Call dia_dct_wri to write the transports into file
+     !!               Reinitialise all relevant arrays to zero
+     !!  ** Purpose: Compute sections tranport and write it in numdct file
      !!---------------------------------------------------------------------
      !! * Arguments
 …
      !! * Local variables
      INTEGER             :: jsec,            &! loop on sections
+                            iost,            &! error for opening fileout
                             itotal            ! nb_sec_max*nb_type_class*nb_class_max
      LOGICAL             :: lldebug =.FALSE.  ! debug a section
+     CHARACTER(len=160)  :: clfileout         ! fileout name
      INTEGER , DIMENSION(1)             :: ish   ! tmp array for mpp_sum
 …
      ENDIF
-     ! Initialise arrays
-     zwork(:) = 0.0
-     zsum(:,:,:) = 0.0
      IF( lwp .AND. kt==nit000+nn_dct-1 ) THEN
          WRITE(numout,*) " "
 …
            !Compute transport through section
            CALL transport(secs(jsec),lldebug,jsec)
+           CALL transport(secs(jsec),lldebug)
         ENDDO
 …
         IF( MOD(kt,nn_dctwri)==0 )THEN
            IF( lwp .AND. kt==nit000+nn_dctwri-1 )WRITE(numout,*)"      diadct: average transports and write at kt = ",kt
+           IF( lwp .AND. kt==nit000+nn_dctwri-1 )WRITE(numout,*)"      diadct: write at kt = ",kt
-           !! divide arrays by nn_dctwri/nn_dct to obtain average
-           transports_3d(:,:,:,:)=transports_3d(:,:,:,:)/(nn_dctwri/nn_dct)
-           transports_2d(:,:,:)  =transports_2d(:,:,:)  /(nn_dctwri/nn_dct)
-           ! Sum over each class
-           DO jsec=1,nb_sec
-              CALL dia_dct_sum(secs(jsec),jsec)
-           ENDDO
            !Sum on all procs
            IF( lk_mpp )THEN
 …
               !nullify transports values after writing
-              transports_3d(:,jsec,:,:)=0.
-              transports_2d(:,jsec,:  )=0.
               secs(jsec)%transport(:,:)=0.
 …
      INTEGER :: isec, iiglo, ijglo, iiloc, ijloc,iost,i1 ,i2  ! temporary  integer
      INTEGER :: jsec, jpt                                     ! dummy loop indices
+                                                              ! heat/salt tranport is actived
      INTEGER, DIMENSION(2) :: icoord
 …
      !!             *** function removepoints
      !!
+     !!   ** Purpose :: Remove points which are common to 2 procs
+     !!   ** Purpose ::
+     !!              remove points which are common to 2 procs
+     !!
      !!
      !----------------------------------------------------------------------------
 …
   END SUBROUTINE removepoints
   SUBROUTINE transport(sec,ld_debug,jsec)
+  SUBROUTINE transport(sec,ld_debug)
      !!-------------------------------------------------------------------------------------------
      !!                     ***  ROUTINE transport  ***
      !!
+     !!  Purpose ::  Compute the transport for each point in a section
+     !!  ** Purpose : Compute the transport through a section
+     !!
+     !!  ** 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.
+     !!
+     !!              !BE carefull :
+     !!              one section is a sum of segments
+     !!              one segment is defined by 2 consectuve points in sec%listPoint
+     !!              all points of sec%listPoint are positioned on the F-point of the cell.
      !!
+     !!  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,heat,salt transports for each i
+     !!              point in a section, summed over each nn_dct.
+     !!              There are several loops:
+     !!              loop on the density/temperature/salinity/level classes
+     !!              loop on the segment between 2 nodes
+     !!              loop on the level jk
+     !!              test on the density/temperature/salinity/level
+     !!
+     !! ** Output: sec%transport: volume/mass/ice/heat/salt transport in the 2 directions
+     !!
      !!
      !!-------------------------------------------------------------------------------------------
 …
      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/potential density/ssh/depth at u/v point
+     INTEGER             :: jk,jseg,jclass,   &!loop on level/segment/classes
+                            isgnu  , isgnv     !
+     INTEGER :: ii, ij ! local integer
+     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
+                ztransp1     , ztransp2     ,&!total        transport in directions 1 and 2
+                ztemp1       , ztemp2       ,&!temperature  transport     "
+                zrhoi1       , zrhoi2       ,&!mass         transport     "
+                zrhop1       , zrhop2       ,&!mass         transport     "
+                zsal1        , zsal2        ,&!salinity     transport     "
+                zice_vol_pos , zice_vol_neg ,&!volume  ice  transport     "
+                zice_surf_pos, zice_surf_neg  !surface ice  transport     "
+     REAL(wp):: ztn, zsn, zrhoi, zrhop, zsshn, zfsdep ! temperature/salinity/ssh/potential density /depth at u/v point
      TYPE(POINT_SECTION) :: k
+     REAL(wp), POINTER, DIMENSION(:,:):: zsum ! 2D work array
      !!--------------------------------------------------------
+     CALL wrk_alloc( nb_type_class , nb_class_max , zsum   )
      IF( ld_debug )WRITE(numout,*)'      Compute transport'
+     !----------------!
+     ! INITIALIZATION !
+     !----------------!
+     zsum    = 0._wp
+     zice_surf_neg = 0._wp ; zice_surf_pos = 0._wp
+     zice_vol_pos  = 0._wp ; zice_vol_neg  = 0._wp
      !---------------------------!
 …
            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',tsn(:,:,:,jp_tem) )
+                 zsn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_sal) )
+                 zrhop = interp(k%I,k%J,jk,'V',rhop)
+                 zrhoi = interp(k%I,k%J,jk,'V',rhd*rau0+rau0)
+                 zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I,k%J+1)    ) * vmask(k%I,k%J,1)
+              CASE(2,3)
+                 ztn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_tem) )
+                 zsn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_sal) )
+                 zrhop = interp(k%I,k%J,jk,'U',rhop)
+                 zrhoi = interp(k%I,k%J,jk,'U',rhd*rau0+rau0)
+                 zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I+1,k%J)    ) * umask(k%I,k%J,1)
+              END SELECT
+              zfsdep= gdept(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)
+           !-------------------------------
+           !  LOOP ON THE DENSITY CLASSES |
+           !-------------------------------
+           !The computation is made for each density class
+           DO jclass=1,MAX(1,sec%nb_class-1)
+              ztransp1=0._wp ; zrhoi1=0._wp ; zrhop1=0._wp ; ztemp1=0._wp ;zsal1=0._wp
+              ztransp2=0._wp ; zrhoi2=0._wp ; zrhop2=0._wp ; ztemp2=0._wp ;zsal2=0._wp
+              !---------------------------|
+              !     LOOP ON THE LEVEL     |
+              !---------------------------|
+              !Sum of the transport on the vertical
+              DO jk=1,jpk
+                 ! 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',tsn(:,:,:,jp_tem) )
+                    zsn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_sal) )
+                    zrhop = interp(k%I,k%J,jk,'V',rhop)
+                    zrhoi = interp(k%I,k%J,jk,'V',rhd*rau0+rau0)
+                    zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I,k%J+1)    ) * vmask(k%I,k%J,1)
+                 CASE(2,3)
+                    ztn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_tem) )
+                    zsn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_sal) )
+                    zrhop = interp(k%I,k%J,jk,'U',rhop)
+                    zrhoi = interp(k%I,k%J,jk,'U',rhd*rau0+rau0)
+                    zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I+1,k%J)    ) * umask(k%I,k%J,1)
+                 END SELECT
+                 zfsdep= gdept(k%I,k%J,jk)
+                 !----------------------------------------------!
+                 !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
+                    !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
+                    !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
+                    !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(1,jsec,jseg,jk) = transports_3d(1,jsec,jseg,jk) + zTnorm
+              IF ( sec%llstrpond ) THEN
+                 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
+                    !COMPUTE TRANSPORT
+                    !zTnorm=transport through one cell for one class
+                    !ztransp1 or ztransp2=transport through one cell i
+                    !                     for one class for one direction
+                    IF( zTnorm .GE. 0 )THEN
+                       ztransp1=zTnorm+ztransp1
+                       IF ( sec%llstrpond ) THEN
+                          ztemp1 = ztemp1  + zTnorm * ztn
+                          zsal1  = zsal1   + zTnorm * zsn
+                          zrhoi1 = zrhoi1  + zTnorm * zrhoi
+                          zrhop1 = zrhop1  + zTnorm * zrhop
+                       ENDIF
+                    ELSE
+                       ztransp2=(zTnorm)+ztransp2
+                       IF ( sec%llstrpond ) THEN
+                          ztemp2 = ztemp2  + zTnorm * ztn
+                          zsal2  = zsal2   + zTnorm * zsn
+                          zrhoi2 = zrhoi2  + zTnorm * zrhoi
+                          zrhop2 = zrhop2  + zTnorm * zrhop
+                       ENDIF
+                    ENDIF
+                 ENDIF ! end of density test
+              ENDDO!end of loop on the level
+              !ZSUM=TRANSPORT FOR EACH CLASSES FOR THE  DIRECTIONS
+              !---------------------------------------------------
+              zsum(1,jclass)     = zsum(1,jclass)+ztransp1
+              zsum(2,jclass)     = zsum(2,jclass)+ztransp2
+              IF( sec%llstrpond )THEN
+                 zsum(3 ,jclass) = zsum( 3,jclass)+zrhoi1
+                 zsum(4 ,jclass) = zsum( 4,jclass)+zrhoi2
+                 zsum(5 ,jclass) = zsum( 5,jclass)+zrhop1
+                 zsum(6 ,jclass) = zsum( 6,jclass)+zrhop2
+                 zsum(7 ,jclass) = zsum( 7,jclass)+ztemp1
+                 zsum(8 ,jclass) = zsum( 8,jclass)+ztemp2
+                 zsum(9 ,jclass) = zsum( 9,jclass)+zsal1
+                 zsum(10,jclass) = zsum(10,jclass)+zsal2
               ENDIF
            ENDDO !end of loop on the level
+           ENDDO !end of loop on the density classes
 #if defined key_lim2 || defined key_lim3
 …
               zTnorm=zumid_ice*e2u(k%I,k%J)+zvmid_ice*e1v(k%I,k%J)
+              transports_2d(1,jsec,jseg) = transports_2d(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))
+              transports_2d(2,jsec,jseg) = transports_2d(2,jsec,jseg) + (zTnorm)*   &
+                                    (1.0 -  frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J))
+              IF( zTnorm .GE. 0)THEN
+                 zice_vol_pos = (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
+                 zice_surf_pos = (zTnorm)*   &
+                                       (1.0 -  frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J))  &
+                                      +zice_surf_pos
+              ELSE
+                 zice_vol_neg=(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_neg
+                 zice_surf_neg=(zTnorm)*   &
+                                    (1.0 - frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J))  &
+                                     +zice_surf_neg
+              ENDIF
+              zsum(11,1) = zsum(11,1)+zice_vol_pos
+              zsum(12,1) = zsum(12,1)+zice_vol_neg
+              zsum(13,1) = zsum(13,1)+zice_surf_pos
+              zsum(14,1) = zsum(14,1)+zice_surf_neg
            ENDIF !end of ice case
 …
         ENDDO !end of loop on the segment
+     ENDIF !end of sec%nb_point =0 case
+     ELSE  !if sec%nb_point =0
+        zsum(1:2,:)=0.
+        IF (sec%llstrpond) zsum(3:10,:)=0.
+        zsum( 11:14,:)=0.
+     ENDIF   !end of sec%nb_point =0 case
+     !-------------------------------|
+     !FINISH COMPUTING TRANSPORTS    |
+     !-------------------------------|
+     DO jclass=1,MAX(1,sec%nb_class-1)
+        sec%transport(1,jclass)=sec%transport(1,jclass)+zsum(1,jclass)*1.E-6
+        sec%transport(2,jclass)=sec%transport(2,jclass)+zsum(2,jclass)*1.E-6
+        IF( sec%llstrpond ) THEN
+           IF( zsum(1,jclass) .NE. 0._wp ) THEN
+              sec%transport( 3,jclass) = sec%transport( 3,jclass) + zsum( 3,jclass)/zsum(1,jclass)
+              sec%transport( 5,jclass) = sec%transport( 5,jclass) + zsum( 5,jclass)/zsum(1,jclass)
+              sec%transport( 7,jclass) = sec%transport( 7,jclass) + zsum( 7,jclass)
+              sec%transport( 9,jclass) = sec%transport( 9,jclass) + zsum( 9,jclass)
+           ENDIF
+           IF( zsum(2,jclass) .NE. 0._wp )THEN
+              sec%transport( 4,jclass) = sec%transport( 4,jclass) + zsum( 4,jclass)/zsum(2,jclass)
+              sec%transport( 6,jclass) = sec%transport( 6,jclass) + zsum( 6,jclass)/zsum(2,jclass)
+              sec%transport( 8,jclass) = sec%transport( 8,jclass) + zsum( 8,jclass)
+              sec%transport(10,jclass) = sec%transport(10,jclass) + zsum(10,jclass)
+           ENDIF
+        ELSE
+           sec%transport( 3,jclass) = 0._wp
+           sec%transport( 4,jclass) = 0._wp
+           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(10,jclass) = 0._wp
+        ENDIF
+     ENDDO
+     IF( sec%ll_ice_section ) THEN
+        sec%transport( 9,1)=sec%transport( 9,1)+zsum( 9,1)*1.E-6
+        sec%transport(10,1)=sec%transport(10,1)+zsum(10,1)*1.E-6
+        sec%transport(11,1)=sec%transport(11,1)+zsum(11,1)*1.E-6
+        sec%transport(12,1)=sec%transport(12,1)+zsum(12,1)*1.E-6
+     ENDIF
+     CALL wrk_dealloc( nb_type_class , nb_class_max , zsum   )
+     !
   END SUBROUTINE transport
-  SUBROUTINE dia_dct_sum(sec,jsec)
-     !!-------------------------------------------------------------
-     !! 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 class
-     !!              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
-     !!
-     !!  Note:    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                        ! dummy variables for looping 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',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)
-              CASE(2,3)
-                 ztn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_tem) )
-                 zsn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_sal) )
-                 zrhop = interp(k%I,k%J,jk,'U',rhop)
-                 zrhoi = interp(k%I,k%J,jk,'U',rhd*rau0+rau0)
-                 zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I+1,k%J)    ) * umask(k%I,k%J,1)
-              END SELECT
-              zfsdep= gdept(k%I,k%J,jk)
-              !-------------------------------
-              !  LOOP ON THE DENSITY CLASSES |
-              !-------------------------------
-              !The computation is made for each density/temperature/salinity/depth 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(1,jsec,jseg,jk) .GE. 0.0) THEN
-                       sec%transport(1,jclass) = sec%transport(1,jclass)+transports_3d(1,jsec,jseg,jk)*1.E-6
-                    ELSE
-                       sec%transport(2,jclass) = sec%transport(2,jclass)+transports_3d(1,jsec,jseg,jk)*1.E-6
-                    ENDIF
-                    IF( sec%llstrpond )THEN
-                       IF ( transports_3d(2,jsec,jseg,jk) .GE. 0.0 ) THEN
-                          sec%transport(3,jclass) = sec%transport(3,jclass)+transports_3d(2,jsec,jseg,jk)
-                       ELSE
-                          sec%transport(4,jclass) = sec%transport(4,jclass)+transports_3d(2,jsec,jseg,jk)
-                       ENDIF
-                       IF ( transports_3d(3,jsec,jseg,jk) .GE. 0.0 ) THEN
-                          sec%transport(5,jclass) = sec%transport(5,jclass)+transports_3d(3,jsec,jseg,jk)
-                       ELSE
-                          sec%transport(6,jclass) = sec%transport(6,jclass)+transports_3d(3,jsec,jseg,jk)
-                       ENDIF
-                    ELSE
-                       sec%transport( 3,jclass) = 0._wp
-                       sec%transport( 4,jclass) = 0._wp
-                       sec%transport( 5,jclass) = 0._wp
-                       sec%transport( 6,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(1,jsec,jseg) .GE. 0.0 ) THEN
-                 sec%transport( 7,1) = sec%transport( 7,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
-              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
-              ELSE
-                 sec%transport(10,1) = sec%transport(10,1)+transports_2d(2,jsec,jseg)*1.E-6
-              ENDIF
-           ENDIF !end of ice case
-#endif
-        ENDDO !end of loop on the segment
-     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.
-     ENDIF !end of sec%nb_point =0 case
-  END SUBROUTINE dia_dct_sum
   SUBROUTINE dia_dct_wri(kt,ksec,sec)
 …
      !!
      !!        2. Write heat transports in "heat_transport"
      !!           Unit: Peta W : area * Velocity * T * rhop * Cp * 1.e-15
+     !!           Unit: Peta W : area * Velocity * T * rhau * Cp / 1.e15
      !!
      !!        3. Write salt transports in "salt_transport"
      !!           Unit: 10^9 Kg/m^2/s : area * Velocity * S * rhop * 1.e-9
+     !!           Unit: 10^9 g m^3 / s : area * Velocity * S / 1.e6
      !!
      !!-------------------------------------------------------------
 …
      !!local declarations
      INTEGER               :: jclass             ! Dummy loop
+     INTEGER               :: jcl,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
+     REAL(wp), POINTER, DIMENSION(:):: zsumclass ! 1D workspace
      !!-------------------------------------------------------------
      CALL wrk_alloc(nb_type_class , zsumclasses )
      zsumclasses(:)=0._wp
+     CALL wrk_alloc(nb_type_class , zsumclass )
+     zsumclass(:)=0._wp
      zslope = sec%slopeSection
+     DO jclass=1,MAX(1,sec%nb_class-1)
+     DO jcl=1,MAX(1,sec%nb_class-1)
+        ! Mean computation
+        sec%transport(:,jcl)=sec%transport(:,jcl)/(nn_dctwri/nn_dct)
         classe   = 'N       '
         zbnd1   = 0._wp
         zbnd2   = 0._wp
         zsumclasses(1:nb_type_class)=zsumclasses(1:nb_type_class)+sec%transport(1:nb_type_class,jclass)
+        zsumclass(1:nb_type_class)=zsumclass(1:nb_type_class)+sec%transport(1:nb_type_class,jcl)
         !insitu density classes transports
         IF( ( sec%zsigi(jclass)   .NE. 99._wp ) .AND. &
             ( sec%zsigi(jclass+1) .NE. 99._wp )       )THEN
+        IF( ( sec%zsigi(jcl)   .NE. 99._wp ) .AND. &
+            ( sec%zsigi(jcl+1) .NE. 99._wp )       )THEN
            classe = 'DI       '
            zbnd1 = sec%zsigi(jclass)
            zbnd2 = sec%zsigi(jclass+1)
+           zbnd1 = sec%zsigi(jcl)
+           zbnd2 = sec%zsigi(jcl+1)
         ENDIF
         !potential density classes transports
         IF( ( sec%zsigp(jclass)   .NE. 99._wp ) .AND. &
             ( sec%zsigp(jclass+1) .NE. 99._wp )       )THEN
+        IF( ( sec%zsigp(jcl)   .NE. 99._wp ) .AND. &
+            ( sec%zsigp(jcl+1) .NE. 99._wp )       )THEN
            classe = 'DP      '
            zbnd1 = sec%zsigp(jclass)
            zbnd2 = sec%zsigp(jclass+1)
+           zbnd1 = sec%zsigp(jcl)
+           zbnd2 = sec%zsigp(jcl+1)
         ENDIF
         !depth classes transports
         IF( ( sec%zlay(jclass)    .NE. 99._wp ) .AND. &
             ( sec%zlay(jclass+1)  .NE. 99._wp )       )THEN
+        IF( ( sec%zlay(jcl)    .NE. 99._wp ) .AND. &
+            ( sec%zlay(jcl+1)  .NE. 99._wp )       )THEN
            classe = 'Z       '
            zbnd1 = sec%zlay(jclass)
            zbnd2 = sec%zlay(jclass+1)
+           zbnd1 = sec%zlay(jcl)
+           zbnd2 = sec%zlay(jcl+1)
         ENDIF
         !salinity classes transports
         IF( ( sec%zsal(jclass) .NE. 99._wp    ) .AND. &
             ( sec%zsal(jclass+1) .NE. 99._wp  )       )THEN
+        IF( ( sec%zsal(jcl) .NE. 99._wp    ) .AND. &
+            ( sec%zsal(jcl+1) .NE. 99._wp  )       )THEN
            classe = 'S       '
            zbnd1 = sec%zsal(jclass)
            zbnd2 = sec%zsal(jclass+1)
+           zbnd1 = sec%zsal(jcl)
+           zbnd2 = sec%zsal(jcl+1)
         ENDIF
         !temperature classes transports
         IF( ( sec%ztem(jclass) .NE. 99._wp     ) .AND. &
             ( sec%ztem(jclass+1) .NE. 99._wp     )       ) THEN
+        IF( ( sec%ztem(jcl) .NE. 99._wp     ) .AND. &
+            ( sec%ztem(jcl+1) .NE. 99._wp     )       ) THEN
            classe = 'T       '
            zbnd1 = sec%ztem(jclass)
            zbnd2 = sec%ztem(jclass+1)
+           zbnd1 = sec%ztem(jcl)
+           zbnd2 = sec%ztem(jcl+1)
         ENDIF
         !write volume transport per class
         WRITE(numdct_vol,118) ndastp,kt,ksec,sec%name,zslope, &
                               jclass,classe,zbnd1,zbnd2,&
                               sec%transport(1,jclass),sec%transport(2,jclass), &
                               sec%transport(1,jclass)+sec%transport(2,jclass)
+                              jcl,classe,zbnd1,zbnd2,&
+                              sec%transport(1,jcl),sec%transport(2,jcl), &
+                              sec%transport(1,jcl)+sec%transport(2,jcl)
         IF( sec%llstrpond )THEN
 …
            !write heat transport per class:
            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
+                              jcl,classe,zbnd1,zbnd2,&
+                              sec%transport(7,jcl)*1000._wp*rcp/1.e15,sec%transport(8,jcl)*1000._wp*rcp/1.e15, &
+                              ( sec%transport(7,jcl)+sec%transport(8,jcl) )*1000._wp*rcp/1.e15
            !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
+                              jcl,classe,zbnd1,zbnd2,&
+                              sec%transport(9,jcl)*1000._wp/1.e9,sec%transport(10,jcl)*1000._wp/1.e9,&
+                              (sec%transport(9,jcl)+sec%transport(10,jcl))*1000._wp/1.e9
         ENDIF
 …
      zbnd1 = 0._wp
      zbnd2 = 0._wp
      jclass=0
+     jcl=0
      !write total volume transport
      WRITE(numdct_vol,118) ndastp,kt,ksec,sec%name,zslope, &
                            jclass,"total",zbnd1,zbnd2,&
                            zsumclasses(1),zsumclasses(2),zsumclasses(1)+zsumclasses(2)
+                           jcl,"total",zbnd1,zbnd2,&
+                           zsumclass(1),zsumclass(2),zsumclass(1)+zsumclass(2)
      IF( sec%llstrpond )THEN
 …
         !write total heat transport
         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
+                           jcl,"total",zbnd1,zbnd2,&
+                           zsumclass(7)* 1000._wp*rcp/1.e15,zsumclass(8)* 1000._wp*rcp/1.e15,&
+                           (zsumclass(7)+zsumclass(8) )* 1000._wp*rcp/1.e15
         !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
+                           jcl,"total",zbnd1,zbnd2,&
+                           zsumclass(9)*1000._wp/1.e9,zsumclass(10)*1000._wp/1.e9,&
+                           (zsumclass(9)+zsumclass(10))*1000._wp/1.e9
      ENDIF
 …
         !write total ice volume transport
         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)
+                              jcl,"ice_vol",zbnd1,zbnd2,&
+                              sec%transport(9,1),sec%transport(10,1),&
+                              sec%transport(9,1)+sec%transport(10,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)
+                              jcl,"ice_surf",zbnd1,zbnd2,&
+                              sec%transport(11,1),sec%transport(12,1), &
+                              sec%transport(11,1)+sec%transport(12,1)
      ENDIF
 …
 FORMAT(I8,1X,I8,1X,I4,1X,A30,1X,f9.2,1X,I4,3X,A8,1X,2F12.4,5X,3E15.6)
      CALL wrk_dealloc(nb_type_class , zsumclasses )
+     CALL wrk_dealloc(nb_type_class , zsumclass )
   END SUBROUTINE dia_dct_wri
 …
   !!----------------------------------------------------------------------
   !!
   !!   Purpose: compute temperature/salinity/density at U-point or V-point
+  !!   Purpose: compute Temperature/Salinity/density at U-point or V-point
   !!   --------
   !!
 …
   !!
   !!
   !!    |    I          |    I+1           |    Z=temperature/salinity/density at U-poinT
+  !!    |    I          |    I+1           |    Z=Temperature/Salinity/density at U-poinT
   !!    |               |                  |
   !!  ----------------------------------------  1. Veritcal interpolation: compute zbis
+  !!  ----------------------------------------  1. Veritcale interpolation: compute zbis
   !!    |               |                  |       interpolation between ptab(I,J,K) and ptab(I,J,K+1)
   !!    |               |                  |       zbis =
 …
      zdep2 = fsdept(ii2,ij2,kk) - zdepu
      ! weights
+     !weights
      zwgt1 = SQRT( ( 0.5 * zet1 ) * ( 0.5 * zet1 ) + ( zdep1 * zdep1 ) )
      zwgt2 = SQRT( ( 0.5 * zet2 ) * ( 0.5 * zet2 ) + ( zdep2 * zdep2 ) )
 …
         IF( ze3t >= 0. )THEN
            ! zbis
+           !zbis
            zbis = ptab(ii2,ij2,kk) + zwgt1 * ( ptab(ii2,ij2,kk-1) - ptab(ii2,ij2,kk) )
            ! result
             interp = umask(ii1,ij1,kk) * ( zet2 * ptab(ii1,ij1,kk) + zet1 * zbis )/( zet1 + zet2 )
         ELSE
            ! zbis
+           !zbis
            zbis = ptab(ii1,ij1,kk) + zwgt2 * ( ptab(ii1,ij1,kk-1) - ptab(ii1,ij2,kk) )
            ! result
 …
    END SUBROUTINE dia_dct_init
    SUBROUTINE dia_dct( kt )         ! Dummy routine
       INTEGER, INTENT( in ) :: kt   ! ocean time-step index
+   SUBROUTINE dia_dct( kt )           ! Dummy routine
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
       WRITE(*,*) 'dia_dct: You should not have seen this print! error?', kt
    END SUBROUTINE dia_dct

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90

-                      r3294
+                      r6736
 #else
       DO jh = 1, nb_ana
       CALL iom_put( TRIM(tname(jh))//'x_v', out_u(:,:,jh) )
       CALL iom_put( TRIM(tname(jh))//'y_v', out_u(:,:,nb_ana+jh) )
+      CALL iom_put( TRIM(tname(jh))//'x_v', out_v(:,:,jh) )
+      CALL iom_put( TRIM(tname(jh))//'y_v', out_v(:,:,nb_ana+jh) )
       END DO
 #endif

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

-                      r3625
+                      r6736
       z_frc_trd_s =           SUM( sbc_tsc(:,:,jp_sal) * surf(:,:) )     ! salt fluxes
       ! Add penetrative solar radiation
       IF( ln_traqsr )   z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * SUM( qsr     (:,:) * surf(:,:) )
+      IF( ln_traqsr )   z_frc_trd_t = z_frc_trd_t + ro0cpr * SUM( qsr     (:,:) * surf(:,:) )
       ! Add geothermal heat flux
       IF( ln_trabbc )   z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * SUM( qgh_trd0(:,:) * surf(:,:) )
+      IF( ln_trabbc )   z_frc_trd_t = z_frc_trd_t + ro0cpr * SUM( qgh_trd0(:,:) * surf(:,:) )
       IF( lk_mpp ) THEN
          CALL mpp_sum( z_frc_trd_v )

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

-                      r3704
+                      r6736
    USE sbc_oce         ! Surface boundary condition: ocean fields
    USE sbc_ice         ! Surface boundary condition: ice fields
-   USE icb_oce         ! Icebergs
-   USE icbdia          ! Iceberg budgets
    USE sbcssr          ! restoring term toward SST/SSS climatology
    USE phycst          ! physical constants
 …
    INTEGER ::   nid_T, nz_T, nh_T, ndim_T, ndim_hT   ! grid_T file
-   INTEGER ::          nb_T              , ndim_bT   ! grid_T file
    INTEGER ::   nid_U, nz_U, nh_U, ndim_U, ndim_hU   ! grid_U file
    INTEGER ::   nid_V, nz_V, nh_V, ndim_V, ndim_hV   ! grid_V file
 …
    INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV
    INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_T, ndex_U, ndex_V
-   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_bT
    !! * Substitutions
 …
       CALL iom_put( "sss2"   , tsn(:,:,1,jp_sal) * tsn(:,:,1,jp_sal) )    ! square of sea surface salinity
       CALL iom_put( "uoce"   , un                                    )    ! i-current
-      CALL iom_put( "suoce"  , un(:,:,1)                             )    ! surface i-current
       CALL iom_put( "voce"   , vn                                    )    ! j-current
+      CALL iom_put( "svoce"  , vn(:,:,1)                             )    ! surface j-current
       CALL iom_put( "avt"    , avt                                   )    ! T vert. eddy diff. coef.
       CALL iom_put( "avm"    , avmu                                  )    ! T vert. eddy visc. coef.
 …
       INTEGER  ::   ierr                                     ! error code return from allocation
       INTEGER  ::   iimi, iima, ipk, it, itmod, ijmi, ijma   ! local integers
-      INTEGER  ::   jn, ierror                               ! local integers
       REAL(wp) ::   zsto, zout, zmax, zjulian, zdt           ! local scalars
       !!
 …
          CALL wheneq( jpi*jpj*ipk, tmask, 1, 1., ndex_T , ndim_T  )      ! volume
          CALL wheneq( jpi*jpj    , tmask, 1, 1., ndex_hT, ndim_hT )      ! surface
+         !
-         IF( ln_icebergs ) THEN
+            !
-            !! allocation cant go in dia_wri_alloc because ln_icebergs is only set after
-            !! that routine is called from nemogcm, so do it here immediately before its needed
-            ALLOCATE( ndex_bT(jpi*jpj*nclasses), STAT=ierror )
-            IF( lk_mpp )   CALL mpp_sum( ierror )
-            IF( ierror /= 0 ) THEN
-               CALL ctl_stop('dia_wri: failed to allocate iceberg diagnostic array')
-               RETURN
-            ENDIF
+            !
-            !! iceberg vertical coordinate is class number
-            CALL histvert( nid_T, "class", "Iceberg class",      &  ! Vertical grid: class
-               &           "number", nclasses, class_num, nb_T )
+            !
-            !! each class just needs the surface index pattern
-            ndim_bT = 3
-            DO jn = 1,nclasses
-               ndex_bT((jn-1)*jpi*jpj+1:jn*jpi*jpj) = ndex_hT(1:jpi*jpj)
-            ENDDO
+            !
-         ENDIF
          ! Define the U grid FILE ( nid_U )
 …
          CALL histdef( nid_T, "sossheig", "Sea Surface Height"                 , "m"      ,   &  ! ssh
             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+!!$#if defined key_lim3 || defined key_lim2
+!!$         ! sowaflup = sowaflep + sorunoff + sowafldp + a term associated to
+!!$         !    internal damping to Levitus that can be diagnosed from others
+!!$         ! sowaflcd = sowaflep + sorunoff + sowafldp + iowaflup
+!!$         CALL histdef( nid_T, "iowaflup", "Ice=>ocean net freshwater"          , "kg/m2/s",   &  ! fsalt
+!!$            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+!!$         CALL histdef( nid_T, "sowaflep", "atmos=>ocean net freshwater"        , "kg/m2/s",   &  ! fmass
+!!$            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+!!$#endif
          CALL histdef( nid_T, "sowaflup", "Net Upward Water Flux"              , "Kg/m2/s",   &  ! (emp-rnf)
             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sosfldow", "downward salt flux"                 , "PSU/m2/s",  &  ! sfx
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+#if ! defined key_vvl
+         CALL histdef( nid_T, "sosst_cd", "Concentration/Dilution term on temperature"        &  ! emp * tsn(:,:,1,jp_tem)
+            &                                                                  , "KgC/m2/s",  &  ! sosst_cd
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sosss_cd", "Concentration/Dilution term on salinity"           &  ! emp * tsn(:,:,1,jp_sal)
+            &                                                                  , "KgPSU/m2/s",&  ! sosss_cd
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+#endif
+!!$         CALL histdef( nid_T, "sorunoff", "Runoffs"                            , "Kg/m2/s",   &  ! runoffs
+!!$            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sowaflcd", "concentration/dilution water flux"  , "kg/m2/s",   &  ! (emps-rnf)
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sosalflx", "Surface Salt Flux"                  , "Kg/m2/s",   &  ! (emps-rnf) * sn
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
          CALL histdef( nid_T, "sohefldo", "Net Downward Heat Flux"             , "W/m2"   ,   &  ! qns + qsr
             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
 …
          CALL histdef( nid_T, "sowindsp", "wind speed at 10m"                  , "m/s"    ,   &  ! wndm
             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+!
+         IF( ln_icebergs ) THEN
+            CALL histdef( nid_T, "calving"             , "calving mass input"                       , "kg/s"   , &
+               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+            CALL histdef( nid_T, "calving_heat"        , "calving heat flux"                        , "XXXX"   , &
+               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+            CALL histdef( nid_T, "berg_floating_melt"  , "Melt rate of icebergs + bits"             , "kg/m2/s", &
+               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+            CALL histdef( nid_T, "berg_stored_ice"     , "Accumulated ice mass by class"            , "kg"     , &
+               &          jpi, jpj, nh_T, nclasses  , 1, nclasses  , nb_T , 32, clop, zsto, zout )
+            IF( ln_bergdia ) THEN
+               CALL histdef( nid_T, "berg_melt"           , "Melt rate of icebergs"                    , "kg/m2/s", &
+         IF( ln_ssr ) THEN
+            IF( nn_sstr /= 0 ) THEN
+               CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping", "W/m2"      ,   &  ! qrp
                   &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+               CALL histdef( nid_T, "berg_buoy_melt"      , "Buoyancy component of iceberg melt rate"  , "kg/m2/s", &
+            ENDIF
+            IF( nn_sssr /= 0 ) THEN
+               CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"  , "Kg/m2/s",   &  ! erp
                   &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
                CALL histdef( nid_T, "berg_eros_melt"      , "Erosion component of iceberg melt rate"   , "kg/m2/s", &
+               CALL histdef( nid_T, "sosafldp", "Surface salt flux: damping"   , "Kg/m2/s",   &  ! erp * sn
                   &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-               CALL histdef( nid_T, "berg_conv_melt"      , "Convective component of iceberg melt rate", "kg/m2/s", &
-                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-               CALL histdef( nid_T, "berg_virtual_area"   , "Virtual coverage by icebergs"             , "m2"     , &
-                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-               CALL histdef( nid_T, "bits_src"           , "Mass source of bergy bits"                , "kg/m2/s", &
-                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-               CALL histdef( nid_T, "bits_melt"          , "Melt rate of bergy bits"                  , "kg/m2/s", &
-                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-               CALL histdef( nid_T, "bits_mass"          , "Bergy bit density field"                  , "kg/m2"  , &
-                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-               CALL histdef( nid_T, "berg_mass"           , "Iceberg density field"                    , "kg/m2"  , &
-                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-               CALL histdef( nid_T, "berg_real_calving"   , "Calving into iceberg class"               , "kg/s"   , &
-                  &          jpi, jpj, nh_T, nclasses  , 1, nclasses  , nb_T , 32, clop, zsto, zout )
             ENDIF
          ENDIF
-#if ! defined key_coupled
-         CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp
-            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-         CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp
-            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-         CALL histdef( nid_T, "sosafldp", "Surface salt flux: damping"         , "Kg/m2/s",   &  ! erp * sn
-            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-#endif
-#if ( defined key_coupled && ! defined key_lim3 && ! defined key_lim2 )
-         CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp
-            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-         CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp
-            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-         CALL histdef( nid_T, "sosafldp", "Surface salt flux: Damping"         , "Kg/m2/s",   &  ! erp * sn
-            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-#endif
          clmx ="l_max(only(x))"    ! max index on a period
          CALL histdef( nid_T, "sobowlin", "Bowl Index"                         , "W-point",   &  ! bowl INDEX
             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clmx, zsto, zout )
 #if defined key_diahth
          CALL histdef( nid_T, "sothedep", "Thermocline Depth"                  , "m"      ,   & ! hth
             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
          CALL histdef( nid_T, "so20chgt", "Depth of 20C isotherm"              , "m"      ,   & ! hd20
             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
          CALL histdef( nid_T, "so28chgt", "Depth of 28C isotherm"              , "m"      ,   & ! hd28
             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
          CALL histdef( nid_T, "sohtc300", "Heat content 300 m"                 , "W"      ,   & ! htc3
+         CALL histdef( nid_T, "sothedep", "Thermocline Depth"                  , "m"      ,   &  ! hth
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "so20chgt", "Depth of 20C isotherm"              , "m"      ,   &  ! hd20
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "so28chgt", "Depth of 28C isotherm"              , "m"      ,   &  ! hd28
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sohtc300", "Heat content 300 m"                 , "W"      ,   &  ! htc3
             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
 #endif
 …
 # if defined key_lim3
          Must be adapted to LIM3
+# endif
+# if defined key_lim2
+# else
          CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature"            , "K"      ,   &  ! tn_ice
             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
 …
       CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal), ndim_hT, ndex_hT )   ! sea surface salinity
       CALL histwrite( nid_T, "sossheig", it, sshn          , ndim_hT, ndex_hT )   ! sea surface height
+!!$#if  defined key_lim3 || defined key_lim2
+!!$      CALL histwrite( nid_T, "iowaflup", it, fsalt(:,:)    , ndim_hT, ndex_hT )   ! ice=>ocean water flux
+!!$      CALL histwrite( nid_T, "sowaflep", it, fmass(:,:)    , ndim_hT, ndex_hT )   ! atmos=>ocean water flux
+!!$#endif
       CALL histwrite( nid_T, "sowaflup", it, ( emp-rnf )   , ndim_hT, ndex_hT )   ! upward water flux
+      CALL histwrite( nid_T, "sosfldow", it, sfx           , ndim_hT, ndex_hT )   ! downward salt flux
+                                                                                  ! (includes virtual salt flux beneath ice
+                                                                                  ! in linear free surface case)
+#if ! defined key_vvl
+      zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_tem)
+      CALL histwrite( nid_T, "sosst_cd", it, zw2d, ndim_hT, ndex_hT )             ! c/d term on sst
+      zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_sal)
+      CALL histwrite( nid_T, "sosss_cd", it, zw2d, ndim_hT, ndex_hT )             ! c/d term on sss
+#endif
+!!$      CALL histwrite( nid_T, "sorunoff", it, runoff        , ndim_hT, ndex_hT )   ! runoff
+      CALL histwrite( nid_T, "sowaflcd", it, ( emps-rnf )  , ndim_hT, ndex_hT )   ! c/d water flux
+      zw2d(:,:) = ( emps(:,:) - rnf(:,:) ) * tsn(:,:,1,jp_sal) * tmask(:,:,1)
+      CALL histwrite( nid_T, "sosalflx", it, zw2d          , ndim_hT, ndex_hT )   ! c/d salt flux
       CALL histwrite( nid_T, "sohefldo", it, qns + qsr     , ndim_hT, ndex_hT )   ! total heat flux
       CALL histwrite( nid_T, "soshfldo", it, qsr           , ndim_hT, ndex_hT )   ! solar heat flux
 …
       CALL histwrite( nid_T, "soicecov", it, fr_i          , ndim_hT, ndex_hT )   ! ice fraction
       CALL histwrite( nid_T, "sowindsp", it, wndm          , ndim_hT, ndex_hT )   ! wind speed
+!
+      IF( ln_icebergs ) THEN
+         !
+         CALL histwrite( nid_T, "calving"             , it, berg_grid%calving      , ndim_hT, ndex_hT )
+         CALL histwrite( nid_T, "calving_heat"        , it, berg_grid%calving_hflx , ndim_hT, ndex_hT )
+         CALL histwrite( nid_T, "berg_floating_melt"  , it, berg_grid%floating_melt, ndim_hT, ndex_hT )
+         !
+         CALL histwrite( nid_T, "berg_stored_ice"     , it, berg_grid%stored_ice   , ndim_bT, ndex_bT )
+         !
+         IF( ln_bergdia ) THEN
+            CALL histwrite( nid_T, "berg_melt"           , it, berg_melt        , ndim_hT, ndex_hT   )
+            CALL histwrite( nid_T, "berg_buoy_melt"      , it, buoy_melt        , ndim_hT, ndex_hT   )
+            CALL histwrite( nid_T, "berg_eros_melt"      , it, eros_melt        , ndim_hT, ndex_hT   )
+            CALL histwrite( nid_T, "berg_conv_melt"      , it, conv_melt        , ndim_hT, ndex_hT   )
+            CALL histwrite( nid_T, "berg_virtual_area"   , it, virtual_area     , ndim_hT, ndex_hT   )
+            CALL histwrite( nid_T, "bits_src"            , it, bits_src         , ndim_hT, ndex_hT   )
+            CALL histwrite( nid_T, "bits_melt"           , it, bits_melt        , ndim_hT, ndex_hT   )
+            CALL histwrite( nid_T, "bits_mass"           , it, bits_mass        , ndim_hT, ndex_hT   )
+            CALL histwrite( nid_T, "berg_mass"           , it, berg_mass        , ndim_hT, ndex_hT   )
+            !
+            CALL histwrite( nid_T, "berg_real_calving"   , it, real_calving     , ndim_bT, ndex_bT   )
+      IF( ln_ssr ) THEN
+         IF( nn_sstr /= 0 ) THEN
+            CALL histwrite( nid_T, "sohefldp", it, qrp     , ndim_hT, ndex_hT )   ! heat flux damping
          ENDIF
+      ENDIF
+#if ! defined key_coupled
+      CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping
+      CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping
+      IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1)
+      CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping
+#endif
+#if ( defined key_coupled && ! defined key_lim3 && ! defined key_lim2 )
+      CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping
+      CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping
+         IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1)
+      CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping
+#endif
+         IF( nn_sssr /= 0 ) THEN
+            CALL histwrite( nid_T, "sowafldp", it, erp     , ndim_hT, ndex_hT )   ! freshwater flux damping
+            zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1)
+            CALL histwrite( nid_T, "sosafldp", it, zw2d    , ndim_hT, ndex_hT )   ! salt flux damping
+         ENDIF
+      ENDIF
       zw2d(:,:) = FLOAT( nmln(:,:) ) * tmask(:,:,1)
       CALL histwrite( nid_T, "sobowlin", it, zw2d          , ndim_hT, ndex_hT )   ! ???
 …
       CALL histwrite( nid_T, "soicetem", it, tn_ice        , ndim_hT, ndex_hT )   ! surf. ice temperature
       CALL histwrite( nid_T, "soicealb", it, alb_ice       , ndim_hT, ndex_hT )   ! ice albedo
+# endif
+# if defined key_lim2
+# else
       CALL histwrite( nid_T, "soicetem", it, tn_ice(:,:,1) , ndim_hT, ndex_hT )   ! surf. ice temperature
       CALL histwrite( nid_T, "soicealb", it, alb_ice(:,:,1), ndim_hT, ndex_hT )   ! ice albedo
 …
       !!----------------------------------------------------------------------
+      !
-!     IF( nn_timing == 1 )   CALL timing_start('dia_wri_state') ! not sure this works for routines not called in first timestep
       ! 0. Initialisation
       ! -----------------
 …
       ENDIF
 #endif
-!     IF( nn_timing == 1 )   CALL timing_stop('dia_wri_state') ! not sure this works for routines not called in first timestep
+      !

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90

-                      r3764
+                      r6736
     !!  level 14: qct(:,:)                 equivalent flux due to treshold SST
     !!  level 15: fbt(:,:)                 feedback term .
+    !!  level 16: ( emp * sss )            concentration/dilution term on salinity
+    !!  level 17: ( emp * sst )            concentration/dilution term on temperature
+    !!  level 16: ( emps(:,:) - rnf(:,:) ) concentration/dilution water flux
     !!  level 17: fsalt(:,:)               Ice=>ocean net freshwater
     !!  level 18: gps(:,:)                 the surface pressure (m).
 …
     inbsel = 18
+    inbsel = 17
     IF( inbsel >  jpk ) THEN
 …
        !        fsel(:,:,14) = fsel(:,:,14) + qct(:,:)
        !        fsel(:,:,15) = fsel(:,:,15) + fbt(:,:)
+       fsel(:,:,16) = fsel(:,:,16) + ( emp(:,:)*tsn(:,:,1,jp_sal) )
+       fsel(:,:,17) = fsel(:,:,17) + ( emp(:,:)*tsn(:,:,1,jp_tem) )
+       fsel(:,:,16) = fsel(:,:,16) + ( emps(:,:)-rnf(:,:) )
+       !
        ! Output of dynamics and tracer fields and selected fields
 …
           !         fsel(:,:,14) =  qct(:,:)
           !         fsel(:,:,15) =  fbt(:,:)
+          fsel(:,:,16) = ( emp(:,:)-tsn(:,:,1,jp_sal) ) * tmask(:,:,1)
+          fsel(:,:,17) = ( emp(:,:)-tsn(:,:,1,jp_tem) ) * tmask(:,:,1)
+          fsel(:,:,16) = ( emps(:,:)-rnf(:,:) ) * tmask(:,:,1)
+          !
           !         qct(:,:) = 0._wp

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90

-                      r3632
+                      r6736
    USE oce             ! dynamics and tracers
    USE dom_oce         ! ocean space and time domain
-   USE phycst          ! physical constants
    USE in_out_manager  ! I/O manager
    USE sbc_oce         ! ocean surface boundary conditions
 …
       !!      put as run-off in open ocean.
       !!
       !! ** Action  :   emp updated surface freshwater fluxes and associated heat content at kt
+      !! ** Action  :   emp, emps   updated surface freshwater fluxes at kt
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! ocean model time step
 …
       REAL(wp), PARAMETER ::   rsmall = 1.e-20_wp    ! Closed sea correction epsilon
       REAL(wp)            ::   zze2, ztmp, zcorr     !
-      REAL(wp)            ::   zcoef, zcoef1         !
       COMPLEX(wp)         ::   ctmp
       REAL(wp), DIMENSION(jpncs) ::   zfwf   ! 1D workspace
 …
       ENDIF
       !                                                   !--------------------!
       !                                                   !  update emp        !
+      !                                                   !  update emp, emps  !
       zfwf = 0.e0_wp                                      !--------------------!
       IF( lk_mpp_rep ) THEN                         ! MPP reproductible calculation
 …
+            !
             IF( ncstt(jc) == 0 ) THEN           ! water/evap excess is shared by all open ocean
+               zcoef    = zfwf(jc) / surf(jpncs+1)
+               zcoef1   = rcp * zcoef
+               emp(:,:) = emp(:,:) + zcoef
+               qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:)
+               emp (:,:) = emp (:,:) + zfwf(jc) / surf(jpncs+1)
+               emps(:,:) = emps(:,:) + zfwf(jc) / surf(jpncs+1)
                ! accumulate closed seas correction
                zcorr    = zcorr    + zcoef
+               zcorr     = zcorr     + zfwf(jc) / surf(jpncs+1)
+               !
             ELSEIF( ncstt(jc) == 1 ) THEN       ! Excess water in open sea, at outflow location, excess evap shared
 …
                      IF (      ji > 1 .AND. ji < jpi   &
                          .AND. jj > 1 .AND. jj < jpj ) THEN
+                         zcoef      = zfwf(jc) / ( REAL(ncsnr(jc)) * e1e2t(ji,jj) )
+                         zcoef1     = rcp * zcoef
+                         emp(ji,jj) = emp(ji,jj) + zcoef
+                         qns(ji,jj) = qns(ji,jj) - zcoef1 * sst_m(ji,jj)
+                         emp (ji,jj) = emp (ji,jj) + zfwf(jc) / ( REAL(ncsnr(jc)) * e1e2t(ji,jj) )
+                         emps(ji,jj) = emps(ji,jj) + zfwf(jc) / ( REAL(ncsnr(jc)) * e1e2t(ji,jj) )
                      ENDIF
                    END DO
                ELSE
+                   zcoef    = zfwf(jc) / surf(jpncs+1)
+                   zcoef1   = rcp * zcoef
+                   emp(:,:) = emp(:,:) + zcoef
+                   qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:)
+                   emp (:,:) = emp (:,:) + zfwf(jc) / surf(jpncs+1)
+                   emps(:,:) = emps(:,:) + zfwf(jc) / surf(jpncs+1)
                    ! accumulate closed seas correction
                    zcorr    = zcorr    + zcoef
+                   zcorr     = zcorr     + zfwf(jc) / surf(jpncs+1)
                ENDIF
             ELSEIF( ncstt(jc) == 2 ) THEN       ! Excess e-p-r (either sign) goes to open ocean, at outflow location
 …
                   IF(      ji > 1 .AND. ji < jpi    &
                      .AND. jj > 1 .AND. jj < jpj ) THEN
+                     zcoef      = zfwf(jc) / ( REAL(ncsnr(jc)) *  e1e2t(ji,jj) )
+                     zcoef1     = rcp * zcoef
+                     emp(ji,jj) = emp(ji,jj) + zcoef
+                     qns(ji,jj) = qns(ji,jj) - zcoef1 * sst_m(ji,jj)
+                     emp (ji,jj) = emp (ji,jj) + zfwf(jc) / ( REAL(ncsnr(jc)) *  e1e2t(ji,jj) )
+                     emps(ji,jj) = emps(ji,jj) + zfwf(jc) / ( REAL(ncsnr(jc)) *  e1e2t(ji,jj) )
                   ENDIF
                END DO
 …
             DO jj = ncsj1(jc), ncsj2(jc)
                DO ji = ncsi1(jc), ncsi2(jc)
+                  zcoef      = zfwf(jc) / surf(jc)
+                  zcoef1     = rcp * zcoef
+                  emp(ji,jj) = emp(ji,jj) - zcoef
+                  qns(ji,jj) = qns(ji,jj) + zcoef1 * sst_m(ji,jj)
+                  emp (ji,jj) = emp (ji,jj) - zfwf(jc) / surf(jc)
+                  emps(ji,jj) = emps(ji,jj) - zfwf(jc) / surf(jc)
                END DO
             END DO
 …
             DO jj = ncsj1(jc), ncsj2(jc)
                DO ji = ncsi1(jc), ncsi2(jc)
                   emp(ji,jj) = emp(ji,jj) - zcorr
                   qns(ji,jj) = qns(ji,jj) + rcp * zcorr * sst_m(ji,jj)
+                  emp (ji,jj) = emp (ji,jj) - zcorr
+                  emps(ji,jj) = emps(ji,jj) - zcorr
                END DO
              END DO
 …
+      !
       emp (:,:) = emp (:,:) * tmask(:,:,1)
+      emps(:,:) = emps(:,:) * tmask(:,:,1)
+      !
       CALL lbc_lnk( emp , 'T', 1._wp )
+      CALL lbc_lnk( emps, 'T', 1._wp )
+      !
       IF( nn_timing == 1 )  CALL timing_stop('sbc_clo')

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90

-                      r3851
+                      r6736
    USE ioipsl, ONLY :   ymds2ju   ! for calendar
    USE prtctl          ! Print control
+   USE restart         !
    USE trc_oce, ONLY : lk_offline ! offline flag
    USE timing          ! Timing
-   USE restart         ! restart
    IMPLICIT NONE
 …
          IF ( nleapy == 1 ) THEN   ! we are using calandar with leap years
             IF ( MOD(nyear-1, 4) == 0 .AND. ( MOD(nyear-1, 400) == 0 .OR. MOD(nyear-1, 100) /= 0 ) ) THEN
                nyear_len(0)  = 366
             ENDIF
             IF ( MOD(nyear  , 4) == 0 .AND. ( MOD(nyear  , 400) == 0 .OR. MOD(nyear  , 100) /= 0 ) ) THEN
+               nyear_len(0) = 366
+            ENDIF
+            IF ( MOD(nyear, 4) == 0 .AND. ( MOD(nyear, 400) == 0 .OR. MOD(nyear, 100) /= 0 ) ) THEN
                nmonth_len(2) = 29
+               nyear_len(1)  = 366
+            ENDIF
+            IF ( MOD(nyear+1, 4) == 0 .AND. ( MOD(nyear+1, 400) == 0 .OR. MOD(nyear+1, 100) /= 0 ) ) THEN
+               nyear_len(2)  = 366
+               nyear_len(1) = 366
             ENDIF
          ENDIF

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

-                      r3851
+                      r6736
    !!            3.3  ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level
    !!            4.0  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
-   !!            3.5  ! 2012     (S. Mocavero, I. Epicoco) Add arrays associated
-   !!                             to the optimization of BDY communications
    !!----------------------------------------------------------------------
 …
    INTEGER, PUBLIC ::   narea             !: number for local area
    INTEGER, PUBLIC ::   nbondi, nbondj    !: mark of i- and j-direction local boundaries
-   INTEGER, ALLOCATABLE, PUBLIC ::   nbondi_bdy(:)    !: mark i-direction local boundaries for BDY open boundaries
-   INTEGER, ALLOCATABLE, PUBLIC ::   nbondj_bdy(:)    !: mark j-direction local boundaries for BDY open boundaries
-   INTEGER, ALLOCATABLE, PUBLIC ::   nbondi_bdy_b(:)  !: mark i-direction of neighbours local boundaries for BDY open boundaries
-   INTEGER, ALLOCATABLE, PUBLIC ::   nbondj_bdy_b(:)  !: mark j-direction of neighbours local boundaries for BDY open boundaries
    INTEGER, PUBLIC ::   npolj             !: north fold mark (0, 3 or 4)
    INTEGER, PUBLIC ::   nlci, nldi, nlei  !: i-dimensions of the local subdomain and its first and last indoor indices
 …
    LOGICAL, PUBLIC ::   ln_zps     =  .FALSE.   !: z-coordinate - partial step
    LOGICAL, PUBLIC ::   ln_sco     =  .FALSE.   !: s-coordinate or hybrid z-s coordinate
+   LOGICAL, PUBLIC ::   ln_s_sigma  = .FALSE.   ! use hybrid s-sigma -coordinate & stretching function
+   LOGICAL, PUBLIC ::   ln_hyb     =  .FALSE.   !: MANE1 s-coordinate or hybrid z-s coordinate
    !! All coordinates
    !! ---------------
 …
    !! =----------------======---------------
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   gsigt, gsigw   !: model level depth coefficient at t-, w-levels (analytic)
+#if defined key_smsh
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gsigt3, gsigw3  !: model level depth coefficient for sigma_s levels
+#endif
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   gsi3w          !: model level depth coefficient at w-level (sum of gsigw)
+#if defined key_smsh
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gsi3w3          !: model level depth coefficient for sigma_s levels
+#endif
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   esigt, esigw   !: vertical scale factor coef. at t-, w-levels
+#if defined key_smsh
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   esigt3, esigw3  !: vertical scale factor coef. for sigma_S levels
+#endif
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hbatv , hbatf    !: ocean depth at the vertical of  V--F
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hbatt , hbatu    !:                                 T--U  points (m)
 …
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hifv  , hiff     !: interface depth between stretching at  V--F
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hift  , hifu     !: and quasi-uniform spacing              T--U  points (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rx1              !: Maximum grid stiffness ratio
    !!----------------------------------------------------------------------
 …
    REAL(wp), PUBLIC ::   adatrj        !: number of elapsed days since the begining of the whole simulation
    !                                   !: (cumulative duration of previous runs that may have used different time-step size)
    INTEGER , PUBLIC, DIMENSION(0: 2) ::   nyear_len     !: length in days of the previous/current/next year
+   INTEGER , PUBLIC, DIMENSION(0: 1) ::   nyear_len     !: length in days of the previous/current year
    INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_len    !: length in days of the months of the current year
    INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_half   !: second since Jan 1st 0h of the current year and the half of the months
 …
          &      hv(jpi,jpj) , hvr(jpi,jpj) , hv_0(jpi,jpj) , STAT=ierr(6) )
+         !
+      ALLOCATE( gdept_0(jpk) , gdepw_0(jpk) ,                                     &
+         &      e3t_0  (jpk) , e3w_0  (jpk) , e3tp (jpi,jpj), e3wp(jpi,jpj) ,     &
+         &      gsigt  (jpk) , gsigw  (jpk) , gsi3w(jpk)    ,                     &
+         &      esigt  (jpk) , esigw  (jpk)                                 , STAT=ierr(7) )
+      ALLOCATE( gdept_0(jpk)         , gdepw_0(jpk)         ,                                     &
+         &      e3t_0  (jpk)         , e3w_0  (jpk)         , e3tp (jpi,jpj), e3wp(jpi,jpj) ,     &
+         &      gsigt  (jpk)         , gsigw  (jpk)         , gsi3w(jpk)    ,                     &
+#if defined key_smsh
+         &      gsigt3 (jpi,jpj,jpk) , gsigw3 (jpi,jpj,jpk) ,                                     &
+         &      esigt3 (jpi,jpj,jpk) , esigw3 (jpi,jpj,jpk) ,                                     &
+         &      gsi3w3 (jpi,jpj,jpk) ,                                                            &
+#endif
+         &      esigt  (jpk)         , esigw  (jpk)                                 , STAT=ierr(7) )
+         !
       ALLOCATE( hbatv (jpi,jpj) , hbatf (jpi,jpj) ,     &
 …
          &      scosrf(jpi,jpj) , scobot(jpi,jpj) ,     &
          &      hifv  (jpi,jpj) , hiff  (jpi,jpj) ,     &
          &      hift  (jpi,jpj) , hifu  (jpi,jpj) , rx1 (jpi,jpj) , STAT=ierr(8) )
+         &      hift  (jpi,jpj) , hifu  (jpi,jpj) , STAT=ierr(8) )
       ALLOCATE( mbathy(jpi,jpj) , bathy(jpi,jpj) ,                     &

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

-                      r3764
+                      r6736
    USE dyncor_c1d      ! Coriolis term (c1d case)         (cor_c1d routine)
    USE timing          ! Timing
-   USE lbclnk          ! ocean lateral boundary condition (or mpp link)
    IMPLICIT NONE
 …
                              CALL dom_zgr      ! Vertical mesh and bathymetry
                              CALL dom_msk      ! Masks
-      IF( ln_sco )           CALL dom_stiff    ! Maximum stiffness ratio/hydrostatic consistency
       IF( lk_vvl         )   CALL dom_vvl      ! Vertical variable mesh
+      !
 …
       NAMELIST/namrun/ nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   &
          &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   &
          &             nn_write, ln_dimgnnn, ln_mskland  , ln_clobber   , nn_chunksz
+         &             nn_write, ln_dimgnnn, ln_mskland  , ln_clobber   , nn_chunksz, ln_fse3t_b
       NAMELIST/namdom/ nn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh    , rn_hmin,   &
          &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,            &
 …
          WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
          WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
+         WRITE(numout,*) '      fse3t_b in restart?             ln_fse3t_b = ', ln_fse3t_b
       ENDIF
 …
    END SUBROUTINE dom_ctl
-   SUBROUTINE dom_stiff
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE dom_stiff  ***
-      !!
-      !! ** Purpose :   Diagnose maximum grid stiffness/hydrostatic consistency
-      !!
-      !! ** Method  :   Compute Haney (1991) hydrostatic condition ratio
-      !!                Save the maximum in the vertical direction
-      !!                (this number is only relevant in s-coordinates)
-      !!
-      !!                Haney, R. L., 1991: On the pressure gradient force
-      !!                over steep topography in sigma coordinate ocean models.
-      !!                J. Phys. Oceanogr., 21, 610???619.
-      !!----------------------------------------------------------------------
-      INTEGER  ::   ji, jj, jk
-      REAL(wp) ::   zrxmax
-      REAL(wp), DIMENSION(4) :: zr1
-      !!----------------------------------------------------------------------
-      rx1(:,:) = 0.e0
-      zrxmax   = 0.e0
-      zr1(:)   = 0.e0
-      DO ji = 2, jpim1
-         DO jj = 2, jpjm1
-            DO jk = 1, jpkm1
-               zr1(1) = umask(ji-1,jj  ,jk) *abs( (gdepw(ji  ,jj  ,jk  )-gdepw(ji-1,jj  ,jk  )  &
-                    &                         +gdepw(ji  ,jj  ,jk+1)-gdepw(ji-1,jj  ,jk+1)) &
-                    &                        /(gdepw(ji  ,jj  ,jk  )+gdepw(ji-1,jj  ,jk  )  &
-                    &                         -gdepw(ji  ,jj  ,jk+1)-gdepw(ji-1,jj  ,jk+1) + rsmall) )
-               zr1(2) = umask(ji  ,jj  ,jk) *abs( (gdepw(ji+1,jj  ,jk  )-gdepw(ji  ,jj  ,jk  )  &
-                    &                         +gdepw(ji+1,jj  ,jk+1)-gdepw(ji  ,jj  ,jk+1)) &
-                    &                        /(gdepw(ji+1,jj  ,jk  )+gdepw(ji  ,jj  ,jk  )  &
-                    &                         -gdepw(ji+1,jj  ,jk+1)-gdepw(ji  ,jj  ,jk+1) + rsmall) )
-               zr1(3) = vmask(ji  ,jj  ,jk) *abs( (gdepw(ji  ,jj+1,jk  )-gdepw(ji  ,jj  ,jk  )  &
-                    &                         +gdepw(ji  ,jj+1,jk+1)-gdepw(ji  ,jj  ,jk+1)) &
-                    &                        /(gdepw(ji  ,jj+1,jk  )+gdepw(ji  ,jj  ,jk  )  &
-                    &                         -gdepw(ji  ,jj+1,jk+1)-gdepw(ji  ,jj  ,jk+1) + rsmall) )
-               zr1(4) = vmask(ji  ,jj-1,jk) *abs( (gdepw(ji  ,jj  ,jk  )-gdepw(ji  ,jj-1,jk  )  &
-                    &                         +gdepw(ji  ,jj  ,jk+1)-gdepw(ji  ,jj-1,jk+1)) &
-                    &                        /(gdepw(ji  ,jj  ,jk  )+gdepw(ji  ,jj-1,jk  )  &
-                    &                         -gdepw(ji,  jj  ,jk+1)-gdepw(ji  ,jj-1,jk+1) + rsmall) )
-               zrxmax = MAXVAL(zr1(1:4))
-               rx1(ji,jj) = MAX(rx1(ji,jj), zrxmax)
-            END DO
-         END DO
-      END DO
-      CALL lbc_lnk( rx1, 'T', 1. )
-      zrxmax = MAXVAL(rx1)
-      IF( lk_mpp )   CALL mpp_max( zrxmax ) ! max over the global domain
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'dom_stiff : maximum grid stiffness ratio: ', zrxmax
-         WRITE(numout,*) '~~~~~~~~~'
-      ENDIF
-   END SUBROUTINE dom_stiff
    !!======================================================================
 END MODULE domain

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90

r3294	r6736
26	26	USE lib_mpp ! MPP library
27	27	USE timing ! Timing
28
	28	!! test - delete this line
29	29	IMPLICIT NONE
30	30	PRIVATE

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

-                      r3294
+                      r6736
       ! End of individual corrections to scale factors
+#if ! defined key_melange
       IF( ln_zps ) THEN          ! minimum of the e3t at partial cell level
+#endif
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1
                iku = mbku(ji,jj)
+#if defined key_melange
+               IF(iku>39) THEN
+#endif
+               pe3u_b(ji,jj,iku) = MIN( fse3t_b(ji,jj,iku), fse3t_b(ji+1,jj  ,iku) )
+#if defined key_melange
+               ENDIF
+#endif
                ikv = mbkv(ji,jj)
+               pe3u_b(ji,jj,iku) = MIN( fse3t_b(ji,jj,iku), fse3t_b(ji+1,jj  ,iku) )
+#if defined key_melange
+               IF(ikv>39) THEN
+#endif
                pe3v_b(ji,jj,ikv) = MIN( fse3t_b(ji,jj,ikv), fse3t_b(ji  ,jj+1,ikv) )
+            END DO
+         END DO
+      ENDIF
+#if defined key_melange
+               ENDIF
+#endif
+            END DO
+         END DO
+#if ! defined key_melange
+      ENDIF
+#endif
       pe3u_b(:,:,:) = pe3u_b(:,:,:) - fse3u_0(:,:,:)      ! anomaly to avoid zero along closed boundary/extra halos

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90

-                      r3680
+                      r6736
       IF( ln_sco ) THEN                                         ! s-coordinate
          CALL iom_rstput( 0, 0, inum4, 'hbatt', hbatt )
          CALL iom_rstput( 0, 0, inum4, 'hbatu', hbatu )
+         CALL iom_rstput( 0, 0, inum4, 'hbatt', hbatt )         !    ! depth
+         CALL iom_rstput( 0, 0, inum4, 'hbatu', hbatu )
          CALL iom_rstput( 0, 0, inum4, 'hbatv', hbatv )
          CALL iom_rstput( 0, 0, inum4, 'hbatf', hbatf )
+         !
+         CALL iom_rstput( 0, 0, inum4, 'gsigt', gsigt )         !    ! scaling coef.
+         CALL iom_rstput( 0, 0, inum4, 'gsigw', gsigw )
+         CALL iom_rstput( 0, 0, inum4, 'gsi3w', gsi3w )
+         CALL iom_rstput( 0, 0, inum4, 'esigt', esigt )
+         CALL iom_rstput( 0, 0, inum4, 'esigw', esigw )
+#if defined key_smsh
+          CALL iom_rstput( 0, 0, inum4, 'gsigt', gsigt3 )         !    ! scaling coef.
+          CALL iom_rstput( 0, 0, inum4, 'gsigw', gsigw3 )
+          CALL iom_rstput( 0, 0, inum4, 'gsi3w', gsi3w3 )
+          CALL iom_rstput( 0, 0, inum4, 'esigt', esigt3 )
+          CALL iom_rstput( 0, 0, inum4, 'esigw', esigw3 )
+#else
+          CALL iom_rstput( 0, 0, inum4, 'gsigt', gsigt )         !    ! scaling coef.
+          CALL iom_rstput( 0, 0, inum4, 'gsigw', gsigw )
+          CALL iom_rstput( 0, 0, inum4, 'gsi3w', gsi3w )
+          CALL iom_rstput( 0, 0, inum4, 'esigt', esigt )
+          CALL iom_rstput( 0, 0, inum4, 'esigw', esigw )
+#endif
+         !
          CALL iom_rstput( 0, 0, inum4, 'e3t', e3t )             !    ! scale factors
 …
          CALL iom_rstput( 0, 0, inum4, 'e3v', e3v )
          CALL iom_rstput( 0, 0, inum4, 'e3w', e3w )
+         CALL iom_rstput( 0, 0, inum4, 'rx1', rx1 )             !    ! Max. grid stiffness ratio
+         !
+         CALL iom_rstput( 0, 0, inum4, 'gdept' , gdept )    !    ! stretched system
+         CALL iom_rstput( 0, 0, inum4, 'gdepw' , gdepw )
+         !
+#if defined key_smsh
+            CALL iom_rstput( 0, 0, inum4, 'gdept', gdept, ktype = jp_r4 )
+            DO jk = 1,jpk
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     zdepu(ji,jj,jk) = MIN( gdept(ji,jj,jk) , gdept(ji+1,jj  ,jk) )
+                     zdepv(ji,jj,jk) = MIN( gdept(ji,jj,jk) , gdept(ji  ,jj+1,jk) )
+                  END DO
+               END DO
+            END DO
+            CALL lbc_lnk( zdepu, 'U', 1. )   ;   CALL lbc_lnk( zdepv, 'V', 1. )
+            CALL iom_rstput( 0, 0, inum4, 'gdepu', zdepu, ktype = jp_r4 )
+            CALL iom_rstput( 0, 0, inum4, 'gdepv', zdepv, ktype = jp_r4 )
+            CALL iom_rstput( 0, 0, inum4, 'gdepw', gdepw, ktype = jp_r4 )
+            DO jj = 1,jpj
+               DO ji = 1,jpi
+                  zprt(ji,jj) = gdept(ji,jj,mbkt(ji,jj)  ) * tmask(ji,jj,1)
+                  zprw(ji,jj) = gdepw(ji,jj,mbkt(ji,jj)+1) * tmask(ji,jj,1)
+               END DO
+            END DO
+            CALL iom_rstput( 0, 0, inum4, 'hdept', zprt, ktype = jp_r4 )
+            CALL iom_rstput( 0, 0, inum4, 'hdepw', zprw, ktype = jp_r4 )
+#endif
+         CALL iom_rstput( 0, 0, inum4, 'gdept_0' , gdept_0 )    !    ! stretched system
+         CALL iom_rstput( 0, 0, inum4, 'gdepw_0' , gdepw_0 )
       ENDIF

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

-                      r3764
+                      r6736
    !!            3.2  ! 2009-07  (R. Benshila) Suppression of rigid-lid option
    !!            3.3  ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level
-   !!            3.4  ! 2012-08  (J. Siddorn) added Siddorn and Furner stretching function
    !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  modify C1D case
    !!----------------------------------------------------------------------
+  !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
 …
    !!       zgr_zps      : z-coordinate with partial steps
    !!       zgr_sco      : s-coordinate
+   !!       fssig        : tanh stretch function
+   !!       fssig1       : Song and Haidvogel 1994 stretch function
+   !!       fgamma       : Siddorn and Furner 2012 stretching function
+   !!       fssig        : sigma coordinate non-dimensional function
+   !!       dfssig       : derivative of the sigma coordinate function    !!gm  (currently missing!)
    !!---------------------------------------------------------------------
    USE oce               ! ocean variables
 …
    !                                       !!* Namelist namzgr_sco *
-   LOGICAL  ::   ln_s_sh94   = .false.      ! use hybrid s-sig Song and Haidvogel 1994 stretching function fssig1 (ln_sco=T)
-   LOGICAL  ::   ln_s_sf12   = .true.       ! use hybrid s-z-sig Siddorn and Furner 2012 stretching function fgamma (ln_sco=T)
+   !
    REAL(wp) ::   rn_sbot_min =  300._wp     ! minimum depth of s-bottom surface (>0) (m)
    REAL(wp) ::   rn_sbot_max = 5250._wp     ! maximum depth of s-bottom surface (= ocean depth) (>0) (m)
-   REAL(wp) ::   rn_rmax     =    0.15_wp   ! maximum cut-off r-value allowed (0<rn_rmax<1)
-   REAL(wp) ::   rn_hc       =  150._wp     ! Critical depth for transition from sigma to stretched coordinates
-   ! Song and Haidvogel 1994 stretching parameters
    REAL(wp) ::   rn_theta    =    6.00_wp   ! surface control parameter (0<=rn_theta<=20)
    REAL(wp) ::   rn_thetb    =    0.75_wp   ! bottom control parameter  (0<=rn_thetb<= 1)
+   REAL(wp) ::   rn_bb       =    0.80_wp   ! stretching parameter
+   REAL(wp) ::   rn_rmax     =    0.15_wp   ! maximum cut-off r-value allowed (0<rn_rmax<1)
+!  LOGICAL  ::   ln_s_sigma  = .false.      ! use hybrid s-sigma -coordinate & stretching function fssig1 (ln_sco=T)
+   REAL(wp) ::   rn_bb       =    0.80_wp   ! stretching parameter for song and haidvogel stretching
    !                                        ! ( rn_bb=0; top only, rn_bb =1; top and bottom)
+   ! Siddorn and Furner stretching parameters
+   LOGICAL  ::   ln_sigcrit  = .false.      ! use sigma coordinates below critical depth (T) or Z coordinates (F) for Siddorn & Furner stretch
+   REAL(wp) ::   rn_alpha    =    4.4_wp    ! control parameter ( > 1 stretch towards surface, < 1 towards seabed)
+   REAL(wp) ::   rn_efold    =    0.0_wp    !  efold length scale for transition to stretched coord
+   REAL(wp) ::   rn_zs       =    1.0_wp    !  depth of surface grid box
+                           !  bottom cell depth (Zb) is a linear function of water depth Zb = H*a + b
+   REAL(wp) ::   rn_zb_a     =    0.024_wp  !  bathymetry scaling factor for calculating Zb
+   REAL(wp) ::   rn_zb_b     =   -0.2_wp    !  offset for calculating Zb
+   REAL(wp) ::   rn_hc       =  150._wp     ! Critical depth for s-sigma coordinates
+   REAL(wp) ::   rn_zsigma   =  300._wp     ! Maximum  depth for s-sigma layer
+   INTEGER  ::   nn_sig_lev  =  10          ! Maximum number of levels of s-sigma layer
+   REAL(wp) ::   rn_kth      = 15._wp    ! Approximate layer number, beyond which streching will be maximum
+   REAL(wp) ::   rn_acr      = 9.00_wp   !
   !! * Substitutions
 …
       INTEGER ::   ioptio, ibat   ! local integer
+      !
       NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco
+      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco , ln_hyb
       !!----------------------------------------------------------------------
+      !
 …
          WRITE(numout,*) '             z-coordinate - partial steps   ln_zps = ', ln_zps
          WRITE(numout,*) '             s- or hybrid z-s-coordinate    ln_sco = ', ln_sco
+         WRITE(numout,*) '             hybrid s-z-coordinates,s at shelf ln_hyb = ', ln_hyb
       ENDIF
 …
       IF( ln_zco      )   CALL zgr_zco          ! z-coordinate
       IF( ln_zps      )   CALL zgr_zps          ! Partial step z-coordinate
+      IF( ln_sco      )   CALL zgr_sco          ! s-coordinate or hybrid z-s coordinate
+      IF( ln_sco.AND. .NOT. ln_hyb )   CALL zgr_sco          ! s-coordinate or hybrid z-s coordinate (z at upper levels )
+      IF( ln_sco  .AND.     ln_hyb )   CALL zgr_hyb          ! hybrid s-sigma z      ( s- at shel
+      !
       ! final adjustment of mbathy & check
 …
       ENDIF
+      !
+      !
       CALL wrk_dealloc( jpidta, jpjdta, idta )
       CALL wrk_dealloc( jpidta, jpjdta, zdta )
 …
          END DO
       END DO
+      IF( lk_mpp )   CALL mpp_sum( icompt )
       IF( icompt == 0 ) THEN
          IF(lwp) WRITE(numout,*)'     no isolated ocean grid points'
 …
    END SUBROUTINE zgr_zps
+   FUNCTION fssig( pk ) RESULT( pf )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_init  ***
+      !!
+      !! ** Purpose :   provide the analytical function in s-coordinate
+      !!
+      !! ** Method  :   the function provide the non-dimensional position of
+      !!                T and W (i.e. between 0 and 1)
+      !!                T-points at integer values (between 1 and jpk)
+      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in) ::   pk   ! continuous "k" coordinate
+      REAL(wp)             ::   pf   ! sigma value
+      !!----------------------------------------------------------------------
+      !
+      pf =   (   TANH( rn_theta * ( -(pk-0.5_wp) / REAL(jpkm1) + rn_thetb )  )   &
+         &     - TANH( rn_thetb * rn_theta                                )  )   &
+         & * (   COSH( rn_theta                           )                      &
+         &     + COSH( rn_theta * ( 2._wp * rn_thetb - 1._wp ) )  )              &
+         & / ( 2._wp * SINH( rn_theta ) )
+      !
+   END FUNCTION fssig
+   FUNCTION fssig1( pk1, pbb ) RESULT( pf1 )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_init  ***
+      !!
+      !! ** Purpose :   provide the Song and Haidvogel version of the analytical function in s-coordinate
+      !!
+      !! ** Method  :   the function provides the non-dimensional position of
+      !!                T and W (i.e. between 0 and 1)
+      !!                T-points at integer values (between 1 and jpk)
+      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in) ::   pk1   ! continuous "k" coordinate
+      REAL(wp), INTENT(in) ::   pbb   ! Stretching coefficient
+      REAL(wp)             ::   pf1   ! sigma value
+      !!----------------------------------------------------------------------
+      !
+      IF ( rn_theta == 0._wp ) then      ! uniform sigma
+         pf1 = - ( pk1 - 0.5_wp ) / REAL( jpkm1 )
+      ELSE                        ! stretched sigma
+         pf1 =   ( 1._wp - pbb ) * ( SINH( rn_theta*(-(pk1-0.5_wp)/REAL(jpkm1)) ) ) / SINH( rn_theta )              &
+            &  + pbb * (  (TANH( rn_theta*( (-(pk1-0.5_wp)/REAL(jpkm1)) + 0.5_wp) ) - TANH( 0.5_wp * rn_theta )  )  &
+            &        / ( 2._wp * TANH( 0.5_wp * rn_theta ) )  )
+      ENDIF
+      !
+   END FUNCTION fssig1
+   FUNCTION fssig2 ( pk, kmax ) RESULT( pf2 )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_init  ***
+      !!
+      !! ** Purpose :   provide the analytical function in s-coordinate
+      !!
+      !! ** Method  :   the function provide the non-dimensional position of
+      !!                T and W (i.e. between 0 and 1)
+      !!                T-points at integer values (between 1 and kmax )
+      !!                W-points at integer values - 1/2 (between 0.5 and kmax-0.5)
+      !!
+      !! Reference  :   ???
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in   ) ::   pk   ! continuous "k" coordinate
+      REAL(wp)                ::   pf2   ! sigma value
+      INTEGER, INTENT (in)    ::   kmax ! max of sigma)level
+      !!----------------------------------------------------------------------
+      !
+      pf2 =   (   TANH( rn_theta * ( -(pk-0.5) / REAL(kmax-1,wp) + rn_thetb )  )      &
+         &     - TANH( rn_thetb * rn_theta                                )  )   &
+         & * (   COSH( rn_theta                           )                   &
+         &     + COSH( rn_theta * ( 2._wp * rn_thetb - 1._wp ) )  )                &
+         & / ( 2._wp * SINH( rn_theta ) )
+      !
+   END FUNCTION fssig2
+   FUNCTION fssig3( pk1, pbb ,kmax ) RESULT( pf3 )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_init  ***
+      !!
+      !! ** Purpose :   provide the Song and Haidvogel version of the analytical function in s-coordinate
+      !!
+      !! ** Method  :   the function provides the non-dimensional position of
+      !!                T and W (i.e. between 0 and 1)
+      !!                T-points at integer values (between 1 and jpk)
+      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+      !!
+      !! Reference  :   ???
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in   ) ::   pk1   ! continuous "k" coordinate
+      REAL(wp), INTENT(in   ) ::   pbb   ! Stretching coefficient
+      REAL(wp)                ::   pf3   ! sigma value
+      INTEGER, INTENT (in)    ::   kmax  ! max number of s-sigma levels
+      !!----------------------------------------------------------------------
+      !
+      IF ( rn_theta == 0 ) then      ! uniform sigma
+         pf3 = -(pk1-0.5_wp) / REAL( kmax-1,wp )
+      ELSE                        ! stretched sigma
+         pf3 =   (1.0-pbb) * (sinh( rn_theta*(-(pk1-0.5_wp)/REAL(kmax-1,wp)) ) ) / sinh(rn_theta) + &
+            &    pbb * ( (tanh( rn_theta*( (-(pk1-0.5_wp)/REAL(kmax-1,wp)) + 0.5_wp) ) - tanh(0.5*rn_theta) ) / &
+            &    (2._wp*tanh(0.5_wp*rn_theta) ) )
+      ENDIF
+   END FUNCTION fssig3
+    SUBROUTINE fszref (zkth, zdzmin, zacr, zhmax,jpup,zhsigm )
+      INTEGER  ::   jk                             ! dummy loop indices
+      REAL(wp) ::   zt, zw                         ! temporary scalars
+      REAL(wp) ::   zsur, za0, za1, zkth           ! Values set from parameters in
+      REAL(wp) ::   zacr, zdzmin, zhmax, zhmax_r    ! read from namelist or par_XXX.h90
+      REAL(wp) ::   zhsigm                         ! depth of sigma layer
+      INTEGER  ::   jpup, jpkmax                   ! the last sigma level and number of z-levels
+      !!----------------------------------------------------------------------
+! compute reference  depth  leveles
+      ! Set variables from parameters
+      ! ------------------------------
+      ! zkth = rn_kth       ;   zacr = rn_acr
+      ! zdzmin = rn_dzmin   ;   zhmax_r = rn_hmax
+      !  za0, za1, zsur are computed from zdzmin , zhmax, zkth, zacr
+      !
+       jpkmax= jpk - jpup
+       zhmax_r = zhmax - zhsigm
+         za1  = (  zdzmin - zhmax_r / REAL(jpkmax,wp)  )                                                      &
+            & / ( TANH((1-zkth)/zacr) - zacr/REAL(jpkmax,wp) * (  LOG( COSH( (jpkmax + 1 - zkth) / zacr) )      &
+            &                                                   - LOG( COSH( ( 1  - zkth) / zacr) )  )  )
+         za0  =     zdzmin - za1 *              TANH( (1-zkth) / zacr )
+         zsur =   - za0 - za1 * zacr * LOG( COSH( (1-zkth) / zacr )  )
+      ! Reference z-coordinate (depth - scale factor at T- and W-points)
+      ! ======================
+      IF( zkth == 0.e0 ) THEN            !  uniform vertical grid
+         za1 = zhmax_r / REAL(jpkmax-1,wp)
+         DO jk = 1, jpkmax+1
+            zw = REAL( jk,wp )
+            zt = REAL( jk,wp ) + 0.5_wp
+            gdepw_0(jk+jpup-1 ) = ( zw - 1 ) * za1 + zhsigm
+            gdept_0(jk+jpup-1 ) = ( zt - 1 ) * za1 + zhsigm
+            e3w_0  (jk+jpup-1 ) =  za1
+            e3t_0  (jk+jpup-1 ) =  za1
+         END DO
+      ELSE                                ! Madec & Imbard 1996 function
+         DO jk = 1, jpkmax+1
+            zw = REAL( jk,wp)
+            zt = REAL( jk,wp ) + 0.5_wp
+            gdepw_0(jk+jpup-1) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth) / zacr ) )  )+zhsigm
+            gdept_0(jk+jpup-1) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth) / zacr ) )  )+zhsigm
+            e3w_0  (jk+jpup-1) =          za0      + za1        * TANH(       (zw-zkth) / zacr   )
+            e3t_0  (jk+jpup-1) =          za0      + za1        * TANH(       (zt-zkth) / zacr   )
+         END DO
+         gdepw_0(jpup) = zhsigm                     ! force first w-level to be exactly at zhsigm
+      ENDIF
+      IF(lwp) WRITE (numout,*) " max and min z-vertical level",jpkmax+1,jpup
+   END SUBROUTINE  fszref
    SUBROUTINE zgr_sco
       !!----------------------------------------------------------------------
 …
       !!            hbatv = mj( hbatt )
       !!            hbatf = mi( mj( hbatt ) )
       !!          - Compute z_gsigt, z_gsigw, z_esigt, z_esigw from an analytical
+      !!          - Compute gsigt, gsigw, esigt, esigw from an analytical
       !!         function and its derivative given as function.
       !!            z_gsigt(k) = fssig (k    )
       !!            z_gsigw(k) = fssig (k-0.5)
       !!            z_esigt(k) = fsdsig(k    )
       !!            z_esigw(k) = fsdsig(k-0.5)
       !!      Three options for stretching are give, and they can be modified
       !!      following the users requirements. Nevertheless, the output as
+      !!            gsigt(k) = fssig (k    )
+      !!            gsigw(k) = fssig (k-0.5)
+      !!            esigt(k) = fsdsig(k    )
+      !!            esigw(k) = fsdsig(k-0.5)
+      !!      This routine is given as an example, it must be modified
+      !!      following the user s desiderata. nevertheless, the output as
       !!      well as the way to compute the model levels and scale factors
       !!      must be respected in order to insure second order accuracy
+      !!      must be respected in order to insure second order a!!uracy
       !!      schemes.
       !!
+      !!      The three methods for stretching available are:
+      !!
+      !!           s_sh94 (Song and Haidvogel 1994)
+      !!                a sinh/tanh function that allows sigma and stretched sigma
+      !!
+      !!           s_sf12 (Siddorn and Furner 2012?)
+      !!                allows the maintenance of fixed surface and or
+      !!                bottom cell resolutions (cf. geopotential coordinates)
+      !!                within an analytically derived stretched S-coordinate framework.
+      !!
+      !!          s_tanh  (Madec et al 1996)
+      !!                a cosh/tanh function that gives stretched coordinates
+      !!
+      !! Reference : Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408.
       !!----------------------------------------------------------------------
+      !
       INTEGER  ::   ji, jj, jk, jl           ! dummy loop argument
+      INTEGER  ::   iip1, ijp1, iim1, ijm1   ! temporary integers
+      REAL(wp) ::   zrmax, ztaper   ! temporary scalars
+      !
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zenv, ztmp, zmsk, zri, zrj, zhbat
+      NAMELIST/namzgr_sco/ln_s_sh94, ln_s_sf12, ln_sigcrit, rn_sbot_min, rn_sbot_max, rn_hc, rn_rmax,rn_theta, &
+                           rn_thetb, rn_bb, rn_alpha, rn_efold, rn_zs, rn_zb_a, rn_zb_b
+     !!----------------------------------------------------------------------
+      INTEGER  ::   inum                      ! temporary logical unit
+      INTEGER  ::   iip1, ijp1, iim1, ijm1, kdep   ! temporary integers
+      REAL(wp) ::   zcoeft, zcoefw, zrmax, ztaper, maxzenv   ! temporary scalars
+#if defined key_melange
+      REAL(wp) ::   rn_hc_bak   ! temporary scalars
+#endif
+      REAL(wp) ::   zrfact   ! temporary scalars
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: ztmpi1, ztmpi2, ztmpj1, ztmpj2
+      !
+#if defined key_fudge
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zenv, zri, zrj, zhbat, fenv
+#else
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zenv, zri, zrj, zhbat
+#endif
+#if defined key_smsh
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: esigtu3, esigtv3, esigtf3, esigwu3, esigwv3
+#else
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: gsigw3, gsigt3, gsi3w3
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: esigt3, esigw3, esigtu3, esigtv3, esigtf3, esigwu3, esigwv3
+#endif
+      NAMELIST/namzgr_sco/ rn_sbot_max, rn_sbot_min, rn_theta, rn_thetb, rn_rmax, ln_s_sigma, rn_bb, rn_hc
+#if defined key_melange
+      NAMELIST/namzgr_sco/ rn_sbot_max, rn_sbot_min, rn_theta, rn_thetb, rn_rmax, ln_s_sigma, rn_bb, rn_hc, nn_sig_lev
+#endif
+      !!----------------------------------------------------------------------
+      !
       IF( nn_timing == 1 )  CALL timing_start('zgr_sco')
+      !
+      CALL wrk_alloc( jpi, jpj,      zenv, ztmp, zmsk, zri, zrj, zhbat                           )
+      !
+      CALL wrk_alloc( jpi, jpj,      ztmpi1, ztmpi2, ztmpj1, ztmpj2         )
+#if defined key_fudge
+      CALL wrk_alloc( jpi, jpj,      zenv, zri, zrj, zhbat, fenv     )
+#else
+      CALL wrk_alloc( jpi, jpj,      zenv, zri, zrj, zhbat           )
+#endif
+#if defined key_smsh
+      CALL wrk_alloc( jpi, jpj, jpk, esigtu3, esigtv3, esigtf3, esigwu3, esigwv3 )
+#else
+      CALL wrk_alloc( jpi, jpj, jpk, gsigw3, gsigt3, gsi3w3                                      )
+      CALL wrk_alloc( jpi, jpj, jpk, esigt3, esigw3, esigtu3, esigtv3, esigtf3, esigwu3, esigwv3 )
+#endif
       REWIND( numnam )                       ! Read Namelist namzgr_sco : sigma-stretching parameters
       READ  ( numnam, namzgr_sco )
 …
          WRITE(numout,*) '~~~~~~~~~~~'
          WRITE(numout,*) '   Namelist namzgr_sco'
+         WRITE(numout,*) '     stretching coeffs '
+         WRITE(numout,*) '        maximum depth of s-bottom surface (>0)       rn_sbot_max   = ',rn_sbot_max
+         WRITE(numout,*) '        minimum depth of s-bottom surface (>0)       rn_sbot_min   = ',rn_sbot_min
+         WRITE(numout,*) '        Critical depth                               rn_hc         = ',rn_hc
+         WRITE(numout,*) '        maximum cut-off r-value allowed              rn_rmax       = ',rn_rmax
+         WRITE(numout,*) '     Song and Haidvogel 1994 stretching              ln_s_sh94     = ',ln_s_sh94
+         WRITE(numout,*) '        Song and Haidvogel 1994 stretching coefficients'
+         WRITE(numout,*) '        surface control parameter (0<=rn_theta<=20)  rn_theta      = ',rn_theta
+         WRITE(numout,*) '        bottom  control parameter (0<=rn_thetb<= 1)  rn_thetb      = ',rn_thetb
+         WRITE(numout,*) '        stretching parameter (song and haidvogel)    rn_bb         = ',rn_bb
+         WRITE(numout,*) '     Siddorn and Furner 2012 stretching              ln_s_sf12     = ',ln_s_sf12
+         WRITE(numout,*) '        switching to sigma (T) or Z (F) at H<Hc      ln_sigcrit    = ',ln_sigcrit
+         WRITE(numout,*) '        Siddorn and Furner 2012 stretching coefficients'
+         WRITE(numout,*) '        stretchin parameter ( >1 surface; <1 bottom) rn_alpha      = ',rn_alpha
+         WRITE(numout,*) '        e-fold length scale for transition region    rn_efold      = ',rn_efold
+         WRITE(numout,*) '        Surface cell depth (Zs) (m)                  rn_zs         = ',rn_zs
+         WRITE(numout,*) '        Bathymetry multiplier for Zb                 rn_zb_a       = ',rn_zb_a
+         WRITE(numout,*) '        Offset for Zb                                rn_zb_b       = ',rn_zb_b
+         WRITE(numout,*) '        Bottom cell (Zb) (m) = H*rn_zb_a + rn_zb_b'
+      ENDIF
+         WRITE(numout,*) '      sigma-stretching coeffs '
+         WRITE(numout,*) '      maximum depth of s-bottom surface (>0)       rn_sbot_max   = ' ,rn_sbot_max
+         WRITE(numout,*) '      minimum depth of s-bottom surface (>0)       rn_sbot_min   = ' ,rn_sbot_min
+         WRITE(numout,*) '      surface control parameter (0<=rn_theta<=20)  rn_theta      = ', rn_theta
+         WRITE(numout,*) '      bottom  control parameter (0<=rn_thetb<= 1)  rn_thetb      = ', rn_thetb
+         WRITE(numout,*) '      maximum cut-off r-value allowed              rn_rmax       = ', rn_rmax
+         WRITE(numout,*) '      Hybrid s-sigma-coordinate                    ln_s_sigma    = ', ln_s_sigma
+         WRITE(numout,*) '      stretching parameter (song and haidvogel)    rn_bb         = ', rn_bb
+         WRITE(numout,*) '      Critical depth                               rn_hc         = ', rn_hc
+      ENDIF
+#if defined key_melange
+      CALL zgr_zps          ! Partial step z-coordinate
+      ! Scale factors and depth at U-, V-, UW and VW-points
+      DO jk = 1, nn_sig_lev                        ! initialisation to z-scale factors above ln_s_sigma to remove any zps
+         e3u (:,:,jk) = e3t_0(jk)
+         e3v (:,:,jk) = e3t_0(jk)
+         e3uw(:,:,jk) = e3w_0(jk)
+         e3vw(:,:,jk) = e3w_0(jk)
+      END DO
+#endif
+      gsigw3  = 0._wp   ;   gsigt3  = 0._wp   ;   gsi3w3  = 0._wp
+      esigt3  = 0._wp   ;   esigw3  = 0._wp
+      esigtu3 = 0._wp   ;   esigtv3 = 0._wp   ;   esigtf3 = 0._wp
+      esigwu3 = 0._wp   ;   esigwv3 = 0._wp
       hift(:,:) = rn_sbot_min                     ! set the minimum depth for the s-coordinate
 …
       !                                        ! =============================
       ! use r-value to create hybrid coordinates
+      zenv(:,:) = bathy(:,:)
+#if defined key_melange
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+           zenv(ji,jj) = MIN( bathy(ji,jj), gdepw_0(nn_sig_lev + 1) )
+         ENDDO
+      ENDDO
+#endif
+#if defined key_fudge
+            CALL iom_open ( 'fudge.nc', inum )
+            CALL iom_get  ( inum, jpdom_data, 'zenv', fenv )
+            CALL iom_close( inum )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+              zenv(ji,jj) = MAX( zenv(ji,jj), fenv(ji,jj) )
+         ENDDO
+      ENDDO
+#endif
+      !
+      ! set first land point adjacent to a wet cell to sbot_min as this needs to be included in smoothing
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+           IF( bathy(ji,jj) == 0._wp ) THEN
+             iip1 = MIN( ji+1, jpi )
+             ijp1 = MIN( jj+1, jpj )
+             iim1 = MAX( ji-1, 1 )
+             ijm1 = MAX( jj-1, 1 )
+             IF( (bathy(iip1,jj) + bathy(iim1,jj) + bathy(ji,ijp1) + bathy(ji,ijm1) +              &
+        &         bathy(iip1,ijp1) + bathy(iim1,ijm1) + bathy(iip1,ijp1) + bathy(iim1,ijm1)) > 0._wp ) THEN
+               zenv(ji,jj) = rn_sbot_min
+             ENDIF
+           ENDIF
+         END DO
+      END DO
+      ! apply lateral boundary condition   CAUTION: keep the value when the lbc field is zero
+      CALL lbc_lnk( zenv, 'T', 1._wp, 'no0' )
+      !
+      ! smooth the bathymetry (if required)
+      scosrf(:,:) = 0._wp             ! ocean surface depth (here zero: no under ice-shelf sea)
+      scobot(:,:) = bathy(:,:)        ! ocean bottom  depth
+      !
+      jl = 0
+      zrmax = 1._wp
+      !
+      ! set scaling factor used in reducing vertical gradients
+      zrfact = ( 1._wp - rn_rmax ) / ( 1._wp + rn_rmax )
+      !
+      ! initialise temporary evelope depth arrays
+      ztmpi1(:,:) = zenv(:,:)
+      ztmpi2(:,:) = zenv(:,:)
+      ztmpj1(:,:) = zenv(:,:)
+      ztmpj2(:,:) = zenv(:,:)
+      !
+      ! initialise temporary r-value arrays
+      zri(:,:) = 1._wp
+      zrj(:,:) = 1._wp
+      !                                                            ! ================ !
+      DO WHILE( jl <= 10000 .AND. ( zrmax - rn_rmax ) > 1.e-8_wp ) !  Iterative loop  !
+         !                                                         ! ================ !
+         jl = jl + 1
+         zrmax = 0._wp
+         ! we set zrmax from previous r-values (zri and zrj) first
+         ! if set after current r-value calculation (as previously)
+         ! we could exit DO WHILE prematurely before checking r-value
+         ! of current zenv
+         DO jj = 1, nlcj
+            DO ji = 1, nlci
+               zrmax = MAX( zrmax, ABS(zri(ji,jj)), ABS(zrj(ji,jj)) )
+            END DO
+         END DO
+         zri(:,:) = 0._wp
+         zrj(:,:) = 0._wp
+         DO jj = 1, nlcj
+            DO ji = 1, nlci
+               iip1 = MIN( ji+1, nlci )      ! force zri = 0 on last line (ji=ncli+1 to jpi)
+               ijp1 = MIN( jj+1, nlcj )      ! force zrj = 0 on last raw  (jj=nclj+1 to jpj)
+               IF( (zenv(ji,jj) > 0._wp) .AND. (zenv(iip1,jj) > 0._wp)) THEN
+                  zri(ji,jj) = ( zenv(iip1,jj  ) - zenv(ji,jj) ) / ( zenv(iip1,jj  ) + zenv(ji,jj) )
+               END IF
+               IF( (zenv(ji,jj) > 0._wp) .AND. (zenv(ji,ijp1) > 0._wp)) THEN
+                  zrj(ji,jj) = ( zenv(ji  ,ijp1) - zenv(ji,jj) ) / ( zenv(ji  ,ijp1) + zenv(ji,jj) )
+               END IF
+               IF( zri(ji,jj) >  rn_rmax )   ztmpi1(ji  ,jj  ) = zenv(iip1,jj  ) * zrfact
+               IF( zri(ji,jj) < -rn_rmax )   ztmpi2(iip1,jj  ) = zenv(ji  ,jj  ) * zrfact
+               IF( zrj(ji,jj) >  rn_rmax )   ztmpj1(ji  ,jj  ) = zenv(ji  ,ijp1) * zrfact
+               IF( zrj(ji,jj) < -rn_rmax )   ztmpj2(ji  ,ijp1) = zenv(ji  ,jj  ) * zrfact
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mpp_max( zrmax )   ! max over the global domain
+         !
+         IF(lwp)WRITE(numout,*) 'zgr_sco :   iter= ',jl, ' rmax= ', zrmax
+         !
+         DO jj = 1, nlcj
+            DO ji = 1, nlci
+               zenv(ji,jj) = MAX(zenv(ji,jj), ztmpi1(ji,jj), ztmpi2(ji,jj), ztmpj1(ji,jj), ztmpj2(ji,jj) )
+            END DO
+         END DO
+         ! apply lateral boundary condition   CAUTION: keep the value when the lbc field is zero
+         CALL lbc_lnk( zenv, 'T', 1._wp, 'no0' )
+         !                                                  ! ================ !
+      END DO                                                !     End loop     !
+      !                                                     ! ================ !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zenv(ji,jj) = MAX( zenv(ji,jj), rn_sbot_min ) ! set all points to avoid undefined scale value warnings
+         END DO
+      END DO
+      !
+      ! Envelope bathymetry saved in hbatt
+      hbatt(:,:) = zenv(:,:)
+      IF( MINVAL( gphit(:,:) ) * MAXVAL( gphit(:,:) ) <= 0._wp ) THEN
+         CALL ctl_warn( ' s-coordinates are tapered in vicinity of the Equator' )
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ztaper = EXP( -(gphit(ji,jj)/8._wp)**2._wp )
+               hbatt(ji,jj) = rn_sbot_max * ztaper + hbatt(ji,jj) * ( 1._wp - ztaper )
+            END DO
+         END DO
+      ENDIF
+      !
+      IF(lwp) THEN                             ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) ' domzgr: hbatt field; ocean depth in meters'
+         WRITE(numout,*)
+         CALL prihre( hbatt(1,1), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 0._wp, numout )
+         IF( nprint == 1 )   THEN
+            WRITE(numout,*) ' bathy  MAX ', MAXVAL( bathy(:,:) ), ' MIN ', MINVAL( bathy(:,:) )
+            WRITE(numout,*) ' hbatt  MAX ', MAXVAL( hbatt(:,:) ), ' MIN ', MINVAL( hbatt(:,:) )
+         ENDIF
+      ENDIF
+      !                                        ! ==============================
+      !                                        !   hbatu, hbatv, hbatf fields
+      !                                        ! ==============================
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' zgr_sco: minimum depth of the envelop topography set to : ', rn_sbot_min
+      ENDIF
+      hbatu(:,:) = rn_sbot_min
+      hbatv(:,:) = rn_sbot_min
+      hbatf(:,:) = rn_sbot_min
+      DO jj = 1, jpjm1
+        DO ji = 1, jpim1   ! NO vector opt.
+           hbatu(ji,jj) = 0.50_wp * ( hbatt(ji  ,jj) + hbatt(ji+1,jj  ) )
+           hbatv(ji,jj) = 0.50_wp * ( hbatt(ji  ,jj) + hbatt(ji  ,jj+1) )
+           hbatf(ji,jj) = 0.25_wp * ( hbatt(ji  ,jj) + hbatt(ji  ,jj+1)   &
+              &                     + hbatt(ji+1,jj) + hbatt(ji+1,jj+1) )
+        END DO
+      END DO
+      !
+      ! Apply lateral boundary condition
+!!gm  ! CAUTION: retain non zero value in the initial file this should be OK for orca cfg, not for EEL
+      zhbat(:,:) = hbatu(:,:)   ;   CALL lbc_lnk( hbatu, 'U', 1._wp )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( hbatu(ji,jj) == 0._wp ) THEN
+               IF( zhbat(ji,jj) == 0._wp )   hbatu(ji,jj) = rn_sbot_min
+               IF( zhbat(ji,jj) /= 0._wp )   hbatu(ji,jj) = zhbat(ji,jj)
+            ENDIF
+         END DO
+      END DO
+      zhbat(:,:) = hbatv(:,:)   ;   CALL lbc_lnk( hbatv, 'V', 1._wp )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( hbatv(ji,jj) == 0._wp ) THEN
+               IF( zhbat(ji,jj) == 0._wp )   hbatv(ji,jj) = rn_sbot_min
+               IF( zhbat(ji,jj) /= 0._wp )   hbatv(ji,jj) = zhbat(ji,jj)
+            ENDIF
+         END DO
+      END DO
+      zhbat(:,:) = hbatf(:,:)   ;   CALL lbc_lnk( hbatf, 'F', 1._wp )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( hbatf(ji,jj) == 0._wp ) THEN
+               IF( zhbat(ji,jj) == 0._wp )   hbatf(ji,jj) = rn_sbot_min
+               IF( zhbat(ji,jj) /= 0._wp )   hbatf(ji,jj) = zhbat(ji,jj)
+            ENDIF
+         END DO
+      END DO
+!!bug:  key_helsinki a verifer
+      hift(:,:) = MIN( hift(:,:), hbatt(:,:) )
+      hifu(:,:) = MIN( hifu(:,:), hbatu(:,:) )
+      hifv(:,:) = MIN( hifv(:,:), hbatv(:,:) )
+      hiff(:,:) = MIN( hiff(:,:), hbatf(:,:) )
+      IF( nprint == 1 .AND. lwp )   THEN
+         WRITE(numout,*) ' MAX val hif   t ', MAXVAL( hift (:,:) ), ' f ', MAXVAL( hiff (:,:) ),  &
+            &                        ' u ',   MAXVAL( hifu (:,:) ), ' v ', MAXVAL( hifv (:,:) )
+         WRITE(numout,*) ' MIN val hif   t ', MINVAL( hift (:,:) ), ' f ', MINVAL( hiff (:,:) ),  &
+            &                        ' u ',   MINVAL( hifu (:,:) ), ' v ', MINVAL( hifv (:,:) )
+         WRITE(numout,*) ' MAX val hbat  t ', MAXVAL( hbatt(:,:) ), ' f ', MAXVAL( hbatf(:,:) ),  &
+            &                        ' u ',   MAXVAL( hbatu(:,:) ), ' v ', MAXVAL( hbatv(:,:) )
+         WRITE(numout,*) ' MIN val hbat  t ', MINVAL( hbatt(:,:) ), ' f ', MINVAL( hbatf(:,:) ),  &
+            &                        ' u ',   MINVAL( hbatu(:,:) ), ' v ', MINVAL( hbatv(:,:) )
+      ENDIF
+!! helsinki
+      !                                            ! =======================
+      !                                            !   s-ccordinate fields     (gdep., e3.)
+      !                                            ! =======================
+      !
+      ! non-dimensional "sigma" for model level depth at w- and t-levels
+      IF( ln_s_sigma ) THEN        ! Song and Haidvogel style stretched sigma for depths
+         !                         ! below rn_hc, with uniform sigma in shallower waters
+         DO ji = 1, jpi
+            DO jj = 1, jpj
+               IF( hbatt(ji,jj) > rn_hc ) THEN    !deep water, stretched sigma
+                  DO jk = 1, jpk
+#if defined key_melange
+                     gsigw3(ji,jj,jk) = gdepw_0(jk)/gdepw_0(nn_sig_lev + 1)
+                     gsigt3(ji,jj,jk) = gdept_0(jk)/gdepw_0(nn_sig_lev + 1)
+#else
+                     gsigw3(ji,jj,jk) = -fssig1( REAL(jk,wp)-0.5_wp, rn_bb )
+                     gsigt3(ji,jj,jk) = -fssig1( REAL(jk,wp)       , rn_bb )
+#endif
+                  END DO
+               ELSE ! shallow water, uniform sigma
+                  DO jk = 1, jpk
+#if defined key_melange
+                     gsigw3(ji,jj,jk) =   REAL(jk-1,wp)            / REAL(nn_sig_lev,wp)
+                     gsigt3(ji,jj,jk) = ( REAL(jk-1,wp) + 0.5_wp ) / REAL(nn_sig_lev,wp)
+#else
+                     gsigw3(ji,jj,jk) =   REAL(jk-1,wp)            / REAL(jpk-1,wp)
+                     gsigt3(ji,jj,jk) = ( REAL(jk-1,wp) + 0.5_wp ) / REAL(jpk-1,wp)
+#endif
+                  END DO
+               ENDIF
+               IF( nprint == 1 .AND. lwp )   WRITE(numout,*) 'gsigw3 1 jpk    ', gsigw3(ji,jj,1), gsigw3(ji,jj,jpk)
+               !
+               DO jk = 1, jpkm1
+                  esigt3(ji,jj,jk  ) = gsigw3(ji,jj,jk+1) - gsigw3(ji,jj,jk)
+                  esigw3(ji,jj,jk+1) = gsigt3(ji,jj,jk+1) - gsigt3(ji,jj,jk)
+               END DO
+               esigw3(ji,jj,1  ) = 2._wp * ( gsigt3(ji,jj,1  ) - gsigw3(ji,jj,1  ) )
+               esigt3(ji,jj,jpk) = 2._wp * ( gsigt3(ji,jj,jpk) - gsigw3(ji,jj,jpk) )
+               !
+               ! Coefficients for vertical depth as the sum of e3w scale factors
+               gsi3w3(ji,jj,1) = 0.5_wp * esigw3(ji,jj,1)
+               DO jk = 2, jpk
+                  gsi3w3(ji,jj,jk) = gsi3w3(ji,jj,jk-1) + esigw3(ji,jj,jk)
+               END DO
+               !
+#if defined key_melange
+               DO jk = 1, nn_sig_lev+1
+!              DO jk = 1, jpk
+               IF( bathy(ji,jj) < gdepw_0(nn_sig_lev + 1) ) THEN ! should this be bathy or hbatt?
+#else
+               DO jk = 1, jpk
+#endif
+#if defined key_melange
+                  zcoeft = ( REAL(jk,wp) - 0.5_wp ) / REAL(nn_sig_lev,wp)
+                  zcoefw = ( REAL(jk,wp) - 1.0_wp ) / REAL(nn_sig_lev,wp)
+!                 zcoeft = ( REAL(MIN(jk,nn_sig_lev),wp) - 0.5_wp ) / REAL(nn_sig_lev-1,wp)
+!                 zcoefw = ( REAL(MIN(jk,nn_sig_lev),wp) - 1.0_wp ) / REAL(nn_sig_lev-1,wp)
+#else
+                  zcoeft = ( REAL(jk,wp) - 0.5_wp ) / REAL(jpkm1,wp)
+                  zcoefw = ( REAL(jk,wp) - 1.0_wp ) / REAL(jpkm1,wp)
+#endif
+#if defined key_melange
+                  rn_hc_bak = rn_hc
+                  rn_hc = MIN( MAX ( &
+                &            (hbatt(ji,jj)-gdepw_0(nn_sig_lev + 1)) / (1._wp - (gdepw_0(nn_sig_lev + 1)/rn_hc)) &
+                &                   ,0._wp) ,rn_hc)
+#endif
+                  gdept (ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*gsigt3(ji,jj,jk)+rn_hc*zcoeft )
+                  gdepw (ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*gsigw3(ji,jj,jk)+rn_hc*zcoefw )
+                  gdep3w(ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*gsi3w3(ji,jj,jk)+rn_hc*zcoeft )
+#if defined key_melange
+                  rn_hc = rn_hc_bak
+#endif
+               IF( gdepw(ji,jj,jk) < 0._wp ) THEN
+                  WRITE(*,*) 'zgr_sco :   gdepw  at point (i,j,k)= ', ji, jj, jk, (gsigw3(ji,jj,jk)*10000._wp-zcoefw*10000._wp)
+               ENDIF
+#if defined key_melange
+               ENDIF
+#endif
+               END DO
+               !
+            END DO   ! for all jj's
+         END DO    ! for all ji's
+         DO ji = 1, jpim1
+            DO jj = 1, jpjm1
+#if defined key_melange
+               IF( bathy(ji,jj) < gdepw_0(nn_sig_lev + 1) ) THEN ! should this be bathy or hbatt?
+               DO jk = 1, nn_sig_lev+1      ! scale factors should be the same in both zps and sco when H > Hcrit??
+!              DO jk = 1, jpk
+#else
+               DO jk = 1, jpk
+#endif
+                  esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*esigt3(ji,jj,jk)+hbatt(ji+1,jj)*esigt3(ji+1,jj,jk) )   &
+                     &              / ( hbatt(ji,jj)+hbatt(ji+1,jj) )
+                  esigtv3(ji,jj,jk) = ( hbatt(ji,jj)*esigt3(ji,jj,jk)+hbatt(ji,jj+1)*esigt3(ji,jj+1,jk) )   &
+                     &              / ( hbatt(ji,jj)+hbatt(ji,jj+1) )
+                  esigtf3(ji,jj,jk) = ( hbatt(ji,jj)*esigt3(ji,jj,jk)+hbatt(ji+1,jj)*esigt3(ji+1,jj,jk)     &
+                     &                + hbatt(ji,jj+1)*esigt3(ji,jj+1,jk)+hbatt(ji+1,jj+1)*esigt3(ji+1,jj+1,jk) )   &
+                     &              / ( hbatt(ji,jj)+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1) )
+                  esigwu3(ji,jj,jk) = ( hbatt(ji,jj)*esigw3(ji,jj,jk)+hbatt(ji+1,jj)*esigw3(ji+1,jj,jk) )   &
+                     &              / ( hbatt(ji,jj)+hbatt(ji+1,jj) )
+                  esigwv3(ji,jj,jk) = ( hbatt(ji,jj)*esigw3(ji,jj,jk)+hbatt(ji,jj+1)*esigw3(ji,jj+1,jk) )   &
+                     &              / ( hbatt(ji,jj)+hbatt(ji,jj+1) )
+                  !
+#if defined key_melange
+                  rn_hc_bak = rn_hc
+                  rn_hc = MIN( MAX( &
+                &            (hbatt(ji,jj)-gdepw_0(nn_sig_lev + 1)) / (1._wp - (gdepw_0(nn_sig_lev + 1)/rn_hc)) &
+                &                   ,0._wp) ,rn_hc)
+!                 e3t(ji,jj,jk) = ( (hbatt(ji,jj)-rn_hc)*esigt3 (ji,jj,jk) + rn_hc/REAL(nn_sig_lev - 1,wp) )
+!                 e3w (ji,jj,jk) = ( (hbatt(ji,jj)-rn_hc)*esigw3 (ji,jj,jk) + rn_hc/REAL(nn_sig_lev - 1,wp) )
+                  e3t(ji,jj,jk) = ( (hbatt(ji,jj)-rn_hc)*esigt3 (ji,jj,jk) + rn_hc/REAL(nn_sig_lev ,wp) )
+                  e3w (ji,jj,jk) = ( (hbatt(ji,jj)-rn_hc)*esigw3 (ji,jj,jk) + rn_hc/REAL(nn_sig_lev ,wp) )
+#else
+                  e3t(ji,jj,jk) = ( (hbatt(ji,jj)-rn_hc)*esigt3 (ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+                  e3w (ji,jj,jk) = ( (hbatt(ji,jj)-rn_hc)*esigw3 (ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+#endif
+#if defined key_melange
+                  rn_hc = MIN( MAX( &
+                &            (hbatu(ji,jj)-gdepw_0(nn_sig_lev + 1)) / (1._wp - (gdepw_0(nn_sig_lev + 1)/rn_hc_bak)) &
+                &                   ,0._wp) ,rn_hc_bak)
+!                 e3u(ji,jj,jk) = ( (hbatu(ji,jj)-rn_hc)*esigtu3(ji,jj,jk) + rn_hc/REAL(nn_sig_lev - 1,wp) )
+!                 e3uw(ji,jj,jk) = ( (hbatu(ji,jj)-rn_hc)*esigwu3(ji,jj,jk) + rn_hc/REAL(nn_sig_lev - 1,wp) )
+                  e3u(ji,jj,jk) = ( (hbatu(ji,jj)-rn_hc)*esigtu3(ji,jj,jk) + rn_hc/REAL(nn_sig_lev ,wp) )
+                  e3uw(ji,jj,jk) = ( (hbatu(ji,jj)-rn_hc)*esigwu3(ji,jj,jk) + rn_hc/REAL(nn_sig_lev ,wp) )
+#else
+                  e3u(ji,jj,jk) = ( (hbatu(ji,jj)-rn_hc)*esigtu3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+                  e3uw(ji,jj,jk) = ( (hbatu(ji,jj)-rn_hc)*esigwu3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+#endif
+#if defined key_melange
+                  rn_hc = MIN( MAX( &
+                &            (hbatv(ji,jj)-gdepw_0(nn_sig_lev + 1)) / (1._wp - (gdepw_0(nn_sig_lev + 1)/rn_hc_bak)) &
+                &                   ,0._wp) ,rn_hc_bak)
+!                 e3v(ji,jj,jk) = ( (hbatv(ji,jj)-rn_hc)*esigtv3(ji,jj,jk) + rn_hc/REAL(nn_sig_lev - 1,wp) )
+!                 e3vw(ji,jj,jk) = ( (hbatv(ji,jj)-rn_hc)*esigwv3(ji,jj,jk) + rn_hc/REAL(nn_sig_lev - 1,wp) )
+                  e3v(ji,jj,jk) = ( (hbatv(ji,jj)-rn_hc)*esigtv3(ji,jj,jk) + rn_hc/REAL(nn_sig_lev ,wp) )
+                  e3vw(ji,jj,jk) = ( (hbatv(ji,jj)-rn_hc)*esigwv3(ji,jj,jk) + rn_hc/REAL(nn_sig_lev ,wp) )
+#else
+                  e3v(ji,jj,jk) = ( (hbatv(ji,jj)-rn_hc)*esigtv3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+                  e3vw(ji,jj,jk) = ( (hbatv(ji,jj)-rn_hc)*esigwv3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+#endif
+#if defined key_melange
+                  rn_hc = MIN( MAX( &
+                &            (hbatf(ji,jj)-gdepw_0(nn_sig_lev + 1)) / (1._wp - (gdepw_0(nn_sig_lev + 1)/rn_hc_bak)) &
+                &                   ,0._wp), rn_hc_bak)
+!                 e3f(ji,jj,jk) = ( (hbatf(ji,jj)-rn_hc)*esigtf3(ji,jj,jk) + rn_hc/REAL(nn_sig_lev - 1,wp) )
+                  e3f(ji,jj,jk) = ( (hbatf(ji,jj)-rn_hc)*esigtf3(ji,jj,jk) + rn_hc/REAL(nn_sig_lev ,wp) )
+#else
+                  e3f(ji,jj,jk) = ( (hbatf(ji,jj)-rn_hc)*esigtf3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp))
+#endif
+                  !
+#if defined key_melange
+                  rn_hc = rn_hc_bak
+#endif
+               END DO
+#if defined key_melange
+               ENDIF
+#endif
+            END DO
+         END DO
+         CALL lbc_lnk( e3t , 'T', 1._wp )
+         CALL lbc_lnk( e3u , 'U', 1._wp )
+         CALL lbc_lnk( e3v , 'V', 1._wp )
+         CALL lbc_lnk( e3f , 'F', 1._wp )
+         CALL lbc_lnk( e3w , 'W', 1._wp )
+         CALL lbc_lnk( e3uw, 'U', 1._wp )
+         CALL lbc_lnk( e3vw, 'V', 1._wp )
+         !
+      ELSE   ! not ln_s_sigma
+         !
+         DO jk = 1, jpk
+           gsigw(jk) = -fssig( REAL(jk,wp)-0.5_wp )
+           gsigt(jk) = -fssig( REAL(jk,wp)        )
+         END DO
+         IF( nprint == 1 .AND. lwp )   WRITE(numout,*) 'gsigw 1 jpk    ', gsigw(1), gsigw(jpk)
+         !
+         ! Coefficients for vertical scale factors at w-, t- levels
+!!gm bug :  define it from analytical function, not like juste bellow....
+!!gm        or betteroffer the 2 possibilities....
+         DO jk = 1, jpkm1
+            esigt(jk  ) = gsigw(jk+1) - gsigw(jk)
+            esigw(jk+1) = gsigt(jk+1) - gsigt(jk)
+         END DO
+         esigw( 1 ) = 2._wp * ( gsigt(1  ) - gsigw(1  ) )
+         esigt(jpk) = 2._wp * ( gsigt(jpk) - gsigw(jpk) )
+!!gm  original form
+!!org DO jk = 1, jpk
+!!org    esigt(jk)=fsdsig( FLOAT(jk)     )
+!!org    esigw(jk)=fsdsig( FLOAT(jk)-0.5 )
+!!org END DO
+!!gm
+         !
+         ! Coefficients for vertical depth as the sum of e3w scale factors
+         gsi3w(1) = 0.5_wp * esigw(1)
+         DO jk = 2, jpk
+            gsi3w(jk) = gsi3w(jk-1) + esigw(jk)
+         END DO
+!!gm: depuw, depvw can be suppressed (modif in ldfslp) and depw=dep3w can be set (save 3 3D arrays)
+         DO jk = 1, jpk
+            zcoeft = ( REAL(jk,wp) - 0.5_wp ) / REAL(jpkm1,wp)
+            zcoefw = ( REAL(jk,wp) - 1.0_wp ) / REAL(jpkm1,wp)
+            gdept (:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*gsigt(jk) + hift(:,:)*zcoeft )
+            gdepw (:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*gsigw(jk) + hift(:,:)*zcoefw )
+            gdep3w(:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*gsi3w(jk) + hift(:,:)*zcoeft )
+         END DO
+!!gm: e3uw, e3vw can be suppressed  (modif in dynzdf, dynzdf_iso, zdfbfr) (save 2 3D arrays)
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpk
+                 e3t(ji,jj,jk) = ( (hbatt(ji,jj)-hift(ji,jj))*esigt(jk) + hift(ji,jj)/REAL(jpkm1,wp) )
+                 e3u(ji,jj,jk) = ( (hbatu(ji,jj)-hifu(ji,jj))*esigt(jk) + hifu(ji,jj)/REAL(jpkm1,wp) )
+                 e3v(ji,jj,jk) = ( (hbatv(ji,jj)-hifv(ji,jj))*esigt(jk) + hifv(ji,jj)/REAL(jpkm1,wp) )
+                 e3f(ji,jj,jk) = ( (hbatf(ji,jj)-hiff(ji,jj))*esigt(jk) + hiff(ji,jj)/REAL(jpkm1,wp) )
+                 !
+                 e3w (ji,jj,jk) = ( (hbatt(ji,jj)-hift(ji,jj))*esigw(jk) + hift(ji,jj)/REAL(jpkm1,wp) )
+                 e3uw(ji,jj,jk) = ( (hbatu(ji,jj)-hifu(ji,jj))*esigw(jk) + hifu(ji,jj)/REAL(jpkm1,wp) )
+                 e3vw(ji,jj,jk) = ( (hbatv(ji,jj)-hifv(ji,jj))*esigw(jk) + hifv(ji,jj)/REAL(jpkm1,wp) )
+               END DO
+            END DO
+         END DO
+         !
+      ENDIF ! ln_s_sigma
+      where (e3t   (:,:,:).eq.0._wp)  e3t(:,:,:) = 1._wp
+      where (e3u   (:,:,:).eq.0._wp)  e3u(:,:,:) = 1._wp
+      where (e3v   (:,:,:).eq.0._wp)  e3v(:,:,:) = 1._wp
+      where (e3f   (:,:,:).eq.0._wp)  e3f(:,:,:) = 1._wp
+      where (e3w   (:,:,:).eq.0._wp)  e3w(:,:,:) = 1._wp
+      where (e3uw  (:,:,:).eq.0._wp)  e3uw(:,:,:) = 1._wp
+      where (e3vw  (:,:,:).eq.0._wp)  e3vw(:,:,:) = 1._wp
+      fsdept(:,:,:) = gdept (:,:,:)
+      fsdepw(:,:,:) = gdepw (:,:,:)
+      fsde3w(:,:,:) = gdep3w(:,:,:)
+      fse3t (:,:,:) = e3t   (:,:,:)
+      fse3u (:,:,:) = e3u   (:,:,:)
+      fse3v (:,:,:) = e3v   (:,:,:)
+      fse3f (:,:,:) = e3f   (:,:,:)
+      fse3w (:,:,:) = e3w   (:,:,:)
+      fse3uw(:,:,:) = e3uw  (:,:,:)
+      fse3vw(:,:,:) = e3vw  (:,:,:)
+!!
+      ! HYBRID :
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+#if defined key_melange
+               IF( bathy(ji,jj) < gdepw_0(nn_sig_lev + 1) ) THEN ! should this be hbatt or bathy
+               DO jk = 1, nn_sig_lev
+!              DO jk = 1, jpkm1
+#else
+               DO jk = 1, jpkm1
+#endif
+                   IF( scobot(ji,jj) >= fsdept(ji,jj,jk) )   mbathy(ji,jj) = MAX(  2, jk )
+               END DO
+#if defined key_melange
+               ENDIF
+#endif
+               IF( scobot(ji,jj) == 0._wp            )   mbathy(ji,jj) = 0
+         END DO
+      END DO
+      IF( nprint == 1 .AND. lwp ) WRITE(numout,*) ' MIN val mbathy h90 ', MINVAL( mbathy(:,:) ),   &
+         &                                                       ' MAX ', MAXVAL( mbathy(:,:) )
+      !                                               ! =============
+      IF(lwp) THEN                                    ! Control print
+         !                                            ! =============
+         WRITE(numout,*)
+         WRITE(numout,*) ' domzgr: vertical coefficients for model level'
+         WRITE(numout, "(9x,'  level    gsigt      gsigw      esigt      esigw      gsi3w')" )
+         WRITE(numout, "(10x,i4,5f11.4)" ) ( jk, gsigt(jk), gsigw(jk), esigt(jk), esigw(jk), gsi3w(jk), jk=1,jpk )
+      ENDIF
+      IF( nprint == 1  .AND. lwp )   THEN         ! min max values over the local domain
+         WRITE(numout,*) ' MIN val mbathy  ', MINVAL( mbathy(:,:)   ), ' MAX ', MAXVAL( mbathy(:,:) )
+         WRITE(numout,*) ' MIN val depth t ', MINVAL( fsdept(:,:,:) ),   &
+            &                          ' w ', MINVAL( fsdepw(:,:,:) ), '3w '  , MINVAL( fsde3w(:,:,:) )
+         WRITE(numout,*) ' MIN val e3    t ', MINVAL( fse3t (:,:,:) ), ' f '  , MINVAL( fse3f (:,:,:) ),   &
+            &                          ' u ', MINVAL( fse3u (:,:,:) ), ' u '  , MINVAL( fse3v (:,:,:) ),   &
+            &                          ' uw', MINVAL( fse3uw(:,:,:) ), ' vw'  , MINVAL( fse3vw(:,:,:) ),   &
+            &                          ' w ', MINVAL( fse3w (:,:,:) )
+         WRITE(numout,*) ' MAX val depth t ', MAXVAL( fsdept(:,:,:) ),   &
+            &                          ' w ', MAXVAL( fsdepw(:,:,:) ), '3w '  , MAXVAL( fsde3w(:,:,:) )
+         WRITE(numout,*) ' MAX val e3    t ', MAXVAL( fse3t (:,:,:) ), ' f '  , MAXVAL( fse3f (:,:,:) ),   &
+            &                          ' u ', MAXVAL( fse3u (:,:,:) ), ' u '  , MAXVAL( fse3v (:,:,:) ),   &
+            &                          ' uw', MAXVAL( fse3uw(:,:,:) ), ' vw'  , MAXVAL( fse3vw(:,:,:) ),   &
+            &                          ' w ', MAXVAL( fse3w (:,:,:) )
+      ENDIF
+      !
+      IF(lwp) THEN                                  ! selected vertical profiles
+         WRITE(numout,*)
+         WRITE(numout,*) ' domzgr: vertical coordinates : point (1,1,k) bathy = ', bathy(1,1), hbatt(1,1)
+         WRITE(numout,*) ' ~~~~~~  --------------------'
+         WRITE(numout,"(9x,' level   gdept    gdepw    gde3w     e3t      e3w  ')")
+         WRITE(numout,"(10x,i4,4f9.2)") ( jk, fsdept(1,1,jk), fsdepw(1,1,jk),     &
+            &                                 fse3t (1,1,jk), fse3w (1,1,jk), jk=1,jpk )
+         DO jj = mj0(20), mj1(20)
+            DO ji = mi0(20), mi1(20)
+               WRITE(numout,*)
+               WRITE(numout,*) ' domzgr: vertical coordinates : point (20,20,k)   bathy = ', bathy(ji,jj), hbatt(ji,jj)
+               WRITE(numout,*) ' ~~~~~~  --------------------'
+               WRITE(numout,"(9x,' level   gdept    gdepw    gde3w     e3t      e3w  ')")
+               WRITE(numout,"(10x,i4,4f9.2)") ( jk, fsdept(ji,jj,jk), fsdepw(ji,jj,jk),     &
+                  &                                 fse3t (ji,jj,jk), fse3w (ji,jj,jk), jk=1,jpk )
+            END DO
+         END DO
+         DO jj = mj0(74), mj1(74)
+            DO ji = mi0(100), mi1(100)
+               WRITE(numout,*)
+               WRITE(numout,*) ' domzgr: vertical coordinates : point (100,74,k)   bathy = ', bathy(ji,jj), hbatt(ji,jj)
+               WRITE(numout,*) ' ~~~~~~  --------------------'
+               WRITE(numout,"(9x,' level   gdept    gdepw    gde3w     e3t      e3w  ')")
+               WRITE(numout,"(10x,i4,4f9.2)") ( jk, fsdept(ji,jj,jk), fsdepw(ji,jj,jk),     &
+                  &                                 fse3t (ji,jj,jk), fse3w (ji,jj,jk), jk=1,jpk )
+            END DO
+         END DO
+      ENDIF
+!!gm bug?  no more necessary?  if ! defined key_helsinki
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( fse3w(ji,jj,jk) <= 0._wp .OR. fse3t(ji,jj,jk) <= 0._wp ) THEN
+                  WRITE(*,*) 'zgr_sco :   e3w   or e3t   =< 0  at point (i,j,k)= ', ji, jj, jk, fse3w(ji,jj,jk), fse3t(ji,jj,jk)
+!                 WRITE(ctmp1,*) 'zgr_sco :   e3w   or e3t   =< 0  at point (i,j,k)= ', ji, jj, jk
+!                 CALL ctl_stop( ctmp1 )
+               ENDIF
+               IF( fsdepw(ji,jj,jk) < 0._wp .OR. fsdept(ji,jj,jk) < 0._wp ) THEN
+                  WRITE(*,*) 'zgr_sco :   gdepw or gdept =< 0  at point (i,j,k)= ', ji, jj, jk, fsdepw(ji,jj,jk), fsdept(ji,jj,jk)
+!                 WRITE(ctmp1,*) 'zgr_sco :   gdepw or gdept =< 0  at point (i,j,k)= ', ji, jj, jk
+!                 CALL ctl_stop( ctmp1 )
+               ENDIF
+            END DO
+         END DO
+      END DO
+!!gm bug    #endif
+      !
+      CALL wrk_dealloc( jpi, jpj,      zenv, ztmpi1, ztmpi2, ztmpj1, ztmpj2, zri, zrj, zhbat                           )
+#if defined key_smsh
+      CALL wrk_dealloc( jpi, jpj, jpk, esigtu3, esigtv3, esigtf3, esigwu3, esigwv3 )
+#else
+      CALL wrk_dealloc( jpi, jpj, jpk, gsigw3, gsigt3, gsi3w3                                      )
+      CALL wrk_dealloc( jpi, jpj, jpk, esigt3, esigw3, esigtu3, esigtv3, esigtf3, esigwu3, esigwv3 )
+#endif
+     !
+      IF( nn_timing == 1 )  CALL timing_stop('zgr_sco')
+      !
+   END SUBROUTINE zgr_sco
+      SUBROUTINE zgr_hyb
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zgr_sco  ***
+      !!    Combination of zgr_sco in upper layers ( shelf ) and zgr_zps in abyss      !!
+      !! ** Purpose :   define the s-z coordinate system
+      !!
+      !! ** Method  :   s-coordinate in upper layers and z-coordinates below
+      !!         The depth of model levels is defined as the product of an
+      !!      analytical function by the local bathymetry, while the vertical
+      !!      scale factors are defined as the product of the first derivative
+      !!      of the analytical function by the bathymetry.
+      !!      (this solution save memory as depth and scale factors are not
+      !!      3d fields)
+      !!          - Read bathymetry (in meters) at t-point and compute the
+      !!         bathymetry at u-, v-, and f-points.
+      !!            hbatu = mi( hbatt )
+      !!            hbatv = mj( hbatt )
+      !!            hbatf = mi( mj( hbatt ) )
+      !!          - Compute gsigt, gsigw, esigt, esigw from an analytical
+      !!         function
+      !!            gsigt(k) = fssig (k    )
+      !!            gsigw(k) = fssig (k-0.5)
+      !!      This routine is given as an example, it must be modified
+      !!      following the user s desiderata. nevertheless, the output as
+      !!      well as the way to compute the model levels and scale factors
+      !!      must be respected in order to insure second order a!!uracy
+      !!      schemes.
+      !!
+  !!======================================================================
+      INTEGER  ::   ji, jj, jk, jl, ik           ! dummy loop argument
+      INTEGER  ::   iip1, ijp1, iim1, ijm1       ! temporary integers
+      INTEGER  ::   jpksigm                      ! temporary integer for maxnumber of s-levels
+      REAL(wp) ::   zcoeft, zcoefw, zrmax, ztaper,zrmin,e3t_t,e3w_t  ! temporary scalars
+      REAL(wp) ::   ze3tp , ze3wp           ! Last ocean level thickness at T- and W-points
+      REAL(wp) ::   zdepwp, zdepth          ! Ajusted ocean depth to avoid too small e3t
+      REAL(wp) ::   zmax, zmin ,zsigma      ! Maximum and minimum depth and depth of sigma layer
+      REAL(wp) ::   zacr , zkth ,za1         ! parameters for z- layer (as ppacr , ppzkth )
+      !
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zenv, ztmp, zmsk, zri, zrj, zhbat ,zrpt
+      NAMELIST/namzgr_hyb/ rn_sbot_max, rn_sbot_min, rn_theta, rn_thetb, rn_rmax, &
+                 ln_s_sigma, rn_bb, rn_hc,rn_zsigma , nn_sig_lev , rn_kth , rn_acr
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zgr_hyb')
+      !
+      CALL wrk_alloc( jpi, jpj,      zenv, ztmp, zmsk, zri, zrj, zhbat                           )
+!      CALL wrk_alloc( jpi, jpj, jpk, gsigw3, gsigt3                                              )
+      !
+      REWIND( numnam )                       ! Read Namelist namzgr_sco : sigma-stretching parameters
+      READ  ( numnam, namzgr_hyb )
+      IF(lwp) THEN                           ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom:zgr_hyb : s-coordinate or hybrid z-s-coordinate'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namzgr_hyb'
+         WRITE(numout,*) '      sigma-stretching coeffs '
+         WRITE(numout,*) '      maximum depth of s-bottom surface (>0)       rn_sbot_max   = ' ,rn_sbot_max
+         WRITE(numout,*) '      minimum depth of s-bottom surface (>0)       rn_sbot_min   = ' ,rn_sbot_min
+         WRITE(numout,*) '      surface control parameter (0<=rn_theta<=20)  rn_theta      = ', rn_theta
+         WRITE(numout,*) '      bottom  control parameter (0<=rn_thetb<= 1)  rn_thetb      = ', rn_thetb
+         WRITE(numout,*) '      maximum cut-off r-value allowed              rn_rmax       = ', rn_rmax
+         WRITE(numout,*) '      Hybrid s-sigma-coordinate                    ln_s_sigma    = ', ln_s_sigma
+         WRITE(numout,*) '      stretching parameter (song and haidvogel)    rn_bb         = ', rn_bb
+         WRITE(numout,*) '      Critical depth                               rn_hc         = ', rn_hc
+         WRITE(numout,*) '      Sigma  depth                                rn_zsigma     = ', rn_zsigma
+         WRITE(numout,*) '      The same as pp_arc                           rn_arc        = ', rn_acr
+         WRITE(numout,*) '      Number of sigma levels                       rn_arc        = ', nn_sig_lev
+         WRITE(numout,*) '      Number of levels for stretching z-coord      rn_kth        = ', rn_kth
+      ENDIF
+      zsigma   =    rn_zsigma
+      jpksigm =  nn_sig_lev
+      zmax    =  rn_sbot_max
+      zacr    =  rn_acr
+      zkth    =  rn_kth
+      e3t(:,:,:) = 1._wp
+      e3w(:,:,:) = 1._wp
+      e3u(:,:,:) = 1._wp
+      e3v(:,:,:) = 1._wp
+      e3f(:,:,:) = 1._wp
+      e3uw(:,:,:)= 1._wp
+      e3vw(:,:,:)= 1._wp
+      DO jj = 1, jpj
+         DO ji= 1, jpi
+            IF( bathy(ji,jj) <= 0._wp ) THEN   ;   bathy(ji,jj) = 0.e0_wp
+            ELSE                               ;   bathy(ji,jj) = MIN( rn_sbot_max,  MAX( bathy(ji,jj),rn_sbot_min )  )
+            ENDIF
+         END DO
+      END DO
+! create bathymetry for enveloping
       DO jj = 1, jpj
          DO ji = 1, jpi
             zenv(ji,jj) = MAX( bathy(ji,jj), rn_sbot_min )
          END DO
       END DO
+      !
       ! Smooth the bathymetry (if required)
+            zenv(ji,jj) = MIN (zenv(ji,jj),  zsigma )
+            hbatt(ji,jj) = zenv(ji,jj)
+         END DO
+      END DO
       scosrf(:,:) = 0._wp             ! ocean surface depth (here zero: no under ice-shelf sea)
       scobot(:,:) = bathy(:,:)        ! ocean bottom  depth
+      !
       jl = 0
       zrmax = 1._wp
 …
             END DO
          END DO
+         !
+         IF(lwp)WRITE(numout,*) 'zgr_sco :   iter= ',jl, ' rmax= ', zrmax, ' nb of pt= ', INT( SUM(zmsk(:,:) ) )
+         IF(lwp)WRITE(numout,*) 'zgr_hyb :   iter= ',jl, ' rmax= ', zrmax, ' nb of pt= ', INT( SUM(zmsk(:,:) ) )
+         !
          DO jj = 1, nlcj
 …
          DO jj = 1, nlcj
             DO ji = 1, nlci
                IF( zmsk(ji,jj) == 1._wp )   zenv(ji,jj) = MAX( ztmp(ji,jj), bathy(ji,jj) )
+               IF( zmsk(ji,jj) == 1._wp )   zenv(ji,jj) = MAX( ztmp(ji,jj), hbatt(ji,jj) )
             END DO
          END DO
+         !
          ! Apply lateral boundary condition   CAUTION: keep the value when the lbc field is zero
+         ! Apply lateral boundary condition   CAUTION: kept the value when the lbc field is zero
          ztmp(:,:) = zenv(:,:)   ;   CALL lbc_lnk( zenv, 'T', 1._wp )
          DO jj = 1, nlcj
 …
       !                                                     ! ================ !
+      !
+      ! Fill ghost rows with appropriate values to avoid undefined e3 values with some mpp decompositions
+      DO ji = nlci+1, jpi
+         zenv(ji,1:nlcj) = zenv(nlci,1:nlcj)
+      END DO
+      !
+      DO jj = nlcj+1, jpj
+         zenv(:,jj) = zenv(:,nlcj)
+      END DO
+      !
+      ! Envelope bathymetry saved in hbatt
+      !                                        ! envelop bathymetry saved in hbatt
       hbatt(:,:) = zenv(:,:)
+      IF( MINVAL( gphit(:,:) ) * MAXVAL( gphit(:,:) ) <= 0._wp ) THEN
+         CALL ctl_warn( ' s-coordinates are tapered in vicinity of the Equator' )
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ztaper = EXP( -(gphit(ji,jj)/8._wp)**2 )
+               hbatt(ji,jj) = rn_sbot_max * ztaper + hbatt(ji,jj) * ( 1._wp - ztaper )
+            END DO
+         END DO
+      ENDIF
+      !
+      IF(lwp) THEN                             ! Control print
+   IF( lk_mpp )   CALL mpp_max( nstop )
+   IF (lwp) write(numout,*)"after envelope", nstop
+! define new reference levels
+! for s- levels, allows stretching at surface and bottom layer
+IF( jpksigm > 1 )THEN
+    IF(ln_s_sigma)THEN
+           DO jk = 1, jpksigm
+            gsigw(jk) = -fssig3( REAL(jk,wp)-0.5_wp     , rn_bb,jpksigm )
+            gsigt(jk) = -fssig3( REAL(jk,wp)            , rn_bb,jpksigm )
+           END DO
+    ELSE
+          DO jk = 1, jpksigm
+           gsigw(jk) = -fssig2( REAL(jk,wp)-0.5_wp ,jpksigm )
+           gsigt(jk) = -fssig2( REAL(jk,wp)        ,jpksigm )
+          END DO
+   ENDIF
+    gsigw(1)=0._wp   ! set gsigw exactly to zero
+    IF( lk_mpp )   CALL mpp_max( nstop )
+    IF (lwp) THEN
+    write(numout,*)"after fssig", nstop,"gsigw,gsigt="
+    do jk=1,jpksigm
+    write(numout,*)jk,gsigw(jk),gsigt(jk)
+    enddo
+    ENDIF
+       DO jk=1,jpksigm
+          DO jj=1,jpj
+            DO ji=1,jpi
+                 zrmin= min( hbatt(ji,jj), zsigma )
+                   IF(hbatt(ji,jj).lt.rn_hc)THEN
+                   zcoefw=REAL(jk-1,wp)      / REAL(jpksigm-1,wp)
+                   zcoeft=(REAL(jk-1,wp)+0.5)/ REAL(jpksigm-1,wp)
+                   ELSE
+                   zcoefw=gsigw(jk)
+                   zcoeft=gsigt(jk)
+                   ENDIF
+                   gdept(ji,jj,jk)=scosrf(ji,jj)+(zrmin-rn_hc)*zcoeft &
+                       +rn_hc* (REAL(jk,wp)- 0.5_wp)  / REAL(jpksigm-1,wp)
+                   gdepw(ji,jj,jk)=scosrf(ji,jj)+(zrmin-rn_hc)*zcoefw &
+                       +rn_hc*( REAL(jk,wp)- 1.0_wp ) / REAL(jpksigm-1,wp)
+           ENDDO
+          ENDDO
+        ENDDO
+        gdepw(:,:,1)= scosrf(:,:)
+ ! redefine gdept_0, gdepw_0 which will be used in diawri.F90
+    DO jk=1,jpksigm
+                   IF(zsigma.lt.rn_hc)THEN
+                   zcoefw=REAL(jk-1,wp)      / REAL(jpksigm-1,wp)
+                   zcoeft=(REAL(jk-1,wp)+0.5)/ REAL(jpksigm-1,wp)
+                   ELSE
+                   zcoefw=gsigw(jk)
+                   zcoeft=gsigt(jk)
+                   ENDIF
+         gdept_0(jk)=  zcoeft * (zsigma-rn_hc)+rn_hc* (REAL(jk,wp)- 0.5_wp )/REAL(jpksigm-1,wp)
+         gdepw_0(jk)=  zcoefw * (zsigma-rn_hc)+rn_hc* (REAL(jk,wp)- 1.0_wp )/REAL(jpksigm-1,wp)
+    ENDDO
+    DO jk=1,jpksigm-1
+         e3t_0(jk)  = gdepw_0(jk+1)-gdepw_0(jk)
+         e3w_0(jk+1)= gdept_0(jk+1)-gdept_0(jk)
+    ENDDO
+         e3w_0(1) = 2._wp * ( gdept_0(1  ) - gdepw_0(1  ) )
+ ! now for lower z-levels :
+         zmin = e3t_0 (jpksigm -1 ) ! min layer width in z- zone is the same as lowest in s- layer
+ ELSE
+  zsigma = 0._wp
+  hbatt(:,:) = zsigma
+  zmin = 5._wp
+ ENDIF
+ IF(lwp) write(numout,*) ": last vertical level of sigma-coordinates",zmin
+        CALL fszref (  zkth, zmin, zacr, zmax, jpksigm , zsigma  )
+    DO jk=jpksigm,jpkm1
+         e3t_0(jk)  = gdepw_0(jk+1)-gdepw_0(jk)
+         e3w_0(jk+1)= gdept_0(jk+1)-gdept_0(jk)
+    ENDDO
+         e3w_0(1) = 2._wp * ( gdept_0(1  ) - gdepw_0(1  ) )
+         e3t_0(jpk) = 2._wp * ( gdept_0(jpk) - gdepw_0(jpk) )
+   IF( lk_mpp )   CALL mpp_max( nstop )
+   IF (lwp) write(numout,*)"e3t0" ,nstop
+      IF(lwp) THEN                        ! control print
          WRITE(numout,*)
+         WRITE(numout,*) ' domzgr: hbatt field; ocean depth in meters'
+         WRITE(numout,*) '  zhyb          Reference z-coordinate depth and scale factors:'
+         WRITE(numout, "(9x,' level   gdept    gdepw     e3t      e3w  ')" )
+         WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, gdept_0(jk), gdepw_0(jk), e3t_0(jk), e3w_0(jk), jk = 1, jpk )
+         open(333,file='zmesh.dat')
+         WRITE(333,*)'initial zsigma  =', zsigma, jpk
+         WRITE(333,*)'initial jpksigm =', jpksigm
+         WRITE(333,*)'rn_bb =', rn_bb,'rn_theta=',rn_theta
+         do jk=1,jpk
+         WRITE(333,'(i4,1x,4(1x,e13.6))') jk, gdept_0(jk), gdepw_0(jk), e3t_0(jk),e3w_0(jk)
+         enddo
+         close(333)
+      ENDIF
+        DO jk=jpksigm,jpk
+          DO jj=1,jpj
+           DO ji=1,jpi
+           IF(jpksigm>1)THEN
+                   gdept(ji,jj,jk)=scosrf(ji,jj) + gdept_0(jk) *hbatt(ji,jj)/zsigma ! differ from gdept0+scorf only at land
+                   gdepw(ji,jj,jk)=scosrf(ji,jj) + gdepw_0(jk) *hbatt(ji,jj)/zsigma ! as hbatt=zsigma over deep part of basin
+            ELSE
+                   gdept(ji,jj,jk)=scosrf(ji,jj) + gdept_0(jk)
+                   gdepw(ji,jj,jk)=scosrf(ji,jj) + gdepw_0(jk)
+            ENDIF
+           ENDDO
+          ENDDO
+        ENDDO
+! define e3t, e3w for general levels
+        DO jk=1,jpkm1
+            e3t(:,:,jk)  = gdepw(:,:,jk+1)-gdepw(:,:,jk)
+            e3w(:,:,jk+1)= gdept(:,:,jk+1)-gdept(:,:,jk)
+        ENDDO
+        e3w(:,:,1)   = 2._wp * ( gdept(:,:,1  ) - gdepw(:,:,1  ) )
+        e3t(:,:,jpk) = 2._wp * ( gdept(:,:,jpk) - gdepw(:,:,jpk) )
+! and surface :
+!      ! HYBRID mbathy :
+      IF(lwp) THEN                        ! control print
          WRITE(numout,*)
+         CALL prihre( hbatt(1,1), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 0._wp, numout )
+         IF( nprint == 1 )   THEN
+            WRITE(numout,*) ' bathy  MAX ', MAXVAL( bathy(:,:) ), ' MIN ', MINVAL( bathy(:,:) )
+            WRITE(numout,*) ' hbatt  MAX ', MAXVAL( hbatt(:,:) ), ' MIN ', MINVAL( hbatt(:,:) )
+         ENDIF
+      ENDIF
+      !                                        ! ==============================
+      !                                        !   hbatu, hbatv, hbatf fields
+      !                                        ! ==============================
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' zgr_sco: minimum depth of the envelop topography set to : ', rn_sbot_min
+      ENDIF
+      hbatu(:,:) = rn_sbot_min
+      hbatv(:,:) = rn_sbot_min
+      hbatf(:,:) = rn_sbot_min
+      DO jj = 1, jpjm1
+        DO ji = 1, jpim1   ! NO vector opt.
+           hbatu(ji,jj) = 0.50_wp * ( hbatt(ji  ,jj) + hbatt(ji+1,jj  ) )
+           hbatv(ji,jj) = 0.50_wp * ( hbatt(ji  ,jj) + hbatt(ji  ,jj+1) )
+           hbatf(ji,jj) = 0.25_wp * ( hbatt(ji  ,jj) + hbatt(ji  ,jj+1)   &
+              &                     + hbatt(ji+1,jj) + hbatt(ji+1,jj+1) )
+        END DO
+      END DO
+      !
+      ! Apply lateral boundary condition
+!!gm  ! CAUTION: retain non zero value in the initial file this should be OK for orca cfg, not for EEL
+      zhbat(:,:) = hbatu(:,:)   ;   CALL lbc_lnk( hbatu, 'U', 1._wp )
+         WRITE(numout,*) '  zhyb          centre of basin s-z-coordinate depth and scale factors:'
+         WRITE(numout, "(9x,' level   gdept    gdepw     e3t      e3w  ')" )
+         write(numout,*)"bathy" ,"min e3t"
+         do jk=1,jpk
+         WRITE(numout, "(10x, i4, 4f9.2)" )  jk, gdept(20,20,jk), gdepw(20,20,jk), &
+  &       e3t(20,20,jk), e3w(20,20,jk)
+         enddo
+      ENDIF
+      mbathy(:,:)=0
+!      WHERE( 0._wp < bathy(:,:)) mbathy(:,:)=jpkm1
       DO jj = 1, jpj
          DO ji = 1, jpi
+            IF( hbatu(ji,jj) == 0._wp ) THEN
+               IF( zhbat(ji,jj) == 0._wp )   hbatu(ji,jj) = rn_sbot_min
+               IF( zhbat(ji,jj) /= 0._wp )   hbatu(ji,jj) = zhbat(ji,jj)
+             DO jk = 1, jpkm1
+                IF( bathy(ji,jj) >= gdept(ji,jj,jk) ) mbathy(ji,jj) = MAX( 2, jk )
+         END DO
+        END DO
+      END DO
+ !     DO jk = jpkm1, jpksigm+1, -1
+ !        zdepth = gdepw_0(jk) + MIN( e3zps_min, e3t_0(jk)*e3zps_rat )
+ !        WHERE( 0._wp < bathy(:,:) .AND. bathy(:,:) <= zdepth )   mbathy(:,:) = jk-1
+ !     END DO
+      ! z-partial steps :goto 20
+       DO jj = 1, jpj
+         DO ji = 1, jpi
+            ik = mbathy(ji,jj)
+            IF( ik > jpksigm ) THEN               ! ocean point only
+               ! max ocean level case
+               IF( ik == jpkm1 ) THEN
+                  zdepwp = bathy(ji,jj)
+                  ze3tp  = bathy(ji,jj) - gdepw_0(ik)
+                  ze3wp = 0.5_wp * e3w_0(ik) * ( 1._wp + ( ze3tp/e3t_0(ik) ) )
+                  e3t(ji,jj,ik  ) = ze3tp
+                  e3t(ji,jj,ik+1) = ze3tp
+                  e3w(ji,jj,ik  ) = ze3wp
+                  e3w(ji,jj,ik+1) = ze3tp
+                  gdepw(ji,jj,ik+1) = zdepwp
+                  gdept(ji,jj,ik  ) = gdept_0(ik-1) + ze3wp
+                  gdept(ji,jj,ik+1) = gdept(ji,jj,ik) + ze3tp
+                  !
+               ELSE                         ! standard case
+                  IF( bathy(ji,jj) <= gdepw_0(ik+1) ) THEN   ;   gdepw(ji,jj,ik+1) = bathy(ji,jj)
+                  ELSE                                       ;   gdepw(ji,jj,ik+1) = gdepw_0(ik+1)
+                  ENDIF
+!gm Bug?  check the gdepw_0
+                  !       ... on ik
+                  gdept(ji,jj,ik) = gdepw_0(ik) + ( gdepw  (ji,jj,ik+1) - gdepw_0(ik) )   &
+                     &                          * ((gdept_0(      ik  ) - gdepw_0(ik) )   &
+                     &                          / ( gdepw_0(      ik+1) - gdepw_0(ik) ))
+                  e3t  (ji,jj,ik) = e3t_0  (ik) * ( gdepw  (ji,jj,ik+1) - gdepw_0(ik) )   &
+                     &                          / ( gdepw_0(      ik+1) - gdepw_0(ik) )
+                  e3w  (ji,jj,ik) = 0.5_wp * ( gdepw(ji,jj,ik+1) + gdepw_0(ik+1) - 2._wp * gdepw_0(ik) )   &
+                     &                     * ( e3w_0(ik) / ( gdepw_0(ik+1) - gdepw_0(ik) ) )
+                  !       ... on ik+1
+                  e3w  (ji,jj,ik+1) = e3t  (ji,jj,ik)
+                  e3t  (ji,jj,ik+1) = e3t  (ji,jj,ik)
+                  gdept(ji,jj,ik+1) = gdept(ji,jj,ik) + e3t(ji,jj,ik)
+               ENDIF
             ENDIF
          END DO
       END DO
+      zhbat(:,:) = hbatv(:,:)   ;   CALL lbc_lnk( hbatv, 'V', 1._wp )
+      !
+      jl = 0
       DO jj = 1, jpj
          DO ji = 1, jpi
+            IF( hbatv(ji,jj) == 0._wp ) THEN
+               IF( zhbat(ji,jj) == 0._wp )   hbatv(ji,jj) = rn_sbot_min
+               IF( zhbat(ji,jj) /= 0._wp )   hbatv(ji,jj) = zhbat(ji,jj)
+            ik = mbathy(ji,jj)
+            IF( ik > jpksigm ) THEN               ! ocean point only
+               e3tp (ji,jj) = e3t(ji,jj,ik  )
+               e3wp (ji,jj) = e3w(ji,jj,ik  )
+               ! test
+               zmin= gdepw(ji,jj,ik+1) - gdept(ji,jj,ik  )
+               IF( zmin <= 0._wp .AND. lwp ) THEN
+                  jl = jl + 1
+                  WRITE(numout,*) ' it      = ', jl, ' ik      = ', ik, ' (i,j) = ', ji, jj
+                  WRITE(numout,*) ' bathy = ', bathy(ji,jj)
+                  WRITE(numout,*) ' gdept = ', gdept(ji,jj,ik), ' gdepw = ', gdepw(ji,jj,ik+1), ' zdiff = ', zmin
+                  WRITE(numout,*) ' e3tp  = ', e3t  (ji,jj,ik), ' e3wp  = ', e3w  (ji,jj,ik  )
+               ENDIF
             ENDIF
          END DO
       END DO
+      zhbat(:,:) = hbatf(:,:)   ;   CALL lbc_lnk( hbatf, 'F', 1._wp )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( hbatf(ji,jj) == 0._wp ) THEN
+               IF( zhbat(ji,jj) == 0._wp )   hbatf(ji,jj) = rn_sbot_min
+               IF( zhbat(ji,jj) /= 0._wp )   hbatf(ji,jj) = zhbat(ji,jj)
+            ENDIF
+         END DO
+      END DO
+!!bug:  key_helsinki a verifer
+      hift(:,:) = MIN( hift(:,:), hbatt(:,:) )
+      hifu(:,:) = MIN( hifu(:,:), hbatu(:,:) )
+      hifv(:,:) = MIN( hifv(:,:), hbatv(:,:) )
+      hiff(:,:) = MIN( hiff(:,:), hbatf(:,:) )
+      IF( nprint == 1 .AND. lwp )   THEN
+         WRITE(numout,*) ' MAX val hif   t ', MAXVAL( hift (:,:) ), ' f ', MAXVAL( hiff (:,:) ),  &
+            &                        ' u ',   MAXVAL( hifu (:,:) ), ' v ', MAXVAL( hifv (:,:) )
+         WRITE(numout,*) ' MIN val hif   t ', MINVAL( hift (:,:) ), ' f ', MINVAL( hiff (:,:) ),  &
+            &                        ' u ',   MINVAL( hifu (:,:) ), ' v ', MINVAL( hifv (:,:) )
+         WRITE(numout,*) ' MAX val hbat  t ', MAXVAL( hbatt(:,:) ), ' f ', MAXVAL( hbatf(:,:) ),  &
+            &                        ' u ',   MAXVAL( hbatu(:,:) ), ' v ', MAXVAL( hbatv(:,:) )
+         WRITE(numout,*) ' MIN val hbat  t ', MINVAL( hbatt(:,:) ), ' f ', MINVAL( hbatf(:,:) ),  &
+            &                        ' u ',   MINVAL( hbatu(:,:) ), ' v ', MINVAL( hbatv(:,:) )
+      ENDIF
+!! helsinki
+      !                                            ! =======================
+      !                                            !   s-ccordinate fields     (gdep., e3.)
+      !                                            ! =======================
+      !
+      ! non-dimensional "sigma" for model level depth at w- and t-levels
+!========================================================================
+! Song and Haidvogel  1994 (ln_s_sh94=T)
+! Siddorn and Furner 2012 (ln_sf12=T)
+! or  tanh function       (both false)
+!========================================================================
+      IF      ( ln_s_sh94 ) THEN
+                           CALL s_sh94()
+      ELSE IF ( ln_s_sf12 ) THEN
+                           CALL s_sf12()
+      ELSE
+                           CALL s_tanh()
+      ENDIF
+      CALL lbc_lnk( e3t , 'T', 1._wp )
+      CALL lbc_lnk( e3u , 'U', 1._wp )
+      CALL lbc_lnk( e3v , 'V', 1._wp )
+      CALL lbc_lnk( e3f , 'F', 1._wp )
+      CALL lbc_lnk( e3w , 'W', 1._wp )
+      CALL lbc_lnk( e3uw, 'U', 1._wp )
+      CALL lbc_lnk( e3vw, 'V', 1._wp )
+      fsdepw(:,:,:) = gdepw (:,:,:)
+      fsde3w(:,:,:) = gdep3w(:,:,:)
+      !
+      where (e3t   (:,:,:).eq.0.0)  e3t(:,:,:) = 1.0
+      where (e3u   (:,:,:).eq.0.0)  e3u(:,:,:) = 1.0
+      where (e3v   (:,:,:).eq.0.0)  e3v(:,:,:) = 1.0
+      where (e3f   (:,:,:).eq.0.0)  e3f(:,:,:) = 1.0
+      where (e3w   (:,:,:).eq.0.0)  e3w(:,:,:) = 1.0
+      where (e3uw  (:,:,:).eq.0.0)  e3uw(:,:,:) = 1.0
+      where (e3vw  (:,:,:).eq.0.0)  e3vw(:,:,:) = 1.0
+      fsdept(:,:,:) = gdept (:,:,:)
+      fsdepw(:,:,:) = gdepw (:,:,:)
+      fsde3w(:,:,:) = gdep3w(:,:,:)
+      fse3t (:,:,:) = e3t   (:,:,:)
+      fse3u (:,:,:) = e3u   (:,:,:)
+      fse3v (:,:,:) = e3v   (:,:,:)
+      fse3f (:,:,:) = e3f   (:,:,:)
+      fse3w (:,:,:) = e3w   (:,:,:)
+      fse3uw(:,:,:) = e3uw  (:,:,:)
+      fse3vw(:,:,:) = e3vw  (:,:,:)
+!!
+      ! HYBRID :
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpkm1
+               IF( scobot(ji,jj) >= fsdept(ji,jj,jk) )   mbathy(ji,jj) = MAX( 2, jk )
+               IF( scobot(ji,jj) == 0._wp            )   mbathy(ji,jj) = 0
+      ! Scale factors and depth at U-, V-, UW and VW-points
+      DO jk = 1, jpk                        ! initialisation to z-scale factors
+         e3u (:,:,jk) = e3t(:,:,jk)
+         e3v (:,:,jk) = e3t(:,:,jk)
+         e3uw(:,:,jk) = e3w(:,:,jk)
+         e3vw(:,:,jk) = e3w(:,:,jk)
+         e3f (:,:,jk) = e3t(:,:,jk)
+      END DO
+          DO jk = 1, jpksigm-1
+           DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1
+                e3u(ji,jj,jk)=( REAL(MIN(1,mbathy(ji,jj)),wp)* e3t(ji,jj,jk)     +          &
+                                REAL(MIN(1,mbathy(ji+1,jj)),wp)*e3t(ji+1,jj,jk) )           &
+                /MAX(  1, MIN(1,mbathy(ji,jj))+MIN(1,mbathy(ji+1,jj))   )
+                e3uw(ji,jj,jk)=(REAL(MIN(1,mbathy(ji,jj)),wp)* e3w(ji,jj,jk)    +          &
+                                REAL(MIN(1,mbathy(ji+1,jj)),wp)*e3w(ji+1,jj,jk) )           &
+                  /REAL(MAX(  1, MIN(1,mbathy(ji,jj))+MIN(1,mbathy(ji+1,jj))),wp)
+                e3v(ji,jj,jk)=(REAL(MIN(1,mbathy(ji,jj)),wp)* e3t(ji,jj,jk)     +          &
+                               REAL(MIN(1,mbathy(ji,jj+1)),wp)*e3t(ji,jj+1,jk) )           &
+                /REAL (MAX(  1, MIN(1,mbathy(ji,jj))+MIN(1,mbathy(ji,jj+1))),wp)
+                e3vw(ji,jj,jk)=(REAL(MIN(1,mbathy(ji,jj)),wp)* e3w(ji,jj,jk)    +          &
+                                REAL(MIN(1,mbathy(ji,jj+1)),wp)*e3w(ji,jj+1,jk) )                 &
+                /REAL(MAX(  1, MIN(1,mbathy(ji,jj))+MIN(1,mbathy(ji,jj+1))),wp)
+                e3f(ji,jj,jk)=(REAL(MIN(1,mbathy(ji,jj)),wp)* e3t(ji,jj,jk)     +          &
+                               REAL(MIN(1,mbathy(ji+1,jj)),wp)*e3t(ji+1,jj,jk)  +          &
+                               REAL(MIN(1,mbathy(ji+1,jj+1)),wp)* e3t(ji+1,jj+1,jk)+       &
+                               REAL(MIN(1,mbathy(ji,jj+1)),wp)*e3t(ji,jj+1,jk) )           &
+                /REAL(MAX(  1, MIN(1,mbathy(ji,jj))+MIN(1,mbathy(ji,jj+1))             &
+                      +   MIN(1,mbathy(ji+1,jj))+MIN(1,mbathy(ji+1,jj+1))),wp)
+               ENDDO
             END DO
          END DO
+      END DO
+      IF( nprint == 1 .AND. lwp ) WRITE(numout,*) ' MIN val mbathy h90 ', MINVAL( mbathy(:,:) ),   &
+         &                                                       ' MAX ', MAXVAL( mbathy(:,:) )
+      IF( nprint == 1  .AND. lwp )   THEN         ! min max values over the local domain
+         WRITE(numout,*) ' MIN val mbathy  ', MINVAL( mbathy(:,:)   ), ' MAX ', MAXVAL( mbathy(:,:) )
+         WRITE(numout,*) ' MIN val depth t ', MINVAL( fsdept(:,:,:) ),   &
+            &                          ' w ', MINVAL( fsdepw(:,:,:) ), '3w '  , MINVAL( fsde3w(:,:,:) )
+         WRITE(numout,*) ' MIN val e3    t ', MINVAL( fse3t (:,:,:) ), ' f '  , MINVAL( fse3f (:,:,:) ),   &
+            &                          ' u ', MINVAL( fse3u (:,:,:) ), ' u '  , MINVAL( fse3v (:,:,:) ),   &
+            &                          ' uw', MINVAL( fse3uw(:,:,:) ), ' vw'  , MINVAL( fse3vw(:,:,:) ),   &
+            &                          ' w ', MINVAL( fse3w (:,:,:) )
+         WRITE(numout,*) ' MAX val depth t ', MAXVAL( fsdept(:,:,:) ),   &
+            &                          ' w ', MAXVAL( fsdepw(:,:,:) ), '3w '  , MAXVAL( fsde3w(:,:,:) )
+         WRITE(numout,*) ' MAX val e3    t ', MAXVAL( fse3t (:,:,:) ), ' f '  , MAXVAL( fse3f (:,:,:) ),   &
+            &                          ' u ', MAXVAL( fse3u (:,:,:) ), ' u '  , MAXVAL( fse3v (:,:,:) ),   &
+            &                          ' uw', MAXVAL( fse3uw(:,:,:) ), ' vw'  , MAXVAL( fse3vw(:,:,:) ),   &
+            &                          ' w ', MAXVAL( fse3w (:,:,:) )
+      ENDIF
+      !  END DO
+      IF(lwp) THEN                                  ! selected vertical profiles
+         WRITE(numout,*)
+         WRITE(numout,*) ' domzgr: vertical coordinates : point (1,1,k) bathy = ', bathy(1,1), hbatt(1,1)
+         WRITE(numout,*) ' ~~~~~~  --------------------'
+         WRITE(numout,"(9x,' level   gdept    gdepw    gde3w     e3t      e3w  ')")
+         WRITE(numout,"(10x,i4,4f9.2)") ( jk, fsdept(1,1,jk), fsdepw(1,1,jk),     &
+            &                                 fse3t (1,1,jk), fse3w (1,1,jk), jk=1,jpk )
+         DO jj = mj0(20), mj1(20)
+            DO ji = mi0(20), mi1(20)
+               WRITE(numout,*)
+               WRITE(numout,*) ' domzgr: vertical coordinates : point (20,20,k)   bathy = ', bathy(ji,jj), hbatt(ji,jj)
+               WRITE(numout,*) ' ~~~~~~  --------------------'
+               WRITE(numout,"(9x,' level   gdept    gdepw    gde3w     e3t      e3w  ')")
+               WRITE(numout,"(10x,i4,4f9.2)") ( jk, fsdept(ji,jj,jk), fsdepw(ji,jj,jk),     &
+                  &                                 fse3t (ji,jj,jk), fse3w (ji,jj,jk), jk=1,jpk )
+      DO jk = jpksigm,jpk                         ! Computed as the minimum of neighbooring scale factors
+               DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               e3u (ji,jj,jk) = MIN( e3t(ji,jj,jk), e3t(ji+1,jj,jk) )
+               e3v (ji,jj,jk) = MIN( e3t(ji,jj,jk), e3t(ji,jj+1,jk) )
+               e3uw(ji,jj,jk) = MIN( e3w(ji,jj,jk), e3w(ji+1,jj,jk) )
+               e3vw(ji,jj,jk) = MIN( e3w(ji,jj,jk), e3w(ji,jj+1,jk) )
             END DO
          END DO
+         DO jj = mj0(74), mj1(74)
+            DO ji = mi0(100), mi1(100)
+               WRITE(numout,*)
+               WRITE(numout,*) ' domzgr: vertical coordinates : point (100,74,k)   bathy = ', bathy(ji,jj), hbatt(ji,jj)
+               WRITE(numout,*) ' ~~~~~~  --------------------'
+               WRITE(numout,"(9x,' level   gdept    gdepw    gde3w     e3t      e3w  ')")
+               WRITE(numout,"(10x,i4,4f9.2)") ( jk, fsdept(ji,jj,jk), fsdepw(ji,jj,jk),     &
+                  &                                 fse3t (ji,jj,jk), fse3w (ji,jj,jk), jk=1,jpk )
+      END DO
+      CALL lbc_lnk( e3u , 'U', 1._wp )   ;   CALL lbc_lnk( e3uw, 'U', 1._wp )   ! lateral boundary conditions
+      CALL lbc_lnk( e3v , 'V', 1._wp )   ;   CALL lbc_lnk( e3vw, 'V', 1._wp )
+      !
+      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries)
+         WHERE( e3u (:,:,jk) == 0._wp )   e3u (:,:,jk) = e3t_0(jk)
+         WHERE( e3v (:,:,jk) == 0._wp )   e3v (:,:,jk) = e3t_0(jk)
+         WHERE( e3uw(:,:,jk) == 0._wp )   e3uw(:,:,jk) = e3w_0(jk)
+         WHERE( e3vw(:,:,jk) == 0._wp )   e3vw(:,:,jk) = e3w_0(jk)
+      END DO
+      DO jk = jpksigm, jpk                        ! Computed as the minimum of neighbooring V-scale factors
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               e3f(ji,jj,jk) = MIN( e3v(ji,jj,jk), e3v(ji+1,jj,jk) )
             END DO
          END DO
+      ENDIF
+!================================================================================
+! check the coordinate makes sense
+!================================================================================
+      DO ji = 1, jpi
+         DO jj = 1, jpj
+            IF( hbatt(ji,jj) > 0._wp) THEN
+               DO jk = 1, mbathy(ji,jj)
+                 ! check coordinate is monotonically increasing
+                 IF (fse3w(ji,jj,jk) <= 0._wp .OR. fse3t(ji,jj,jk) <= 0._wp ) THEN
+                    WRITE(ctmp1,*) 'ERROR zgr_sco :   e3w   or e3t   =< 0  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'ERROR zgr_sco :   e3w   or e3t   =< 0  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'e3w',fse3w(ji,jj,:)
+                    WRITE(numout,*) 'e3t',fse3t(ji,jj,:)
+                    CALL ctl_stop( ctmp1 )
+                 ENDIF
+                 ! and check it has never gone negative
+                 IF( fsdepw(ji,jj,jk) < 0._wp .OR. fsdept(ji,jj,jk) < 0._wp ) THEN
+                    WRITE(ctmp1,*) 'ERROR zgr_sco :   gdepw or gdept =< 0  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'ERROR zgr_sco :   gdepw   or gdept   =< 0  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'gdepw',fsdepw(ji,jj,:)
+                    WRITE(numout,*) 'gdept',fsdept(ji,jj,:)
+                    CALL ctl_stop( ctmp1 )
+                 ENDIF
+                 ! and check it never exceeds the total depth
+                 IF( fsdepw(ji,jj,jk) > hbatt(ji,jj) ) THEN
+                    WRITE(ctmp1,*) 'ERROR zgr_sco :   gdepw > hbatt  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'ERROR zgr_sco :   gdepw > hbatt  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'gdepw',fsdepw(ji,jj,:)
+                    CALL ctl_stop( ctmp1 )
+                 ENDIF
+               END DO
+               DO jk = 1, mbathy(ji,jj)-1
+                 ! and check it never exceeds the total depth
+                IF( fsdept(ji,jj,jk) > hbatt(ji,jj) ) THEN
+                    WRITE(ctmp1,*) 'ERROR zgr_sco :   gdept > hbatt  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'ERROR zgr_sco :   gdept > hbatt  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'gdept',fsdept(ji,jj,:)
+                    CALL ctl_stop( ctmp1 )
+                 ENDIF
+               END DO
+            ENDIF
+         END DO
+      END DO
+      !
+      CALL wrk_dealloc( jpi, jpj,      zenv, ztmp, zmsk, zri, zrj, zhbat                           )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zgr_sco')
+      !
+   END SUBROUTINE zgr_sco
+!!======================================================================
+   SUBROUTINE s_sh94()
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE s_sh94  ***
+      !!
+      !! ** Purpose :   stretch the s-coordinate system
+      !!
+      !! ** Method  :   s-coordinate stretch using the Song and Haidvogel 1994
+      !!                mixed S/sigma coordinate
+      !!
+      !! Reference : Song and Haidvogel 1994.
+      !!----------------------------------------------------------------------
+      !
+      INTEGER  ::   ji, jj, jk           ! dummy loop argument
+      REAL(wp) ::   zcoeft, zcoefw   ! temporary scalars
+      !
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: z_gsigw3, z_gsigt3, z_gsi3w3
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3
+      CALL wrk_alloc( jpi, jpj, jpk, z_gsigw3, z_gsigt3, z_gsi3w3                                      )
+      CALL wrk_alloc( jpi, jpj, jpk, z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 )
+      z_gsigw3  = 0._wp   ;   z_gsigt3  = 0._wp   ;   z_gsi3w3  = 0._wp
+      z_esigt3  = 0._wp   ;   z_esigw3  = 0._wp
+      z_esigtu3 = 0._wp   ;   z_esigtv3 = 0._wp   ;   z_esigtf3 = 0._wp
+      z_esigwu3 = 0._wp   ;   z_esigwv3 = 0._wp
+      DO ji = 1, jpi
+         DO jj = 1, jpj
+            IF( hbatt(ji,jj) > rn_hc ) THEN    !deep water, stretched sigma
+               DO jk = 1, jpk
+                  z_gsigw3(ji,jj,jk) = -fssig1( REAL(jk,wp)-0.5_wp, rn_bb )
+                  z_gsigt3(ji,jj,jk) = -fssig1( REAL(jk,wp)       , rn_bb )
+               END DO
+            ELSE ! shallow water, uniform sigma
+               DO jk = 1, jpk
+                  z_gsigw3(ji,jj,jk) =   REAL(jk-1,wp)            / REAL(jpk-1,wp)
+                  z_gsigt3(ji,jj,jk) = ( REAL(jk-1,wp) + 0.5_wp ) / REAL(jpk-1,wp)
+                  END DO
+            ENDIF
+            !
+            DO jk = 1, jpkm1
+               z_esigt3(ji,jj,jk  ) = z_gsigw3(ji,jj,jk+1) - z_gsigw3(ji,jj,jk)
+               z_esigw3(ji,jj,jk+1) = z_gsigt3(ji,jj,jk+1) - z_gsigt3(ji,jj,jk)
+            END DO
+            z_esigw3(ji,jj,1  ) = 2._wp * ( z_gsigt3(ji,jj,1  ) - z_gsigw3(ji,jj,1  ) )
+            z_esigt3(ji,jj,jpk) = 2._wp * ( z_gsigt3(ji,jj,jpk) - z_gsigw3(ji,jj,jpk) )
+            !
+            ! Coefficients for vertical depth as the sum of e3w scale factors
+            z_gsi3w3(ji,jj,1) = 0.5_wp * z_esigw3(ji,jj,1)
+            DO jk = 2, jpk
+               z_gsi3w3(ji,jj,jk) = z_gsi3w3(ji,jj,jk-1) + z_esigw3(ji,jj,jk)
+            END DO
+            !
+            DO jk = 1, jpk
+               zcoeft = ( REAL(jk,wp) - 0.5_wp ) / REAL(jpkm1,wp)
+               zcoefw = ( REAL(jk,wp) - 1.0_wp ) / REAL(jpkm1,wp)
+               gdept (ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsigt3(ji,jj,jk)+rn_hc*zcoeft )
+               gdepw (ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsigw3(ji,jj,jk)+rn_hc*zcoefw )
+               gdep3w(ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsi3w3(ji,jj,jk)+rn_hc*zcoeft )
+            END DO
+           !
+         END DO   ! for all jj's
+      END DO    ! for all ji's
+      DO ji = 1, jpim1
+         DO jj = 1, jpjm1
+            DO jk = 1, jpk
+               z_esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj,jk) )   &
+                  &              / ( hbatt(ji,jj)+hbatt(ji+1,jj) )
+               z_esigtv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigt3(ji,jj+1,jk) )   &
+                  &              / ( hbatt(ji,jj)+hbatt(ji,jj+1) )
+               z_esigtf3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj,jk)     &
+                  &                + hbatt(ji,jj+1)*z_esigt3(ji,jj+1,jk)+hbatt(ji+1,jj+1)*z_esigt3(ji+1,jj+1,jk) )   &
+                  &              / ( hbatt(ji,jj)+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1) )
+               z_esigwu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigw3(ji+1,jj,jk) )   &
+                  &              / ( hbatt(ji,jj)+hbatt(ji+1,jj) )
+               z_esigwv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigw3(ji,jj+1,jk) )   &
+                  &              / ( hbatt(ji,jj)+hbatt(ji,jj+1) )
+               !
+               e3t(ji,jj,jk) = ( (hbatt(ji,jj)-rn_hc)*z_esigt3 (ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+               e3u(ji,jj,jk) = ( (hbatu(ji,jj)-rn_hc)*z_esigtu3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+               e3v(ji,jj,jk) = ( (hbatv(ji,jj)-rn_hc)*z_esigtv3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+               e3f(ji,jj,jk) = ( (hbatf(ji,jj)-rn_hc)*z_esigtf3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+               !
+               e3w (ji,jj,jk) = ( (hbatt(ji,jj)-rn_hc)*z_esigw3 (ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+               e3uw(ji,jj,jk) = ( (hbatu(ji,jj)-rn_hc)*z_esigwu3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+               e3vw(ji,jj,jk) = ( (hbatv(ji,jj)-rn_hc)*z_esigwv3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+            END DO
+        END DO
+      END DO
+      CALL wrk_dealloc( jpi, jpj, jpk, z_gsigw3, z_gsigt3, z_gsi3w3                                      )
+      CALL wrk_dealloc( jpi, jpj, jpk, z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 )
+   END SUBROUTINE s_sh94
+   SUBROUTINE s_sf12
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE s_sf12 ***
+      !!
+      !! ** Purpose :   stretch the s-coordinate system
+      !!
+      !! ** Method  :   s-coordinate stretch using the Siddorn and Furner 2012?
+      !!                mixed S/sigma/Z coordinate
+      !!
+      !!                This method allows the maintenance of fixed surface and or
+      !!                bottom cell resolutions (cf. geopotential coordinates)
+      !!                within an analytically derived stretched S-coordinate framework.
+      !!
+      !!
+      !! Reference : Siddorn and Furner 2012 (submitted Ocean modelling).
+      !!----------------------------------------------------------------------
+      !
+      INTEGER  ::   ji, jj, jk           ! dummy loop argument
+      REAL(wp) ::   zsmth               ! smoothing around critical depth
+      REAL(wp) ::   zzs, zzb           ! Surface and bottom cell thickness in sigma space
+      !
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: z_gsigw3, z_gsigt3, z_gsi3w3
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, z_gsigw3, z_gsigt3, z_gsi3w3                                      )
+      CALL wrk_alloc( jpi, jpj, jpk, z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 )
+      z_gsigw3  = 0._wp   ;   z_gsigt3  = 0._wp   ;   z_gsi3w3  = 0._wp
+      z_esigt3  = 0._wp   ;   z_esigw3  = 0._wp
+      z_esigtu3 = 0._wp   ;   z_esigtv3 = 0._wp   ;   z_esigtf3 = 0._wp
+      z_esigwu3 = 0._wp   ;   z_esigwv3 = 0._wp
+      DO ji = 1, jpi
+         DO jj = 1, jpj
+          IF (hbatt(ji,jj)>rn_hc) THEN !deep water, stretched sigma
+              zzb = hbatt(ji,jj)*rn_zb_a + rn_zb_b   ! this forces a linear bottom cell depth relationship with H,.
+                                                     ! could be changed by users but care must be taken to do so carefully
+              zzb = 1.0_wp-(zzb/hbatt(ji,jj))
+              zzs = rn_zs / hbatt(ji,jj)
+              IF (rn_efold /= 0.0_wp) THEN
+                zsmth   = tanh( (hbatt(ji,jj)- rn_hc ) / rn_efold )
+              ELSE
+                zsmth = 1.0_wp
+              ENDIF
+              DO jk = 1, jpk
+                z_gsigw3(ji,jj,jk) =  REAL(jk-1,wp)        /REAL(jpk-1,wp)
+                z_gsigt3(ji,jj,jk) = (REAL(jk-1,wp)+0.5_wp)/REAL(jpk-1,wp)
+              ENDDO
+              z_gsigw3(ji,jj,:) = fgamma( z_gsigw3(ji,jj,:), zzb, zzs, zsmth  )
+              z_gsigt3(ji,jj,:) = fgamma( z_gsigt3(ji,jj,:), zzb, zzs, zsmth  )
+          ELSE IF (ln_sigcrit) THEN ! shallow water, uniform sigma
+            DO jk = 1, jpk
+              z_gsigw3(ji,jj,jk) =  REAL(jk-1,wp)     /REAL(jpk-1,wp)
+              z_gsigt3(ji,jj,jk) = (REAL(jk-1,wp)+0.5)/REAL(jpk-1,wp)
+            END DO
+          ELSE  ! shallow water, z coordinates
+            DO jk = 1, jpk
+              z_gsigw3(ji,jj,jk) =  REAL(jk-1,wp)        /REAL(jpk-1,wp)*(rn_hc/hbatt(ji,jj))
+              z_gsigt3(ji,jj,jk) = (REAL(jk-1,wp)+0.5_wp)/REAL(jpk-1,wp)*(rn_hc/hbatt(ji,jj))
+            END DO
+          ENDIF
+          DO jk = 1, jpkm1
+             z_esigt3(ji,jj,jk) = z_gsigw3(ji,jj,jk+1) - z_gsigw3(ji,jj,jk)
+             z_esigw3(ji,jj,jk+1) = z_gsigt3(ji,jj,jk+1) - z_gsigt3(ji,jj,jk)
+          END DO
+          z_esigw3(ji,jj,1  ) = 2.0_wp * (z_gsigt3(ji,jj,1  ) - z_gsigw3(ji,jj,1  ))
+          z_esigt3(ji,jj,jpk) = 2.0_wp * (z_gsigt3(ji,jj,jpk) - z_gsigw3(ji,jj,jpk))
+          ! Coefficients for vertical depth as the sum of e3w scale factors
+          z_gsi3w3(ji,jj,1) = 0.5 * z_esigw3(ji,jj,1)
+          DO jk = 2, jpk
+             z_gsi3w3(ji,jj,jk) = z_gsi3w3(ji,jj,jk-1) + z_esigw3(ji,jj,jk)
+          END DO
+          DO jk = 1, jpk
+             gdept (ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsigt3(ji,jj,jk)
+             gdepw (ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsigw3(ji,jj,jk)
+             gdep3w(ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsi3w3(ji,jj,jk)
+          END DO
+        ENDDO   ! for all jj's
+      ENDDO    ! for all ji's
+      DO ji=1,jpi-1
+        DO jj=1,jpj-1
+          DO jk = 1, jpk
+                z_esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj,jk) ) / &
+                                    ( hbatt(ji,jj)+hbatt(ji+1,jj) )
+                z_esigtv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigt3(ji,jj+1,jk) ) / &
+                                    ( hbatt(ji,jj)+hbatt(ji,jj+1) )
+                z_esigtf3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj,jk) +  &
+                                      hbatt(ji,jj+1)*z_esigt3(ji,jj+1,jk)+hbatt(ji+1,jj+1)*z_esigt3(ji+1,jj+1,jk) ) / &
+                                    ( hbatt(ji,jj)+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1) )
+                z_esigwu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigw3(ji+1,jj,jk) ) / &
+                                    ( hbatt(ji,jj)+hbatt(ji+1,jj) )
+                z_esigwv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigw3(ji,jj+1,jk) ) / &
+                                    ( hbatt(ji,jj)+hbatt(ji,jj+1) )
+             e3t(ji,jj,jk)=(scosrf(ji,jj)+hbatt(ji,jj))*z_esigt3(ji,jj,jk)
+             e3u(ji,jj,jk)=(scosrf(ji,jj)+hbatu(ji,jj))*z_esigtu3(ji,jj,jk)
+             e3v(ji,jj,jk)=(scosrf(ji,jj)+hbatv(ji,jj))*z_esigtv3(ji,jj,jk)
+             e3f(ji,jj,jk)=(scosrf(ji,jj)+hbatf(ji,jj))*z_esigtf3(ji,jj,jk)
+             !
+             e3w(ji,jj,jk)=hbatt(ji,jj)*z_esigw3(ji,jj,jk)
+             e3uw(ji,jj,jk)=hbatu(ji,jj)*z_esigwu3(ji,jj,jk)
+             e3vw(ji,jj,jk)=hbatv(ji,jj)*z_esigwv3(ji,jj,jk)
+          END DO
+        ENDDO
+      ENDDO
+      !
+      CALL lbc_lnk(e3t ,'T',1.) ; CALL lbc_lnk(e3u ,'T',1.)
+      CALL lbc_lnk(e3v ,'T',1.) ; CALL lbc_lnk(e3f ,'T',1.)
+      CALL lbc_lnk(e3w ,'T',1.)
+      CALL lbc_lnk(e3uw,'T',1.) ; CALL lbc_lnk(e3vw,'T',1.)
+      !
+      !                                               ! =============
+      CALL wrk_dealloc( jpi, jpj, jpk, z_gsigw3, z_gsigt3, z_gsi3w3                                      )
+      CALL wrk_dealloc( jpi, jpj, jpk, z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 )
+   END SUBROUTINE s_sf12
+   SUBROUTINE s_tanh()
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE s_tanh***
+      !!
+      !! ** Purpose :   stretch the s-coordinate system
+      !!
+      !! ** Method  :   s-coordinate stretch
+      !!
+      !! Reference : Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408.
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk           ! dummy loop argument
+      REAL(wp) ::   zcoeft, zcoefw   ! temporary scalars
+      REAL(wp), POINTER, DIMENSION(:) :: z_gsigw, z_gsigt, z_gsi3w
+      REAL(wp), POINTER, DIMENSION(:) :: z_esigt, z_esigw
+      CALL wrk_alloc( jpk, z_gsigw, z_gsigt, z_gsi3w                                      )
+      CALL wrk_alloc( jpk, z_esigt, z_esigw                                               )
+      z_gsigw  = 0._wp   ;   z_gsigt  = 0._wp   ;   z_gsi3w  = 0._wp
+      z_esigt  = 0._wp   ;   z_esigw  = 0._wp
+      DO jk = 1, jpk
+        z_gsigw(jk) = -fssig( REAL(jk,wp)-0.5_wp )
+        z_gsigt(jk) = -fssig( REAL(jk,wp)        )
+      END DO
+      IF( nprint == 1 .AND. lwp )   WRITE(numout,*) 'z_gsigw 1 jpk    ', z_gsigw(1), z_gsigw(jpk)
+      !
+      ! Coefficients for vertical scale factors at w-, t- levels
+!!gm bug :  define it from analytical function, not like juste bellow....
+!!gm        or betteroffer the 2 possibilities....
+      DO jk = 1, jpkm1
+         z_esigt(jk  ) = z_gsigw(jk+1) - z_gsigw(jk)
+         z_esigw(jk+1) = z_gsigt(jk+1) - z_gsigt(jk)
+      END DO
+      z_esigw( 1 ) = 2._wp * ( z_gsigt(1  ) - z_gsigw(1  ) )
+      z_esigt(jpk) = 2._wp * ( z_gsigt(jpk) - z_gsigw(jpk) )
+      !
+      ! Coefficients for vertical depth as the sum of e3w scale factors
+      z_gsi3w(1) = 0.5_wp * z_esigw(1)
+      END DO
+      CALL lbc_lnk( e3f, 'F', 1._wp )       ! Lateral boundary conditions
+      !
+      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries)
+         WHERE( e3f(:,:,jk) == 0._wp )   e3f(:,:,jk) = e3t_0(jk)
+      END DO
+!!gm  bug ? :  must be a do loop with mj0,mj1
+      !
+      e3t(:,mj0(1),:) = e3t(:,mj0(2),:)     ! we duplicate factor scales for jj = 1 and jj = 2
+      e3w(:,mj0(1),:) = e3w(:,mj0(2),:)
+      e3u(:,mj0(1),:) = e3u(:,mj0(2),:)
+      e3v(:,mj0(1),:) = e3v(:,mj0(2),:)
+      e3f(:,mj0(1),:) = e3f(:,mj0(2),:)
+      ! Control of the sign
+      Do jk=1,jpk
+       do jj=1,jpj
+        do ji=1,jpi
+      IF( ( e3t  (ji,jj,jk) ) <= 0._wp )then
+      write(numout,*)'    zgr_hyb :   e r r o r   e3t   <= 0',ji,jj,jk,e3t  (ji,jj,jk); endif
+      IF( ( e3w  (ji,jj,jk) ) <= 0._wp )then
+      write(numout,*)'    zgr_hyb :   e r r o r   e3t   <= 0',ji,jj,jk,e3w  (ji,jj,jk); endif
+      IF( ( gdept(ji,jj,jk) ) <  0._wp )THEN
+       write (numout,*)'   zgr_hyb :   e r r o r   gdept <  0',ji,jj,jk ,gdept(ji,jj,jj);    endif
+      IF( ( gdepw(ji,jj,jk) ) <  0._wp )then
+      write (numout,*)'   zgr_hyb :   e r r o r   gdepw <  0',ji,jj,jk , gdepw(ji,jj,jj);   endif
+        enddo
+        enddo
+        enddo
+      ! Compute gdep3w (vertical sum of e3w)
+      gdep3w(:,:,1) = 0.5_wp * e3w(:,:,1)
       DO jk = 2, jpk
+         z_gsi3w(jk) = z_gsi3w(jk-1) + z_esigw(jk)
+      END DO
+!!gm: depuw, depvw can be suppressed (modif in ldfslp) and depw=dep3w can be set (save 3 3D arrays)
+      DO jk = 1, jpk
+         zcoeft = ( REAL(jk,wp) - 0.5_wp ) / REAL(jpkm1,wp)
+         zcoefw = ( REAL(jk,wp) - 1.0_wp ) / REAL(jpkm1,wp)
+         gdept (:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsigt(jk) + hift(:,:)*zcoeft )
+         gdepw (:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsigw(jk) + hift(:,:)*zcoefw )
+         gdep3w(:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsi3w(jk) + hift(:,:)*zcoeft )
+      END DO
+!!gm: e3uw, e3vw can be suppressed  (modif in dynzdf, dynzdf_iso, zdfbfr) (save 2 3D arrays)
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpk
+              e3t(ji,jj,jk) = ( (hbatt(ji,jj)-hift(ji,jj))*z_esigt(jk) + hift(ji,jj)/REAL(jpkm1,wp) )
+              e3u(ji,jj,jk) = ( (hbatu(ji,jj)-hifu(ji,jj))*z_esigt(jk) + hifu(ji,jj)/REAL(jpkm1,wp) )
+              e3v(ji,jj,jk) = ( (hbatv(ji,jj)-hifv(ji,jj))*z_esigt(jk) + hifv(ji,jj)/REAL(jpkm1,wp) )
+              e3f(ji,jj,jk) = ( (hbatf(ji,jj)-hiff(ji,jj))*z_esigt(jk) + hiff(ji,jj)/REAL(jpkm1,wp) )
+              !
+              e3w (ji,jj,jk) = ( (hbatt(ji,jj)-hift(ji,jj))*z_esigw(jk) + hift(ji,jj)/REAL(jpkm1,wp) )
+              e3uw(ji,jj,jk) = ( (hbatu(ji,jj)-hifu(ji,jj))*z_esigw(jk) + hifu(ji,jj)/REAL(jpkm1,wp) )
+              e3vw(ji,jj,jk) = ( (hbatv(ji,jj)-hifv(ji,jj))*z_esigw(jk) + hifv(ji,jj)/REAL(jpkm1,wp) )
+            END DO
+         END DO
+      END DO
+      CALL wrk_dealloc( jpk, z_gsigw, z_gsigt, z_gsi3w                                      )
+      CALL wrk_dealloc( jpk, z_esigt, z_esigw                                               )
+   END SUBROUTINE s_tanh
+   FUNCTION fssig( pk ) RESULT( pf )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE fssig ***
+      !!
+      !! ** Purpose :   provide the analytical function in s-coordinate
+      !!
+      !! ** Method  :   the function provide the non-dimensional position of
+      !!                T and W (i.e. between 0 and 1)
+      !!                T-points at integer values (between 1 and jpk)
+      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in) ::   pk   ! continuous "k" coordinate
+      REAL(wp)             ::   pf   ! sigma value
+      !!----------------------------------------------------------------------
+      !
+      pf =   (   TANH( rn_theta * ( -(pk-0.5_wp) / REAL(jpkm1) + rn_thetb )  )   &
+         &     - TANH( rn_thetb * rn_theta                                )  )   &
+         & * (   COSH( rn_theta                           )                      &
+         &     + COSH( rn_theta * ( 2._wp * rn_thetb - 1._wp ) )  )              &
+         & / ( 2._wp * SINH( rn_theta ) )
+      !
+   END FUNCTION fssig
+   FUNCTION fssig1( pk1, pbb ) RESULT( pf1 )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE fssig1 ***
+      !!
+      !! ** Purpose :   provide the Song and Haidvogel version of the analytical function in s-coordinate
+      !!
+      !! ** Method  :   the function provides the non-dimensional position of
+      !!                T and W (i.e. between 0 and 1)
+      !!                T-points at integer values (between 1 and jpk)
+      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in) ::   pk1   ! continuous "k" coordinate
+      REAL(wp), INTENT(in) ::   pbb   ! Stretching coefficient
+      REAL(wp)             ::   pf1   ! sigma value
+      !!----------------------------------------------------------------------
+      !
+      IF ( rn_theta == 0 ) then      ! uniform sigma
+         pf1 = - ( pk1 - 0.5_wp ) / REAL( jpkm1 )
+      ELSE                        ! stretched sigma
+         pf1 =   ( 1._wp - pbb ) * ( SINH( rn_theta*(-(pk1-0.5_wp)/REAL(jpkm1)) ) ) / SINH( rn_theta )              &
+            &  + pbb * (  (TANH( rn_theta*( (-(pk1-0.5_wp)/REAL(jpkm1)) + 0.5_wp) ) - TANH( 0.5_wp * rn_theta )  )  &
+            &        / ( 2._wp * TANH( 0.5_wp * rn_theta ) )  )
+      ENDIF
+      !
+   END FUNCTION fssig1
+   FUNCTION fgamma( pk1, pzb, pzs, psmth) RESULT( p_gamma )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE fgamma  ***
+      !!
+      !! ** Purpose :   provide analytical function for the s-coordinate
+      !!
+      !! ** Method  :   the function provides the non-dimensional position of
+      !!                T and W (i.e. between 0 and 1)
+      !!                T-points at integer values (between 1 and jpk)
+      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+      !!
+      !!                This method allows the maintenance of fixed surface and or
+      !!                bottom cell resolutions (cf. geopotential coordinates)
+      !!                within an analytically derived stretched S-coordinate framework.
+      !!
+      !! Reference  :   Siddorn and Furner, in prep
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in   ) ::   pk1(jpk)       ! continuous "k" coordinate
+      REAL(wp)                ::   p_gamma(jpk)   ! stretched coordinate
+      REAL(wp), INTENT(in   ) ::   pzb           ! Bottom box depth
+      REAL(wp), INTENT(in   ) ::   pzs           ! surface box depth
+      REAL(wp), INTENT(in   ) ::   psmth       ! Smoothing parameter
+      REAL(wp)                ::   za1,za2,za3    ! local variables
+      REAL(wp)                ::   zn1,zn2        ! local variables
+      REAL(wp)                ::   za,zb,zx       ! local variables
+      integer                 ::   jk
+      !!----------------------------------------------------------------------
+      !
+      zn1  =  1./(jpk-1.)
+      zn2  =  1. -  zn1
+      za1 = (rn_alpha+2.0_wp)*zn1**(rn_alpha+1.0_wp)-(rn_alpha+1.0_wp)*zn1**(rn_alpha+2.0_wp)
+      za2 = (rn_alpha+2.0_wp)*zn2**(rn_alpha+1.0_wp)-(rn_alpha+1.0_wp)*zn2**(rn_alpha+2.0_wp)
+      za3 = (zn2**3.0_wp - za2)/( zn1**3.0_wp - za1)
+         gdep3w(:,:,jk) = gdep3w(:,:,jk-1) + e3w(:,:,jk)
+      END DO
+     IF( lk_mpp )   CALL mpp_max( nstop )
+   IF (lwp) write(numout,*)"zpartial" ,nstop
+      CALL lbc_lnk( e3f, 'F', 1._wp )       ! Lateral boundary conditions
+      za = pzb - za3*(pzs-za1)-za2
+      za = za/( zn2-0.5_wp*(za2+zn2**2.0_wp) - za3*(zn1-0.5_wp*(za1+zn1**2.0_wp) ) )
+      zb = (pzs - za1 - za*( zn1-0.5_wp*(za1+zn1**2.0_wp ) ) ) / (zn1**3.0_wp - za1)
+      zx = 1.0_wp-za/2.0_wp-zb
+      DO jk = 1, jpk
+        p_gamma(jk) = za*(pk1(jk)*(1.0_wp-pk1(jk)/2.0_wp))+zb*pk1(jk)**3.0_wp +  &
+                    & zx*( (rn_alpha+2.0_wp)*pk1(jk)**(rn_alpha+1.0_wp)- &
+                    &      (rn_alpha+1.0_wp)*pk1(jk)**(rn_alpha+2.0_wp) )
+        p_gamma(jk) = p_gamma(jk)*psmth+pk1(jk)*(1.0_wp-psmth)
+      ENDDO
+      !
+   END FUNCTION fgamma
+      CALL wrk_dealloc( jpi, jpj,      zenv, ztmp, zmsk, zri, zrj, zhbat )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zgr_hyb')
+   END SUBROUTINE zgr_hyb
    !!======================================================================

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr_substitute.h90

-                      r2528
+                      r6736
 #   define  fse3vw(i,j,k)  e3vw_1(i,j,k)
+#if defined key_jth_fix
+#   define  fsdept_b(i,j,k)  (fsdept_0(i,j,k)*(1.+sshb(i,j)*mut(i,j,k)))
+#   define  fsdepw_b(i,j,k)  (fsdepw_0(i,j,k)*(1.+sshb(i,j)*mut(i,j,k)))
+#   define  fsde3w_b(i,j,k)  (fsde3w_0(i,j,k)*(1.+sshb(i,j)*mut(i,j,k))-sshb(i,j))
+#   define  fse3t_b(i,j,k)   (fse3t_0(i,j,k)*(1.+sshb(i,j)*mut(i,j,k)))
+#   define  fse3u_b(i,j,k)   (fse3u_0(i,j,k)*(1.+sshu_b(i,j)*muu(i,j,k)))
+#   define  fse3v_b(i,j,k)   (fse3v_0(i,j,k)*(1.+sshv_b(i,j)*muv(i,j,k)))
+#   define  fse3f_b(i,j,k)   (fse3f_0(i,j,k)*(1.+sshf_b(i,j)*muf(i,j,k)))
+#   define  fse3w_b(i,j,k)   (fse3w_0(i,j,k)*(1.+sshb(i,j)*mut(i,j,k)))
+#   define  fse3uw_b(i,j,k)  (fse3uw_0(i,j,k)*(1.+sshu_b(i,j)*muu(i,j,k)))
+#   define  fse3vw_b(i,j,k)  (fse3vw_0(i,j,k)*(1.+sshv_b(i,j)*muv(i,j,k)))
+#else
 #   define  fse3t_b(i,j,k)   e3t_b(i,j,k)
 #   define  fse3u_b(i,j,k)   e3u_b(i,j,k)
 …
 #   define  fse3uw_b(i,j,k)  (fse3uw_0(i,j,k)*(1.+sshu_b(i,j)*muu(i,j,k)))
 #   define  fse3vw_b(i,j,k)  (fse3vw_0(i,j,k)*(1.+sshv_b(i,j)*muv(i,j,k)))
+#endif
 #   define  fsdept_n(i,j,k)  (fsdept_0(i,j,k)*(1.+sshn(i,j)*mut(i,j,k)))
 …
 #   define  fse3t_m(i,j,k)   (fse3t_0(i,j,k)*(1.+ssh_m(i,j)*mut(i,j,k)))
+#if defined key_jth_fix
+#   define  fsdept_a(i,j,k)  (fsdept_0(i,j,k)*(1.+ssha(i,j)*mut(i,j,k)))
+#   define  fsdepw_a(i,j,k)  (fsdepw_0(i,j,k)*(1.+ssha(i,j)*mut(i,j,k)))
+#   define  fsde3w_a(i,j,k)  (fsde3w_0(i,j,k)*(1.+ssha(i,j)*mut(i,j,k))-ssha(i,j))
+#endif
 #   define  fse3t_a(i,j,k)   (fse3t_0(i,j,k)*(1.+ssha(i,j)*mut(i,j,k)))
 #   define  fse3u_a(i,j,k)   (fse3u_0(i,j,k)*(1.+sshu_a(i,j)*muu(i,j,k)))
 #   define  fse3v_a(i,j,k)   (fse3v_0(i,j,k)*(1.+sshv_a(i,j)*muv(i,j,k)))
+#if defined key_jth_fix
+#   define  fse3f_a(i,j,k)   (fse3f_0(i,j,k)*(1.+sshf_a(i,j)*muf(i,j,k)))
+#   define  fse3w_a(i,j,k)   (fse3w_0(i,j,k)*(1.+ssha(i,j)*mut(i,j,k)))
+#   define  fse3uw_a(i,j,k)  (fse3uw_0(i,j,k)*(1.+sshu_a(i,j)*muu(i,j,k)))
+#   define  fse3vw_a(i,j,k)  (fse3vw_0(i,j,k)*(1.+sshv_a(i,j)*muv(i,j,k)))
+#endif
 #else
 …
 #   define  fse3vw(i,j,k)  fse3vw_0(i,j,k)
+#if defined key_jth_fix
+#   define  fsdept_b(i,j,k)  fsdept_0(i,j,k)
+#   define  fsdepw_b(i,j,k)  fsdepw_0(i,j,k)
+#   define  fsde3w_b(i,j,k)  fsde3w_0(i,j,k)
+#endif
 #   define  fse3t_b(i,j,k)   fse3t_0(i,j,k)
 #   define  fse3u_b(i,j,k)   fse3u_0(i,j,k)
 #   define  fse3v_b(i,j,k)   fse3v_0(i,j,k)
+#if defined key_jth_fix
+#   define  fse3f_b(i,j,k)   fse3f_0(i,j,k)
+#   define  fse3w_b(i,j,k)   fse3w_0(i,j,k)
+#endif
 #   define  fse3uw_b(i,j,k)  fse3uw_0(i,j,k)
 #   define  fse3vw_b(i,j,k)  fse3vw_0(i,j,k)
 …
 #   define  fse3t_m(i,j,k)   fse3t_0(i,j,k)
+#if defined key_jth_fix
+#   define  fsdept_a(i,j,k)  fsdept_0(i,j,k)
+#   define  fsdepw_a(i,j,k)  fsdepw_0(i,j,k)
+#   define  fsde3w_a(i,j,k)  fsde3w_0(i,j,k)
+#endif
 #   define  fse3t_a(i,j,k)   fse3t_0(i,j,k)
 #   define  fse3u_a(i,j,k)   fse3u_0(i,j,k)
 #   define  fse3v_a(i,j,k)   fse3v_0(i,j,k)
+#if defined key_jth_fix
+#   define  fse3f_a(i,j,k)   fse3f_0(i,j,k)
+#   define  fse3w_a(i,j,k)   fse3w_0(i,j,k)
+#   define  fse3uw_a(i,j,k)  fse3uw_0(i,j,k)
+#   define  fse3vw_a(i,j,k)  fse3vw_0(i,j,k)
+#endif
 #endif
    !!----------------------------------------------------------------------

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90

-                      r3294
+                      r6736
    USE dom_oce         ! ocean space and time domain
    USE fldread         ! read input fields
-   USE in_out_manager  ! I/O manager
    USE phycst          ! physical constants
    USE lib_mpp         ! MPP library
    USE wrk_nemo        ! Memory allocation
    USE timing          ! Timing
+   USE in_out_manager  ! I/O manager
+   USE iom
    IMPLICIT NONE
 …
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tsd   ! structure of input SST (file informations, fields read)
+#if defined key_jdha_init
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,: ) ::   gdept_init
+#endif
    !! * Substitutions
 …
       INTEGER                              , INTENT(in   ) ::   kt     ! ocean time-step
       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   ptsd   ! T & S data
+!     REAL(wp), DIMENSION(jpi,jpj,jpk) ::   gdept_init   ! T & S data
+      !
       INTEGER ::   ji, jj, jk, jl, jkk   ! dummy loop indicies
 …
+      !
       CALL fld_read( kt, 1, sf_tsd )      !==   read T & S data at kt time step   ==!
+#if defined key_jdha_init
+      ALLOCATE( gdept_init(jpi,jpj,jpk) )
+      CALL iom_open ( sf_tsd(jp_tem)%clname, sf_tsd(jp_tem)%num )
+      CALL iom_get ( sf_tsd(jp_tem)%num, jpdom_data, 'deptht', gdept_init,1)
+      CALL iom_close( sf_tsd(jp_tem)%num )   ! Close the input file
+#endif
+      !
+      !
 …
                DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points
                   zl = fsdept_0(ji,jj,jk)
+#if defined key_jdha_init
+                  IF(     zl < gdept_init(ji,jj,1  ) ) THEN          ! above the first level of data
+#else
                   IF(     zl < gdept_0(1  ) ) THEN          ! above the first level of data
+#endif
                      ztp(jk) =  ptsd(ji,jj,1    ,jp_tem)
                      zsp(jk) =  ptsd(ji,jj,1    ,jp_sal)
+#if defined key_jdha_init
+                  ELSEIF( zl > gdept_init(ji,jj,jpk) ) THEN          ! below the last level of data
+#else
                   ELSEIF( zl > gdept_0(jpk) ) THEN          ! below the last level of data
+#endif
                      ztp(jk) =  ptsd(ji,jj,jpkm1,jp_tem)
                      zsp(jk) =  ptsd(ji,jj,jpkm1,jp_sal)
                   ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1
                      DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1)
+#if defined key_jdha_init
+                        IF( (zl-gdept_init(ji,jj,jkk)) * (zl-gdept_init(ji,jj,jkk+1)) <= 0._wp ) THEN
+                           zi = ( zl - gdept_init(ji,jj,jkk) ) / (gdept_init(ji,jj,jkk+1)-gdept_init(ji,jj,jkk))
+#else
                         IF( (zl-gdept_0(jkk)) * (zl-gdept_0(jkk+1)) <= 0._wp ) THEN
                            zi = ( zl - gdept_0(jkk) ) / (gdept_0(jkk+1)-gdept_0(jkk))
+#endif
                            ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi
                            zsp(jk) = ptsd(ji,jj,jkk,jp_sal) + ( ptsd(ji,jj,jkk+1,jp_sal) - ptsd(ji,jj,jkk,jp_sal) ) * zi
 …
          IF( sf_tsd(jp_sal)%ln_tint )   DEALLOCATE( sf_tsd(jp_sal)%fdta )
                                         DEALLOCATE( sf_tsd              )     ! the structure itself
+#if defined key_jdha_init
+         DEALLOCATE( gdept_init )
+#endif
       ENDIF
+      !

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

-                      r3764
+                      r6736
    USE phycst          ! physical constants
    USE dtatsd          ! data temperature and salinity   (dta_tsd routine)
+   USE restart         ! ocean restart                   (rst_read routine)
    USE in_out_manager  ! I/O manager
    USE iom             ! I/O library
 …
    USE sol_oce         ! ocean solver variables
    USE lib_mpp         ! MPP library
-   USE restart         ! restart
    USE wrk_nemo        ! Memory allocation
    USE timing          ! Timing
 …
       ! - ML - needed for initialization of e3t_b
       INTEGER  ::  jk     ! dummy loop indice
+      INTEGER  ::   inum              ! temporary logical unit
       !!----------------------------------------------------------------------
+      !
 …
          CALL rst_read                           ! Read the restart file
          !                                       ! define e3u_b, e3v_b from e3t_b read in restart file
+#if ! defined key_jth_fix
          CALL dom_vvl_2( nit000, fse3u_b(:,:,:), fse3v_b(:,:,:) )
+#endif
          CALL day_init                           ! model calendar (using both namelist and restart infos)
       ELSE
 …
             CALL dta_tsd( nit000, tsb )                  ! read 3D T and S data at nit000
             tsn(:,:,:,:) = tsb(:,:,:,:)
+#if defined key_jdha_ssh_init
+      CALL iom_open ( 'initcd_ssh.nc', inum )
+      CALL iom_get ( inum, jpdom_data, 'sossheig', sshb(:,:))
+      CALL iom_close( inum )   ! Close the input file
+      sshn(:,:) = sshb(:,:)
+#endif
+            !
          ELSE                                    ! Initial T-S fields defined analytically
 …
+         !
          ! - ML - sshn could be modified by istate_eel, so that initialization of fse3t_b is done here
+#if ! defined key_jth_fix
          IF( lk_vvl ) THEN
             DO jk = 1, jpk
 …
          !                                       ! define e3u_b, e3v_b from e3t_b initialized in domzgr
          CALL dom_vvl_2( nit000, fse3u_b(:,:,:), fse3v_b(:,:,:) )
+#endif
+         !
       ENDIF
 …
       INTEGER  :: ji, jj, jk
       REAL(wp) ::   zsal = 35.50
+#if defined key_istate_fixed
+      REAL(wp) ::   ztem = 25.50
+#endif
       !!----------------------------------------------------------------------
+      !
 …
       IF(lwp) WRITE(numout,*) '~~~~~~~~~~   and constant salinity (',zsal,' psu)'
+      !
+#if ! defined key_istate_fixed
       DO jk = 1, jpk
          tsn(:,:,jk,jp_tem) = (  ( ( 7.5 - 0. * ABS( gphit(:,:) )/30. ) * ( 1.-TANH((fsdept(:,:,jk)-80.)/30.) )   &
 …
          tsb(:,:,jk,jp_tem) = tsn(:,:,jk,jp_tem)
       END DO
+#else
+      tsn(:,:,:,jp_tem) = ztem * tmask(:,:,:)
+      tsb(:,:,:,jp_tem) = tsn(:,:,:,jp_tem)
+#endif
       tsn(:,:,:,jp_sal) = zsal * tmask(:,:,:)
       tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal)

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90

-                      r3625
+                      r6736
    REAL(wp), PUBLIC ::   rsmall = 0.5 * EPSILON( 1.e0 )         !: smallest real computer value
+   REAL(wp), PUBLIC ::   rday = 24.*60.*60.     !: day                                [s]
+   REAL(wp), PUBLIC ::   rsiyea                 !: sideral year                       [s]
+   REAL(wp), PUBLIC ::   rsiday                 !: sideral day                        [s]
+   REAL(wp), PUBLIC ::   raamo =  12._wp        !: number of months in one year
+   REAL(wp), PUBLIC ::   rjjhh =  24._wp        !: number of hours in one day
+   REAL(wp), PUBLIC ::   rhhmm =  60._wp        !: number of minutes in one hour
+   REAL(wp), PUBLIC ::   rmmss =  60._wp        !: number of seconds in one minute
+   REAL(wp), PUBLIC ::   omega                  !: earth rotation parameter           [s-1]
+   REAL(wp), PUBLIC ::   ra    = 6371229._wp    !: earth radius                       [m]
+   REAL(wp), PUBLIC ::   grav  = 9.80665_wp     !: gravity                            [m/s2]
+   REAL(wp), PUBLIC ::   rday = 24.*60.*60.       !: day (s)
+   REAL(wp), PUBLIC ::   rsiyea                   !: sideral year (s)
+   REAL(wp), PUBLIC ::   rsiday                   !: sideral day (s)
+   REAL(wp), PUBLIC ::   raamo =  12._wp          !: number of months in one year
+   REAL(wp), PUBLIC ::   rjjhh =  24._wp          !: number of hours in one day
+   REAL(wp), PUBLIC ::   rhhmm =  60._wp          !: number of minutes in one hour
+   REAL(wp), PUBLIC ::   rmmss =  60._wp          !: number of seconds in one minute
+!! REAL(wp), PUBLIC ::   omega = 7.292115083046061e-5_wp ,  &  !: change the last digit!
+   REAL(wp), PUBLIC ::   omega                    !: earth rotation parameter
+   REAL(wp), PUBLIC ::   ra    = 6371229._wp      !: earth radius (meter)
+   REAL(wp), PUBLIC ::   grav  = 9.80665_wp       !: gravity (m/s2)
    REAL(wp), PUBLIC ::   rtt      = 273.16_wp        !: triple point of temperature   [Kelvin]
    REAL(wp), PUBLIC ::   rt0      = 273.15_wp        !: freezing point of fresh water [Kelvin]
+   REAL(wp), PUBLIC ::   rtt      = 273.16_wp     !: triple point of temperature (Kelvin)
+   REAL(wp), PUBLIC ::   rt0      = 273.15_wp     !: freezing point of water (Kelvin)
 #if defined key_lim3
    REAL(wp), PUBLIC ::   rt0_snow = 273.16_wp        !: melting point of snow         [Kelvin]
    REAL(wp), PUBLIC ::   rt0_ice  = 273.16_wp        !: melting point of ice          [Kelvin]
+   REAL(wp), PUBLIC ::   rt0_snow = 273.16_wp     !: melting point of snow  (Kelvin)
+   REAL(wp), PUBLIC ::   rt0_ice  = 273.16_wp     !: melting point of ice   (Kelvin)
 #else
    REAL(wp), PUBLIC ::   rt0_snow = 273.15_wp        !: melting point of snow         [Kelvin]
    REAL(wp), PUBLIC ::   rt0_ice  = 273.05_wp        !: melting point of ice          [Kelvin]
+   REAL(wp), PUBLIC ::   rt0_snow = 273.15_wp     !: melting point of snow  (Kelvin)
+   REAL(wp), PUBLIC ::   rt0_ice  = 273.05_wp     !: melting point of ice   (Kelvin)
 #endif
 #if defined key_cice
    REAL(wp), PUBLIC ::   rau0     = 1026._wp         !: volumic mass of reference     [kg/m3]
+   REAL(wp), PUBLIC ::   rau0     = 1026._wp      !: reference volumic mass (density)  (kg/m3)
 #else
    REAL(wp), PUBLIC ::   rau0     = 1035._wp         !: volumic mass of reference     [kg/m3]
+   REAL(wp), PUBLIC ::   rau0     = 1035._wp      !: reference volumic mass (density)  (kg/m3)
 #endif
+   REAL(wp), PUBLIC ::   r1_rau0                     !: = 1. / rau0                   [m3/kg]
+   REAL(wp), PUBLIC ::   rauw     = 1000._wp         !: volumic mass of pure water    [m3/kg]
+   REAL(wp), PUBLIC ::   rcp      =    4.e3_wp       !: ocean specific heat           [J/Kelvin]
+   REAL(wp), PUBLIC ::   r1_rcp                      !: = 1. / rcp                    [Kelvin/J]
+   REAL(wp), PUBLIC ::   r1_rau0_rcp                 !: = 1. / ( rau0 * rcp )
+   REAL(wp), PUBLIC ::   rhosn    =  330._wp         !: volumic mass of snow          [kg/m3]
+   REAL(wp), PUBLIC ::   emic     =    0.97_wp       !: emissivity of snow or ice
+   REAL(wp), PUBLIC ::   sice     =    6.0_wp        !: salinity of ice               [psu]
+   REAL(wp), PUBLIC ::   soce     =   34.7_wp        !: salinity of sea               [psu]
+   REAL(wp), PUBLIC ::   cevap    =    2.5e+6_wp     !: latent heat of evaporation (water)
+   REAL(wp), PUBLIC ::   srgamma  =    0.9_wp        !: correction factor for solar radiation (Oberhuber, 1974)
+   REAL(wp), PUBLIC ::   vkarmn   =    0.4_wp        !: von Karman constant
+   REAL(wp), PUBLIC ::   stefan   =    5.67e-8_wp    !: Stefan-Boltzmann constant
+   REAL(wp), PUBLIC ::   rau0r                    !: reference specific volume         (m3/kg)
+   REAL(wp), PUBLIC ::   rcp      =    4.e+3_wp   !: ocean specific heat
+   REAL(wp), PUBLIC ::   ro0cpr                   !: = 1. / ( rau0 * rcp )
 #if defined key_lim3 || defined key_cice
+   REAL(wp), PUBLIC ::   rhoic    =  917._wp         !: volumic mass of sea ice                               [kg/m3]
+   REAL(wp), PUBLIC ::   rcdic    =    2.034396_wp   !: thermal conductivity of fresh ice
+   REAL(wp), PUBLIC ::   rcdsn    =    0.31_wp       !: thermal conductivity of snow
+   REAL(wp), PUBLIC ::   cpic     = 2067.0_wp        !: specific heat for ice
+   REAL(wp), PUBLIC ::   lsub     =    2.834e+6_wp   !: pure ice latent heat of sublimation                   [J/kg]
+   REAL(wp), PUBLIC ::   lfus     =    0.334e+6_wp   !: latent heat of fusion of fresh ice                    [J/kg]
+   REAL(wp), PUBLIC ::   tmut     =    0.054_wp      !: decrease of seawater meltpoint with salinity
+   REAL(wp), PUBLIC ::   xlsn                        !: = lfus*rhosn (volumetric latent heat fusion of snow)  [J/m3]
+   REAL(wp), PUBLIC ::   rcdsn   =   0.31_wp      !: thermal conductivity of snow
+   REAL(wp), PUBLIC ::   rcdic   =   2.034396_wp  !: thermal conductivity of fresh ice
+   REAL(wp), PUBLIC ::   cpic    = 2067.0         !: specific heat of sea ice
+   REAL(wp), PUBLIC ::   lsub    = 2.834e+6       !: pure ice latent heat of sublimation (J.kg-1)
+   REAL(wp), PUBLIC ::   lfus    = 0.334e+6       !: latent heat of fusion of fresh ice   (J.kg-1)
+   REAL(wp), PUBLIC ::   rhoic   = 917._wp        !: volumic mass of sea ice (kg/m3)
+   REAL(wp), PUBLIC ::   tmut    =   0.054        !: decrease of seawater meltpoint with salinity
 #else
+   REAL(wp), PUBLIC ::   rhoic    =  900._wp         !: volumic mass of sea ice                               [kg/m3]
+   REAL(wp), PUBLIC ::   rcdic    =    2.034396_wp   !: conductivity of the ice                               [W/m/K]
+   REAL(wp), PUBLIC ::   rcpic    =    1.8837e+6_wp  !: volumetric specific heat for ice                      [J/m3/K]
+   REAL(wp), PUBLIC ::   cpic                        !: = rcpic / rhoic  (specific heat for ice)              [J/Kg/K]
+   REAL(wp), PUBLIC ::   rcdsn    =    0.22_wp       !: conductivity of the snow                              [W/m/K]
+   REAL(wp), PUBLIC ::   rcpsn    =    6.9069e+5_wp  !: volumetric specific heat for snow                     [J/m3/K]
+   REAL(wp), PUBLIC ::   xlsn     =  110.121e+6_wp   !: volumetric latent heat fusion of snow                 [J/m3]
+   REAL(wp), PUBLIC ::   lfus                        !: = xlsn / rhosn   (latent heat of fusion of fresh ice) [J/Kg]
+   REAL(wp), PUBLIC ::   xlic     =  300.33e+6_wp    !: volumetric latent heat fusion of ice                  [J/m3]
+   REAL(wp), PUBLIC ::   xsn      =    2.8e+6_wp     !: volumetric latent heat of sublimation of snow         [J/m3]
+   REAL(wp), PUBLIC ::   rcdsn   =   0.22_wp      !: conductivity of the snow
+   REAL(wp), PUBLIC ::   rcdic   =   2.034396_wp  !: conductivity of the ice
+   REAL(wp), PUBLIC ::   rcpsn   =   6.9069e+5_wp !: density times specific heat for snow
+   REAL(wp), PUBLIC ::   rcpic   =   1.8837e+6_wp !: volumetric latent heat fusion of sea ice
+   REAL(wp), PUBLIC ::   lfus    =   0.3337e+6    !: latent heat of fusion of fresh ice   (J.kg-1)
+   REAL(wp), PUBLIC ::   xlsn    = 110.121e+6_wp  !: volumetric latent heat fusion of snow
+   REAL(wp), PUBLIC ::   xlic    = 300.33e+6_wp   !: volumetric latent heat fusion of ice
+   REAL(wp), PUBLIC ::   xsn     =   2.8e+6       !: latent heat of sublimation of snow
+   REAL(wp), PUBLIC ::   rhoic   = 900._wp        !: volumic mass of sea ice (kg/m3)
 #endif
+   REAL(wp), PUBLIC ::   rhosn   = 330._wp        !: volumic mass of snow (kg/m3)
+   REAL(wp), PUBLIC ::   emic    =   0.97_wp      !: emissivity of snow or ice
+   REAL(wp), PUBLIC ::   sice    =   6.0_wp       !: reference salinity of ice (psu)
+   REAL(wp), PUBLIC ::   soce    =  34.7_wp       !: reference salinity of sea (psu)
+   REAL(wp), PUBLIC ::   cevap   =   2.5e+6_wp    !: latent heat of evaporation (water)
+   REAL(wp), PUBLIC ::   srgamma =   0.9_wp       !: correction factor for solar radiation (Oberhuber, 1974)
+   REAL(wp), PUBLIC ::   vkarmn  =   0.4_wp       !: von Karman constant
+   REAL(wp), PUBLIC ::   stefan  =   5.67e-8_wp   !: Stefan-Boltzmann constant
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
 …
       !!----------------------------------------------------------------------
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' phy_cst : initialization of ocean parameters and constants'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~'
+      !                                   ! Define additional parameters
+      rsiyea = 365.25 * rday * 2. * rpi / 6.283076
+      rsiday = rday / ( 1. + rday / rsiyea )
+#if defined key_cice
+      omega =  7.292116e-05
+#else
+      omega  = 2. * rpi / rsiday
+#endif
+      ! Ocean Parameters
+      ! ----------------
+      IF(lwp) THEN
+      rau0r  = 1. /   rau0
+      ro0cpr = 1. / ( rau0 * rcp )
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) ' phy_cst : initialization of ocean parameters and constants'
+         WRITE(numout,*) ' ~~~~~~~'
          WRITE(numout,*) '       Domain info'
          WRITE(numout,*) '          dimension of model'
 …
          WRITE(numout,*) '             jpnij   : ', jpnij
          WRITE(numout,*) '          lateral domain boundary condition type : jperio  = ', jperio
+      ENDIF
+      ! Define constants
+      ! ----------------
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '       Constants'
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '          mathematical constant                 rpi = ', rpi
+      rsiyea = 365.25_wp * rday * 2._wp * rpi / 6.283076_wp
+      rsiday = rday / ( 1._wp + rday / rsiyea )
+#if defined key_cice
+      omega  = 7.292116e-05
+#else
+      omega  = 2._wp * rpi / rsiday
+#endif
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '          day                                rday   = ', rday,   ' s'
+      IF(lwp) WRITE(numout,*) '          sideral year                       rsiyea = ', rsiyea, ' s'
+      IF(lwp) WRITE(numout,*) '          sideral day                        rsiday = ', rsiday, ' s'
+      IF(lwp) WRITE(numout,*) '          omega                              omega  = ', omega,  ' s^-1'
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '          nb of months per year               raamo = ', raamo, ' months'
+      IF(lwp) WRITE(numout,*) '          nb of hours per day                 rjjhh = ', rjjhh, ' hours'
+      IF(lwp) WRITE(numout,*) '          nb of minutes per hour              rhhmm = ', rhhmm, ' mn'
+      IF(lwp) WRITE(numout,*) '          nb of seconds per minute            rmmss = ', rmmss, ' s'
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '          earth radius                         ra   = ', ra, ' m'
+      IF(lwp) WRITE(numout,*) '          gravity                              grav = ', grav , ' m/s^2'
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '          triple point of temperature      rtt      = ', rtt     , ' K'
+      IF(lwp) WRITE(numout,*) '          freezing point of water          rt0      = ', rt0     , ' K'
+      IF(lwp) WRITE(numout,*) '          melting point of snow            rt0_snow = ', rt0_snow, ' K'
+      IF(lwp) WRITE(numout,*) '          melting point of ice             rt0_ice  = ', rt0_ice , ' K'
+      r1_rau0     = 1._wp / rau0
+      r1_rcp      = 1._wp / rcp
+      r1_rau0_rcp = 1._wp / ( rau0 * rcp )
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '          volumic mass of pure water          rauw  = ', rauw   , ' kg/m^3'
+      IF(lwp) WRITE(numout,*) '          volumic mass of reference           rau0  = ', rau0   , ' kg/m^3'
+      IF(lwp) WRITE(numout,*) '          1. / rau0                        r1_rau0  = ', r1_rau0, ' m^3/kg'
+      IF(lwp) WRITE(numout,*) '          ocean specific heat                 rcp   = ', rcp    , ' J/Kelvin'
+      IF(lwp) WRITE(numout,*) '          1. / ( rau0 * rcp )           r1_rau0_rcp = ', r1_rau0_rcp
+#if defined key_lim3 || defined key_cice
+      xlsn = lfus * rhosn        ! volumetric latent heat fusion of snow [J/m3]
+#else
+      cpic = rcpic / rhoic       ! specific heat for ice   [J/Kg/K]
+      lfus = xlsn / rhosn        ! latent heat of fusion of fresh ice
+#endif
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '       Constants'
+         WRITE(numout,*)
+         WRITE(numout,*) '          mathematical constant                 rpi = ', rpi
+         WRITE(numout,*) '          day                                rday   = ', rday,   ' s'
+         WRITE(numout,*) '          sideral year                       rsiyea = ', rsiyea, ' s'
+         WRITE(numout,*) '          sideral day                        rsiday = ', rsiday, ' s'
+         WRITE(numout,*) '          omega                              omega  = ', omega,  ' s-1'
+         WRITE(numout,*)
+         WRITE(numout,*) '          nb of months per year               raamo = ', raamo, ' months'
+         WRITE(numout,*) '          nb of hours per day                 rjjhh = ', rjjhh, ' hours'
+         WRITE(numout,*) '          nb of minutes per hour              rhhmm = ', rhhmm, ' mn'
+         WRITE(numout,*) '          nb of seconds per minute            rmmss = ', rmmss, ' s'
+         WRITE(numout,*)
+         WRITE(numout,*) '          earth radius                         ra   = ', ra, ' m'
+         WRITE(numout,*) '          gravity                              grav = ', grav , ' m/s^2'
+         WRITE(numout,*)
+         WRITE(numout,*) '          triple point of temperature      rtt      = ', rtt     , ' K'
+         WRITE(numout,*) '          freezing point of water          rt0      = ', rt0     , ' K'
+         WRITE(numout,*) '          melting point of snow            rt0_snow = ', rt0_snow, ' K'
+         WRITE(numout,*) '          melting point of ice             rt0_ice  = ', rt0_ice , ' K'
+         WRITE(numout,*)
+         WRITE(numout,*) '          ocean reference volumic mass       rau0   = ', rau0 , ' kg/m^3'
+         WRITE(numout,*) '          ocean reference specific volume    rau0r  = ', rau0r, ' m^3/Kg'
+         WRITE(numout,*) '          ocean specific heat                rcp    = ', rcp
+         WRITE(numout,*) '                       1. / ( rau0 * rcp ) = ro0cpr = ', ro0cpr
          WRITE(numout,*)
          WRITE(numout,*) '          thermal conductivity of the snow          = ', rcdsn   , ' J/s/m/K'
          WRITE(numout,*) '          thermal conductivity of the ice           = ', rcdic   , ' J/s/m/K'
+#if defined key_lim3
          WRITE(numout,*) '          fresh ice specific heat                   = ', cpic    , ' J/kg/K'
          WRITE(numout,*) '          latent heat of fusion of fresh ice / snow = ', lfus    , ' J/kg'
-#if defined key_lim3 || defined key_cice
          WRITE(numout,*) '          latent heat of subl.  of fresh ice / snow = ', lsub    , ' J/kg'
+#elif defined key_cice
+         WRITE(numout,*) '          latent heat of fusion of fresh ice / snow = ', lfus    , ' J/kg'
 #else
          WRITE(numout,*) '          density times specific heat for snow      = ', rcpsn   , ' J/m^3/K'
          WRITE(numout,*) '          density times specific heat for ice       = ', rcpic   , ' J/m^3/K'
          WRITE(numout,*) '          volumetric latent heat fusion of sea ice  = ', xlic    , ' J/m'
+         WRITE(numout,*) '          volumetric latent heat fusion of snow     = ', xlsn    , ' J/m'
          WRITE(numout,*) '          latent heat of sublimation of snow        = ', xsn     , ' J/kg'
 #endif
-         WRITE(numout,*) '          volumetric latent heat fusion of snow     = ', xlsn    , ' J/m^3'
          WRITE(numout,*) '          density of sea ice                        = ', rhoic   , ' kg/m^3'
          WRITE(numout,*) '          density of snow                           = ', rhosn   , ' kg/m^3'

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90

-                      r3634
+                      r6736
          ! Multiply by the eddy viscosity coef. (at u- and v-points)
+         zlu(:,:,jk) = zlu(:,:,jk) * ( fsahmu(:,:,jk) * (1-nkahm_smag) + nkahm_smag)
+         zlv(:,:,jk) = zlv(:,:,jk) * ( fsahmv(:,:,jk) * (1-nkahm_smag) + nkahm_smag)
+         zlu(:,:,jk) = zlu(:,:,jk) * fsahmu(:,:,jk)
+         zlv(:,:,jk) = zlv(:,:,jk) * fsahmv(:,:,jk)
          ! Contravariant "laplacian"
 …
                   &  + ( zut(ji,jj+1,jk) - zut(ji  ,jj,jk) ) / e2v(ji,jj)
                ! add it to the general momentum trends
                ua(ji,jj,jk) = ua(ji,jj,jk) + zua * ( fsahmu(ji,jj,jk)*nkahm_smag +(1 -nkahm_smag ))
                va(ji,jj,jk) = va(ji,jj,jk) + zva * ( fsahmv(ji,jj,jk)*nkahm_smag +(1 -nkahm_smag ))
+               ua(ji,jj,jk) = ua(ji,jj,jk) + zua
+               va(ji,jj,jk) = va(ji,jj,jk) + zva
             END DO
          END DO

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90

-                      r3634
+                      r6736
          ! II.3 Divergence of vertical fluxes added to the horizontal divergence
          ! ---------------------------------------------------------------------
+         IF( (kahm -nkahm_smag) ==1 ) THEN
+         IF( kahm == 1 ) THEN
             ! multiply the laplacian by the eddy viscosity coefficient
             DO jk = 1, jpkm1
 …
                END DO
             END DO
          ELSEIF( (kahm +nkahm_smag ) == 2 ) THEN
+         ELSEIF( kahm == 2 ) THEN
             ! second call, no multiplication
             DO jk = 1, jpkm1

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

-                      r3764
+                      r6736
             !                             ! ================!
+            !
+#if ! defined key_jth_fix
             DO jk = 1, jpkm1                 ! Before scale factor at t-points
                fse3t_b(:,:,jk) = fse3t_n(:,:,jk)                                   &
 …
                   &                         - 2._wp * fse3t_n(:,:,jk)            )
             END DO
+#endif
             zec = atfp * rdt / rau0          ! Add filter correction only at the 1st level of t-point scale factors
+#if ! defined key_jth_fix
             fse3t_b(:,:,1) = fse3t_b(:,:,1) - zec * ( emp_b(:,:) - emp(:,:) ) * tmask(:,:,1)
+#endif
+            !
             IF( ln_dynadv_vec ) THEN         ! vector invariant form (no thickness weighted calulation)
+               !
                !                                      ! before scale factors at u- & v-pts (computed from fse3t_b)
+#if ! defined key_jth_fix
                CALL dom_vvl_2( kt, fse3u_b(:,:,:), fse3v_b(:,:,:) )
+#endif
+               !
                DO jk = 1, jpkm1                       ! Leap-Frog - Asselin filter and swap: applied on velocity
 …
             ELSE                             ! flux form (thickness weighted calulation)
+               !
+#if ! defined key_jth_fix
                CALL dom_vvl_2( kt, ze3u_f, ze3v_f )   ! before scale factors at u- & v-pts (computed from fse3t_b)
+#endif
+               !
                DO jk = 1, jpkm1                       ! Leap-Frog - Asselin filter and swap:
 …
                   END DO
                END DO
+#if ! defined key_jth_fix
                fse3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1)      ! e3u_b <-- filtered scale factor
                fse3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1)
+#endif
+               CALL lbc_lnk( ub, 'U', -1. )                    ! lateral boundary conditions
+               CALL lbc_lnk( vb, 'V', -1. )
             ENDIF
+            !

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90

-                      r3625
+                      r6736
+      !
       INTEGER  ::   ji, jj, jk                             ! dummy loop indices
       REAL(wp) ::   z2dt, zg_2, zintp, zgrau0r             ! temporary scalar
+      REAL(wp) ::   z2dt, zg_2                             ! temporary scalar
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv
-      REAL(wp), POINTER, DIMENSION(:,:)   ::  zpice
       !!----------------------------------------------------------------------
+      !
 …
             END DO
          END DO
-      ENDIF
-      IF( nn_ice_embd == 2 ) THEN             !== embedded sea ice: Pressure gradient due to snow-ice mass ==!
-         CALL wrk_alloc( jpi, jpj, zpice )
+         !
-         zintp = REAL( MOD( kt-1, nn_fsbc ) ) / REAL( nn_fsbc )
-         zgrau0r     = - grav * r1_rau0
-         zpice(:,:) = (  zintp * snwice_mass(:,:) + ( 1.- zintp ) * snwice_mass_b(:,:)  ) * zgrau0r
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               spgu(ji,jj) = ( zpice(ji+1,jj) - zpice(ji,jj) ) / e1u(ji,jj)
-               spgv(ji,jj) = ( zpice(ji,jj+1) - zpice(ji,jj) ) / e2v(ji,jj)
-            END DO
-         END DO
-         DO jk = 1, jpkm1                             ! Add the surface pressure trend to the general trend
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ua(ji,jj,jk) = ua(ji,jj,jk) + spgu(ji,jj)
-                  va(ji,jj,jk) = va(ji,jj,jk) + spgv(ji,jj)
-               END DO
-            END DO
-         END DO
+         !
-         CALL wrk_dealloc( jpi, jpj, zpice )
       ENDIF

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90

r3680	r6736
27	27	USE prtctl ! Print control
28	28	USE iom ! I/O library
	29	USE restart ! only for lrst_oce
29	30	USE timing ! Timing
30	31

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90

-                      r3765
+                      r6736
    USE prtctl          ! Print control
    USE iom
+   USE restart         ! only for lrst_oce
    USE lib_fortran
 #if defined key_agrif
 …
 #if defined key_obc
       IF( lk_obc ) CALL obc_dyn( kt )   ! Update velocities on each open boundary with the radiation algorithm
       IF( lk_obc ) CALL obc_vol( kt )   ! Correction of the barotropic componant velocity to control the volume of the system
+      IF( lk_obc)  CALL obc_vol( kt )   ! Correction of the barotropic componant velocity to control the volume of the system
 #endif
 #if defined key_bdy
 …
       END DO
       ! applied the lateral boundary conditions
       IF( nn_solv == 2 .AND. MAX( jpr2di, jpr2dj ) > 0 )   CALL lbc_lnk_e( gcb, c_solver_pt, 1., jpr2di, jpr2dj )
+      IF( nn_solv == 2 .AND. MAX( jpr2di, jpr2dj ) > 0 )   CALL lbc_lnk_e( gcb, c_solver_pt, 1. )
 #if defined key_agrif
 …
             ! multiplied by z2dt
 #if defined key_obc
-            IF(lk_obc) THEN
             ! caution : grad D = 0 along open boundaries
             ! Remark: The filtering force could be reduced here in the FRS zone
             !         by multiplying spgu/spgv by (1-alpha) ??
+               spgu(ji,jj) = z2dt * ztdgu * obcumask(ji,jj)
+               spgv(ji,jj) = z2dt * ztdgv * obcvmask(ji,jj)
+            ELSE
+               spgu(ji,jj) = z2dt * ztdgu
+               spgv(ji,jj) = z2dt * ztdgv
+            ENDIF
+            spgu(ji,jj) = z2dt * ztdgu * obcumask(ji,jj)
+            spgv(ji,jj) = z2dt * ztdgv * obcvmask(ji,jj)
 #elif defined key_bdy
-            IF(lk_bdy) THEN
             ! caution : grad D = 0 along open boundaries
+               spgu(ji,jj) = z2dt * ztdgu * bdyumask(ji,jj)
+               spgv(ji,jj) = z2dt * ztdgv * bdyvmask(ji,jj)
+            ELSE
+               spgu(ji,jj) = z2dt * ztdgu
+               spgv(ji,jj) = z2dt * ztdgv
+            ENDIF
+            spgu(ji,jj) = z2dt * ztdgu * bdyumask(ji,jj)
+            spgv(ji,jj) = z2dt * ztdgv * bdyvmask(ji,jj)
 #else
             spgu(ji,jj) = z2dt * ztdgu

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

-                      r3680
+                      r6736
    USE in_out_manager  ! I/O manager
    USE iom             ! IOM library
+   USE restart         ! only for lrst_oce
    USE zdf_oce         ! Vertical diffusion
    USE wrk_nemo        ! Memory Allocation
 …
          IF( lk_obc )   CALL obc_dta_bt ( kt, jn   )
          IF( lk_bdy )   CALL bdy_dta ( kt, jit=jn, time_offset=+1 )
          IF ( ln_tide_pot .AND. lk_tide) CALL upd_tide( kt, jn )
+         IF ( ln_tide_pot ) CALL upd_tide( kt, jn )
          !                                                !* after ssh_e
 …
                   ENDIF
                   ! add tidal astronomical forcing
                   IF ( ln_tide_pot .AND. lk_tide ) THEN
+                  IF ( ln_tide_pot ) THEN
                   zu_spg = zu_spg + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) / e1u(ji,jj)
                   zv_spg = zv_spg + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) / e2v(ji,jj)
 …
                   ENDIF
                   ! add tidal astronomical forcing
                   IF ( ln_tide_pot .AND. lk_tide ) THEN
+                  IF ( ln_tide_pot ) THEN
                   zu_spg = zu_spg + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) / e1u(ji,jj)
                   zv_spg = zv_spg + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) / e2v(ji,jj)
 …
                   ENDIF
                   ! add tidal astronomical forcing
                   IF ( ln_tide_pot .AND. lk_tide ) THEN
+                  IF ( ln_tide_pot ) THEN
                   zu_spg = zu_spg + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) / e1u(ji,jj)
                   zv_spg = zv_spg + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) / e2v(ji,jj)

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90

-                      r3625
+                      r6736
+      !
       INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
       REAL(wp) ::   zlavmr, zua, zva   ! local scalars
+      REAL(wp) ::   zrau0r, zlavmr, zua, zva   ! local scalars
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwx, zwy, zwz, zww
       !!----------------------------------------------------------------------
 …
       ENDIF
+      zrau0r = 1. / rau0               ! Local constant initialization
       zlavmr = 1. / REAL( nn_zdfexp )
 …
       DO jj = 2, jpjm1                 ! Surface boundary condition
          DO ji = 2, jpim1
             zwy(ji,jj,1) = ( utau_b(ji,jj) + utau(ji,jj) ) * r1_rau0
             zww(ji,jj,1) = ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_rau0
+            zwy(ji,jj,1) = ( utau_b(ji,jj) + utau(ji,jj) ) * zrau0r
+            zww(ji,jj,1) = ( vtau_b(ji,jj) + vtau(ji,jj) ) * zrau0r
          END DO
       END DO

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90

-                      r3625
+                      r6736
          DO ji = fs_2, fs_jpim1   ! vector opt.
             ua(ji,jj,1) = ub(ji,jj,1) + p2dt * (  ua(ji,jj,1) + 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   &
                &                                                       * r1_rau0 / fse3u(ji,jj,1)       )
+               &                                                       / ( fse3u(ji,jj,1) * rau0       )  )
          END DO
       END DO
 …
          DO ji = fs_2, fs_jpim1   ! vector opt.
             va(ji,jj,1) = vb(ji,jj,1) + p2dt * (  va(ji,jj,1) + 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   &
                &                                                       * r1_rau0 / fse3v(ji,jj,1)       )
+               &                                                       / ( fse3v(ji,jj,1) * rau0       )  )
          END DO
       END DO

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

r3764	r6736
20	20	USE divcur ! hor. divergence and curl (div & cur routines)
21	21	USE iom ! I/O library
	22	USE restart ! only for lrst_oce
22	23	USE in_out_manager ! I/O manager
23	24	USE prtctl ! Print control

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90

-                      r3680
+                      r6736
    LOGICAL       ::   ln_clobber    = .FALSE.     !: clobber (overwrite) an existing file
    INTEGER       ::   nn_chunksz    = 0           !: chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
+   LOGICAL       ::   ln_fse3t_b    = .TRUE.      !: restart contains fse3t_b
 #if defined key_netcdf4
    !!----------------------------------------------------------------------
 …
    !! was in restart but moved here because of the OFF line... better solution should be found...
    !!----------------------------------------------------------------------
+   INTEGER ::   nitrst                !: time step at which restart file should be written
+   LOGICAL ::   lrst_oce              !: logical to control the oce restart write
+   INTEGER ::   numror, numrow        !: logical unit for cean restart (read and write)
+   INTEGER ::   nitrst   !: time step at which restart file should be written
    !!----------------------------------------------------------------------

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

-                      r3771
+                      r6736
    !!            2.0  ! 2006-02  (S. Masson) Adaptation to NEMO
    !!            3.0  ! 2007-07  (D. Storkey) Changes to iom_gettime
+   !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  add C1D case
+   !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  add C1D case
+   !!            3.4  ! 2013-04  (J. Harle)  added real attribute case
    !!--------------------------------------------------------------------
 …
 #if defined key_iomput
    USE sbc_oce, ONLY :   nn_fsbc         ! ocean space and time domain
-   USE trc_oce, ONLY :   nn_dttrc        !  !: frequency of step on passive tracers
    USE domngb          ! ocean space and time domain
    USE phycst          ! physical constants
    USE dianam          ! build name of file
+   USE xios
+   USE mod_event_client
+   USE mod_attribut
 # endif
 …
    PRIVATE iom_p1d, iom_p2d, iom_p3d
 #if defined key_iomput
+   PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_set_grid_attr
+   PRIVATE set_grid, set_scalar, set_xmlatt, set_mooring
+   PRIVATE set_grid
 # endif
 …
    END INTERFACE
    INTERFACE iom_getatt
       MODULE PROCEDURE iom_g0d_intatt
+      MODULE PROCEDURE iom_g0d_intatt, iom_g0d_ratt
    END INTERFACE
    INTERFACE iom_rstput
 …
 #if defined key_iomput
    INTERFACE iom_setkt
       MODULE PROCEDURE xios_update_calendar
+      MODULE PROCEDURE event__set_timestep
    END INTERFACE
 # endif
 …
       !!----------------------------------------------------------------------
 #if defined key_iomput
+      TYPE(xios_time)   :: dtime    = xios_time(0, 0, 0, 0, 0, 0)
+      CHARACTER(len=19) :: cldate
+      CHARACTER(len=10) :: clname
+      INTEGER           ::   ji
+      !!----------------------------------------------------------------------
+      clname = "nemo"
+      IF( TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname)
+      CALL xios_context_initialize(TRIM(clname), mpi_comm_opa)
+      REAL(wp) ::   ztmp
+      !!----------------------------------------------------------------------
+!if defined key_adam
+!     REAL(wp)        ,DIMENSION( 2833) ::   zlon
+!     REAL(wp)        ,DIMENSION( 2833) ::   zlat
+!  include "NA_lons.h90"
+!  include "NA_lats.h90"
+!endif
+      ! read the xml file
+      IF( Agrif_Root() ) CALL event__parse_xml_file( 'iodef.xml' )   ! <- to get from the nameliste (namrun)...
       CALL iom_swap
       ! calendar parameters
       SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
       CASE ( 1)   ;   CALL xios_set_context_attr(TRIM(clname), calendar_type= "Gregorian")
       CASE ( 0)   ;   CALL xios_set_context_attr(TRIM(clname), calendar_type= "NoLeap")
       CASE (30)   ;   CALL xios_set_context_attr(TRIM(clname), calendar_type= "D360")
+      CASE ( 1)   ;   CALL event__set_calendar('gregorian')
+      CASE ( 0)   ;   CALL event__set_calendar('noleap'   )
+      CASE (30)   ;   CALL event__set_calendar('360d'     )
       END SELECT
+      WRITE(cldate,"(i4.4,'-',i2.2,'-',i2.2,' 00:00:00')") nyear,nmonth,nday
+      CALL xios_set_context_attr(TRIM(clname), start_date=cldate )
+      ztmp = fjulday - adatrj
+      IF( ABS(ztmp  - REAL(NINT(ztmp),wp)) < 0.1 / rday )   ztmp = REAL(NINT(ztmp),wp)   ! avoid truncation error
+      CALL event__set_time_parameters( nit000 - 1, ztmp, rdt )
       ! horizontal grid definition
       CALL set_scalar
+      CALL set_grid( "T", glamt, gphit )
+      CALL set_grid( "U", glamu, gphiu )
+      CALL set_grid( "V", glamv, gphiv )
+      CALL set_grid( "W", glamt, gphit )
+#if defined key_adam
+!     CALL set_grid( "grid_A", zlon, zlat )
+      WRITE(*,*) 'A0'
+      CALL set_adam_mooring
+      WRITE(*,*) 'A1'
+#endif
+      CALL set_grid( "grid_T", glamt, gphit )
+      CALL set_grid( "grid_U", glamu, gphiu )
+      CALL set_grid( "grid_V", glamv, gphiv )
+      CALL set_grid( "grid_W", glamt, gphit )
       ! vertical grid definition
       CALL iom_set_axis_attr( "deptht", gdept_0 )
       CALL iom_set_axis_attr( "depthu", gdept_0 )
       CALL iom_set_axis_attr( "depthv", gdept_0 )
       CALL iom_set_axis_attr( "depthw", gdepw_0 )
+      CALL event__set_vert_axis( "deptht", gdept_0 )
+      CALL event__set_vert_axis( "depthu", gdept_0 )
+      CALL event__set_vert_axis( "depthv", gdept_0 )
+      CALL event__set_vert_axis( "depthw", gdepw_0 )
 # if defined key_floats
       CALL iom_set_axis_attr( "nfloat", (ji, ji=1,nfloat) )
+      CALL event__set_vert_axis( "nfloat", REAL(nfloat,wp)  )
 # endif
 …
       ! end file definition
+       dtime%second=rdt
+       CALL xios_set_timestep(dtime)
+       CALL xios_close_context_definition()
+       CALL xios_update_calendar(0)
+      CALL event__close_io_definition
 #endif
 …
       !!---------------------------------------------------------------------
 #if defined key_iomput
-      TYPE(xios_context) :: nemo_hdl
      IF( TRIM(Agrif_CFixed()) == '0' ) THEN
         CALL xios_get_handle("nemo",nemo_hdl)
+        CALL event__swap_context("nemo")
      ELSE
         CALL xios_get_handle(TRIM(Agrif_CFixed())//"_nemo",nemo_hdl)
+        CALL event__swap_context(TRIM(Agrif_CFixed())//"_nemo")
      ENDIF
-     CALL xios_set_current_context(nemo_hdl)
 #endif
 …
          i_s = 1
          i_e = jpmax_files
+#if defined key_iomput
+         CALL event__stop_ioserver
+#endif
       ENDIF
 …
    !!                   INTERFACE iom_getatt
    !!----------------------------------------------------------------------
    SUBROUTINE iom_g0d_intatt( kiomid, cdatt, pvar )
+   SUBROUTINE iom_g0d_intatt( kiomid, cdatt, pvar, cdvar )
       INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file
       CHARACTER(len=*), INTENT(in   )                 ::   cdatt     ! Name of the attribute
+      INTEGER         , INTENT(  out)                 ::   pvar      ! read field
+      INTEGER         , INTENT(  out)                 ::   pvar      ! written field
+      CHARACTER(len=*), INTENT(in   ), OPTIONAL       ::   cdvar     ! Name of the variable
+      !
       IF( kiomid > 0 ) THEN
 …
             SELECT CASE (iom_file(kiomid)%iolib)
             CASE (jpioipsl )   ;   CALL ctl_stop('iom_getatt: only nf90 available')
             CASE (jpnf90   )   ;   CALL iom_nf90_getatt( kiomid, cdatt, pvar )
+            CASE (jpnf90   )   ;   CALL iom_nf90_getatt( kiomid, cdatt, pv_i0d=pvar )
             CASE (jprstdimg)   ;   CALL ctl_stop('iom_getatt: only nf90 available')
             CASE DEFAULT
 …
    END SUBROUTINE iom_g0d_intatt
+   SUBROUTINE iom_g0d_ratt( kiomid, cdatt, pvar, cdvar )
+      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*), INTENT(in   )                 ::   cdatt     ! Name of the attribute
+      REAL(wp)        , INTENT(  out)                 ::   pvar      ! written field
+      CHARACTER(len=*), INTENT(in   ), OPTIONAL       ::   cdvar     ! Name of the variable
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) THEN
+            SELECT CASE (iom_file(kiomid)%iolib)
+            CASE (jpioipsl )   ;   CALL ctl_stop('iom_getatt: only nf90 available')
+            CASE (jpnf90   )   ;   IF( PRESENT(cdvar) ) THEN
+                                      CALL iom_nf90_getatt( kiomid, cdatt, pv_r0d=pvar, cdvar=cdvar )
+                                   ELSE
+                                      CALL iom_nf90_getatt( kiomid, cdatt, pv_r0d=pvar )
+                                   ENDIF
+            CASE (jprstdimg)   ;   CALL ctl_stop('iom_getatt: only nf90 available')
+            CASE DEFAULT
+               CALL ctl_stop( 'iom_g0d_att: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+            END SELECT
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_g0d_ratt
    !!----------------------------------------------------------------------
 …
       REAL(wp)        , INTENT(in) ::   pfield0d
 #if defined key_iomput
       CALL xios_send_field(cdname, (/pfield0d/))
+      CALL event__write_field2D( cdname, RESHAPE( (/pfield0d/), (/1,1/) ) )
 #else
       IF( .FALSE. )   WRITE(numout,*) cdname, pfield0d   ! useless test to avoid compilation warnings
 …
       CHARACTER(LEN=*)          , INTENT(in) ::   cdname
       REAL(wp),     DIMENSION(:), INTENT(in) ::   pfield1d
+      INTEGER :: jpz
 #if defined key_iomput
+      CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) )
+      jpz=SIZE(pfield1d)
+      CALL event__write_field3D( cdname, RESHAPE( (/pfield1d/), (/1,1,jpz/) ) )
 #else
       IF( .FALSE. )   WRITE(numout,*) cdname, pfield1d   ! useless test to avoid compilation warnings
 …
       REAL(wp),     DIMENSION(:,:), INTENT(in) ::   pfield2d
 #if defined key_iomput
       CALL xios_send_field(cdname, pfield2d)
+      CALL event__write_field2D( cdname, pfield2d(nldi:nlei, nldj:nlej) )
 #else
       IF( .FALSE. )   WRITE(numout,*) cdname, pfield2d   ! useless test to avoid compilation warnings
 …
       REAL(wp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d
 #if defined key_iomput
       CALL xios_send_field(cdname, pfield3d)
+      CALL event__write_field3D( cdname, pfield3d(nldi:nlei, nldj:nlej, :) )
 #else
       IF( .FALSE. )   WRITE(numout,*) cdname, pfield3d   ! useless test to avoid compilation warnings
 …
 #if defined key_iomput
+   SUBROUTINE iom_set_domain_attr( cdname, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj,   &
+      &                                    data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask )
+      CHARACTER(LEN=*)                 , INTENT(in) ::   cdname
+      INTEGER                , OPTIONAL, INTENT(in) ::   ni_glo, nj_glo, ibegin, jbegin, ni, nj
+      INTEGER                , OPTIONAL, INTENT(in) ::   data_dim, data_ibegin, data_ni, data_jbegin, data_nj
+      INTEGER                , OPTIONAL, INTENT(in) ::   zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj
+      REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) ::   lonvalue, latvalue
+      LOGICAL, DIMENSION(:,:), OPTIONAL, INTENT(in) ::   mask
+      IF ( xios_is_valid_domain     (cdname) ) THEN
+         CALL xios_set_domain_attr     ( cdname, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   &
+            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj   ,   &
+            &    zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj,                         &
+            &    lonvalue=lonvalue, latvalue=latvalue,mask=mask )
+      ENDIF
+      IF ( xios_is_valid_domaingroup(cdname) ) THEN
+         CALL xios_set_domaingroup_attr( cdname, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   &
+            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj   ,   &
+            &    zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj,                         &
+            &    lonvalue=lonvalue, latvalue=latvalue,mask=mask )
+      ENDIF
+   END SUBROUTINE iom_set_domain_attr
+   SUBROUTINE iom_set_axis_attr( cdname, paxis )
+      CHARACTER(LEN=*)      , INTENT(in) ::   cdname
+      REAL(wp), DIMENSION(:), INTENT(in) ::   paxis
+      IF ( xios_is_valid_axis     (cdname) )   CALL xios_set_axis_attr     ( cdname, size=size(paxis),value=paxis )
+      IF ( xios_is_valid_axisgroup(cdname) )   CALL xios_set_axisgroup_attr( cdname, size=size(paxis),value=paxis )
+   END SUBROUTINE iom_set_axis_attr
+   SUBROUTINE iom_set_field_attr( cdname, freq_op)
+      CHARACTER(LEN=*)          , INTENT(in) ::   cdname
+      CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   freq_op
+      IF ( xios_is_valid_field     (cdname) )   CALL xios_set_field_attr     ( cdname, freq_op=freq_op )
+      IF ( xios_is_valid_fieldgroup(cdname) )   CALL xios_set_fieldgroup_attr( cdname, freq_op=freq_op )
+   END SUBROUTINE iom_set_field_attr
+   SUBROUTINE iom_set_file_attr( cdname, name, name_suffix )
+      CHARACTER(LEN=*)          , INTENT(in) ::   cdname
+      CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   name, name_suffix
+      IF ( xios_is_valid_file     (cdname) )   CALL xios_set_file_attr     ( cdname, name=name, name_suffix=name_suffix )
+      IF ( xios_is_valid_filegroup(cdname) )   CALL xios_set_filegroup_attr( cdname, name=name, name_suffix=name_suffix )
+   END SUBROUTINE iom_set_file_attr
+   SUBROUTINE iom_set_grid_attr( cdname, mask )
+      CHARACTER(LEN=*)                   , INTENT(in) ::   cdname
+      LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) ::   mask
+      IF ( xios_is_valid_grid     (cdname) )   CALL xios_set_grid_attr     ( cdname, mask=mask )
+      IF ( xios_is_valid_gridgroup(cdname) )   CALL xios_set_gridgroup_attr( cdname, mask=mask )
+   END SUBROUTINE iom_set_grid_attr
+   SUBROUTINE set_grid( cdgrd, plon, plat )
+   SUBROUTINE set_grid( cdname, plon, plat )
       !!----------------------------------------------------------------------
       !!                     ***  ROUTINE   ***
 …
       !!
       !!----------------------------------------------------------------------
       CHARACTER(LEN=1)            , INTENT(in) ::   cdgrd
+      CHARACTER(LEN=*)            , INTENT(in) ::   cdname
       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plon
       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat
+      !
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmask
+      INTEGER  :: ni,nj
+      ni=nlei-nldi+1 ; nj=nlej-nldj+1
+      CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj)
+      CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)
+      CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)),   &
+         &                                     latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))
+      IF ( ln_mskland ) THEN
+         ! mask land points, keep values on coast line -> specific mask for U, V and W points
+         SELECT CASE ( cdgrd )
+         CASE('T')   ;   zmask(:,:,:)       = tmask(:,:,:)
+         CASE('U')   ;   zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:)   ;   CALL lbc_lnk( zmask, 'U', 1. )
+         CASE('V')   ;   zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpi,:)   ;   CALL lbc_lnk( zmask, 'V', 1. )
+         CASE('W')   ;   zmask(:,:,2:jpk  ) = tmask(:,:,1:jpkm1) + tmask(:,:,2:jpk)   ;   zmask(:,:,1) = tmask(:,:,1)
+         END SELECT
+         !
+         CALL iom_set_domain_attr( "grid_"//cdgrd       , mask = zmask(:,:,1) /= 0. )
+         CALL iom_set_grid_attr  ( "grid_"//cdgrd//"_3D", mask = zmask(:,:,:) /= 0. )
+      ENDIF
+      CALL event__set_grid_dimension( cdname, jpiglo, jpjglo)
+      CALL event__set_grid_domain( cdname, nlei-nldi+1, nlej-nldj+1, nimpp+nldi-1, njmpp+nldj-1, &
+         &                         plon(nldi:nlei, nldj:nlej), plat(nldi:nlei, nldj:nlej) )
+      CALL event__set_grid_type_nemo( cdname )
    END SUBROUTINE set_grid
 …
       REAL(wp), DIMENSION(1,1) ::   zz = 1.
       !!----------------------------------------------------------------------
       CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea, jbegin=1, ni=1, nj=1)
       CALL iom_set_domain_attr('scalarpoint', data_dim=1)
       CALL iom_set_domain_attr('scalarpoint', lonvalue=(/ zz /), latvalue=(/ zz /))
+      CALL event__set_grid_dimension( 'scalarpoint', jpnij, 1)
+      CALL event__set_grid_domain   ( 'scalarpoint', 1, 1, narea, 1, zz, zz )
+      CALL event__set_grid_type_nemo( 'scalarpoint' )
    END SUBROUTINE set_scalar
+#if defined key_adam
+   SUBROUTINE set_adam_mooring
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE   ***
+      !!
+      !! ** Purpose :   define fake grids for adam's mooring data
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp)        ,DIMENSION( 2833,1) ::   zlon
+      REAL(wp)        ,DIMENSION( 2833,1) ::   zlat
+      INTEGER         ,DIMENSION( 2833,1) ::   ix
+      INTEGER         ,DIMENSION( 2833,1) ::   iy
+      INTEGER                           ::   ji
+      !!----------------------------------------------------------------------
+#  include "NA_lons.h90"
+#  include "NA_lats.h90"
+      DO ji = 1, 2833
+         CALL dom_ngb( zlon(ji), zlat(ji), ix(ji), iy(ji), 'T' )
+      ENDDO
+!     WRITE(*,*) 'CLOSEST', narea, ix(1), iy(1), zlon(1), zlat(1)
+      WRITE(*,*) 'a0'
+!     CALL event__set_grid_dimension( 'grid_A', 1, 1)
+      CALL event__set_grid_dimension( 'grid_A', 2833, 1)
+!     CALL event__set_grid_dimension( 'scalarpointX', jpnij, 1)
+      WRITE(*,*) 'a1'
+!     CALL event__set_grid_domain   ( 'grid_A', 1, 1, ix(1), iy(1), zlon(1), zlat(1) )
+      CALL event__set_grid_domain   ( 'grid_A', 2833, 1, 1, 1, zlon, zlat )
+!     CALL event__set_grid_domain   ( 'scalarpointX', 1, 1, narea, 1, 1, 1 )
+      WRITE(*,*) 'a2'
+      CALL event__set_grid_type_nemo( 'grid_A' )
+!     CALL event__set_grid_type_nemo( 'scalarpointX' )
+      WRITE(*,*) 'a3'
+   END SUBROUTINE set_adam_mooring
+#endif
    SUBROUTINE set_xmlatt
 …
       !!
       !!----------------------------------------------------------------------
+#if defined key_adam
+      CHARACTER(len=6),DIMENSION( 9) ::   clsuff                   ! suffix name
+#else
       CHARACTER(len=6),DIMENSION( 8) ::   clsuff                   ! suffix name
+#endif
       CHARACTER(len=1),DIMENSION( 3) ::   clgrd                    ! suffix name
       CHARACTER(len=50)              ::   clname                   ! file name
       CHARACTER(len=1)               ::   cl1                      ! 1 character
       CHARACTER(len=2)               ::   cl2                      ! 1 character
-      CHARACTER(len=255)             ::   tfo
       INTEGER                        ::   idt                      ! time-step in seconds
       INTEGER                        ::   iddss, ihhss             ! number of seconds in 1 day, 1 hour and 1 year
 …
       ! frequency of the call of iom_put (attribut: freq_op)
+      tfo = TRIM(i2str(idt))//'s'
+      CALL iom_set_field_attr('field_definition', freq_op=tfo)
+      CALL iom_set_field_attr('SBC'   , freq_op=TRIM(i2str(idt* nn_fsbc ))//'s')
+      CALL iom_set_field_attr('ptrc_T', freq_op=TRIM(i2str(idt* nn_dttrc))//'s')
+      CALL iom_set_field_attr('diad_T', freq_op=TRIM(i2str(idt* nn_dttrc))//'s')
+      CALL event__set_attribut( 'field_definition', attr( field__freq_op, idt           ) )    ! model time-step
+      CALL event__set_attribut( 'SBC'             , attr( field__freq_op, idt * nn_fsbc ) )    ! SBC time-step
       ! output file names (attribut: name)
+#if defined key_adam
+      clsuff(:) = (/ 'grid_A', 'grid_T', 'grid_U', 'grid_V', 'grid_W', 'icemod', 'ptrc_T', 'diad_T', 'scalar' /)
+#else
       clsuff(:) = (/ 'grid_T', 'grid_U', 'grid_V', 'grid_W', 'icemod', 'ptrc_T', 'diad_T', 'scalar' /)
+#endif
+      WRITE(*,*) 'set adam2'
       DO jg = 1, SIZE(clsuff)                                                                  ! grid type
+         DO jh = 1, 24                                                                         ! 1-24 hours
+            WRITE(cl2,'(i2)') jh
+            CALL dia_nam( clname, jh * ihhss, clsuff(jg), ldfsec = .TRUE. )
+            CALL iom_set_file_attr(TRIM(ADJUSTL(cl2))//'h_'//clsuff(jg), name=TRIM(clname))
+         DO jh = 1, 12                                                                         ! 1, 2, 3, 4, 6, 12 hours
+            IF( MOD(12,jh) == 0 ) THEN
+               WRITE(cl2,'(i2)') jh
+               CALL dia_nam( clname, jh * ihhss, clsuff(jg), ldfsec = .TRUE. )
+               CALL event__set_attribut( TRIM(ADJUSTL(cl2))//'h_'//clsuff(jg), attr( file__name, TRIM(clname) ) )
+            ENDIF
          END DO
          DO jd = 1, 30                                                                         ! 1-30 days
+         DO jd = 1, 5, 2                                                                       ! 1, 3, 5 days
             WRITE(cl1,'(i1)') jd
             CALL dia_nam( clname, jd * iddss, clsuff(jg), ldfsec = .TRUE. )
             CALL iom_set_file_attr(cl1//'d_'//clsuff(jg), name=TRIM(clname))
+            CALL event__set_attribut( cl1//'d_'//clsuff(jg), attr( file__name, TRIM(clname) ) )
          END DO
+         DO jm = 1, 11                                                                         ! 1-11 months
+            WRITE(cl1,'(i1)') jm
+            CALL dia_nam( clname, -jm, clsuff(jg) )
+            CALL iom_set_file_attr(cl1//'m_'//clsuff(jg), name=TRIM(clname))
+         DO jm = 1, 6                                                                          ! 1, 2, 3, 4, 6 months
+            IF( MOD(6,jm) == 0 ) THEN
+               WRITE(cl1,'(i1)') jm
+               CALL dia_nam( clname, -jm, clsuff(jg) )
+               CALL event__set_attribut( cl1//'m_'//clsuff(jg), attr( file__name, TRIM(clname) ) )
+            ENDIF
          END DO
+         DO jy = 1, 50                                                                         ! 1-50 years
+            WRITE(cl2,'(i2)') jy
+            CALL dia_nam( clname, -jy * iyymo, clsuff(jg) )
+            CALL iom_set_file_attr(TRIM(ADJUSTL(cl2))//'y_'//clsuff(jg), name=TRIM(clname))
+         DO jy = 1, 10                                                                         ! 1, 2, 5, 10 years
+            IF( MOD(10,jy) == 0 ) THEN
+               WRITE(cl2,'(i2)') jy
+               CALL dia_nam( clname, -jy * iyymo, clsuff(jg) )
+               CALL event__set_attribut( TRIM(ADJUSTL(cl2))//'y_'//clsuff(jg), attr( file__name, TRIM(clname) ) )
+            ENDIF
          END DO
       END DO
 …
          ! Equatorial section (attributs: jbegin, ni, name_suffix)
          CALL dom_ngb( 0., 0., ix, iy, cl1 )
+         CALL iom_set_domain_attr('Eq'//cl1, zoom_jbegin=iy, zoom_ni=jpiglo)
+         CALL iom_set_file_attr('Eq'//cl1, name_suffix= '_Eq')
+         CALL event__set_attribut( 'Eq'//cl1, attr( zoom__jbegin     , iy     ) )
+         CALL event__set_attribut( 'Eq'//cl1, attr( zoom__ni         , jpiglo ) )
+         CALL event__set_attribut( 'Eq'//cl1, attr( file__name_suffix, '_Eq'  ) )
       END DO
       ! TAO moorings (attributs: ibegin, jbegin, name_suffix)
 …
       CALL set_mooring( zlonpira, zlatpira )
+      WRITE(*,*) 'set adam3'
    END SUBROUTINE set_xmlatt
 …
                ENDIF
                clname = TRIM(ADJUSTL(clat))//TRIM(ADJUSTL(clon))
+               CALL iom_set_domain_attr(TRIM(clname)//cl1, zoom_ibegin= ix, zoom_jbegin= iy)
+               CALL iom_set_file_attr(TRIM(clname)//cl1, name_suffix= '_'//TRIM(clname))
+               CALL event__set_attribut( TRIM(clname)//cl1, attr( zoom__ibegin     , ix                ) )
+               CALL event__set_attribut( TRIM(clname)//cl1, attr( zoom__jbegin     , iy                ) )
+               CALL event__set_attribut( TRIM(clname)//cl1, attr( file__name_suffix, '_'//TRIM(clname) ) )
             END DO
          END DO
 …
 #endif
+   FUNCTION i2str(int)
+   IMPLICIT NONE
+      INTEGER, INTENT(IN) :: int
+      CHARACTER(LEN=255) :: i2str
+      WRITE(i2str,*) int
+   END FUNCTION i2str
    !!======================================================================
 END MODULE iom

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90

r3680	r6736
43	43	INTEGER, PARAMETER, PUBLIC :: jp_i1 = 204 !: write INTEGER(1)
44	44
45		INTEGER, PARAMETER, PUBLIC :: jpmax_files = 100 !: maximum number of simultaneously opened file
	45	INTEGER, PARAMETER, PUBLIC :: jpmax_files = 50 !: maximum number of simultaneously opened file
46	46	INTEGER, PARAMETER, PUBLIC :: jpmax_vars = 360 !: maximum number of variables in one file
47	47	INTEGER, PARAMETER, PUBLIC :: jpmax_dims = 4 !: maximum number of dimensions for one variable

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90

-                      r2715
+                      r6736
    !!            9.0  ! 06 02  (S. Masson) Adaptation to NEMO
    !!             "   ! 07 07  (D. Storkey) Changes to iom_nf90_gettime
+   !!                 ! 13 04  (J. Harle) Additions to iom_nf90_getatt
    !!--------------------------------------------------------------------
    !!gm  caution add !DIR nec: improved performance to be checked as well as no result changes
 …
    END INTERFACE
    INTERFACE iom_nf90_getatt
       MODULE PROCEDURE iom_nf90_intatt
+      MODULE PROCEDURE iom_nf90_att
    END INTERFACE
    INTERFACE iom_nf90_rstput
 …
    SUBROUTINE iom_nf90_intatt( kiomid, cdatt, pvar )
       !!-----------------------------------------------------------------------
       !!                  ***  ROUTINE  iom_nf90_intatt  ***
+   SUBROUTINE iom_nf90_att( kiomid, cdatt, pv_i0d, pv_r0d, cdvar)
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_nf90_att  ***
       !!
       !! ** Purpose : read an integer attribute with NF90
 …
       INTEGER         , INTENT(in   ) ::   kiomid   ! Identifier of the file
       CHARACTER(len=*), INTENT(in   ) ::   cdatt    ! attribute name
+      INTEGER         , INTENT(  out) ::   pvar     ! read field
+      INTEGER         , INTENT(  out), OPTIONAL       ::   pv_i0d    ! read field
+      REAL(wp),         INTENT(  out), OPTIONAL       ::   pv_r0d    ! read field
+      CHARACTER(len=*), INTENT(in   ), OPTIONAL       ::   cdvar     ! name of the variable
+      !
       INTEGER                         ::   if90id   ! temporary integer
+      INTEGER                         ::   ivarid           ! NetCDF  variable Id
       LOGICAL                         ::   llok     ! temporary logical
       CHARACTER(LEN=100)              ::   clinfo   ! info character
 …
+      !
       if90id = iom_file(kiomid)%nfid
+      llok = NF90_Inquire_attribute(if90id, NF90_GLOBAL, cdatt) == nf90_noerr
+      IF( PRESENT(cdvar) ) THEN
+         llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr   ! does the variable exist in the file
+         IF( llok ) THEN
+            llok = NF90_Inquire_attribute(if90id, ivarid, cdatt) == nf90_noerr
+         ELSE
+            CALL ctl_warn('iom_nf90_getatt: no variable '//cdvar//' found')
+         ENDIF
+      ELSE
+         llok = NF90_Inquire_attribute(if90id, NF90_GLOBAL, cdatt) == nf90_noerr
+      ENDIF
+!
       IF( llok) THEN
          clinfo = 'iom_nf90_getatt, file: '//TRIM(iom_file(kiomid)%name)//', att: '//TRIM(cdatt)
+         CALL iom_nf90_check(NF90_GET_ATT(if90id, NF90_GLOBAL, cdatt, values=pvar), clinfo)
+         IF(     PRESENT(pv_r0d) ) THEN
+            IF( PRESENT(cdvar) ) THEN
+               CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, cdatt, values=pv_r0d), clinfo)
+            ELSE
+               CALL iom_nf90_check(NF90_GET_ATT(if90id, NF90_GLOBAL, cdatt, values=pv_r0d), clinfo)
+            ENDIF
+         ELSE
+            IF( PRESENT(cdvar) ) THEN
+               CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, cdatt, values=pv_i0d), clinfo)
+            ELSE
+               CALL iom_nf90_check(NF90_GET_ATT(if90id, NF90_GLOBAL, cdatt, values=pv_i0d), clinfo)
+            ENDIF
+         ENDIF
       ELSE
          CALL ctl_warn('iom_nf90_getatt: no attribute '//cdatt//' found')
+         pvar = -999
+         IF(     PRESENT(pv_r0d) ) THEN
+            pv_r0d = -999._wp
+         ELSE
+            pv_i0d = -999
+         ENDIF
       ENDIF
+      !
    END SUBROUTINE iom_nf90_intatt
+   END SUBROUTINE iom_nf90_att

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90

-                      r3680
+                      r6736
    !!----------------------------------------------------------------------
    USE dom_oce          ! ocean space and time domain variables
-#if defined key_nemocice_decomp
-   USE ice_domain_size, only: nx_global, ny_global
-#endif
    USE in_out_manager   ! I/O manager
    USE lib_mpp          ! distributed memory computing
 …
    PUBLIC prt_ctl_info    ! called by all subroutines
    PUBLIC prt_ctl_init    ! called by opa.F90
-   PUBLIC sub_dom         ! called by opa.F90
    !!----------------------------------------------------------------------
 …
          nrecil, nrecjl, nldil, nleil, nldjl, nlejl
       INTEGER, POINTER, DIMENSION(:,:) ::   iimpptl, ijmpptl, ilcitl, ilcjtl   ! workspace
+      INTEGER, DIMENSION(:,:), ALLOCATABLE ::   iimpptl, ijmpptl, ilcitl, ilcjtl   ! workspace
       REAL(wp) ::   zidom, zjdom            ! temporary scalars
       !!----------------------------------------------------------------------
+      !
-      CALL wrk_alloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl )
+      !
       !  1. Dimension arrays for subdomains
       ! -----------------------------------
 …
       !  array (cf. par_oce.F90).
+      ijpi = ( jpiglo-2*jpreci + (isplt-1) ) / isplt + 2*jpreci
 #if defined key_nemocice_decomp
+      ijpi = ( nx_global+2-2*jpreci + (isplt-1) ) / isplt + 2*jpreci
+      ijpj = ( ny_global+2-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj
+      ijpj = ( jpjglo+1-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj
 #else
-      ijpi = ( jpiglo-2*jpreci + (isplt-1) ) / isplt + 2*jpreci
       ijpj = ( jpjglo-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj
 #endif
+      ALLOCATE(ilcitl (isplt,jsplt))
+      ALLOCATE(ilcjtl (isplt,jsplt))
       nrecil  = 2 * jpreci
 …
       ! -------------------------------
+      ALLOCATE(iimpptl(isplt,jsplt))
+      ALLOCATE(ijmpptl(isplt,jsplt))
       iimpptl(:,:) = 1
       ijmpptl(:,:) = 1
 …
       END DO
+      !
+      !
+      CALL wrk_dealloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl )
+      !
+      DEALLOCATE( iimpptl, ijmpptl, ilcitl, ilcjtl )
+      !
    END SUBROUTINE sub_dom

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90

-                      r3680
+                      r6736
    USE trdmld_oce      ! ocean active mixed layer tracers trends variables
    USE domvvl          ! variable volume
-   USE divcur          ! hor. divergence and curl      (div & cur routines)
    IMPLICIT NONE
 …
    PUBLIC   rst_write  ! routine called by step module
    PUBLIC   rst_read   ! routine called by opa  module
+   LOGICAL, PUBLIC ::   lrst_oce =  .FALSE.   !: logical to control the oce restart write
+   INTEGER, PUBLIC ::   numror, numrow        !: logical unit for cean restart (read and write)
    !! * Substitutions
 …
                      CALL iom_rstput( kt, nitrst, numrow, 'hdivb'  , hdivb     )
                      CALL iom_rstput( kt, nitrst, numrow, 'sshb'   , sshb      )
+      IF( lk_vvl )   CALL iom_rstput( kt, nitrst, numrow, 'fse3t_b', fse3t_b(:,:,:) )
+#if ! defined key_jth_fix
+          IF( lk_vvl )   CALL iom_rstput( kt, nitrst, numrow, 'fse3t_b', fse3t_b(:,:,:) )
+#endif
+                     !
                      CALL iom_rstput( kt, nitrst, numrow, 'un'     , un        )     ! now fields
 …
       ENDIF
+      !
+      IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN
+         CALL iom_get( numror, jpdom_autoglo, 'ub'     , ub      )   ! before fields
+         CALL iom_get( numror, jpdom_autoglo, 'vb'     , vb      )
+         CALL iom_get( numror, jpdom_autoglo, 'tb'     , tsb(:,:,:,jp_tem) )
+         CALL iom_get( numror, jpdom_autoglo, 'sb'     , tsb(:,:,:,jp_sal) )
+         CALL iom_get( numror, jpdom_autoglo, 'rotb'   , rotb    )
+         CALL iom_get( numror, jpdom_autoglo, 'hdivb'  , hdivb   )
+         CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb    )
+         IF( lk_vvl )   CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) )
+      ELSE
+         neuler = 0
+      ENDIF
+      !
+      CALL iom_get( numror, jpdom_autoglo, 'un'     , un      )   ! now    fields
+      CALL iom_get( numror, jpdom_autoglo, 'vn'     , vn      )
+      CALL iom_get( numror, jpdom_autoglo, 'tn'     , tsn(:,:,:,jp_tem) )
+      CALL iom_get( numror, jpdom_autoglo, 'sn'     , tsn(:,:,:,jp_sal) )
+      CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn    )
+      IF( iom_varid( numror, 'rotn', ldstop = .FALSE. ) > 0 ) THEN
+         CALL iom_get( numror, jpdom_autoglo, 'rotn'   , rotn    )
+         CALL iom_get( numror, jpdom_autoglo, 'hdivn'  , hdivn   )
+      ELSE
+         CALL div_cur( 0 )                              ! Horizontal divergence & Relative vorticity
+      ENDIF
+      IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN
+         CALL iom_get( numror, jpdom_autoglo, 'rhop'   , rhop    )   ! now    potential density
+      ELSE
+         CALL eos    ( tsn, rhd, rhop )
+      ENDIF
+                     CALL iom_get( numror, jpdom_autoglo, 'ub'     , ub      )   ! before fields
+                     CALL iom_get( numror, jpdom_autoglo, 'vb'     , vb      )
+                     CALL iom_get( numror, jpdom_autoglo, 'tb'     , tsb(:,:,:,jp_tem) )
+                     CALL iom_get( numror, jpdom_autoglo, 'sb'     , tsb(:,:,:,jp_sal) )
+                     CALL iom_get( numror, jpdom_autoglo, 'rotb'   , rotb    )
+                     CALL iom_get( numror, jpdom_autoglo, 'hdivb'  , hdivb   )
+                     CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb    )
+#if ! defined key_jth_fix
+         IF( lk_vvl ) THEN
+            DO jk = 1, jpk
+               fse3t_b(:,:,jk) = fse3t_n(:,:,jk)
+            END DO
+         ENDIF
+      IF( lk_vvl .AND. ln_fse3t_b )   CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) )
+#endif
+                     !
+                     CALL iom_get( numror, jpdom_autoglo, 'un'     , un      )   ! now    fields
+                     CALL iom_get( numror, jpdom_autoglo, 'vn'     , vn      )
+                     CALL iom_get( numror, jpdom_autoglo, 'tn'     , tsn(:,:,:,jp_tem) )
+                     CALL iom_get( numror, jpdom_autoglo, 'sn'     , tsn(:,:,:,jp_sal) )
+                     CALL iom_get( numror, jpdom_autoglo, 'rotn'   , rotn    )
+                     CALL iom_get( numror, jpdom_autoglo, 'hdivn'  , hdivn   )
+                     CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn    )
+                     CALL iom_get( numror, jpdom_autoglo, 'rhop'   , rhop    )   ! now    potential density
 #if defined key_zdfkpp
       IF( iom_varid( numror, 'rhd', ldstop = .FALSE. ) > 0 ) THEN
          CALL iom_get( numror, jpdom_autoglo, 'rhd'    , rhd     )   ! now    in situ density anomaly
+                     CALL iom_get( numror, jpdom_autoglo, 'rhd'    , rhd     )   ! now    in situ density anomaly
       ELSE
          CALL eos( tsn, rhd )   ! compute rhd
+                     CALL eos( tsn, rhd )   ! compute rhd
       ENDIF
 #endif
 …
          hdivb(:,:,:)   = hdivn(:,:,:)
          sshb (:,:)     = sshn (:,:)
+#if ! defined key_jth_fix
          IF( lk_vvl ) THEN
             DO jk = 1, jpk
 …
             END DO
          ENDIF
+#endif
       ENDIF
+      !

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90

-                      r3768
+                      r6736
    !!   NEMO     1.0  ! 2002-09  (G. Madec)     F90: Free form and module
    !!            3.2  ! 2009-03  (R. Benshila)  External north fold treatment
-   !!            3.5  ! 2012     (S.Mocavero, I. Epicoco) Add 'lbc_bdy_lnk'
-   !!                            and lbc_obc_lnk' routine to optimize
-   !!                            the BDY/OBC communications
    !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  add a C1D case
    !!----------------------------------------------------------------------
 …
    !!   lbc_lnk      : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp
    !!   lbc_lnk_e    : generic interface for mpp_lnk_2d_e routine defined in lib_mpp
-   !!   lbc_bdy_lnk  : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp
-   !!   lbc_obc_lnk  : generic interface for mpp_lnk_obc_2d and mpp_lnk_obc_3d routines defined in lib_mpp
    !!----------------------------------------------------------------------
    USE lib_mpp          ! distributed memory computing library
 …
    END INTERFACE
-   INTERFACE lbc_bdy_lnk
-      MODULE PROCEDURE mpp_lnk_bdy_2d, mpp_lnk_bdy_3d
-   END INTERFACE
-   INTERFACE lbc_obc_lnk
-      MODULE PROCEDURE mpp_lnk_obc_2d, mpp_lnk_obc_3d
-   END INTERFACE
    INTERFACE lbc_lnk_e
       MODULE PROCEDURE mpp_lnk_2d_e
 …
    PUBLIC lbc_lnk       ! ocean lateral boundary conditions
    PUBLIC lbc_lnk_e
-   PUBLIC lbc_bdy_lnk   ! ocean lateral BDY boundary conditions
-   PUBLIC lbc_obc_lnk   ! ocean lateral BDY boundary conditions
    !!----------------------------------------------------------------------
 …
    !!   lbc_lnk_3d   : set the lateral boundary condition on a 3D variable on ocean mesh
    !!   lbc_lnk_2d   : set the lateral boundary condition on a 2D variable on ocean mesh
-   !!   lbc_bdy_lnk  : set the lateral BDY boundary condition
-   !!   lbc_obc_lnk  : set the lateral OBC boundary condition
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers
 …
    INTERFACE lbc_lnk_e
+      MODULE PROCEDURE lbc_lnk_2d_e
+   END INTERFACE
+   INTERFACE lbc_bdy_lnk
+      MODULE PROCEDURE lbc_bdy_lnk_2d, lbc_bdy_lnk_3d
+   END INTERFACE
+   INTERFACE lbc_obc_lnk
+      MODULE PROCEDURE lbc_lnk_2d, lbc_lnk_3d
+      MODULE PROCEDURE lbc_lnk_2d
    END INTERFACE
    PUBLIC   lbc_lnk       ! ocean/ice  lateral boundary conditions
    PUBLIC   lbc_lnk_e
-   PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions
-   PUBLIC   lbc_obc_lnk   ! ocean lateral OBC boundary conditions
    !!----------------------------------------------------------------------
 …
    END SUBROUTINE lbc_lnk_3d
-   SUBROUTINE lbc_bdy_lnk_3d( pt3d, cd_type, psgn, ib_bdy )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE lbc_bdy_lnk  ***
-      !!
-      !! ** Purpose :   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used
-      !!                to maintain the same interface with regards to the mpp case
-      !!
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
-      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign
-      INTEGER                                                   ::   ib_bdy    ! BDY boundary set
-      !!
-      CALL lbc_lnk_3d( pt3d, cd_type, psgn)
-   END SUBROUTINE lbc_bdy_lnk_3d
-   SUBROUTINE lbc_bdy_lnk_2d( pt2d, cd_type, psgn, ib_bdy )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE lbc_bdy_lnk  ***
-      !!
-      !! ** Purpose :   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used
-      !!                to maintain the same interface with regards to the mpp case
-      !!
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj),     INTENT(inout)           ::   pt2d      ! 3D array on which the lbc is applied
-      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign
-      INTEGER                                                   ::   ib_bdy    ! BDY boundary set
-      !!
-      CALL lbc_lnk_2d( pt2d, cd_type, psgn)
-   END SUBROUTINE lbc_bdy_lnk_2d
    SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
 …
    END SUBROUTINE lbc_lnk_2d
-   SUBROUTINE lbc_lnk_2d_e( pt2d, cd_type, psgn, jpri, jprj )
-      !!---------------------------------------------------------------------
-      !!                 ***  ROUTINE lbc_lnk_2d  ***
-      !!
-      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case)
-      !!                special dummy routine to allow for use of halo indexing in mpp case
-      !!
-      !! ** Method  :   psign = -1 :    change the sign across the north fold
-      !!                      =  1 : no change of the sign across the north fold
-      !!                      =  0 : no change of the sign across the north fold and
-      !!                             strict positivity preserved: use inner row/column
-      !!                             for closed boundaries.
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied
-      REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign
-      INTEGER                     , INTENT(in   )           ::   jpri      ! size of extra halo (not needed in non-mpp)
-      INTEGER                     , INTENT(in   )           ::   jprj      ! size of extra halo (not needed in non-mpp)
-      !!----------------------------------------------------------------------
-      CALL lbc_lnk_2d( pt2d, cd_type, psgn )
+      !
-   END SUBROUTINE lbc_lnk_2d_e
 # endif
 #endif

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

-                      r3799
+                      r6736
    !!            3.2  !  2009  (O. Marti)    add mpp_ini_znl
    !!            4.0  !  2011  (G. Madec)  move ctl_ routines from in_out_manager
-   !!            3.5  !  2012  (S.Mocavero, I. Epicoco) Add 'mpp_lnk_bdy_3d', 'mpp_lnk_obc_3d',
-   !!                          'mpp_lnk_bdy_2d' and 'mpp_lnk_obc_2d' routines and update
-   !!                          the mppobc routine to optimize the BDY and OBC communications
    !!----------------------------------------------------------------------
 …
    PUBLIC   mppobc, mpp_ini_ice, mpp_ini_znl
    PUBLIC   mppsize
+   PUBLIC   mppsend, mpprecv                          ! needed by TAM and ICB routines
+   PUBLIC   lib_mpp_alloc   ! Called in nemogcm.F90
+   PUBLIC   mpp_lnk_bdy_2d, mpp_lnk_bdy_3d
+   PUBLIC   mpp_lnk_obc_2d, mpp_lnk_obc_3d
+   PUBLIC   lib_mpp_alloc    ! Called in nemogcm.F90
+   PUBLIC   mppsend, mpprecv ! (PUBLIC for TAM)
    !! * Interfaces
 …
    REAL(wp), DIMENSION(:,:,:)    , ALLOCATABLE, SAVE ::   t2ew, t2we   ! 2d for east-west & west-east
    REAL(wp), DIMENSION(:,:,:)    , ALLOCATABLE, SAVE ::   t2p1, t2p2   ! 2d for north fold
+   REAL(wp), DIMENSION(:,:,:)    , ALLOCATABLE, SAVE ::   tr2ns, tr2sn ! 2d for north-south & south-north + extra outer halo
+   REAL(wp), DIMENSION(:,:,:)    , ALLOCATABLE, SAVE ::   tr2ew, tr2we ! 2d for east-west   & west-east   + extra outer halo
    ! Arrays used in mpp_lbc_north_3d()
 …
          &      t2ew(jpj,jpreci    ,2)   , t2we(jpj,jpreci    ,2)   ,                                            &
          &      t2p1(jpi,jprecj    ,2)   , t2p2(jpi,jprecj    ,2)   ,                                            &
+         !
+         &      tr2ns(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2) ,                                                     &
+         &      tr2sn(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2) ,                                                     &
+         &      tr2ew(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2) ,                                                     &
+         &      tr2we(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2) ,                                                     &
+         !
          &      ztab(jpiglo,4,jpk) , znorthloc(jpi,4,jpk) , znorthgloio(jpi,4,jpk,jpni) ,                        &
 …
    END FUNCTION mynode
+   SUBROUTINE mpp_lnk_obc_3d( ptab, cd_type, psgn )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_obc_3d  ***
+   SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp, pval )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_3d  ***
       !!
       !! ** Purpose :   Message passing manadgement
       !!
       !! ** Method  :   Use mppsend and mpprecv function for passing OBC boundaries
+      !! ** Method  :   Use mppsend and mpprecv function for passing mask
       !!      between processors following neighboring subdomains.
       !!            domain parameters
 …
       !!                    nbondi : mark for "east-west local boundary"
       !!                    nbondj : mark for "north-south local boundary"
       !!                    noea   : number for local neighboring processors
+      !!                    noea   : number for local neighboring processors
       !!                    nowe   : number for local neighboring processors
       !!                    noso   : number for local neighboring processors
 …
       REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
       !                                                             ! =  1. , the sign is kept
+      CHARACTER(len=3), OPTIONAL      , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
+      REAL(wp)        , OPTIONAL      , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
       !!
       INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices
 …
       !!----------------------------------------------------------------------
+      zland = 0.e0      ! zero by default
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0.e0      ! zero by default
+      ENDIF
       ! 1. standard boundary treatment
       ! ------------------------------
+      IF( nbondi == 2) THEN
+        IF (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN
+          ptab( 1 ,:,:) = ptab(jpim1,:,:)
+          ptab(jpi,:,:) = ptab(  2  ,:,:)
+        ELSE
+          IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point
+          ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north
+        ENDIF
+      ELSEIF(nbondi == -1) THEN
+        IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point
+      ELSEIF(nbondi == 1) THEN
+        ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north
+      ENDIF                                     !* closed
+      IF (nbondj == 2 .OR. nbondj == -1) THEN
+        IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point
+      ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN
+        ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north
+      IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
+         !
+         ! WARNING ptab is defined only between nld and nle
+         DO jk = 1, jpk
+            DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
+               ptab(nldi  :nlei  , jj          ,jk) = ptab(nldi:nlei,     nlej,jk)
+               ptab(1     :nldi-1, jj          ,jk) = ptab(nldi     ,     nlej,jk)
+               ptab(nlei+1:nlci  , jj          ,jk) = ptab(     nlei,     nlej,jk)
+            END DO
+            DO ji = nlci+1, jpi                 ! added column(s) (full)
+               ptab(ji           ,nldj  :nlej  ,jk) = ptab(     nlei,nldj:nlej,jk)
+               ptab(ji           ,1     :nldj-1,jk) = ptab(     nlei,nldj     ,jk)
+               ptab(ji           ,nlej+1:jpj   ,jk) = ptab(     nlei,     nlej,jk)
+            END DO
+         END DO
+         !
+      ELSE                              ! standard close or cyclic treatment
+         !
+         !                                   ! East-West boundaries
+         !                                        !* Cyclic east-west
+         IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+            ptab( 1 ,:,:) = ptab(jpim1,:,:)
+            ptab(jpi,:,:) = ptab(  2  ,:,:)
+         ELSE                                     !* closed
+            IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point
+                                         ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north
+         ENDIF
+         !                                   ! North-South boundaries (always closed)
+         IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point
+                                      ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north
+         !
       ENDIF
       ! 2. East and west directions exchange
       ! ------------------------------------
+      ! we play with the neigbours AND the row number because of the periodicity
+      !
+      IF(nbondj .ne. 0) THEN
+      ! we play with the neigbours AND the row number because of the periodicity
+      !
       SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
       CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
 …
             t3we(:,jl,:,1) = ptab(iihom +jl,:,:)
          END DO
       END SELECT
+      END SELECT
+      !
       !                           ! Migrations
       imigr = jpreci * jpj * jpk
+      !
       SELECT CASE ( nbondi )
+      SELECT CASE ( nbondi )
       CASE ( -1 )
          CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 )
 …
          END DO
       END SELECT
-      ENDIF
 …
       ! always closed : we play only with the neigbours
+      !
-      IF(nbondi .ne. 0) THEN
       IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
          ijhom = nlcj-nrecj
 …
       imigr = jprecj * jpi * jpk
+      !
       SELECT CASE ( nbondj )
+      SELECT CASE ( nbondj )
       CASE ( -1 )
          CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req1 )
 …
          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
          IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
       CASE ( 1 )
+      CASE ( 1 )
          CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )
          CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso )
 …
          END DO
       END SELECT
-      ENDIF
 …
       ! -----------------------
+      !
       IF( npolj /= 0 ) THEN
+      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
+         !
          SELECT CASE ( jpni )
 …
       ENDIF
+      !
    END SUBROUTINE mpp_lnk_obc_3d
    SUBROUTINE mpp_lnk_obc_2d( pt2d, cd_type, psgn )
       !!----------------------------------------------------------------------
       !!                  ***  routine mpp_lnk_obc_2d  ***
       !!
+   END SUBROUTINE mpp_lnk_3d
+   SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_2d  ***
+      !!
       !! ** Purpose :   Message passing manadgement for 2d array
       !!
       !! ** Method  :   Use mppsend and mpprecv function for passing OBC boundaries
+      !! ** Method  :   Use mppsend and mpprecv function for passing mask
       !!      between processors following neighboring subdomains.
       !!            domain parameters
 …
       !!                    nbondi : mark for "east-west local boundary"
       !!                    nbondj : mark for "north-south local boundary"
       !!                    noea   : number for local neighboring processors
+      !!                    noea   : number for local neighboring processors
       !!                    nowe   : number for local neighboring processors
       !!                    noso   : number for local neighboring processors
 …
       REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
       !                                                         ! =  1. , the sign is kept
+      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
+      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
       !!
       INTEGER  ::   ji, jj, jl   ! dummy loop indices
 …
       !!----------------------------------------------------------------------
+      zland = 0.e0      ! zero by default
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0.e0      ! zero by default
+      ENDIF
       ! 1. standard boundary treatment
       ! ------------------------------
+      !
+      IF( nbondi == 2) THEN
+        IF (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN
+          pt2d( 1 ,:) = pt2d(jpim1,:)
+          pt2d(jpi,:) = pt2d(  2  ,:)
+        ELSE
+          IF( .NOT. cd_type == 'F' )   pt2d(     1       :jpreci,:) = zland    ! south except F-point
+          pt2d(nlci-jpreci+1:jpi   ,:) = zland    ! north
+        ENDIF
+      ELSEIF(nbondi == -1) THEN
+        IF( .NOT. cd_type == 'F' )   pt2d(     1       :jpreci,:) = zland    ! south except F-point
+      ELSEIF(nbondi == 1) THEN
+        pt2d(nlci-jpreci+1:jpi   ,:) = zland    ! north
+      ENDIF                                     !* closed
+      IF (nbondj == 2 .OR. nbondj == -1) THEN
+        IF( .NOT. cd_type == 'F' )   pt2d(:,     1       :jprecj) = zland       ! south except F-point
+      ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN
+        pt2d(:,nlcj-jprecj+1:jpj) = zland       ! north
+      IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
+         !
+         ! WARNING pt2d is defined only between nld and nle
+         DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
+            pt2d(nldi  :nlei  , jj          ) = pt2d(nldi:nlei,     nlej)
+            pt2d(1     :nldi-1, jj          ) = pt2d(nldi     ,     nlej)
+            pt2d(nlei+1:nlci  , jj          ) = pt2d(     nlei,     nlej)
+         END DO
+         DO ji = nlci+1, jpi                 ! added column(s) (full)
+            pt2d(ji           ,nldj  :nlej  ) = pt2d(     nlei,nldj:nlej)
+            pt2d(ji           ,1     :nldj-1) = pt2d(     nlei,nldj     )
+            pt2d(ji           ,nlej+1:jpj   ) = pt2d(     nlei,     nlej)
+         END DO
+         !
+      ELSE                              ! standard close or cyclic treatment
+         !
+         !                                   ! East-West boundaries
+         IF( nbondi == 2 .AND.   &                ! Cyclic east-west
+            &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+            pt2d( 1 ,:) = pt2d(jpim1,:)                                    ! west
+            pt2d(jpi,:) = pt2d(  2  ,:)                                    ! east
+         ELSE                                     ! closed
+            IF( .NOT. cd_type == 'F' )   pt2d(     1       :jpreci,:) = zland    ! south except F-point
+                                         pt2d(nlci-jpreci+1:jpi   ,:) = zland    ! north
+         ENDIF
+         !                                   ! North-South boundaries (always closed)
+            IF( .NOT. cd_type == 'F' )   pt2d(:,     1       :jprecj) = zland    !south except F-point
+                                         pt2d(:,nlcj-jprecj+1:jpj   ) = zland    ! north
+         !
       ENDIF
       ! 2. East and west directions exchange
       ! ------------------------------------
       ! we play with the neigbours AND the row number because of the periodicity
+      ! we play with the neigbours AND the row number because of the periodicity
+      !
       SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
 …
             pt2d(:,ijhom+jl) = t2ns(:,jl,2)
          END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            pt2d(:,jl      ) = t2sn(:,jl,2)
-         END DO
-      END SELECT
-      ! 4. north fold treatment
-      ! -----------------------
+      !
-      IF( npolj /= 0 ) THEN
+         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd      ( pt2d, cd_type, psgn )   ! only 1 northern proc, no mpp
-         CASE DEFAULT   ;   CALL mpp_lbc_north( pt2d, cd_type, psgn )   ! for all northern procs.
-         END SELECT
+         !
-      ENDIF
+      !
-   END SUBROUTINE mpp_lnk_obc_2d
-   SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp, pval )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_3d  ***
-      !!
-      !! ** Purpose :   Message passing manadgement
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    nbondi : mark for "east-west local boundary"
-      !!                    nbondj : mark for "north-south local boundary"
-      !!                    noea   : number for local neighboring processors
-      !!                    nowe   : number for local neighboring processors
-      !!                    noso   : number for local neighboring processors
-      !!                    nono   : number for local neighboring processors
-      !!
-      !! ** Action  :   ptab with update value at its periphery
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
-      !                                                             ! = T , U , V , F , W points
-      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
-      !                                                             ! =  1. , the sign is kept
-      CHARACTER(len=3), OPTIONAL      , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
-      REAL(wp)        , OPTIONAL      , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
-      !!
-      INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      REAL(wp) ::   zland
-      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !!----------------------------------------------------------------------
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
-      ELSE                         ;   zland = 0.e0      ! zero by default
-      ENDIF
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
+         !
-         ! WARNING ptab is defined only between nld and nle
-         DO jk = 1, jpk
-            DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
-               ptab(nldi  :nlei  , jj          ,jk) = ptab(nldi:nlei,     nlej,jk)
-               ptab(1     :nldi-1, jj          ,jk) = ptab(nldi     ,     nlej,jk)
-               ptab(nlei+1:nlci  , jj          ,jk) = ptab(     nlei,     nlej,jk)
-            END DO
-            DO ji = nlci+1, jpi                 ! added column(s) (full)
-               ptab(ji           ,nldj  :nlej  ,jk) = ptab(     nlei,nldj:nlej,jk)
-               ptab(ji           ,1     :nldj-1,jk) = ptab(     nlei,nldj     ,jk)
-               ptab(ji           ,nlej+1:jpj   ,jk) = ptab(     nlei,     nlej,jk)
-            END DO
-         END DO
+         !
-      ELSE                              ! standard close or cyclic treatment
+         !
-         !                                   ! East-West boundaries
-         !                                        !* Cyclic east-west
-         IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
-            ptab( 1 ,:,:) = ptab(jpim1,:,:)
-            ptab(jpi,:,:) = ptab(  2  ,:,:)
-         ELSE                                     !* closed
-            IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point
-                                         ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north
-         ENDIF
-         !                                   ! North-South boundaries (always closed)
-         IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point
-                                      ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north
+         !
-      ENDIF
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity
+      !
-      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
-      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-         iihom = nlci-nreci
-         DO jl = 1, jpreci
-            t3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
-            t3we(:,jl,:,1) = ptab(iihom +jl,:,:)
-         END DO
-      END SELECT
+      !
-      !                           ! Migrations
-      imigr = jpreci * jpj * jpk
+      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea )
-         CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
-      CASE ( 1 )
-         CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
+      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci-jpreci
+      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jpreci
-            ptab(jl      ,:,:) = t3we(:,jl,:,2)
-            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            ptab(jl      ,:,:) = t3we(:,jl,:,2)
-         END DO
-      END SELECT
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
+      !
-      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
-         ijhom = nlcj-nrecj
-         DO jl = 1, jprecj
-            t3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)
-            t3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)
-         END DO
-      ENDIF
+      !
-      !                           ! Migrations
-      imigr = jprecj * jpi * jpk
+      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono )
-         CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
-      CASE ( 1 )
-         CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
+      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj-jprecj
+      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jprecj
-            ptab(:,jl      ,:) = t3sn(:,jl,:,2)
-            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            ptab(:,jl,:) = t3sn(:,jl,:,2)
-         END DO
-      END SELECT
-      ! 4. north fold treatment
-      ! -----------------------
+      !
-      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
+         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
-         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
-         END SELECT
+         !
-      ENDIF
+      !
-   END SUBROUTINE mpp_lnk_3d
-   SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_2d  ***
-      !!
-      !! ** Purpose :   Message passing manadgement for 2d array
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    nbondi : mark for "east-west local boundary"
-      !!                    nbondj : mark for "north-south local boundary"
-      !!                    noea   : number for local neighboring processors
-      !!                    nowe   : number for local neighboring processors
-      !!                    noso   : number for local neighboring processors
-      !!                    nono   : number for local neighboring processors
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d     ! 2D array on which the boundary condition is applied
-      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
-      !                                                         ! = T , U , V , F , W and I points
-      REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
-      !                                                         ! =  1. , the sign is kept
-      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
-      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
-      !!
-      INTEGER  ::   ji, jj, jl   ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      REAL(wp) ::   zland
-      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !!----------------------------------------------------------------------
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
-      ELSE                         ;   zland = 0.e0      ! zero by default
-      ENDIF
-      ! 1. standard boundary treatment
-      ! ------------------------------
+      !
-      IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
+         !
-         ! WARNING pt2d is defined only between nld and nle
-         DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
-            pt2d(nldi  :nlei  , jj          ) = pt2d(nldi:nlei,     nlej)
-            pt2d(1     :nldi-1, jj          ) = pt2d(nldi     ,     nlej)
-            pt2d(nlei+1:nlci  , jj          ) = pt2d(     nlei,     nlej)
-         END DO
-         DO ji = nlci+1, jpi                 ! added column(s) (full)
-            pt2d(ji           ,nldj  :nlej  ) = pt2d(     nlei,nldj:nlej)
-            pt2d(ji           ,1     :nldj-1) = pt2d(     nlei,nldj     )
-            pt2d(ji           ,nlej+1:jpj   ) = pt2d(     nlei,     nlej)
-         END DO
+         !
-      ELSE                              ! standard close or cyclic treatment
+         !
-         !                                   ! East-West boundaries
-         IF( nbondi == 2 .AND.   &                ! Cyclic east-west
-            &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
-            pt2d( 1 ,:) = pt2d(jpim1,:)                                    ! west
-            pt2d(jpi,:) = pt2d(  2  ,:)                                    ! east
-         ELSE                                     ! closed
-            IF( .NOT. cd_type == 'F' )   pt2d(     1       :jpreci,:) = zland    ! south except F-point
-                                         pt2d(nlci-jpreci+1:jpi   ,:) = zland    ! north
-         ENDIF
-         !                                   ! North-South boundaries (always closed)
-            IF( .NOT. cd_type == 'F' )   pt2d(:,     1       :jprecj) = zland    !south except F-point
-                                         pt2d(:,nlcj-jprecj+1:jpj   ) = zland    ! north
+         !
-      ENDIF
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity
+      !
-      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
-      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-         iihom = nlci-nreci
-         DO jl = 1, jpreci
-            t2ew(:,jl,1) = pt2d(jpreci+jl,:)
-            t2we(:,jl,1) = pt2d(iihom +jl,:)
-         END DO
-      END SELECT
+      !
-      !                           ! Migrations
-      imigr = jpreci * jpj
+      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )
-         CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
-      CASE ( 1 )
-         CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
+      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci - jpreci
+      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            pt2d(iihom+jl,:) = t2ew(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jpreci
-            pt2d(jl      ,:) = t2we(:,jl,2)
-            pt2d(iihom+jl,:) = t2ew(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            pt2d(jl      ,:) = t2we(:,jl,2)
-         END DO
-      END SELECT
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
+      !
-      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
-         ijhom = nlcj-nrecj
-         DO jl = 1, jprecj
-            t2sn(:,jl,1) = pt2d(:,ijhom +jl)
-            t2ns(:,jl,1) = pt2d(:,jprecj+jl)
-         END DO
-      ENDIF
+      !
-      !                           ! Migrations
-      imigr = jprecj * jpi
+      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )
-         CALL mpprecv( 4, t2sn(1,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
-      CASE ( 1 )
-         CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, t2sn(1,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
+      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj - jprecj
+      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            pt2d(:,ijhom+jl) = t2ns(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jprecj
-            pt2d(:,jl      ) = t2sn(:,jl,2)
-            pt2d(:,ijhom+jl) = t2ns(:,jl,2)
-         END DO
       CASE ( 1 )
          DO jl = 1, jprecj
 …
    SUBROUTINE mpp_lnk_2d_e( pt2d, cd_type, psgn, jpri, jprj )
+   SUBROUTINE mpp_lnk_2d_e( pt2d, cd_type, psgn )
       !!----------------------------------------------------------------------
       !!                  ***  routine mpp_lnk_2d_e  ***
 …
       !!                    nlci   : first dimension of the local subdomain
       !!                    nlcj   : second dimension of the local subdomain
       !!                    jpri   : number of rows for extra outer halo
       !!                    jprj   : number of columns for extra outer halo
+      !!                    jpr2di : number of rows for extra outer halo
+      !!                    jpr2dj : number of columns for extra outer halo
       !!                    nbondi : mark for "east-west local boundary"
       !!                    nbondj : mark for "north-south local boundary"
 …
       !!
       !!----------------------------------------------------------------------
+      INTEGER                                             , INTENT(in   ) ::   jpri
+      INTEGER                                             , INTENT(in   ) ::   jprj
+      REAL(wp), DIMENSION(1-jpri:jpi+jpri,1-jprj:jpj+jprj), INTENT(inout) ::   pt2d     ! 2D array with extra halo
+      CHARACTER(len=1)                                    , INTENT(in   ) ::   cd_type  ! nature of ptab array grid-points
+      !                                                                                 ! = T , U , V , F , W and I points
+      REAL(wp)                                            , INTENT(in   ) ::   psgn     ! =-1 the sign change across the
+      !!                                                                                ! north boundary, =  1. otherwise
+      REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), INTENT(inout) ::   pt2d     ! 2D array with extra halo
+      CHARACTER(len=1)                                            , INTENT(in   ) ::   cd_type  ! nature of ptab array grid-points
+      !                                                                                         ! = T , U , V , F , W and I points
+      REAL(wp)                                                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the
+      !!                                                                                        ! north boundary, =  1. otherwise
       INTEGER  ::   jl   ! dummy loop indices
       INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
 …
       INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
       INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
+      !!
+      REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dns
+      REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dsn
+      REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dwe
+      REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dew
+      !!----------------------------------------------------------------------
+      ipreci = jpreci + jpri      ! take into account outer extra 2D overlap area
+      iprecj = jprecj + jprj
+      !!----------------------------------------------------------------------
+      ipreci = jpreci + jpr2di      ! take into account outer extra 2D overlap area
+      iprecj = jprecj + jpr2dj
 …
+      !
       !                                      !* North-South boundaries (always colsed)
       IF( .NOT. cd_type == 'F' )   pt2d(:,  1-jprj   :  jprecj  ) = 0.e0    ! south except at F-point
                                    pt2d(:,nlcj-jprecj+1:jpj+jprj) = 0.e0    ! north
+      IF( .NOT. cd_type == 'F' )   pt2d(:,  1-jpr2dj   :  jprecj  ) = 0.e0    ! south except at F-point
+                                   pt2d(:,nlcj-jprecj+1:jpj+jpr2dj) = 0.e0    ! north
       !                                      ! East-West boundaries
       !                                           !* Cyclic east-west
       IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
          pt2d(1-jpri:     1    ,:) = pt2d(jpim1-jpri:  jpim1 ,:)       ! east
          pt2d(   jpi  :jpi+jpri,:) = pt2d(     2      :2+jpri,:)       ! west
+         pt2d(1-jpr2di:     1    ,:) = pt2d(jpim1-jpr2di:  jpim1 ,:)       ! east
+         pt2d(   jpi  :jpi+jpr2di,:) = pt2d(     2      :2+jpr2di,:)       ! west
+         !
       ELSE                                        !* closed
          IF( .NOT. cd_type == 'F' )   pt2d(  1-jpri   :jpreci    ,:) = 0.e0    ! south except at F-point
                                       pt2d(nlci-jpreci+1:jpi+jpri,:) = 0.e0    ! north
+         IF( .NOT. cd_type == 'F' )   pt2d(  1-jpr2di   :jpreci    ,:) = 0.e0    ! south except at F-point
+                                      pt2d(nlci-jpreci+1:jpi+jpr2di,:) = 0.e0    ! north
       ENDIF
+      !
 …
+         !
          SELECT CASE ( jpni )
          CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj )
+         CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jpr2dj), cd_type, psgn, pr2dj=jpr2dj )
          CASE DEFAULT   ;   CALL mpp_lbc_north_e( pt2d                    , cd_type, psgn               )
          END SELECT
 …
       SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
       CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
          iihom = nlci-nreci-jpri
+         iihom = nlci-nreci-jpr2di
          DO jl = 1, ipreci
             r2dew(:,jl,1) = pt2d(jpreci+jl,:)
             r2dwe(:,jl,1) = pt2d(iihom +jl,:)
+            tr2ew(:,jl,1) = pt2d(jpreci+jl,:)
+            tr2we(:,jl,1) = pt2d(iihom +jl,:)
          END DO
       END SELECT
+      !
       !                           ! Migrations
       imigr = ipreci * ( jpj + 2*jprj)
+      imigr = ipreci * ( jpj + 2*jpr2dj)
+      !
       SELECT CASE ( nbondi )
       CASE ( -1 )
          CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req1 )
          CALL mpprecv( 1, r2dew(1-jprj,1,2), imigr, noea )
+         CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr, noea )
          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
       CASE ( 0 )
          CALL mppsend( 1, r2dew(1-jprj,1,1), imigr, nowe, ml_req1 )
          CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req2 )
          CALL mpprecv( 1, r2dew(1-jprj,1,2), imigr, noea )
          CALL mpprecv( 2, r2dwe(1-jprj,1,2), imigr, nowe )
+         CALL mppsend( 1, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr, noea )
+         CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr, nowe )
          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
          IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
       CASE ( 1 )
          CALL mppsend( 1, r2dew(1-jprj,1,1), imigr, nowe, ml_req1 )
          CALL mpprecv( 2, r2dwe(1-jprj,1,2), imigr, nowe )
+         CALL mppsend( 1, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr, nowe )
          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
       END SELECT
 …
       CASE ( -1 )
          DO jl = 1, ipreci
             pt2d(iihom+jl,:) = r2dew(:,jl,2)
+            pt2d(iihom+jl,:) = tr2ew(:,jl,2)
          END DO
       CASE ( 0 )
          DO jl = 1, ipreci
             pt2d(jl-jpri,:) = r2dwe(:,jl,2)
             pt2d( iihom+jl,:) = r2dew(:,jl,2)
+            pt2d(jl-jpr2di,:) = tr2we(:,jl,2)
+            pt2d( iihom+jl,:) = tr2ew(:,jl,2)
          END DO
       CASE ( 1 )
          DO jl = 1, ipreci
             pt2d(jl-jpri,:) = r2dwe(:,jl,2)
+            pt2d(jl-jpr2di,:) = tr2we(:,jl,2)
          END DO
       END SELECT
 …
+      !
       IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
          ijhom = nlcj-nrecj-jprj
+         ijhom = nlcj-nrecj-jpr2dj
          DO jl = 1, iprecj
             r2dsn(:,jl,1) = pt2d(:,ijhom +jl)
             r2dns(:,jl,1) = pt2d(:,jprecj+jl)
+            tr2sn(:,jl,1) = pt2d(:,ijhom +jl)
+            tr2ns(:,jl,1) = pt2d(:,jprecj+jl)
          END DO
       ENDIF
+      !
       !                           ! Migrations
       imigr = iprecj * ( jpi + 2*jpri )
+      imigr = iprecj * ( jpi + 2*jpr2di )
+      !
       SELECT CASE ( nbondj )
       CASE ( -1 )
          CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req1 )
          CALL mpprecv( 3, r2dns(1-jpri,1,2), imigr, nono )
+         CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr, nono )
          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
       CASE ( 0 )
          CALL mppsend( 3, r2dns(1-jpri,1,1), imigr, noso, ml_req1 )
          CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req2 )
          CALL mpprecv( 3, r2dns(1-jpri,1,2), imigr, nono )
          CALL mpprecv( 4, r2dsn(1-jpri,1,2), imigr, noso )
+         CALL mppsend( 3, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr, nono )
+         CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr, noso )
          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
          IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
       CASE ( 1 )
          CALL mppsend( 3, r2dns(1-jpri,1,1), imigr, noso, ml_req1 )
          CALL mpprecv( 4, r2dsn(1-jpri,1,2), imigr, noso )
+         CALL mppsend( 3, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr, noso )
          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
       END SELECT
 …
       CASE ( -1 )
          DO jl = 1, iprecj
             pt2d(:,ijhom+jl) = r2dns(:,jl,2)
+            pt2d(:,ijhom+jl) = tr2ns(:,jl,2)
          END DO
       CASE ( 0 )
          DO jl = 1, iprecj
             pt2d(:,jl-jprj) = r2dsn(:,jl,2)
             pt2d(:,ijhom+jl ) = r2dns(:,jl,2)
+            pt2d(:,jl-jpr2dj) = tr2sn(:,jl,2)
+            pt2d(:,ijhom+jl ) = tr2ns(:,jl,2)
          END DO
       CASE ( 1 )
          DO jl = 1, iprecj
             pt2d(:,jl-jprj) = r2dsn(:,jl,2)
+            pt2d(:,jl-jpr2dj) = tr2sn(:,jl,2)
          END DO
       END SELECT
 …
       INTEGER ::   ml_stat(MPI_STATUS_SIZE)    ! for key_mpi_isend
       REAL(wp), POINTER, DIMENSION(:,:) ::   ztab   ! temporary workspace
-      LOGICAL :: lmigr ! is true for those processors that have to migrate the OB
       !!----------------------------------------------------------------------
 …
 !!gm Remark : this is very time consumming!!!
       !                                         ! ------------------------ !
-            IF( ijpt0 > ijpt1 .OR. iipt0 > iipt1 ) THEN
-            ! there is nothing to be migrated
-               lmigr = .FALSE.
-            ELSE
-              lmigr = .TRUE.
-            ENDIF
-      IF( lmigr ) THEN
       DO jk = 1, kk                             !   Loop over the levels   !
          !                                      ! ------------------------ !
 …
          ! ---------------------------
+         !
-       IF( ktype == 1 ) THEN
          IF( nbondi /= 2 ) THEN         ! Read Dirichlet lateral conditions
             iihom = nlci-nreci
+            t2ew(1:jpreci,1,1) = ztab(jpreci+1:nreci, ijpt0)
+            t2we(1:jpreci,1,1) = ztab(iihom+1:iihom+jpreci, ijpt0)
+            DO jl = 1, jpreci
+               t2ew(:,jl,1) = ztab(jpreci+jl,:)
+               t2we(:,jl,1) = ztab(iihom +jl,:)
+            END DO
          ENDIF
+         !
          !                              ! Migrations
          imigr = jpreci
+         imigr=jpreci*jpj
+         !
          IF( nbondi == -1 ) THEN
 …
+         !
          IF( nbondi == 0 .OR. nbondi == 1 ) THEN
+            ztab(1:jpreci, ijpt0) = t2we(1:jpreci,1,2)
+            DO jl = 1, jpreci
+               ztab(jl,:) = t2we(:,jl,2)
+            END DO
          ENDIF
          IF( nbondi == -1 .OR. nbondi == 0 ) THEN
+            ztab(iihom+1:iihom+jpreci, ijpt0) = t2ew(1:jpreci,1,2)
+            DO jl = 1, jpreci
+               ztab(iihom+jl,:) = t2ew(:,jl,2)
+            END DO
          ENDIF
+       ENDIF  ! (ktype == 1)
          ! 2. North and south directions
          ! -----------------------------
+         !
-       IF(ktype == 2 ) THEN
          IF( nbondj /= 2 ) THEN         ! Read Dirichlet lateral conditions
             ijhom = nlcj-nrecj
+            t2sn(1:jprecj,1,1) = ztab(iipt0, ijhom+1:ijhom+jprecj)
+            t2ns(1:jprecj,1,1) = ztab(iipt0, jprecj+1:nrecj)
+            DO jl = 1, jprecj
+               t2sn(:,jl,1) = ztab(:,ijhom +jl)
+               t2ns(:,jl,1) = ztab(:,jprecj+jl)
+            END DO
          ENDIF
+         !
          !                              ! Migrations
          imigr = jprecj
+         imigr = jprecj * jpi
+         !
          IF( nbondj == -1 ) THEN
 …
          ijhom = nlcj - jprecj
          IF( nbondj == 0 .OR. nbondj == 1 ) THEN
+            ztab(iipt0,1:jprecj) = t2sn(1:jprecj,1,2)
+            DO jl = 1, jprecj
+               ztab(:,jl) = t2sn(:,jl,2)
+            END DO
          ENDIF
          IF( nbondj == 0 .OR. nbondj == -1 ) THEN
+            ztab(iipt0, ijhom+1:ijhom+jprecj) = t2ns(1:jprecj,1,2)
+            DO jl = 1, jprecj
+               ztab(:,ijhom+jl) = t2ns(:,jl,2)
+            END DO
          ENDIF
-         ENDIF    ! (ktype == 2)
          IF( ktype==1 .AND. kd1 <= jpi+nimpp-1 .AND. nimpp <= kd2 ) THEN
             DO jj = ijpt0, ijpt1            ! north/south boundaries
 …
       END DO
+      !
-      ENDIF ! ( lmigr )
       CALL wrk_dealloc( jpi,jpj, ztab )
+      !
 …
    END SUBROUTINE mpp_lbc_north_e
-      SUBROUTINE mpp_lnk_bdy_3d( ptab, cd_type, psgn, ib_bdy )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_bdy_3d  ***
-      !!
-      !! ** Purpose :   Message passing management
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing BDY boundaries
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    nbondi_bdy : mark for "east-west local boundary"
-      !!                    nbondj_bdy : mark for "north-south local boundary"
-      !!                    noea   : number for local neighboring processors
-      !!                    nowe   : number for local neighboring processors
-      !!                    noso   : number for local neighboring processors
-      !!                    nono   : number for local neighboring processors
-      !!
-      !! ** Action  :   ptab with update value at its periphery
-      !!
-      !!----------------------------------------------------------------------
-      USE lbcnfd          ! north fold
-      INCLUDE 'mpif.h'
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
-      !                                                             ! = T , U , V , F , W points
-      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
-      !                                                             ! =  1. , the sign is kept
-      INTEGER                         , INTENT(in   ) ::   ib_bdy   ! BDY boundary set
-      INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      REAL(wp) ::   zland
-      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !!----------------------------------------------------------------------
-      zland = 0.e0
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      !                                   ! East-West boundaries
-      !                                        !* Cyclic east-west
-      IF( nbondi == 2) THEN
-        IF (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN
-          ptab( 1 ,:,:) = ptab(jpim1,:,:)
-          ptab(jpi,:,:) = ptab(  2  ,:,:)
-        ELSE
-          IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point
-          ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north
-        ENDIF
-      ELSEIF(nbondi == -1) THEN
-        IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point
-      ELSEIF(nbondi == 1) THEN
-        ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north
-      ENDIF                                     !* closed
-      IF (nbondj == 2 .OR. nbondj == -1) THEN
-        IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point
-      ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN
-        ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north
-      ENDIF
+      !
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity
+      !
-      SELECT CASE ( nbondi_bdy(ib_bdy) )      ! Read Dirichlet lateral conditions
-      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-         iihom = nlci-nreci
-         DO jl = 1, jpreci
-            t3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
-            t3we(:,jl,:,1) = ptab(iihom +jl,:,:)
-         END DO
-      END SELECT
+      !
-      !                           ! Migrations
-      imigr = jpreci * jpj * jpk
+      !
-      SELECT CASE ( nbondi_bdy(ib_bdy) )
-      CASE ( -1 )
-         CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 )
-      CASE ( 0 )
-         CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req2 )
-      CASE ( 1 )
-         CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )
-      END SELECT
+      !
-      SELECT CASE ( nbondi_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea )
-      CASE ( 0 )
-         CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea )
-         CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe )
-      CASE ( 1 )
-         CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe )
-      END SELECT
+      !
-      SELECT CASE ( nbondi_bdy(ib_bdy) )
-      CASE ( -1 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
-      CASE ( 1 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
+      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci-jpreci
+      !
-      SELECT CASE ( nbondi_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jpreci
-            ptab(jl      ,:,:) = t3we(:,jl,:,2)
-            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            ptab(jl      ,:,:) = t3we(:,jl,:,2)
-         END DO
-      END SELECT
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
+      !
-      IF( nbondj_bdy(ib_bdy) /= 2 ) THEN      ! Read Dirichlet lateral conditions
-         ijhom = nlcj-nrecj
-         DO jl = 1, jprecj
-            t3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)
-            t3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)
-         END DO
-      ENDIF
+      !
-      !                           ! Migrations
-      imigr = jprecj * jpi * jpk
+      !
-      SELECT CASE ( nbondj_bdy(ib_bdy) )
-      CASE ( -1 )
-         CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req1 )
-      CASE ( 0 )
-         CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req2 )
-      CASE ( 1 )
-         CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )
-      END SELECT
+      !
-      SELECT CASE ( nbondj_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono )
-      CASE ( 0 )
-         CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono )
-         CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso )
-      CASE ( 1 )
-         CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso )
-      END SELECT
+      !
-      SELECT CASE ( nbondj_bdy(ib_bdy) )
-      CASE ( -1 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
-      CASE ( 1 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
+      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj-jprecj
+      !
-      SELECT CASE ( nbondj_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jprecj
-            ptab(:,jl      ,:) = t3sn(:,jl,:,2)
-            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            ptab(:,jl,:) = t3sn(:,jl,:,2)
-         END DO
-      END SELECT
-      ! 4. north fold treatment
-      ! -----------------------
+      !
-      IF( npolj /= 0) THEN
+         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
-         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
-         END SELECT
+         !
-      ENDIF
+      !
-   END SUBROUTINE mpp_lnk_bdy_3d
-      SUBROUTINE mpp_lnk_bdy_2d( ptab, cd_type, psgn, ib_bdy )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_bdy_2d  ***
-      !!
-      !! ** Purpose :   Message passing management
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing BDY boundaries
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    nbondi_bdy : mark for "east-west local boundary"
-      !!                    nbondj_bdy : mark for "north-south local boundary"
-      !!                    noea   : number for local neighboring processors
-      !!                    nowe   : number for local neighboring processors
-      !!                    noso   : number for local neighboring processors
-      !!                    nono   : number for local neighboring processors
-      !!
-      !! ** Action  :   ptab with update value at its periphery
-      !!
-      !!----------------------------------------------------------------------
-      USE lbcnfd          ! north fold
-      INCLUDE 'mpif.h'
-      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
-      !                                                             ! = T , U , V , F , W points
-      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
-      !                                                             ! =  1. , the sign is kept
-      INTEGER                         , INTENT(in   ) ::   ib_bdy   ! BDY boundary set
-      INTEGER  ::   ji, jj, jl             ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      REAL(wp) ::   zland
-      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !!----------------------------------------------------------------------
-      zland = 0.e0
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      !                                   ! East-West boundaries
-      !                                        !* Cyclic east-west
-      IF( nbondi == 2) THEN
-        IF (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN
-          ptab( 1 ,:) = ptab(jpim1,:)
-          ptab(jpi,:) = ptab(  2  ,:)
-        ELSE
-          IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:) = zland    ! south except F-point
-          ptab(nlci-jpreci+1:jpi   ,:) = zland    ! north
-        ENDIF
-      ELSEIF(nbondi == -1) THEN
-        IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:) = zland    ! south except F-point
-      ELSEIF(nbondi == 1) THEN
-        ptab(nlci-jpreci+1:jpi   ,:) = zland    ! north
-      ENDIF                                     !* closed
-      IF (nbondj == 2 .OR. nbondj == -1) THEN
-        IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj) = zland       ! south except F-point
-      ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN
-        ptab(:,nlcj-jprecj+1:jpj) = zland       ! north
-      ENDIF
+      !
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity
+      !
-      SELECT CASE ( nbondi_bdy(ib_bdy) )      ! Read Dirichlet lateral conditions
-      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-         iihom = nlci-nreci
-         DO jl = 1, jpreci
-            t2ew(:,jl,1) = ptab(jpreci+jl,:)
-            t2we(:,jl,1) = ptab(iihom +jl,:)
-         END DO
-      END SELECT
+      !
-      !                           ! Migrations
-      imigr = jpreci * jpj
+      !
-      SELECT CASE ( nbondi_bdy(ib_bdy) )
-      CASE ( -1 )
-         CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )
-      CASE ( 0 )
-         CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )
-      CASE ( 1 )
-         CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
-      END SELECT
+      !
-      SELECT CASE ( nbondi_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )
-      CASE ( 0 )
-         CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )
-         CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )
-      CASE ( 1 )
-         CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )
-      END SELECT
+      !
-      SELECT CASE ( nbondi_bdy(ib_bdy) )
-      CASE ( -1 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
-      CASE ( 1 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
+      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci-jpreci
+      !
-      SELECT CASE ( nbondi_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            ptab(iihom+jl,:) = t2ew(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jpreci
-            ptab(jl      ,:) = t2we(:,jl,2)
-            ptab(iihom+jl,:) = t2ew(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            ptab(jl      ,:) = t2we(:,jl,2)
-         END DO
-      END SELECT
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
+      !
-      IF( nbondj_bdy(ib_bdy) /= 2 ) THEN      ! Read Dirichlet lateral conditions
-         ijhom = nlcj-nrecj
-         DO jl = 1, jprecj
-            t2sn(:,jl,1) = ptab(:,ijhom +jl)
-            t2ns(:,jl,1) = ptab(:,jprecj+jl)
-         END DO
-      ENDIF
+      !
-      !                           ! Migrations
-      imigr = jprecj * jpi
+      !
-      SELECT CASE ( nbondj_bdy(ib_bdy) )
-      CASE ( -1 )
-         CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )
-      CASE ( 0 )
-         CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )
-      CASE ( 1 )
-         CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )
-      END SELECT
+      !
-      SELECT CASE ( nbondj_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )
-      CASE ( 0 )
-         CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )
-         CALL mpprecv( 4, t2sn(1,1,2), imigr, noso )
-      CASE ( 1 )
-         CALL mpprecv( 4, t2sn(1,1,2), imigr, noso )
-      END SELECT
+      !
-      SELECT CASE ( nbondj_bdy(ib_bdy) )
-      CASE ( -1 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
-      CASE ( 1 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
+      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj-jprecj
+      !
-      SELECT CASE ( nbondj_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            ptab(:,ijhom+jl) = t2ns(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jprecj
-            ptab(:,jl      ) = t2sn(:,jl,2)
-            ptab(:,ijhom+jl) = t2ns(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            ptab(:,jl) = t2sn(:,jl,2)
-         END DO
-      END SELECT
-      ! 4. north fold treatment
-      ! -----------------------
+      !
-      IF( npolj /= 0) THEN
+         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
-         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
-         END SELECT
+         !
-      ENDIF
+      !
-   END SUBROUTINE mpp_lnk_bdy_2d
    SUBROUTINE mpi_init_opa( ldtxt, ksft, code )

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90

r3294	r6736
13	13	!! * Modules used
14	14	USE dom_oce ! ocean space and time domain
	15	USE bdy_oce ! ocean space and time domain
15	16	USE in_out_manager ! I/O Manager
16	17	USE lib_mpp ! distribued memory computing library

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90

-                      r3818
+                      r6736
       USE in_out_manager  ! I/O Manager
       USE iom
+      USE bdy_oce
       !!
       INTEGER :: ji, jj, jn, jproc, jarea     ! dummy loop indices
 …
       ! read namelist for ln_zco
       NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco
+      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_hyb
       !!----------------------------------------------------------------------
 …
       imask(:,:)=1
       WHERE ( zdta(:,:) <= 0. ) imask = 0
+#if defined key_bdy
+      ! Adjust imask with bdy_msk if exists
+      NAMELIST/nambdy/ nb_bdy, ln_coords_file, cn_coords_file,             &
+         &             ln_mask_file, cn_mask_file, nn_dyn2d, nn_dyn2d_dta, &
+         &             nn_dyn3d, nn_dyn3d_dta, nn_tra, nn_tra_dta, nb_jpk, &
+#if defined key_lim2
+         &             nn_ice_lim2, nn_ice_lim2_dta,                       &
+#endif
+         &             ln_vol, nn_volctl, nn_rimwidth
+      REWIND ( numnam )              ! Read Namelist namzgr : vertical coordinate'
+      READ   ( numnam, nambdy )
+      IF( ln_mask_file ) THEN
+         CALL iom_open( cn_mask_file, inum )
+         CALL iom_get ( inum, jpdom_unknown, 'bdy_msk', zdta(:,:) )
+         CALL iom_close( inum )
+         WHERE ( zdta(:,:) <= 0. ) imask = 0
+      ENDIF
+#endif
       !  1. Dimension arrays for subdomains

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90

-                      r3634
+                      r6736
       NAMELIST/namdyn_ldf/ ln_dynldf_lap  , ln_dynldf_bilap,                  &
          &                 ln_dynldf_level, ln_dynldf_hor  , ln_dynldf_iso,   &
+         &                 rn_ahm_0_lap   , rn_ahmb_0      , rn_ahm_0_blp ,   &
+         &                 rn_cmsmag_1    , rn_cmsmag_2    , rn_cmsh,         &
+         &                 rn_ahm_m_lap   , rn_ahm_m_blp
+   !!----------------------------------------------------------------------
+         &                 rn_ahm_0_lap   , rn_ahmb_0      , rn_ahm_0_blp
+      !!----------------------------------------------------------------------
       REWIND( numnam )                  ! Read Namelist namdyn_ldf : Lateral physics
 …
          WRITE(numout,*) '      background viscosity                    rn_ahmb_0       = ', rn_ahmb_0
          WRITE(numout,*) '      horizontal bilaplacian eddy viscosity   rn_ahm_0_blp    = ', rn_ahm_0_blp
-         WRITE(numout,*) '      upper limit for laplacian eddy visc     rn_ahm_m_lap    = ', rn_ahm_m_lap
-         WRITE(numout,*) '      upper limit for bilap eddy viscosity    rn_ahm_m_blp    = ', rn_ahm_m_blp
       ENDIF
 …
       IF(lwp) WRITE(numout,*) '        ahm1 = ahm2 = ahm0 =  ',ahm0
 #endif
-     nkahm_smag = 0
-#if defined key_dynldf_smag
-     nkahm_smag = 1
-#endif
+      !
    END SUBROUTINE ldf_dyn_init

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_oce.F90

-                      r3634
+                      r6736
    REAL(wp), PUBLIC ::   rn_ahm_0_blp    =     0._wp   !: lateral bilaplacian eddy viscosity (m4/s)
    REAL(wp), PUBLIC ::   ahm0, ahmb0, ahm0_blp         !: OLD namelist names
-   REAL(wp), PUBLIC ::   rn_cmsmag_1     =     3._wp   !: constant in laplacian Smagorinsky viscosity
-   REAL(wp), PUBLIC ::   rn_cmsmag_2     =     3._wp   !: constant in bilaplacian Smagorinsky viscosity
-   REAL(wp), PUBLIC ::   rn_cmsh         =     1._wp   !: 1 or 0 , if 0 -use only shear for Smagorinsky viscosity
-   REAL(wp), PUBLIC ::   rn_ahm_m_blp    = -1.e12_wp   !: upper limit for bilap  abs(ahm) < min( dx^4/128rdt, rn_ahm_m_blp)
-   REAL(wp), PUBLIC ::   rn_ahm_m_lap    =  40000_wp   !: upper limit for lap  ahm < min(dx^2/16rdt, rn_ahm_m_lap)
-   INTEGER , PUBLIC ::   nkahm_smag      =  0          !:
    !                                                                                  !!! eddy coeff. at U-,V-,W-pts [m2/s]

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90

-                      r3634
+                      r6736
       NAMELIST/namtra_ldf/ ln_traldf_lap  , ln_traldf_bilap,                  &
          &                 ln_traldf_level, ln_traldf_hor  , ln_traldf_iso,   &
          &                 ln_traldf_grif , ln_traldf_gdia ,                  &
          &                 ln_triad_iso   , ln_botmix_grif ,                  &
+         &                 ln_traldf_grif , ln_traldf_gdia,                   &
+         &                 ln_triad_iso   , ln_botmix_grif,                   &
          &                 rn_aht_0       , rn_ahtb_0      , rn_aeiv_0,       &
+         &                 rn_slpmax      , rn_chsmag      ,    rn_smsh,      &
+         &                 rn_aht_m
+         &                 rn_slpmax
       !!----------------------------------------------------------------------
 …
       IF(lwp)WRITE(numout,*) '      constant eddy diffusivity coef.   ahtu = ahtv = ahtw = aht0 = ', aht0
       IF( lk_traldf_eiv ) THEN
+         IF(lwp)WRITE(numout,*)
          IF(lwp)WRITE(numout,*) '      constant eddy induced velocity coef.   aeiu = aeiv = aeiw = aeiv0 = ', aeiv0
       ENDIF
 #endif
-#if defined key_traldf_smag && ! defined key_traldf_c3d
-        CALL ctl_stop( 'key_traldf_smag can only be used with key_traldf_c3d' )
-#endif
-#if defined key_traldf_smag
-        IF(lwp) WRITE(numout,*)' SMAGORINSKY DIFFUSION'
-        IF(lwp .AND. rn_smsh < 1)  WRITE(numout,*)' only  shear is used '
-        IF(lwp.and.ln_traldf_bilap) CALL ctl_stop(' SMAGORINSKY + BILAPLACIAN - UNSTABLE OR NON_CONSERVATIVE' )
-#endif
+      !
    END SUBROUTINE ldf_tra_init

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c3d.h90

-                      r3634
+                      r6736
       CALL lbc_lnk( aeiv, 'V', 1. )
       CALL lbc_lnk( aeiw, 'W', 1. )
+!!!!!# endif jdha
       IF(lwp .AND. ld_print ) THEN
          WRITE(numout,*)
 …
          CALL prihre(aeiw(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
       ENDIF
+# endif
+# endif jdha
+      !
    END SUBROUTINE ldf_tra_c3d

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_oce.F90

-                      r3634
+                      r6736
    REAL(wp), PUBLIC ::   rn_aeiv_0       = 2000._wp  !: eddy induced velocity coefficient (m2/s)
    REAL(wp), PUBLIC ::   rn_slpmax       = 0.01_wp   !: slope limit
-   REAL(wp), PUBLIC ::   rn_chsmag       = 1._wp     !:  multiplicative factor in Smagorinsky diffusivity
-   REAL(wp), PUBLIC ::   rn_smsh         = 1._wp     !:  Smagorinsky diffusivity: = 0 - use only sheer
-   REAL(wp), PUBLIC ::   rn_aht_m        = 2000._wp  !:  upper limit or stability criteria for lateral eddy diffusivity (m2/s)
    REAL(wp), PUBLIC ::   aht0, ahtb0, aeiv0         !!: OLD namelist names
    LOGICAL , PUBLIC ::   ln_triad_iso    = .FALSE.   !: calculate triads twice
    LOGICAL , PUBLIC ::   ln_botmix_grif  = .FALSE.   !: mixing on bottom

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/OBC/obcdyn.F90

-                      r3680
+                      r6736
    !! Ocean dynamics:   Radiation of velocities on each open boundary
    !!=================================================================================
+   !! History :  3.5  !  2012     (S. Mocavero, I. Epicoco) Updates for the
+   !!                             optimization of OBC communications
    !!---------------------------------------------------------------------------------
    !!   obc_dyn        : call the subroutine for each open boundary
 …
       IF( lk_mpp ) THEN
          IF( kt >= nit000+3 .AND. ln_rstart ) THEN
             CALL lbc_obc_lnk( ub, 'U', -1. )
             CALL lbc_obc_lnk( vb, 'V', -1. )
+            CALL lbc_lnk( ub, 'U', -1. )
+            CALL lbc_lnk( vb, 'V', -1. )
          END IF
          CALL lbc_obc_lnk( ua, 'U', -1. )
          CALL lbc_obc_lnk( va, 'V', -1. )
+         CALL lbc_lnk( ua, 'U', -1. )
+         CALL lbc_lnk( va, 'V', -1. )
       ENDIF

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/OBC/obcdyn_bt.F90

-                      r3680
+                      r6736
    !!======================================================================
    !! History :  1.0  ! 2005-12  (V. Garnier) original code
-   !!            3.5  ! 2012     (S. Mocavero, I. Epicoco) Updates for the
-   !!                             optimization of OBC communications
    !!----------------------------------------------------------------------
 #if ( defined key_dynspg_ts || defined key_dynspg_exp ) && defined key_obc
 …
       IF( lk_mpp ) THEN
          IF( kt >= nit000+3 .AND. ln_rstart ) THEN
             CALL lbc_obc_lnk( sshb, 'T',  1. )
             CALL lbc_obc_lnk( ub  , 'U', -1. )
             CALL lbc_obc_lnk( vb  , 'V', -1. )
+            CALL lbc_lnk( sshb, 'T',  1. )
+            CALL lbc_lnk( ub  , 'U', -1. )
+            CALL lbc_lnk( vb  , 'V', -1. )
          END IF
          CALL lbc_obc_lnk( sshn, 'T',  1. )
          CALL lbc_obc_lnk( ua  , 'U', -1. )
          CALL lbc_obc_lnk( va  , 'V', -1. )
+         CALL lbc_lnk( sshn, 'T',  1. )
+         CALL lbc_lnk( ua  , 'U', -1. )
+         CALL lbc_lnk( va  , 'V', -1. )
       ENDIF

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/OBC/obctra.F90

-                      r3680
+                      r6736
    !! Ocean tracers:   Radiation of tracers on each open boundary
    !!=================================================================================
-   !! History :  3.5  !  2012     (S. Mocavero, I. Epicoco) Updates for the
-   !!                             optimization of OBC communications
 #if defined key_obc
    !!---------------------------------------------------------------------------------
 …
       IF( lk_mpp ) THEN                  !!bug ???
          IF( kt >= nit000+3 .AND. ln_rstart ) THEN
             CALL lbc_obc_lnk( tsb(:,:,:,jp_tem), 'T', 1. )
             CALL lbc_obc_lnk( tsb(:,:,:,jp_sal), 'T', 1. )
+            CALL lbc_lnk( tsb(:,:,:,jp_tem), 'T', 1. )
+            CALL lbc_lnk( tsb(:,:,:,jp_sal), 'T', 1. )
          END IF
          CALL lbc_obc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )
          CALL lbc_obc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )
+         CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )
+         CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )
       ENDIF

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90

-                      r3651
+                      r6736
    LOGICAL, DIMENSION(:), ALLOCATABLE :: &
       & ld_velav     !: Velocity data is daily averaged
-   LOGICAL, DIMENSION(:), ALLOCATABLE :: &
-      & ld_sstnight  !: SST observation corresponds to night mean
    !!----------------------------------------------------------------------
 …
          ALLOCATE(sstdata(nsstsets))
          ALLOCATE(sstdatqc(nsstsets))
-         ALLOCATE(ld_sstnight(nsstsets))
          sstdata(:)%nsurf=0
+         sstdatqc(:)%nsurf=0
+         ld_sstnight(:)=.false.
+         sstdatqc(:)%nsurf=0
          nsstsets = 0
 …
             nsstsets = nsstsets + 1
-            ld_sstnight(nsstsets) = .TRUE.
             CALL obs_rea_sst_rey( reysstname, reysstfmt, sstdata(nsstsets), &
 …
             nsstsets = nsstsets + 1
-            ld_sstnight(nsstsets) = .TRUE.
             CALL obs_rea_sst( 1, sstdata(nsstsets), jnumsst, &
 …
                nsstsets = nsstsets + 1
-               ld_sstnight(nsstsets) = .TRUE.
                CALL obs_rea_sst( 0, sstdata(nsstsets), 1, &
 …
       IF ( ln_sst ) THEN
          DO jsstset = 1, nsstsets
+            CALL obs_sst_opt( sstdatqc(jsstset),                &
+               &              kstp, jpi, jpj, nit000, idaystp,  &
+               &              tsn(:,:,1,jp_tem), tmask(:,:,1),  &
+               &              n2dint, ld_sstnight(jsstset) )
+            CALL obs_sst_opt( sstdatqc(jsstset),                 &
+               &              kstp, jpi, jpj, nit000, tsn(:,:,1,jp_tem), &
+               &              tmask(:,:,1), n2dint )
          END DO
       ENDIF

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90

-                      r3651
+                      r6736
    END SUBROUTINE obs_sla_opt
+   SUBROUTINE obs_sst_opt( sstdatqc, kt, kpi, kpj, kit000, kdaystp, &
+      &                    psstn, psstmask, k2dint, ld_nightav )
+   SUBROUTINE obs_sst_opt( sstdatqc, kt, kpi, kpj, kit000, &
+      &                    psstn, psstmask, k2dint )
       !!-----------------------------------------------------------------------
       !!
 …
       !! * Modules used
       USE obs_surf_def  ! Definition of storage space for surface observations
-      USE sbcdcy
       IMPLICIT NONE
 …
                                        !   (kit000-1 = restart time)
       INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header)
-      INTEGER, INTENT(IN) :: kdaystp   ! Number of time steps per day
       REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: &
          & psstn,  &    ! Model SST field
          & psstmask     ! Land-sea mask
       !! * Local declarations
       INTEGER :: ji
 …
       INTEGER :: isst
       INTEGER :: iobs
-      INTEGER :: idayend
       REAL(KIND=wp) :: zlam
       REAL(KIND=wp) :: zphi
       REAL(KIND=wp) :: zext(1), zobsmask(1)
-      REAL(KIND=wp) :: zdaystp
-      INTEGER, DIMENSION(:,:), SAVE, ALLOCATABLE :: &
-         & icount_sstnight,      &
-         & imask_night
-      REAL(kind=wp), DIMENSION(:,:), SAVE, ALLOCATABLE :: &
-         & zintmp, &
-         & zouttmp, &
-         & zmeanday    ! to compute model sst in region of 24h daylight (pole)
       REAL(kind=wp), DIMENSION(2,2,1) :: &
          & zweig
 …
          & zmask, &
          & zsstl, &
-         & zsstm, &
          & zglam, &
          & zgphi
 …
          & igrdi, &
          & igrdj
-      LOGICAL, INTENT(IN) :: ld_nightav
       !-----------------------------------------------------------------------
 …
       inrc = kt - kit000 + 2
       isst = sstdatqc%nsstp(inrc)
-      IF ( ld_nightav ) THEN
-      ! Initialize array for night mean
-      IF ( kt .EQ. 0 ) THEN
-         ALLOCATE ( icount_sstnight(kpi,kpj) )
-         ALLOCATE ( imask_night(kpi,kpj) )
-         ALLOCATE ( zintmp(kpi,kpj) )
-         ALLOCATE ( zouttmp(kpi,kpj) )
-         ALLOCATE ( zmeanday(kpi,kpj) )
-         nday_qsr = -1   ! initialisation flag for nbc_dcy
-      ENDIF
-      ! Initialize daily mean for first timestep
-      idayend = MOD( kt - kit000 + 1, kdaystp )
-      ! Added kt == 0 test to catch restart case
-      IF ( idayend == 1 .OR. kt == 0) THEN
-         IF (lwp) WRITE(numout,*) 'Reset sstdatqc%vdmean on time-step: ',kt
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               sstdatqc%vdmean(ji,jj) = 0.0
-               zmeanday(ji,jj) = 0.0
-               icount_sstnight(ji,jj) = 0
-            END DO
-         END DO
-      ENDIF
-      zintmp(:,:) = 0.0
-      zouttmp(:,:) = sbc_dcy( zintmp(:,:), .TRUE. )
-      imask_night(:,:) = INT( zouttmp(:,:) )
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            ! Increment the temperature field for computing night mean and counter
-            sstdatqc%vdmean(ji,jj) = sstdatqc%vdmean(ji,jj)  &
-                   &                        + psstn(ji,jj)*imask_night(ji,jj)
-            zmeanday(ji,jj)        = zmeanday(ji,jj) + psstn(ji,jj)
-            icount_sstnight(ji,jj) = icount_sstnight(ji,jj) + imask_night(ji,jj)
-         END DO
-      END DO
-      ! Compute the daily mean at the end of day
-      zdaystp = 1.0 / REAL( kdaystp )
-      IF ( idayend == 0 ) THEN
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ! Test if "no night" point
-               IF ( icount_sstnight(ji,jj) .NE. 0 ) THEN
-                  sstdatqc%vdmean(ji,jj) = sstdatqc%vdmean(ji,jj) &
-                    &                        / icount_sstnight(ji,jj)
-               ELSE
-                  sstdatqc%vdmean(ji,jj) = zmeanday(ji,jj) * zdaystp
-               ENDIF
-            END DO
-         END DO
-      ENDIF
-      ENDIF
       ! Get the data for interpolation
 …
       CALL obs_int_comm_2d( 2, 2, isst, &
          &                  igrdi, igrdj, psstn, zsstl )
+      ! At the end of the day get interpolated means
+      IF ( idayend == 0 .AND. ld_nightav ) THEN
+         ALLOCATE( &
+            & zsstm(2,2,isst)  &
+            & )
+         CALL obs_int_comm_2d( 2, 2, isst, igrdi, igrdj, &
+            &               sstdatqc%vdmean(:,:), zsstm )
+      ENDIF
       ! Loop over observations
 …
          ! Interpolate the model SST to the observation point
+         IF ( ld_nightav ) THEN
+           IF ( idayend == 0 )  THEN
+               ! Daily averaged/diurnal cycle of SST  data
+               CALL obs_int_h2d( 1, 1,      &
+                     &              zweig, zsstm(:,:,iobs), zext )
+            ELSE
+               CALL ctl_stop( ' ld_nightav is set to true: a nonzero' //     &
+                     &           ' number of night SST data should' // &
+                     &           ' only occur at the end of a given day' )
+            ENDIF
+         ELSE
+            CALL obs_int_h2d( 1, 1,      &
+         CALL obs_int_h2d( 1, 1,      &
             &              zweig, zsstl(:,:,iobs),  zext )
-         ENDIF
          sstdatqc%rmod(jobs,1) = zext(1)
 …
          & zsstl  &
          & )
-      ! At the end of the day also get interpolated means
-      IF ( idayend == 0 .AND. ld_nightav ) THEN
-         DEALLOCATE( &
-            & zsstm  &
-            & )
-      ENDIF
       sstdatqc%nsurfup = sstdatqc%nsurfup + isst

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_seaice.F90

-                      r3651
+                      r6736
          &               iindx   )
+      CALL obs_surf_alloc( seaicedata, iobs, &
+                           kvars, kextr, kstp, jpi, jpj )
+      CALL obs_surf_alloc( seaicedata, iobs, kvars, kextr, kstp )
       ! * Read obs/positions, QC, all variable and assign to seaicedata

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sla.F90

-                      r3651
+                      r6736
          &               iindx   )
+      CALL obs_surf_alloc( sladata, iobs, kvars, kextr, &
+         &                 jpi, jpj, kstp )
+      CALL obs_surf_alloc( sladata, iobs, kvars, kextr, kstp )
       ! * Read obs/positions, QC, all variable and assign to sladata

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sst.F90

-                      r3651
+                      r6736
          &               iindx   )
       CALL obs_surf_alloc( sstdata, iobs, kvars, kextr, kstp, jpi, jpj )
+      CALL obs_surf_alloc( sstdata, iobs, kvars, kextr, kstp )
       ! * Read obs/positions, QC, all variable and assign to sstdata
 …
       ! Allocate obs_surf data structure for time sorted data
       CALL obs_surf_alloc( sstdata, inumobs, kvars, kextra, kstp, jpi, jpj )
+      CALL obs_surf_alloc( sstdata, inumobs, kvars, kextra, kstp )
       pjul = pjulini + 1

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/OBS/obs_surf_def.F90

-                      r3651
+                      r6736
       INTEGER :: nextra     !: Number of extra fields at observation points
       INTEGER :: nstp       !: Number of time steps
-      INTEGER :: npi        !: Number of 3D grid points
-      INTEGER :: npj
       INTEGER :: nsurfup    !: Observation counter used in obs_oper
 …
          & rext           !: Extra fields interpolated to observation points
-      REAL(KIND=wp), POINTER, DIMENSION(:,:) :: &
-         & vdmean         !: Time averaged of model field
       ! Arrays with size equal to the number of time steps in the window
 …
 CONTAINS
    SUBROUTINE obs_surf_alloc( surf, ksurf, kvar, kextra, kstp, kpi, kpj )
+   SUBROUTINE obs_surf_alloc( surf, ksurf, kvar, kextra, kstp )
       !!----------------------------------------------------------------------
       !!                     ***  ROUTINE obs_surf_alloc  ***
 …
       INTEGER, INTENT(IN) :: kextra  ! Number of extra fields at observation points
       INTEGER, INTENT(IN) :: kstp    ! Number of time steps
-      INTEGER, INTENT(IN) :: kpi     ! Number of 3D grid points
-      INTEGER, INTENT(IN) :: kpj
       !!* Local variables
 …
       surf%nvar     = kvar
       surf%nstp     = kstp
-      surf%npi      = kpi
-      surf%npj      = kpj
       ! Allocate arrays of number of surface data size
 …
          & )
-      ! Allocate arrays of size number of grid points
-      ALLOCATE( &
-         & surf%vdmean(kpi,kpj) &
-         & )
       ! Set defaults for compression indices
 …
          & )
-      ! Deallocate arrays of size number of grid points size times
-      ! number of variables
-      DEALLOCATE( &
-         & surf%vdmean &
-         & )
       ! Deallocate arrays of number of time step size
 …
       IF ( lallocate ) THEN
          CALL obs_surf_alloc( newsurf,  insurf, surf%nvar, &
             & surf%nextra, surf%nstp, surf%npi, surf%npj )
+            & surf%nextra, surf%nstp )
       ENDIF

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90

-                      r3625
+                      r6736
    !!----------------------------------------------------------------------
    !!   albedo_ice    : albedo for   ice (clear and overcast skies)
    !!   albedo_oce    : albedo for ocean (clear and overcast skies)
    !!   albedo_init   : initialisation of albedo computation
    !!----------------------------------------------------------------------
    USE phycst         ! physical constants
    USE in_out_manager ! I/O manager
    USE lib_mpp        ! MPP library
    USE wrk_nemo       ! work arrays
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   !!   albedo_ice  : albedo for   ice (clear and overcast skies)
+   !!   albedo_oce  : albedo for ocean (clear and overcast skies)
+   !!   albedo_init : initialisation of albedo computation
+   !!----------------------------------------------------------------------
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! work arrays
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
    IMPLICIT NONE

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

-                      r3851
+                      r6736
    !!                 !  05-2008  (S. Alderson) Modified for Interpolation in memory
    !!                 !                         from input grid to model grid
+   !!                 !  04-2013  (J. Harle) Addition to interpolate bdy data onto
+   !!                 !                      model grid
    !!----------------------------------------------------------------------
 …
    PUBLIC   fld_map    ! routine called by tides_init
-   PUBLIC   fld_read, fld_fill   ! called by sbc... modules
    TYPE, PUBLIC ::   FLD_N      !: Namelist field informations
 …
       !                                                 ! into the WGTLIST structure
       CHARACTER(len = 34)             ::   vcomp        ! symbolic name for a vector component that needs rotation
+      LOGICAL, DIMENSION(2)           ::   rotn         ! flag to indicate whether before/after field has been rotated
+      INTEGER                         ::   nreclast     ! last record to be read in the current file
+      LOGICAL                         ::   rotn         ! flag to indicate whether field has been rotated
    END TYPE FLD
 …
 !$AGRIF_END_DO_NOT_TREAT
+   PUBLIC   fld_read, fld_fill   ! called by sbc... modules
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
 …
 CONTAINS
    SUBROUTINE fld_read( kt, kn_fsbc, sd, map, kit, kt_offset )
+   SUBROUTINE fld_read( kt, kn_fsbc, sd, map, jit, time_offset, jpk_1)
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE fld_read  ***
 …
       INTEGER  , INTENT(in   )               ::   kn_fsbc   ! sbc computation period (in time step)
       TYPE(FLD), INTENT(inout), DIMENSION(:) ::   sd        ! input field related variables
       TYPE(MAP_POINTER),INTENT(in), OPTIONAL, DIMENSION(:) ::   map   ! global-to-local mapping indices
       INTEGER  , INTENT(in   ), OPTIONAL     ::   kit       ! subcycle timestep for timesplitting option
       INTEGER  , INTENT(in   ), OPTIONAL     ::   kt_offset ! provide fields at time other than "now"
                                                             !   kt_offset = -1 => fields at "before" time level
                                                             !   kt_offset = +1 => fields at "after"  time level
                                                             !   etc.
       !!
       INTEGER  ::   itmp       ! temporary variable
+      TYPE(MAP_POINTER),INTENT(in), OPTIONAL, DIMENSION(:) ::   map   ! global-to-local mapping index
+      INTEGER  , INTENT(in   ), OPTIONAL     ::   jit       ! subcycle timestep for timesplitting option
+      INTEGER  , INTENT(in   ), OPTIONAL     ::   time_offset ! provide fields at time other than "now"
+                                                              ! time_offset = -1 => fields at "before" time level
+                                                              ! time_offset = +1 => fields at "after" time levels
+                                                              ! etc.
+      INTEGER  , INTENT(in   ), OPTIONAL     ::   jpk_1       !
+      !!
       INTEGER  ::   imf        ! size of the structure sd
       INTEGER  ::   jf         ! dummy indices
+      INTEGER  ::   ireclast   ! last record to be read in the current year file
       INTEGER  ::   isecend    ! number of second since Jan. 1st 00h of nit000 year at nitend
       INTEGER  ::   isecsbc    ! number of seconds between Jan. 1st 00h of nit000 year and the middle of sbc time step
       INTEGER  ::   it_offset  ! local time offset variable
+      INTEGER  ::   itime_add  ! local time offset variable
       LOGICAL  ::   llnxtyr    ! open next year  file?
       LOGICAL  ::   llnxtmth   ! open next month file?
 …
       REAL(wp) ::   ztintb     ! ratio applied to before records when doing time interpolation
       CHARACTER(LEN=1000) ::   clfmt   ! write format
+      TYPE(MAP_POINTER) ::   imap   ! global-to-local mapping indices
+      !!---------------------------------------------------------------------
+      ll_firstcall = kt == nit000
+      IF( PRESENT(kit) )   ll_firstcall = ll_firstcall .and. kit == 1
+      it_offset = 0
+      IF( PRESENT(kt_offset) )   it_offset = kt_offset
+      imap%ptr => NULL()
+      !!---------------------------------------------------------------------
+      ll_firstcall = .false.
+      IF( PRESENT(jit) ) THEN
+         IF(kt == nit000 .and. jit == 1) ll_firstcall = .true.
+      ELSE
+         IF(kt == nit000) ll_firstcall = .true.
+      ENDIF
+      itime_add = 0
+      IF( PRESENT(time_offset) ) itime_add = time_offset
       ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar
+      IF( present(kit) ) THEN   ! ignore kn_fsbc in this case
+         isecsbc = nsec_year + nsec1jan000 + (kit+it_offset)*NINT( rdt/REAL(nn_baro,wp) )
+      ELSE                      ! middle of sbc time step
+         isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdttra(1)) + it_offset * NINT(rdttra(1))
+      IF( present(jit) ) THEN
+         ! ignore kn_fsbc in this case
+         isecsbc = nsec_year + nsec1jan000 + (jit+itime_add)*rdt/REAL(nn_baro,wp)
+      ELSE
+         isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdttra(1)) + itime_add * rdttra(1)  ! middle of sbc time step
       ENDIF
       imf = SIZE( sd )
+      !
       IF( ll_firstcall ) THEN                      ! initialization
+         DO jf = 1, imf
+            IF( PRESENT(map) ) imap = map(jf)
+            CALL fld_init( kn_fsbc, sd(jf), imap )  ! read each before field (put them in after as they will be swapped)
+         END DO
+         IF( PRESENT(map) ) THEN
+            DO jf = 1, imf
+               IF( PRESENT(jpk_1) ) THEN
+               CALL fld_init( kn_fsbc, sd(jf), map(jf)%ptr, jpk_1 )  ! read each before field (put them in after as they will be swapped)
+               ELSE
+               CALL fld_init( kn_fsbc, sd(jf), map(jf)%ptr )  ! read each before field (put them in after as they will be swapped)
+               ENDIF
+            END DO
+         ELSE
+            DO jf = 1, imf
+               CALL fld_init( kn_fsbc, sd(jf) )       ! read each before field (put them in after as they will be swapped)
+            END DO
+         ENDIF
          IF( lwp ) CALL wgt_print()                ! control print
+         CALL fld_rot( kt, sd )                    ! rotate vector fiels if needed
       ENDIF
       !                                            ! ====================================== !
 …
          DO jf = 1, imf                            ! ---   loop over field   --- !
+            IF( isecsbc > sd(jf)%nrec_a(2) .OR. ll_firstcall ) THEN    ! read/update the after data?
+               IF( PRESENT(map) )   imap = map(jf)   ! temporary definition of map
+               sd(jf)%nrec_b(:) = sd(jf)%nrec_a(:)                                  ! swap before record informations
+               sd(jf)%rotn(1) = sd(jf)%rotn(2)                                      ! swap before rotate informations
+               IF( sd(jf)%ln_tint )   sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2)   ! swap before record field
+               CALL fld_rec( kn_fsbc, sd(jf), kt_offset = it_offset, kit = kit )    ! update after record informations
+               ! if kn_fsbc*rdttra is larger than nfreqh (which is kind of odd),
+               ! it is possible that the before value is no more the good one... we have to re-read it
+               ! if before is not the last record of the file currently opened and after is the first record to be read
+               ! in a new file which means after = 1 (the file to be opened corresponds to the current time)
+               ! or after = nreclast + 1 (the file to be opened corresponds to a future time step)
+               IF( .NOT. ll_firstcall .AND. sd(jf)%ln_tint .AND. sd(jf)%nrec_b(1) /= sd(jf)%nreclast &
+                  &                   .AND. MOD( sd(jf)%nrec_a(1), sd(jf)%nreclast ) == 1 ) THEN
+                  itmp = sd(jf)%nrec_a(1)                       ! temporary storage
+                  sd(jf)%nrec_a(1) = sd(jf)%nreclast            ! read the last record of the file currently opened
+                  CALL fld_get( sd(jf), imap )                  ! read after data
+                  sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2)   ! re-swap before record field
+                  sd(jf)%nrec_b(1) = sd(jf)%nrec_a(1)           ! update before record informations
+                  sd(jf)%nrec_b(2) = sd(jf)%nrec_a(2) - sd(jf)%nfreqh * 3600  ! assume freq to be in hours in this case
+                  sd(jf)%rotn(1)   = sd(jf)%rotn(2)             ! update before rotate informations
+                  sd(jf)%nrec_a(1) = itmp                       ! move back to after record
+            IF( isecsbc > sd(jf)%nrec_a(2) .OR. ll_firstcall ) THEN  ! read/update the after data?
+               IF( sd(jf)%ln_tint ) THEN                             ! swap before record field and informations
+                  sd(jf)%nrec_b(:) = sd(jf)%nrec_a(:)
+!CDIR COLLAPSE
+                  sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2)
                ENDIF
+               CALL fld_clopn( sd(jf) )   ! Do we need to open a new year/month/week/day file?
+               IF( PRESENT(jit) ) THEN
+                  CALL fld_rec( kn_fsbc, sd(jf), time_offset=itime_add, jit=jit )              ! update record informations
+               ELSE
+                  CALL fld_rec( kn_fsbc, sd(jf), time_offset=itime_add )                       ! update record informations
+               ENDIF
+               ! do we have to change the year/month/week/day of the forcing field??
                IF( sd(jf)%ln_tint ) THEN
-                  ! if kn_fsbc*rdttra is larger than nfreqh (which is kind of odd),
-                  ! it is possible that the before value is no more the good one... we have to re-read it
-                  ! if before record is not just just before the after record...
-                  IF( .NOT. ll_firstcall .AND. MOD( sd(jf)%nrec_a(1), sd(jf)%nreclast ) /= 1 &
-                     &                   .AND. sd(jf)%nrec_b(1) /= sd(jf)%nrec_a(1) - 1 ) THEN
-                     sd(jf)%nrec_a(1) = sd(jf)%nrec_a(1) - 1       ! move back to before record
-                     CALL fld_get( sd(jf), imap )                  ! read after data
-                     sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2)   ! re-swap before record field
-                     sd(jf)%nrec_b(1) = sd(jf)%nrec_a(1)           ! update before record informations
-                     sd(jf)%nrec_b(2) = sd(jf)%nrec_a(2) - sd(jf)%nfreqh * 3600  ! assume freq to be in hours in this case
-                     sd(jf)%rotn(1)   = sd(jf)%rotn(2)             ! update before rotate informations
-                     sd(jf)%nrec_a(1) = sd(jf)%nrec_a(1) + 1       ! move back to after record
-                  ENDIF
-                  ! do we have to change the year/month/week/day of the forcing field??
                   ! if we do time interpolation we will need to open next year/month/week/day file before the end of the current
                   ! one. If so, we are still before the end of the year/month/week/day when calling fld_rec so sd(jf)%nrec_a(1)
                   ! will be larger than the record number that should be read for current year/month/week/day
+                  ! last record to be read in the current file
+                  IF    ( sd(jf)%nfreqh == -12 ) THEN                 ;   ireclast = 1    !  yearly mean
+                  ELSEIF( sd(jf)%nfreqh ==  -1 ) THEN                                     ! monthly mean
+                     IF(     sd(jf)%cltype      == 'monthly' ) THEN   ;   ireclast = 1
+                     ELSE                                             ;   ireclast = 12
+                     ENDIF
+                  ELSE                                                                    ! higher frequency mean (in hours)
+                     IF(     sd(jf)%cltype      == 'monthly' ) THEN   ;   ireclast = 24 * nmonth_len(nmonth) / sd(jf)%nfreqh
+                     ELSEIF( sd(jf)%cltype(1:4) == 'week'    ) THEN   ;   ireclast = 24 * 7                  / sd(jf)%nfreqh
+                     ELSEIF( sd(jf)%cltype      == 'daily'   ) THEN   ;   ireclast = 24                      / sd(jf)%nfreqh
+                     ELSE                                             ;   ireclast = 24 * nyear_len(     1 ) / sd(jf)%nfreqh
+                     ENDIF
+                  ENDIF
                   ! do we need next file data?
                   IF( sd(jf)%nrec_a(1) > sd(jf)%nreclast ) THEN
                      sd(jf)%nrec_a(1) = sd(jf)%nrec_a(1) - sd(jf)%nreclast   !
                      IF( .NOT. ( sd(jf)%ln_clim .AND. sd(jf)%cltype == 'yearly' ) ) THEN   ! close/open the current/new file
+                  IF( sd(jf)%nrec_a(1) > ireclast ) THEN
+                     sd(jf)%nrec_a(1) = 1              ! force to read the first record of the next file
+                     IF( .NOT. sd(jf)%ln_clim ) THEN   ! close the current file and open a new one.
                         llnxtmth = sd(jf)%cltype == 'monthly' .OR. nday == nmonth_len(nmonth)      ! open next month file?
                         llnxtyr  = sd(jf)%cltype == 'yearly'  .OR. (nmonth == 12 .AND. llnxtmth)   ! open next year  file?
 …
                         isecend = nsec_year + nsec1jan000 + (nitend - kt) * NINT(rdttra(1))   ! second at the end of the run
                         llstop = isecend > sd(jf)%nrec_a(2)                                   ! read more than 1 record of next year
+                        ! we suppose that the date of next file is next day (should be ok even for weekly files...)
                         CALL fld_clopn( sd(jf), nyear  + COUNT((/llnxtyr /))                                           ,         &
                            &                    nmonth + COUNT((/llnxtmth/)) - 12                 * COUNT((/llnxtyr /)),         &
 …
                            CALL ctl_warn('next year/month/week/day file: '//TRIM(sd(jf)%clname)//     &
                               &     ' not present -> back to current year/month/day')
                            CALL fld_clopn( sd(jf) )       ! back to the current year/month/day
                            sd(jf)%nrec_a(1) = sd(jf)%nreclast     ! force to read the last record in the current year file
+                           CALL fld_clopn( sd(jf), nyear, nmonth, nday )       ! back to the current year/month/day
+                           sd(jf)%nrec_a(1) = ireclast     ! force to read the last record to be read in the current year file
                         ENDIF
                      ENDIF
+                  ENDIF   ! open need next file?
+               ENDIF   ! temporal interpolation?
+                  ENDIF
+               ELSE
+                  ! if we are not doing time interpolation, we must change the year/month/week/day of the file just after
+                  ! switching to the NEW year/month/week/day. If it is the case, we are at the beginning of the
+                  ! year/month/week/day when calling fld_rec so sd(jf)%nrec_a(1) = 1
+                  IF( sd(jf)%nrec_a(1) == 1 .AND. .NOT. ( sd(jf)%ln_clim .AND. sd(jf)%cltype == 'yearly' ) )   &
+                     &   CALL fld_clopn( sd(jf), nyear, nmonth, nday )
+               ENDIF
                ! read after data
+               CALL fld_get( sd(jf), imap )
+            ENDIF   ! read new data?
+               IF( PRESENT(map) ) THEN
+                  IF( PRESENT(jpk_1) ) THEN
+                  CALL fld_get( sd(jf), map(jf)%ptr, jpk_1)
+                  ELSE
+                  CALL fld_get( sd(jf), map(jf)%ptr)
+                  ENDIF
+               ELSE
+                  CALL fld_get( sd(jf) )
+               ENDIF
+            ENDIF
          END DO                                    ! --- end loop over field --- !
          CALL fld_rot( kt, sd )                    ! rotate vector before/now/after fields if needed
+         CALL fld_rot( kt, sd )                    ! rotate vector fiels if needed
          DO jf = 1, imf                            ! ---   loop over field   --- !
 …
                   WRITE(numout, clfmt)  TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday,   &
                      & sd(jf)%nrec_b(1), sd(jf)%nrec_a(1), REAL(sd(jf)%nrec_b(2),wp)/rday, REAL(sd(jf)%nrec_a(2),wp)/rday
                   WRITE(numout, *) 'it_offset is : ',it_offset
+                  WRITE(numout, *) 'itime_add is : ',itime_add
                ENDIF
                ! temporal interpolation weights
 …
    SUBROUTINE fld_init( kn_fsbc, sdjf, map )
+   SUBROUTINE fld_init( kn_fsbc, sdjf, map , jpk_1 )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE fld_init  ***
 …
       INTEGER  , INTENT(in   ) ::   kn_fsbc   ! sbc computation period (in time step)
       TYPE(FLD), INTENT(inout) ::   sdjf      ! input field related variables
+      TYPE(MAP_POINTER),INTENT(in) ::   map   ! global-to-local mapping indices
+      INTEGER  , INTENT(in), OPTIONAL, DIMENSION(:) :: map ! global-to-local mapping indices
+      INTEGER  , INTENT(in), OPTIONAL               :: jpk_1 ! global-to-local mapping indices
       !!
       LOGICAL :: llprevyr              ! are we reading previous year  file?
 …
       CHARACTER(LEN=1000) ::   clfmt   ! write format
       !!---------------------------------------------------------------------
+      ! some default definitions...
+      sdjf%num = 0   ! default definition for non-opened file
+      IF( sdjf%ln_clim )   sdjf%clname = TRIM( sdjf%clrootname )   ! file name defaut definition, never change in this case
       llprevyr   = .FALSE.
       llprevmth  = .FALSE.
 …
       isec_week  = 0
+      IF( sdjf%cltype(1:4) == 'week' .AND. nn_leapy == 0 )   &
+         &   CALL ctl_stop('fld_clopn: weekly file ('//TRIM(sdjf%clrootname)//') needs nn_leapy = 1')
+      IF( sdjf%cltype(1:4) == 'week' .AND. sdjf%ln_clim  )   &
+         &   CALL ctl_stop('fld_clopn: weekly file ('//TRIM(sdjf%clrootname)//') needs ln_clim = .FALSE.')
       ! define record informations
       CALL fld_rec( kn_fsbc, sdjf, ldbefore = .TRUE. )  ! return before values in sdjf%nrec_a (as we will swap it later)
 …
                   llprevyr  = .NOT. sdjf%ln_clim                                           ! use previous year  file?
                ELSE
                   CALL ctl_stop( "fld_init: yearly mean file must be in a yearly type of file: "//TRIM(sdjf%clrootname) )
+                  CALL ctl_stop( "fld_init: yearly mean file must be in a yearly type of file: "//TRIM(sdjf%clname) )
                ENDIF
             ELSEIF( sdjf%nfreqh ==  -1 ) THEN   ! monthly mean
 …
                   llprevmth = .TRUE.                                                       ! use previous month file?
                   llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file?
+!           IF (lwp) write(numout,*) sdjf%clvar,'AFTER', sdjf%nrec_a(1), sdjf%nrec_a(2), sdjf%clname
                ELSE                                           ! yearly file
                   sdjf%nrec_a(1) = 12                                                      ! force to read december mean
 …
             ENDIF
          ENDIF
+         !
          IF ( sdjf%cltype(1:4) == 'week' ) THEN
             isec_week = isec_week + ksec_week( sdjf%cltype(6:8) )   ! second since the beginning of the week
 …
          ! if previous year/month/day file does not exist, we switch to the current year/month/day
          IF( llprev .AND. sdjf%num <= 0 ) THEN
             CALL ctl_warn( 'previous year/month/week/day file: '//TRIM(sdjf%clrootname)//   &
+            CALL ctl_warn( 'previous year/month/week/day file: '//TRIM(sdjf%clname)//   &
                &           ' not present -> back to current year/month/week/day' )
             ! we force to read the first record of the current year/month/day instead of last record of previous year/month/day
             llprev = .FALSE.
             sdjf%nrec_a(1) = 1
             CALL fld_clopn( sdjf )
+            CALL fld_clopn( sdjf, nyear, nmonth, nday )
          ENDIF
          IF( llprev ) THEN   ! check if the record sdjf%nrec_a(1) exists in the file
+         IF( llprev ) THEN   ! check if the last record sdjf%nrec_n(1) exists in the file
             idvar = iom_varid( sdjf%num, sdjf%clvar )                                        ! id of the variable sdjf%clvar
             IF( idvar <= 0 )   RETURN
 …
          ENDIF
+         ! read before data in after arrays(as we will swap it later)
+         CALL fld_get( sdjf, map )
+         ! read before data
+         IF( PRESENT(map) ) THEN
+            IF( PRESENT(jpk_1) ) THEN
+            CALL fld_get( sdjf, map , jpk_1)  ! read before values in after arrays(as we will swap it later)
+            ELSE
+            CALL fld_get( sdjf, map )  ! read before values in after arrays(as we will swap it later)
+            ENDIF
+         ELSE
+            CALL fld_get( sdjf )  ! read before values in after arrays(as we will swap it later)
+         ENDIF
          clfmt = "('fld_init : time-interpolation for ', a, ' read previous record = ', i4, ' at time = ', f7.2, ' days')"
          IF(lwp) WRITE(numout, clfmt) TRIM(sdjf%clvar), sdjf%nrec_a(1), REAL(sdjf%nrec_a(2),wp)/rday
+         IF( llprev )   CALL iom_close( sdjf%num )          ! force to close previous year file (-> redefine sdjf%num to 0)
       ENDIF
+      ! make sure current year/month/day file is opened
+      IF( sdjf%num <= 0 ) THEN
+         !
+         IF ( sdjf%cltype(1:4) == 'week' ) THEN
+            isec_week  = ksec_week( sdjf%cltype(6:8) )      ! second since the beginning of the week
+            llprevmth  = isec_week > nsec_month             ! longer time since beginning of the week than the month
+            llprevyr   = llprevmth .AND. nmonth == 1
+         ELSE
+            isec_week  = 0
+            llprevmth  = .FALSE.
+            llprevyr   = .FALSE.
+         ENDIF
+         !
+         iyear  = nyear  - COUNT((/llprevyr /))
+         imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /))
+         iday   = nday   + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday)
+         !
+         CALL fld_clopn( sdjf, iyear, imonth, iday )
+      ENDIF
+      !
    END SUBROUTINE fld_init
    SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore, kit, kt_offset )
+   SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore, jit, time_offset )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE fld_rec  ***
 …
       TYPE(FLD), INTENT(inout)           ::   sdjf      ! input field related variables
       LOGICAL  , INTENT(in   ), OPTIONAL ::   ldbefore  ! sent back before record values (default = .FALSE.)
       INTEGER  , INTENT(in   ), OPTIONAL ::   kit       ! index of barotropic subcycle
+      INTEGER  , INTENT(in   ), OPTIONAL ::   jit       ! index of barotropic subcycle
                                                         ! used only if sdjf%ln_tint = .TRUE.
       INTEGER  , INTENT(in   ), OPTIONAL ::   kt_offset ! Offset of required time level compared to "now"
                                                         !   time level in units of time steps.
+      INTEGER  , INTENT(in   ), OPTIONAL ::   time_offset  ! Offset of required time level compared to "now"
+                                                           ! time level in units of time steps.
       !!
       LOGICAL  ::   llbefore    ! local definition of ldbefore
 …
       INTEGER  ::   ifreq_sec   ! frequency mean (in seconds)
       INTEGER  ::   isec_week   ! number of seconds since the start of the weekly file
       INTEGER  ::   it_offset   ! local time offset variable
+      INTEGER  ::   itime_add   ! local time offset variable
       REAL(wp) ::   ztmp        ! temporary variable
       !!----------------------------------------------------------------------
 …
       ENDIF
+      !
+      it_offset = 0
+      IF( PRESENT(kt_offset) )   it_offset = kt_offset
+      IF( PRESENT(kit) ) THEN   ;   it_offset = ( kit + it_offset ) * NINT( rdt/REAL(nn_baro,wp) )
+      ELSE                      ;   it_offset =         it_offset   * NINT(       rdttra(1)      )
+      ENDIF
+      itime_add = 0
+      IF( PRESENT(time_offset) ) itime_add = time_offset
+      !
       !                                      ! =========== !
 …
             !       forcing record :    1
+            !
+            ztmp = REAL( nday, wp ) / REAL( nyear_len(1), wp ) + 0.5 + REAL( it_offset, wp )
+            ztmp = REAL( nday, wp ) / REAL( nyear_len(1), wp ) + 0.5
+            IF( PRESENT(jit) ) THEN
+               ztmp = ztmp + (jit+itime_add)*rdt/REAL(nn_baro,wp)
+            ELSE
+               ztmp = ztmp + itime_add*rdttra(1)
+            ENDIF
             sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))
             ! swap at the middle of the year
 …
             !       forcing record :  nmonth
+            !
+            ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 + REAL( it_offset, wp )
+            ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5
+            IF( PRESENT(jit) ) THEN
+               ztmp = ztmp + (jit+itime_add)*rdt/REAL(nn_baro,wp)  / ( REAL( nmonth_len(nmonth), wp )* 86400. )
+            ELSE
+               ztmp = ztmp + itime_add*rdttra(1) / ( REAL( nmonth_len(nmonth), wp ) * 86400. )
+            ENDIF
             imth = nmonth + INT( ztmp ) - COUNT((/llbefore/))
             IF( sdjf%cltype == 'monthly' ) THEN   ;   sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))
 …
             ENDIF
             sdjf%nrec_a(2) = nmonth_half(   imth ) + nsec1jan000   ! swap at the middle of the month
+!           IF (lwp) write(numout,*) sdjf%clvar, sdjf%nrec_a(1), sdjf%nrec_a(2), nday, nmonth, itime_add, &
+!                                                     rdttra(1), COUNT((/llbefore/)), ztmp, nmonth_half(   imth ), &
+!                                                      nsec1jan000, REAL( nmonth_len(nmonth), wp )
          ELSE                                    ! no time interpolation
             IF( sdjf%cltype == 'monthly' ) THEN   ;   sdjf%nrec_a(1) = 1
 …
          ELSE                                           ;   ztmp = REAL(nsec_year ,wp)  ! since 00h on Jan 1 of the current year
          ENDIF
+         ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rdttra(1) + REAL( it_offset, wp )  ! centrered in the middle of sbc time step
+         ztmp = ztmp + 0.01 * rdttra(1)                                                 ! avoid truncation error
+         ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rdttra(1)   ! shift time to be centrered in the middle of sbc time step
+         ztmp = ztmp + 0.01 * rdttra(1)                          ! add 0.01 time step to avoid truncation error
+         IF( PRESENT(jit) ) THEN
+            ztmp = ztmp + (jit+itime_add)*rdt/REAL(nn_baro,wp)
+         ELSE
+            ztmp = ztmp + itime_add*rdttra(1)
+         ENDIF
          IF( sdjf%ln_tint ) THEN                ! time interpolation, shift by 1/2 record
+            !
             !          INT( ztmp/ifreq_sec + 0.5 )
+            !                  INT( ztmp )
             !                     /|\
             !                    2 |        *-----(
 …
             !                    0 |--(
             !                      |--+--|--+--|--+--|--> time
             !                      0 /|\ 1 /|\ 2 /|\ 3    (ztmp/ifreq_sec)
+            !                      0 /|\ 1 /|\ 2 /|\ 3 (nsec_year/ifreq_sec) or (nsec_month/ifreq_sec)
             !                         |     |     |
             !                         |     |     |
 …
          ELSE                                   ! no time interpolation
+            !
             !           INT( ztmp/ifreq_sec )
+            !                  INT( ztmp )
             !                     /|\
             !                    2 |           *-----(
 …
             !                    0 |-----(
             !                      |--+--|--+--|--+--|--> time
             !                      0 /|\ 1 /|\ 2 /|\ 3    (ztmp/ifreq_sec)
+            !                      0 /|\ 1 /|\ 2 /|\ 3 (nsec_year/ifreq_sec) or (nsec_month/ifreq_sec)
             !                         |     |     |
             !                         |     |     |
 …
             ztmp= ztmp / REAL(ifreq_sec, wp)
          ENDIF
          sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))   ! record number to be read
+         sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))   ! record nomber to be read
          iendrec = ifreq_sec * sdjf%nrec_a(1) + nsec1jan000       ! end of this record (in second)
 …
    SUBROUTINE fld_get( sdjf, map )
+   SUBROUTINE fld_get( sdjf, map, jpk_1 )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE fld_get  ***
 …
       !!----------------------------------------------------------------------
       TYPE(FLD), INTENT(inout) ::   sdjf   ! input field related variables
+      TYPE(MAP_POINTER),INTENT(in) ::   map   ! global-to-local mapping indices
+      INTEGER  , INTENT(in), OPTIONAL, DIMENSION(:) :: map ! global-to-local mapping indices
+      INTEGER  , INTENT(in), OPTIONAL              :: jpk_1 ! number of levels in bdy data
       !!
       INTEGER                  ::   ipk    ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk )
       INTEGER                  ::   iw     ! index into wgts array
+      INTEGER                  ::   ipdom  ! index of the domain
+      !!---------------------------------------------------------------------
+      !
+      !!---------------------------------------------------------------------
       ipk = SIZE( sdjf%fnow, 3 )
+      !
+      IF( ASSOCIATED(map%ptr) ) THEN
+         IF( sdjf%ln_tint ) THEN   ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map%ptr )
+         ELSE                      ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1), map%ptr )
+      IF( PRESENT(map) ) THEN
+         IF( PRESENT(jpk_1) ) THEN
+         IF( sdjf%ln_tint ) THEN   ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map, jpk_1 )
+         IF(lwp) WRITE(numout,*) 'in get 2'
+         CALL flush(numout)
+         ELSE                      ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1), map, jpk_1 )
+         IF(lwp) WRITE(numout,*) 'in get 1'
+         CALL flush(numout)
+         ENDIF
+         ELSE
+         IF( sdjf%ln_tint ) THEN   ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map )
+         ELSE                      ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1), map )
+         ENDIF
          ENDIF
       ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN
 …
          ENDIF
       ELSE
-         IF( SIZE(sdjf%fnow, 1) == jpi ) THEN  ;  ipdom = jpdom_data
-         ELSE                                  ;  ipdom = jpdom_unknown
-         ENDIF
          SELECT CASE( ipk )
          CASE(1)
             IF( sdjf%ln_tint ) THEN   ;   CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_a(1) )
             ELSE                      ;   CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fnow(:,:,1  ), sdjf%nrec_a(1) )
+         CASE(1)
+            IF( sdjf%ln_tint ) THEN   ;   CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_a(1) )
+            ELSE                      ;   CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,1  ), sdjf%nrec_a(1) )
             ENDIF
          CASE DEFAULT
             IF( sdjf%ln_tint ) THEN   ;   CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) )
             ELSE                      ;   CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1) )
+            IF( sdjf%ln_tint ) THEN   ;   CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) )
+            ELSE                      ;   CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1) )
             ENDIF
          END SELECT
       ENDIF
+      !
       sdjf%rotn(2) = .false.   ! vector not yet rotated
+      sdjf%rotn = .false.   ! vector not yet rotated
    END SUBROUTINE fld_get
    SUBROUTINE fld_map( num, clvar, dta, nrec, map )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE fld_map  ***
+   SUBROUTINE fld_map( num, clvar, dta, nrec, map, jpk_1 )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE fld_get  ***
       !!
       !! ** Purpose :   read global data from file and map onto local data
       !!                using a general mapping (for open boundaries)
+      !!
+      !!                12-04-13 updated to include interpolation of boundary
+      !!                         data from non-native vertical grid
       !!----------------------------------------------------------------------
 #if defined key_bdy
       USE bdy_oce, ONLY:  dta_global, dta_global2         ! workspace to read in global data arrays
+      USE bdy_oce, ONLY:  dta_global, dta_global_1, dta_global_2, idx_bdy         ! workspace to read in global data arrays
 #endif
+      INTEGER                   , INTENT(in ) ::   num     ! stream number
+      CHARACTER(LEN=*)          , INTENT(in ) ::   clvar   ! variable name
+      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   dta   ! output field on model grid (2 dimensional)
+      INTEGER                   , INTENT(in ) ::   nrec    ! record number to read (ie time slice)
+      INTEGER,  DIMENSION(:)    , INTENT(in ) ::   map     ! global-to-local mapping indices
+      !!
+      INTEGER                                 ::   ipi      ! length of boundary data on local process
+      INTEGER                                 ::   ipj      ! length of dummy dimension ( = 1 )
+      INTEGER                                 ::   ipk      ! number of vertical levels of dta ( 2D: ipk=1 ; 3D: ipk=jpk )
+      INTEGER                                 ::   ilendta  ! length of data in file
+      INTEGER                                 ::   idvar    ! variable ID
+      INTEGER                                 ::   ib, ik, ji, jj   ! loop counters
+      INTEGER                   , INTENT(in ) ::   num        ! stream number
+      CHARACTER(LEN=*)          , INTENT(in ) ::   clvar      ! variable name
+      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   dta        ! output field on model grid (2 dimensional)
+      INTEGER                   , INTENT(in ) ::   nrec       ! record number to read (ie time slice)
+      INTEGER,  DIMENSION(:)    , INTENT(in ) ::   map        ! global-to-local mapping indices
+      INTEGER  , INTENT(in), OPTIONAL         ::   jpk_1      ! number of levels in bdy data
+      INTEGER                                 ::   jpkm1_1    ! number of levels in bdy data minus 1
+      !!
+      INTEGER                                 ::   ipi        ! length of boundary data on local process
+      INTEGER                                 ::   ipj        ! length of dummy dimension ( = 1 )
+      INTEGER                                 ::   ipk, ipkm1 ! number of vertical levels of dta ( 2D: ipk=1 ; 3D: ipk=jpk )
+      INTEGER                                 ::   ilendta    ! length of data in file
+      INTEGER                                 ::   idvar      ! variable ID
+      INTEGER                                 ::   ib, ik, ikk! loop counters
       INTEGER                                 ::   ierr
+      REAL(wp), POINTER, DIMENSION(:,:,:)     ::   dta_read  ! work space for global data
+      INTEGER                                 ::   igrd, ib_bdy
+      REAL(wp)                                ::   zl, zi     ! tmp variable for current depth and interpolation factor
+      REAL(wp)                                ::   fv, fv_alt ! fillvalue and alternative -ABS(fv)
+      REAL(wp), POINTER, DIMENSION(:,:,:)     ::   dta_read   ! work space for global data
+      REAL(wp), POINTER, DIMENSION(:,:,:)     ::   dta_read_1 ! work space for BDY data from file
+      REAL(wp), POINTER, DIMENSION(:,:)       ::   dta_read_2 ! work space for BDY depth data from file
       !!---------------------------------------------------------------------
+#if defined key_bdy
+      dta_read => dta_global
+      IF( PRESENT(jpk_1) ) THEN
+         IF( jpk_1>0 ) THEN
+            dta_read_1 => dta_global_1
+            dta_read_2 => dta_global_2
+            jpkm1_1 = jpk_1 - 1
+         ENDIF
+      ENDIF
+      igrd = 1            ! T/S only so far
+      ib_bdy = 1          ! and only one bdy file
+#endif
       ipi = SIZE( dta, 1 )
       ipj = 1
       ipk = SIZE( dta, 3 )
+      ipkm1 = ipk - 1
       idvar   = iom_varid( num, clvar )
       ilendta = iom_file(num)%dimsz(1,idvar)
-#if defined key_bdy
-      ipj = iom_file(num)%dimsz(2,idvar)
-      IF (ipj == 1) THEN ! we assume that this is a structured open boundary file
-         dta_read => dta_global
-      ELSE
-         dta_read => dta_global2
-      ENDIF
-#endif
       IF(lwp) WRITE(numout,*) 'Dim size for ',TRIM(clvar),' is ', ilendta
       IF(lwp) WRITE(numout,*) 'Number of levels for ',TRIM(clvar),' is ', ipk
+      CALL flush(numout)
       SELECT CASE( ipk )
+      CASE(1)        ;   CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1    ), nrec )
+      CASE DEFAULT   ;   CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1:ipk), nrec )
+      CASE(1)
+         CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1    ), nrec )
+      CASE DEFAULT
+#if defined key_bdy
+         IF( PRESENT(jpk_1) ) THEN       ! boundary data not on model grid: veritcal interpolation
+            IF( jpk_1>0 ) THEN
+               IF( lwp )THEN
+                  WRITE(numout,*) 'BDY: interpolate T & S data onto new vertical mesh'
+               ENDIF
+               !
+               ! gather data from file along with depth and _FillValue info
+               !
+               CALL iom_get ( num, jpdom_unknown, clvar, dta_read_1(1:ilendta,1:ipj,1:jpk_1), nrec )
+               CALL iom_get ( num, jpdom_unknown, 'deptht', dta_read_2(1:ilendta,1:jpk_1) )
+               CALL iom_getatt(num, '_FillValue', fv, cdvar=clvar )
+               !
+               fv_alt = -ABS(fv)  ! set _FillValue < 0 as we make use of MAXVAL and MAXLOC later
+               !
+               DO ib = 1, ipi
+                  DO ik = 1, ipk
+                     IF( ( dta_read_1(map(ib),1,ik) == fv ) ) THEN
+                        dta_read_2(map(ib),ik) = fv_alt ! safety: put fillvalue into external depth field so consistent with data
+                     ENDIF
+                     dta_read(map(ib),1,ik) = fv_alt    ! put fillvalue into new field as if all goes well all wet points will be replaced
+                  ENDDO
+               ENDDO ! had to use map in this loop ?? tried looping over ib but failed !! investigate TODO
+               !
+               DO ib = 1, ipi
+                  DO ik = 1, ipk
+                     zl =  gdept_1(idx_bdy(ib_bdy)%nbi(ib,igrd),idx_bdy(ib_bdy)%nbj(ib,igrd),ik)   ! if using in step could use fsdept instead of gdept_1?
+                     IF( zl < dta_read_2(map(ib),1) ) THEN                                         ! above the first level of external data
+                        dta_read(map(ib),1,ik) =  dta_read_1(map(ib),1,1)
+                     ELSEIF( zl > MAXVAL(dta_read_2(map(ib),:),1) ) THEN                           ! below the last level of external data
+                        dta_read(map(ib),1,ik) =  dta_read_1(map(ib),1,MAXLOC(dta_read_2(map(ib),:),1))
+                     ELSE                                                                          ! inbetween : vertical interpolation between ikk & ikk+1
+                        DO ikk = 1, ipkm1                                                          ! when  gdept_1(ikk) < zl < gdept_1(ikk+1)
+                           IF( ( (zl-dta_read_2(map(ib),ikk)) * (zl-dta_read_2(map(ib),ikk+1)) <= 0._wp)   &
+                            &    .AND. (dta_read_2(map(ib),ikk+1) /= fv_alt)) THEN
+                              zi = ( zl - dta_read_2(map(ib),ikk) ) / (dta_read_2(map(ib),ikk+1)-dta_read_2(map(ib),ikk))
+                              dta_read(map(ib),1,ik) = dta_read_1(map(ib),1,ikk) + &
+                            &                          ( dta_read_1(map(ib),1,ikk+1) -  dta_read_1(map(ib),1,ikk) ) * zi
+                           ENDIF
+                        END DO
+                     ENDIF
+                  END DO
+               END DO
+               !
+               IF(lwp) WRITE(numout,*) 'BDY: finished interpolating T & S data onto new vertical mesh'
+               !
+            ENDIF ! is jpk_1 > 0
+         ELSE ! must be on model grid already
+            CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1:ipk), nrec )
+         ENDIF ! end PRESENT jpk_1
+#else
+         CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1:ipk), nrec )
+#endif
       END SELECT
+      !
+      IF (ipj==1) THEN
+         DO ib = 1, ipi
+            DO ik = 1, ipk
+               dta(ib,1,ik) =  dta_read(map(ib),1,ik)
+            END DO
+      DO ib = 1, ipi
+         DO ik = 1, ipk
+            dta(ib,1,ik) =  dta_read(map(ib),1,ik)
          END DO
+      ELSE ! we assume that this is a structured open boundary file
+         DO ib = 1, ipi
+            jj=1+floor(REAL(map(ib)-1)/REAL(ilendta))
+            ji=map(ib)-(jj-1)*ilendta
+            DO ik = 1, ipk
+               dta(ib,1,ik) =  dta_read(ji,jj,ik)
+            END DO
+         END DO
+      ENDIF
+      END DO
    END SUBROUTINE fld_map
 …
       TYPE(FLD), INTENT(inout), DIMENSION(:) ::   sd        ! input field related variables
       !!
       INTEGER                           ::   ju,jv,jk,jn  ! loop indices
+      INTEGER                           ::   ju, jv, jk   ! loop indices
       INTEGER                           ::   imf          ! size of the structure sd
       INTEGER                           ::   ill          ! character length
 …
       DO ju = 1, imf
          ill = LEN_TRIM( sd(ju)%vcomp )
+         DO jn = 2-COUNT((/sd(ju)%ln_tint/)), 2
+            IF( ill > 0 .AND. .NOT. sd(ju)%rotn(jn) ) THEN   ! find vector rotations required
+               IF( sd(ju)%vcomp(1:1) == 'U' ) THEN      ! east-west component has symbolic name starting with 'U'
+                  ! look for the north-south component which has same symbolic name but with 'U' replaced with 'V'
+                  clcomp = 'V' // sd(ju)%vcomp(2:ill)   ! works even if ill == 1
+                  iv = -1
+                  DO jv = 1, imf
+                     IF( TRIM(sd(jv)%vcomp) == TRIM(clcomp) )   iv = jv
+                  END DO
+                  IF( iv > 0 ) THEN   ! fields ju and iv are two components which need to be rotated together
+                     DO jk = 1, SIZE( sd(ju)%fnow, 3 )
+                        IF( sd(ju)%ln_tint )THEN
+                           CALL rot_rep( sd(ju)%fdta(:,:,jk,jn), sd(iv)%fdta(:,:,jk,jn), 'T', 'en->i', utmp(:,:) )
+                           CALL rot_rep( sd(ju)%fdta(:,:,jk,jn), sd(iv)%fdta(:,:,jk,jn), 'T', 'en->j', vtmp(:,:) )
+                           sd(ju)%fdta(:,:,jk,jn) = utmp(:,:)   ;   sd(iv)%fdta(:,:,jk,jn) = vtmp(:,:)
+                        ELSE
+                           CALL rot_rep( sd(ju)%fnow(:,:,jk  ), sd(iv)%fnow(:,:,jk  ), 'T', 'en->i', utmp(:,:) )
+                           CALL rot_rep( sd(ju)%fnow(:,:,jk  ), sd(iv)%fnow(:,:,jk  ), 'T', 'en->j', vtmp(:,:) )
+                           sd(ju)%fnow(:,:,jk   ) = utmp(:,:)   ;   sd(iv)%fnow(:,:,jk   ) = vtmp(:,:)
+                        ENDIF
+                     END DO
+                     sd(ju)%rotn(jn) = .TRUE.               ! vector was rotated
+                     IF( lwp .AND. kt == nit000 )   WRITE(numout,*)   &
+                        &   'fld_read: vector pair ('//TRIM(sd(ju)%clvar)//', '//TRIM(sd(iv)%clvar)//') rotated on to model grid'
+                  ENDIF
+               ENDIF
+            ENDIF
+         END DO
+         IF( ill > 0 .AND. .NOT. sd(ju)%rotn ) THEN   ! find vector rotations required
+             IF( sd(ju)%vcomp(1:1) == 'U' ) THEN      ! east-west component has symbolic name starting with 'U'
+                ! look for the north-south component which has same symbolic name but with 'U' replaced with 'V'
+                clcomp = 'V' // sd(ju)%vcomp(2:ill)   ! works even if ill == 1
+                iv = -1
+                DO jv = 1, imf
+                  IF( TRIM(sd(jv)%vcomp) == TRIM(clcomp) )   iv = jv
+                END DO
+                IF( iv > 0 ) THEN   ! fields ju and iv are two components which need to be rotated together
+                   DO jk = 1, SIZE( sd(ju)%fnow, 3 )
+                      IF( sd(ju)%ln_tint )THEN
+                         CALL rot_rep( sd(ju)%fdta(:,:,jk,2), sd(iv)%fdta(:,:,jk,2), 'T', 'en->i', utmp(:,:) )
+                         CALL rot_rep( sd(ju)%fdta(:,:,jk,2), sd(iv)%fdta(:,:,jk,2), 'T', 'en->j', vtmp(:,:) )
+                         sd(ju)%fdta(:,:,jk,2) = utmp(:,:)   ;   sd(iv)%fdta(:,:,jk,2) = vtmp(:,:)
+                      ELSE
+                         CALL rot_rep( sd(ju)%fnow(:,:,jk  ), sd(iv)%fnow(:,:,jk  ), 'T', 'en->i', utmp(:,:) )
+                         CALL rot_rep( sd(ju)%fnow(:,:,jk  ), sd(iv)%fnow(:,:,jk  ), 'T', 'en->j', vtmp(:,:) )
+                         sd(ju)%fnow(:,:,jk  ) = utmp(:,:)   ;   sd(iv)%fnow(:,:,jk  ) = vtmp(:,:)
+                      ENDIF
+                   END DO
+                   sd(ju)%rotn = .TRUE.               ! vector was rotated
+                   IF( lwp .AND. kt == nit000 )   WRITE(numout,*)   &
+                      &   'fld_read: vector pair ('//TRIM(sd(ju)%clvar)//', '//TRIM(sd(iv)%clvar)//') rotated on to model grid'
+                ENDIF
+             ENDIF
+          ENDIF
        END DO
+      !
 …
       !!----------------------------------------------------------------------
       TYPE(FLD)        , INTENT(inout) ::   sdjf     ! input field related variables
       INTEGER, OPTIONAL, INTENT(in   ) ::   kyear    ! year value
       INTEGER, OPTIONAL, INTENT(in   ) ::   kmonth   ! month value
       INTEGER, OPTIONAL, INTENT(in   ) ::   kday     ! day value
+      INTEGER          , INTENT(in   ) ::   kyear    ! year value
+      INTEGER          , INTENT(in   ) ::   kmonth   ! month value
+      INTEGER          , INTENT(in   ) ::   kday     ! day value
       LOGICAL, OPTIONAL, INTENT(in   ) ::   ldstop   ! stop if open to read a non-existing file (default = .TRUE.)
+      !!
+      LOGICAL :: llprevyr              ! are we reading previous year  file?
+      LOGICAL :: llprevmth             ! are we reading previous month file?
+      INTEGER :: iyear, imonth, iday   ! first day of the current file in yyyy mm dd
+      INTEGER :: isec_week             ! number of seconds since start of the weekly file
+      INTEGER :: indexyr               ! year undex (O/1/2: previous/current/next)
+      INTEGER :: iyear_len, imonth_len ! length (days) of iyear and imonth             !
+      CHARACTER(len = 256)::   clname  ! temporary file name
+      !!----------------------------------------------------------------------
+      IF( PRESENT(kyear) ) THEN                             ! use given values
+         iyear = kyear
+         imonth = kmonth
+         iday = kday
+      ELSE                                                  ! use current day values
+         IF ( sdjf%cltype(1:4) == 'week' ) THEN             ! find the day of the beginning of the week
+            isec_week  = ksec_week( sdjf%cltype(6:8) )      ! second since the beginning of the week
+            llprevmth  = isec_week > nsec_month             ! longer time since beginning of the week than the month
+            llprevyr   = llprevmth .AND. nmonth == 1
+         ELSE
+            isec_week  = 0
+            llprevmth  = .FALSE.
+            llprevyr   = .FALSE.
+         ENDIF
+         iyear  = nyear  - COUNT((/llprevyr /))
+         imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /))
+         iday   = nday   + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday)
+      ENDIF
+      !!----------------------------------------------------------------------
+      IF( sdjf%num /= 0 )   CALL iom_close( sdjf%num )   ! close file if already open
       ! build the new filename if not climatological data
       clname=TRIM(sdjf%clrootname)
+      !
       ! note that sdjf%ln_clim is is only acting on the presence of the year in the file name
+      sdjf%clname=TRIM(sdjf%clrootname)
+      !
+      ! note that sdjf%ln_clim is is only acting on presence of the year in the file
       IF( .NOT. sdjf%ln_clim ) THEN
                                          WRITE(clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), iyear    ! add year
          IF( sdjf%cltype /= 'yearly' )   WRITE(clname, '(a,"m" ,i2.2)' ) TRIM( clname          ), imonth   ! add month
+                                         WRITE(sdjf%clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear    ! add year
+         IF( sdjf%cltype /= 'yearly' )   WRITE(sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname     ), kmonth   ! add month
       ELSE
          ! build the new filename if climatological data
          IF( sdjf%cltype /= 'yearly' )   WRITE(clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), imonth   ! add month
+         IF( sdjf%cltype /= 'yearly' )   WRITE(sdjf%clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), kmonth   ! add month
       ENDIF
       IF( sdjf%cltype == 'daily' .OR. sdjf%cltype(1:4) == 'week' ) &
+            &                            WRITE(clname, '(a,"d" ,i2.2)' ) TRIM( clname          ), iday     ! add day
+      !
+      IF( TRIM(clname) /= TRIM(sdjf%clname) .OR. sdjf%num == 0 ) THEN   ! new file to be open
+         sdjf%clname = TRIM(clname)
+         IF( sdjf%num /= 0 )   CALL iom_close( sdjf%num )   ! close file if already open
+         CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof =  LEN(TRIM(sdjf%wgtname)) > 0 )
+         ! find the last record to be read -> update sdjf%nreclast
+         indexyr = iyear - nyear + 1
+         iyear_len = nyear_len( indexyr )
+         SELECT CASE ( indexyr )
+         CASE ( 0 )   ;   imonth_len = 31   ! previous year -> imonth = 12
+         CASE ( 1 )   ;   imonth_len = nmonth_len(imonth)
+         CASE ( 2 )   ;   imonth_len = 31   ! next     year -> imonth = 1
+         END SELECT
+         ! last record to be read in the current file
+         IF    ( sdjf%nfreqh == -12 ) THEN                 ;   sdjf%nreclast = 1    !  yearly mean
+         ELSEIF( sdjf%nfreqh ==  -1 ) THEN                                          ! monthly mean
+            IF(     sdjf%cltype      == 'monthly' ) THEN   ;   sdjf%nreclast = 1
+            ELSE                                           ;   sdjf%nreclast = 12
+            ENDIF
+         ELSE                                                                       ! higher frequency mean (in hours)
+            IF(     sdjf%cltype      == 'monthly' ) THEN   ;   sdjf%nreclast = 24 * imonth_len / sdjf%nfreqh
+            ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ;   sdjf%nreclast = 24 * 7          / sdjf%nfreqh
+            ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ;   sdjf%nreclast = 24              / sdjf%nfreqh
+            ELSE                                           ;   sdjf%nreclast = 24 * iyear_len  / sdjf%nfreqh
+            ENDIF
+         ENDIF
+      ENDIF
+      !
+            &                            WRITE(sdjf%clname, '(a,"d" ,i2.2)' ) TRIM( sdjf%clname     ), kday     ! add day
+      !
+      CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof =  LEN(TRIM(sdjf%wgtname)) > 0 )
+     !
    END SUBROUTINE fld_clopn
 …
       DO jf = 1, SIZE(sdf)
          sdf(jf)%clrootname = TRIM( cdir )//TRIM( sdf_n(jf)%clname )
-         sdf(jf)%clname     = "not yet defined"
          sdf(jf)%nfreqh     = sdf_n(jf)%nfreqh
          sdf(jf)%clvar      = sdf_n(jf)%clvar
 …
          sdf(jf)%ln_clim    = sdf_n(jf)%ln_clim
          sdf(jf)%cltype     = sdf_n(jf)%cltype
+         sdf(jf)%num        = -1
+         sdf(jf)%wgtname    = " "
+         sdf(jf)%wgtname = " "
          IF( LEN( TRIM(sdf_n(jf)%wname) ) > 0 )   sdf(jf)%wgtname = TRIM( cdir )//TRIM( sdf_n(jf)%wname )
+         sdf(jf)%vcomp      = sdf_n(jf)%vcomp
+         sdf(jf)%rotn(:)    = .TRUE.   ! pretend to be rotated -> won't try to rotate data before the first call to fld_get
+         IF( sdf(jf)%cltype(1:4) == 'week' .AND. nn_leapy == 0  )   &
+            &   CALL ctl_stop('fld_clopn: weekly file ('//TRIM(sdf(jf)%clrootname)//') needs nn_leapy = 1')
+         IF( sdf(jf)%cltype(1:4) == 'week' .AND. sdf(jf)%ln_clim )   &
+            &   CALL ctl_stop('fld_clopn: weekly file ('//TRIM(sdf(jf)%clrootname)//') needs ln_clim = .FALSE.')
+         sdf(jf)%vcomp   = sdf_n(jf)%vcomp
+         sdf(jf)%rotn    = .TRUE.
       END DO

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90

-                      r3625
+                      r6736
    ! finally, arrays corresponding to different ice categories
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i                !: category ice fraction
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   topmelt            !: category topmelt
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   botmelt            !: category botmelt
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   topmelt           !: category topmelt
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   botmelt           !: category botmelt
 #endif

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

-                      r3680
+                      r6736
    LOGICAL , PUBLIC ::   ln_ssr      = .FALSE.   !: Sea Surface restoring on SST and/or SSS
    LOGICAL , PUBLIC ::   ln_apr_dyn  = .FALSE.   !: Atmospheric pressure forcing used on dynamics (ocean & ice)
+   LOGICAL , PUBLIC ::   ln_icebergs = .FALSE.   !: Icebergs
+   INTEGER , PUBLIC ::   nn_ice      = 0         !: flag for ice in the surface boundary condition (=0/1/2/3)
+   INTEGER , PUBLIC ::   nn_ice_embd = 0         !: flag for levitating/embedding sea-ice in the ocean
+   !                                             !: =0 levitating ice (no mass exchange, concentration/dilution effect)
+   !                                             !: =1 levitating ice with mass and salt exchange but no presure effect
+   !                                             !: =2 embedded sea-ice (full salt and mass exchanges and pressure)
+   INTEGER , PUBLIC ::   nn_ice      = 0         !: flag on ice in the surface boundary condition (=0/1/2/3)
    INTEGER , PUBLIC ::   nn_fwb      = 0         !: FreshWater Budget:
    !                                             !:  = 0 unchecked
    !                                             !:  = 1 global mean of e-p-r set to zero at each nn_fsbc time step
    !                                             !:  = 2 annual global mean of e-p-r set to zero
+   LOGICAL , PUBLIC ::   ln_wave     = .FALSE.   !: true if some coupling with wave model
+   LOGICAL , PUBLIC ::   ln_cdgw     = .FALSE.   !: true if neutral drag coefficient from wave model
+   LOGICAL , PUBLIC ::   ln_sdw      = .FALSE.   !: true if 3d stokes drift from wave model
+   LOGICAL , PUBLIC ::   ln_cdgw     = .FALSE.   !: true if neutral drag coefficient read from wave model
    !!----------------------------------------------------------------------
 …
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qns_tot           !: total non solar heat flux (over sea and ice) [W/m2]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emp    , emp_b    !: freshwater budget: volume flux               [Kg/m2/s]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx    , sfx_b    !: salt flux                                    [PSU/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emps   , emps_b   !: freshwater budget: concentration/dillution   [Kg/m2/s]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emp_tot           !: total E-P over ocean and ice                 [Kg/m2/s]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rnf    , rnf_b    !: river runoff   [Kg/m2/s]
 …
          &      vtau(jpi,jpj) , vtau_b(jpi,jpj) , wndm(jpi,jpj) , STAT=ierr(1) )
+         !
       ALLOCATE( qns_tot(jpi,jpj) , qns  (jpi,jpj) , qns_b(jpi,jpj),        &
          &      qsr_tot(jpi,jpj) , qsr  (jpi,jpj) ,                        &
          &      emp    (jpi,jpj) , emp_b(jpi,jpj) ,                        &
          &      sfx    (jpi,jpj) , sfx_b(jpi,jpj) , emp_tot(jpi,jpj) , STAT=ierr(2) )
+      ALLOCATE( qns_tot(jpi,jpj) , qns   (jpi,jpj) , qns_b(jpi,jpj),        &
+         &      qsr_tot(jpi,jpj) , qsr   (jpi,jpj) ,                        &
+         &      emp    (jpi,jpj) , emp_b (jpi,jpj) ,                        &
+         &      emps   (jpi,jpj) , emps_b(jpi,jpj) , emp_tot(jpi,jpj) , STAT=ierr(2) )
+         !
       ALLOCATE( rnf  (jpi,jpj) , sbc_tsc  (jpi,jpj,jpts) , qsr_hc  (jpi,jpj,jpk) ,     &

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90

-                      r3625
+                      r6736
       !!
       !! ** Action  : - set the ocean surface boundary condition, i.e.
       !!                   utau, vtau, taum, wndm, qns, qsr, emp
+      !!                   utau, vtau, taum, wndm, qns, qsr, emp, emps
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt       ! ocean time step
 …
          nn_tau000 = MAX( nn_tau000, 1 )     ! must be >= 1
+         !
+         qns (:,:) = rn_qns0
+         qsr (:,:) = rn_qsr0
          emp (:,:) = rn_emp0
+         sfx (:,:) = 0.0_wp
+         qns (:,:) = rn_qns0 - emp(:,:) * sst_m(:,:) * rcp      ! including heat content associated with mass flux at SST
+         qsr (:,:) = rn_qsr0
+         emps(:,:) = rn_emp0
+         !
          utau(:,:) = rn_utau0
 …
       !!
       !! ** Action  : - set the ocean surface boundary condition, i.e.
       !!                   utau, vtau, taum, wndm, qns, qsr, emp, sfx
+      !!                   utau, vtau, taum, wndm, qns, qsr, emp, emps
       !!
       !! Reference : Hazeleger, W., and S. Drijfhout, JPO, 30, 677-695, 2000.
 …
          END DO
       END DO
+      emps(:,:) = emp(:,:)
       ! Compute the emp flux such as its integration on the whole domain at each time is zero
 …
       ENDIF
+      ! freshwater (mass flux) and update of qns with heat content of emp
+      emp (:,:) = emp(:,:) - zsumemp * tmask(:,:,1)        ! freshwater flux (=0 in domain average)
+      sfx (:,:) = 0.0_wp                                   ! no salt flux
+      qns (:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp   ! evap and precip are at SST
+      !salinity terms
+      emp (:,:) = emp(:,:) - zsumemp * tmask(:,:,1)
+      emps(:,:) = emp(:,:)

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90

-                      r3795
+                      r6736
    USE iom             ! IOM library
    USE lib_mpp         ! MPP library
+   USE restart         ! ocean restart
    IMPLICIT NONE
 …
    PUBLIC   sbc_apr    ! routine called in sbcmod
+   !                                              !!* namsbc_apr namelist (Atmospheric PRessure) *
+   LOGICAL, PUBLIC ::   ln_apr_obc = .FALSE.      !: inverse barometer added to OBC ssh data
+   LOGICAL, PUBLIC ::   ln_ref_apr = .FALSE.      !: ref. pressure: global mean Patm (F) or a constant (F)
+   REAL(wp)        ::   rn_pref    = 101000._wp   !  reference atmospheric pressure   [N/m2]
+   !                                         !!* namsbc_apr namelist (Atmospheric PRessure) *
+   LOGICAL, PUBLIC ::   ln_apr_obc = .FALSE.  !: inverse barometer added to OBC ssh data
+   LOGICAL, PUBLIC ::   ln_ref_apr = .FALSE.  !: ref. pressure: global mean Patm (F) or a constant (F)
    REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   ssh_ib    ! Inverse barometer now    sea surface height   [m]
 …
    REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   apr       ! atmospheric pressure at kt                 [N/m2]
+   REAL(wp) ::   rpref = 101000._wp   ! reference atmospheric pressure          [N/m2]
    REAL(wp) ::   tarea                ! whole domain mean masked ocean surface
    REAL(wp) ::   r1_grau              ! = 1.e0 / (grav * rau0)
 …
       !!
       INTEGER            ::   ierror  ! local integer
+      REAL(wp)           ::   zpref   ! local scalar
       !!
       CHARACTER(len=100) ::  cn_dir   ! Root directory for location of ssr files
       TYPE(FLD_N)        ::  sn_apr   ! informations about the fields to be read
       !!
       NAMELIST/namsbc_apr/ cn_dir, sn_apr, ln_ref_apr, rn_pref, ln_apr_obc
+      NAMELIST/namsbc_apr/ cn_dir, sn_apr, ln_ref_apr
       !!----------------------------------------------------------------------
+      !
 …
+         !
          IF( ln_ref_apr ) THEN                        !* Compute whole inner domain mean masked ocean surface
             tarea = glob_sum( e1e2t(:,:) )
+            tarea = glob_sum( e1t(:,:) * e2t(:,:) )
             IF(lwp) WRITE(numout,*) '         Variable ref. Patm computed over a ocean surface of ', tarea*1e-6, 'km2'
          ELSE
             IF(lwp) WRITE(numout,*) '         Reference Patm used : ', rn_pref, ' N/m2'
+            IF(lwp) WRITE(numout,*) '         Reference Patm used : ', rpref, ' N/m2'
          ENDIF
+         !
 …
+         !
          !                                            !* control check
+         IF ( ln_apr_obc  ) THEN
+            IF(lwp) WRITE(numout,*) '         Inverse barometer added to OBC ssh data'
+         ENDIF
+         IF( ln_apr_obc  )   &
+            CALL ctl_stop( 'sbc_apr: inverse barometer added to OBC ssh data not yet implemented ' )
+         IF( ln_apr_obc .AND. .NOT. lk_obc )   &
+            CALL ctl_stop( 'sbc_apr: add inverse barometer to OBC requires to use key_obc' )
          IF( ( ln_apr_obc ) .AND. .NOT. lk_dynspg_ts )   &
             CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY possible with time-splitting' )
 …
+         !
          !                                                  !* update the reference atmospheric pressure (if necessary)
          IF( ln_ref_apr )   rn_pref = glob_sum( sf_apr(1)%fnow(:,:,1) * e1e2t(:,:) ) / tarea
+         IF( ln_ref_apr )   rpref = glob_sum( sf_apr(1)%fnow(:,:,1) * e1t(:,:) * e2t(:,:) ) / tarea
+         !
          !                                                  !* Patm related forcing at kt
          ssh_ib(:,:) = - ( sf_apr(1)%fnow(:,:,1) - rn_pref ) * r1_grau    ! equivalent ssh (inverse barometer)
+         ssh_ib(:,:) = - ( sf_apr(1)%fnow(:,:,1) - rpref ) * r1_grau    ! equivalent ssh (inverse barometer)
          apr   (:,:) =     sf_apr(1)%fnow(:,:,1)                        ! atmospheric pressure
+         !

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90

-                      r3625
+                      r6736
    !!----------------------------------------------------------------------
    !!   sbc_blk_clio     : CLIO bulk formulation: read and update required input fields
    !!   blk_clio_oce     : ocean CLIO bulk formulea: compute momentum, heat and freswater fluxes for the ocean
    !!   blk_ice_clio     : ice   CLIO bulk formulea: compute momentum, heat and freswater fluxes for the sea-ice
+   !!   sbc_blk_clio   : CLIO bulk formulation: read and update required input fields
+   !!   blk_clio_oce   : ocean CLIO bulk formulea: compute momentum, heat and freswater fluxes for the ocean
+   !!   blk_ice_clio   : ice   CLIO bulk formulea: compute momentum, heat and freswater fluxes for the sea-ice
    !!   blk_clio_qsr_oce : shortwave radiation for ocean computed from the cloud cover
    !!   blk_clio_qsr_ice : shortwave radiation for ice   computed from the cloud cover
    !!   flx_blk_declin   : solar declination
+   !!   flx_blk_declin : solar declinaison
    !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE fldread        ! read input fields
+   USE sbc_oce        ! Surface boundary condition: ocean fields
+   USE iom            ! I/O manager library
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! distribued memory computing library
+   USE wrk_nemo       ! work arrays
+   USE timing         ! Timing
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE fldread         ! read input fields
+   USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE iom             ! I/O manager library
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distribued memory computing library
+   USE wrk_nemo        ! work arrays
+   USE timing          ! Timing
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE albedo
    USE prtctl          ! Print control
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
 #if defined key_lim3
    USE ice
 …
    INTEGER , PARAMETER ::   jp_vtau = 2           ! index of wind stress (j-component)      (N/m2)    at V-point
    INTEGER , PARAMETER ::   jp_wndm = 3           ! index of 10m wind module                 (m/s)    at T-point
    INTEGER , PARAMETER ::   jp_humi = 4           ! index of specific humidity               ( % )
    INTEGER , PARAMETER ::   jp_ccov = 5           ! index of cloud cover                     ( % )
+   INTEGER , PARAMETER ::   jp_humi = 4           ! index of specific humidity               ( - )
+   INTEGER , PARAMETER ::   jp_ccov = 5           ! index of cloud cover                     ( - )
    INTEGER , PARAMETER ::   jp_tair = 6           ! index of 10m air temperature             (Kelvin)
    INTEGER , PARAMETER ::   jp_prec = 7           ! index of total precipitation (rain+snow) (Kg/m2/s)
 …
       !!      the i-component of the stress                (N/m2)
       !!      the j-component of the stress                (N/m2)
       !!      the 10m wind speed module                    (m/s)
+      !!      the 10m wind pseed module                    (m/s)
       !!      the 10m air temperature                      (Kelvin)
       !!      the 10m specific humidity                    (%)
       !!      the cloud cover                              (%)
+      !!      the 10m specific humidity                    (-)
+      !!      the cloud cover                              (-)
       !!      the total precipitation (rain+snow)          (Kg/m2/s)
       !!              (2) CALL blk_oce_clio
       !!
       !!      C A U T I O N : never mask the surface stress fields
+      !!                      the stress is assumed to be in the (i,j) mesh referential
+      !!                      the stress is assumed to be in the mesh referential
+      !!                      i.e. the (i,j) referential
       !!
       !! ** Action  :   defined at each time-step at the air-sea interface
 …
       !!              - taum        wind stress module at T-point
       !!              - wndm        10m wind module at T-point
+      !!              - qns         non-solar heat flux including latent heat of solid
+      !!                            precip. melting and emp heat content
+      !!              - qsr         solar heat flux
+      !!              - emp         upward mass flux (evap. - precip)
+      !!              - sfx         salt flux; set to zero at nit000 but possibly non-zero
+      !!                            if ice is present (computed in limsbc(_2).F90)
+      !!              - qns, qsr    non-slor and solar heat flux
+      !!              - emp, emps   evaporation minus precipitation
       !!----------------------------------------------------------------------
       INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
       !!
       INTEGER  ::   ifpr, jfpr   ! dummy indices
 …
          ALLOCATE( sbudyko(jpi,jpj) , stauc(jpi,jpj), STAT=ierr3 )
          IF( ierr3 > 0 )   CALL ctl_stop( 'STOP', 'sbc_blk_clio: unable to allocate arrays' )
+         !
-         sfx(:,:) = 0._wp                       ! salt flux; zero unless ice is present (computed in limsbc(_2).F90)
+         !
       ENDIF
 …
       !!               - taum        wind stress module at T-point
       !!               - wndm        10m wind module at T-point
+      !!               - qns         non-solar heat flux including latent heat of solid
+      !!                             precip. melting and emp heat content
+      !!               - qsr         solar heat flux
+      !!               - emp         suface mass flux (evap.-precip.)
+      !!               - qns, qsr    non-slor and solar heat flux
+      !!               - emp, emps   evaporation minus precipitation
       !!  ** Nota    :   sf has to be a dummy argument for AGRIF on NEC
       !!----------------------------------------------------------------------
 …
       REAL(wp) ::   zsst, ztatm, zcco1, zpatm, zcmax, zrmax     !    -         -
       REAL(wp) ::   zrhoa, zev, zes, zeso, zqatm, zevsqr        !    -         -
       REAL(wp) ::   ztx2, zty2, zcevap, zcprec                  !    -         -
+      REAL(wp) ::   ztx2, zty2                                  !    -         -
       REAL(wp), POINTER, DIMENSION(:,:) ::   zqlw        ! long-wave heat flux over ocean
       REAL(wp), POINTER, DIMENSION(:,:) ::   zqla        ! latent heat flux over ocean
 …
       !     III    Total FLUXES                                                       !
       ! ----------------------------------------------------------------------------- !
+      zcevap = rcp /  cevap    ! convert zqla ==> evap (Kg/m2/s) ==> m/s ==> W/m2
+      zcprec = rcp /  rday     ! convert prec ( mm/day ==> m/s)  ==> W/m2
+!CDIR COLLAPSE
+      emp(:,:) = zqla(:,:) / cevap                                        &   ! freshwater flux
+         &     - sf(jp_prec)%fnow(:,:,1) / rday * tmask(:,:,1)
+      !
+!CDIR COLLAPSE
+      qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                        &   ! Downward Non Solar flux
+         &     - zqla(:,:)             * pst(:,:) * zcevap                &   ! remove evap.   heat content at SST in Celcius
+         &     + sf(jp_prec)%fnow(:,:,1) * sf(jp_tair)%fnow(:,:,1) * zcprec   ! add    precip. heat content at Tair in Celcius
+      ! NB: if sea-ice model, the snow precip are computed and the associated heat is added to qns (see blk_ice_clio)
+!CDIR COLLAPSE
+      emp (:,:) = zqla(:,:) / cevap - sf(jp_prec)%fnow(:,:,1) / rday * tmask(:,:,1)
+      qns (:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)         ! Downward Non Solar flux
+      emps(:,:) = emp(:,:)
+      !
       CALL iom_put( "qlw_oce",   zqlw )   ! output downward longwave  heat over the ocean
       CALL iom_put( "qsb_oce", - zqsb )   ! output downward sensible  heat over the ocean
 …
       !!
       !!  ** Action  :   call albedo_oce/albedo_ice to compute ocean/ice albedo
+      !!               - snow precipitation
+      !!               - solar flux at the ocean and ice surfaces
+      !!               - the long-wave radiation for the ocean and sea/ice
+      !!               - turbulent heat fluxes over water and ice
+      !!               - evaporation over water
+      !!               - total heat fluxes sensitivity over ice (dQ/dT)
+      !!               - latent heat flux sensitivity over ice (dQla/dT)
+      !!               - qns  :  modified the non solar heat flux over the ocean
+      !!                         to take into account solid precip latent heat flux
+      !!          computation of snow precipitation
+      !!          computation of solar flux at the ocean and ice surfaces
+      !!          computation of the long-wave radiation for the ocean and sea/ice
+      !!          computation of turbulent heat fluxes over water and ice
+      !!          computation of evaporation over water
+      !!          computation of total heat fluxes sensitivity over ice (dQ/dT)
+      !!          computation of latent heat flux sensitivity over ice (dQla/dT)
+      !!
       !!----------------------------------------------------------------------
       REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   pst      ! ice surface temperature                   [Kelvin]
 …
+      !
       ! ----------------------------------------------------------------------------- !
       !    Total FLUXES                                                               !
+      !    Total FLUXES                                                       !
       ! ----------------------------------------------------------------------------- !
+      !
 …
 !CDIR COLLAPSE
       p_tpr(:,:)   = sf(jp_prec)%fnow(:,:,1) / rday                     ! total precipitation [kg/m2/s]
+      !
-      ! ----------------------------------------------------------------------------- !
-      !    Correct the OCEAN non solar flux with the existence of solid precipitation !
-      ! ---------------=====--------------------------------------------------------- !
-!CDIR COLLAPSE
-      qns(:,:) = qns(:,:)                                                           &   ! update the non-solar heat flux with:
-         &     - p_spr(:,:) * lfus                                                  &   ! remove melting solid precip
-         &     + p_spr(:,:) * MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow - rt0 ) * cpic &   ! add solid P at least below melting
-         &     - p_spr(:,:) * sf(jp_tair)%fnow(:,:,1)                        * rcp      ! remove solid precip. at Tair
+      !
 !!gm : not necessary as all input data are lbc_lnk...

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

-                      r3772
+                      r6736
    USE fldread         ! read input fields
    USE sbc_oce         ! Surface boundary condition: ocean fields
-   USE cyclone         ! Cyclone 10m wind form trac of cyclone centres
    USE sbcdcy          ! surface boundary condition: diurnal cycle
    USE iom             ! I/O manager library
 …
    INTEGER , PARAMETER ::   jp_wndi = 1           ! index of 10m wind velocity (i-component) (m/s)    at T-point
    INTEGER , PARAMETER ::   jp_wndj = 2           ! index of 10m wind velocity (j-component) (m/s)    at T-point
    INTEGER , PARAMETER ::   jp_humi = 3           ! index of specific humidity               ( % )
+   INTEGER , PARAMETER ::   jp_humi = 3           ! index of specific humidity               ( - )
    INTEGER , PARAMETER ::   jp_qsr  = 4           ! index of solar heat                      (W/m2)
    INTEGER , PARAMETER ::   jp_qlw  = 5           ! index of Long wave                       (W/m2)
 …
    REAL(wp), PARAMETER ::   Stef =    5.67e-8     ! Stefan Boltzmann constant
    REAL(wp), PARAMETER ::   Cice =    1.63e-3     ! transfer coefficient over ice
    REAL(wp), PARAMETER ::   albo =    0.066       ! ocean albedo assumed to be constant
+   REAL(wp), PARAMETER ::   albo =    0.066       ! ocean albedo assumed to be contant
    !                                  !!* Namelist namsbc_core : CORE bulk parameters
 …
       !!      the 10m wind velocity (i-component) (m/s)    at T-point
       !!      the 10m wind velocity (j-component) (m/s)    at T-point
       !!      the 10m or 2m specific humidity     ( % )
+      !!      the specific humidity               ( - )
       !!      the solar heat                      (W/m2)
       !!      the Long wave                       (W/m2)
       !!      the 10m or 2m air temperature       (Kelvin)
+      !!      the 10m air temperature             (Kelvin)
       !!      the total precipitation (rain+snow) (Kg/m2/s)
       !!      the snow (solid prcipitation)       (kg/m2/s)
+      !!      the tau diff associated to HF tau   (N/m2)   at T-point   (ln_taudif=T)
+      !!   OPTIONAL parameter (see ln_taudif namelist flag):
+      !!      the tau diff associated to HF tau   (N/m2)   at T-point
       !!              (2) CALL blk_oce_core
       !!
       !!      C A U T I O N : never mask the surface stress fields
+      !!                      the stress is assumed to be in the (i,j) mesh referential
+      !!                      the stress is assumed to be in the mesh referential
+      !!                      i.e. the (i,j) referential
       !!
       !! ** Action  :   defined at each time-step at the air-sea interface
       !!              - utau, vtau  i- and j-component of the wind stress
+      !!              - taum, wndm  wind stress and 10m wind modules at T-point
+      !!              - qns, qsr    non-solar and solar heat fluxes
+      !!              - emp         upward mass flux (evapo. - precip.)
+      !!              - sfx         salt flux due to freezing/melting (non-zero only if ice is present)
+      !!                            (set in limsbc(_2).F90)
+      !!              - taum        wind stress module at T-point
+      !!              - wndm        10m wind module at T-point
+      !!              - qns, qsr    non-slor and solar heat flux
+      !!              - emp, emps   evaporation minus precipitation
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! ocean time step
 …
       CHARACTER(len=100) ::  cn_dir   !   Root directory for location of core files
       TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i     ! array of namelist informations on the fields to read
+      TYPE(FLD_N) ::   sn_wndi, sn_wndj, sn_humi, sn_qsr             ! informations about the fields to be read
+      TYPE(FLD_N) ::   sn_qlw , sn_tair, sn_prec, sn_snow, sn_tdif   !       -                       -
+      TYPE(FLD_N) ::   sn_wndi, sn_wndj, sn_humi, sn_qsr       ! informations about the fields to be read
+      TYPE(FLD_N) ::   sn_qlw , sn_tair, sn_prec, sn_snow      !   "                                 "
+      TYPE(FLD_N) ::   sn_tdif                                 !   "                                 "
       NAMELIST/namsbc_core/ cn_dir , ln_2m  , ln_taudif, rn_pfac,           &
          &                  sn_wndi, sn_wndj, sn_humi  , sn_qsr ,           &
 …
          CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_core', 'flux formulation for ocean surface boundary condition', 'namsbc_core' )
+         !
+         sfx(:,:) = 0._wp                          ! salt flux; zero unless ice is present (computed in limsbc(_2).F90)
+         !
+      ENDIF
+      CALL fld_read( kt, nn_fsbc, sf )             ! input fields provided at the current time-step
+      !                                            ! compute the surface ocean fluxes using CORE bulk formulea
+      IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce_core( kt, sf, sst_m, ssu_m, ssv_m )
+      ENDIF
+      CALL fld_read( kt, nn_fsbc, sf )        ! input fields provided at the current time-step
+      !                                                        ! surface ocean fluxes computed with CLIO bulk formulea
+      IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce_core( sf, sst_m, ssu_m, ssv_m )
 #if defined key_cice
 …
    SUBROUTINE blk_oce_core( kt, sf, pst, pu, pv )
+   SUBROUTINE blk_oce_core( sf, pst, pu, pv )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE blk_core  ***
 …
       !!              - qns     : Non Solar heat flux over the ocean    (W/m2)
       !!              - evap    : Evaporation over the ocean            (kg/m2/s)
       !!              - emp     : evaporation minus precipitation       (kg/m2/s)
+      !!              - emp(s)  : evaporation minus precipitation       (kg/m2/s)
       !!
       !!  ** Nota  :   sf has to be a dummy argument for AGRIF on NEC
       !!---------------------------------------------------------------------
+      INTEGER  , INTENT(in   )                 ::   kt    ! time step index
+      TYPE(fld), INTENT(inout), DIMENSION(:)   ::   sf    ! input data
+      REAL(wp) , INTENT(in)   , DIMENSION(:,:) ::   pst   ! surface temperature                      [Celcius]
+      REAL(wp) , INTENT(in)   , DIMENSION(:,:) ::   pu    ! surface current at U-point (i-component) [m/s]
+      REAL(wp) , INTENT(in)   , DIMENSION(:,:) ::   pv    ! surface current at V-point (j-component) [m/s]
+      TYPE(fld), INTENT(in), DIMENSION(:)   ::   sf    ! input data
+      REAL(wp) , INTENT(in), DIMENSION(:,:) ::   pst   ! surface temperature                      [Celcius]
+      REAL(wp) , INTENT(in), DIMENSION(:,:) ::   pu    ! surface current at U-point (i-component) [m/s]
+      REAL(wp) , INTENT(in), DIMENSION(:,:) ::   pv    ! surface current at V-point (j-component) [m/s]
+      !
       INTEGER  ::   ji, jj               ! dummy loop indices
 …
       zcoef_qsatw = 0.98 * 640380. / rhoa
       zst(:,:) = pst(:,:) + rt0      ! convert SST from Celcius to Kelvin (and set minimum value far above 0 K)
+      zst(:,:) = pst(:,:) + rt0      ! converte Celcius to Kelvin (and set minimum value far above 0 K)
       ! ----------------------------------------------------------------------------- !
 …
       zwnd_i(:,:) = 0.e0
       zwnd_j(:,:) = 0.e0
-#if defined key_cyclone
-# if defined key_vectopt_loop
-!CDIR COLLAPSE
-# endif
-      CALL wnd_cyc( kt, zwnd_i, zwnd_j )    ! add Manu !
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vect. opt.
-            sf(jp_wndi)%fnow(ji,jj,1) = sf(jp_wndi)%fnow(ji,jj,1) + zwnd_i(ji,jj)
-            sf(jp_wndj)%fnow(ji,jj,1) = sf(jp_wndj)%fnow(ji,jj,1) + zwnd_j(ji,jj)
-         END DO
-      END DO
-#endif
 #if defined key_vectopt_loop
 !CDIR COLLAPSE
 …
 !CDIR COLLAPSE
+      emp (:,:) = (  zevap(:,:)                                          &   ! mass flux (evap. - precip.)
+         &         - sf(jp_prec)%fnow(:,:,1) * rn_pfac  ) * tmask(:,:,1)
+!CDIR COLLAPSE
+      qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                &   ! Downward Non Solar flux
+         &     - sf(jp_snow)%fnow(:,:,1) * rn_pfac * lfus                         &   ! remove latent melting heat for solid precip
+         &     - zevap(:,:) * pst(:,:) * rcp                                      &   ! remove evap heat content at SST
+         &     + ( sf(jp_prec)%fnow(:,:,1) - sf(jp_snow)%fnow(:,:,1) ) * rn_pfac  &   ! add liquid precip heat content at Tair
+         &     * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp                          &
+         &     + sf(jp_snow)%fnow(:,:,1) * rn_pfac                                &   ! add solid  precip heat content at min(Tair,Tsnow)
+         &     * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic
+      qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)      ! Downward Non Solar flux
+!CDIR COLLAPSE
+      emp(:,:) = zevap(:,:) - sf(jp_prec)%fnow(:,:,1) * rn_pfac * tmask(:,:,1)
+!CDIR COLLAPSE
+      emps(:,:) = emp(:,:)
+      !
       CALL iom_put( "qlw_oce",   zqlw )                 ! output downward longwave heat over the ocean
       CALL iom_put( "qsb_oce", - zqsb )                 ! output downward sensible heat over the ocean
       CALL iom_put( "qla_oce", - zqla )                 ! output downward latent   heat over the ocean
-      CALL iom_put( "qhc_oce",   qns-zqlw+zqsb+zqla )   ! output downward heat content of E-P over the ocean
       CALL iom_put( "qns_oce",   qns  )                 ! output downward non solar heat over the ocean
+      !

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90

-                      r3625
+                      r6736
       !!              - wndm        10m wind module at T-point
       !!              - qns, qsr    non-slor and solar heat flux
       !!              - emp         evaporation minus precipitation
+      !!              - emp, emps   evaporation minus precipitation
       !!----------------------------------------------------------------------
       REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  sh_now   ! specific humidity at T-point
 …
            emp (:,:) = evap(:,:) - sf(jp_prec)%fnow(:,:,1) * tmask(:,:,1)
 !CDIR COLLAPSE
+           emps(:,:) = emp(:,:)
          CALL iom_put( "qlw_oce",   qbw  )                 ! output downward longwave heat over the ocean

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

-                      r3680
+                      r6736
 #endif
    USE geo2ocean       !
+   USE restart         !
    USE oce   , ONLY : tsn, un, vn
    USE albedo          !
 …
          &     srcv( (/jpr_otz1, jpr_otz2, jpr_itz1, jpr_itz2/) )%laction = .FALSE.
+      !
-      IF( TRIM( sn_rcv_tau%clvor  ) == 'local grid' ) THEN        ! already on local grid -> no need of the second grid
-            srcv(jpr_otx2:jpr_otz2)%laction = .FALSE.
-            srcv(jpr_itx2:jpr_itz2)%laction = .FALSE.
-            srcv(jpr_oty1)%clgrid = srcv(jpr_oty2)%clgrid   ! not needed but cleaner...
-            srcv(jpr_ity1)%clgrid = srcv(jpr_ity2)%clgrid   ! not needed but cleaner...
-      ENDIF
+      !
       IF( TRIM( sn_rcv_tau%cldes ) /= 'oce and ice' ) THEN        ! 'oce and ice' case ocean stress on ocean mesh used
          srcv(jpr_itx1:jpr_itz2)%laction = .FALSE.    ! ice components not received
 …
       ssnd(jps_tmix)%clname = 'O_TepMix'
       SELECT CASE( TRIM( sn_snd_temp%cldes ) )
-      CASE( 'none'         )       ! nothing to do
       CASE( 'oce only'             )   ;   ssnd(   jps_toce             )%laction = .TRUE.
       CASE( 'weighted oce and ice' )
 …
       SELECT CASE ( TRIM( sn_snd_thick%cldes ) )
+      CASE( 'none'         )       ! nothing to do
+      CASE( 'ice and snow' )
+      CASE ( 'ice and snow' )
          ssnd(jps_hice:jps_hsnw)%laction = .TRUE.
          IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN
 …
          ELSE
             IF ( jpl > 1 ) THEN
 CALL ctl_stop( 'sbc_cpl_init: use weighted ice and snow option for sn_snd_thick%cldes if not exchanging category fields' )
+               CALL ctl_stop( 'sbc_cpl_init: use weighted ice and snow option for sn_snd_thick%cldes if not exchanging category fields' )
             ENDIF
          ENDIF
 …
       !! ** Action  :   update  utau, vtau   ocean stress at U,V grid
       !!                        taum, wndm   wind stres and wind speed module at T-point
+      !!                        qns          non solar heat fluxes including emp heat content    (ocean only case)
+      !!                                     and the latent heat flux of solid precip. melting
+      !!                        qsr          solar ocean heat fluxes   (ocean only case)
+      !!                        emp          upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case)
+      !!                        qns , qsr    non solar and solar ocean heat fluxes   ('ocean only case)
+      !!                        emp = emps   evap. - precip. (- runoffs) (- calving) ('ocean only case)
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt       ! ocean model time step index
 …
          ! Stress module can be negative when received (interpolation problem)
          IF( llnewtau ) THEN
             frcv(jpr_taum)%z3(:,:,1) = MAX( 0._wp, frcv(jpr_taum)%z3(:,:,1) )
+            frcv(jpr_taum)%z3(:,:,1) = MAX( 0.0e0, frcv(jpr_taum)%z3(:,:,1) )
          ENDIF
       ENDIF
 …
          !                                                   ! ========================= !
+         !
+         !                                                       ! total freshwater fluxes over the ocean (emp)
+         !                                                       ! non solar heat flux over the ocean (qns)
+         IF( srcv(jpr_qnsoce)%laction )   qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)
+         IF( srcv(jpr_qnsmix)%laction )   qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
+         ! add the latent heat of solid precip. melting
+         IF( srcv(jpr_snow  )%laction )   qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus
+         !                                                       ! solar flux over the ocean          (qsr)
+         IF( srcv(jpr_qsroce)%laction )   qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1)
+         IF( srcv(jpr_qsrmix)%laction )   qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1)
+         IF( ln_dm2dc )   qsr(:,:) = sbc_dcy( qsr )                           ! modify qsr to include the diurnal cycle
+         !
+         !                                                       ! total freshwater fluxes over the ocean (emp, emps)
          SELECT CASE( TRIM( sn_rcv_emp%cldes ) )                                    ! evaporation - precipitation
          CASE( 'conservative' )
 …
 !!gm  end of internal cooking
+         !
+         !                                                       ! non solar heat flux over the ocean (qns)
+         IF( srcv(jpr_qnsoce)%laction )   qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)
+         IF( srcv(jpr_qnsmix)%laction )   qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
+         ! add the latent heat of solid precip. melting
+         IF( srcv(jpr_snow  )%laction )   THEN                         ! update qns over the free ocean with:
+              qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus  & ! energy for melting solid precipitation over the free ocean
+           &           - emp(:,:) * sst_m(:,:) * rcp                   ! remove heat content due to mass flux (assumed to be at SST)
+         ENDIF
+         !                                                       ! solar flux over the ocean          (qsr)
+         IF( srcv(jpr_qsroce)%laction )   qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1)
+         IF( srcv(jpr_qsrmix)%laction )   qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1)
+         IF( ln_dm2dc )   qsr(:,:) = sbc_dcy( qsr )                           ! modify qsr to include the diurnal cycle
+         !
+         emps(:,:) = emp(:,:)                                        ! concentration/dilution = emp
       ENDIF
 …
       zicefr(:,:) = 1.- p_frld(:,:)
       zcptn(:,:) = rcp * sst_m(:,:)
+      IF( lk_diaar5 )   zcptn(:,:) = rcp * tsn(:,:,1,jp_tem)
+      !
       !                                                      ! ========================= !
 …
             &                                                   +          pist(:,:,1)   * zicefr(:,:) ) )
       END SELECT
+      ztmp(:,:) = p_frld(:,:) * sprecip(:,:) * lfus
+      qns_tot(:,:) = qns_tot(:,:)                         &            ! qns_tot update over free ocean with:
+         &          - ztmp(:,:)                           &            ! remove the latent heat flux of solid precip. melting
+         &          - (  emp_tot(:,:)                     &            ! remove the heat content of mass flux (assumed to be at SST)
+         &             - emp_ice(:,:) * zicefr(:,:)  ) * zcptn(:,:)
+      ztmp(:,:) = p_frld(:,:) * sprecip(:,:) * lfus               ! add the latent heat of solid precip. melting
+      qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:)                     ! over free ocean
       IF( lk_diaar5 )   CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average)
 !!gm
 …
       !                                                      ! ========================= !
       CASE( 'oce only' )
          qsr_tot(:,:  ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) )
+         qsr_tot(:,:  ) = MAX(0.0,frcv(jpr_qsroce)%z3(:,:,1))
       CASE( 'conservative' )
          qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
 …
       !                                                      !    Surface temperature    !   in Kelvin
       !                                                      ! ------------------------- !
+      IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN
+         SELECT CASE( sn_snd_temp%cldes)
+         CASE( 'oce only'             )   ;   ztmp1(:,:) =   tsn(:,:,1,jp_tem) + rt0
+         CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:)
+            SELECT CASE( sn_snd_temp%clcat )
+            CASE( 'yes' )
+               ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
+            CASE( 'no' )
+               ztmp3(:,:,:) = 0.0
+               DO jl=1,jpl
+                  ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)
+               ENDDO
+            CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
+            END SELECT
+         CASE( 'mixed oce-ice'        )
+            ztmp1(:,:) = ( tsn(:,:,1,1) + rt0 ) * zfr_l(:,:)
+      SELECT CASE( sn_snd_temp%cldes)
+      CASE( 'oce only'             )   ;   ztmp1(:,:) =   tsn(:,:,1,jp_tem) + rt0
+      CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:)
+         SELECT CASE( sn_snd_temp%clcat )
+         CASE( 'yes' )
+            ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
+         CASE( 'no' )
+            ztmp3(:,:,:) = 0.0
             DO jl=1,jpl
                ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl)
+               ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)
             ENDDO
          CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' )
+         CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
          END SELECT
+         IF( ssnd(jps_toce)%laction )   CALL cpl_prism_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
+         IF( ssnd(jps_tice)%laction )   CALL cpl_prism_snd( jps_tice, isec, ztmp3, info )
+         IF( ssnd(jps_tmix)%laction )   CALL cpl_prism_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
+      ENDIF
+      CASE( 'mixed oce-ice'        )
+         ztmp1(:,:) = ( tsn(:,:,1,1) + rt0 ) * zfr_l(:,:)
+         DO jl=1,jpl
+            ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl)
+         ENDDO
+      CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' )
+      END SELECT
+      IF( ssnd(jps_toce)%laction )   CALL cpl_prism_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
+      IF( ssnd(jps_tice)%laction )   CALL cpl_prism_snd( jps_tice, isec, ztmp3, info )
+      IF( ssnd(jps_tmix)%laction )   CALL cpl_prism_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
+      !
       !                                                      ! ------------------------- !
 …
       !                                                      ! ------------------------- !
       ! Send ice fraction field
+      IF( ssnd(jps_fice)%laction ) THEN
+      SELECT CASE( sn_snd_thick%clcat )
+         CASE( 'yes' )
+            ztmp3(:,:,1:jpl) =  a_i(:,:,1:jpl)
+         CASE( 'no' )
+            ztmp3(:,:,1) = fr_i(:,:)
+      CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
+      END SELECT
+      IF( ssnd(jps_fice)%laction ) CALL cpl_prism_snd( jps_fice, isec, ztmp3, info )
+      ! Send ice and snow thickness field
+      SELECT CASE( sn_snd_thick%cldes)
+      CASE( 'weighted ice and snow' )
          SELECT CASE( sn_snd_thick%clcat )
+         CASE( 'yes' )   ;   ztmp3(:,:,1:jpl) =  a_i(:,:,1:jpl)
+         CASE( 'no'  )   ;   ztmp3(:,:,1    ) = fr_i(:,:      )
+         CASE default    ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
+         CASE( 'yes' )
+            ztmp3(:,:,1:jpl) =  ht_i(:,:,1:jpl) * a_i(:,:,1:jpl)
+            ztmp4(:,:,1:jpl) =  ht_s(:,:,1:jpl) * a_i(:,:,1:jpl)
+         CASE( 'no' )
+            ztmp3(:,:,:) = 0.0   ;  ztmp4(:,:,:) = 0.0
+            DO jl=1,jpl
+               ztmp3(:,:,1) = ztmp3(:,:,1) + ht_i(:,:,jl) * a_i(:,:,jl)
+               ztmp4(:,:,1) = ztmp4(:,:,1) + ht_s(:,:,jl) * a_i(:,:,jl)
+            ENDDO
+         CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
          END SELECT
+         CALL cpl_prism_snd( jps_fice, isec, ztmp3, info )
+      ENDIF
+      ! Send ice and snow thickness field
+      IF( ssnd(jps_hice)%laction .OR. ssnd(jps_hsnw)%laction ) THEN
+         SELECT CASE( sn_snd_thick%cldes)
+         CASE( 'none'                  )       ! nothing to do
+         CASE( 'weighted ice and snow' )
+            SELECT CASE( sn_snd_thick%clcat )
+            CASE( 'yes' )
+               ztmp3(:,:,1:jpl) =  ht_i(:,:,1:jpl) * a_i(:,:,1:jpl)
+               ztmp4(:,:,1:jpl) =  ht_s(:,:,1:jpl) * a_i(:,:,1:jpl)
+            CASE( 'no' )
+               ztmp3(:,:,:) = 0.0   ;  ztmp4(:,:,:) = 0.0
+               DO jl=1,jpl
+                  ztmp3(:,:,1) = ztmp3(:,:,1) + ht_i(:,:,jl) * a_i(:,:,jl)
+                  ztmp4(:,:,1) = ztmp4(:,:,1) + ht_s(:,:,jl) * a_i(:,:,jl)
+               ENDDO
+            CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
+            END SELECT
+         CASE( 'ice and snow'         )
+            ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl)
+            ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl)
+         CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' )
+         END SELECT
+         IF( ssnd(jps_hice)%laction )   CALL cpl_prism_snd( jps_hice, isec, ztmp3, info )
+         IF( ssnd(jps_hsnw)%laction )   CALL cpl_prism_snd( jps_hsnw, isec, ztmp4, info )
+      ENDIF
+      CASE( 'ice and snow'         )
+         ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl)
+         ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl)
+      CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' )
+      END SELECT
+      IF( ssnd(jps_hice)%laction )   CALL cpl_prism_snd( jps_hice, isec, ztmp3, info )
+      IF( ssnd(jps_hsnw)%laction )   CALL cpl_prism_snd( jps_hsnw, isec, ztmp4, info )
+      !
 #if defined key_cpl_carbon_cycle

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/SBC/sbcdcy.F90

-                      r3764
+                      r6736
    FUNCTION sbc_dcy( pqsrin, l_mask ) RESULT( zqsrout )
+   FUNCTION sbc_dcy( pqsrin ) RESULT( zqsrout )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE sbc_dcy  ***
 …
       !!              Part 1: a diurnally forced OGCM. Climate Dynamics 29:6, 575-590.
       !!----------------------------------------------------------------------
-      LOGICAL, OPTIONAL, INTENT(in) :: l_mask ! use the routine for night mask computation
       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqsrin    ! input daily QSR flux
       !!
       INTEGER  ::   ji, jj                                       ! dummy loop indices
-      INTEGER, DIMENSION(jpi,jpj) :: imask_night ! night mask
       REAL(wp) ::   ztwopi, zinvtwopi, zconvrad
       REAL(wp) ::   zlo, zup, zlousd, zupusd
       REAL(wp) ::   zdsws, zdecrad, ztx, zsin, zcos
       REAL(wp) ::   ztmp, ztmp1, ztmp2, ztest
-      REAL(wp) ::   ztmpm, ztmpm1, ztmpm2
       REAL(wp), DIMENSION(jpi,jpj) ::   zqsrout                  ! output QSR flux with diurnal cycle
       !---------------------------statement functions------------------------
 …
       zup = zlo + ( REAL(nn_fsbc, wp)     * rdttra(1) ) / rday
+      !
       IF( nday_qsr == -1 ) THEN       ! first time step only
+      IF( nday_qsr == -1 ) THEN       ! first time step only
          IF(lwp) THEN
             WRITE(numout,*)
 …
          zdecrad = (-23.5_wp * zconvrad) * COS( zdsws * ztwopi / REAL(nyear_len(1),wp) )
          ! Compute A and B needed to compute the time integral of the diurnal cycle
          zsin = SIN( zdecrad )   ;   zcos = COS( zdecrad )
          DO jj = 1, jpj
 …
             END DO
          END DO
          ! Compute the time of dawn and dusk
 …
          rdawn(:,:) = MOD( (rdawn(:,:) + 1._wp), 1._wp )
          rdusk(:,:) = MOD( (rdusk(:,:) + 1._wp), 1._wp )
          !     2.2 Compute the scaling function:
          !         S* = the inverse of the time integral of the diurnal cycle from dawn to dusk
 …
+         !
       ENDIF
          !     3. update qsr with the diurnal cycle
          !     ------------------------------------
-      imask_night(:,:) = 0
       DO jj = 1, jpj
          DO ji = 1, jpi
+            ztmpm = 0.0
+            IF( ABS(rab(ji,jj)) < 1. ) THEN         ! day duration is less than 24h
+            IF( ABS(rab(ji,jj)) < 1._wp ) THEN         ! day duration is less than 24h
+               !
                IF( rdawn(ji,jj) < rdusk(ji,jj) ) THEN       ! day time in one part
 …
                   ztmp = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))
                   zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj)
-                  ztmpm = zupusd - zlousd
-                  IF ( ztmpm .EQ. 0 ) imask_night(ji,jj) = 1
+                  !
                ELSE                                         ! day time in two parts
 …
                   zupusd = MIN(zup, rdusk(ji,jj))
                   ztmp1 = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))
-                  ztmpm1=zupusd-zlousd
                   zlousd = MAX(zlo, rdawn(ji,jj))
                   zupusd = MAX(zup, rdawn(ji,jj))
                   ztmp2 = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))
-                  ztmpm2 =zupusd-zlousd
                   ztmp = ztmp1 + ztmp2
-                  ztmpm = ztmpm1 + ztmpm2
                   zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj)
-                  IF (ztmpm .EQ. 0.) imask_night(ji,jj) = 1
                ENDIF
             ELSE                                   ! 24h light or 24h night
 …
                   ztmp = fintegral(zlo, zup, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))
                   zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj)
-                  imask_night(ji,jj) = 0
+                  !
                ELSE                                         ! No day
                   zqsrout(ji,jj) = 0.0_wp
-                  imask_night(ji,jj) = 1
                ENDIF
             ENDIF
          END DO
       END DO
+      !
-      IF ( PRESENT(l_mask) .AND. l_mask ) THEN
-         zqsrout(:,:) = float(imask_night(:,:))
-      ENDIF
+      !
       IF( nn_timing == 1 )  CALL timing_stop('sbc_dcy')

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90

-                      r3625
+                      r6736
       !!
       !!      CAUTION :  - never mask the surface stress fields
+      !!                 - the stress is assumed to be in the (i,j) mesh referential
+      !!                 - the stress is assumed to be in the mesh referential
+      !!                   i.e. the (i,j) referential
       !!
       !! ** Action  :   update at each time-step
 …
       !!              - taum        wind stress module at T-point
       !!              - wndm        10m wind module at T-point
+      !!              - qns         non solar heat flux including heat flux due to emp
+      !!              - qsr         solar heat flux
+      !!              - emp         upward mass flux (evap. - precip.)
+      !!              - sfx         salt flux; set to zero at nit000 but possibly non-zero
+      !!                            if ice is present (computed in limsbc(_2).F90)
+      !!              - qns, qsr    non-slor and solar heat flux
+      !!              - emp, emps   evaporation minus precipitation
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! ocean time step
 …
          CALL fld_fill( sf, slf_i, cn_dir, 'sbc_flx', 'flux formulation for ocean surface boundary condition', 'namsbc_flx' )
+         !
-         sfx(:,:) = 0.0_wp                         ! salt flux due to freezing/melting (non-zero only if ice is present; set in limsbc(_2).F90)
+         !
       ENDIF
 …
             END DO
          END DO
-         !                                                        ! add to qns the heat due to e-p
-         qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp        ! mass flux is at SST
+         !
          !                                                        ! module of wind stress and wind speed at T-point
          zcoef = 1. / ( zrhoa * zcdrag )
 …
          CALL lbc_lnk( taum(:,:), 'T', 1. )   ;   CALL lbc_lnk( wndm(:,:), 'T', 1. )
+         emps(:,:) = emp (:,:)                                    ! Initialization of emps (needed when no ice model)
          IF( nitend-nit000 <= 100 .AND. lwp ) THEN                ! control print (if less than 100 time-step asked)
             WRITE(numout,*)

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90

-                      r3625
+                      r6736
       !!                =3 global mean of emp set to zero at each nn_fsbc time step
       !!                   & spread out over erp area depending its sign
-      !! Note: if sea ice is embedded it is taken into account when computing the budget
       !!----------------------------------------------------------------------
       INTEGER, INTENT( in ) ::   kt       ! ocean time-step index
 …
       INTEGER, INTENT( in ) ::   kn_fwb   ! ocean time-step index
+      !
+      INTEGER  ::   inum, ikty, iyear     ! local integers
+      REAL(wp) ::   z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp                ! local scalars
+      REAL(wp) ::   zsurf_neg, zsurf_pos, zsurf_tospread, zcoef          !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:) ::   ztmsk_neg, ztmsk_pos, z_wgt ! 2D workspaces
+      REAL(wp), POINTER, DIMENSION(:,:) ::   ztmsk_tospread, zerp_cor    !   -      -
+      INTEGER  ::   inum, ikty, iyear   ! local integers
+      REAL(wp) ::   z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp   ! local scalars
+      REAL(wp) ::   zsurf_neg, zsurf_pos, zsurf_tospread    !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:) ::   ztmsk_neg, ztmsk_pos, ztmsk_tospread, z_wgt, zerp_cor
       !!----------------------------------------------------------------------
+      !
 …
+         !
          area = glob_sum( e1e2t(:,:) )           ! interior global domain surface
+         !
-#if ! defined key_lim2 &&  ! defined key_lim3 && ! defined key_cice
-         snwice_mass_b(:,:) = 0.e0               ! no sea-ice model is being used : no snow+ice mass
-         snwice_mass  (:,:) = 0.e0
-#endif
+         !
       ENDIF
 …
+         !
          IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
+            z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) -  snwice_fmass(:,:) ) ) / area   ! sum over the global domain
+            zcoef = z_fwf * rcp
+            emp(:,:) = emp(:,:) - z_fwf
+            qns(:,:) = qns(:,:) + zcoef * sst_m(:,:)  ! account for change to the heat budget due to fw correction
+            z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) ) ) / area   ! sum over the global domain
+            emp (:,:) = emp (:,:) - z_fwf
+            emps(:,:) = emps(:,:) - z_fwf
          ENDIF
+         !
       CASE ( 2 )                             !==  fwf budget adjusted from the previous year  ==!
+         !
          IF( kt == nit000 ) THEN                      ! initialisation
+         IF( kt == nit000 ) THEN                   ! initialisation
             !                                         ! Read the corrective factor on precipitations (fwfold)
             CALL ctl_opn( inum, 'EMPave_old.dat', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
 …
          ikty = 365 * 86400 / rdttra(1)    !!bug  use of 365 days leap year or 360d year !!!!!!!
          IF( MOD( kt, ikty ) == 0 ) THEN
+            a_fwb_b = a_fwb                           ! mean sea level taking into account the ice+snow
+                                                      ! sum over the global domain
+            a_fwb   = glob_sum( e1e2t(:,:) * ( sshn(:,:) + snwice_mass(:,:) * r1_rau0 ) )
+            a_fwb_b = a_fwb
+            a_fwb   = glob_sum( e1e2t(:,:) * sshn(:,:) )   ! sum over the global domain
             a_fwb   = a_fwb * 1.e+3 / ( area * 86400. * 365. )     ! convert in Kg/m3/s = mm/s
 !!gm        !                                                      !!bug 365d year
 …
          ENDIF
+         !
+         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN         ! correct the freshwater fluxes
+            zcoef = fwfold * rcp
+            emp(:,:) = emp(:,:) + fwfold
+            qns(:,:) = qns(:,:) - zcoef * sst_m(:,:)  ! account for change to the heat budget due to fw correction
+         ENDIF
+         !
+         IF( kt == nitend .AND. lwp ) THEN            ! save fwfold value in a file
+         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN      ! correct the freshwater fluxes
+            emp (:,:) = emp (:,:) + fwfold
+            emps(:,:) = emps(:,:) + fwfold
+         ENDIF
+         !
+         IF( kt == nitend .AND. lwp ) THEN         ! save fwfold value in a file
             CALL ctl_opn( inum, 'EMPave.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
             WRITE( inum, "(24X,I8,2ES24.16)" ) nyear, a_fwb_b, a_fwb
 …
             ztmsk_neg(:,:) = tmask_i(:,:) - ztmsk_pos(:,:)
+            !
             zsurf_neg = glob_sum( e1e2t(:,:)*ztmsk_neg(:,:) )  ! Area filled by <0 and >0 erp
+            zsurf_neg = glob_sum( e1e2t(:,:)*ztmsk_neg(:,:) )   ! Area filled by <0 and >0 erp
             zsurf_pos = glob_sum( e1e2t(:,:)*ztmsk_pos(:,:) )
             !                                                  ! fwf global mean (excluding ocean to ice/snow exchanges)
             z_fwf     = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) - snwice_fmass(:,:) ) ) / area
+            !                                                  ! fwf global mean
+            z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) ) ) / area
+            !
             IF( z_fwf < 0._wp ) THEN         ! spread out over >0 erp area to increase evaporation
 …
             z_fwf_nsrf =  zsum_fwf / ( zsurf_tospread + rsmall )
             !                                                  ! weight to respect erp field 2D structure
             zsum_erp   = glob_sum( ztmsk_tospread(:,:) * erp(:,:) * e1e2t(:,:) )
+            zsum_erp = glob_sum( ztmsk_tospread(:,:) * erp(:,:) * e1e2t(:,:) )
             z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( zsum_erp + rsmall )
             !                                                  ! final correction term to apply
 …
             CALL lbc_lnk( zerp_cor, 'T', 1. )
+            !
             emp(:,:) = emp(:,:) + zerp_cor(:,:)
             qns(:,:) = qns(:,:) - zerp_cor(:,:) * rcp * sst_m(:,:)  ! account for change to the heat budget due to fw correction
             erp(:,:) = erp(:,:) + zerp_cor(:,:)
+            emp (:,:) = emp (:,:) + zerp_cor(:,:)
+            emps(:,:) = emps(:,:) + zerp_cor(:,:)
+            erp (:,:) = erp (:,:) + zerp_cor(:,:)
+            !
             IF( nprint == 1 .AND. lwp ) THEN                   ! control print

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

-                      r3625
+                      r6736
    USE dom_oce         ! ocean space and time domain
    USE domvvl
    USE phycst, only : rcp, rau0, r1_rau0, rhosn, rhoic
+   USE phycst, only : rcp, rau0
    USE in_out_manager  ! I/O manager
    USE lib_mpp         ! distributed memory computing library
 …
    USE ice_gather_scatter
    USE ice_calendar, only: dt
    USE ice_state, only: aice,aicen,uvel,vvel,vsno,vsnon,vice,vicen
+   USE ice_state, only: aice,aicen,uvel,vvel,vsnon,vicen
    USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow,  &
                 sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_gbm,     &
 …
    PUBLIC cice_sbc_final  ! routine called by sbc_final
    PUBLIC sbc_ice_cice    ! routine called by sbc
-   INTEGER , PARAMETER ::   ji_off = INT ( (jpiglo - nx_global) / 2 )
-   INTEGER , PARAMETER ::   jj_off = INT ( (jpjglo - ny_global) / 2 )
    INTEGER , PARAMETER ::   jpfld   = 13   ! maximum number of files to read
 …
       !! ** Action  : - time evolution of the CICE sea-ice model
       !!              - update all sbc variables below sea-ice:
       !!                utau, vtau, qns , qsr, emp , sfx
+      !!                utau, vtau, qns , qsr, emp , emps
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt      ! ocean time step
 …
       !! ** Purpose: Initialise ice related fields for NEMO and coupling
       !!
+      INTEGER, INTENT( in  ) ::   nsbc                ! surface forcing type
+      REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2
+      REAL(wp) ::   zcoefu, zcoefv, zcoeff            ! local scalar
+      INTEGER  ::   ji, jj, jl                        ! dummy loop indices
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT( in  ) ::   nsbc ! surface forcing type
+      !!---------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jpl                        ! dummy loop indices
       IF( nn_timing == 1 )  CALL timing_start('cice_sbc_init')
+      !
-      CALL wrk_alloc( jpi,jpj, ztmp1, ztmp2 )
+      !
       IF(lwp) WRITE(numout,*)'cice_sbc_init'
 …
       CALL cice2nemo(aice,fr_i, 'T', 1. )
       IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN
          DO jl=1,ncat
             CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. )
+         DO jpl=1,ncat
+            CALL cice2nemo(aicen(:,:,jpl,:),a_i(:,:,jpl), 'T', 1. )
          ENDDO
       ENDIF
 …
       CALL lbc_lnk ( fr_iu , 'U', 1. )
       CALL lbc_lnk ( fr_iv , 'V', 1. )
-      !                                      ! embedded sea ice
-      IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass
-         CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. )
-         CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. )
-         snwice_mass  (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:)  )
-         snwice_mass_b(:,:) = snwice_mass(:,:)
-      ELSE
-         snwice_mass  (:,:) = 0.0_wp         ! no mass exchanges
-         snwice_mass_b(:,:) = 0.0_wp         ! no mass exchanges
-      ENDIF
-      IF( nn_ice_embd == 2 .AND.          &  ! full embedment (case 2) & no restart :
-         &   .NOT.ln_rstart ) THEN           ! deplete the initial ssh belew sea-ice area
-         sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0
-         sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0
+         !
-         ! Note: Changed the initial values of sshb and sshn=>  need to recompute ssh[u,v,f]_[b,n]
-         !       which were previously set in domvvl
-         IF ( lk_vvl ) THEN            ! Is this necessary? embd 2 should be restricted to vvl only???
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1                    ! caution: use of Vector Opt. not possible
-                  zcoefu = 0.5  * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) )
-                  zcoefv = 0.5  * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) )
-                  zcoeff = 0.25 * umask(ji,jj,1) * umask(ji,jj+1,1)
-                  sshu_b(ji,jj) = zcoefu * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshb(ji  ,jj)     &
-                     &                     + e1t(ji+1,jj) * e2t(ji+1,jj) * sshb(ji+1,jj) )
-                  sshv_b(ji,jj) = zcoefv * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshb(ji,jj  )     &
-                     &                     + e1t(ji,jj+1) * e2t(ji,jj+1) * sshb(ji,jj+1) )
-                  sshu_n(ji,jj) = zcoefu * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshn(ji  ,jj)     &
-                     &                     + e1t(ji+1,jj) * e2t(ji+1,jj) * sshn(ji+1,jj) )
-                  sshv_n(ji,jj) = zcoefv * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshn(ji,jj  )     &
-                     &                     + e1t(ji,jj+1) * e2t(ji,jj+1) * sshn(ji,jj+1) )
-               END DO
-            END DO
-            CALL lbc_lnk( sshu_b, 'U', 1. )   ;   CALL lbc_lnk( sshu_n, 'U', 1. )
-            CALL lbc_lnk( sshv_b, 'V', 1. )   ;   CALL lbc_lnk( sshv_n, 'V', 1. )
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1      ! NO Vector Opt.
-                  sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                   &
-                       &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     &
-                       &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_n(ji,jj  )     &
-                       &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) )
-               END DO
-            END DO
-            CALL lbc_lnk( sshf_n, 'F', 1. )
-          ENDIF
-      ENDIF
-      CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 )
+      !
       IF( nn_timing == 1 )  CALL timing_stop('cice_sbc_init')
 …
       INTEGER, INTENT(in   ) ::   nsbc ! surface forcing type
       INTEGER  ::   ji, jj, jl                   ! dummy loop indices
       REAL(wp), DIMENSION(:,:), POINTER :: ztmp, zpice
+      INTEGER  ::   ji, jj, jpl                   ! dummy loop indices
+      REAL(wp), DIMENSION(:,:), POINTER :: ztmp
       REAL(wp), DIMENSION(:,:,:), POINTER :: ztmpn
-      REAL(wp) ::   zintb, zintn  ! dummy argument
       !!---------------------------------------------------------------------
       IF( nn_timing == 1 )  CALL timing_start('cice_sbc_in')
+      !
       CALL wrk_alloc( jpi,jpj, ztmp, zpice )
+      CALL wrk_alloc( jpi,jpj, ztmp )
       CALL wrk_alloc( jpi,jpj,ncat, ztmpn )
 …
 ! Surface downward latent heat flux (CI_5)
          IF (nsbc == 2) THEN
             DO jl=1,ncat
                ztmpn(:,:,jl)=qla_ice(:,:,1)*a_i(:,:,jl)
+            DO jpl=1,ncat
+               ztmpn(:,:,jpl)=qla_ice(:,:,1)*a_i(:,:,jpl)
             ENDDO
          ELSE
 …
                DO ji=1,jpi
                   IF (fr_i(ji,jj).eq.0.0) THEN
                      DO jl=1,ncat
                         ztmpn(ji,jj,jl)=0.0
+                     DO jpl=1,ncat
+                        ztmpn(ji,jj,jpl)=0.0
                      ENDDO
                      ! This will then be conserved in CICE
                      ztmpn(ji,jj,1)=qla_ice(ji,jj,1)
                   ELSE
                      DO jl=1,ncat
                         ztmpn(ji,jj,jl)=qla_ice(ji,jj,1)*a_i(ji,jj,jl)/fr_i(ji,jj)
+                     DO jpl=1,ncat
+                        ztmpn(ji,jj,jpl)=qla_ice(ji,jj,1)*a_i(ji,jj,jpl)/fr_i(ji,jj)
                      ENDDO
                   ENDIF
 …
             ENDDO
          ENDIF
          DO jl=1,ncat
             CALL nemo2cice(ztmpn(:,:,jl),flatn_f(:,:,jl,:),'T', 1. )
+         DO jpl=1,ncat
+            CALL nemo2cice(ztmpn(:,:,jpl),flatn_f(:,:,jpl,:),'T', 1. )
 ! GBM conductive flux through ice (CI_6)
 !  Convert to GBM
             IF (nsbc == 2) THEN
                ztmp(:,:) = botmelt(:,:,jl)*a_i(:,:,jl)
+               ztmp(:,:) = botmelt(:,:,jpl)*a_i(:,:,jpl)
             ELSE
                ztmp(:,:) = botmelt(:,:,jl)
+               ztmp(:,:) = botmelt(:,:,jpl)
             ENDIF
             CALL nemo2cice(ztmp,fcondtopn_f(:,:,jl,:),'T', 1. )
+            CALL nemo2cice(ztmp,fcondtopn_f(:,:,jpl,:),'T', 1. )
 ! GBM surface heat flux (CI_7)
 !  Convert to GBM
             IF (nsbc == 2) THEN
                ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i(:,:,jl)
+               ztmp(:,:) = (topmelt(:,:,jpl)+botmelt(:,:,jpl))*a_i(:,:,jpl)
             ELSE
                ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))
+               ztmp(:,:) = (topmelt(:,:,jpl)+botmelt(:,:,jpl))
             ENDIF
             CALL nemo2cice(ztmp,fsurfn_f(:,:,jl,:),'T', 1. )
+            CALL nemo2cice(ztmp,fsurfn_f(:,:,jpl,:),'T', 1. )
          ENDDO
 …
       CALL nemo2cice(ztmp,vocn,'F', -1. )
-      IF( nn_ice_embd == 2 ) THEN             !== embedded sea ice: compute representative ice top surface ==!
+          !
-          ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1}
-          !                                               = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1}
-         zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp
+          !
-          ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1}
-          !                                               = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1})
-         zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp
+          !
-         zpice(:,:) = ssh_m(:,:) + (  zintn * snwice_mass(:,:) +  zintb * snwice_mass_b(:,:)  ) * r1_rau0
+          !
+         !
-      ELSE                                    !== non-embedded sea ice: use ocean surface for slope calculation ==!
-         zpice(:,:) = ssh_m(:,:)
-      ENDIF
 ! x comp and y comp of sea surface slope (on F points)
 ! T point to F point
       DO jj=1,jpjm1
          DO ji=1,jpim1
             ztmp(ji,jj)=0.5 * (  (zpice(ji+1,jj  )-zpice(ji,jj  ))/e1u(ji,jj  )   &
                                + (zpice(ji+1,jj+1)-zpice(ji,jj+1))/e1u(ji,jj+1) ) &
+            ztmp(ji,jj)=0.5 * (  (ssh_m(ji+1,jj  )-ssh_m(ji,jj  ))/e1u(ji,jj  )   &
+                               + (ssh_m(ji+1,jj+1)-ssh_m(ji,jj+1))/e1u(ji,jj+1) ) &
                             *  fmask(ji,jj,1)
          ENDDO
 …
       DO jj=1,jpjm1
          DO ji=1,jpim1
             ztmp(ji,jj)=0.5 * (  (zpice(ji  ,jj+1)-zpice(ji  ,jj))/e2v(ji  ,jj)   &
                                + (zpice(ji+1,jj+1)-zpice(ji+1,jj))/e2v(ji+1,jj) ) &
+            ztmp(ji,jj)=0.5 * (  (ssh_m(ji  ,jj+1)-ssh_m(ji  ,jj))/e2v(ji  ,jj)   &
+                               + (ssh_m(ji+1,jj+1)-ssh_m(ji+1,jj))/e2v(ji+1,jj) ) &
                             *  fmask(ji,jj,1)
          ENDDO
 …
       INTEGER, INTENT( in  ) ::   nsbc ! surface forcing type
       INTEGER  ::   ji, jj, jl                 ! dummy loop indices
       REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2
+      INTEGER  ::   ji, jj, jpl                 ! dummy loop indices
+      REAL(wp), DIMENSION(:,:), POINTER :: ztmp
       !!---------------------------------------------------------------------
       IF( nn_timing == 1 )  CALL timing_start('cice_sbc_out')
+      !
       CALL wrk_alloc( jpi,jpj, ztmp1, ztmp2 )
+      CALL wrk_alloc( jpi,jpj, ztmp )
       IF( kt == nit000 )  THEN
 …
 ! x comp of ocean-ice stress
       CALL cice2nemo(strocnx,ztmp1,'F', -1. )
+      CALL cice2nemo(strocnx,ztmp,'F', -1. )
       ss_iou(:,:)=0.0
 ! F point to U point
       DO jj=2,jpjm1
          DO ji=2,jpim1
             ss_iou(ji,jj) = 0.5 * ( ztmp1(ji,jj-1) + ztmp1(ji,jj) ) * umask(ji,jj,1)
+            ss_iou(ji,jj) = 0.5 * ( ztmp(ji,jj-1) + ztmp(ji,jj) ) * umask(ji,jj,1)
          ENDDO
       ENDDO
 …
 ! y comp of ocean-ice stress
       CALL cice2nemo(strocny,ztmp1,'F', -1. )
+      CALL cice2nemo(strocny,ztmp,'F', -1. )
       ss_iov(:,:)=0.0
 ! F point to V point
 …
       DO jj=1,jpjm1
          DO ji=2,jpim1
             ss_iov(ji,jj) = 0.5 * ( ztmp1(ji-1,jj) + ztmp1(ji,jj) ) * vmask(ji,jj,1)
+            ss_iov(ji,jj) = 0.5 * ( ztmp(ji-1,jj) + ztmp(ji,jj) ) * vmask(ji,jj,1)
          ENDDO
       ENDDO
 …
          emp(:,:)  = (1.0-fr_i(:,:))*emp(:,:)
       ELSE IF (nsbc ==5) THEN
+! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above)
+! This is currently as required with the coupling fields from the UM atmosphere
+! emp_tot is set in sbc_cpl_ice_flx (call from cice_sbc_in above)
          emp(:,:) = emp_tot(:,:)+tprecip(:,:)*fr_i(:,:)
       ENDIF
+      CALL cice2nemo(fresh_gbm,ztmp1,'T', 1. )
+      CALL cice2nemo(fsalt_gbm,ztmp2,'T', 1. )
+! Check to avoid unphysical expression when ice is forming (ztmp1 negative)
+! Otherwise we are effectively allowing ice of higher salinity than the ocean to form
+! which has to be compensated for by the ocean salinity potentially going negative
+! This check breaks conservation but seems reasonable until we have prognostic ice salinity
+! Note the 1000.0 below is to convert from kg salt to g salt (needed for PSU)
+      WHERE (ztmp1(:,:).lt.0.0) ztmp2(:,:)=MAX(ztmp2(:,:),ztmp1(:,:)*sss_m(:,:)/1000.0)
+      sfx(:,:)=ztmp2(:,:)*1000.0
+      emp(:,:)=emp(:,:)-ztmp1(:,:)
+! Subtract fluxes from CICE to get freshwater equivalent flux used in
+! salinity calculation
+      CALL cice2nemo(fresh_gbm,ztmp,'T', 1. )
+      emps(:,:)=emp(:,:)-ztmp(:,:)
+! Note the 1000.0 is to convert from kg salt to g salt (needed for PSU)
+      CALL cice2nemo(fsalt_gbm,ztmp,'T', 1. )
+      DO jj=1,jpj
+         DO ji=1,jpi
+            IF (sss_m(ji,jj).gt.0.0) THEN
+               emps(ji,jj)=emps(ji,jj)+ztmp(ji,jj)*1000.0/sss_m(ji,jj)
+            ENDIF
+         ENDDO
+      ENDDO
+! No longer remove precip over ice from free surface calculation on basis that the
+! weight of the precip will affect the free surface even if it falls on the ice
+! (same to the argument that freezing / melting of ice doesn't change the free surface)
+! Sublimation from the ice is treated in a similar way (included in emp but not emps)
+!
+! This should not be done in the variable volume case
+      IF (.NOT. lk_vvl) THEN
+         emp(:,:)  = emp(:,:) - tprecip(:,:)*fr_i(:,:)
+! Take sublimation into account
+         IF (nsbc == 5 ) THEN
+            emp(:,:) = emp(:,:) + ( emp_ice(:,:) + sprecip(:,:) )
+         ELSE IF (nsbc == 2 ) THEN
+            emp(:,:) = emp(:,:) - qla_ice(:,:,1) / Lsub
+         ENDIF
+      ENDIF
       CALL lbc_lnk( emp , 'T', 1. )
       CALL lbc_lnk( sfx , 'T', 1. )
+      CALL lbc_lnk( emps , 'T', 1. )
 ! Solar penetrative radiation and non solar surface heat flux
 …
 ! Now add in ice / snow related terms
 ! [fswthru will be zero unless running with calc_Tsfc=T in CICE]
       CALL cice2nemo(fswthru_gbm,ztmp1,'T', 1. )
       qsr(:,:)=qsr(:,:)+ztmp1(:,:)
+      CALL cice2nemo(fswthru_gbm,ztmp,'T', 1. )
+      qsr(:,:)=qsr(:,:)+ztmp(:,:)
       CALL lbc_lnk( qsr , 'T', 1. )
 …
       ENDDO
       CALL cice2nemo(fhocn_gbm,ztmp1,'T', 1. )
       qns(:,:)=qns(:,:)+nfrzmlt(:,:)+ztmp1(:,:)
+      CALL cice2nemo(fhocn_gbm,ztmp,'T', 1. )
+      qns(:,:)=qns(:,:)+nfrzmlt(:,:)+ztmp(:,:)
       CALL lbc_lnk( qns , 'T', 1. )
 …
       CALL cice2nemo(aice,fr_i,'T', 1. )
       IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN
          DO jl=1,ncat
             CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. )
+         DO jpl=1,ncat
+            CALL cice2nemo(aicen(:,:,jpl,:),a_i(:,:,jpl), 'T', 1. )
          ENDDO
       ENDIF
 …
       CALL lbc_lnk ( fr_iv , 'V', 1. )
-      !                                      ! embedded sea ice
-      IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass
-         CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. )
-         CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. )
-         snwice_mass  (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:)  )
-         snwice_mass_b(:,:) = snwice_mass(:,:)
-         snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) / dt
-      ENDIF
 ! Release work space
       CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 )
+      CALL wrk_dealloc( jpi,jpj, ztmp )
+      !
       IF( nn_timing == 1 )  CALL timing_stop('cice_sbc_out')
 …
       !!---------------------------------------------------------------------
       INTEGER  ::   jl                        ! dummy loop index
+      INTEGER  ::   jpl                        ! dummy loop index
       INTEGER  ::   ierror
 …
 ! Snow and ice thicknesses (CO_2 and CO_3)
       DO jl = 1,ncat
          CALL cice2nemo(vsnon(:,:,jl,:),ht_s(:,:,jl),'T', 1. )
          CALL cice2nemo(vicen(:,:,jl,:),ht_i(:,:,jl),'T', 1. )
+      DO jpl = 1,ncat
+         CALL cice2nemo(vsnon(:,:,jpl,:),ht_s(:,:,jpl),'T', 1. )
+         CALL cice2nemo(vicen(:,:,jpl,:),ht_i(:,:,jpl),'T', 1. )
       ENDDO
+      !
 …
       REAL(wp), DIMENSION(jpi,jpj) :: pn
 #if !defined key_nemocice_decomp
-      REAL(wp), DIMENSION(jpiglo,jpjglo) :: png2
       REAL (kind=dbl_kind), dimension(nx_global,ny_global) :: pcg
 #endif
 …
       ! Copy local domain data from NEMO to CICE field
       pc(:,:,1)=0.0
       DO jj=2,ny_block-1
          DO ji=2,nx_block-1
             pc(ji,jj,1)=pn(ji-1+ji_off,jj-1+jj_off)
+      DO jj=2,ny_block
+         DO ji=2,nx_block
+            pc(ji,jj,1)=pn(ji,jj-1)
          ENDDO
       ENDDO
 …
 !        pcg(:,:)=0.0
          DO jn=1,jpnij
             DO jj=nldjt(jn),nlejt(jn)
                DO ji=nldit(jn),nleit(jn)
                   png2(ji+nimppt(jn)-1,jj+njmppt(jn)-1)=png(ji,jj,jn)
+            DO jj=1,nlcjt(jn)-1
+               DO ji=2,nlcit(jn)-1
+                  pcg(ji+nimppt(jn)-2,jj+njmppt(jn)-1)=png(ji,jj,jn)
                ENDDO
-            ENDDO
-         ENDDO
-         DO jj=1,ny_global
-            DO ji=1,nx_global
-               pcg(ji,jj)=png2(ji+ji_off,jj+jj_off)
             ENDDO
          ENDDO
 …
       DO jj=1,jpjm1
          DO ji=1,jpim1
             pn(ji,jj)=pc(ji+1-ji_off,jj+1-jj_off,1)
+            pn(ji,jj)=pc(ji,jj+1,1)
          ENDDO
       ENDDO
 …
 ! Need to make sure this is robust to changes in NEMO halo rows....
 ! (may be OK but not spent much time thinking about it)
-! Note that non-existent pcg elements may be used below, but
-! the lbclnk call on pn will replace these with sensible values
       IF (nproc==0) THEN
          png(:,:,:)=0.0
          DO jn=1,jpnij
             DO jj=nldjt(jn),nlejt(jn)
                DO ji=nldit(jn),nleit(jn)
                   png(ji,jj,jn)=pcg(ji+nimppt(jn)-1-ji_off,jj+njmppt(jn)-1-jj_off)
+            DO jj=1,nlcjt(jn)-1
+               DO ji=2,nlcit(jn)-1
+                  png(ji,jj,jn)=pcg(ji+nimppt(jn)-2,jj+njmppt(jn)-1)
                ENDDO
             ENDDO

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90

-                      r3625
+                      r6736
    !!                   covered area using ice-if model
    !!======================================================================
    !! History :  3.0  !  2006-06  (G. Madec)  Original code
+   !! History :  3.0   !  2006-06  (G. Madec)  Original code
    !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
    !!   sbc_ice_if    : update sbc in ice-covered area
+   !!   sbc_ice_if     : update sbc in ice-covered area
    !!----------------------------------------------------------------------
    USE oce            ! ocean dynamics and tracers
    USE dom_oce        ! ocean space and time domain
    USE phycst         ! physical constants
    USE eosbn2         ! equation of state
    USE sbc_oce        ! surface boundary condition: ocean fields
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE eosbn2          ! equation of state
+   USE sbc_oce         ! surface boundary condition: ocean fields
    USE sbccpl
    USE fldread        ! read input field
    USE iom            ! I/O manager library
    USE in_out_manager ! I/O manager
    USE lib_mpp        ! MPP library
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE fldread         ! read input field
+   USE iom             ! I/O manager library
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
    IMPLICIT NONE
 …
       !!                taum, wndm : remain unchanged
       !!                qns, qsr   : update heat flux below sea-ice
       !!                emp, sfx   : update freshwater flux below sea-ice
+      !!                emp, emps  : update freshwater flux below sea-ice
       !!                fr_i       : update the ice fraction
       !!---------------------------------------------------------------------

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

-                      r3625
+                      r6736
    !!             -   ! 2008-04  (G. Madec)  sltyle and lim_ctl routine
    !!            3.3  ! 2010-11  (G. Madec) ice-ocean stress always computed at each ocean time-step
    !!            3.4  ! 2011-01  (A Porter)  dynamical allocation
+   !!            4.0  ! 2011-01  (A Porter)  dynamical allocation
    !!----------------------------------------------------------------------
 #if defined key_lim3
 …
       !! ** Action  : - time evolution of the LIM sea-ice model
       !!              - update all sbc variables below sea-ice:
       !!                utau, vtau, taum, wndm, qns , qsr, emp , sfx
+      !!                utau, vtau, taum, wndm, qns , qsr, emp , emps
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt      ! ocean time step
 …
          !                                           ! intialisation to zero    !!gm is it truly necessary ???
          d_a_i_thd  (:,:,:)   = 0._wp   ;   d_a_i_trp  (:,:,:)   = 0._wp
          d_v_i_thd  (:,:,:)   = 0._wp   ;   d_v_i_trp  (:,:,:)   = 0._wp
          d_e_i_thd  (:,:,:,:) = 0._wp   ;   d_e_i_trp  (:,:,:,:) = 0._wp
          d_v_s_thd  (:,:,:)   = 0._wp   ;   d_v_s_trp  (:,:,:)   = 0._wp
          d_e_s_thd  (:,:,:,:) = 0._wp   ;   d_e_s_trp  (:,:,:,:) = 0._wp
          d_smv_i_thd(:,:,:)   = 0._wp   ;   d_smv_i_trp(:,:,:)   = 0._wp
          d_oa_i_thd (:,:,:)   = 0._wp   ;   d_oa_i_trp (:,:,:)   = 0._wp
+         !
          sfx    (:,:) = 0._wp
          sfx_bri(:,:) = 0._wp   ;   sfx_mec  (:,:) = 0._wp   ;   sfx_res  (:,:) = 0._wp
          fhbri  (:,:) = 0._wp   ;   fheat_mec(:,:) = 0._wp   ;   fheat_res(:,:) = 0._wp
          fhmec  (:,:) = 0._wp   ;
          fmmec  (:,:) = 0._wp
          focea2D(:,:) = 0._wp
          fsup2D (:,:) = 0._wp
+         d_a_i_thd  (:,:,:)   = 0.e0   ;   d_a_i_trp  (:,:,:)   = 0.e0
+         d_v_i_thd  (:,:,:)   = 0.e0   ;   d_v_i_trp  (:,:,:)   = 0.e0
+         d_e_i_thd  (:,:,:,:) = 0.e0   ;   d_e_i_trp  (:,:,:,:) = 0.e0
+         d_v_s_thd  (:,:,:)   = 0.e0   ;   d_v_s_trp  (:,:,:)   = 0.e0
+         d_e_s_thd  (:,:,:,:) = 0.e0   ;   d_e_s_trp  (:,:,:,:) = 0.e0
+         d_smv_i_thd(:,:,:)   = 0.e0   ;   d_smv_i_trp(:,:,:)   = 0.e0
+         d_oa_i_thd (:,:,:)   = 0.e0   ;   d_oa_i_trp (:,:,:)   = 0.e0
+         !
+         fseqv    (:,:) = 0.e0
+         fsbri    (:,:) = 0.e0     ;   fsalt_res(:,:) = 0.e0
+         fsalt_rpo(:,:) = 0.e0
+         fhmec    (:,:) = 0.e0     ;   fhbri    (:,:) = 0.e0
+         fmmec    (:,:) = 0.e0     ;   fheat_res(:,:) = 0.e0
+         fheat_rpo(:,:) = 0.e0     ;   focea2D  (:,:) = 0.e0
+         fsup2D   (:,:) = 0.e0
+         !
          diag_sni_gr(:,:) = 0._wp   ;   diag_lat_gr(:,:) = 0._wp
          diag_bot_gr(:,:) = 0._wp   ;   diag_dyn_gr(:,:) = 0._wp
          diag_bot_me(:,:) = 0._wp   ;   diag_sur_me(:,:) = 0._wp
+         diag_sni_gr(:,:) = 0.e0   ;   diag_lat_gr(:,:) = 0.e0
+         diag_bot_gr(:,:) = 0.e0   ;   diag_dyn_gr(:,:) = 0.e0
+         diag_bot_me(:,:) = 0.e0   ;   diag_sur_me(:,:) = 0.e0
          ! dynamical invariants
          delta_i(:,:) = 0._wp       ;   divu_i(:,:) = 0._wp       ;   shear_i(:,:) = 0._wp
+         delta_i(:,:) = 0.e0       ;   divu_i(:,:) = 0.e0       ;   shear_i(:,:) = 0.e0
                           CALL lim_rst_opn( kt )     ! Open Ice restart file
 …
          IF( ln_nicep )   CALL lim_prt_state( jiindx, jjindx, 1, ' - Beginning the time step - ' )   ! control print
+         !
+         IF( .NOT. lk_c1d ) THEN                     ! Ice dynamics & transport (except in 1D case)
+         IF( .NOT. lk_c1d ) THEN
+                                                     ! Ice dynamics & transport (not in 1D case)
                           CALL lim_dyn( kt )              ! Ice dynamics    ( rheology/dynamics )
                           CALL lim_trp( kt )              ! Ice transport   ( Advection/diffusion )
 …
                           CALL lim_var_bv                 ! bulk brine volume (diag)
                           CALL lim_thd( kt )              ! Ice thermodynamics
                           zcoef = rdt_ice /rday           !  Ice natural aging
+                          zcoef = rdt_ice / 86400.e0      !  Ice natural aging
                           oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * zcoef
                           CALL lim_var_glo2eqv            ! this CALL is maybe not necessary (Martin)
 …
       inb_altests = 10
       inb_alp(:)  =  0
+      inb_alp(:)  = 0
       ! Alert if incompatible volume and concentration
 …
          DO jj = 1, jpj
             DO ji = 1, jpi
                IF(  v_i(ji,jj,jl) /= 0._wp   .AND.   a_i(ji,jj,jl) == 0._wp   ) THEN
+               IF(  v_i(ji,jj,jl) /= 0.e0   .AND.   a_i(ji,jj,jl) == 0.e0   ) THEN
                   WRITE(numout,*) ' ALERTE 2 :   Incompatible volume and concentration '
                   WRITE(numout,*) ' at_i     ', at_i(ji,jj)
 …
       DO jj = 1, jpj
          DO ji = 1, jpi
             IF(   ht_i(ji,jj,jl)  >  50._wp   ) THEN
+            IF(   ht_i(ji,jj,jl) .GT. 50.0   ) THEN
                CALL lim_prt_state( ji, jj, 2, ' ALERTE 3 :   Very thick ice ' )
                inb_alp(ialert_id) = inb_alp(ialert_id) + 1
 …
       DO jj = 1, jpj
          DO ji = 1, jpi
             IF(   MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 0.5  .AND.  &
                &  at_i(ji,jj) > 0._wp   ) THEN
+            IF(   MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) .GT. 0.5  .AND.  &
+               &  at_i(ji,jj) .GT. 0.e0   ) THEN
                CALL lim_prt_state( ji, jj, 1, ' ALERTE 4 :   Very fast ice ' )
                WRITE(numout,*) ' ice strength             : ', strength(ji,jj)
 …
       DO jj = 1, jpj
          DO ji = 1, jpi
             IF(   tms(ji,jj) <= 0._wp   .AND.   at_i(ji,jj) > 0._wp   ) THEN
+            IF(   tms(ji,jj) .LE. 0.0   .AND.   at_i(ji,jj) .GT. 0.e0   ) THEN
                CALL lim_prt_state( ji, jj, 1, ' ALERTE 6 :   Ice on continents ' )
                WRITE(numout,*) ' masks s, u, v        : ', tms(ji,jj), tmu(ji,jj), tmv(ji,jj)
 …
             DO ji = 1, jpi
 !!gm  test twice sm_i ...  ????  bug?
                IF( ( ( ABS( sm_i(ji,jj,jl) ) < 0.5 )   .OR.  &
                      ( ABS( sm_i(ji,jj,jl) ) < 0.5 ) ) .AND. &
                              ( a_i(ji,jj,jl) > 0._wp ) ) THEN
+               IF( ( ( ABS( sm_i(ji,jj,jl) ) .LT. 0.50) .OR. &
+                     ( ABS( sm_i(ji,jj,jl) ) .LT. 0.50) ) .AND. &
+                             ( a_i(ji,jj,jl) .GT. 0.e0 ) ) THEN
 !                 CALL lim_prt_state(ji,jj,1, ' ALERTE 7 :   Very fresh ice ' )
 !                 WRITE(numout,*) ' sst                  : ', sst_m(ji,jj)
 …
          DO jj = 1, jpj
             DO ji = 1, jpi
                IF ( ( ( ABS( o_i(ji,jj,jl) ) > rdt_ice ) .OR. &
                       ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. &
                              ( a_i(ji,jj,jl) > 0._wp ) ) THEN
+               IF ( ( ( ABS( o_i(ji,jj,jl) ) .GT. rdt_ice ) .OR. &
+                      ( ABS( o_i(ji,jj,jl) ) .LT. 0.00) ) .AND. &
+                             ( a_i(ji,jj,jl) .GT. 0.0 ) ) THEN
                   CALL lim_prt_state( ji, jj, 1, ' ALERTE 9 :   Wrong ice age ')
                   inb_alp(ialert_id) = inb_alp(ialert_id) + 1
 …
       DO jj = 1, jpj
          DO ji = 1, jpi
             IF( ABS( sfx (ji,jj) ) .GT. 1.0e-2 ) THEN
+            IF( ABS( emps(ji,jj) ) .GT. 1.0e-2 ) THEN
                CALL lim_prt_state( ji, jj, 3, ' ALERTE 5 :   High salt flux ' )
                DO jl = 1, jpl
 …
       DO jj = 1, jpj
          DO ji = 1, jpi
             IF(   ABS( qns(ji,jj) ) > 1500._wp  .AND.  at_i(ji,jj) > 0._wp  )  THEN
+            IF(   ABS( qns(ji,jj) ) .GT. 1500.0   .AND.  ( at_i(ji,jj) .GT. 0.0 ) )  THEN
+               !
                WRITE(numout,*) ' ALERTE 8 :   Very high non-solar heat flux'
 …
                WRITE(numout,*) ' fdtcn     : ', fdtcn(ji,jj)
                WRITE(numout,*) ' fhmec     : ', fhmec(ji,jj)
                WRITE(numout,*) ' fheat_mec : ', fheat_mec(ji,jj)
+               WRITE(numout,*) ' fheat_rpo : ', fheat_rpo(ji,jj)
                WRITE(numout,*) ' fheat_res : ', fheat_res(ji,jj)
                WRITE(numout,*) ' fhbri     : ', fhbri(ji,jj)
 …
                DO ji = 1, jpi
                   ztmelts    =  -tmut * s_i(ji,jj,jk,jl) + rtt
                   IF( t_i(ji,jj,jk,jl) >= ztmelts  .AND.  v_i(ji,jj,jl) > 1.e-6   &
                      &                             .AND.  a_i(ji,jj,jl) > 0._wp   ) THEN
+                  IF( t_i(ji,jj,jk,jl) .GE. ztmelts  .AND.  v_i(ji,jj,jl) .GT. 1.e-6   &
+                     &                               .AND.  a_i(ji,jj,jl) .GT. 0.e0    ) THEN
                      WRITE(numout,*) ' ALERTE 10 :   Very warm ice'
                      WRITE(numout,*) ' ji, jj, jk, jl : ', ji, jj, jk, jl
 …
         WRITE(numout,*) ' - Heat / FW fluxes '
         WRITE(numout,*) '   ~~~~~~~~~~~~~~~~ '
 !       WRITE(numout,*) ' sfx_bri    : ', sfx_bri  (ki,kj)
 !       WRITE(numout,*) ' sfx        : ', sfx      (ki,kj)
+!       WRITE(numout,*) ' fsbri      : ', fsbri(ki,kj)
+!       WRITE(numout,*) ' fseqv      : ', fseqv(ki,kj)
 !       WRITE(numout,*) ' fsalt_res  : ', fsalt_res(ki,kj)
         WRITE(numout,*) ' fmmec      : ', fmmec    (ki,kj)
         WRITE(numout,*) ' fhmec      : ', fhmec    (ki,kj)
         WRITE(numout,*) ' fhbri      : ', fhbri    (ki,kj)
         WRITE(numout,*) ' fheat_mec  : ', fheat_mec(ki,kj)
+        WRITE(numout,*) ' fmmec      : ', fmmec(ki,kj)
+        WRITE(numout,*) ' fhmec      : ', fhmec(ki,kj)
+        WRITE(numout,*) ' fhbri      : ', fhbri(ki,kj)
+        WRITE(numout,*) ' fheat_rpo  : ', fheat_rpo(ki,kj)
         WRITE(numout,*)
         WRITE(numout,*) ' sst        : ', sst_m(ki,kj)
 …
         WRITE(numout,*) ' utau_ice   : ', utau_ice(ki,kj)
         WRITE(numout,*) ' vtau_ice   : ', vtau_ice(ki,kj)
         WRITE(numout,*) ' utau       : ', utau    (ki,kj)
         WRITE(numout,*) ' vtau       : ', vtau    (ki,kj)
         WRITE(numout,*) ' oc. vel. u : ', u_oce   (ki,kj)
         WRITE(numout,*) ' oc. vel. v : ', v_oce   (ki,kj)
+        WRITE(numout,*) ' utau       : ', utau(ki,kj)
+        WRITE(numout,*) ' vtau       : ', vtau(ki,kj)
+        WRITE(numout,*) ' oc. vel. u : ', u_oce(ki,kj)
+        WRITE(numout,*) ' oc. vel. v : ', v_oce(ki,kj)
      ENDIF
 …
         WRITE(numout,*)
         WRITE(numout,*) ' - Heat fluxes at bottom interface ***'
         WRITE(numout,*) ' qsr       : ', qsr(ki,kj)
         WRITE(numout,*) ' qns       : ', qns(ki,kj)
+        WRITE(numout,*) ' qsr        : ', qsr(ki,kj)
+        WRITE(numout,*) ' qns        : ', qns(ki,kj)
         WRITE(numout,*)
         WRITE(numout,*) ' - Salt fluxes at bottom interface ***'
+        WRITE(numout,*) ' emp       : ', emp    (ki,kj)
+        WRITE(numout,*) ' sfx_bri   : ', sfx_bri(ki,kj)
+        WRITE(numout,*) ' sfx       : ', sfx    (ki,kj)
+        WRITE(numout,*) ' sfx_res   : ', sfx_res(ki,kj)
+        WRITE(numout,*) ' sfx_mec   : ', sfx_mec(ki,kj)
+        WRITE(numout,*) ' emps       : ', emps(ki,kj)
+        WRITE(numout,*) ' emp        : ', emp(ki,kj)
+        WRITE(numout,*) ' fsbri      : ', fsbri(ki,kj)
+        WRITE(numout,*) ' fseqv      : ', fseqv(ki,kj)
+        WRITE(numout,*) ' fsalt_res  : ', fsalt_res(ki,kj)
+        WRITE(numout,*) ' fsalt_rpo  : ', fsalt_rpo(ki,kj)
         WRITE(numout,*) ' - Heat fluxes at bottom interface ***'
         WRITE(numout,*) ' fheat_res : ', fheat_res(ki,kj)
+        WRITE(numout,*) ' fheat_res  : ', fheat_res(ki,kj)
         WRITE(numout,*)
         WRITE(numout,*) ' - Momentum fluxes '

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

-                      r3680
+                      r6736
    USE in_out_manager   ! I/O manager
    USE prtctl           ! Print control
-# if defined key_agrif
-   USE agrif_ice
-   USE agrif_lim2_update
-# endif
    IMPLICIT NONE
 …
       !! ** Action  : - time evolution of the LIM sea-ice model
       !!              - update all sbc variables below sea-ice:
       !!                utau, vtau, taum, wndm, qns , qsr, emp , sfx
+      !!                utau, vtau, taum, wndm, qns , qsr, emp , emps
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt      ! ocean time step
 …
+         !
          CALL ice_init_2
+         !
-# if defined key_agrif
-         IF( .NOT. Agrif_Root() ) CALL Agrif_InitValues_cont_lim2   ! AGRIF: set the meshes
-# endif
       ENDIF
 …
       IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !  Ice time-step only  !
          !                                     !----------------------!
-# if defined key_agrif
-         IF( .NOT. Agrif_Root() ) lim_nbstep = MOD(lim_nbstep,Agrif_rhot()&
-         &*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc)) + 1
-# endif
          !  Bulk Formulea !
          !----------------!
 …
          IF( lrst_ice  )   CALL lim_rst_write_2( kt )      ! Ice restart file
+         !
-# if defined key_agrif && defined key_lim2
-         IF( .NOT. Agrif_Root() )   CALL agrif_update_lim2( kt )
-# endif
+         !
       ENDIF                                    ! End sea-ice time step only
+      !

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

-                      r3764
+                      r6736
    !!             -   ! 2010-10  (J. Chanut, C. Bricaud, G. Madec)  add the surface pressure forcing
    !!            3.4  ! 2011-11  (C. Harris) CICE added as an option
-   !!            3.5  ! 2012-11  (A. Coward, G. Madec) Rethink of heat, mass and salt surface fluxes
    !!----------------------------------------------------------------------
 …
    USE bdy_par          ! for lk_bdy
    USE bdyice_lim2      ! unstructured open boundary data  (bdy_ice_lim_2 routine)
-   USE icbstp           ! Icebergs!
    USE prtctl           ! Print control                    (prt_ctl routine)
+   USE restart          ! ocean restart
    USE iom              ! IOM library
    USE in_out_manager   ! I/O manager
 …
       !!
       !! ** Method  :   Read the namsbc namelist and set derived parameters
-      !!                Call init routines for all other SBC modules that have one
       !!
       !! ** Action  : - read namsbc parameters
 …
       INTEGER ::   icpt   ! local integer
       !!
+      NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx,  ln_blk_clio, ln_blk_core, ln_cpl,   &
+         &             ln_blk_mfs, ln_apr_dyn, nn_ice,  nn_ice_embd, ln_dm2dc   , ln_rnf,   &
+         &             ln_ssr    , nn_fwb    , ln_cdgw , ln_wave , ln_sdw
+      NAMELIST/namsbc/ nn_fsbc   , ln_ana , ln_flx  , ln_blk_clio, ln_blk_core, ln_cpl,   &
+         &             ln_blk_mfs, ln_apr_dyn, nn_ice , ln_dm2dc, ln_rnf, ln_ssr     , nn_fwb, ln_cdgw
       !!----------------------------------------------------------------------
 …
          WRITE(numout,*) '              Patm gradient added in ocean & ice Eqs.    ln_apr_dyn  = ', ln_apr_dyn
          WRITE(numout,*) '              ice management in the sbc (=0/1/2/3)       nn_ice      = ', nn_ice
-         WRITE(numout,*) '              ice-ocean embedded/levitating (=0/1/2)     nn_ice_embd = ', nn_ice_embd
          WRITE(numout,*) '              daily mean to diurnal cycle qsr            ln_dm2dc    = ', ln_dm2dc
          WRITE(numout,*) '              runoff / runoff mouths                     ln_rnf      = ', ln_rnf
 …
          IF( sbc_rnf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_rnf arrays' )
          nkrnf         = 0
          rnf     (:,:) = 0.0_wp
          rnfmsk  (:,:) = 0.0_wp
          rnfmsk_z(:)   = 0.0_wp
+         rnf     (:,:) = 0.e0
+         rnfmsk  (:,:) = 0.e0
+         rnfmsk_z(:)   = 0.e0
       ENDIF
       IF( nn_ice == 0  )   fr_i(:,:) = 0.e0        ! no ice in the domain, ice fraction is always zero
-      sfx(:,:) = 0.0_wp                            ! the salt flux due to freezing/melting will be computed (i.e. will be non-zero)
-                                                   ! only if sea-ice is present
       !                                            ! restartability
 …
       IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. lk_cpl ) )   &
          &   CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or lk_cpl' )
+      IF( nn_ice == 4 .AND. lk_agrif )   &
+         &   CALL ctl_stop( 'CICE sea-ice model not currently available with AGRIF' )
+      IF( ( nn_ice == 3 .OR. nn_ice == 4 ) .AND. nn_ice_embd == 0 )   &
+         &   CALL ctl_stop( 'LIM3 and CICE sea-ice models require nn_ice_embd = 1 or 2' )
+      IF( nn_ice == 4 .AND. ( .NOT. ( cp_cfg == 'orca' ) .OR. lk_agrif ) )   &
+         &   CALL ctl_stop( 'CICE sea-ice model currently only available in a global ORCA configuration without AGRIF' )
       IF( ln_dm2dc )   nday_qsr = -1   ! initialisation flag
 …
          &   CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' )
+      IF ( ln_wave ) THEN
+      !Activated wave module but neither drag nor stokes drift activated
+         IF ( .NOT.(ln_cdgw .OR. ln_sdw) )   THEN
+            CALL ctl_warn( 'Ask for wave coupling but nor drag coefficient (ln_cdgw=F) neither stokes drift activated (ln_sdw=F)' )
+      !drag coefficient read from wave model definable only with mfs bulk formulae and core
+         ELSEIF (ln_cdgw .AND. .NOT.(ln_blk_mfs .OR. ln_blk_core) )       THEN
+             CALL ctl_stop( 'drag coefficient read from wave model definable only with mfs bulk formulae and core')
+         ENDIF
+      ELSE
+      IF ( ln_cdgw .OR. ln_sdw  )                                         &
+         &   CALL ctl_stop('Not Activated Wave Module (ln_wave=F) but     &
+         & asked coupling with drag coefficient (ln_cdgw =T) or Stokes drift (ln_sdw=T) ')
+      ENDIF
+       !drag coefficient read from wave model definable only with mfs bulk formulae and core
+       IF(ln_cdgw .AND. .NOT.(ln_blk_mfs .OR. ln_blk_core) )              &
+          &   CALL ctl_stop( 'drag coefficient read from wave model definable only with mfs bulk formulae and core')
       !                          ! Choice of the Surface Boudary Condition (set nsbc)
 …
       !! ** Action  : - set the ocean surface boundary condition at before and now
       !!                time step, i.e.
       !!                utau_b, vtau_b, qns_b, qsr_b, emp_n, sfx_b, qrp_b, erp_b
       !!                utau  , vtau  , qns  , qsr  , emp  , sfx  , qrp  , erp
+      !!                utau_b, vtau_b, qns_b, qsr_b, emp_n, emps_b, qrp_b, erp_b
+      !!                utau  , vtau  , qns  , qsr  , emp  , emps  , qrp  , erp
       !!              - updte the ice fraction : fr_i
       !!----------------------------------------------------------------------
 …
          ! The 3D heat content due to qsr forcing is treated in traqsr
          ! qsr_b (:,:) = qsr (:,:)
          emp_b(:,:) = emp(:,:)
          sfx_b(:,:) = sfx(:,:)
+         emp_b (:,:) = emp (:,:)
+         emps_b(:,:) = emps(:,:)
       ENDIF
       !                                            ! ---------------------------------------- !
       !                                            !        forcing field computation         !
       !                                            ! ---------------------------------------- !
+      CALL iom_setkt( kt + nn_fsbc - 1 )                 ! in sbc, iom_put is called every nn_fsbc time step
+      !
       IF( ln_apr_dyn ) CALL sbc_apr( kt )                ! atmospheric pressure provided at kt+0.5*nn_fsbc
 …
       !                                                  ! averaged over nf_sbc time-step
       IF (ln_wave) CALL sbc_wave( kt )
+      IF (ln_cdgw) CALL sbc_wave( kt )
                                                    !==  sbc formulation  ==!
       SELECT CASE( nsbc )                                ! Compute ocean surface boundary condition
       !                                                  ! (i.e. utau,vtau, qns, qsr, emp, sfx)
+      !                                                  ! (i.e. utau,vtau, qns, qsr, emp, emps)
       CASE(  0 )   ;   CALL sbc_gyre    ( kt )                    ! analytical formulation : GYRE configuration
       CASE(  1 )   ;   CALL sbc_ana     ( kt )                    ! analytical formulation : uniform sbc
 …
       END SELECT
-      IF( ln_icebergs    )   CALL icb_stp( kt )                   ! compute icebergs
       IF( ln_rnf         )   CALL sbc_rnf( kt )                   ! add runoffs to fresh water fluxes
 …
             CALL iom_get( numror, jpdom_autoglo, 'qns_b' , qns_b  )   ! before non solar heat flux (T-point)
             ! The 3D heat content due to qsr forcing is treated in traqsr
+            ! CALL iom_get( numror, jpdom_autoglo, 'qsr_b' , qsr_b  ) ! before     solar heat flux (T-point)
+            CALL iom_get( numror, jpdom_autoglo, 'emp_b', emp_b  )    ! before     freshwater flux (T-point)
+            ! To ensure restart capability with 3.3x/3.4 restart files    !! to be removed in v3.6
+            IF( iom_varid( numror, 'sfx_b', ldstop = .FALSE. ) > 0 ) THEN
+               CALL iom_get( numror, jpdom_autoglo, 'sfx_b', sfx_b )  ! before salt flux (T-point)
+            ELSE
+               sfx_b (:,:) = sfx(:,:)
+            ENDIF
+            ! CALL iom_get( numror, jpdom_autoglo, 'qsr_b' , qsr_b  )   ! before     solar heat flux (T-point)
+            CALL iom_get( numror, jpdom_autoglo, 'emp_b' , emp_b  )   ! before     freshwater flux (T-point)
+            CALL iom_get( numror, jpdom_autoglo, 'emps_b', emps_b )   ! before C/D freshwater flux (T-point)
          ELSE                                                   !* no restart: set from nit000 values
             IF(lwp) WRITE(numout,*) '          nit000-1 surface forcing fields set to nit000'
 …
             vtau_b(:,:) = vtau(:,:)
             qns_b (:,:) = qns (:,:)
+            emp_b (:,:) = emp(:,:)
+            sfx_b (:,:) = sfx(:,:)
+            ! qsr_b (:,:) = qsr (:,:)
+            emp_b (:,:) = emp (:,:)
+            emps_b(:,:) = emps(:,:)
          ENDIF
       ENDIF
 …
          ! CALL iom_rstput( kt, nitrst, numrow, 'qsr_b'  , qsr  )
          CALL iom_rstput( kt, nitrst, numrow, 'emp_b'  , emp  )
          CALL iom_rstput( kt, nitrst, numrow, 'sfx_b' , sfx )
+         CALL iom_rstput( kt, nitrst, numrow, 'emps_b' , emps )
       ENDIF
 …
       IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN
          CALL iom_put( "empmr" , emp  - rnf )                   ! upward water flux
+         CALL iom_put( "saltflx", sfx  )                        ! downward salt flux
+                                                                ! (includes virtual salt flux beneath ice
+                                                                ! in linear free surface case)
+         CALL iom_put( "empsmr", emps - rnf )                   ! c/d water flux
          CALL iom_put( "qt"    , qns  + qsr )                   ! total heat flux
          CALL iom_put( "qns"   , qns        )                   ! solar heat flux
 …
       ENDIF
+      !
+      CALL iom_setkt( kt )           ! iom_put outside of sbc is called at every time step
+      !
       CALL iom_put( "utau", utau )   ! i-wind stress   (stress can be updated at
       CALL iom_put( "vtau", vtau )   ! j-wind stress    each time step in sea-ice)
 …
          CALL prt_ctl(tab2d_1=fr_i             , clinfo1=' fr_i     - : ', mask1=tmask, ovlap=1 )
          CALL prt_ctl(tab2d_1=(emp-rnf)        , clinfo1=' emp-rnf  - : ', mask1=tmask, ovlap=1 )
          CALL prt_ctl(tab2d_1=(sfx-rnf)        , clinfo1=' sfx-rnf  - : ', mask1=tmask, ovlap=1 )
+         CALL prt_ctl(tab2d_1=(emps-rnf)       , clinfo1=' emps-rnf - : ', mask1=tmask, ovlap=1 )
          CALL prt_ctl(tab2d_1=qns              , clinfo1=' qns      - : ', mask1=tmask, ovlap=1 )
          CALL prt_ctl(tab2d_1=qsr              , clinfo1=' qsr      - : ', mask1=tmask, ovlap=1 )

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

-                      r3832
+                      r6736
    USE closea          ! closed seas
    USE fldread         ! read input field at current time step
+   USE restart         ! restart
    USE in_out_manager  ! I/O manager
    USE iom             ! I/O module
 …
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   h_rnf               !: depth of runoff in m
    INTEGER,  PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   nk_rnf              !: depth of runoff in model levels
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rnf_tsc_b, rnf_tsc  !: before and now T & S runoff contents   [K.m/s & PSU.m/s]
+   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   sf_rnf       ! structure: river runoff (file information, fields read)
+   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   sf_s_rnf     ! structure: river runoff salinity (file information, fields read)
+   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   sf_t_rnf     ! structure: river runoff temperature (file information, fields read)
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rnf_tsc_b, rnf_tsc  !: before and now T & S runoff contents   [K.m/s & PSU.m/s]
+   REAL(wp) ::   r1_rau0   ! = 1 / rau0
+   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   sf_rnf       ! structure: river runoff (file information, fields read) (PUBLIC for TAM)
+   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   sf_s_rnf     ! structure: river runoff salinity (file information, fields read)  (PUBLIC for TAM)
+   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   sf_t_rnf     ! structure: river runoff temperature (file information, fields read) (PUBLIC for TAM)
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
 …
    END FUNCTION sbc_rnf_alloc
    SUBROUTINE sbc_rnf( kt )
       !!----------------------------------------------------------------------
 …
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt          ! ocean time step
+      !
+      INTEGER  ::   ji, jj    ! dummy loop indices
+      INTEGER  ::   z_err = 0 ! dummy integer for error handling
+      !!
+      INTEGER  ::   ji, jj   ! dummy loop indices
       !!----------------------------------------------------------------------
+      !
 …
+         !
          IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN
+            rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) )
+            !
+            rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) )       ! updated runoff value at time step kt
+            !
+            r1_rau0 = 1._wp / rau0
             !                                                     ! set temperature & salinity content of runoffs
             IF( ln_rnf_tem ) THEN                                       ! use runoffs temperature data
 …
             IF( ln_rnf_sal )   rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0
             !                                                           ! else use S=0 for runoffs (done one for all in the init)
+            IF ( ANY( rnf(:,:) < 0._wp ) ) z_err=1
+            IF(lk_mpp) CALL mpp_sum(z_err)
+            IF( z_err > 0 ) CALL ctl_stop( 'sbc_rnf : negative runnoff values exist' )
+            !
+            IF( ln_rnf_tem .OR. ln_rnf_sal ) THEN                 ! runoffs as outflow: use ocean SST and SSS
+               WHERE( rnf(:,:) < 0._wp )                                 ! example baltic model when flow is out of domain
+                  rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0
+                  rnf_tsc(:,:,jp_sal) = sss_m(:,:) * rnf(:,:) * r1_rau0
+               END WHERE
+            ENDIF
+            !
             CALL iom_put( "runoffs", rnf )         ! output runoffs arrays
 …
       !!
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   r1_rau0   ! local scalar
       REAL(wp) ::   zfact     ! local scalar
       !!----------------------------------------------------------------------
 …
       zfact = 0.5_wp
+      !
+      r1_rau0 = 1._wp / rau0
       IF( ln_rnf_depth ) THEN      !==   runoff distributed over several levels   ==!
          IF( lk_vvl ) THEN             ! variable volume case
 …
       INTEGER           ::   ji, jj, jk    ! dummy loop indices
       INTEGER           ::   ierror, inum  ! temporary integer
+      !
+      !!
       NAMELIST/namsbc_rnf/ cn_dir, ln_rnf_emp, ln_rnf_depth, ln_rnf_tem, ln_rnf_sal,   &
          &                 sn_rnf, sn_cnf    , sn_s_rnf    , sn_t_rnf  , sn_dep_rnf,   &
          &                 ln_rnf_mouth      , rn_hrnf     , rn_avt_rnf, rn_rfact
       !!----------------------------------------------------------------------
+      !
       !                                   ! ============
       !                                   !   Namelist
 …
       REWIND ( numnam )                         ! Read Namelist namsbc_rnf
       READ   ( numnam, namsbc_rnf )
+      !
       !                                         ! Control print
       IF(lwp) THEN
 …
          WRITE(numout,*) '      multiplicative factor for runoff           rn_rfact     = ', rn_rfact
       ENDIF
+      !
       !                                   ! ==================
       !                                   !   Type of runoff
 …
             IF(lwp) WRITE(numout,*) '          runoffs depth read in a file'
             rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname )
-            IF( .NOT. sn_dep_rnf%ln_clim ) THEN   ;   WRITE(rn_dep_file, '(a,"_y",i4)' ) TRIM( rn_dep_file ), nyear    ! add year
-               IF( sn_dep_rnf%cltype == 'monthly' )   WRITE(rn_dep_file, '(a,"m",i2)'  ) TRIM( rn_dep_file ), nmonth   ! add month
-            ENDIF
             CALL iom_open ( rn_dep_file, inum )                           ! open file
             CALL iom_get  ( inum, jpdom_data, sn_dep_rnf%clvar, h_rnf )   ! read the river mouth array
 …
                   ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN   ;  nk_rnf(ji,jj) = mbkt(ji,jj)
                   ELSE
                      CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999'  )
                      WRITE(999,*) 'ji, jj, h_rnf(ji,jj) :', ji, jj, h_rnf(ji,jj)
+                     CALL ctl_stop( 'runoff depth not positive, and not -999 or -1, rnf value in file fort.999'  )
+                     WRITE(999,*) 'ji, jj, rnf(ji,jj) :', ji, jj, rnf(ji,jj)
                   ENDIF
                END DO
 …
             nkrnf = 2
             DO WHILE( nkrnf /= jpkm1 .AND. gdepw_0(nkrnf+1) < rn_hrnf )   ;   nkrnf = nkrnf + 1   ;   END DO
+            IF( ln_sco )   CALL ctl_warn( 'sbc_rnf: number of levels over which Kz is increased is computed for zco...' )
+            IF( ln_sco )   &
+               CALL ctl_warn( 'sbc_rnf: number of levels over which Kz is increased is computed for zco...' )
          ENDIF
          IF(lwp) WRITE(numout,*)
 …
          nkrnf = 0
       ENDIF
+      !
    END SUBROUTINE sbc_rnf_init
 …
       !!                rnfmsk_z vertical structure
       !!----------------------------------------------------------------------
+      !
       INTEGER            ::   inum        ! temporary integers
       CHARACTER(len=140) ::   cl_rnfile   ! runoff file name
 …
       IF(lwp) WRITE(numout,*) 'rnf_mouth : river mouth mask'
       IF(lwp) WRITE(numout,*) '~~~~~~~~~ '
+      !
       cl_rnfile = TRIM( cn_dir )//TRIM( sn_cnf%clname )
       IF( .NOT. sn_cnf%ln_clim ) THEN   ;   WRITE(cl_rnfile, '(a,"_y",i4)' ) TRIM( cl_rnfile ), nyear    ! add year
          IF( sn_cnf%cltype == 'monthly' )   WRITE(cl_rnfile, '(a,"m",i2)'  ) TRIM( cl_rnfile ), nmonth   ! add month
       ENDIF
+      !
       ! horizontal mask (read in NetCDF file)
       CALL iom_open ( cl_rnfile, inum )                           ! open file
       CALL iom_get  ( inum, jpdom_data, sn_cnf%clvar, rnfmsk )    ! read the river mouth array
       CALL iom_close( inum )                                      ! close file
+      !
       IF( nn_closea == 1 )   CALL clo_rnf( rnfmsk )               ! closed sea inflow set as ruver mouth
+      !
       rnfmsk_z(:)   = 0._wp                                       ! vertical structure
       rnfmsk_z(1)   = 1.0

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90

-                      r3680
+                      r6736
    USE sbcapr          ! surface boundary condition: atmospheric pressure
    USE prtctl          ! Print control                    (prt_ctl routine)
+   USE restart         ! ocean restart
    USE iom
    USE in_out_manager  ! I/O manager
 …
    PRIVATE
+   PUBLIC   sbc_ssm         ! routine called by step.F90
+   PUBLIC   sbc_ssm_init    ! routine called by sbcmod.F90
+   PUBLIC   sbc_ssm    ! routine called by step.F90
-   LOGICAL, SAVE  ::   l_ssm_mean = .FALSE.       ! keep track of whether means have been read
-                                                  ! from restart file
    !! * Substitutions
 #  include "domzgr_substitute.h90"
 …
       !!---------------------------------------------------------------------
       !                                                   ! ---------------------------------------- !
       IF( nn_fsbc == 1 ) THEN                             !   Instantaneous surface fields        !
+      IF( nn_fsbc == 1 ) THEN                             !      Instantaneous surface fields        !
          !                                                ! ---------------------------------------- !
+         IF( kt == nit000 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'sbc_ssm : sea surface mean fields, nn_fsbc=1 : instantaneous values'
+            IF(lwp) WRITE(numout,*) '~~~~~~~ '
+         ENDIF
+         !
          ssu_m(:,:) = ub(:,:,1)
          ssv_m(:,:) = vb(:,:,1)
 …
+         !
       ELSE
          !                                                ! ----------------------------------------------- !
          IF( kt == nit000 .AND. .NOT. l_ssm_mean ) THEN   !   Initialisation: 1st time-step, no input means !
             !                                             ! ----------------------------------------------- !
+         !                                                ! ---------------------------------------- !
+         IF( kt == nit000) THEN                           !       Initialisation: 1st time-step      !
+            !                                             ! ---------------------------------------- !
             IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '~~~~~~~   mean fields initialised to instantaneous values'
+            zcoef = REAL( nn_fsbc - 1, wp )
+            ssu_m(:,:) = zcoef * ub(:,:,1)
+            ssv_m(:,:) = zcoef * vb(:,:,1)
+            sst_m(:,:) = zcoef * tsn(:,:,1,jp_tem)
+            sss_m(:,:) = zcoef * tsn(:,:,1,jp_sal)
+            !                          ! removed inverse barometer ssh when Patm forcing is used
+            IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) )
+            ELSE                    ;   ssh_m(:,:) = zcoef *   sshn(:,:)
+            IF(lwp) WRITE(numout,*) 'sbc_ssm : sea surface mean fields'
+            !
+            IF( ln_rstart .AND. iom_varid( numror, 'nn_fsbc', ldstop = .FALSE. ) > 0 ) THEN
+               CALL iom_get( numror               , 'nn_fsbc', zf_sbc )   ! sbc frequency of previous run
+               CALL iom_get( numror, jpdom_autoglo, 'ssu_m'  , ssu_m  )   ! sea surface mean velocity    (T-point)
+               CALL iom_get( numror, jpdom_autoglo, 'ssv_m'  , ssv_m  )   !   "         "    velocity    (V-point)
+               CALL iom_get( numror, jpdom_autoglo, 'sst_m'  , sst_m  )   !   "         "    temperature (T-point)
+               CALL iom_get( numror, jpdom_autoglo, 'sss_m'  , sss_m  )   !   "         "    salinity    (T-point)
+               CALL iom_get( numror, jpdom_autoglo, 'ssh_m'  , ssh_m  )   !   "         "    height      (T-point)
+               !
+               IF( zf_sbc /= REAL( nn_fsbc, wp ) ) THEN      ! nn_fsbc has changed between 2 runs
+                  IF(lwp) WRITE(numout,*) '~~~~~~~   restart with a change in the frequency of mean ',   &
+                     &                    'from ', zf_sbc, ' to ', nn_fsbc
+                  zcoef = REAL( nn_fsbc - 1, wp ) / zf_sbc
+                  ssu_m(:,:) = zcoef * ssu_m(:,:)
+                  ssv_m(:,:) = zcoef * ssv_m(:,:)
+                  sst_m(:,:) = zcoef * sst_m(:,:)
+                  sss_m(:,:) = zcoef * sss_m(:,:)
+                  ssh_m(:,:) = zcoef * ssh_m(:,:)
+               ELSE
+                  IF(lwp) WRITE(numout,*) '~~~~~~~   mean fields read in the ocean restart file'
+               ENDIF
+            ELSE
+               IF(lwp) WRITE(numout,*) '~~~~~~~   mean fields initialised to instantaneous values'
+               zcoef = REAL( nn_fsbc - 1, wp )
+               ssu_m(:,:) = zcoef * ub(:,:,1)
+               ssv_m(:,:) = zcoef * vb(:,:,1)
+               sst_m(:,:) = zcoef * tsn(:,:,1,jp_tem)
+               sss_m(:,:) = zcoef * tsn(:,:,1,jp_sal)
+               !                          ! removed inverse barometer ssh when Patm forcing is used
+               IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) )
+               ELSE                    ;   ssh_m(:,:) = zcoef *   sshn(:,:)
+               ENDIF
             ENDIF
             !                                             ! ---------------------------------------- !
 …
    END SUBROUTINE sbc_ssm
-   SUBROUTINE sbc_ssm_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE sbc_ssm_init  ***
-      !!
-      !! ** Purpose :   Initialisation of the sbc data
-      !!
-      !! ** Action  : - read parameters
-      !!----------------------------------------------------------------------
-      REAL(wp) ::   zcoef, zf_sbc       ! local scalar
-      !!----------------------------------------------------------------------
-      IF( nn_fsbc == 1 ) THEN
+         !
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'sbc_ssm : sea surface mean fields, nn_fsbc=1 : instantaneous values'
-         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+         !
-      ELSE
+         !
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'sbc_ssm : sea surface mean fields'
-         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+         !
-         IF( ln_rstart .AND. iom_varid( numror, 'nn_fsbc', ldstop = .FALSE. ) > 0 ) THEN
-            l_ssm_mean = .TRUE.
-            CALL iom_get( numror               , 'nn_fsbc', zf_sbc )   ! sbc frequency of previous run
-            CALL iom_get( numror, jpdom_autoglo, 'ssu_m'  , ssu_m  )   ! sea surface mean velocity    (T-point)
-            CALL iom_get( numror, jpdom_autoglo, 'ssv_m'  , ssv_m  )   !   "         "    velocity    (V-point)
-            CALL iom_get( numror, jpdom_autoglo, 'sst_m'  , sst_m  )   !   "         "    temperature (T-point)
-            CALL iom_get( numror, jpdom_autoglo, 'sss_m'  , sss_m  )   !   "         "    salinity    (T-point)
-            CALL iom_get( numror, jpdom_autoglo, 'ssh_m'  , ssh_m  )   !   "         "    height      (T-point)
+            !
-            IF( zf_sbc /= REAL( nn_fsbc, wp ) ) THEN      ! nn_fsbc has changed between 2 runs
-               IF(lwp) WRITE(numout,*) '~~~~~~~   restart with a change in the frequency of mean ',   &
-                  &                    'from ', zf_sbc, ' to ', nn_fsbc
-               zcoef = REAL( nn_fsbc - 1, wp ) / zf_sbc
-               ssu_m(:,:) = zcoef * ssu_m(:,:)
-               ssv_m(:,:) = zcoef * ssv_m(:,:)
-               sst_m(:,:) = zcoef * sst_m(:,:)
-               sss_m(:,:) = zcoef * sss_m(:,:)
-               ssh_m(:,:) = zcoef * ssh_m(:,:)
-            ELSE
-               IF(lwp) WRITE(numout,*) '~~~~~~~   mean fields read in the ocean restart file'
-            ENDIF
-         ENDIF
-      ENDIF
+      !
-   END SUBROUTINE sbc_ssm_init
    !!======================================================================
 END MODULE sbcssm

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90

-                      r3764
+                      r6736
    !!----------------------------------------------------------------------
    !!   sbc_ssr       : add to sbc a restoring term toward SST/SSS climatology
    !!----------------------------------------------------------------------
    USE oce            ! ocean dynamics and tracers
    USE dom_oce        ! ocean space and time domain
    USE sbc_oce        ! surface boundary condition
    USE phycst         ! physical constants
    USE sbcrnf         ! surface boundary condition : runoffs
    USE fldread        ! read input fields
    USE iom            ! I/O manager
    USE in_out_manager ! I/O manager
    USE lib_mpp        ! distribued memory computing library
    USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
    USE timing         ! Timing
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   !!   sbc_ssr        : add to sbc a restoring term toward SST/SSS climatology
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE sbc_oce         ! surface boundary condition
+   USE phycst          ! physical constants
+   USE sbcrnf          ! surface boundary condition : runoffs
+   USE fldread         ! read input fields
+   USE iom             ! I/O manager
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distribued memory computing library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE timing          ! Timing
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
    IMPLICIT NONE
 …
       !!              - at each nscb time step
       !!                   add a retroaction term on qns    (nn_sstr = 1)
       !!                   add a damping term on sfx        (nn_sssr = 1)
       !!                   add a damping term on emp        (nn_sssr = 2)
+      !!                   add a damping term on emps       (nn_sssr = 1)
+      !!                   add a damping term on emp & emps (nn_sssr = 2)
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in   ) ::   kt   ! ocean time step
 …
             !                                      ! ========================= !
+            !
             IF( nn_sstr == 1 ) THEN                                   !* Temperature restoring term
+            IF( nn_sstr == 1 ) THEN                   !* Temperature restoring term
 !CDIR COLLAPSE
                DO jj = 1, jpj
 …
             ENDIF
+            !
             IF( nn_sssr == 1 ) THEN                                   !* Salinity damping term (salt flux only (sfx))
+            IF( nn_sssr == 1 ) THEN                   !* Salinity damping term (salt flux, emps only)
                zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s]
 !CDIR COLLAPSE
 …
                   DO ji = 1, jpi
                      zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths
+                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )
+                     sfx(ji,jj) = sfx(ji,jj) + zerp                 ! salt flux
+                     erp(ji,jj) = zerp / MAX( sss_m(ji,jj), 1.e-20 ) ! converted into an equivalent volume flux (diagnostic only)
+                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )   &
+                        &        / ( sss_m(ji,jj) + 1.e-20   )
+                     emps(ji,jj) = emps(ji,jj) + zerp
+                     erp( ji,jj) = zerp
                   END DO
                END DO
                CALL iom_put( "erp", erp )                             ! freshwater flux damping
+               !
             ELSEIF( nn_sssr == 2 ) THEN                               !* Salinity damping term (volume flux (emp) and associated heat flux (qns)
+            ELSEIF( nn_sssr == 2 ) THEN               !* Salinity damping term (volume flux, emp and emps)
                zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s]
                zerp_bnd = rn_sssr_bnd / rday                          !       -              -
 …
                      zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths
                         &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )   &
                         &        / MAX(  sss_m(ji,jj), 1.e-20   )
+                        &        / ( sss_m(ji,jj) + 1.e-20   )
                      IF( ln_sssr_bnd )   zerp = SIGN( 1., zerp ) * MIN( zerp_bnd, ABS(zerp) )
                      emp(ji,jj) = emp (ji,jj) + zerp
                      qns(ji,jj) = qns(ji,jj) - zerp * rcp * sst_m(ji,jj)
                      erp(ji,jj) = zerp
+                     emp (ji,jj) = emp (ji,jj) + zerp
+                     emps(ji,jj) = emps(ji,jj) + zerp
+                     erp (ji,jj) = zerp
                   END DO
                END DO

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90

-                      r3651
+                      r6736
   USE daymod
   USE dynspg_oce
   USE tideini
+  USE tide_mod
   USE iom
 …
   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: pot_astro
+  LOGICAL, PUBLIC :: ln_tide_pot = .false.
 #if defined key_tide
   LOGICAL, PUBLIC, PARAMETER ::   lk_tide  = .TRUE.
+  REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) :: omega_tide
+  REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) ::  &
+       v0tide,      &
+       utide,       &
+       ftide
   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: amp_pot,phi_pot
+  INTEGER, PUBLIC :: nb_harmo
+  INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:) :: ntide
+  INTEGER, PUBLIC :: nn_tide, kt_tide
   !!---------------------------------------------------------------------------------
   !!   OPA 9.0 , LODYC-IPSL  (2003)
 …
     !! * Arguments
     INTEGER, INTENT( in ) ::   kt     ! ocean time-step
+    !! * Local declarations
+    INTEGER  :: jk,ji
+    CHARACTER(LEN=4), DIMENSION(jpmax_harmo) :: clname
     !!----------------------------------------------------------------------
     IF ( kt == nit000 .AND. .NOT. lk_dynspg_ts )  CALL ctl_stop( 'STOP', 'sbc_tide : tidal potential use only with time splitting' )
+    NAMELIST/nam_tide/ln_tide_pot,nb_harmo,clname,nn_tide
+    IF ( nsec_day == NINT(0.5 * rdttra(1)) ) THEN
+      !
+    IF ( kt == nit000 ) THEN
+       IF( .NOT. lk_dynspg_ts  )  CALL ctl_stop( 'STOP', 'sbc_tide : tidal potential use only with time splitting' )
+    ! Read Namelist nam_tide
+    nn_tide=INT(rday/rdt)
+    CALL tide_init_Wave
+    REWIND ( numnam )
+    READ   ( numnam, nam_tide )
+    IF(lwp) THEN
+       WRITE(numout,*)
+       WRITE(numout,*) 'sbc_tide : Initialization of the tidal components'
+       WRITE(numout,*) '~~~~~~~ '
+    ENDIF
+    IF(lwp) THEN
+       WRITE(numout,*) '        Namelist nam_tide'
+       WRITE(numout,*) '        Apply astronomical potential : ln_tide_pot =', ln_tide_pot
+       WRITE(numout,*) '        nb_harmo    = ', nb_harmo
+       CALL flush(numout)
+    ENDIF
+    ALLOCATE(ntide     (nb_harmo))
+    DO jk=1,nb_harmo
+       DO ji=1,jpmax_harmo
+          IF (TRIM(clname(jk)) .eq. Wave(ji)%cname_tide) THEN
+             ntide(jk) = ji
+             EXIT
+          END IF
+       END DO
+    END DO
+    ALLOCATE(omega_tide(nb_harmo))
+    ALLOCATE(v0tide    (nb_harmo))
+    ALLOCATE(utide     (nb_harmo))
+    ALLOCATE(ftide     (nb_harmo))
+    ALLOCATE(amp_pot(jpi,jpj,nb_harmo))
+    ALLOCATE(phi_pot(jpi,jpj,nb_harmo))
+    ALLOCATE(pot_astro(jpi,jpj))
+    ENDIF
+    IF ( MOD( kt - 1, nn_tide ) == 0 ) THEN
       kt_tide = kt
+      CALL tide_harmo(omega_tide, v0tide, utide, ftide, ntide, nb_harmo)
+    ENDIF
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'sbc_tide : (re)Initialization of the tidal potential at kt=',kt
+         WRITE(numout,*) '~~~~~~~ '
+      ENDIF
+    amp_pot(:,:,:) = 0.e0
+    phi_pot(:,:,:) = 0.e0
+    pot_astro(:,:) = 0.e0
+      IF(lwp) THEN
+         IF ( kt == nit000 ) WRITE(numout,*) 'Apply astronomical potential : ln_tide_pot =', ln_tide_pot
+         CALL flush(numout)
+      ENDIF
+      IF ( kt == nit000 ) ALLOCATE(amp_pot(jpi,jpj,nb_harmo))
+      IF ( kt == nit000 ) ALLOCATE(phi_pot(jpi,jpj,nb_harmo))
+      IF ( kt == nit000 ) ALLOCATE(pot_astro(jpi,jpj))
+      amp_pot(:,:,:) = 0.e0
+      phi_pot(:,:,:) = 0.e0
+      pot_astro(:,:) = 0.e0
+      IF ( ln_tide_pot ) CALL tide_init_potential
+      !
+    ENDIF
+    IF (ln_tide_pot          ) CALL tide_init_potential
   END SUBROUTINE sbc_tide

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90

-                      r3680
+                      r6736
    !! Wave module
    !!======================================================================
+   !! History :  3.3.1  !   2011-09  (Adani M)  Original code: Drag Coefficient
+   !!         :  3.4    !   2012-10  (Adani M)                 Stokes Drift
+   !! History :  3.3.1  !   2011-09  (Adani M)  Original code
    !!----------------------------------------------------------------------
    USE iom             ! I/O manager library
 …
    USE lib_mpp         ! distribued memory computing library
    USE fldread        ! read input fields
-   USE oce
    USE sbc_oce        ! Surface boundary condition: ocean fields
-   USE domvvl
 …
    PUBLIC   sbc_wave    ! routine called in sbc_blk_core or sbc_blk_mfs
+   INTEGER , PARAMETER ::   jpfld  = 3           ! maximum number of files to read for srokes drift
+   INTEGER , PARAMETER ::   jp_usd = 1           ! index of stokes drift  (i-component) (m/s)    at T-point
+   INTEGER , PARAMETER ::   jp_vsd = 2           ! index of stokes drift  (j-component) (m/s)    at T-point
+   INTEGER , PARAMETER ::   jp_wn  = 3           ! index of wave number                 (1/m)    at T-point
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:)  :: sf_cd    ! structure of input fields (file informations, fields read) Drag Coefficient
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:)  :: sf_sd    ! structure of input fields (file informations, fields read) Stokes Drift
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:)  :: sf_wave     ! structure of input fields (file informations, fields read)
    REAL(wp),PUBLIC,ALLOCATABLE,DIMENSION (:,:)       :: cdn_wave
-   REAL(wp),ALLOCATABLE,DIMENSION (:,:)              :: usd2d,vsd2d,uwavenum,vwavenum
-   REAL(wp),PUBLIC,ALLOCATABLE,DIMENSION (:,:,:)     :: usd3d,vsd3d,wsd3d
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011)
 …
       !! ** Method  : - Read namelist namsbc_wave
       !!              - Read Cd_n10 fields in netcdf files
-      !!              - Read stokes drift 2d in netcdf files
-      !!              - Read wave number      in netcdf files
-      !!              - Compute 3d stokes drift using monochromatic
       !! ** action  :
       !!
       !!---------------------------------------------------------------------
+      USE oce,  ONLY : un,vn,hdivn,rotn
+      USE divcur
+      USE wrk_nemo
+#if defined key_bdy
+      USE bdy_oce, ONLY : bdytmask
+#endif
+      INTEGER, INTENT( in  ) ::  kt       ! ocean time step
+      INTEGER, INTENT( in  ) ::  kt   ! ocean time step
       INTEGER                ::  ierror   ! return error code
+      INTEGER                ::  ifpr, jj,ji,jk
+      REAL(wp),DIMENSION(:,:,:),POINTER             ::  udummy,vdummy,hdivdummy,rotdummy
+      REAL                                          ::  z2dt,z1_2dt
+      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i     ! array of namelist informations on the fields to read
+      CHARACTER(len=100)     ::  cn_dir                          ! Root directory for location of drag coefficient files
+      TYPE(FLD_N)            ::  sn_cdg, sn_usd, sn_vsd, sn_wn   ! informations about the fields to be read
+      CHARACTER(len=100)     ::  cn_dir_cdg                       ! Root directory for location of drag coefficient files
+      TYPE(FLD_N)            ::  sn_cdg                          ! informations about the fields to be read
       !!---------------------------------------------------------------------
       NAMELIST/namsbc_wave/  sn_cdg, cn_dir, sn_usd, sn_vsd, sn_wn
+      NAMELIST/namsbc_wave/  sn_cdg, cn_dir_cdg
       !!---------------------------------------------------------------------
 …
          !              !   name   !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    !
          sn_cdg = FLD_N('cdg_wave'  ,    1     ,'drag_coeff',  .true.    , .false. ,   'daily'   , ''       , ''       )
+         sn_usd = FLD_N('sdw_wave'  ,    1     ,'u_sd2d',      .true.    , .false. ,   'daily'   , ''       , ''       )
+         sn_vsd = FLD_N('sdw_wave'  ,    1     ,'v_sd2d',      .true.    , .false. ,   'daily'   , ''       , ''       )
+         sn_wn = FLD_N( 'sdw_wave'  ,    1     ,'wave_num',    .true.    , .false. ,   'daily'   , ''       , ''       )
+         cn_dir = './'          ! directory in which the wave data are
+         cn_dir_cdg = './'          ! directory in which the Patm data are
 …
+         !
+         IF ( ln_cdgw ) THEN
+            ALLOCATE( sf_cd(1), STAT=ierror )           !* allocate and fill sf_wave with sn_cdg
+            IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave: unable to allocate sf_wave structure' )
+            !
+                                   ALLOCATE( sf_cd(1)%fnow(jpi,jpj,1)   )
+            IF( sn_cdg%ln_tint )   ALLOCATE( sf_cd(1)%fdta(jpi,jpj,1,2) )
+            CALL fld_fill( sf_cd, (/ sn_cdg /), cn_dir, 'sbc_wave', 'Wave module ', 'namsbc_wave' )
+            ALLOCATE( cdn_wave(jpi,jpj) )
+            cdn_wave(:,:) = 0.0
+        ENDIF
+         IF ( ln_sdw ) THEN
+            slf_i(jp_usd) = sn_usd ; slf_i(jp_vsd) = sn_vsd; slf_i(jp_wn) = sn_wn
+            ALLOCATE( sf_sd(3), STAT=ierror )           !* allocate and fill sf_wave with sn_cdg
+            IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave: unable to allocate sf_wave structure' )
+            !
+            DO ifpr= 1, jpfld
+               ALLOCATE( sf_sd(ifpr)%fnow(jpi,jpj,1) )
+               IF( slf_i(ifpr)%ln_tint )   ALLOCATE( sf_sd(ifpr)%fdta(jpi,jpj,1,2) )
+            END DO
+            CALL fld_fill( sf_sd, slf_i, cn_dir, 'sbc_wave', 'Wave module ', 'namsbc_wave' )
+            ALLOCATE( usd2d(jpi,jpj),vsd2d(jpi,jpj),uwavenum(jpi,jpj),vwavenum(jpi,jpj) )
+            ALLOCATE( usd3d(jpi,jpj,jpk),vsd3d(jpi,jpj,jpk),wsd3d(jpi,jpj,jpk) )
+            usd2d(:,:) = 0.0 ;  vsd2d(:,:) = 0.0 ; uwavenum(:,:) = 0.0 ; vwavenum(:,:) = 0.0
+            usd3d(:,:,:) = 0.0 ;vsd3d(:,:,:) = 0.0 ; wsd3d(:,:,:) = 0.0
+         ENDIF
+         ALLOCATE( sf_wave(1), STAT=ierror )           !* allocate and fill sf_wave with sn_cdg
+         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave: unable to allocate sf_wave structure' )
+         !
+         CALL fld_fill( sf_wave, (/ sn_cdg /), cn_dir_cdg, 'sbc_wave', 'Wave module ', 'namsbc_wave' )
+                                ALLOCATE( sf_wave(1)%fnow(jpi,jpj,1)   )
+         IF( sn_cdg%ln_tint )   ALLOCATE( sf_wave(1)%fdta(jpi,jpj,1,2) )
+         ALLOCATE( cdn_wave(jpi,jpj) )
+         cdn_wave(:,:) = 0.0
       ENDIF
+         !
+         !
+      IF ( ln_cdgw ) THEN
+         CALL fld_read( kt, nn_fsbc, sf_cd )      !* read drag coefficient from external forcing
+         cdn_wave(:,:) = sf_cd(1)%fnow(:,:,1)
+      ENDIF
+      IF ( ln_sdw )  THEN
+          CALL fld_read( kt, nn_fsbc, sf_sd )      !* read drag coefficient from external forcing
+      CALL fld_read( kt, nn_fsbc, sf_wave )      !* read drag coefficient from external forcing
+      cdn_wave(:,:) = sf_wave(1)%fnow(:,:,1)
-         ! Interpolate wavenumber, stokes drift into the grid_V and grid_V
-         !-------------------------------------------------
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               uwavenum(ji,jj)=0.5 * ( 2. - umask(ji,jj,1) ) * ( sf_sd(3)%fnow(ji,jj,1) * tmask(ji,jj,1) &
-               &                                + sf_sd(3)%fnow(ji+1,jj,1) * tmask(ji+1,jj,1) )
-               vwavenum(ji,jj)=0.5 * ( 2. - vmask(ji,jj,1) ) * ( sf_sd(3)%fnow(ji,jj,1) * tmask(ji,jj,1) &
-               &                                + sf_sd(3)%fnow(ji,jj+1,1) * tmask(ji,jj+1,1) )
-               usd2d(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( sf_sd(1)%fnow(ji,jj,1) * tmask(ji,jj,1) &
-               &                                + sf_sd(1)%fnow(ji+1,jj,1) * tmask(ji+1,jj,1) )
-               vsd2d(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( sf_sd(2)%fnow(ji,jj,1) * tmask(ji,jj,1) &
-               &                                + sf_sd(2)%fnow(ji,jj+1,1) * tmask(ji,jj+1,1) )
-            END DO
-         END DO
-          !Computation of the 3d Stokes Drift
-          DO jk = 1, jpk
-             DO jj = 1, jpj-1
-                DO ji = 1, jpi-1
-                   usd3d(ji,jj,jk) = usd2d(ji,jj)*exp(2.0*uwavenum(ji,jj)*(-MIN( gdept(ji,jj,jk) , gdept(ji+1,jj  ,jk))))
-                   vsd3d(ji,jj,jk) = vsd2d(ji,jj)*exp(2.0*vwavenum(ji,jj)*(-MIN( gdept(ji,jj,jk) , gdept(ji  ,jj+1,jk))))
-                END DO
-             END DO
-             usd3d(jpi,:,jk) = usd2d(jpi,:)*exp( 2.0*uwavenum(jpi,:)*(-gdept(jpi,:,jk)) )
-             vsd3d(:,jpj,jk) = vsd2d(:,jpj)*exp( 2.0*vwavenum(:,jpj)*(-gdept(:,jpj,jk)) )
-          END DO
-          CALL wrk_alloc( jpi,jpj,jpk,udummy,vdummy,hdivdummy,rotdummy)
-          udummy(:,:,:)=un(:,:,:)
-          vdummy(:,:,:)=vn(:,:,:)
-          hdivdummy(:,:,:)=hdivn(:,:,:)
-          rotdummy(:,:,:)=rotn(:,:,:)
-          un(:,:,:)=usd3d(:,:,:)
-          vn(:,:,:)=vsd3d(:,:,:)
-          CALL div_cur(kt)
-      !                                           !------------------------------!
-      !                                           !     Now Vertical Velocity    !
-      !                                           !------------------------------!
-          z2dt = 2._wp * rdt                              ! set time step size (Euler/Leapfrog)
-          z1_2dt = 1.e0 / z2dt
-          DO jk = jpkm1, 1, -1                             ! integrate from the bottom the hor. divergence
-             ! - ML - need 3 lines here because replacement of fse3t by its expression yields too long lines otherwise
-             wsd3d(:,:,jk) = wsd3d(:,:,jk+1) -   fse3t_n(:,:,jk) * hdivn(:,:,jk)        &
-                &                      - ( fse3t_a(:,:,jk) - fse3t_b(:,:,jk) )    &
-                &                         * tmask(:,:,jk) * z1_2dt
-#if defined key_bdy
-             wsd3d(:,:,jk) = wsd3d(:,:,jk) * bdytmask(:,:)
-#endif
-          END DO
-          hdivn(:,:,:)=hdivdummy(:,:,:)
-          rotn(:,:,:)=rotdummy(:,:,:)
-          vn(:,:,:)=vdummy(:,:,:)
-          un(:,:,:)=udummy(:,:,:)
-          CALL wrk_dealloc( jpi,jpj,jpk,udummy,vdummy,hdivdummy,rotdummy)
-      ENDIF
    END SUBROUTINE sbc_wave

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/SBC/tide_mod.F90

-                      r3670
+                      r6736
   USE phycst
   USE daymod
+  USE in_out_manager  ! I/O units
   IMPLICIT NONE
 …
        jpmax_harmo = 19             ! maximum number of harmonic
   TYPE, PUBLIC ::    tide
+  TYPE,PUBLIC:: tide
      CHARACTER(LEN=4)  :: cname_tide
      REAL(wp) :: equitide
 …
   PUBLIC nodal_factort
   PUBLIC tide_init_Wave
+  PUBLIC tide_pulse
 CONTAINS
 …
   END SUBROUTINE tide_init_Wave
+  SUBROUTINE tide_harmo( pomega, pvt, put , pcor, ktide ,kc)
+  SUBROUTINE tide_harmo( pomega, pvt, put , pcor, ktide ,kc, rdate)
+    INTEGER, INTENT( in ), OPTIONAL :: &
+         rdate      ! Reference date for tidal data
     INTEGER, DIMENSION(kc), INTENT( in ) ::   &
 …
          pcor         !
+    CALL astronomic_angle
+    IF( PRESENT(rdate) ) THEN
+       CALL astronomic_angle(rdate)
+    ELSE
+       CALL astronomic_angle
+    ENDIF
     CALL tide_pulse(pomega, ktide ,kc)
     CALL tide_vuf( pvt, put, pcor, ktide ,kc)
 …
   END SUBROUTINE tide_harmo
+  SUBROUTINE astronomic_angle
+  SUBROUTINE astronomic_angle(rdate)
+    INTEGER, INTENT( in ),OPTIONAL :: &
+         rdate         ! Reference Year
     !!----------------------------------------------------------------------
 …
     REAL(wp) ::  cosI,p,q,t2,t4,sin2I,s2,tgI2,P1,sh_tgn2,at1,at2
     REAL(wp) :: zqy,zsy,zday,zdj,zhfrac
+    zqy=AINT((nyear-1901.)/4.)
+    zsy=nyear-1900.
+    zdj=dayjul(nyear,nmonth,nday)
+    INTEGER  :: lcl_ryear, lcl_rmonth, lcl_rday
+    IF( PRESENT(rdate) )   THEN
+       lcl_ryear  = int(rdate / 10000  )
+       lcl_rmonth = int((rdate  - lcl_ryear * 10000 ) / 100 )
+       lcl_rday   = int(rdate  - lcl_ryear * 10000 - lcl_rmonth * 100)
+    ELSE
+       lcl_ryear  = nyear
+       lcl_rmonth = nmonth
+       lcl_rday   = nday
+    ENDIF
+    zqy=AINT((lcl_ryear-1901.)/4.)
+    zsy=lcl_ryear-1900.
+    zdj=dayjul(lcl_ryear,lcl_rmonth,lcl_rday)
     zday=zdj+zqy-1.
+    zhfrac=nsec_day/3600.
+    IF( PRESENT(rdate) )   THEN
+       zhfrac=0._wp
+    ELSE
+       zhfrac=nsec_day/3600._wp
+    ENDIF
     !----------------------------------------------------------------------
 …
     case ( 11 )
        zf=nodal_factort(75)
        zf=nodal_factort(0)
+       zf1=nodal_factort(0)
        zf=zf*zf1

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90

-                      r3651
+                      r6736
   USE sbctide
   USE dynspg_oce
-  USE tideini, ONLY: ln_tide_ramp, rdttideramp
   IMPLICIT NONE
 …
     INTEGER, INTENT( in ) ::   kt,kit      ! ocean time-step index
     INTEGER  :: ji,jj,jk
-    REAL (wp) :: zramp
     REAL (wp), DIMENSION(nb_harmo) :: zwt
+    !...............................................................................
+    ! Potentiel astronomique
     !...............................................................................
     pot_astro(:,:)=0.e0
-    zramp = 1.e0
     IF (lk_dynspg_ts) THEN
        zwt(:) = omega_tide(:)* ((kt-kt_tide)*rdt + kit*(rdt/REAL(nn_baro,wp)))
-       IF (ln_tide_ramp) THEN
-          zramp = MIN(MAX( ((kt-nit000)*rdt + kit*(rdt/REAL(nn_baro,wp)))/(rdttideramp*rday),0.),1.)
-       ENDIF
     ELSE
        zwt(:) = omega_tide(:)*(kt-kt_tide)*rdt
-       IF (ln_tide_ramp) THEN
-          zramp = MIN(MAX( ((kt-nit000)*rdt)/(rdttideramp*rday),0.),1.)
-       ENDIF
     ENDIF
 …
        do ji=1,jpi
           do jj=1,jpj
              pot_astro(ji,jj)=pot_astro(ji,jj) + zramp*(amp_pot(ji,jj,jk)*COS(zwt(jk)+phi_pot(ji,jj,jk)))
+             pot_astro(ji,jj)=pot_astro(ji,jj) + (amp_pot(ji,jj,jk)*COS(zwt(jk)+phi_pot(ji,jj,jk)))
           enddo
        enddo

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90

-                      r3609
+                      r6736
       IF( nn_solv == 2 .AND. MAX( jpr2di, jpr2dj ) > 0) THEN
          CALL lbc_lnk_e( gcp   (:,:,1), c_solver_pt, 1., jpr2di, jpr2dj )   ! lateral boundary conditions
          CALL lbc_lnk_e( gcp   (:,:,2), c_solver_pt, 1., jpr2di, jpr2dj )   ! lateral boundary conditions
          CALL lbc_lnk_e( gcp   (:,:,3), c_solver_pt, 1., jpr2di, jpr2dj )   ! lateral boundary conditions
          CALL lbc_lnk_e( gcp   (:,:,4), c_solver_pt, 1., jpr2di, jpr2dj )   ! lateral boundary conditions
          CALL lbc_lnk_e( gcdprc(:,:)  , c_solver_pt, 1., jpr2di, jpr2dj )   ! lateral boundary conditions
          CALL lbc_lnk_e( gcdmat(:,:)  , c_solver_pt, 1., jpr2di, jpr2dj )   ! lateral boundary conditions
+         CALL lbc_lnk_e( gcp   (:,:,1), c_solver_pt, 1. )   ! lateral boundary conditions
+         CALL lbc_lnk_e( gcp   (:,:,2), c_solver_pt, 1. )   ! lateral boundary conditions
+         CALL lbc_lnk_e( gcp   (:,:,3), c_solver_pt, 1. )   ! lateral boundary conditions
+         CALL lbc_lnk_e( gcp   (:,:,4), c_solver_pt, 1. )   ! lateral boundary conditions
+         CALL lbc_lnk_e( gcdprc(:,:)  , c_solver_pt, 1. )   ! lateral boundary conditions
+         CALL lbc_lnk_e( gcdmat(:,:)  , c_solver_pt, 1. )   ! lateral boundary conditions
          IF( npolj /= 0 ) CALL sol_exd( gcp , c_solver_pt ) ! switch northernelements
       END IF

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/SOL/solsor.F90

-                      r3609
+                      r6736
          !                                                    ! ==============
          IF( MOD(icount,ijpr2d+1) == 0 )   CALL lbc_lnk_e( gcx, c_solver_pt, 1., jpr2di, jpr2dj )   ! lateral boundary conditions
+         IF( MOD(icount,ijpr2d+1) == 0 )   CALL lbc_lnk_e( gcx, c_solver_pt, 1. )   ! lateral boundary conditions
          ! Residus
 …
          icount = icount + 1
          IF( MOD(icount,ijpr2d+1) == 0 )   CALL lbc_lnk_e( gcx, c_solver_pt, 1., jpr2di, jpr2dj )   ! lateral boundary conditions
+         IF( MOD(icount,ijpr2d+1) == 0 )   CALL lbc_lnk_e( gcx, c_solver_pt, 1. )   ! lateral boundary conditions
          ! Guess red update
 …
       !  Output in gcx
       !  -------------
       CALL lbc_lnk_e( gcx, c_solver_pt, 1._wp, jpr2di, jpr2dj )    ! boundary conditions
+      CALL lbc_lnk_e( gcx, c_solver_pt, 1. )    ! boundary conditions
+      !
       CALL wrk_dealloc( jpi, jpj, ztab )

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

-                      r3625
+                      r6736
       REAL(wp) ::   zd , zc , zaw, za    !   -      -
       REAL(wp) ::   zb1, za1, zkw, zk0   !   -      -
+      REAL(wp) ::   zrau0r               !   -      -
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zws
       !!----------------------------------------------------------------------
 …
+      !
       CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==!
+         zrau0r = 1.e0 / rau0
 !CDIR NOVERRCHK
          zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) )
 …
                   ! masked in situ density anomaly
                   prd(ji,jj,jk) = (  zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  )    &
                      &             - rau0  ) * r1_rau0 * tmask(ji,jj,jk)
+                     &             - rau0  ) * zrau0r * tmask(ji,jj,jk)
                END DO
             END DO
 …
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
       REAL(wp) ::   zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw   ! local scalars
       REAL(wp) ::   zb, zd, zc, zaw, za, zb1, za1, zkw, zk0               !   -      -
+      REAL(wp) ::   zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zrau0r       !   -      -
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zws
       !!----------------------------------------------------------------------
 …
+      !
       CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==!
+         zrau0r = 1.e0 / rau0
 !CDIR NOVERRCHK
          zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) )
 …
                   ! masked in situ density anomaly
                   prd(ji,jj,jk) = (  zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  )    &
                      &             - rau0  ) * r1_rau0 * tmask(ji,jj,jk)
+                     &             - rau0  ) * zrau0r * tmask(ji,jj,jk)
                END DO
             END DO

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

-                      r3718
+                      r6736
    LOGICAL ::   ln_traadv_ubs    = .FALSE.   ! UBS scheme flag
    LOGICAL ::   ln_traadv_qck    = .FALSE.   ! QUICKEST scheme flag
-   LOGICAL ::   ln_traadv_msc_ups= .FALSE.   ! use upstream scheme within muscl
    INTEGER ::   nadv   ! choice of the type of advection scheme
 …
       CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt, nit000, 'TRA',         zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  2nd order centered
       CASE ( 2 )   ;    CALL tra_adv_tvd   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  TVD
       CASE ( 3 )   ;    CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb,      tsa, jpts, ln_traadv_msc_ups )   !  MUSCL
+      CASE ( 3 )   ;    CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb,      tsa, jpts )   !  MUSCL
       CASE ( 4 )   ;    CALL tra_adv_muscl2( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  MUSCL2
       CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  UBS
 …
          CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv1 - Ta: ', mask1=tmask,               &
             &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
          CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb,      tsa, jpts, ln_traadv_msc_ups )
+         CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb,      tsa, jpts )
          CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv3 - Ta: ', mask1=tmask,               &
             &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
 …
       NAMELIST/namtra_adv/ ln_traadv_cen2 , ln_traadv_tvd,     &
          &                 ln_traadv_muscl, ln_traadv_muscl2,  &
+         &                 ln_traadv_ubs  , ln_traadv_qck,     &
+         &                 ln_traadv_msc_ups
+         &                 ln_traadv_ubs  , ln_traadv_qck
       !!----------------------------------------------------------------------
 …
          WRITE(numout,*) '~~~~~~~~~~~'
          WRITE(numout,*) '   Namelist namtra_adv : chose a advection scheme for tracers'
+         WRITE(numout,*) '      2nd order advection scheme     ln_traadv_cen2    = ', ln_traadv_cen2
+         WRITE(numout,*) '      TVD advection scheme           ln_traadv_tvd     = ', ln_traadv_tvd
+         WRITE(numout,*) '      MUSCL  advection scheme        ln_traadv_muscl   = ', ln_traadv_muscl
+         WRITE(numout,*) '      MUSCL2 advection scheme        ln_traadv_muscl2  = ', ln_traadv_muscl2
+         WRITE(numout,*) '      UBS    advection scheme        ln_traadv_ubs     = ', ln_traadv_ubs
+         WRITE(numout,*) '      QUICKEST advection scheme      ln_traadv_qck     = ', ln_traadv_qck
+         WRITE(numout,*) '      upstream scheme within muscl   ln_traadv_msc_ups = ', ln_traadv_msc_ups
+         WRITE(numout,*) '      2nd order advection scheme     ln_traadv_cen2   = ', ln_traadv_cen2
+         WRITE(numout,*) '      TVD advection scheme           ln_traadv_tvd    = ', ln_traadv_tvd
+         WRITE(numout,*) '      MUSCL  advection scheme        ln_traadv_muscl  = ', ln_traadv_muscl
+         WRITE(numout,*) '      MUSCL2 advection scheme        ln_traadv_muscl2 = ', ln_traadv_muscl2
+         WRITE(numout,*) '      UBS    advection scheme        ln_traadv_ubs    = ', ln_traadv_ubs
+         WRITE(numout,*) '      QUICKEST advection scheme      ln_traadv_qck    = ', ln_traadv_qck
       ENDIF

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90

-                      r3718
+                      r6736
    USE diaptr          ! poleward transport diagnostics
    USE zdf_oce         ! ocean vertical physics
+   USE restart         ! ocean restart
    USE trc_oce         ! share passive tracers/Ocean variables
    USE lib_mpp         ! MPP library
 …
          IF(lwp) WRITE(numout,*)
+         !
          IF ( .NOT. ALLOCATED( upsmsk ) )  THEN
+         IF (.not. ALLOCATED(upsmsk))THEN
              ALLOCATE( upsmsk(jpi,jpj), STAT=ierr )
              IF( ierr /= 0 )   CALL ctl_stop('STOP', 'tra_adv_cen2: unable to allocate array')

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90

-                      r3718
+                      r6736
    !!   NEMO     1.0  !  2002-06  (G. Madec)  F90: Free form and module
    !!            3.2  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
-   !!            3.4  !  2012-06  (P. Oddo, M. Vichi) include the upstream where needed
    !!----------------------------------------------------------------------
 …
    !!                   and vertical advection trends using MUSCL scheme
    !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers
+   USE dom_oce        ! ocean space and time domain
+   USE trdmod_oce     ! tracers trends
+   USE trdtra         ! tracers trends
+   USE in_out_manager ! I/O manager
+   USE dynspg_oce     ! choice/control of key cpp for surface pressure gradient
+   USE trabbl         ! tracers: bottom boundary layer
+   USE lib_mpp        ! distribued memory computing
+   USE lbclnk         ! ocean lateral boundary condition (or mpp link)
+   USE diaptr         ! poleward transport diagnostics
+   USE trc_oce        ! share passive tracers/Ocean variables
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE eosbn2          ! equation of state
+   USE sbcrnf          ! river runoffs
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE trdmod_oce      ! tracers trends
+   USE trdtra      ! tracers trends
+   USE in_out_manager  ! I/O manager
+   USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient
+   USE trabbl          ! tracers: bottom boundary layer
+   USE lib_mpp         ! distribued memory computing
+   USE lbclnk          ! ocean lateral boundary condition (or mpp link)
+   USE diaptr          ! poleward transport diagnostics
+   USE trc_oce         ! share passive tracers/Ocean variables
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
    IMPLICIT NONE
 …
    PUBLIC   tra_adv_muscl  ! routine called by step.F90
+   LOGICAL  :: l_trd                        ! flag to compute trends
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: upsmsk !: mixed upstream/centered scheme near some straits
+   !                                                             !  and in closed seas (orca 2 and 4 configurations)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xind         !: mixed upstream/centered index
+   LOGICAL  :: l_trd       ! flag to compute trends
    !! * Substitutions
 #  include "domzgr_substitute.h90"
 …
    SUBROUTINE tra_adv_muscl( kt, kit000, cdtype, p2dt, pun, pvn, pwn, &
       &                                        ptb, pta, kjpt, ld_msc_ups )
+      &                                        ptb, pta, kjpt )
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE tra_adv_muscl  ***
 …
       CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
       INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
-      LOGICAL                              , INTENT(in   ) ::   ld_msc_ups      ! use upstream scheme within muscl
       REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb             ! before tracer field
       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend
+      !
       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
 …
       REAL(wp) ::   ztra, zbtr, zdt, zalpha   !   -      -
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zslpx, zslpy
-      INTEGER  ::   ierr
       !!----------------------------------------------------------------------
+      !
 …
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) 'tra_adv : MUSCL advection scheme on ', cdtype
-         IF(lwp) WRITE(numout,*) '        : mixed up-stream           ', ld_msc_ups
          IF(lwp) WRITE(numout,*) '~~~~~~~'
-         IF(lwp) WRITE(numout,*)
+         !
+         !
-         IF( ld_msc_ups ) THEN
-            IF( .NOT. ALLOCATED( upsmsk ) )  THEN
-                ALLOCATE( upsmsk(jpi,jpj), STAT=ierr )
-                IF( ierr /= 0 )   CALL ctl_stop('STOP', 'tra_adv_muscl: unable to allocate upsmsk array')
-            ENDIF
-            upsmsk(:,:) = 0._wp                             ! not upstream by default
-         ENDIF
-         IF( .NOT. ALLOCATED( xind ) ) THEN
-             ALLOCATE( xind(jpi,jpj,jpk), STAT=ierr )
-             IF( ierr /= 0 )   CALL ctl_stop('STOP', 'tra_adv_muscl: unable to allocate zind array')
-         ENDIF
+         !
+         !
          l_trd = .FALSE.
          IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
+         !
+         ! Upstream / centered scheme indicator
+         ! ------------------------------------
+         xind(:,:,:) = 1._wp                             ! set equal to 1 where up-stream is not needed
+         !
+         IF( ld_msc_ups )  THEN
+            DO jk = 1, jpk
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     xind(ji,jj,jk) = 1  - MAX (           &
+                        rnfmsk(ji,jj) * rnfmsk_z(jk),      &  ! near runoff mouths (& closed sea outflows)
+                        upsmsk(ji,jj) ) * tmask(ji,jj,jk)     ! some of some straits
+                  END DO
+               END DO
+            END DO
+         ENDIF
+         !
+      ENDIF
+      ENDIF
       !                                                     ! ===========
       DO jn = 1, kjpt                                       ! tracer loop
 …
                   zalpha = 0.5 - z0u
                   zu  = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) )
                   zzwx = ptb(ji+1,jj,jk,jn) + xind(ji,jj,jk) * (zu * zslpx(ji+1,jj,jk))
                   zzwy = ptb(ji  ,jj,jk,jn) + xind(ji,jj,jk) * (zu * zslpx(ji  ,jj,jk))
+                  zzwx = ptb(ji+1,jj,jk,jn) + zu * zslpx(ji+1,jj,jk)
+                  zzwy = ptb(ji  ,jj,jk,jn) + zu * zslpx(ji  ,jj,jk)
                   zwx(ji,jj,jk) = pun(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
+                  !
 …
                   zalpha = 0.5 - z0v
                   zv  = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) )
                   zzwx = ptb(ji,jj+1,jk,jn) + xind(ji,jj,jk) * (zv * zslpy(ji,jj+1,jk))
                   zzwy = ptb(ji,jj  ,jk,jn) + xind(ji,jj,jk) * (zv * zslpy(ji,jj  ,jk))
+                  zzwx = ptb(ji,jj+1,jk,jn) + zv * zslpy(ji,jj+1,jk)
+                  zzwy = ptb(ji,jj  ,jk,jn) + zv * zslpy(ji,jj  ,jk)
                   zwy(ji,jj,jk) = pvn(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
                END DO
 …
                   zalpha = 0.5 + z0w
                   zw  = z0w - 0.5 * pwn(ji,jj,jk+1) * zdt * zbtr
                   zzwx = ptb(ji,jj,jk+1,jn) + xind(ji,jj,jk) * (zw * zslpx(ji,jj,jk+1))
                   zzwy = ptb(ji,jj,jk  ,jn) + xind(ji,jj,jk) * (zw * zslpx(ji,jj,jk  ))
+                  zzwx = ptb(ji,jj,jk+1,jn) + zw * zslpx(ji,jj,jk+1)
+                  zzwy = ptb(ji,jj,jk  ,jn) + zw * zslpx(ji,jj,jk  )
                   zwx(ji,jj,jk+1) = pwn(ji,jj,jk+1) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
                END DO

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90

-                      r3625
+                      r6736
    USE wrk_nemo        ! Memory Allocation
    USE timing          ! Timing
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
    IMPLICIT NONE

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90

r3625	r6736
28	28	USE wrk_nemo ! Memory Allocation
29	29	USE timing ! Timing
30		USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
	30	USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
31	31
32	32	IMPLICIT NONE

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

-                      r3625
+                      r6736
    !!             -   !  2009-11  (V. Garnier) Surface pressure gradient organization
    !!            3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
+   !!            3.4.1!  2013-05  (H. Liu) add vertical PPM option (vppm)
    !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
+   !!   tra_adv_tvd   : update the tracer trend with the 3D advection trends using a TVD scheme
+   !!   nonosc        : compute monotonic tracer fluxes by a non-oscillatory algorithm
+   !!   tra_adv_tvd  : update the tracer trend with the horizontal
+   !!                  and vertical advection trends using a TVD scheme
+   !!   nonosc       : compute monotonic tracer fluxes by a nonoscillatory
+   !!                  algorithm
    !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers
+   USE dom_oce        ! ocean space and time domain
+   USE trdmod_oce     ! tracers trends
+   USE trdtra         ! tracers trends
+   USE in_out_manager ! I/O manager
+   USE dynspg_oce     ! choice/control of key cpp for surface pressure gradient
+   USE lib_mpp        ! MPP library
+   USE lbclnk         ! ocean lateral boundary condition (or mpp link)
+   USE diaptr         ! poleward transport diagnostics
+   USE trc_oce        ! share passive tracers/Ocean variables
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE trdmod_oce      ! tracers trends
+   USE trdtra          ! tracers trends
+   USE in_out_manager  ! I/O manager
+   USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient
+   USE lib_mpp         ! MPP library
+   USE lbclnk          ! ocean lateral boundary condition (or mpp link)
+   USE diaptr          ! poleward transport diagnostics
+   USE trc_oce         ! share passive tracers/Ocean variables
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+#if defined key_vppm
+   USE traadv_vppm     ! vertical ppm scheme
+   !N.B. naac = 1 will not work here
+#endif
    IMPLICIT NONE
 …
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz
       REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz
+#if defined key_vppm
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: hflux
+#endif
       !!----------------------------------------------------------------------
+      !
 …
+      !
       CALL wrk_alloc( jpi, jpj, jpk, zwi, zwz )
+#if defined key_vppm
+      CALL wrk_alloc( jpi, jpj, jpk, hflux )
+#endif
+      !
       IF( kt == kit000 )  THEN
          IF(lwp) WRITE(numout,*)
+#if defined key_vppm
+         IF(lwp) WRITE(numout,*) 'tra_adv_tvd : TVD_vPPM advection scheme on ', cdtype
+#else
          IF(lwp) WRITE(numout,*) 'tra_adv_tvd : TVD advection scheme on ', cdtype
+#endif
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+         !
 …
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+#if defined key_vppm
+                  hflux(ji,jj,jk)  = - (zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+                     &             +    zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  ))
+                  ztra = zbtr * ( hflux(ji,jj,jk) - ( zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) )
+                  hflux(ji,jj,jk)  = hflux(ji,jj,jk) * tmask(ji,jj,jk)
+#else
                   ! total intermediate advective trends
                   ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
                      &             + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
                      &             + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) )
+                  pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn)         + ztra
+#endif
                   ! update and guess with monotonic sheme
-                  pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn)         + ztra
                   zwi(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + z2dtt * ztra ) * tmask(ji,jj,jk)
                END DO
 …
          !                             ! Lateral boundary conditions on zwi  (unchanged sign)
          CALL lbc_lnk( zwi, 'T', 1. )
+!#if defined key_vppm
+!         CALL lbc_lnk( hflux, 'T', 1. ) ! this call seems unnecessary, H.Liu
+!#endif
          !                                 ! trend diagnostics (contribution of upstream fluxes)
 …
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+#if defined key_vppm
+                  ztra =  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk ) +             &
+                     &    zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk )
+                  hflux(ji,jj,jk) =  hflux(ji,jj,jk) - ztra * tmask(ji,jj,jk)
+#else
                   ! total advective trends
                   ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
 …
                      &             + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) )
                   ! add them to the general tracer trends
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+         END DO
+                 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+#endif
+               END DO
+            END DO
+         END DO
+#if defined key_vppm
+         !CALL lbc_lnk( hflux, 'T', 1. ) ! This call seems unnecessary. H.Liu
+         CALL tra_adv_vppm(pta(:,:,:,jn), ptb(:,:,:,jn), hflux, z2dtt)   ! pta has been updated during this call
+#endif
          !                                 ! trend diagnostics (contribution of upstream fluxes)
 …
+      !
                    CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz )
+#if defined key_vppm
+                   CALL wrk_dealloc( jpi, jpj, jpk, hflux )
+#endif
       IF( l_trd )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )
+      !

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90

-                      r3787
+                      r6736
    !!                 advection trends using a third order biaised scheme
    !!----------------------------------------------------------------------
    USE oce            ! ocean dynamics and active tracers
    USE dom_oce        ! ocean space and time domain
    USE trdmod_oce     ! ocean space and time domain
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE trdmod_oce         ! ocean space and time domain
    USE trdtra
    USE lib_mpp
    USE lbclnk         ! ocean lateral boundary condition (or mpp link)
    USE in_out_manager ! I/O manager
    USE diaptr         ! poleward transport diagnostics
    USE dynspg_oce     ! choice/control of key cpp for surface pressure gradient
    USE trc_oce        ! share passive tracers/Ocean variables
    USE wrk_nemo       ! Memory Allocation
    USE timing         ! Timing
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE lbclnk          ! ocean lateral boundary condition (or mpp link)
+   USE in_out_manager  ! I/O manager
+   USE diaptr          ! poleward transport diagnostics
+   USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient
+   USE trc_oce         ! share passive tracers/Ocean variables
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
    IMPLICIT NONE
 …
       !!      and add it to the general trend of passive tracer equations.
       !!
       !! ** Method  :   The upstream biased 3rd order scheme (UBS) is based on an
+      !! ** Method  :   The upstream biased 3rd order scheme (UBS) is based on an
       !!      upstream-biased parabolic interpolation (Shchepetkin and McWilliams 2005)
       !!      It is only used in the horizontal direction.
 …
          ! Surface value
          IF( lk_vvl ) THEN   ;   ztw(:,:,1) = 0.e0                      ! variable volume : flux set to zero
          ELSE                ;   ztw(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)   ! free constant surface
+         IF( lk_vvl ) THEN   ;   ztw(:,:,1) = 0.e0                         ! variable volume : flux set to zero
+         ELSE                ;   ztw(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)   ! constant volume : non zero flux though z=0
          ENDIF
          !  upstream advection with initial mass fluxes & intermediate update

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90

-                      r3625
+                      r6736
          CASE ( 1 )                          !* constant flux
             IF(lwp) WRITE(numout,*) '      *** constant heat flux  =   ', rn_geoflx_cst
             qgh_trd0(:,:) = r1_rau0_rcp * rn_geoflx_cst
+            qgh_trd0(:,:) = ro0cpr * rn_geoflx_cst
+            !
          CASE ( 2 )                          !* variable geothermal heat flux : read the geothermal fluxes in mW/m2
 …
             CALL iom_get  ( inum, jpdom_data, 'heatflow', qgh_trd0 )
             CALL iom_close( inum )
             qgh_trd0(:,:) = r1_rau0_rcp * qgh_trd0(:,:) * 1.e-3     ! conversion in W/m2
+            qgh_trd0(:,:) = ro0cpr * qgh_trd0(:,:) * 1.e-3     ! conversion in W/m2
+            !
          CASE DEFAULT

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

r3805	r6736
221	221	z2d(:,:) = 0._wp
222	222	! note sign is reversed to give down-gradient diffusive transports (#1043)
223		zztmp = -1.0_wp * rau0 * rcp
	223	zztmp = -1.0_wp * rau0 * rcp
224	224	DO jk = 1, jpkm1
225	225	DO jj = 2, jpjm1

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

-                      r3680
+                      r6736
    USE iom             ! I/O manager
    USE fldread         ! read input fields
+   USE restart         ! ocean restart
    USE lib_mpp         ! MPP library
    USE wrk_nemo       ! Memory Allocation
 …
             IF(lwp) WRITE(numout,*) '          nit000-1 qsr tracer content forcing field red in the restart file'
             zfact = 0.5e0
+            qsr_hc(:,:,:) = 0._wp
+!           qsr_hc_b(:,:,:) = 0.e0                 ! don't think this is needed
             CALL iom_get( numror, jpdom_autoglo, 'qsr_hc_b', qsr_hc_b )   ! before heat content trend due to Qsr flux
          ELSE                                           ! No restart or restart not found: Euler forward time stepping
             zfact = 1.e0
+            qsr_hc(:,:,:) = 0.e0
             qsr_hc_b(:,:,:) = 0.e0
          ENDIF
 …
          !                                        ! ============================================== !
          DO jk = 1, jpkm1
             qsr_hc(:,:,jk) = r1_rau0_rcp * ( etot3(:,:,jk) - etot3(:,:,jk+1) )
+            qsr_hc(:,:,jk) = ro0cpr * ( etot3(:,:,jk) - etot3(:,:,jk+1) )
          END DO
          !                                        Add to the general trend
 …
+               !
                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     ! below 400m set to zero
+                  qsr_hc(:,:,jk) = ro0cpr * ( zea(:,:,jk) - zea(:,:,jk+1) )
+               END DO
+               zea(:,:,nksr+1:jpk) = 0._wp     ! below 400m set to zero
                CALL iom_put( 'qsr3d', zea )   ! Shortwave Radiation 3D distribution
+               !
 …
+            !
             IF( lk_vvl ) THEN                                  !* variable volume
                zz0   =        rn_abs   * r1_rau0_rcp
                zz1   = ( 1. - rn_abs ) * r1_rau0_rcp
+               zz0   =        rn_abs   * ro0cpr
+               zz1   = ( 1. - rn_abs ) * ro0cpr
                DO jk = 1, nksr                    ! solar heat absorbed at T-point in the top 400m
                   DO jj = 1, jpj
 …
                   END DO
                END DO
+!                 qsr_hc(:,:,nksr+1:jpk) = 0._wp               ! below nksr set to zero
             ELSE                                               !* constant volume: coef. computed one for all
                DO jk = 1, nksr
 …
+                  !
                   DO jk = 1, nksr
                      etot3(:,:,jk) = r1_rau0_rcp * ( zea(:,:,jk) - zea(:,:,jk+1) )
+                     etot3(:,:,jk) = ro0cpr * ( zea(:,:,jk) - zea(:,:,jk+1) )
                   END DO
                   etot3(:,:,nksr+1:jpk) = 0.e0                ! below 400m set to zero
+                  etot3(:,:,nksr+1:jpk) = 0._wp                ! below 400m set to zero
                ENDIF
             ENDIF
 …
                IF(lwp) WRITE(numout,*) '        key_vvl: light distribution will be computed at each time step'
             ELSE                                ! constant volume: computes one for all
                zz0 =        rn_abs   * r1_rau0_rcp
                zz1 = ( 1. - rn_abs ) * r1_rau0_rcp
+               zz0 =        rn_abs   * ro0cpr
+               zz1 = ( 1. - rn_abs ) * ro0cpr
                DO jk = 1, nksr                    !*  solar heat absorbed at T-point computed once for all
                   DO jj = 1, jpj                              ! top 400 meters
 …
                   END DO
                END DO
                etot3(:,:,nksr+1:jpk) = 0.e0                   ! below 400m set to zero
+               etot3(:,:,nksr+1:jpk) = 0._wp                   ! below 400m set to zero
+               !
             ENDIF

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

-                      r3764
+                      r6736
    USE in_out_manager  ! I/O manager
    USE prtctl          ! Print control
+   USE restart         ! ocean restart
    USE sbcrnf          ! River runoff
    USE sbcmod          ! ln_rnf
 …
       !!         at the surface by evaporation, precipitations and runoff (E-P-R);
       !!      (3) Fwe, tracer carried with the water that is exchanged.
-      !!            - salinity    : salt flux only due to freezing/melting
-      !!            sa = sa +  sfx / rau0 / e3t  for k=1
       !!
       !!      Fext, flux through the air-sea interface for temperature and salt:
 …
       !!            (Tp P - Te E) + SST (P-E) = 0 when Tp=Te=SST
       !!            - salinity    : evaporation, precipitation and runoff
+      !!         water has a zero salinity  but there is a salt flux due to
+      !!         freezing/melting, thus:
+      !!            sa = sa + emp * sn / rau0 / e3t   for k=1
+      !!                    + sfx    / rau0 / e3t
+      !!         water has a zero salinity (Fwe=0), thus only Fwi remains:
+      !!            sa = sa + emp * sn / e3t   for k=1
       !!         where emp, the surface freshwater budget (evaporation minus
       !!         precipitation minus runoff) given in kg/m2/s is divided
       !!         by rau0 = 1020 kg/m3 (density of sea water) to obtain m/s.
+      !!         by 1035 kg/m3 (density of ocena water) to obtain m/s.
       !!         Note: even though Fwe does not appear explicitly for
       !!         temperature in this routine, the heat carried by the water
 …
       !!
       INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices
       REAL(wp) ::   zfact, z1_e3t, zdep
+      REAL(wp) ::   zfact, z1_e3t, zsrau, zdep
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds
       !!----------------------------------------------------------------------
 …
          IF(lwp) WRITE(numout,*) '~~~~~~~ '
       ENDIF
+      zsrau = 1. / rau0             ! initialization
       IF( l_trdtra )   THEN                    !* Save ta and sa trends
 …
                                                    ! evaporation, precipitation and qns, but not river runoff
       IF( lk_vvl ) THEN                            ! Variable Volume case  ==>> heat content of mass flux is in qns
+      IF( lk_vvl ) THEN                            ! Variable Volume case
          DO jj = 1, jpj
             DO ji = 1, jpi
+               sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj)                              ! non solar heat flux
+               sbc_tsc(ji,jj,jp_sal) = r1_rau0     * sfx(ji,jj)                              ! salt flux due to freezing/melting
+               ! temperature : heat flux + cooling/heating effet of EMP flux
+               sbc_tsc(ji,jj,jp_tem) = ro0cpr * qns(ji,jj) - zsrau * emp(ji,jj) * tsn(ji,jj,1,jp_tem)
+               ! concent./dilut. effect due to sea-ice melt/formation and (possibly) SSS restoration
+               sbc_tsc(ji,jj,jp_sal) = ( emps(ji,jj) - emp(ji,jj) ) * zsrau * tsn(ji,jj,1,jp_sal)
             END DO
          END DO
       ELSE                                         ! Constant Volume case ==>> Concentration dilution effect
+      ELSE                                         ! Constant Volume case
          DO jj = 2, jpj
             DO ji = fs_2, fs_jpim1   ! vector opt.
                ! temperature : heat flux
+               sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj)                          &   ! non solar heat flux
+                  &                  + r1_rau0     * emp(ji,jj)  * tsn(ji,jj,1,jp_tem)       ! concent./dilut. effect
+               ! salinity    : salt flux + concent./dilut. effect (both in sfx)
+               sbc_tsc(ji,jj,jp_sal) = r1_rau0  * (  sfx(ji,jj)                          &   ! salt flux (freezing/melting)
+                  &                                + emp(ji,jj) * tsn(ji,jj,1,jp_sal) )      ! concent./dilut. effect
+               sbc_tsc(ji,jj,jp_tem) = ro0cpr * qns(ji,jj)
+               ! salinity    : salt flux + concent./dilut. effect (both in emps)
+               sbc_tsc(ji,jj,jp_sal) = zsrau * emps(ji,jj) * tsn(ji,jj,1,jp_sal)
             END DO
          END DO
-         CALL iom_put( "emp_x_sst", emp (:,:) * tsn(:,:,1,jp_tem) )                          ! c/d term on sst
-         CALL iom_put( "emp_x_sss", emp (:,:) * tsn(:,:,1,jp_sal) )                          ! c/d term on sss
       ENDIF
       ! Concentration dilution effect on (t,s) due to evapouration, precipitation and qns, but not river runoff
 …
             END DO
          END DO
+      ENDIF
+      ENDIF
+      !jdha Running bdy vvl problems if no call to lbc_lnk
+      CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )    ;    CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )
       IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics
          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld.F90

r3792	r6736
36	36	USE trdmld_rst ! restart for diagnosing the ML trends
37	37	USE prtctl ! Print control
	38	USE restart ! for lrst_oce
38	39	USE lib_mpp ! MPP library
39	40	USE wrk_nemo ! Memory allocation

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld_rst.F90

r3680	r6736
12	12	USE in_out_manager ! I/O manager
13	13	USE iom ! I/O module
	14	USE restart ! only for lrst_oce
14	15
15	16	IMPLICIT NONE

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90

-                      r3820
+                      r6736
    USE timing          ! Timing
-   USE phycst, ONLY: vkarmn
    IMPLICIT NONE
    PRIVATE
 …
    PUBLIC   zdf_bfr_init    ! called by opa.F90
+   REAL(wp), PARAMETER :: karman = 0.41_wp ! von Karman constant
    !                                    !!* Namelist nambfr: bottom friction namelist *
    INTEGER , PUBLIC ::   nn_bfr      = 0           ! = 0/1/2/3 type of bottom friction  (PUBLIC for TAM)
    REAL(wp), PUBLIC ::   rn_bfri1    = 4.0e-4_wp   ! bottom drag coefficient (linear case)  (PUBLIC for TAM)
    REAL(wp), PUBLIC ::   rn_bfri2    = 1.0e-3_wp   ! bottom drag coefficient (non linear case) (PUBLIC for TAM)
    REAL(wp), PUBLIC ::   rn_bfeb2    = 2.5e-3_wp   ! background bottom turbulent kinetic energy  [m2/s2] (PUBLIC for TAM)
    REAL(wp), PUBLIC ::   rn_bfrien   = 30._wp      ! local factor to enhance coefficient bfri (PUBLIC for TAM)
    LOGICAL , PUBLIC ::   ln_bfr2d    = .false.     ! logical switch for 2D enhancement (PUBLIC for TAM)
    LOGICAL , PUBLIC ::   ln_loglayer = .false.     ! switch for log layer bfr coeff. (PUBLIC for TAM)
    REAL(wp), PUBLIC ::   rn_bfrz0    = 0.003_wp    ! bottom roughness for loglayer bfr coeff (PUBLIC for TAM)
+   INTEGER , PUBLIC ::   nn_bfr    = 0           ! = 0/1/2/3 type of bottom friction  (PUBLIC for TAM)
+   REAL(wp), PUBLIC ::   rn_bfri1  = 4.0e-4_wp   ! bottom drag coefficient (linear case)  (PUBLIC for TAM)
+   REAL(wp), PUBLIC ::   rn_bfri2  = 1.0e-3_wp   ! bottom drag coefficient (non linear case) (PUBLIC for TAM)
+   REAL(wp), PUBLIC ::   rn_bfeb2  = 2.5e-3_wp   ! background bottom turbulent kinetic energy  [m2/s2] (PUBLIC for TAM)
+   REAL(wp), PUBLIC ::   rn_bfrien = 30._wp      ! local factor to enhance coefficient bfri (PUBLIC for TAM)
+   REAL(wp), PUBLIC ::   rn_bfrz0    = 0.003_wp    ! bottom roughness for loglayer bfr coeff
+   LOGICAL , PUBLIC ::   ln_bfr2d  = .false.     ! logical switch for 2D enhancement (PUBLIC for TAM)
+   LOGICAL , PUBLIC ::   ln_loglayer = .false.     ! switch for log layer bfr coeff.
    LOGICAL , PUBLIC                                    ::  ln_bfrimp = .false.  ! logical switch for implicit bottom friction
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::  bfrcoef2d            ! 2D bottom drag coefficient (PUBLIC for TAM)
 …
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
       !!
       INTEGER  ::   ji, jj                       ! dummy loop indices
       INTEGER  ::   ikbu, ikbv                   ! local integers
       REAL(wp) ::   zvu, zuv, zecu, zecv         ! temporary scalars
       REAL(wp) ::   ztmp, ztmp1                  ! temporary scalars
+      INTEGER  ::   ji, jj       ! dummy loop indices
+      INTEGER  ::   ikbu, ikbv   ! local integers
+      REAL(wp) ::   zvu, zuv, zecu, zecv   ! temporary scalars
+      REAL(wp) ::   ztmp         ! temporary scalars
       !!----------------------------------------------------------------------
+      !
 …
          ! where -F_h/e3U_bot = bfrUa*Ub/e3U_bot {U=[u,v]}
+         !
          IF(ln_loglayer) THEN       ! "log layer" bottom friction coefficient
-           ! add 2D-enhancement bottom friction
-           ztmp1 = 1._wp
-           IF(ABS(rn_bfri2) >= 1.e-10 ) THEN
-             ztmp1 = 1._wp / rn_bfri2
-           ELSE
-             CALL ctl_stop( 'rn_bfri2 must not be less than 1.e-10')
-           END IF
 #  if defined key_vectopt_loop
            DO jj = 1, 1
 …
 #  endif
                 ztmp = 0.5_wp * fse3t(ji,jj,mbkt(ji,jj))
+                ztmp = max(ztmp, rn_bfrz0 + 1.e-10)
+                bfrcoef2d(ji,jj) = bfrcoef2d(ji,jj) * ztmp1 * &
+                                 & ( log( ztmp / rn_bfrz0 ) / vkarmn ) ** (-2)
+                ztmp = max(ztmp, rn_bfrz0)
+                bfrcoef2d(ji,jj) = ( log( ztmp / rn_bfrz0 ) / karman ) ** (-2)
+#  if defined key_limit_bfr
+                bfrcoef2d(ji,jj) = max(bfrcoef2d(ji,jj), rn_bfri2)
+                bfrcoef2d(ji,jj) = min(bfrcoef2d(ji,jj), rn_bfri1)
+#  endif
              END DO
            END DO
 …
             END DO
          END DO
+         !
          CALL lbc_lnk( bfrua, 'U', 1. )   ;   CALL lbc_lnk( bfrva, 'V', 1. )      ! Lateral boundary condition
 …
       USE iom   ! I/O module for ehanced bottom friction file
       !!
       INTEGER   ::   inum         ! logical unit for enhanced bottom friction file
       INTEGER   ::   ji, jj       ! dummy loop indexes
       INTEGER   ::   ikbu, ikbv   ! temporary integers
       INTEGER   ::   ictu, ictv   !    -          -
       REAL(wp)  ::   zminbfr, zmaxbfr   ! temporary scalars
       REAL(wp)  ::   zfru, zfrv         !    -         -
+      INTEGER ::   inum         ! logical unit for enhanced bottom friction file
+      INTEGER ::   ji, jj       ! dummy loop indexes
+      INTEGER ::   ikbu, ikbv   ! temporary integers
+      INTEGER ::   ictu, ictv   !    -          -
+      REAL(wp) ::  zminbfr, zmaxbfr   ! temporary scalars
+      REAL(wp) ::  zfru, zfrv         !    -         -
       !!
       NAMELIST/nambfr/ nn_bfr, rn_bfri1, rn_bfri2, rn_bfeb2, rn_bfrz0, ln_bfr2d, &
 …
          ENDIF
          bfrcoef2d(:,:) = rn_bfri2  ! initialize bfrcoef2d to the namelist variable
+         !
          IF(ln_bfr2d) THEN
 …
+         !
       END SELECT
-      IF( nn_bfr /= 2 .AND. ln_loglayer ) THEN
-         IF(lwp) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) 'Loglayer can only be by applied for quadratic bottom friction'
-            WRITE(numout,*) 'but you have set: nn_bfr /= 2 and ln_loglayer=.true.!!!!'
-            WRITE(ctmp1,*)  'check nn_bfr and ln_loglayer (should be 2 and true)'
-            CALL ctl_stop( ctmp1 )
-         END IF
-      END IF
       IF(lwp) WRITE(numout,*) '      implicit bottom friction switch                ln_bfrimp  = ', ln_bfrimp
+      !

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90

-                      r3294
+                      r6736
    USE zdf_oce         ! ocean vertical physics variables
    USE zdfkpp          ! KPP vertical mixing
+   USE zdfgls          ! GLS vertical mixing
    USE in_out_manager  ! I/O manager
    USE iom             ! for iom_put
 …
          IF(lwp) WRITE(numout,*) '~~~~~~~ '
          IF(lwp) WRITE(numout,*)
+         !
+         IF(lwp .AND. lk_zdfgls )   CALL ctl_warn(' No need zdf_evd with GLS closures ')
+         !
       ENDIF

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90

-                      r3798
+                      r6736
    !!   'key_zdfgls'                 Generic Length Scale vertical physics
    !!----------------------------------------------------------------------
    !!   zdf_gls       : update momentum and tracer Kz from a gls scheme
    !!   zdf_gls_init  : initialization, namelist read, and parameters control
    !!   gls_rst       : read/write gls restart in ocean restart file
+   !!   zdf_gls      : update momentum and tracer Kz from a gls scheme
+   !!   zdf_gls_init : initialization, namelist read, and parameters control
+   !!   gls_rst      : read/write gls restart in ocean restart file
    !!----------------------------------------------------------------------
    USE oce            ! ocean dynamics and active tracers
 …
    USE phycst         ! physical constants
    USE zdfmxl         ! mixed layer
+   USE restart        ! only for lrst_oce
    USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
    USE lib_mpp        ! MPP manager
 …
    USE iom            ! I/O manager library
    USE timing         ! Timing
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
    IMPLICIT NONE
 …
+            !
             ! surface friction
             ustars2(ji,jj) = r1_rau0 * taum(ji,jj) * tmask(ji,jj,1)
+            ustars2(ji,jj) = rau0r * taum(ji,jj) * tmask(ji,jj,1)
+            !
             ! bottom friction (explicit before friction)
 …
          !                                   ! -------------------
          IF(lwp) WRITE(numout,*) '---- gls-rst ----'
          CALL iom_rstput( kt, nitrst, numrow, 'en'   , en     )
+         CALL iom_rstput( kt, nitrst, numrow, 'en'   , en    )
          CALL iom_rstput( kt, nitrst, numrow, 'avt'  , avt_k  )
          CALL iom_rstput( kt, nitrst, numrow, 'avm'  , avm_k  )
          CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu_k )
          CALL iom_rstput( kt, nitrst, numrow, 'avmv' , avmv_k )
          CALL iom_rstput( kt, nitrst, numrow, 'mxln' , mxln   )
+         CALL iom_rstput( kt, nitrst, numrow, 'mxln' , mxln  )
+         !
       ENDIF

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90

r3680	r6736
26	26	USE tranpc ! convection: non penetrative adjustment
27	27	USE ldfslp ! iso-neutral slopes
	28	USE restart ! ocean restart
28	29
29	30	USE in_out_manager ! I/O manager

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90

-                      r3792
+                      r6736
    !!   'key_zdfkpp'                                             KPP scheme
    !!----------------------------------------------------------------------
    !!   zdf_kpp       : update momentum and tracer Kz from a kpp scheme
    !!   zdf_kpp_init  : initialization, namelist read, and parameters control
    !!   tra_kpp       : compute and add to the T & S trend the non-local flux
    !!   trc_kpp       : compute and add to the passive tracer trend the non-local flux (lk_top=T)
+   !!   zdf_kpp      : update momentum and tracer Kz from a kpp scheme
+   !!   zdf_kpp_init : initialization, namelist read, and parameters control
+   !!   tra_kpp      : compute and add to the T & S trend the non-local flux
+   !!   trc_kpp      : compute and add to the passive tracer trend the non-local flux (lk_top=T)
    !!----------------------------------------------------------------------
    USE oce            ! ocean dynamics and active tracers
    USE dom_oce        ! ocean space and time domain
    USE zdf_oce        ! ocean vertical physics
    USE sbc_oce        ! surface boundary condition: ocean
    USE phycst         ! physical constants
    USE eosbn2         ! equation of state
    USE zdfddm         ! double diffusion mixing
    USE in_out_manager ! I/O manager
    USE lib_mpp        ! MPP library
    USE wrk_nemo       ! work arrays
    USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
    USE prtctl         ! Print control
    USE trdmod_oce     ! ocean trends definition
    USE trdtra         ! tracers trends
    USE timing         ! Timing
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE zdf_oce         ! ocean vertical physics
+   USE sbc_oce         ! surface boundary condition: ocean
+   USE phycst          ! physical constants
+   USE eosbn2          ! equation of state
+   USE zdfddm          ! double diffusion mixing
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! work arrays
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE prtctl          ! Print control
+   USE trdmod_oce      ! ocean trends definition
+   USE trdtra          ! tracers trends
+   USE timing          ! Timing
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
    IMPLICIT NONE
 …
                zthermal = rn_alpha / ( rcp * zrhos + epsln )
                zhalin   = rn_beta * tsn(ji,jj,1,jp_sal) * rcs
-               zbeta    = rn_beta
             ENDIF
             ! Radiative surface buoyancy force
             zBosol(ji,jj) = grav * zthermal * qsr(ji,jj)
             ! Non radiative surface buoyancy force
+            zBo   (ji,jj) = grav * zthermal * qns(ji,jj) -  grav * zhalin * ( emp(ji,jj)-rnf(ji,jj) )  &
+               &                                         -  grav * zbeta * rcs * sfx(ji,jj)
+            zBo   (ji,jj) = grav * zthermal * qns(ji,jj) -  grav * zhalin * ( emps(ji,jj)-rnf(ji,jj) )
             ! Surface Temperature flux for non-local term
             wt0(ji,jj) = - ( qsr(ji,jj) + qns(ji,jj) )* r1_rau0_rcp * tmask(ji,jj,1)
+            wt0(ji,jj) = - ( qsr(ji,jj) + qns(ji,jj) )* ro0cpr * tmask(ji,jj,1)
             ! Surface salinity flux for non-local term
+            ws0(ji,jj) = - ( ( emp(ji,jj)-rnf(ji,jj) ) * tsn(ji,jj,1,jp_sal)                          &
+               &             + sfx(ji,jj)                                     ) * rcs * tmask(ji,jj,1)
+            ws0(ji,jj) = - ( ( emps(ji,jj)-rnf(ji,jj) ) * tsn(ji,jj,1,jp_sal) * rcs ) * tmask(ji,jj,1)
          ENDDO
       ENDDO
 …
                DO ji = fs_2, fs_jpim1
                   ! Surface tracer flux for non-local term
                   zflx = - ( sfx (ji,jj) * tra(ji,jj,1,jn) * rcs ) * tmask(ji,jj,1)
+                  zflx = - ( emps(ji,jj) * tra(ji,jj,1,jn) * rcs ) * tmask(ji,jj,1)
                   ! compute the trend
                   ztra = - ( ghats(ji,jj,jk  ) * fsavs(ji,jj,jk  )   &

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90

-                      r3625
+                      r6736
    !!   'key_zdfric'                                             Kz = f(Ri)
    !!----------------------------------------------------------------------
    !!   zdf_ric       : update momentum and tracer Kz from the Richardson
+   !!   zdf_ric      : update momentum and tracer Kz from the Richardson
    !!                  number computation
    !!   zdf_ric_init  : initialization, namelist read, & parameters control
    !!----------------------------------------------------------------------
    USE oce            ! ocean dynamics and tracers variables
    USE dom_oce        ! ocean space and time domain variables
    USE zdf_oce        ! ocean vertical physics
    USE in_out_manager ! I/O manager
    USE lbclnk         ! ocean lateral boundary condition (or mpp link)
    USE lib_mpp        ! MPP library
    USE wrk_nemo       ! work arrays
    USE timing         ! Timing
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   !!   zdf_ric_init : initialization, namelist read, & parameters control
+   !!----------------------------------------------------------------------
+   USE oce                   ! ocean dynamics and tracers variables
+   USE dom_oce               ! ocean space and time domain variables
+   USE zdf_oce               ! ocean vertical physics
+   USE in_out_manager        ! I/O manager
+   USE lbclnk                ! ocean lateral boundary condition (or mpp link)
+   USE lib_mpp               ! MPP library
+   USE wrk_nemo              ! work arrays
+   USE timing                ! Timing
+   USE lib_fortran           ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
    USE eosbn2, ONLY : nn_eos

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

-                      r3680
+                      r6736
    !!   'key_zdftke'                                   TKE vertical physics
    !!----------------------------------------------------------------------
    !!   zdf_tke       : update momentum and tracer Kz from a tke scheme
    !!   tke_tke       : tke time stepping: update tke at now time step (en)
    !!   tke_avn       : compute mixing length scale and deduce avm and avt
    !!   zdf_tke_init  : initialization, namelist read, and parameters control
    !!   tke_rst       : read/write tke restart in ocean restart file
+   !!   zdf_tke      : update momentum and tracer Kz from a tke scheme
+   !!   tke_tke      : tke time stepping: update tke at now time step (en)
+   !!   tke_avn      : compute mixing length scale and deduce avm and avt
+   !!   zdf_tke_init : initialization, namelist read, and parameters control
+   !!   tke_rst      : read/write tke restart in ocean restart file
    !!----------------------------------------------------------------------
    USE oce            ! ocean: dynamics and active tracers variables
 …
    USE zdf_oce        ! vertical physics: ocean variables
    USE zdfmxl         ! vertical physics: mixed layer
+   USE restart        ! ocean restart
    USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
    USE prtctl         ! Print control
 …
    USE wrk_nemo       ! work arrays
    USE timing         ! Timing
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
    IMPLICIT NONE

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90

-                      r3625
+                      r6736
    !!   'key_zdftmx'                                  Tidal vertical mixing
    !!----------------------------------------------------------------------
    !!   zdf_tmx       : global     momentum & tracer Kz with tidal induced Kz
    !!   tmx_itf       : Indonesian momentum & tracer Kz with tidal induced Kz
    !!----------------------------------------------------------------------
    USE oce            ! ocean dynamics and tracers variables
    USE dom_oce        ! ocean space and time domain variables
    USE zdf_oce        ! ocean vertical physics variables
    USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
    USE eosbn2         ! ocean equation of state
    USE phycst         ! physical constants
    USE prtctl         ! Print control
    USE in_out_manager ! I/O manager
    USE iom            ! I/O Manager
    USE lib_mpp        ! MPP library
    USE wrk_nemo       ! work arrays
    USE timing         ! Timing
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   !!   zdf_tmx      : global     momentum & tracer Kz with tidal induced Kz
+   !!   tmx_itf      : Indonesian momentum & tracer Kz with tidal induced Kz
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE zdf_oce         ! ocean vertical physics variables
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE eosbn2          ! ocean equation of state
+   USE phycst          ! physical constants
+   USE prtctl          ! Print control
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O Manager
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! work arrays
+   USE timing          ! Timing
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
    IMPLICIT NONE

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/lib_cray.f90

-                      r3680
+                      r6736
 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
 !!----------------------------------------------------------------------
-SUBROUTINE lib_cray
-      WRITE(*,*) 'lib_cray: You should not have seen this print! error?'
-END SUBROUTINE lib_cray
 SUBROUTINE wheneq ( i, x, j, t, ind, nn )
         IMPLICIT NONE

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

-                      r3769
+                      r6736
    USE mppini          ! shared/distributed memory setting (mpp_init routine)
    USE domain          ! domain initialization             (dom_init routine)
-#if defined key_nemocice_decomp
-   USE ice_domain_size, only: nx_global, ny_global
-#endif
-   USE tideini         ! tidal components initialization   (tide_ini routine)
    USE obcini          ! open boundary cond. initialization (obc_ini routine)
    USE bdyini          ! open boundary cond. initialization (bdy_init routine)
    USE bdydta          ! open boundary cond. initialization (bdy_dta_init routine)
    USE bdytides        ! open boundary cond. initialization (bdytide_init routine)
+   USE bdytides        ! open boundary cond. initialization (tide_init routine)
    USE istate          ! initial state setting          (istate_init routine)
    USE ldfdyn          ! lateral viscosity setting      (ldfdyn_init routine)
 …
    USE phycst          ! physical constant                  (par_cst routine)
    USE trdmod          ! momentum/tracers trends       (trd_mod_init routine)
-   USE asminc          ! assimilation increments
    USE asmbkg          ! writing out state trajectory
    USE diaptr          ! poleward transports           (dia_ptr_init routine)
 …
    USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
    USE step            ! NEMO time-stepping                 (stp     routine)
-   USE icbini          ! handle bergs, initialisation
-   USE icbstp          ! handle bergs, calving, themodynamics and transport
 #if defined key_oasis3
    USE cpl_oasis3      ! OASIS3 coupling
 …
    USE lib_mpp         ! distributed memory computing
 #if defined key_iomput
    USE xios
 #endif
    USE sbctide, ONLY: lk_tide
+   USE mod_ioclient
+#endif
+   USE tamtrj          ! Output trajectory, needed for TAM
    IMPLICIT NONE
 …
       !                            !-----------------------!
 #if defined key_agrif
+      CALL Agrif_Declare_Var_dom   ! AGRIF: set the meshes for DOM
+      CALL Agrif_Declare_Var       !  "      "   "   "      "  DYN/TRA
+      CALL Agrif_Declare_Var       ! AGRIF: set the meshes
 # if defined key_top
+      CALL Agrif_Declare_Var_top   !  "      "   "   "      "  TOP
+# endif
+# if defined key_lim2
+      CALL Agrif_Declare_Var_lim2  !  "      "   "   "      "  LIM
+      CALL Agrif_Declare_Var_Top   ! AGRIF: set the meshes
 # endif
 #endif
 …
 #endif
+      IF( lk_diaobs   )   CALL dia_obs_wri
+      !
+      IF( ln_icebergs )   CALL icb_end( nitend )
+      IF( lk_diaobs ) CALL dia_obs_wri
       !                            !------------------------!
 …
+      !
       CALL nemo_closefile
+#if defined key_iomput
+      CALL xios_finalize                ! end mpp communications with xios
+# if defined key_oasis3 || defined key_oasis4
+#if defined key_oasis3 || defined key_oasis4
       CALL cpl_prism_finalize           ! end coupling and mpp communications with OASIS
-# endif
 #else
-# if defined key_oasis3 || defined key_oasis4
-      CALL cpl_prism_finalize           ! end coupling and mpp communications with OASIS
-# else
       IF( lk_mpp )   CALL mppstop       ! end mpp communications
-# endif
 #endif
+      !
 …
       IF( Agrif_Root() ) THEN
 # if defined key_oasis3 || defined key_oasis4
+         CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis
+         CALL xios_initialize( "oceanx",local_comm=ilocal_comm )
+# else
+         CALL  xios_initialize( "nemo",return_comm=ilocal_comm )
+         CALL cpl_prism_init( ilocal_comm )                 ! nemo local communicator given by oasis
 # endif
+         CALL  init_ioclient( ilocal_comm )                 ! exchange io_server nemo local communicator with the io_server
       ENDIF
       narea = mynode( cltxt, numnam, nstop, ilocal_comm )   ! Nodes selection
 …
       ! than variables
       IF( Agrif_Root() ) THEN
+         jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   ! first  dim.
 #if defined key_nemocice_decomp
+         jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first  dim.
+         jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.
+         jpj = ( jpjglo+1-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.
 #else
-         jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   ! first  dim.
          jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   ! second dim.
 #endif
 …
       IF( ln_ctl        )   CALL prt_ctl_init   ! Print control
+                            CALL     sbc_init   ! Forcings : surface module
       IF( lk_obc        )   CALL     obc_init   ! Open boundaries
-                            CALL  istate_init   ! ocean initial state (Dynamics and tracers)
-      IF( lk_tide       )   CALL tide_init( nit000 )    ! Initialisation of the tidal harmonics
       IF( lk_bdy        )   CALL     bdy_init       ! Open boundaries initialisation
       IF( lk_bdy        )   CALL     bdy_dta_init   ! Open boundaries initialisation of external data arrays
+      IF( lk_bdy        )   CALL     bdytide_init   ! Open boundaries initialisation of tidal harmonic forcing
+      IF( lk_bdy        )   CALL     tide_init      ! Open boundaries initialisation of tidal harmonic forcing
+                            CALL flush(numout)
                             CALL dyn_nept_init  ! simplified form of Neptune effect
+                            CALL flush(numout)
+                            CALL  istate_init   ! ocean initial state (Dynamics and tracers)
       !                                     ! Ocean physics
                             CALL     sbc_init   ! Forcings : surface module
       !                                         ! Vertical physics
                             CALL     zdf_init      ! namelist read
 …
       !                                     ! Misc. options
       IF( nn_cla == 1   )   CALL cla_init       ! Cross Land Advection
+                            CALL icb_init( rdt, nit000)   ! initialise icebergs instance
 #if defined key_top
       !                                     ! Passive tracers
 …
       !                                     ! Diagnostics
       IF( lk_floats     )   CALL     flo_init   ! drifting Floats
+                            CALL     iom_init   ! iom_put initialization
       IF( lk_diaar5     )   CALL dia_ar5_init   ! ar5 diag
                             CALL dia_ptr_init   ! Poleward TRansports initialization
 …
       IF( lk_asminc     )   CALL asm_inc_init   ! Initialize assimilation increments
       IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler
+                            CALL tam_trj_init ! Trajectory handling
+      !
    END SUBROUTINE nemo_init
 …
       USE ldftra_oce, ONLY: ldftra_oce_alloc
       USE trc_oce   , ONLY: trc_oce_alloc
-#if defined key_diadct
-      USE diadct    , ONLY: diadct_alloc
-#endif
+      !
       INTEGER :: ierr
 …
       ierr = ierr + lib_mpp_alloc   (numout)    ! mpp exchanges
       ierr = ierr + trc_oce_alloc   ()          ! shared TRC / TRA arrays
+      !
-#if defined key_diadct
-      ierr = ierr + diadct_alloc    ()          !
-#endif
+      !
       IF( lk_mpp    )   CALL mpp_sum( ierr )

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/oce.F90

-                      r3625
+                      r6736
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gru , grv    !: horizontal gradient of rd at bottom u-point
-   !! arrays relating to embedding ice in the ocean. These arrays need to be declared
-   !! even if no ice model is required. In the no ice model or traditional levitating
-   !! ice cases they contain only zeros
-   !! ---------------------
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_mass        !: mass of snow and ice at current  ice time step   [Kg/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_mass_b      !: mass of snow and ice at previous ice time step   [Kg/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_fmass       !: time evolution of mass of snow+ice               [Kg/m2/s]
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011)
 …
       !!                   ***  FUNCTION oce_alloc  ***
       !!----------------------------------------------------------------------
       INTEGER :: ierr(3)
+      INTEGER :: ierr(2)
       !!----------------------------------------------------------------------
+      !
 …
          &      rn2b (jpi,jpj,jpk)      , rn2  (jpi,jpj,jpk)                              , STAT=ierr(1) )
+         !
+      ALLOCATE( rhd (jpi,jpj,jpk) ,                                         &
+         &      rhop(jpi,jpj,jpk) ,                                         &
+         &      sshb  (jpi,jpj)   , sshn  (jpi,jpj) , ssha  (jpi,jpj) ,     &
+         &      sshu_b(jpi,jpj)   , sshu_n(jpi,jpj) , sshu_a(jpi,jpj) ,     &
+         &      sshv_b(jpi,jpj)   , sshv_n(jpi,jpj) , sshv_a(jpi,jpj) ,     &
+         &                          sshf_n(jpi,jpj) ,                       &
+         &      spgu  (jpi,jpj)   , spgv(jpi,jpj)   ,                       &
+         &      gtsu(jpi,jpj,jpts), gtsv(jpi,jpj,jpts),                     &
+         &      gru(jpi,jpj)      , grv(jpi,jpj)                      , STAT=ierr(2) )
+         !
+      ALLOCATE( snwice_mass(jpi,jpj)  , snwice_mass_b(jpi,jpj),             &
+         &      snwice_fmass(jpi,jpj), STAT= ierr(3) )
+      ALLOCATE(rhd (jpi,jpj,jpk) ,                                         &
+         &     rhop(jpi,jpj,jpk) ,                                         &
+         &     sshb  (jpi,jpj)   , sshn  (jpi,jpj) , ssha  (jpi,jpj) ,     &
+         &     sshu_b(jpi,jpj)   , sshu_n(jpi,jpj) , sshu_a(jpi,jpj) ,     &
+         &     sshv_b(jpi,jpj)   , sshv_n(jpi,jpj) , sshv_a(jpi,jpj) ,     &
+         &                         sshf_n(jpi,jpj) ,                       &
+         &     spgu  (jpi,jpj)   , spgv(jpi,jpj)   ,                       &
+         &     gtsu(jpi,jpj,jpts), gtsv(jpi,jpj,jpts),                     &
+         &     gru(jpi,jpj)      , grv(jpi,jpj)                      , STAT=ierr(2) )
+         !
       oce_alloc = MAXVAL( ierr )

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/par_AMM_12km.h90

r3680	r6736
19	19	jpidta = 198, & !: first horizontal dimension > or = to jpi
20	20	jpjdta = 224, & !: second > or = to jpj
21		jpkdta = 51, & !: number of levels > or = to jpk
	21	jpkdta = 33, & !: number of levels > or = to jpk
22	22	! total domain matrix size
23	23	jpiglo = jpidta, & !: first dimension of global domain --> i

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/par_oce.F90

-                      r3294
+                      r6736
    !!---------------------------------------------------------------------
 #             include "par_AMM_12km.h90"
+#elif defined key_amm_60
+   !!---------------------------------------------------------------------
+   !!   'key_amm_60'   :                            regional basin : AMM60
+   !!---------------------------------------------------------------------
+#             include "par_AMM60.h90"
+#elif defined key_amm
+   !!---------------------------------------------------------------------
+   !!   'key_amm'         :   Atlantic Margin Model (~7km)     :      AMM
+   !!---------------------------------------------------------------------
+#             include "par_AMM.h90"
+#elif defined key_NNA_r12
+   !!---------------------------------------------------------------------
+   !!   'key_NNA_r12'   :                             regional basin : NNA
+   !!---------------------------------------------------------------------
+#             include "par_NNA_R12.h90"
 #else
    !!---------------------------------------------------------------------

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/step.F90

-                      r3769
+                      r6736
    !!----------------------------------------------------------------------
    USE step_oce         ! time stepping definition modules
+#if defined key_top
+   USE trcstp           ! passive tracer time-stepping      (trc_stp routine)
+#endif
+#if defined key_agrif
+   USE agrif_opa_sponge ! Momemtum and tracers sponges
+#endif
    IMPLICIT NONE
 …
 #endif
                              indic = 0                ! reset to no error condition
-      IF( kstp == nit000 )   CALL iom_init            ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)
       IF( kstp /= nit000 )   CALL day( kstp )         ! Calendar (day was already called at nit000 in day_init)
                              CALL iom_setkt( kstp - nit000 + 1 )   ! say to iom that we are at time step kstp
+                             CALL iom_setkt( kstp )   ! say to iom that we are at time step kstp
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
       ! Update data, open boundaries, surface boundary condition (including sea-ice)
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF(lwp) WRITE(numout,*)  'bdy_dta'
+                            CALL flush(numout)
+      IF( lk_bdy     )   CALL bdy_dta( kstp, time_offset=+1 ) ! update dynamic and tracer data at open boundaries
+      IF(lwp) WRITE(numout,*)  'sbc'
+                            CALL flush(numout)
                          CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice)
-      IF( lk_tide.AND.(kstp /= nit000 ))   CALL tide_init ( kstp )
       IF( lk_tide    )   CALL sbc_tide( kstp )
       IF( lk_obc     )   CALL obc_dta( kstp )         ! update dynamic and tracer data at open boundaries
       IF( lk_obc     )   CALL obc_rad( kstp )         ! compute phase velocities at open boundaries
       IF( lk_bdy     )   CALL bdy_dta( kstp, time_offset=+1 ) ! update dynamic and tracer data at open boundaries
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 …
          ENDIF
       ENDIF
+                            CALL flush(numout)
 #if defined key_traldf_c2d
       IF( lk_traldf_eiv )   CALL ldf_eiv( kstp )      ! eddy induced velocity coefficient
 #endif
-#if defined key_traldf_c3d && key_traldf_smag
-                          CALL ldf_tra_smag( kstp )      ! eddy induced velocity coefficient
-#  endif
-#if defined key_dynldf_c3d && key_dynldf_smag
-                          CALL ldf_dyn_smag( kstp )      ! eddy induced velocity coefficient
-#  endif
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 …
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
                              tsa(:,:,:,:) = 0.e0            ! set tracer trends to zero
+      ! Saving non-linear trajectory at restart state
+      ! May not be exact for sbc and zdf parameters
+      IF( ( ln_trjhand ) .AND. ( kstp == nit000 ) ) CALL tam_trj_wri( kstp - 1 )
       IF(  ln_asmiau .AND. &
 …
       IF( lk_trabbl      )   CALL tra_bbl    ( kstp )       ! advective (and/or diffusive) bottom boundary layer scheme
       IF( ln_tradmp      )   CALL tra_dmp    ( kstp )       ! internal damping trends
-      IF( lk_bdy         )   CALL bdy_tra_dmp( kstp )       ! bdy damping trends
                              CALL tra_adv    ( kstp )       ! horizontal & vertical advection
       IF( lk_zdfkpp      )   CALL tra_kpp    ( kstp )       ! KPP non-local tracer fluxes
 …
       ELSE                                                  ! centered hpg  (eos then time stepping)
                              CALL eos    ( tsn, rhd, rhop )      ! now in situ density for hpg computation
+                           ! CALL iom_put( 'rhop', rhop )
+                           ! CALL iom_put( 'rn2',  rn2 )
          IF( ln_zps      )   CALL zps_hde( kstp, jpts, tsn, gtsu, gtsv,  &    ! zps: now hor. derivative
             &                                          rhd, gru , grv  )      ! of t, s, rd at the last ocean level
 …
                                ua(:,:,:) = 0.e0             ! set dynamics trends to zero
                                va(:,:,:) = 0.e0
+                            CALL flush(numout)
       IF(  ln_asmiau .AND. &
 …
       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
                                CALL dyn_adv( kstp )         ! advection (vector or flux form)
                                CALL dyn_vor( kstp )         ! vorticity term including Coriolis
+                        !      CALL iom_put( 'rotn', rotn)
                                CALL dyn_ldf( kstp )         ! lateral mixing
       IF( ln_neptsimp )        CALL dyn_nept_cor( kstp )    ! add Neptune velocities (simplified)
 …
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Trajectory for TAM
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF( ln_trjhand ) CALL tam_trj_wri( kstp )          ! Output trajectory fields
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
       ! Coupled mode
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
       IF( lk_cpl           )   CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges
+      !
-#if defined key_iomput
-      IF( kstp == nitend   )   CALL xios_context_finalize() ! needed for XIOS+AGRIF
-#endif
+      !
       IF( nn_timing == 1 .AND.  kstp == nit000  )   CALL timing_reset

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

-                      r3769
+                      r6736
    USE iom              !
    USE lbclnk
-   USE restart          ! restart
-#if defined key_iomput
-   USE xios
-#endif
    USE daymod           ! calendar                         (day     routine)
 …
    USE bdy_par          ! for lk_bdy
-   USE bdy_oce          ! for dmp logical
    USE bdydta           ! open boundary condition data     (bdy_dta routine)
-   USE bdytra           ! bdy cond. for tracers            (bdy_tra routine)
-   USE bdydyn3d         ! bdy cond. for baroclinic vel.  (bdy_dyn3d routine)
    USE sshwzv           ! vertical velocity and ssh        (ssh_wzv routine)
 …
    USE ldfslp           ! iso-neutral slopes               (ldf_slp routine)
    USE ldfeiv           ! eddy induced velocity coef.      (ldf_eiv routine)
-   USE ldftra_smag      ! Smagirinsky diffusion            (ldftra_smag routine)
-   USE ldfdyn_smag      ! Smagorinsky viscosity            (ldfdyn_smag routine)
    USE zdftmx           ! tide-induced vertical mixing     (zdf_tmx routine)
 …
    USE asmbkg
    USE stpctl           ! time stepping control            (stp_ctl routine)
+   USE restart          ! ocean restart                    (rst_wri routine)
    USE prtctl           ! Print control                    (prt_ctl routine)
 …
    USE timing           ! Timing
+   USE tamtrj           ! Needed by TAM
 #if defined key_agrif
    USE agrif_opa_sponge ! Momemtum and tracers sponges
-#endif
-#if defined key_top
-   USE trcstp           ! passive tracer time-stepping      (trc_stp routine)
 #endif
    !!----------------------------------------------------------------------

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/stpctl.F90

-                      r3294
+                      r6736
       ENDIF
+         IF(MOD(kt,10) == 0) THEN
       IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp
       IF(lwp) REWIND( numstp )                       !  --------------------------
+         ENDIF
       !                                              !* Test maximum of velocity (zonal only)
 …
       !! zumax = MAXVAL( ABS( un(:,:,:) ) )                ! slower than the following loop on NEC SX5
       zumax = 0.e0
+         IF(MOD(kt,10) == 0 .OR. MOD( kt, nwrite ) == 1 ) THEN
       DO jk = 1, jpk
          DO jj = 1, jpj
 …
         END DO
       END DO
+         ENDIF
+      IF( zumax > 20.e0 ) THEN
+            WRITE(numout,*) ' stpctl: the zonal velocity is larger than 20 m/s in dom ', narea
+      ENDIF
+         IF(MOD(kt,10) == 0 .OR. MOD( kt, nwrite ) == 1 ) THEN
       IF( lk_mpp )   CALL mpp_max( zumax )                 ! max over the global domain
+         ENDIF
+      !
       IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' abs(U) max: ', zumax
 …
             WRITE(numout,*) '          output of last fields in numwso'
          ENDIF
+#if defined key_umax
          kindic = -3
+#endif
       ENDIF
   FORMAT (' kt=',i6,' max abs(U): ',1pg11.4,', i j k: ',3i5)
 …
       !                                              !  ------------------------
       !! zsmin = MINVAL( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 )  slower than the following loop on NEC SX5
+         IF(MOD(kt,10) == 0 .OR. MOD( kt, nwrite ) == 1 ) THEN
       zsmin = 100.e0
       DO jj = 2, jpjm1
 …
       END DO
       IF( lk_mpp )   CALL mpp_min( zsmin )                ! min over the global domain
+         ENDIF
+      !
       IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' SSS min:', zsmin
 …
          ENDIF
+         !
+         IF(MOD(kt,10) == 0 .OR. MOD( kt, nwrite ) == 1 ) THEN
          zssh2 = SUM( sshn(:,:) * sshn(:,:) * tmask_i(:,:) )
          IF( lk_mpp )   CALL mpp_sum( zssh2 )      ! sum over the global domain
+         !
          IF(lwp) WRITE(numsol,9300) kt, zssh2, zumax, zsmin      ! ssh statistics
+         ENDIF
+         !
       ENDIF

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/timing.F90

r3610	r6736
95	95	CALL timing_ini_var(cdinfo)
96	96	ELSE
97		s_timer => s_timer_root
	97	s_timer => s_timer_root
98	98	DO WHILE( TRIM(s_timer%cname) /= TRIM(cdinfo) )
99	99	IF( ASSOCIATED(s_timer%next) ) s_timer => s_timer%next

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90

-                      r3770
+                      r6736
    PUBLIC   trc_oce_alloc      ! function called by nemogcm.F90
+   INTEGER , PUBLIC                                      ::   nn_dttrc      !: frequency of step on passive tracers
+   REAL(wp), PUBLIC                                      ::   r_si2         !: largest depth of extinction (blue & 0.01 mg.m-3)  (RGB)
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   etot3         !: light absortion coefficient
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   facvol        !: volume for degraded regions
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                 bio-model
+   REAL(wp), PUBLIC                                      ::   r_si2   !: largest depth of extinction (blue & 0.01 mg.m-3)  (RGB)
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   etot3   !: light absortion coefficient
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   facvol   !: volume for degraded regions
+#if defined key_top && defined key_pisces
+   !!----------------------------------------------------------------------
+   !!   'key_top'   &   'key_pisces'                       PISCES bio-model
    !!----------------------------------------------------------------------
    LOGICAL, PUBLIC, PARAMETER ::   lk_qsr_bio = .TRUE.   !: bio-model light absorption flag

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

Legend:

Download in other formats: