Index: branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
===================================================================
--- branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90	(revision 4771)
+++ branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90	(revision 5075)
@@ -2,6 +2,5 @@
    !!======================================================================
    !!                    ***  MODULE cpl_oasis  ***
-   !! Coupled O/A : coupled ocean-atmosphere case using OASIS3 V. prism_2_4
-   !!               special case: NEMO OPA/LIM coupled to ECHAM5
+   !! Coupled O/A : coupled ocean-atmosphere case using OASIS3-MCT
    !!=====================================================================
    !! History :   
@@ -15,19 +14,16 @@
    !!   3.4  !  11-11  (C. Harris) Changes to allow mutiple category fields
    !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   'key_oasis3'                    coupled Ocean/Atmosphere via OASIS3
+   !!----------------------------------------------------------------------
+   !!   cpl_init     : initialization of coupled mode communication
+   !!   cpl_define   : definition of grid and fields
+   !!   cpl_snd     : snd out fields in coupled mode
+   !!   cpl_rcv     : receive fields in coupled mode
+   !!   cpl_finalize : finalize the coupled mode communication
+   !!----------------------------------------------------------------------
 #if defined key_oasis3
-   !!----------------------------------------------------------------------
-   !!   'key_oasis3'                    coupled Ocean/Atmosphere via OASIS3
-   !!----------------------------------------------------------------------
-   !!   cpl_prism_init     : initialization of coupled mode communication
-   !!   cpl_prism_define   : definition of grid and fields
-   !!   cpl_prism_snd     : snd out fields in coupled mode
-   !!   cpl_prism_rcv     : receive fields in coupled mode
-   !!   cpl_prism_finalize : finalize the coupled mode communication
-   !!----------------------------------------------------------------------
-   USE mod_prism_proto              ! OASIS3 prism module
-   USE mod_prism_def_partition_proto! OASIS3 prism module for partitioning
-   USE mod_prism_put_proto          ! OASIS3 prism module for snding
-   USE mod_prism_get_proto          ! OASIS3 prism module for receiving
-   USE mod_comprism_proto           ! OASIS3 prism module to get coupling frequency
+   USE mod_oasis                    ! OASIS3-MCT module
+#endif
    USE par_oce                      ! ocean parameters
    USE dom_oce                      ! ocean space and time domain
@@ -38,18 +34,34 @@
    PRIVATE
 
-   PUBLIC   cpl_prism_init
-   PUBLIC   cpl_prism_define
-   PUBLIC   cpl_prism_snd
-   PUBLIC   cpl_prism_rcv
-   PUBLIC   cpl_prism_freq
-   PUBLIC   cpl_prism_finalize
-
-   LOGICAL, PUBLIC, PARAMETER ::   lk_cpl = .TRUE.   !: coupled flag
+   PUBLIC   cpl_init
+   PUBLIC   cpl_define
+   PUBLIC   cpl_snd
+   PUBLIC   cpl_rcv
+   PUBLIC   cpl_freq
+   PUBLIC   cpl_finalize
+
    INTEGER, PUBLIC            ::   OASIS_Rcv  = 1    !: return code if received field
    INTEGER, PUBLIC            ::   OASIS_idle = 0    !: return code if nothing done by oasis
-   INTEGER                    ::   ncomp_id          ! id returned by prism_init_comp
+   INTEGER                    ::   ncomp_id          ! id returned by oasis_init_comp
    INTEGER                    ::   nerror            ! return error code
-
-   INTEGER, PARAMETER ::   nmaxfld=40    ! Maximum number of coupling fields
+#if ! defined key_oasis3
+   ! OASIS Variables not used. defined only for compilation purpose
+   INTEGER                    ::   OASIS_Out         = -1
+   INTEGER                    ::   OASIS_REAL        = -1
+   INTEGER                    ::   OASIS_Ok          = -1
+   INTEGER                    ::   OASIS_In          = -1
+   INTEGER                    ::   OASIS_Sent        = -1
+   INTEGER                    ::   OASIS_SentOut     = -1
+   INTEGER                    ::   OASIS_ToRest      = -1
+   INTEGER                    ::   OASIS_ToRestOut   = -1
+   INTEGER                    ::   OASIS_Recvd       = -1
+   INTEGER                    ::   OASIS_RecvOut     = -1
+   INTEGER                    ::   OASIS_FromRest    = -1
+   INTEGER                    ::   OASIS_FromRestOut = -1
+#endif
+
+   INTEGER, PUBLIC, PARAMETER ::   nmaxfld=40        ! Maximum number of coupling fields
+   INTEGER, PUBLIC, PARAMETER ::   nmaxcat=5    ! Maximum number of coupling fields
+   INTEGER, PUBLIC, PARAMETER ::   nmaxcpl=5    ! Maximum number of coupling fields
    
    TYPE, PUBLIC ::   FLD_CPL               !: Type for coupling field information
@@ -58,6 +70,7 @@
       CHARACTER(len = 1)    ::   clgrid    ! Grid type  
       REAL(wp)              ::   nsgn      ! Control of the sign change
-      INTEGER, DIMENSION(9) ::   nid       ! Id of the field (no more than 9 categories)
+      INTEGER, DIMENSION(nmaxcat,nmaxcpl) ::   nid   ! Id of the field (no more than 9 categories and 9 extrena models)
       INTEGER               ::   nct       ! Number of categories in field
+      INTEGER               ::   ncplmodel ! Maximum number of models to/from which this variable may be sent/received
    END TYPE FLD_CPL
 
@@ -73,7 +86,7 @@
 CONTAINS
 
-   SUBROUTINE cpl_prism_init( kl_comm )
+   SUBROUTINE cpl_init( kl_comm )
       !!-------------------------------------------------------------------
-      !!             ***  ROUTINE cpl_prism_init  ***
+      !!             ***  ROUTINE cpl_init  ***
       !!
       !! ** Purpose :   Initialize coupled mode communication for ocean
@@ -89,9 +102,9 @@
 
       !------------------------------------------------------------------
-      ! 1st Initialize the PRISM system for the application
+      ! 1st Initialize the OASIS system for the application
       !------------------------------------------------------------------
-      CALL prism_init_comp_proto ( ncomp_id, 'oceanx', nerror )
-      IF ( nerror /= PRISM_Ok ) &
-         CALL prism_abort_proto (ncomp_id, 'cpl_prism_init', 'Failure in prism_init_comp_proto')
+      CALL oasis_init_comp ( ncomp_id, 'oceanx', nerror )
+      IF ( nerror /= OASIS_Ok ) &
+         CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp')
 
       !------------------------------------------------------------------
@@ -99,14 +112,14 @@
       !------------------------------------------------------------------
 
-      CALL prism_get_localcomm_proto ( kl_comm, nerror )
-      IF ( nerror /= PRISM_Ok ) &
-         CALL prism_abort_proto (ncomp_id, 'cpl_prism_init','Failure in prism_get_localcomm_proto' )
-      !
-   END SUBROUTINE cpl_prism_init
-
-
-   SUBROUTINE cpl_prism_define( krcv, ksnd )
+      CALL oasis_get_localcomm ( kl_comm, nerror )
+      IF ( nerror /= OASIS_Ok ) &
+         CALL oasis_abort (ncomp_id, 'cpl_init','Failure in oasis_get_localcomm' )
+      !
+   END SUBROUTINE cpl_init
+
+
+   SUBROUTINE cpl_define( krcv, ksnd, kcplmodel )
       !!-------------------------------------------------------------------
-      !!             ***  ROUTINE cpl_prism_define  ***
+      !!             ***  ROUTINE cpl_define  ***
       !!
       !! ** Purpose :   Define grid and field information for ocean
@@ -116,17 +129,22 @@
       !!--------------------------------------------------------------------
       INTEGER, INTENT(in) ::   krcv, ksnd     ! Number of received and sent coupling fields
+      INTEGER, INTENT(in) ::   kcplmodel      ! Maximum number of models to/from which NEMO is potentialy sending/receiving data
       !
       INTEGER :: id_part
       INTEGER :: paral(5)       ! OASIS3 box partition
       INTEGER :: ishape(2,2)    ! shape of arrays passed to PSMILe
-      INTEGER :: ji,jc          ! local loop indicees
-      CHARACTER(LEN=8) :: zclname
+      INTEGER :: ji,jc,jm       ! local loop indicees
+      CHARACTER(LEN=64) :: zclname
+      CHARACTER(LEN=2) :: cli2
       !!--------------------------------------------------------------------
 
       IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'cpl_prism_define : initialization in coupled ocean/atmosphere case'
+      IF(lwp) WRITE(numout,*) 'cpl_define : initialization in coupled ocean/atmosphere case'
       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~'
       IF(lwp) WRITE(numout,*)
 
+      IF( kcplmodel > nmaxcpl ) THEN
+         CALL oasis_abort ( ncomp_id, 'cpl_define', 'kcplmodel is larger than nmaxcpl, increase nmaxcpl')   ;   RETURN
+      ENDIF
       !
       ! ... Define the shape for the area that excludes the halo
@@ -141,5 +159,5 @@
       ALLOCATE(exfld(nlei-nldi+1, nlej-nldj+1), stat = nerror)
       IF( nerror > 0 ) THEN
-         CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in allocating exfld')   ;   RETURN
+         CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating exfld')   ;   RETURN
       ENDIF
       !
@@ -161,23 +179,47 @@
       ENDIF
       
-      CALL prism_def_partition_proto ( id_part, paral, nerror )
+      CALL oasis_def_partition ( id_part, paral, nerror )
       !
       ! ... Announce send variables. 
       !
+      ssnd(:)%ncplmodel = kcplmodel
+      !
       DO ji = 1, ksnd
-         IF ( ssnd(ji)%laction ) THEN 
+         IF ( ssnd(ji)%laction ) THEN
+
+            IF( ssnd(ji)%nct > nmaxcat ) THEN
+               CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '//   &
+                  &              TRIM(ssnd(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' )
+               RETURN
+            ENDIF
+            
             DO jc = 1, ssnd(ji)%nct
-               IF ( ssnd(ji)%nct .gt. 1 ) THEN
-                  WRITE(zclname,'( a7, i1)') ssnd(ji)%clname,jc
-               ELSE
-                  zclname=ssnd(ji)%clname
-               ENDIF
-               WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_Out
-               CALL prism_def_var_proto (ssnd(ji)%nid(jc), zclname, id_part, (/ 2, 0/),   &
-                    PRISM_Out, ishape, PRISM_REAL, nerror)
-               IF ( nerror /= PRISM_Ok ) THEN
-                  WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname)
-                  CALL prism_abort_proto ( ssnd(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var')
-               ENDIF
+               DO jm = 1, kcplmodel
+
+                  IF ( ssnd(ji)%nct .GT. 1 ) THEN
+                     WRITE(cli2,'(i2.2)') jc
+                     zclname = TRIM(ssnd(ji)%clname)//'_cat'//cli2
+                  ELSE
+                     zclname = ssnd(ji)%clname
+                  ENDIF
+                  IF ( kcplmodel  > 1 ) THEN
+                     WRITE(cli2,'(i2.2)') jm
+                     zclname = 'model'//cli2//'_'//TRIM(zclname)
+                  ENDIF
+#if defined key_agrif
+                  IF( agrif_fixed() /= 0 ) THEN 
+                     zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname)
+                  END IF
+#endif
+                  IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_Out
+                  CALL oasis_def_var (ssnd(ji)%nid(jc,jm), zclname, id_part   , (/ 2, 0 /),   &
+                     &                OASIS_Out          , ishape , OASIS_REAL, nerror )
+                  IF ( nerror /= OASIS_Ok ) THEN
+                     WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname)
+                     CALL oasis_abort ( ssnd(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' )
+                  ENDIF
+                  IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple"
+                  IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple"
+               END DO
             END DO
          ENDIF
@@ -186,19 +228,44 @@
       ! ... Announce received variables. 
       !
+      srcv(:)%ncplmodel = kcplmodel
+      !
       DO ji = 1, krcv
          IF ( srcv(ji)%laction ) THEN 
+            
+            IF( srcv(ji)%nct > nmaxcat ) THEN
+               CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '//   &
+                  &              TRIM(srcv(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' )
+               RETURN
+            ENDIF
+            
             DO jc = 1, srcv(ji)%nct
-               IF ( srcv(ji)%nct .gt. 1 ) THEN
-                  WRITE(zclname,'( a7, i1)') srcv(ji)%clname,jc
-               ELSE
-                  zclname=srcv(ji)%clname
-               ENDIF
-               WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_In
-               CALL prism_def_var_proto ( srcv(ji)%nid(jc), zclname, id_part, (/ 2, 0/),   &
-                    &                      PRISM_In    , ishape   , PRISM_REAL, nerror)
-               IF ( nerror /= PRISM_Ok ) THEN
-                  WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname)
-                  CALL prism_abort_proto ( srcv(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var')
-               ENDIF
+               DO jm = 1, kcplmodel
+                  
+                  IF ( srcv(ji)%nct .GT. 1 ) THEN
+                     WRITE(cli2,'(i2.2)') jc
+                     zclname = TRIM(srcv(ji)%clname)//'_cat'//cli2
+                  ELSE
+                     zclname = srcv(ji)%clname
+                  ENDIF
+                  IF ( kcplmodel  > 1 ) THEN
+                     WRITE(cli2,'(i2.2)') jm
+                     zclname = 'model'//cli2//'_'//TRIM(zclname)
+                  ENDIF
+#if defined key_agrif
+                  IF( agrif_fixed() /= 0 ) THEN 
+                     zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname)
+                  END IF
+#endif
+                  IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In
+                  CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part   , (/ 2, 0 /),   &
+                     &                OASIS_In           , ishape , OASIS_REAL, nerror )
+                  IF ( nerror /= OASIS_Ok ) THEN
+                     WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname)
+                     CALL oasis_abort ( srcv(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' )
+                  ENDIF
+                  IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple"
+                  IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple"
+
+               END DO
             END DO
          ENDIF
@@ -209,13 +276,13 @@
       !------------------------------------------------------------------
       
-      CALL prism_enddef_proto(nerror)
-      IF( nerror /= PRISM_Ok )   CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in prism_enddef')
-      !
-   END SUBROUTINE cpl_prism_define
+      CALL oasis_enddef(nerror)
+      IF( nerror /= OASIS_Ok )   CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef')
+      !
+   END SUBROUTINE cpl_define
    
    
-   SUBROUTINE cpl_prism_snd( kid, kstep, pdata, kinfo )
+   SUBROUTINE cpl_snd( kid, kstep, pdata, kinfo )
       !!---------------------------------------------------------------------
-      !!              ***  ROUTINE cpl_prism_snd  ***
+      !!              ***  ROUTINE cpl_snd  ***
       !!
       !! ** Purpose : - At each coupling time-step,this routine sends fields
@@ -227,5 +294,5 @@
       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pdata
       !!
-      INTEGER                                   ::   jc        ! local loop index
+      INTEGER                                   ::   jc,jm     ! local loop index
       !!--------------------------------------------------------------------
       !
@@ -233,30 +300,35 @@
       !
       DO jc = 1, ssnd(kid)%nct
-
-         CALL prism_put_proto ( ssnd(kid)%nid(jc), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo )
-         
-         IF ( ln_ctl ) THEN        
-            IF ( kinfo == PRISM_Sent     .OR. kinfo == PRISM_ToRest .OR.   &
-                 & kinfo == PRISM_SentOut  .OR. kinfo == PRISM_ToRestOut ) THEN
-               WRITE(numout,*) '****************'
-               WRITE(numout,*) 'prism_put_proto: Outgoing ', ssnd(kid)%clname
-               WRITE(numout,*) 'prism_put_proto: ivarid ', ssnd(kid)%nid(jc)
-               WRITE(numout,*) 'prism_put_proto:  kstep ', kstep
-               WRITE(numout,*) 'prism_put_proto:   info ', kinfo
-               WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(:,:,jc))
-               WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:,:,jc))
-               WRITE(numout,*) '     -     Sum value is ', SUM(pdata(:,:,jc))
-               WRITE(numout,*) '****************'
+         DO jm = 1, ssnd(kid)%ncplmodel
+        
+            IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN
+               CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo )
+               
+               IF ( ln_ctl ) THEN        
+                  IF ( kinfo == OASIS_Sent     .OR. kinfo == OASIS_ToRest .OR.   &
+                     & kinfo == OASIS_SentOut  .OR. kinfo == OASIS_ToRestOut ) THEN
+                     WRITE(numout,*) '****************'
+                     WRITE(numout,*) 'oasis_put: Outgoing ', ssnd(kid)%clname
+                     WRITE(numout,*) 'oasis_put: ivarid ', ssnd(kid)%nid(jc,jm)
+                     WRITE(numout,*) 'oasis_put:  kstep ', kstep
+                     WRITE(numout,*) 'oasis_put:   info ', kinfo
+                     WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(:,:,jc))
+                     WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:,:,jc))
+                     WRITE(numout,*) '     -     Sum value is ', SUM(pdata(:,:,jc))
+                     WRITE(numout,*) '****************'
+                  ENDIF
+               ENDIF
+               
             ENDIF
-         ENDIF
-
+            
+         ENDDO
       ENDDO
       !
-    END SUBROUTINE cpl_prism_snd
-
-
-   SUBROUTINE cpl_prism_rcv( kid, kstep, pdata, kinfo )
+    END SUBROUTINE cpl_snd
+
+
+   SUBROUTINE cpl_rcv( kid, kstep, pdata, pmask, kinfo )
       !!---------------------------------------------------------------------
-      !!              ***  ROUTINE cpl_prism_rcv  ***
+      !!              ***  ROUTINE cpl_rcv  ***
       !!
       !! ** Purpose : - At each coupling time-step,this routine receives fields
@@ -266,96 +338,177 @@
       INTEGER                   , INTENT(in   ) ::   kstep     ! ocean time-step in seconds
       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdata     ! IN to keep the value if nothing is done
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pmask     ! coupling mask
       INTEGER                   , INTENT(  out) ::   kinfo     ! OASIS3 info argument
       !!
-      INTEGER                                   ::   jc        ! local loop index
-      LOGICAL                                   ::   llaction
+      INTEGER                                   ::   jc,jm     ! local loop index
+      LOGICAL                                   ::   llaction, llfisrt
       !!--------------------------------------------------------------------
       !
       ! receive local data from OASIS3 on every process
       !
+      kinfo = OASIS_idle
+      !
       DO jc = 1, srcv(kid)%nct
-
-         CALL prism_get_proto ( srcv(kid)%nid(jc), kstep, exfld, kinfo )         
-         
-         llaction = .false.
-         IF( kinfo == PRISM_Recvd   .OR. kinfo == PRISM_FromRest .OR.   &
-              kinfo == PRISM_RecvOut .OR. kinfo == PRISM_FromRestOut )   llaction = .TRUE.
-         
-         IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc)
-         
-         IF ( llaction ) THEN
-            
-            kinfo = OASIS_Rcv
-            pdata(nldi:nlei, nldj:nlej,jc) = exfld(:,:)
-            
-            !--- Fill the overlap areas and extra hallows (mpp)
-            !--- check periodicity conditions (all cases)
-            CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn )   
-            
-            IF ( ln_ctl ) THEN        
-               WRITE(numout,*) '****************'
-               WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%clname
-               WRITE(numout,*) 'prism_get_proto: ivarid '  , srcv(kid)%nid(jc)
-               WRITE(numout,*) 'prism_get_proto:   kstep', kstep
-               WRITE(numout,*) 'prism_get_proto:   info ', kinfo
-               WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(:,:,jc))
-               WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:,:,jc))
-               WRITE(numout,*) '     -     Sum value is ', SUM(pdata(:,:,jc))
-               WRITE(numout,*) '****************'
+         llfisrt = .TRUE.
+
+         DO jm = 1, srcv(kid)%ncplmodel
+
+            IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN
+
+               CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo )         
+               
+               llaction =  kinfo == OASIS_Recvd   .OR. kinfo == OASIS_FromRest .OR.   &
+                  &        kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut
+               
+               IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm)
+               
+               IF ( llaction ) THEN
+                  
+                  kinfo = OASIS_Rcv
+                  IF( llfisrt ) THEN 
+                     pdata(nldi:nlei,nldj:nlej,jc) =                                 exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm)
+                     llfisrt = .FALSE.
+                  ELSE
+                     pdata(nldi:nlei,nldj:nlej,jc) = pdata(nldi:nlei,nldj:nlej,jc) + exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm)
+                  ENDIF
+                  
+                  IF ( ln_ctl ) THEN        
+                     WRITE(numout,*) '****************'
+                     WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname
+                     WRITE(numout,*) 'oasis_get: ivarid '  , srcv(kid)%nid(jc,jm)
+                     WRITE(numout,*) 'oasis_get:   kstep', kstep
+                     WRITE(numout,*) 'oasis_get:   info ', kinfo
+                     WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(:,:,jc))
+                     WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:,:,jc))
+                     WRITE(numout,*) '     -     Sum value is ', SUM(pdata(:,:,jc))
+                     WRITE(numout,*) '****************'
+                  ENDIF
+                  
+               ENDIF
+               
             ENDIF
             
-         ELSE
-            kinfo = OASIS_idle     
-         ENDIF
-         
+         ENDDO
+
+         !--- Fill the overlap areas and extra hallows (mpp)
+         !--- check periodicity conditions (all cases)
+         IF( .not. llfisrt )   CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn )   
+ 
       ENDDO
       !
-   END SUBROUTINE cpl_prism_rcv
-
-
-   INTEGER FUNCTION cpl_prism_freq( kid )  
+   END SUBROUTINE cpl_rcv
+
+
+   INTEGER FUNCTION cpl_freq( kid )  
       !!---------------------------------------------------------------------
-      !!              ***  ROUTINE cpl_prism_freq  ***
+      !!              ***  ROUTINE cpl_freq  ***
       !!
       !! ** Purpose : - send back the coupling frequency for a particular field
       !!----------------------------------------------------------------------
-      INTEGER,INTENT(in) ::   kid   ! variable index 
+      INTEGER,INTENT(in) ::   kid   ! variable index
+      !!
+      INTEGER               :: info
+      INTEGER, DIMENSION(1) :: itmp
       !!----------------------------------------------------------------------
-      cpl_prism_freq = ig_def_freq( kid )
-      !
-   END FUNCTION cpl_prism_freq
-
-
-   SUBROUTINE cpl_prism_finalize
+      CALL oasis_get_freqs(kid, 1, itmp, info)
+      cpl_freq = itmp(1)
+      !
+   END FUNCTION cpl_freq
+
+
+   SUBROUTINE cpl_finalize
       !!---------------------------------------------------------------------
-      !!              ***  ROUTINE cpl_prism_finalize  ***
+      !!              ***  ROUTINE cpl_finalize  ***
       !!
       !! ** Purpose : - Finalizes the coupling. If MPI_init has not been
-      !!      called explicitly before cpl_prism_init it will also close
+      !!      called explicitly before cpl_init it will also close
       !!      MPI communication.
       !!----------------------------------------------------------------------
       !
       DEALLOCATE( exfld )
-      CALL prism_terminate_proto( nerror )         
-      !
-   END SUBROUTINE cpl_prism_finalize
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default case          Dummy module          Forced Ocean/Atmosphere
-   !!----------------------------------------------------------------------
-   USE in_out_manager               ! I/O manager
-   LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .FALSE.   !: coupled flag
-   PUBLIC cpl_prism_init
-   PUBLIC cpl_prism_finalize
-CONTAINS
-   SUBROUTINE cpl_prism_init (kl_comm) 
-      INTEGER, INTENT(out)   :: kl_comm       ! local communicator of the model
-      kl_comm = -1
-      WRITE(numout,*) 'cpl_prism_init: Error you sould not be there...'
-   END SUBROUTINE cpl_prism_init
-   SUBROUTINE cpl_prism_finalize
-      WRITE(numout,*) 'cpl_prism_finalize: Error you sould not be there...'
-   END SUBROUTINE cpl_prism_finalize
+      IF (nstop == 0) THEN
+         CALL oasis_terminate( nerror )         
+      ELSE
+         CALL oasis_abort( ncomp_id, "cpl_finalize", "NEMO ABORT STOP" )
+      ENDIF       
+      !
+   END SUBROUTINE cpl_finalize
+
+#if ! defined key_oasis3
+
+   !!----------------------------------------------------------------------
+   !!   No OASIS Library          OASIS3 Dummy module...
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE oasis_init_comp(k1,cd1,k2)
+      CHARACTER(*), INTENT(in   ) ::  cd1
+      INTEGER     , INTENT(  out) ::  k1,k2
+      k1 = -1 ; k2 = -1
+      WRITE(numout,*) 'oasis_init_comp: Error you sould not be there...', cd1
+   END SUBROUTINE oasis_init_comp
+
+   SUBROUTINE oasis_abort(k1,cd1,cd2)
+      INTEGER     , INTENT(in   ) ::  k1
+      CHARACTER(*), INTENT(in   ) ::  cd1,cd2
+      WRITE(numout,*) 'oasis_abort: Error you sould not be there...', cd1, cd2
+   END SUBROUTINE oasis_abort
+
+   SUBROUTINE oasis_get_localcomm(k1,k2)
+      INTEGER     , INTENT(  out) ::  k1,k2
+      k1 = -1 ; k2 = -1
+      WRITE(numout,*) 'oasis_get_localcomm: Error you sould not be there...'
+   END SUBROUTINE oasis_get_localcomm
+
+   SUBROUTINE oasis_def_partition(k1,k2,k3)
+      INTEGER     , INTENT(  out) ::  k1,k3
+      INTEGER     , INTENT(in   ) ::  k2(5)
+      k1 = k2(1) ; k3 = k2(5)
+      WRITE(numout,*) 'oasis_def_partition: Error you sould not be there...'
+   END SUBROUTINE oasis_def_partition
+
+   SUBROUTINE oasis_def_var(k1,cd1,k2,k3,k4,k5,k6,k7)
+      CHARACTER(*), INTENT(in   ) ::  cd1
+      INTEGER     , INTENT(in   ) ::  k2,k3(2),k4,k5(2,2),k6
+      INTEGER     , INTENT(  out) ::  k1,k7
+      k1 = -1 ; k7 = -1
+      WRITE(numout,*) 'oasis_def_var: Error you sould not be there...', cd1
+   END SUBROUTINE oasis_def_var
+
+   SUBROUTINE oasis_enddef(k1)
+      INTEGER     , INTENT(  out) ::  k1
+      k1 = -1
+      WRITE(numout,*) 'oasis_enddef: Error you sould not be there...'
+   END SUBROUTINE oasis_enddef
+  
+   SUBROUTINE oasis_put(k1,k2,p1,k3)
+      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::  p1
+      INTEGER                 , INTENT(in   ) ::  k1,k2
+      INTEGER                 , INTENT(  out) ::  k3
+      k3 = -1
+      WRITE(numout,*) 'oasis_put: Error you sould not be there...'
+   END SUBROUTINE oasis_put
+
+   SUBROUTINE oasis_get(k1,k2,p1,k3)
+      REAL(wp), DIMENSION(:,:), INTENT(  out) ::  p1
+      INTEGER                 , INTENT(in   ) ::  k1,k2
+      INTEGER                 , INTENT(  out) ::  k3
+      p1(1,1) = -1. ; k3 = -1
+      WRITE(numout,*) 'oasis_get: Error you sould not be there...'
+   END SUBROUTINE oasis_get
+
+   SUBROUTINE oasis_get_freqs(k1,k2,k3,k4)
+      INTEGER              , INTENT(in   ) ::  k1,k2
+      INTEGER, DIMENSION(1), INTENT(  out) ::  k3
+      INTEGER              , INTENT(  out) ::  k4
+      k3(1) = k1 ; k4 = k2
+      WRITE(numout,*) 'oasis_get_freqs: Error you sould not be there...'
+   END SUBROUTINE oasis_get_freqs
+
+   SUBROUTINE oasis_terminate(k1)
+      INTEGER     , INTENT(  out) ::  k1
+      k1 = -1
+      WRITE(numout,*) 'oasis_terminate: Error you sould not be there...'
+   END SUBROUTINE oasis_terminate
+   
 #endif
 
Index: branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis4.F90
===================================================================
--- branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis4.F90	(revision 4771)
+++ 	(revision )
@@ -1,481 +1,0 @@
-MODULE cpl_oasis4
-   !!======================================================================
-   !!                    ***  MODULE cpl_oasis  ***
-   !! Coupled O/A : coupled ocean-atmosphere case using OASIS4
-   !!=====================================================================
-   !! History :   
-   !!   9.0  !  2004-06  (R. Redler, NEC Laboratories Europe, St Augustin, Germany) Original code
-   !!    -   !  2004-11  (R. Redler, NEC Laboratories Europe; N. Keenlyside, W. Park, IFM-GEOMAR, Kiel, Germany) revision
-   !!    -   !  2004-11  (V. Gayler, MPI M&D) Grid writing
-   !!    -   !  2005-08  (R. Redler, W. Park) frld initialization, paral(2) revision
-   !!    -   !  2005-09  (R. Redler) extended to allow for communication over root only
-   !!    -   !  2006-01  (W. Park) modification of physical part
-   !!    -   !  2006-02  (R. Redler, W. Park) buffer array fix for root exchange
-   !!    -   !  2010-10  (E. Maisonnave and S. Masson) complete rewrite
-   !!----------------------------------------------------------------------
-#if defined key_oasis4
-   !!----------------------------------------------------------------------
-   !!   'key_oasis4'                    coupled Ocean/Atmosphere via OASIS4
-   !!----------------------------------------------------------------------
-   !!   cpl_prism_init     : initialization of coupled mode communication
-   !!   cpl_prism_define   : definition of grid and fields
-   !!   cpl_prism_snd      : snd out fields in coupled mode
-   !!   cpl_prism_rcv      : receive fields in coupled mode
-   !!   cpl_prism_update_time : update date sent to Oasis
-   !!   cpl_prism_finalize : finalize the coupled mode communication
-   !!----------------------------------------------------------------------
-   USE prism            ! OASIS4 prism module
-   USE par_oce          ! ocean parameters
-   USE dom_oce          ! ocean space and time domain
-   USE domwri           ! ocean space and time domain
-   USE in_out_manager   ! I/O manager
-   USE lbclnk           ! ocean lateral boundary conditions (or mpp link)
-   USE lib_mpp          ! MPP library
-   USE wrk_nemo         ! work arrays
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC cpl_prism_init
-   PUBLIC cpl_prism_define
-   PUBLIC cpl_prism_snd
-   PUBLIC cpl_prism_rcv
-   PUBLIC cpl_prism_update_time
-   PUBLIC cpl_prism_finalize
-   
-!   LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .TRUE.    ! coupled flag
-   INTEGER                    :: ncomp_id           ! id returned by prism_init_comp
-   INTEGER                    :: nerror             ! return error code
-   INTEGER, PUBLIC            :: OASIS_Rcv  = 1     ! return code if received field
-   INTEGER, PUBLIC            :: OASIS_idle = 0     ! return code if nothing done by oasis
-
-   INTEGER, PARAMETER :: nmaxfld=40    ! Maximum number of coupling fields
-   
-   TYPE, PUBLIC ::   FLD_CPL            ! Type for coupling field information
-      LOGICAL            ::   laction   ! To be coupled or not
-      CHARACTER(len = 8) ::   clname    ! Name of the coupling field   
-      CHARACTER(len = 1) ::   clgrid    ! Grid type  
-      REAL(wp)           ::   nsgn      ! Control of the sign change
-      INTEGER            ::   nid       ! Id of the field
-   END TYPE FLD_CPL
-
-   TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC :: srcv, ssnd   ! Coupling fields
-
-   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: exfld  ! Temporary buffer for receiving
-
-   TYPE(PRISM_Time_struct), PUBLIC    :: date            ! date info for send operation
-   TYPE(PRISM_Time_struct), PUBLIC    :: date_bound(2)   ! date info for send operation
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE cpl_prism_init( kl_comm ) 
-      !!-------------------------------------------------------------------
-      !!             ***  ROUTINE cpl_prism_init  ***
-      !!
-      !! ** Purpose :   Initialize coupled mode communication for ocean
-      !!    exchange between AGCM, OGCM and COUPLER. (OASIS4 software)
-      !!
-      !! ** Method  :   OASIS4 MPI communication 
-      !!--------------------------------------------------------------------
-      INTEGER, INTENT(out) ::   kl_comm   ! local communicator of the model
-      !!--------------------------------------------------------------------
-      
-      CALL prism_init( 'nemo', nerror )
-
-      !------------------------------------------------------------------
-      ! 2nd Initialize the PRISM system for the component
-      !------------------------------------------------------------------
-      CALL prism_init_comp( ncomp_id, 'oceanx', nerror )
-      IF( nerror /= PRISM_Success )   CALL prism_abort( ncomp_id, 'cpl_prism_init', 'Failure in prism_init_comp' )
-
-      !------------------------------------------------------------------
-      ! 3rd Get an MPI communicator fr OPA local communication
-      !------------------------------------------------------------------
-      CALL prism_get_localcomm( ncomp_id, kl_comm, nerror )
-      IF( nerror /= PRISM_Success )   CALL prism_abort( ncomp_id, 'cpl_prism_init', 'Failure in prism_get_localcomm' )
-      !
-   END SUBROUTINE cpl_prism_init
-
-
-   SUBROUTINE cpl_prism_define( krcv, ksnd )
-      !!-------------------------------------------------------------------
-      !!             ***  ROUTINE cpl_prism_define  ***
-      !!
-      !! ** Purpose :   Define grid and field information for ocean
-      !!    exchange between AGCM, OGCM and COUPLER. (OASIS4 software)
-      !!
-      !! ** Method  :   OASIS4 MPI communication 
-      !!--------------------------------------------------------------------
-      INTEGER, INTENT(in) :: krcv, ksnd     ! Number of received and sent coupling fields
-      !
-      INTEGER, DIMENSION(4)      :: igrid     ! ids returned by prism_def_grid
-      INTEGER, DIMENSION(4)      :: iptid     ! ids returned by prism_set_points
-      INTEGER, DIMENSION(4)      :: imskid    ! ids returned by prism_set_mask
-      INTEGER, DIMENSION(4)      :: iishift   ! 
-      INTEGER, DIMENSION(4)      :: ijshift   ! 
-      INTEGER, DIMENSION(4)      :: iioff     ! 
-      INTEGER, DIMENSION(4)      :: ijoff     ! 
-      INTEGER, DIMENSION(4)      :: itmp      ! 
-      INTEGER, DIMENSION(1,3)    :: iextent   ! 
-      INTEGER, DIMENSION(1,3)    :: ioffset   ! 
-
-      INTEGER                    :: ishape(2,3)    ! shape of arrays passed to PSMILe
-      INTEGER                    :: data_type      ! data type of transients
-
-      LOGICAL                    :: new_points
-      LOGICAL                    :: new_mask
-      LOGICAL, ALLOCATABLE, SAVE :: llmask(:,:,:) ! jpi,jpj,1
-
-      INTEGER                    :: ji, jj, jg, jc   ! local loop indicees
-      INTEGER                    :: ii, ij           ! index
-      INTEGER, DIMENSION(1)      :: ind              ! index
-
-      CHARACTER(len=32)          :: clpt_name     ! name of the grid points
-      CHARACTER(len=7)           :: cltxt 
-      CHARACTER(len=1), DIMENSION(4) :: clgrd = (/ 'T','U','V','F' /)     ! name of the grid points
-
-      TYPE(PRISM_Time_struct)    :: tmpdate
-      INTEGER                    :: idate_incr      ! date increment
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   zlon, zlat
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zclo, zcla
-      !!--------------------------------------------------------------------
-      
-      CALL wrk_alloc( jpi,jpj, zlon, zlat )
-      CALL wrk_alloc( jpi,jpj,jpk, zclo, zcla )
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'cpl_prism_define : initialization in coupled ocean/atmosphere case'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~'
-      IF(lwp) WRITE(numout,*)
-
-      !
-      ! ... Allocate memory for data exchange
-      !
-      ALLOCATE( exfld(nlei-nldi+1, nlej-nldj+1, 1), stat = nerror )
-      IF ( nerror > 0 ) THEN
-         CALL prism_abort( ncomp_id, 'cpl_prism_define', 'Failure in allocating exfld' )
-         RETURN
-      ENDIF
-
-      IF(.not. ALLOCATED(mask))THEN
-         ALLOCATE(llmask(jpi,jpj,1), Stat=ji)
-         IF(ji /= 0)THEN
-            CALL prism_abort( ncomp_id, 'cpl_prism_define', 'Failure in allocating llmask' )
-            RETURN
-         END IF
-      END IF
-
-      ! -----------------------------------------------------------------
-      ! ... Define the shape of the valid region without the halo and overlaps between cpus
-      !     For serial configuration (key_mpp_mpi not being active)
-      !     nl* is set to the global values 1 and jp*glo.
-      ! -----------------------------------------------------------------
-
-      ishape(:,1) = (/ 1, nlei-nldi+1 /)
-      ishape(:,2) = (/ 1, nlej-nldj+1 /)
-      ishape(:,3) = (/ 1,           1 /)
-          
-      DO ji = 1, 4
-         CALL prism_def_grid( igrid(ji), 'orca'//clgrd(ji), ncomp_id, ishape, PRISM_irrlonlat_regvrt, nerror )
-         IF( nerror /= PRISM_Success )   CALL prism_abort (ncomp_id, 'cpl_prism_define',   &
-            &                                                        'Failure in prism_def_grid of '//clgrd(jg)//'-point' )
-      END DO
-      
-      ! -----------------------------------------------------------------
-      ! ... Define the partition 
-      ! -----------------------------------------------------------------
-      
-      iextent(1,:) = (/    nlei-nldi+1,    nlej-nldj+1, 1 /)
-      ioffset(1,:) = (/ nldi-1+nimpp-1, nldj-1+njmpp-1, 0 /)
-      
-      DO ji = 1, 4
-         CALL prism_def_partition( igrid(ji), 1, ioffset, iextent, nerror )
-         IF( nerror /= PRISM_Success )   CALL prism_abort (ncomp_id, 'cpl_prism_define',   &
-            &                                                        'Failure in prism_def_partition of '//clgrd(jg)//'-point' )
-      END DO
-
-      ! -----------------------------------------------------------------
-      ! ... Define the elements, i.e. specify the corner points for each
-      !     volume element. In case OPA runs on level coordinates (regular
-      !     in the vertical) we only need to give the 4 horizontal corners
-      !     for a volume element plus the vertical position of the upper
-      !     and lower face. Nevertheless the volume element has 8 corners.
-      ! -----------------------------------------------------------------
-      
-      iioff(:) = (/0,1,0,1/)
-      ijoff(:) = (/0,0,1,1/) 
-      iishift(:) = (/0,1,1,0/)
-      ijshift(:) = (/0,0,1,1/)
-
-      DO jg = 1, 4    ! ... the t,u,v,f-points
-
-         cltxt = clgrd(jg)//'-point'
-         
-         ! -----------------------------------------------------------------
-         ! ... Convert OPA masks to logicals and define the masks
-         ! -----------------------------------------------------------------
-         SELECT CASE( jg ) 
-         CASE(1)   ;   llmask(:,:,1) = ( tmask(:,:,1)  ) == 1.
-         CASE(2)   ;   llmask(:,:,1) = ( umask(:,:,1)  ) == 1.
-         CASE(3)   ;   llmask(:,:,1) = ( vmask(:,:,1)  ) == 1.
-         CASE(4)   ;   llmask(:,:,1) = ( fmask(:,:,1)  ) == 1.
-!         CASE(1)   ;   llmask(:,:,1) = ( tmask(:,:,1) * dom_uniq('T') ) == 1.
-!         CASE(2)   ;   llmask(:,:,1) = ( umask(:,:,1) * dom_uniq('U') ) == 1.
-!         CASE(3)   ;   llmask(:,:,1) = ( vmask(:,:,1) * dom_uniq('V') ) == 1.
-!         CASE(4)   ;   llmask(:,:,1) = ( fmask(:,:,1) * dom_uniq('F') ) == 1.
-         END SELECT
-         CALL prism_set_mask( imskid(jg), igrid(jg), ishape, llmask(nldi:nlei, nldj:nlej, 1), .TRUE., nerror )
-         IF( nerror /= PRISM_Success )   CALL prism_abort( ncomp_id, 'cpl_prism_define', 'Failure in prism_set_mask for '//cltxt )
-
-         ! -----------------------------------------------------------------
-         ! ... Define the corners
-         ! -----------------------------------------------------------------
-         SELECT CASE( jg ) 
-         CASE(1)   ;   zlon(:,:) = glamf(:,:)   ;   zlat(:,:) = gphif(:,:)
-         CASE(2)   ;   zlon(:,:) = glamv(:,:)   ;   zlat(:,:) = gphiv(:,:)
-         CASE(3)   ;   zlon(:,:) = glamu(:,:)   ;   zlat(:,:) = gphiu(:,:) 
-         CASE(4)   ;   zlon(:,:) = glamt(:,:)   ;   zlat(:,:) = gphit(:,:)
-         END SELECT
-
-         DO jc = 1, 4   ! corner number (anti-clockwise, starting from the bottom left corner)
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1   ! NO vector opt.
-                  ii = ji-1 + iioff(jg) + iishift(jc)
-                  ij = jj-1 + ijoff(jg) + ijshift(jc)
-                  zclo(ji,jj,jc) = zlon(ii,ij)
-                  zcla(ji,jj,jc) = zlat(ii,ij)
-               END DO
-            END DO
-            CALL lbc_lnk( zclo(:,:,jc), clgrd(jg), 1. )   ;   CALL lbc_lnk( zcla(:,:,jc), clgrd(jg), 1. )
-         END DO
-
-         CALL prism_set_corners( igrid(jg), 8, ishape, zclo(nldi:nlei, nldj:nlej,:),   &
-            &                                          zcla(nldi:nlei, nldj:nlej,:), RESHAPE( (/-1.,1./), (/1,2/) ), nerror )
-         IF( nerror /= PRISM_Success )   CALL prism_abort( ncomp_id, 'cpl_prism_define', 'Failure in prism_set_corners of '//cltxt )    
-
-         ! -----------------------------------------------------------------
-         ! ... Define the center points
-         ! -----------------------------------------------------------------
-         SELECT CASE( jg ) 
-         CASE(1)   ;   zlon(:,:) = glamt(:,:)   ;   zlat(:,:) = gphit(:,:)
-         CASE(2)   ;   zlon(:,:) = glamu(:,:)   ;   zlat(:,:) = gphiu(:,:)
-         CASE(3)   ;   zlon(:,:) = glamv(:,:)   ;   zlat(:,:) = gphiv(:,:)
-         CASE(4)   ;   zlon(:,:) = glamf(:,:)   ;   zlat(:,:) = gphif(:,:)
-         END SELECT
-
-         CALL prism_set_points ( iptid(jg), cltxt, igrid(jg), ishape, zlon(nldi:nlei, nldj:nlej),   &
-         &                                                            zlat(nldi:nlei, nldj:nlej), (/0./), .TRUE., nerror )
-         IF( nerror /= PRISM_Success )   CALL prism_abort ( ncomp_id, 'cpl_prism_define', 'Failure in prism_set_points '//cltxt )
-
-      END DO
-
-      ! ... Announce send variables. 
-      !
-      DO ji = 1, ksnd
-         IF ( ssnd(ji)%laction ) THEN 
-            
-            itmp(:) = 0
-            WHERE( clgrd == ssnd(ji)%clgrid  ) itmp = 1
-            ind(:) = maxloc( itmp )
-            WRITE(6,*) ' grid for field ', ind(1), ssnd(ji)%clname
-             ind(1) = 1
-
-            CALL prism_def_var( ssnd(ji)%nid, ssnd(ji)%clname, igrid(ind(1)), iptid(ind(1)),  imskid(ind(1)), (/ 3, 0/),   &
-               &                ishape, PRISM_Double_Precision, nerror )
-            IF ( nerror /= PRISM_Success )   CALL prism_abort( ssnd(ji)%nid, 'cpl_prism_define',   &
-               &                                               'Failure in prism_def_var for '//TRIM(ssnd(ji)%clname))
-
-         ENDIF
-      END DO
-      !
-      ! ... Announce received variables. 
-      !
-      DO ji = 1, krcv
-         IF ( srcv(ji)%laction ) THEN 
-
-            itmp(:) = 0
-            WHERE( clgrd == srcv(ji)%clgrid  ) itmp = 1
-            ind(:) = maxloc( itmp )
-            WRITE(6,*) ' grid for field ', ind(1), srcv(ji)%clname
-             ind(1) = 1
- 
-            CALL prism_def_var( srcv(ji)%nid, srcv(ji)%clname, igrid(ind(1)), iptid(ind(1)), imskid(ind(1)), (/ 3, 0/),   &
-               &                ishape, PRISM_Double_Precision, nerror )
-            IF ( nerror /= PRISM_Success )   CALL prism_abort( srcv(ji)%nid, 'cpl_prism_define',   &
-               &                                               'Failure in prism_def_var for '//TRIM(srcv(ji)%clname))
-
-         ENDIF
-      END DO
-      
-      !------------------------------------------------------------------
-      ! End of definition phase
-      !------------------------------------------------------------------
-      
-      CALL prism_enddef( nerror )
-      IF ( nerror /= PRISM_Success )   CALL prism_abort ( ncomp_id, 'cpl_prism_define', 'Failure in prism_enddef')
-      
-      CALL wrk_dealloc( jpi,jpj, zlon, zlat )
-      CALL wrk_dealloc( jpi,jpj,jpk, zclo, zcla )
-      !
-   END SUBROUTINE cpl_prism_define
-   
-   
-   SUBROUTINE cpl_prism_snd( kid, kstep, pdata, kinfo )
-      !!---------------------------------------------------------------------
-      !!              ***  ROUTINE cpl_prism_snd  ***
-      !!
-      !! ** Purpose : - At each coupling time-step,this routine sends fields
-      !!      like sst or ice cover to the coupler or remote application.
-      !!----------------------------------------------------------------------
-      INTEGER                 , INTENT(in   ) ::   kid     ! variable intex in the array
-      INTEGER                 , INTENT(  out) ::   kinfo   ! OASIS4 info argument
-      INTEGER                 , INTENT(in   ) ::   kstep   ! ocean time-step in seconds
-      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   pdata
-      !!--------------------------------------------------------------------
-      !
-      ! snd data to OASIS4
-      !
-      exfld(:,:,1) = pdata(nldi:nlei, nldj:nlej)
-      CALL prism_put( ssnd(kid)%nid, date, date_bound, exfld, kinfo, nerror )
-      IF ( nerror /= PRISM_Success )   CALL prism_abort( ssnd(kid)%nid, 'cpl_prism_snd',   &
-         &                                               'Failure in prism_put for '//TRIM(ssnd(kid)%clname) )
-
-      IF( ln_ctl ) THEN        
-         IF ( kinfo >= PRISM_Cpl     .OR. kinfo == PRISM_Rst .OR.   &
-            & kinfo == PRISM_RstTimeop ) THEN
-            WRITE(numout,*) '****************'
-            WRITE(numout,*) 'prism_put: Outgoing ', ssnd(kid)%clname
-            WRITE(numout,*) 'prism_put: ivarid ', ssnd(kid)%nid
-            WRITE(numout,*) 'prism_put:  kstep ', kstep
-            WRITE(numout,*) 'prism_put:   info ', kinfo
-            WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata)
-            WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata)
-            WRITE(numout,*) '     -     Sum value is ', SUM(pdata)
-            WRITE(numout,*) '****************'
-         ENDIF
-      ENDIF
-      !
-   END SUBROUTINE cpl_prism_snd
-
-
-   SUBROUTINE cpl_prism_rcv( kid, kstep, pdata, kinfo )
-      !!---------------------------------------------------------------------
-      !!              ***  ROUTINE cpl_prism_rcv  ***
-      !!
-      !! ** Purpose : - At each coupling time-step,this routine receives fields
-      !!      like stresses and fluxes from the coupler or remote application.
-      !!----------------------------------------------------------------------
-      INTEGER                 , INTENT(in   ) ::   kid     ! variable intex in the array
-      INTEGER                 , INTENT(in   ) ::   kstep   ! ocean time-step in seconds
-      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pdata   ! IN to keep the value if nothing is done
-      INTEGER                 , INTENT(  out) ::   kinfo   ! OASIS4 info argument
-      !
-      LOGICAL                :: llaction
-      !!--------------------------------------------------------------------
-      !
-      ! receive local data from OASIS4 on every process
-      !
-      CALL prism_get( srcv(kid)%nid, date, date_bound, exfld, kinfo, nerror )         
-      IF ( nerror /= PRISM_Success )   CALL prism_abort( srcv(kid)%nid, 'cpl_prism_rcv',   &
-         &                                               'Failure in prism_get for '//TRIM(srcv(kid)%clname) )
-
-      WRITE(numout,*) 'prism_get: Incoming ', srcv(kid)%clname
-      call flush(numout)
-      llaction = .false.
-      IF( kinfo == PRISM_Cpl )  llaction = .TRUE.
-
-      IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid
-
-      IF ( llaction ) THEN
-
-         kinfo = OASIS_Rcv
-         pdata(nldi:nlei, nldj:nlej) = exfld(:,:,1)
-         
-         !--- Fill the overlap areas and extra hallows (mpp)
-         !--- check periodicity conditions (all cases)
-         CALL lbc_lnk( pdata, srcv(kid)%clgrid, srcv(kid)%nsgn )   
-         
-         IF ( ln_ctl ) THEN        
-            WRITE(numout,*) '****************'
-            WRITE(numout,*) 'prism_get: Incoming ', srcv(kid)%clname
-            WRITE(numout,*) 'prism_get: ivarid '  , srcv(kid)%nid
-            WRITE(numout,*) 'prism_get:   kstep', kstep
-            WRITE(numout,*) 'prism_get:   info ', kinfo
-            WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata)
-            WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata)
-            WRITE(numout,*) '     -     Sum value is ', SUM(pdata)
-            WRITE(numout,*) '****************'
-         ENDIF
-
-      ELSE
-         kinfo = OASIS_idle     
-      ENDIF
-      !
-   END SUBROUTINE cpl_prism_rcv
-
-
-   SUBROUTINE cpl_prism_finalize
-      !!---------------------------------------------------------------------
-      !!              ***  ROUTINE cpl_prism_finalize  ***
-      !!
-      !! ** Purpose : - Finalizes the coupling. If MPI_init has not been
-      !!      called explicitly before cpl_prism_init it will also close
-      !!      MPI communication.
-      !!----------------------------------------------------------------------
-      !
-      DEALLOCATE(exfld)
-      CALL prism_terminate ( nerror )         
-      !
-   END SUBROUTINE cpl_prism_finalize
-
-
-   SUBROUTINE cpl_prism_update_time(kt)
-      !!---------------------------------------------------------------------
-      !!              ***  ROUTINE cpl_prism_update_time  ***
-      !!
-      !! ** Purpose : - Increment date with model timestep
-      !!                called explicitly at the end of each timestep
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean model time step index
-
-      TYPE(PRISM_Time_struct) ::   tmpdate
-      INTEGER                 ::   idate_incr   ! date increment
-      !!----------------------------------------------------------------------
-
-      IF( kt == nit000 ) THEN      ! Define the actual date 
-         !
-         ! date is determined by adding days since beginning of the run to the corresponding initial date.
-         ! Note that OPA internal info about the start date of the experiment is bypassed.
-         ! Instead we rely sololy on the info provided by the SCC.xml file.
-         !
-         date = PRISM_Jobstart_date
-         !
-         !
-         ! lower/upper bound is determined by adding half a time step
-         !
-         idate_incr = 0.5 * NINT ( rdttra(1) )
-         tmpdate = date   ;   CALL PRISM_calc_newdate ( tmpdate, -idate_incr, nerror )   ;   date_bound(1) = tmpdate
-         tmpdate = date   ;   CALL PRISM_calc_newdate ( tmpdate,  idate_incr, nerror )   ;   date_bound(2) = tmpdate
-         !
-      ELSE      ! Date update
-         !
-         idate_incr  = rdttra(1)
-         CALL PRISM_calc_newdate( date, idate_incr, nerror )
-         date_bound(1) = date_bound(2)
-         tmpdate = date_bound(2)
-         CALL PRISM_calc_newdate( tmpdate, idate_incr, nerror )
-         date_bound(2) = tmpdate
-         !
-      END IF
-      !
-   END SUBROUTINE cpl_prism_update_time
-
-#endif
-
-   !!=====================================================================
-END MODULE cpl_oasis4
Index: branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
===================================================================
--- branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90	(revision 4771)
+++ branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90	(revision 5075)
@@ -40,5 +40,5 @@
       LOGICAL              ::   ln_clim     ! climatology or not (T/F)
       CHARACTER(len = 8)   ::   cltype      ! type of data file 'daily', 'monthly' or yearly'
-      CHARACTER(len = 34)  ::   wname       ! generic name of a NetCDF weights file to be used, blank if not
+      CHARACTER(len = 256) ::   wname       ! generic name of a NetCDF weights file to be used, blank if not
       CHARACTER(len = 34)  ::   vcomp       ! symbolic component name if a vector that needs rotation
       !                                     ! a string starting with "U" or "V" for each component   
@@ -473,9 +473,12 @@
             !       forcing record :    1 
             !                            
-            ztmp = REAL( nday, wp ) / REAL( nyear_len(1), wp ) + 0.5 + REAL( it_offset, wp )
+            ztmp = REAL( nsec_year, wp ) / ( REAL( nyear_len(1), wp ) * rday ) + 0.5 &
+           &       + REAL( it_offset, wp ) / ( REAL( nyear_len(1), wp ) * rday )
             sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))
             ! swap at the middle of the year
-            IF( llbefore ) THEN   ;   sdjf%nrec_a(2) = nsec1jan000 - NINT(0.5 * rday) * nyear_len(0)
-            ELSE                  ;   sdjf%nrec_a(2) = nsec1jan000 + NINT(0.5 * rday) * nyear_len(1)   
+            IF( llbefore ) THEN   ;   sdjf%nrec_a(2) = nsec1jan000 - (1 - INT(ztmp)) * NINT(0.5 * rday) * nyear_len(0) + &
+                                    & INT(ztmp) * NINT( 0.5 * rday) * nyear_len(1) 
+            ELSE                  ;   sdjf%nrec_a(2) = nsec1jan000 + (1 - INT(ztmp)) * NINT(0.5 * rday) * nyear_len(1) + &
+                                    & INT(ztmp) * INT(rday) * nyear_len(1) + INT(ztmp) * NINT( 0.5 * rday) * nyear_len(2) 
             ENDIF
          ELSE                                    ! no time interpolation
@@ -501,5 +504,6 @@
             !       forcing record :  nmonth 
             !                            
-            ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 + REAL( it_offset, wp )
+            ztmp = REAL( nsec_month, wp ) / ( REAL( nmonth_len(nmonth), wp ) * rday ) + 0.5 &
+           &       + REAL( it_offset, wp ) / ( REAL( nmonth_len(nmonth), wp ) * rday )
             imth = nmonth + INT( ztmp ) - COUNT((/llbefore/))
             IF( sdjf%cltype == 'monthly' ) THEN   ;   sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))
Index: branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/oasis4_date.F90
===================================================================
--- branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/oasis4_date.F90	(revision 4771)
+++ 	(revision )
@@ -1,41 +1,0 @@
-MODULE oasis4_date
-   !!======================================================================
-   !!                     ***  MODULE oasis_date  ***  
-   !!   Date and related information required to couple NEMO via OASIS4
-   !!   Made separate from cpl_oasis4 module to allow wider use.
-   !!======================================================================
-   !! History :  2.0  ! 2005-12  (R. Hill, Met. Office) Original code
-   !!----------------------------------------------------------------------
-#if defined key_oasis4
-   !!----------------------------------------------------------------------
-   !!   'key_oasis4'                                   coupled with OASIS-4
-   !!----------------------------------------------------------------------
-   !##################### WARNING coupled mode ###############################
-   !##################### WARNING coupled mode ###############################
-   !   Following line must be enabled if coupling with OASIS
-   !   USE PRISM
-   !##################### WARNING coupled mode ###############################
-   !##################### WARNING coupled mode ###############################
-
-   PRIVATE
-   IMPLICIT NONE
-
-   INTEGER, PUBLIC :: date_err, date_info   !: 
-
-   TYPE(PRISM_Time_struct), PUBLIC ::   dates            !: date info for send operation
-   TYPE(PRISM_Time_struct), PUBLIC ::   dates_bound(2)   !: date info for send operation
-   TYPE(PRISM_Time_struct), PUBLIC ::   dater            !: date info for receive operation
-   TYPE(PRISM_Time_struct), PUBLIC ::   dater_bound(2)   !: date info for receive operation
-   TYPE(PRISM_Time_struct), PUBLIC ::   tmpdate          !:
-   
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option            Dummy module                   NO OASIS-4
-   !!----------------------------------------------------------------------
-#endif
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!======================================================================
-END MODULE oasis4_date
Index: branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90
===================================================================
--- branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90	(revision 4771)
+++ branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90	(revision 5075)
@@ -14,4 +14,5 @@
    !!----------------------------------------------------------------------
    USE par_oce          ! ocean parameters
+   USE sbc_oce          ! surface boundary condition: ocean
 # if defined key_lim3
    USE par_ice          ! LIM-3 parameters
@@ -21,5 +22,5 @@
    USE ice_2
 # endif
-# if defined key_cice 
+# if defined key_cice
    USE ice_domain_size, only: ncat 
 #endif
@@ -55,36 +56,30 @@
 # endif
 
-#if defined key_lim3 || defined key_lim2 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qns_ice       !: non solar heat flux over ice                  [W/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice       !: solar heat flux over ice                      [W/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice_mean  !: dauly mean solar heat flux over ice       [W/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qla_ice       !: latent flux over ice                          [W/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dqla_ice      !: latent sensibility over ice                 [W/m2/K]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dqns_ice      !: non solar heat flux over ice (LW+SEN+LA)    [W/m2/K]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice        !: ice surface temperature                          [K]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   alb_ice       !: albedo of ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qns_ice        !: non solar heat flux over ice                  [W/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice        !: solar heat flux over ice                      [W/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice_mean   !: daily mean solar heat flux over ice           [W/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qla_ice        !: latent flux over ice                          [W/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dqla_ice       !: latent sensibility over ice                 [W/m2/K]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dqns_ice       !: non solar heat flux over ice (LW+SEN+LA)    [W/m2/K]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice         !: ice surface temperature                          [K]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   alb_ice        !: ice albedo                                       [-]
 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   utau_ice  !: atmos-ice u-stress. VP: I-pt ; EVP: U,V-pts   [N/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   vtau_ice  !: atmos-ice v-stress. VP: I-pt ; EVP: U,V-pts   [N/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr1_i0    !: 1st Qsr fraction penetrating inside ice cover    [-]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr2_i0    !: 2nd Qsr fraction penetrating inside ice cover    [-]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice   !: sublimation-snow budget over ice             [kg/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   utau_ice       !: atmos-ice u-stress. VP: I-pt ; EVP: U,V-pts   [N/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   vtau_ice       !: atmos-ice v-stress. VP: I-pt ; EVP: U,V-pts   [N/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr1_i0         !: Solar surface transmission parameter, thick ice  [-]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr2_i0         !: Solar surface transmission parameter, thin ice   [-]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice        !: sublimation - precip over sea ice            [kg/m2]
 
-# if defined key_lim3
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tatm_ice  !: air temperature
-# endif
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   topmelt            !: category topmelt
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   botmelt            !: category botmelt
 
-#elif defined key_cice
+#if defined key_cice
    !
    ! for consistency with LIM, these are declared with three dimensions
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qlw_ice            !: incoming long-wave
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qla_ice            !: latent flux over ice           [W/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice            !: solar heat flux over ice       [W/m2]
    !
    ! other forcing arrays are two dimensional
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ss_iou             !: x ice-ocean surface stress at NEMO U point
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ss_iov             !: y ice-ocean surface stress at NEMO V point
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice            !: sublimation-snow budget over ice    [kg/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tatm_ice           !: air temperature
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qatm_ice           !: specific humidity
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wndi_ice           !: i wind at T point
@@ -93,10 +88,22 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr_iu              !: ice fraction at NEMO U point
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr_iv              !: ice fraction at NEMO V point
-   !
-   ! 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
+   
+   ! variables used in the coupled interface
+   INTEGER , PUBLIC, PARAMETER ::   jpl = ncat
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice          ! jpi, jpj
 #endif
+   
+#if defined key_lim2 || defined key_cice
+   ! already defined in ice.F90 for LIM3
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  ht_i, ht_s
+#endif
+
+#if defined key_lim3 || defined key_cice
+   ! not used with LIM2
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tatm_ice       !: air temperature [K]
+#endif
+
+   REAL(wp), PUBLIC, SAVE ::   cldf_ice = 0.81    !: cloud fraction over sea ice, summer CLIO value   [-]
 
    !!----------------------------------------------------------------------
@@ -111,5 +118,5 @@
       !!                     ***  FUNCTION sbc_ice_alloc  ***
       !!----------------------------------------------------------------------
-      INTEGER :: ierr(2)
+      INTEGER :: ierr(5)
       !!----------------------------------------------------------------------
       ierr(:) = 0
@@ -123,22 +130,34 @@
          &      fr1_i0  (jpi,jpj)     , fr2_i0  (jpi,jpj)     ,     &
 #if defined key_lim3
-         &      emp_ice(jpi,jpj)      , tatm_ice(jpi,jpj)     , STAT= ierr(1) )
-#else
-         &      emp_ice(jpi,jpj)                              , STAT= ierr(1) )
+         &      tatm_ice(jpi,jpj)     ,                             &
 #endif
-#elif defined key_cice
+#if defined key_lim2
+         &      a_i(jpi,jpj,jpl)      ,                             &
+#endif
+         &      emp_ice(jpi,jpj)      ,  STAT= ierr(1) )
+#endif
+
+#if defined key_cice
       ALLOCATE( qla_ice(jpi,jpj,1)    , qlw_ice(jpi,jpj,1)    , qsr_ice(jpi,jpj,1)    , &
                 wndi_ice(jpi,jpj)     , tatm_ice(jpi,jpj)     , qatm_ice(jpi,jpj)     , &
                 wndj_ice(jpi,jpj)     , nfrzmlt(jpi,jpj)      , ss_iou(jpi,jpj)       , &
                 ss_iov(jpi,jpj)       , fr_iu(jpi,jpj)        , fr_iv(jpi,jpj)        , &
-                a_i(jpi,jpj,ncat)     , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat), STAT= ierr(1) )
+                a_i(jpi,jpj,ncat)     , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat) , &
+                STAT= ierr(1) )
+      IF( lk_cpl )   ALLOCATE( u_ice(jpi,jpj)        , fr1_i0(jpi,jpj)       , tn_ice (jpi,jpj,1)    , &
+         &                     v_ice(jpi,jpj)        , fr2_i0(jpi,jpj)       , alb_ice(jpi,jpj,1)    , &
+         &                     emp_ice(jpi,jpj)      , qns_ice(jpi,jpj,1)    , dqns_ice(jpi,jpj,1)   , &
+         &                     STAT= ierr(2) )
+      
 #endif
          !
 #if defined key_lim2
-      IF( ltrcdm2dc_ice )THEN
-         ALLOCATE( qsr_ice_mean (jpi,jpj,jpl), STAT=ierr(2) )
-      ENDIF
+      IF( ltrcdm2dc_ice )   ALLOCATE( qsr_ice_mean (jpi,jpj,jpl), STAT=ierr(3) )
 #endif
          !
+#if defined key_cice || defined key_lim2
+      IF( lk_cpl )   ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(5) )
+#endif
+
       sbc_ice_alloc = MAXVAL( ierr )
       IF( lk_mpp            )   CALL mpp_sum ( sbc_ice_alloc )
@@ -150,8 +169,18 @@
    !!   Default option                      NO LIM 2.0 or 3.0 or CICE sea-ice model
    !!----------------------------------------------------------------------
+   USE in_out_manager   ! I/O manager
    LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .FALSE.  !: no LIM-2 ice model
    LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .FALSE.  !: no LIM-3 ice model
    LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .FALSE.  !: no CICE  ice model
    CHARACTER(len=1), PUBLIC, PARAMETER ::   cp_ice_msh = '-'      !: no grid ice-velocity
+   REAL            , PUBLIC, PARAMETER ::   cldf_ice = 0.81       !: cloud fraction over sea ice, summer CLIO value   [-]
+   INTEGER         , PUBLIC, PARAMETER ::   jpl = 1 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice,fr1_i0,fr2_i0          ! jpi, jpj
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice, alb_ice, qns_ice, dqns_ice  ! (jpi,jpj,jpl)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ht_i, ht_s
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   topmelt, botmelt
 #endif
 
Index: branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
===================================================================
--- branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90	(revision 4771)
+++ branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90	(revision 5075)
@@ -35,5 +35,9 @@
    LOGICAL , PUBLIC ::   ln_blk_core    !: CORE bulk formulation
    LOGICAL , PUBLIC ::   ln_blk_mfs     !: MFS  bulk formulation
-   LOGICAL , PUBLIC ::   ln_cpl         !: coupled   formulation (overwritten by key_sbc_coupled )
+#if defined key_oasis3
+   LOGICAL , PUBLIC ::   lk_cpl = .TRUE.  !: coupled formulation
+#else
+   LOGICAL , PUBLIC ::   lk_cpl = .FALSE. !: coupled formulation
+#endif
    LOGICAL , PUBLIC ::   ln_dm2dc       !: Daily mean to Diurnal Cycle short wave (qsr)
    LOGICAL , PUBLIC ::   ln_rnf         !: runoffs / runoff mouths
@@ -41,8 +45,14 @@
    LOGICAL , PUBLIC ::   ln_apr_dyn     !: Atmospheric pressure forcing used on dynamics (ocean & ice)
    INTEGER , PUBLIC ::   nn_ice         !: flag for ice in the surface boundary condition (=0/1/2/3)
+   INTEGER , PUBLIC ::   nn_isf         !: flag for isf in the surface boundary condition (=0/1/2/3/4) 
    INTEGER , PUBLIC ::   nn_ice_embd    !: 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_limflx        !: LIM3 Multi-category heat flux formulation
+   !                                             !: =-1  Use of per-category fluxes
+   !                                             !: = 0  Average per-category fluxes
+   !                                             !: = 1  Average then redistribute per-category fluxes
+   !                                             !: = 2  Redistribute a single flux over categories
    INTEGER , PUBLIC ::   nn_fwb         !: FreshWater Budget: 
    !                                             !:  = 0 unchecked 
@@ -55,9 +65,17 @@
    LOGICAL , PUBLIC ::   ln_icebergs    !: Icebergs
    !
-   CHARACTER (len=8), PUBLIC :: cn_iceflx  !: Flux handling over ice categories
-   LOGICAL, PUBLIC :: ln_iceflx_ave     ! Average heat fluxes over all ice categories
-   LOGICAL, PUBLIC :: ln_iceflx_linear  ! Redistribute mean heat fluxes over all ice categories, using ice temperature and albedo
-   !
-   INTEGER , PUBLIC ::   nn_lsm        !: Number of iteration if seaoverland is applied
+   INTEGER , PUBLIC ::   nn_lsm         !: Number of iteration if seaoverland is applied
+   !!----------------------------------------------------------------------
+   !!           switch definition (improve readability)
+   !!----------------------------------------------------------------------
+   INTEGER , PUBLIC, PARAMETER ::   jp_gyre    = 0        !: GYRE analytical formulation
+   INTEGER , PUBLIC, PARAMETER ::   jp_ana     = 1        !: analytical      formulation
+   INTEGER , PUBLIC, PARAMETER ::   jp_flx     = 2        !: flux            formulation
+   INTEGER , PUBLIC, PARAMETER ::   jp_clio    = 3        !: CLIO bulk       formulation
+   INTEGER , PUBLIC, PARAMETER ::   jp_core    = 4        !: CORE bulk       formulation
+   INTEGER , PUBLIC, PARAMETER ::   jp_cpl     = 5        !: Coupled         formulation
+   INTEGER , PUBLIC, PARAMETER ::   jp_mfs     = 6        !: MFS  bulk       formulation
+   INTEGER , PUBLIC, PARAMETER ::   jp_esopa   = -1       !: esopa test, ALL formulations
+   
    !!----------------------------------------------------------------------
    !!              Ocean Surface Boundary Condition fields
@@ -102,5 +120,5 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sss_m     !: mean (nn_fsbc time-step) surface sea salinity            [psu]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssh_m     !: mean (nn_fsbc time-step) sea surface height                [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3t_m     !: mean (nn_fsbc time-step) sea surface height                [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3t_m     !: mean (nn_fsbc time-step) sea surface layer thickness       [m]
 
    !! * Substitutions
Index: branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
===================================================================
--- branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90	(revision 4771)
+++ branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90	(revision 5075)
@@ -114,5 +114,5 @@
       !!              - utau, vtau  i- and j-component of the wind stress
       !!              - taum        wind stress module at T-point
-      !!              - wndm        10m wind module at T-point
+      !!              - wndm        10m wind module at T-point over free ocean or leads in presence of sea-ice
       !!              - qns         non-solar heat flux including latent heat of solid 
       !!                            precip. melting and emp heat content
@@ -204,5 +204,5 @@
       !!               - utau, vtau  i- and j-component of the wind stress
       !!               - taum        wind stress module at T-point
-      !!               - wndm        10m wind module at T-point
+      !!               - wndm        10m wind module at T-point over free ocean or leads in presence of sea-ice
       !!               - qns         non-solar heat flux including latent heat of solid 
       !!                             precip. melting and emp heat content
@@ -257,4 +257,7 @@
          END DO
       END DO
+      utau(:,:) = utau(:,:) * umask(:,:,1)
+      vtau(:,:) = vtau(:,:) * vmask(:,:,1)
+      taum(:,:) = taum(:,:) * tmask(:,:,1)
       CALL lbc_lnk( taum, 'T', 1. )
 
@@ -264,4 +267,5 @@
 !CDIR COLLAPSE
       wndm(:,:) = sf(jp_wndm)%fnow(:,:,1)
+      wndm(:,:) = wndm(:,:) * tmask(:,:,1)
 
       !------------------------------------------------!
@@ -270,5 +274,5 @@
       
       CALL blk_clio_qsr_oce( qsr )
-
+      qsr(:,:) = qsr(:,:) * tmask(:,:,1) ! no shortwave radiation into the ocean beneath ice shelf
       !------------------------!
       !   Other ocean fluxes   !
@@ -376,4 +380,5 @@
          &     - 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
+      qns(:,:) = qns(:,:) * tmask(:,:,1)
       ! NB: if sea-ice model, the snow precip are computed and the associated heat is added to qns (see blk_ice_clio)
 
@@ -398,5 +403,5 @@
 
 
-   SUBROUTINE blk_ice_clio(  pst   , palb_cs, palb_os ,       &
+   SUBROUTINE blk_ice_clio(  pst   , palb_cs, palb_os, palb,  &
       &                      p_taui, p_tauj, p_qns , p_qsr,   &
       &                      p_qla , p_dqns, p_dqla,          &
@@ -427,6 +432,7 @@
       !!----------------------------------------------------------------------
       REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   pst      ! ice surface temperature                   [Kelvin]
-      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_cs  ! ice albedo (clear    sky) (alb_ice_cs)         [%]
-      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_os  ! ice albedo (overcast sky) (alb_ice_os)         [%]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_cs  ! ice albedo (clear    sky) (alb_ice_cs)         [-]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_os  ! ice albedo (overcast sky) (alb_ice_os)         [-]
+      REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   palb     ! ice albedo (actual value)                      [-]
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_taui   ! surface ice stress at I-point (i-component) [N/m2]
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_tauj   ! surface ice stress at I-point (j-component) [N/m2]
@@ -438,6 +444,6 @@
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_tpr    ! total precipitation          (T-point)   [Kg/m2/s]
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_spr    ! solid precipitation          (T-point)   [Kg/m2/s]
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr1    ! 1sr fraction of qsr penetration in ice         [%]
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr2    ! 2nd fraction of qsr penetration in ice         [%]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr1    ! 1sr fraction of qsr penetration in ice         [-]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr2    ! 2nd fraction of qsr penetration in ice         [-]
       CHARACTER(len=1), INTENT(in   )             ::   cd_grid  ! type of sea-ice grid ("C" or "B" grid)
       INTEGER, INTENT(in   )                      ::   pdim     ! number of ice categories
@@ -542,4 +548,9 @@
       !-----------------------------------------------------------!
       CALL blk_clio_qsr_ice( palb_cs, palb_os, p_qsr )
+      
+      DO jl = 1, ijpl
+         palb(:,:,jl) = ( palb_cs(:,:,jl) * ( 1.e0 - sf(jp_ccov)%fnow(:,:,1) )   &
+            &         +   palb_os(:,:,jl) * sf(jp_ccov)%fnow(:,:,1) )
+      END DO
 
       !                                     ! ========================== !
Index: branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
===================================================================
--- branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90	(revision 4771)
+++ branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90	(revision 5075)
@@ -5,22 +5,27 @@
    !!=====================================================================
    !! History :  1.0  !  2004-08  (U. Schweckendiek)  Original code
-   !!            2.0  !  2005-04  (L. Brodeau, A.M. Treguier) additions: 
+   !!            2.0  !  2005-04  (L. Brodeau, A.M. Treguier) additions:
    !!                           -  new bulk routine for efficiency
    !!                           -  WINDS ARE NOW ASSUMED TO BE AT T POINTS in input files !!!!
-   !!                           -  file names and file characteristics in namelist 
-   !!                           -  Implement reading of 6-hourly fields   
-   !!            3.0  !  2006-06  (G. Madec) sbc rewritting   
-   !!             -   !  2006-12  (L. Brodeau) Original code for TURB_CORE_2Z
+   !!                           -  file names and file characteristics in namelist
+   !!                           -  Implement reading of 6-hourly fields
+   !!            3.0  !  2006-06  (G. Madec) sbc rewritting
+   !!             -   !  2006-12  (L. Brodeau) Original code for turb_core_2z
    !!            3.2  !  2009-04  (B. Lemaire)  Introduce iom_put
    !!            3.3  !  2010-10  (S. Masson)  add diurnal cycle
    !!            3.4  !  2011-11  (C. Harris) Fill arrays required by CICE
+   !!            3.7  !  2014-06  (L. Brodeau) simplification and optimization of CORE bulk
    !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
-   !!   sbc_blk_core  : bulk formulation as ocean surface boundary condition
-   !!                   (forced mode, CORE bulk formulea)
-   !!   blk_oce_core  : ocean: computes momentum, heat and freshwater fluxes
-   !!   blk_ice_core  : ice  : computes momentum, heat and freshwater fluxes
-   !!   turb_core     : computes the CORE turbulent transfer coefficients 
+   !!   sbc_blk_core    : bulk formulation as ocean surface boundary condition (forced mode, CORE bulk formulea)
+   !!   blk_oce_core    : computes momentum, heat and freshwater fluxes over ocean
+   !!   blk_ice_core    : computes momentum, heat and freshwater fluxes over ice
+   !!   blk_bio_meanqsr : compute daily mean short wave radiation over the ocean
+   !!   blk_ice_meanqsr : compute daily mean short wave radiation over the ice
+   !!   turb_core_2z    : Computes turbulent transfert coefficients
+   !!   cd_neutral_10m  : Estimate of the neutral drag coefficient at 10m
+   !!   psi_m           : universal profile stability function for momentum
+   !!   psi_h           : universal profile stability function for temperature and humidity
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers
@@ -38,8 +43,6 @@
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE prtctl          ! Print control
-   USE sbcwave,ONLY :  cdn_wave !wave module 
-#if defined key_lim3 || defined key_cice
+   USE sbcwave, ONLY   :  cdn_wave ! wave module
    USE sbc_ice         ! Surface boundary condition: ice fields
-#endif
    USE lib_fortran     ! to use key_nosignedzero
 
@@ -52,5 +55,5 @@
    PUBLIC   turb_core_2z         ! routine calles in sbcblk_mfs module
 
-   INTEGER , PARAMETER ::   jpfld   = 9           ! maximum number of files to read 
+   INTEGER , PARAMETER ::   jpfld   = 9           ! maximum number of files to read
    INTEGER , PARAMETER ::   jp_wndi = 1           ! index of 10m wind velocity (i-component) (m/s)    at T-point
    INTEGER , PARAMETER ::   jp_wndj = 2           ! index of 10m wind velocity (j-component) (m/s)    at T-point
@@ -62,7 +65,7 @@
    INTEGER , PARAMETER ::   jp_snow = 8           ! index of snow (solid prcipitation)       (kg/m2/s)
    INTEGER , PARAMETER ::   jp_tdif = 9           ! index of tau diff associated to HF tau   (N/m2)   at T-point
-   
+
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf   ! structure of input fields (file informations, fields read)
-         
+
    !                                             !!! CORE bulk parameters
    REAL(wp), PARAMETER ::   rhoa =    1.22        ! air density
@@ -75,10 +78,8 @@
 
    !                                  !!* Namelist namsbc_core : CORE bulk parameters
-   LOGICAL  ::   ln_2m       ! logical flag for height of air temp. and hum
    LOGICAL  ::   ln_taudif   ! logical flag to use the "mean of stress module - module of mean stress" data
    REAL(wp) ::   rn_pfac     ! multiplication factor for precipitation
    REAL(wp) ::   rn_efac     ! multiplication factor for evaporation (clem)
    REAL(wp) ::   rn_vfac     ! multiplication factor for ice/ocean velocity in the calculation of wind stress (clem)
-   LOGICAL  ::   ln_bulk2z   ! logical flag for case where z(q,t) and z(u) are specified in the namelist
    REAL(wp) ::   rn_zqt      ! z(q,t) : height of humidity and temperature measurements
    REAL(wp) ::   rn_zu       ! z(u)   : height of wind measurements
@@ -88,5 +89,5 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO-consortium (2010) 
+   !! NEMO/OPA 3.7 , NEMO-consortium (2014)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -97,7 +98,7 @@
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE sbc_blk_core  ***
-      !!                   
+      !!
       !! ** Purpose :   provide at each time step the surface ocean fluxes
-      !!      (momentum, heat, freshwater and runoff) 
+      !!      (momentum, heat, freshwater and runoff)
       !!
       !! ** Method  : (1) READ each fluxes in NetCDF files:
@@ -118,17 +119,21 @@
       !! ** 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
+      !!              - taum        wind stress module at T-point
+      !!              - wndm        wind speed  module at T-point over free ocean or leads in presence of sea-ice
       !!              - 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)
+      !!
+      !! ** References :   Large & Yeager, 2004 / Large & Yeager, 2008
+      !!                   Brodeau et al. Ocean Modelling 2010
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! ocean time step
-      !!
+      !
       INTEGER  ::   ierror   ! return error code
       INTEGER  ::   ifpr     ! dummy loop indice
       INTEGER  ::   jfld     ! dummy loop arguments
       INTEGER  ::   ios      ! Local integer output status for namelist read
-      !!
+      !
       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
@@ -136,10 +141,10 @@
       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, rn_efac, rn_vfac,  &
+      NAMELIST/namsbc_core/ cn_dir , ln_taudif, rn_pfac, rn_efac, rn_vfac,  &
          &                  sn_wndi, sn_wndj, sn_humi  , sn_qsr ,           &
          &                  sn_qlw , sn_tair, sn_prec  , sn_snow,           &
-         &                  sn_tdif, rn_zqt , ln_bulk2z, rn_zu
-      !!---------------------------------------------------------------------
-
+         &                  sn_tdif, rn_zqt,  rn_zu
+      !!---------------------------------------------------------------------
+      !
       !                                         ! ====================== !
       IF( kt == nit000 ) THEN                   !  First call kt=nit000  !
@@ -149,16 +154,16 @@
          READ  ( numnam_ref, namsbc_core, IOSTAT = ios, ERR = 901)
 901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_core in reference namelist', lwp )
-
+         !
          REWIND( numnam_cfg )              ! Namelist namsbc_core in configuration namelist : CORE bulk parameters
          READ  ( numnam_cfg, namsbc_core, IOSTAT = ios, ERR = 902 )
 902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_core in configuration namelist', lwp )
 
-         IF(lwm) WRITE ( numond, namsbc_core )
+         IF(lwm) WRITE( numond, namsbc_core )
          !                                         ! check: do we plan to use ln_dm2dc with non-daily forcing?
-         IF( ln_dm2dc .AND. sn_qsr%nfreqh /= 24 )   & 
-            &   CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' ) 
+         IF( ln_dm2dc .AND. sn_qsr%nfreqh /= 24 )   &
+            &   CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' )
          IF( ln_dm2dc .AND. sn_qsr%ln_tint ) THEN
             CALL ctl_warn( 'sbc_blk_core: ln_dm2dc is taking care of the temporal interpolation of daily qsr',   &
-                 &         '              ==> We force time interpolation = .false. for qsr' )
+               &         '              ==> We force time interpolation = .false. for qsr' )
             sn_qsr%ln_tint = .false.
          ENDIF
@@ -169,5 +174,5 @@
          slf_i(jp_prec) = sn_prec   ;   slf_i(jp_snow) = sn_snow
          slf_i(jp_tdif) = sn_tdif
-         !                 
+         !
          lhftau = ln_taudif                        ! do we use HF tau information?
          jfld = jpfld - COUNT( (/.NOT. lhftau/) )
@@ -191,5 +196,5 @@
       IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce_core( kt, sf, sst_m, ssu_m, ssv_m )
 
-      ! If diurnal cycle is activated, compute a daily mean short waves flux for biogeochemistery 
+      ! If diurnal cycle is activated, compute a daily mean short waves flux for biogeochemistery
       IF( ltrcdm2dc )   CALL blk_bio_meanqsr
 
@@ -226,5 +231,4 @@
       !!              - qsr     : Solar heat flux over the ocean        (W/m2)
       !!              - 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)
       !!
@@ -269,8 +273,5 @@
       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 !
+      CALL wnd_cyc( kt, zwnd_i, zwnd_j )    ! add analytical tropical cyclone (Vincent et al. JGR 2012)
       DO jj = 2, jpjm1
          DO ji = fs_2, fs_jpim1   ! vect. opt.
@@ -279,7 +280,4 @@
          END DO
       END DO
-#endif
-#if defined key_vectopt_loop
-!CDIR COLLAPSE
 #endif
       DO jj = 2, jpjm1
@@ -292,6 +290,4 @@
       CALL lbc_lnk( zwnd_j(:,:) , 'T', -1. )
       ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked)
-!CDIR NOVERRCHK
-!CDIR COLLAPSE
       wndm(:,:) = SQRT(  zwnd_i(:,:) * zwnd_i(:,:)   &
          &             + zwnd_j(:,:) * zwnd_j(:,:)  ) * tmask(:,:,1)
@@ -300,5 +296,5 @@
       !      I   Radiative FLUXES                                                     !
       ! ----------------------------------------------------------------------------- !
-    
+
       ! ocean albedo assumed to be constant + modify now Qsr to include the diurnal cycle                    ! Short Wave
       zztmp = 1. - albo
@@ -306,5 +302,4 @@
       ELSE                  ;   qsr(:,:) = zztmp *          sf(jp_qsr)%fnow(:,:,1)   * tmask(:,:,1)
       ENDIF
-!CDIR COLLAPSE
       zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave
       ! ----------------------------------------------------------------------------- !
@@ -313,43 +308,10 @@
 
       ! ... specific humidity at SST and IST
-!CDIR NOVERRCHK
-!CDIR COLLAPSE
-      zqsatw(:,:) = zcoef_qsatw * EXP( -5107.4 / zst(:,:) ) 
+      zqsatw(:,:) = zcoef_qsatw * EXP( -5107.4 / zst(:,:) )
 
       ! ... NCAR Bulk formulae, computation of Cd, Ch, Ce at T-point :
-      IF( ln_2m ) THEN
-         !! If air temp. and spec. hum. are given at different height (2m) than wind (10m) :
-         CALL TURB_CORE_2Z(2.,10., zst   , sf(jp_tair)%fnow,         &
-            &                      zqsatw, sf(jp_humi)%fnow, wndm,   &
-            &                      Cd    , Ch              , Ce  ,   &
-            &                      zt_zu , zq_zu                   )
-      ELSE IF( ln_bulk2z ) THEN
-         !! If the height of the air temp./spec. hum. and wind are to be specified by hand :
-         IF( rn_zqt == rn_zu ) THEN
-            !! If air temp. and spec. hum. are at the same height as wind :
-            CALL TURB_CORE_1Z( rn_zu, zst   , sf(jp_tair)%fnow(:,:,1),       &
-               &                      zqsatw, sf(jp_humi)%fnow(:,:,1), wndm, &
-               &                      Cd    , Ch                     , Ce  )
-         ELSE
-            !! If air temp. and spec. hum. are at a different height to wind :
-            CALL TURB_CORE_2Z(rn_zqt, rn_zu , zst   , sf(jp_tair)%fnow,         &
-               &                              zqsatw, sf(jp_humi)%fnow, wndm,   &
-               &                              Cd    , Ch              , Ce  ,   &
-               &                              zt_zu , zq_zu                 )
-         ENDIF
-      ELSE
-         !! If air temp. and spec. hum. are given at same height than wind (10m) :
-!gm bug?  at the compiling phase, add a copy in temporary arrays...  ==> check perf
-!         CALL TURB_CORE_1Z( 10., zst   (:,:), sf(jp_tair)%fnow(:,:),              &
-!            &                    zqsatw(:,:), sf(jp_humi)%fnow(:,:), wndm(:,:),   &
-!            &                    Cd    (:,:),             Ch  (:,:), Ce  (:,:)  )
-!gm bug
-! ARPDBG - this won't compile with gfortran. Fix but check performance
-! as per comment above.
-         CALL TURB_CORE_1Z( 10., zst   , sf(jp_tair)%fnow(:,:,1),       &
-            &                    zqsatw, sf(jp_humi)%fnow(:,:,1), wndm, &
-            &                    Cd    , Ch              , Ce    )
-      ENDIF
-
+      CALL turb_core_2z( rn_zqt, rn_zu, zst, sf(jp_tair)%fnow, zqsatw, sf(jp_humi)%fnow, wndm,   &
+         &               Cd, Ch, Ce, zt_zu, zq_zu )
+    
       ! ... tau module, i and j component
       DO jj = 1, jpj
@@ -363,6 +325,5 @@
 
       ! ... add the HF tau contribution to the wind stress module?
-      IF( lhftau ) THEN 
-!CDIR COLLAPSE
+      IF( lhftau ) THEN
          taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:,1)
       ENDIF
@@ -371,8 +332,11 @@
       ! ... utau, vtau at U- and V_points, resp.
       !     Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines
+      !     Note the use of MAX(tmask(i,j),tmask(i+1,j) is to mask tau over ice shelves
       DO jj = 1, jpjm1
          DO ji = 1, fs_jpim1
-            utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( zwnd_i(ji,jj) + zwnd_i(ji+1,jj  ) )
-            vtau(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( zwnd_j(ji,jj) + zwnd_j(ji  ,jj+1) )
+            utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( zwnd_i(ji,jj) + zwnd_i(ji+1,jj  ) ) &
+               &          * MAX(tmask(ji,jj,1),tmask(ji+1,jj,1))
+            vtau(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( zwnd_j(ji,jj) + zwnd_j(ji  ,jj+1) ) &
+               &          * MAX(tmask(ji,jj,1),tmask(ji,jj+1,1))
          END DO
       END DO
@@ -380,17 +344,17 @@
       CALL lbc_lnk( vtau(:,:), 'V', -1. )
 
+    
       !  Turbulent fluxes over ocean
       ! -----------------------------
-      IF( ln_2m .OR. ( ln_bulk2z .AND. rn_zqt /= rn_zu ) ) THEN
-         ! Values of temp. and hum. adjusted to height of wind must be used
-         zevap(:,:) = rn_efac * MAX( 0.e0, rhoa    *Ce(:,:)*( zqsatw(:,:) - zq_zu(:,:) ) * wndm(:,:) )   ! Evaporation
-         zqsb (:,:) =                      rhoa*cpa*Ch(:,:)*( zst   (:,:) - zt_zu(:,:) ) * wndm(:,:)     ! Sensible Heat
+      IF( ABS( rn_zu - rn_zqt) < 0.01_wp ) THEN
+         !! q_air and t_air are (or "are almost") given at 10m (wind reference height)
+         zevap(:,:) = rn_efac*MAX( 0._wp,     rhoa*Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,:,1) )*wndm(:,:) ) ! Evaporation
+         zqsb (:,:) =                     cpa*rhoa*Ch(:,:)*( zst   (:,:) - sf(jp_tair)%fnow(:,:,1) )*wndm(:,:)   ! Sensible Heat
       ELSE
-!CDIR COLLAPSE
-         zevap(:,:) = rn_efac * MAX( 0.e0, rhoa    *Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,:,1) ) * wndm(:,:) )   ! Evaporation
-!CDIR COLLAPSE
-         zqsb (:,:) =            rhoa*cpa*Ch(:,:)*( zst   (:,:) - sf(jp_tair)%fnow(:,:,1) ) * wndm(:,:)     ! Sensible Heat
+         !! q_air and t_air are not given at 10m (wind reference height)
+         ! Values of temp. and hum. adjusted to height of wind during bulk algorithm iteration must be used!!!
+         zevap(:,:) = rn_efac*MAX( 0._wp,     rhoa*Ce(:,:)*( zqsatw(:,:) - zq_zu(:,:) )*wndm(:,:) )   ! Evaporation
+         zqsb (:,:) =                     cpa*rhoa*Ch(:,:)*( zst   (:,:) - zt_zu(:,:) )*wndm(:,:)     ! Sensible Heat
       ENDIF
-!CDIR COLLAPSE
       zqla (:,:) = Lv * zevap(:,:)                                                              ! Latent Heat
 
@@ -409,16 +373,14 @@
       !     III    Total FLUXES                                                       !
       ! ----------------------------------------------------------------------------- !
-     
-!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_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 
+         &     * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1)
       !
       CALL iom_put( "qlw_oce",   zqlw )                 ! output downward longwave heat over the ocean
@@ -442,58 +404,4 @@
       !
    END SUBROUTINE blk_oce_core
-  
-   SUBROUTINE blk_bio_meanqsr
-      !!---------------------------------------------------------------------
-      !!                     ***  ROUTINE blk_bio_meanqsr
-      !!                     
-      !! ** Purpose :   provide daily qsr_mean for PISCES when
-      !!                analytic diurnal cycle is applied in physic
-      !!                
-      !! ** Method  :   add part where there is no ice
-      !! 
-      !!---------------------------------------------------------------------
-      IF( nn_timing == 1 )  CALL timing_start('blk_bio_meanqsr')
-
-      qsr_mean(:,:) = (1. - albo ) *  sf(jp_qsr)%fnow(:,:,1)
-
-      IF( nn_timing == 1 )  CALL timing_stop('blk_bio_meanqsr')
-
-   END SUBROUTINE blk_bio_meanqsr
- 
- 
-   SUBROUTINE blk_ice_meanqsr(palb,p_qsr_mean,pdim)
-      !!---------------------------------------------------------------------
-      !!
-      !! ** Purpose :   provide the daily qsr_mean over sea_ice for PISCES when
-      !!                analytic diurnal cycle is applied in physic
-      !!
-      !! ** Method  :   compute qsr
-      !! 
-      !!---------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb       ! ice albedo (clear sky) (alb_ice_cs)               [%]
-      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_qsr_mean !     solar heat flux over ice (T-point)         [W/m2]
-      INTEGER                   , INTENT(in   ) ::   pdim       ! number of ice categories
-      !!
-      INTEGER  ::   ijpl          ! number of ice categories (size of 3rd dim of input arrays)
-      INTEGER  ::   ji, jj, jl    ! dummy loop indices
-      REAL(wp) ::   zztmp         ! temporary variable
-      !!---------------------------------------------------------------------
-      IF( nn_timing == 1 )  CALL timing_start('blk_ice_meanqsr')
-      !
-      ijpl  = pdim                            ! number of ice categories
-      zztmp = 1. / ( 1. - albo )
-      !                                     ! ========================== !
-      DO jl = 1, ijpl                       !  Loop over ice categories  !
-         !                                  ! ========================== !
-         DO jj = 1 , jpj
-            DO ji = 1, jpi
-                  p_qsr_mean(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr_mean(ji,jj)
-            END DO
-         END DO
-      END DO
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_meanqsr')
-      !
-   END SUBROUTINE blk_ice_meanqsr  
  
    
@@ -518,5 +426,5 @@
       REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pui      ! ice surface velocity (i- and i- components      [m/s]
       REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pvi      !    at I-point (B-grid) or U & V-point (C-grid)
-      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb     ! ice albedo (clear sky) (alb_ice_cs)               [%]
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb     ! ice albedo (all skies)                            [%]
       REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_taui   ! i- & j-components of surface ice stress        [N/m2]
       REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_tauj   !   at I-point (B-grid) or U & V-point (C-grid)
@@ -538,5 +446,4 @@
       REAL(wp) ::   zcoef_wnorm, zcoef_wnorm2, zcoef_dqlw, zcoef_dqla, zcoef_dqsb
       REAL(wp) ::   zztmp                                        ! temporary variable
-      REAL(wp) ::   zcoef_frca                                   ! fractional cloud amount
       REAL(wp) ::   zwnorm_f, zwndi_f , zwndj_f                  ! relative wind module and components at F-point
       REAL(wp) ::             zwndi_t , zwndj_t                  ! relative wind components at T-point
@@ -562,5 +469,4 @@
       zcoef_dqla   = -Ls * Cice * 11637800. * (-5897.8)
       zcoef_dqsb   = rhoa * cpa * Cice
-      zcoef_frca   = 1.0  - 0.3
 
 !!gm brutal....
@@ -579,5 +485,4 @@
       CASE( 'I' )                  ! B-grid ice dynamics :   I-point (i.e. F-point with sea-ice indexation)
          !                           and scalar wind at T-point ( = | U10m - U_ice | ) (masked)
-!CDIR NOVERRCHK
          DO jj = 2, jpjm1
             DO ji = 2, jpim1   ! B grid : NO vector opt
@@ -604,7 +509,4 @@
          !
       CASE( 'C' )                  ! C-grid ice dynamics :   U & V-points (same as ocean)
-#if defined key_vectopt_loop
-!CDIR COLLAPSE
-#endif
          DO jj = 2, jpj
             DO ji = fs_2, jpi   ! vect. opt.
@@ -614,7 +516,4 @@
             END DO
          END DO
-#if defined key_vectopt_loop
-!CDIR COLLAPSE
-#endif
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vect. opt.
@@ -635,8 +534,5 @@
       DO jl = 1, ijpl                       !  Loop over ice categories  !
          !                                  ! ========================== !
-!CDIR NOVERRCHK
-!CDIR COLLAPSE
          DO jj = 1 , jpj
-!CDIR NOVERRCHK
             DO ji = 1, jpi
                ! ----------------------------!
@@ -648,10 +544,5 @@
                p_qsr(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj)
                ! Long  Wave (lw)
-               ! iovino
-               IF( ff(ji,jj) .GT. 0._wp ) THEN
-                  z_qlw(ji,jj,jl) = ( 0.95 * sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1)
-               ELSE
-                  z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1)
-               ENDIF
+               z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1)
                ! lw sensitivity
                z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3                                               
@@ -668,5 +559,10 @@
                   &                         * (  11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1)  ) )
                ! Latent heat sensitivity for ice (Dqla/Dt)
-               p_dqla(ji,jj,jl) = rn_efac * zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) )
+               IF( p_qla(ji,jj,jl) > 0._wp ) THEN
+                  p_dqla(ji,jj,jl) = rn_efac * zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) )
+               ELSE
+                  p_dqla(ji,jj,jl) = 0._wp
+               ENDIF
+
                ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice)
                z_dqsb(ji,jj,jl) = zcoef_dqsb * z_wnds_t(ji,jj)
@@ -676,7 +572,7 @@
                ! ----------------------------!
                ! Downward Non Solar flux
-               p_qns (ji,jj,jl) =     z_qlw (ji,jj,jl) - z_qsb (ji,jj,jl) - p_qla (ji,jj,jl)      
+               p_qns (ji,jj,jl) =     z_qlw (ji,jj,jl) - z_qsb (ji,jj,jl) - p_qla (ji,jj,jl)
                ! Total non solar heat flux sensitivity for ice
-               p_dqns(ji,jj,jl) = - ( z_dqlw(ji,jj,jl) + z_dqsb(ji,jj,jl) + p_dqla(ji,jj,jl) )    
+               p_dqns(ji,jj,jl) = - ( z_dqlw(ji,jj,jl) + z_dqsb(ji,jj,jl) + p_dqla(ji,jj,jl) )
             END DO
             !
@@ -689,16 +585,12 @@
       ! thin surface layer and penetrates inside the ice cover
       ! ( Maykut and Untersteiner, 1971 ; Ebert and Curry, 1993 )
-    
-!CDIR COLLAPSE
-      p_fr1(:,:) = ( 0.18 * ( 1.0 - zcoef_frca ) + 0.35 * zcoef_frca )
-!CDIR COLLAPSE
-      p_fr2(:,:) = ( 0.82 * ( 1.0 - zcoef_frca ) + 0.65 * zcoef_frca )
-       
-!CDIR COLLAPSE
+      !
+      p_fr1(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )
+      p_fr2(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )
+      !
       p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac      ! total precipitation [kg/m2/s]
-!CDIR COLLAPSE
       p_spr(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac      ! solid precipitation [kg/m2/s]
-      CALL iom_put( 'snowpre', p_spr * 86400. )                  ! Snow precipitation 
-      CALL iom_put( 'precip', p_tpr * 86400. )                   ! Total precipitation 
+      CALL iom_put( 'snowpre', p_spr * 86400. )                  ! Snow precipitation
+      CALL iom_put( 'precip' , p_tpr * 86400. )                  ! Total precipitation
       !
       IF(ln_ctl) THEN
@@ -713,160 +605,90 @@
       ENDIF
 
-      CALL wrk_dealloc( jpi,jpj, z_wnds_t )
-      CALL wrk_dealloc( jpi,jpj,pdim, z_qlw, z_qsb, z_dqlw, z_dqsb ) 
+      CALL wrk_dealloc( jpi,jpj,   z_wnds_t )
+      CALL wrk_dealloc( jpi,jpj,   pdim, z_qlw, z_qsb, z_dqlw, z_dqsb )
       !
       IF( nn_timing == 1 )  CALL timing_stop('blk_ice_core')
       !
    END SUBROUTINE blk_ice_core
-  
-
-   SUBROUTINE TURB_CORE_1Z(zu, sst, T_a, q_sat, q_a,   &
-      &                        dU , Cd , Ch   , Ce   )
+
+
+   SUBROUTINE blk_bio_meanqsr
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE blk_bio_meanqsr
+      !!                     
+      !! ** Purpose :   provide daily qsr_mean for PISCES when
+      !!                analytic diurnal cycle is applied in physic
+      !!                
+      !! ** Method  :   add part where there is no ice
+      !! 
+      !!---------------------------------------------------------------------
+      IF( nn_timing == 1 )  CALL timing_start('blk_bio_meanqsr')
+      !
+      qsr_mean(:,:) = (1. - albo ) *  sf(jp_qsr)%fnow(:,:,1)
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('blk_bio_meanqsr')
+      !
+   END SUBROUTINE blk_bio_meanqsr
+ 
+ 
+   SUBROUTINE blk_ice_meanqsr( palb, p_qsr_mean, pdim )
+      !!---------------------------------------------------------------------
+      !!
+      !! ** Purpose :   provide the daily qsr_mean over sea_ice for PISCES when
+      !!                analytic diurnal cycle is applied in physic
+      !!
+      !! ** Method  :   compute qsr
+      !! 
+      !!---------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb       ! ice albedo (clear sky) (alb_ice_cs)               [%]
+      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_qsr_mean !     solar heat flux over ice (T-point)         [W/m2]
+      INTEGER                   , INTENT(in   ) ::   pdim       ! number of ice categories
+      !
+      INTEGER  ::   ijpl          ! number of ice categories (size of 3rd dim of input arrays)
+      INTEGER  ::   ji, jj, jl    ! dummy loop indices
+      REAL(wp) ::   zztmp         ! temporary variable
+      !!---------------------------------------------------------------------
+      IF( nn_timing == 1 )  CALL timing_start('blk_ice_meanqsr')
+      !
+      ijpl  = pdim                            ! number of ice categories
+      zztmp = 1. / ( 1. - albo )
+      !                                     ! ========================== !
+      DO jl = 1, ijpl                       !  Loop over ice categories  !
+         !                                  ! ========================== !
+         DO jj = 1 , jpj
+            DO ji = 1, jpi
+                  p_qsr_mean(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr_mean(ji,jj)
+            END DO
+         END DO
+      END DO
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_meanqsr')
+      !
+   END SUBROUTINE blk_ice_meanqsr  
+
+
+   SUBROUTINE turb_core_2z( zt, zu, sst, T_zt, q_sat, q_zt, dU,    &
+      &                      Cd, Ch, Ce , T_zu, q_zu )
       !!----------------------------------------------------------------------
       !!                      ***  ROUTINE  turb_core  ***
       !!
       !! ** Purpose :   Computes turbulent transfert coefficients of surface
-      !!                fluxes according to Large & Yeager (2004)
-      !!
-      !! ** Method  :   I N E R T I A L   D I S S I P A T I O N   M E T H O D
-      !!      Momentum, Latent and sensible heat exchange coefficients
-      !!      Caution: this procedure should only be used in cases when air
-      !!      temperature (T_air), air specific humidity (q_air) and wind (dU)
-      !!      are provided at the same height 'zzu'!
-      !!
-      !! References :   Large & Yeager, 2004 : ???
-      !!----------------------------------------------------------------------
-      REAL(wp)                , INTENT(in   ) ::   zu      ! altitude of wind measurement       [m]
-      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   sst     ! sea surface temperature         [Kelvin]
-      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   T_a     ! potential air temperature       [Kelvin]
-      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   q_sat   ! sea surface specific humidity   [kg/kg]
-      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   q_a     ! specific air humidity           [kg/kg]
-      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   dU      ! wind module |U(zu)-U(0)|        [m/s]
-      REAL(wp), DIMENSION(:,:), INTENT(  out) ::   Cd      ! transfert coefficient for momentum       (tau)
-      REAL(wp), DIMENSION(:,:), INTENT(  out) ::   Ch      ! transfert coefficient for temperature (Q_sens)
-      REAL(wp), DIMENSION(:,:), INTENT(  out) ::   Ce      ! transfert coefficient for evaporation  (Q_lat)
-      !!
-      INTEGER :: j_itt
-      INTEGER , PARAMETER ::   nb_itt = 3
-      REAL(wp), PARAMETER ::   grav   = 9.8   ! gravity                       
-      REAL(wp), PARAMETER ::   kappa  = 0.4   ! von Karman s constant
-
-      REAL(wp), DIMENSION(:,:), POINTER  ::   dU10          ! dU                                   [m/s]
-      REAL(wp), DIMENSION(:,:), POINTER  ::   dT            ! air/sea temperature differeence      [K]
-      REAL(wp), DIMENSION(:,:), POINTER  ::   dq            ! air/sea humidity difference          [K]
-      REAL(wp), DIMENSION(:,:), POINTER  ::   Cd_n10        ! 10m neutral drag coefficient
-      REAL(wp), DIMENSION(:,:), POINTER  ::   Ce_n10        ! 10m neutral latent coefficient
-      REAL(wp), DIMENSION(:,:), POINTER  ::   Ch_n10        ! 10m neutral sensible coefficient
-      REAL(wp), DIMENSION(:,:), POINTER  ::   sqrt_Cd_n10   ! root square of Cd_n10
-      REAL(wp), DIMENSION(:,:), POINTER  ::   sqrt_Cd       ! root square of Cd
-      REAL(wp), DIMENSION(:,:), POINTER  ::   T_vpot        ! virtual potential temperature        [K]
-      REAL(wp), DIMENSION(:,:), POINTER  ::   T_star        ! turbulent scale of tem. fluct.
-      REAL(wp), DIMENSION(:,:), POINTER  ::   q_star        ! turbulent humidity of temp. fluct.
-      REAL(wp), DIMENSION(:,:), POINTER  ::   U_star        ! turb. scale of velocity fluct.
-      REAL(wp), DIMENSION(:,:), POINTER  ::   L             ! Monin-Obukov length                  [m]
-      REAL(wp), DIMENSION(:,:), POINTER  ::   zeta          ! stability parameter at height zu
-      REAL(wp), DIMENSION(:,:), POINTER  ::   U_n10         ! neutral wind velocity at 10m         [m]   
-      REAL(wp), DIMENSION(:,:), POINTER  ::   xlogt, xct, zpsi_h, zpsi_m
-      
-      INTEGER , DIMENSION(:,:), POINTER  ::   stab          ! 1st guess stability test integer
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('TURB_CORE_1Z')
-      !
-      CALL wrk_alloc( jpi,jpj, stab )   ! integer
-      CALL wrk_alloc( jpi,jpj, dU10, dT, dq, Cd_n10, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd, L )
-      CALL wrk_alloc( jpi,jpj, T_vpot, T_star, q_star, U_star, zeta, U_n10, xlogt, xct, zpsi_h, zpsi_m )
-
-      !! * Start
-      !! Air/sea differences
-      dU10 = max(0.5, dU)     ! we don't want to fall under 0.5 m/s
-      dT = T_a - sst          ! assuming that T_a is allready the potential temp. at zzu
-      dq = q_a - q_sat
-      !!    
-      !! Virtual potential temperature
-      T_vpot = T_a*(1. + 0.608*q_a)
-      !!
-      !! Neutral Drag Coefficient
-      stab    = 0.5 + sign(0.5,dT)    ! stable : stab = 1 ; unstable : stab = 0 
-      IF  ( ln_cdgw ) THEN
-        cdn_wave = cdn_wave - rsmall*(tmask(:,:,1)-1)
-        Cd_n10(:,:) =   cdn_wave
-      ELSE
-        Cd_n10  = 1.e-3 * ( 2.7/dU10 + 0.142 + dU10/13.09 )    !   L & Y eq. (6a)
-      ENDIF
-      sqrt_Cd_n10 = sqrt(Cd_n10)
-      Ce_n10  = 1.e-3 * ( 34.6 * sqrt_Cd_n10 )               !   L & Y eq. (6b)
-      Ch_n10  = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1.-stab)) !   L & Y eq. (6c), (6d)
-      !!
-      !! Initializing transfert coefficients with their first guess neutral equivalents :
-      Cd = Cd_n10 ;  Ce = Ce_n10 ;  Ch = Ch_n10 ;  sqrt_Cd = sqrt(Cd)
-
-      !! * Now starting iteration loop
-      DO j_itt=1, nb_itt
-         !! Turbulent scales :
-         U_star  = sqrt_Cd*dU10                !   L & Y eq. (7a)
-         T_star  = Ch/sqrt_Cd*dT               !   L & Y eq. (7b)
-         q_star  = Ce/sqrt_Cd*dq               !   L & Y eq. (7c)
-
-         !! Estimate the Monin-Obukov length :
-         L  = (U_star**2)/( kappa*grav*(T_star/T_vpot + q_star/(q_a + 1./0.608)) )
-
-         !! Stability parameters :
-         zeta  = zu/L ;  zeta   = sign( min(abs(zeta),10.0), zeta )
-         zpsi_h  = psi_h(zeta)
-         zpsi_m  = psi_m(zeta)
-
-         IF  ( ln_cdgw ) THEN
-           sqrt_Cd=kappa/((kappa/sqrt_Cd_n10) - zpsi_m) ; Cd=sqrt_Cd*sqrt_Cd;
-         ELSE
-           !! Shifting the wind speed to 10m and neutral stability :
-           U_n10 = dU10*1./(1. + sqrt_Cd_n10/kappa*(log(zu/10.) - zpsi_m)) !  L & Y eq. (9a)
-
-           !! Updating the neutral 10m transfer coefficients :
-           Cd_n10  = 1.e-3 * (2.7/U_n10 + 0.142 + U_n10/13.09)              !  L & Y eq. (6a)
-           sqrt_Cd_n10 = sqrt(Cd_n10)
-           Ce_n10  = 1.e-3 * (34.6 * sqrt_Cd_n10)                           !  L & Y eq. (6b)
-           stab    = 0.5 + sign(0.5,zeta)
-           Ch_n10  = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1.-stab))           !  L & Y eq. (6c), (6d)
-
-           !! Shifting the neutral  10m transfer coefficients to ( zu , zeta ) :
-           !!
-           xct = 1. + sqrt_Cd_n10/kappa*(log(zu/10) - zpsi_m)
-           Cd  = Cd_n10/(xct*xct) ;  sqrt_Cd = sqrt(Cd)
-         ENDIF
-         !!
-         xlogt = log(zu/10.) - zpsi_h
-         !!
-         xct = 1. + Ch_n10*xlogt/kappa/sqrt_Cd_n10
-         Ch  = Ch_n10*sqrt_Cd/sqrt_Cd_n10/xct
-         !!
-         xct = 1. + Ce_n10*xlogt/kappa/sqrt_Cd_n10
-         Ce  = Ce_n10*sqrt_Cd/sqrt_Cd_n10/xct
-         !!
-      END DO
-      !!
-      CALL wrk_dealloc( jpi,jpj, stab )   ! integer
-      CALL wrk_dealloc( jpi,jpj, dU10, dT, dq, Cd_n10, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd, L )
-      CALL wrk_dealloc( jpi,jpj, T_vpot, T_star, q_star, U_star, zeta, U_n10, xlogt, xct, zpsi_h, zpsi_m )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('TURB_CORE_1Z')
-      !
-    END SUBROUTINE TURB_CORE_1Z
-
-
-    SUBROUTINE TURB_CORE_2Z(zt, zu, sst, T_zt, q_sat, q_zt, dU, Cd, Ch, Ce, T_zu, q_zu)
-      !!----------------------------------------------------------------------
-      !!                      ***  ROUTINE  turb_core  ***
-      !!
-      !! ** Purpose :   Computes turbulent transfert coefficients of surface 
-      !!                fluxes according to Large & Yeager (2004).
-      !!
-      !! ** Method  :   I N E R T I A L   D I S S I P A T I O N   M E T H O D
-      !!      Momentum, Latent and sensible heat exchange coefficients
-      !!      Caution: this procedure should only be used in cases when air
-      !!      temperature (T_air) and air specific humidity (q_air) are at a
-      !!      different height to wind (dU).
-      !!
-      !! References :   Large & Yeager, 2004 : ???
+      !!                fluxes according to Large & Yeager (2004) and Large & Yeager (2008)
+      !!                If relevant (zt /= zu), adjust temperature and humidity from height zt to zu
+      !!
+      !! ** Method : Monin Obukhov Similarity Theory 
+      !!             + Large & Yeager (2004,2008) closure: CD_n10 = f(U_n10)
+      !!
+      !! ** References :   Large & Yeager, 2004 / Large & Yeager, 2008
+      !!
+      !! ** Last update: Laurent Brodeau, June 2014:
+      !!    - handles both cases zt=zu and zt/=zu
+      !!    - optimized: less 2D arrays allocated and less operations
+      !!    - better first guess of stability by checking air-sea difference of virtual temperature
+      !!       rather than temperature difference only...
+      !!    - added function "cd_neutral_10m" that uses the improved parametrization of 
+      !!      Large & Yeager 2008. Drag-coefficient reduction for Cyclone conditions!
+      !!    - using code-wide physical constants defined into "phycst.mod" rather than redifining them
+      !!      => 'vkarmn' and 'grav'
       !!----------------------------------------------------------------------
       REAL(wp), INTENT(in   )                     ::   zt       ! height for T_zt and q_zt                   [m]
@@ -876,5 +698,5 @@
       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_sat    ! sea surface specific humidity         [kg/kg]
       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity                 [kg/kg]
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   dU       ! relative wind module |U(zu)-U(0)|       [m/s]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   dU       ! relative wind module at zu            [m/s]
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cd       ! transfer coefficient for momentum         (tau)
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ch       ! transfer coefficient for sensible heat (Q_sens)
@@ -882,168 +704,199 @@
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   T_zu     ! air temp. shifted at zu                     [K]
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. hum.  shifted at zu               [kg/kg]
-
-      INTEGER :: j_itt
-      INTEGER , PARAMETER :: nb_itt = 5              ! number of itterations
-      REAL(wp), PARAMETER ::   grav   = 9.8          ! gravity                       
-      REAL(wp), PARAMETER ::   kappa  = 0.4          ! von Karman's constant
-      
-      REAL(wp), DIMENSION(:,:), POINTER ::   dU10          ! dU                                [m/s]
-      REAL(wp), DIMENSION(:,:), POINTER ::   dT            ! air/sea temperature differeence   [K]
-      REAL(wp), DIMENSION(:,:), POINTER ::   dq            ! air/sea humidity difference       [K]
-      REAL(wp), DIMENSION(:,:), POINTER ::   Cd_n10        ! 10m neutral drag coefficient
+      !
+      INTEGER ::   j_itt
+      INTEGER , PARAMETER ::   nb_itt = 5       ! number of itterations
+      LOGICAL ::   l_zt_equal_zu = .FALSE.      ! if q and t are given at different height than U
+      !
+      REAL(wp), DIMENSION(:,:), POINTER ::   U_zu          ! relative wind at zu                            [m/s]
       REAL(wp), DIMENSION(:,:), POINTER ::   Ce_n10        ! 10m neutral latent coefficient
       REAL(wp), DIMENSION(:,:), POINTER ::   Ch_n10        ! 10m neutral sensible coefficient
       REAL(wp), DIMENSION(:,:), POINTER ::   sqrt_Cd_n10   ! root square of Cd_n10
       REAL(wp), DIMENSION(:,:), POINTER ::   sqrt_Cd       ! root square of Cd
-      REAL(wp), DIMENSION(:,:), POINTER ::   T_vpot        ! virtual potential temperature        [K]
-      REAL(wp), DIMENSION(:,:), POINTER ::   T_star        ! turbulent scale of tem. fluct.
-      REAL(wp), DIMENSION(:,:), POINTER ::   q_star        ! turbulent humidity of temp. fluct.
-      REAL(wp), DIMENSION(:,:), POINTER ::   U_star        ! turb. scale of velocity fluct.
-      REAL(wp), DIMENSION(:,:), POINTER ::   L             ! Monin-Obukov length                  [m]
       REAL(wp), DIMENSION(:,:), POINTER ::   zeta_u        ! stability parameter at height zu
       REAL(wp), DIMENSION(:,:), POINTER ::   zeta_t        ! stability parameter at height zt
-      REAL(wp), DIMENSION(:,:), POINTER ::   U_n10         ! neutral wind velocity at 10m        [m]
-      REAL(wp), DIMENSION(:,:), POINTER ::   xlogt, xct, zpsi_hu, zpsi_ht, zpsi_m
-
-      INTEGER , DIMENSION(:,:), POINTER ::   stab          ! 1st stability test integer
+      REAL(wp), DIMENSION(:,:), POINTER ::   zpsi_h_u, zpsi_m_u
+      REAL(wp), DIMENSION(:,:), POINTER ::   ztmp0, ztmp1, ztmp2
+      REAL(wp), DIMENSION(:,:), POINTER ::   stab          ! 1st stability test integer
       !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('TURB_CORE_2Z')
-      !
-      CALL wrk_alloc( jpi,jpj, dU10, dT, dq, Cd_n10, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd, L )
-      CALL wrk_alloc( jpi,jpj, T_vpot, T_star, q_star, U_star, zeta_u, zeta_t, U_n10 )
-      CALL wrk_alloc( jpi,jpj, xlogt, xct, zpsi_hu, zpsi_ht, zpsi_m )
-      CALL wrk_alloc( jpi,jpj, stab )   ! interger
-
-      !! Initial air/sea differences
-      dU10 = max(0.5, dU)      !  we don't want to fall under 0.5 m/s
-      dT = T_zt - sst 
-      dq = q_zt - q_sat
-
-      !! Neutral Drag Coefficient :
-      stab = 0.5 + sign(0.5,dT)                 ! stab = 1  if dT > 0  -> STABLE
-      IF( ln_cdgw ) THEN
-        cdn_wave = cdn_wave - rsmall*(tmask(:,:,1)-1)
-        Cd_n10(:,:) =   cdn_wave
+
+      IF( nn_timing == 1 )  CALL timing_start('turb_core_2z')
+    
+      CALL wrk_alloc( jpi,jpj, U_zu, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd )
+      CALL wrk_alloc( jpi,jpj, zeta_u, stab )
+      CALL wrk_alloc( jpi,jpj, zpsi_h_u, zpsi_m_u, ztmp0, ztmp1, ztmp2 )
+
+      l_zt_equal_zu = .FALSE.
+      IF( ABS(zu - zt) < 0.01 ) l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision
+
+      IF( .NOT. l_zt_equal_zu )   CALL wrk_alloc( jpi,jpj, zeta_t )
+
+      U_zu = MAX( 0.5 , dU )   !  relative wind speed at zu (normally 10m), we don't want to fall under 0.5 m/s
+
+      !! First guess of stability: 
+      ztmp0 = T_zt*(1. + 0.608*q_zt) - sst*(1. + 0.608*q_sat) ! air-sea difference of virtual pot. temp. at zt
+      stab  = 0.5 + sign(0.5,ztmp0)                           ! stab = 1 if dTv > 0  => STABLE, 0 if unstable
+
+      !! Neutral coefficients at 10m:
+      IF( ln_cdgw ) THEN      ! wave drag case
+         cdn_wave(:,:) = cdn_wave(:,:) + rsmall * ( 1._wp - tmask(:,:,1) )
+         ztmp0   (:,:) = cdn_wave(:,:)
       ELSE
-        Cd_n10  = 1.e-3*( 2.7/dU10 + 0.142 + dU10/13.09 ) 
+         ztmp0 = cd_neutral_10m( U_zu )
       ENDIF
-      sqrt_Cd_n10 = sqrt(Cd_n10)
+      sqrt_Cd_n10 = SQRT( ztmp0 )
       Ce_n10  = 1.e-3*( 34.6 * sqrt_Cd_n10 )
       Ch_n10  = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1. - stab))
-
+    
       !! Initializing transf. coeff. with their first guess neutral equivalents :
-      Cd = Cd_n10 ;  Ce = Ce_n10 ;  Ch = Ch_n10 ;  sqrt_Cd = sqrt(Cd)
-
-      !! Initializing z_u values with z_t values :
-      T_zu = T_zt ;  q_zu = q_zt
+      Cd = ztmp0   ;   Ce = Ce_n10   ;   Ch = Ch_n10   ;   sqrt_Cd = sqrt_Cd_n10
+
+      !! Initializing values at z_u with z_t values:
+      T_zu = T_zt   ;   q_zu = q_zt
 
       !!  * Now starting iteration loop
       DO j_itt=1, nb_itt
-         dT = T_zu - sst ;  dq = q_zu - q_sat ! Updating air/sea differences
-         T_vpot = T_zu*(1. + 0.608*q_zu)    ! Updating virtual potential temperature at zu
-         U_star = sqrt_Cd*dU10                ! Updating turbulent scales :   (L & Y eq. (7))
-         T_star  = Ch/sqrt_Cd*dT              !
-         q_star  = Ce/sqrt_Cd*dq              !
-         !!
-         L = (U_star*U_star) &                ! Estimate the Monin-Obukov length at height zu
-              & / (kappa*grav/T_vpot*(T_star*(1.+0.608*q_zu) + 0.608*T_zu*q_star))
+         !
+         ztmp1 = T_zu - sst   ! Updating air/sea differences
+         ztmp2 = q_zu - q_sat 
+
+         ! Updating turbulent scales :   (L&Y 2004 eq. (7))
+         ztmp1  = Ch/sqrt_Cd*ztmp1    ! theta*
+         ztmp2  = Ce/sqrt_Cd*ztmp2    ! q*
+       
+         ztmp0 = T_zu*(1. + 0.608*q_zu) ! virtual potential temperature at zu
+
+         ! Estimate the inverse of Monin-Obukov length (1/L) at height zu:
+         ztmp0 =  (vkarmn*grav/ztmp0*(ztmp1*(1.+0.608*q_zu) + 0.608*T_zu*ztmp2)) / (Cd*U_zu*U_zu) 
+         !                                                                     ( Cd*U_zu*U_zu is U*^2 at zu)
+
          !! Stability parameters :
-         zeta_u  = zu/L  ;  zeta_u = sign( min(abs(zeta_u),10.0), zeta_u )
-         zeta_t  = zt/L  ;  zeta_t = sign( min(abs(zeta_t),10.0), zeta_t )
-         zpsi_hu = psi_h(zeta_u)
-         zpsi_ht = psi_h(zeta_t)
-         zpsi_m  = psi_m(zeta_u)
-         !!
-         !! Shifting the wind speed to 10m and neutral stability : (L & Y eq.(9a))
-!        U_n10 = dU10/(1. + sqrt_Cd_n10/kappa*(log(zu/10.) - psi_m(zeta_u)))
-         U_n10 = dU10/(1. + sqrt_Cd_n10/kappa*(log(zu/10.) - zpsi_m))
-         !!
-         !! Shifting temperature and humidity at zu :          (L & Y eq. (9b-9c))
-!        T_zu = T_zt - T_star/kappa*(log(zt/zu) + psi_h(zeta_u) - psi_h(zeta_t))
-         T_zu = T_zt - T_star/kappa*(log(zt/zu) + zpsi_hu - zpsi_ht)
-!        q_zu = q_zt - q_star/kappa*(log(zt/zu) + psi_h(zeta_u) - psi_h(zeta_t))
-         q_zu = q_zt - q_star/kappa*(log(zt/zu) + zpsi_hu - zpsi_ht)
-         !!
-         !! q_zu cannot have a negative value : forcing 0
-         stab = 0.5 + sign(0.5,q_zu) ;  q_zu = stab*q_zu
-         !!
-         IF( ln_cdgw ) THEN
-            sqrt_Cd=kappa/((kappa/sqrt_Cd_n10) - zpsi_m) ; Cd=sqrt_Cd*sqrt_Cd;
+         zeta_u   = zu*ztmp0   ;  zeta_u = sign( min(abs(zeta_u),10.0), zeta_u )
+         zpsi_h_u = psi_h( zeta_u )
+         zpsi_m_u = psi_m( zeta_u )
+       
+         !! Shifting temperature and humidity at zu (L&Y 2004 eq. (9b-9c))
+         IF ( .NOT. l_zt_equal_zu ) THEN
+            zeta_t = zt*ztmp0 ;  zeta_t = sign( min(abs(zeta_t),10.0), zeta_t )
+            stab = LOG(zu/zt) - zpsi_h_u + psi_h(zeta_t)  ! stab just used as temp array!!!
+            T_zu = T_zt + ztmp1/vkarmn*stab    ! ztmp1 is still theta*
+            q_zu = q_zt + ztmp2/vkarmn*stab    ! ztmp2 is still q*
+            q_zu = max(0., q_zu)
+         END IF
+       
+         IF( ln_cdgw ) THEN      ! surface wave case
+            sqrt_Cd = vkarmn / ( vkarmn / sqrt_Cd_n10 - zpsi_m_u ) 
+            Cd      = sqrt_Cd * sqrt_Cd
          ELSE
-           !! Updating the neutral 10m transfer coefficients :
-           Cd_n10  = 1.e-3 * (2.7/U_n10 + 0.142 + U_n10/13.09)    ! L & Y eq. (6a)
-           sqrt_Cd_n10 = sqrt(Cd_n10)
-           Ce_n10  = 1.e-3 * (34.6 * sqrt_Cd_n10)                 ! L & Y eq. (6b)
-           stab    = 0.5 + sign(0.5,zeta_u)
-           Ch_n10  = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1.-stab)) ! L & Y eq. (6c-6d)
-           !!
-           !!
-           !! Shifting the neutral 10m transfer coefficients to (zu,zeta_u) :
-           xct = 1. + sqrt_Cd_n10/kappa*(log(zu/10.) - zpsi_m)   ! L & Y eq. (10a)
-           Cd = Cd_n10/(xct*xct) ; sqrt_Cd = sqrt(Cd)
+           ! Update neutral wind speed at 10m and neutral Cd at 10m (L&Y 2004 eq. 9a)...
+           !   In very rare low-wind conditions, the old way of estimating the
+           !   neutral wind speed at 10m leads to a negative value that causes the code
+           !   to crash. To prevent this a threshold of 0.25m/s is imposed.
+           ztmp0 = MAX( 0.25 , U_zu/(1. + sqrt_Cd_n10/vkarmn*(LOG(zu/10.) - zpsi_m_u)) ) !  U_n10
+           ztmp0 = cd_neutral_10m(ztmp0)                                                 ! Cd_n10
+           sqrt_Cd_n10 = sqrt(ztmp0)
+       
+           Ce_n10  = 1.e-3 * (34.6 * sqrt_Cd_n10)                     ! L&Y 2004 eq. (6b)
+           stab    = 0.5 + sign(0.5,zeta_u)                           ! update stability
+           Ch_n10  = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1. - stab))  ! L&Y 2004 eq. (6c-6d)
+
+           !! Update of transfer coefficients:
+           ztmp1 = 1. + sqrt_Cd_n10/vkarmn*(LOG(zu/10.) - zpsi_m_u)   ! L&Y 2004 eq. (10a)
+           Cd      = ztmp0 / ( ztmp1*ztmp1 )   
+           sqrt_Cd = SQRT( Cd )
          ENDIF
-         !!
-         xlogt = log(zu/10.) - zpsi_hu
-         !!
-         xct = 1. + Ch_n10*xlogt/kappa/sqrt_Cd_n10               ! L & Y eq. (10b)
-         Ch  = Ch_n10*sqrt_Cd/sqrt_Cd_n10/xct
-         !!
-         xct = 1. + Ce_n10*xlogt/kappa/sqrt_Cd_n10               ! L & Y eq. (10c)
-         Ce  = Ce_n10*sqrt_Cd/sqrt_Cd_n10/xct
-         !!
-         !!
+         !
+         ztmp0 = (LOG(zu/10.) - zpsi_h_u) / vkarmn / sqrt_Cd_n10
+         ztmp2 = sqrt_Cd / sqrt_Cd_n10
+         ztmp1 = 1. + Ch_n10*ztmp0               
+         Ch  = Ch_n10*ztmp2 / ztmp1  ! L&Y 2004 eq. (10b)
+         !
+         ztmp1 = 1. + Ce_n10*ztmp0               
+         Ce  = Ce_n10*ztmp2 / ztmp1  ! L&Y 2004 eq. (10c)
+         !
       END DO
-      !!
-      CALL wrk_dealloc( jpi,jpj, dU10, dT, dq, Cd_n10, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd, L )
-      CALL wrk_dealloc( jpi,jpj, T_vpot, T_star, q_star, U_star, zeta_u, zeta_t, U_n10 )
-      CALL wrk_dealloc( jpi,jpj, xlogt, xct, zpsi_hu, zpsi_ht, zpsi_m )
-      CALL wrk_dealloc( jpi,jpj, stab )   ! interger
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('TURB_CORE_2Z')
-      !
-    END SUBROUTINE TURB_CORE_2Z
-
-
-    FUNCTION psi_m(zta)   !! Psis, L & Y eq. (8c), (8d), (8e)
+
+      CALL wrk_dealloc( jpi,jpj, U_zu, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd )
+      CALL wrk_dealloc( jpi,jpj, zeta_u, stab )
+      CALL wrk_dealloc( jpi,jpj, zpsi_h_u, zpsi_m_u, ztmp0, ztmp1, ztmp2 )
+
+      IF( .NOT. l_zt_equal_zu ) CALL wrk_dealloc( jpi,jpj, zeta_t )
+
+      IF( nn_timing == 1 )  CALL timing_stop('turb_core_2z')
+      !
+   END SUBROUTINE turb_core_2z
+
+
+   FUNCTION cd_neutral_10m( zw10 )
+      !!----------------------------------------------------------------------
+      !! Estimate of the neutral drag coefficient at 10m as a function 
+      !! of neutral wind  speed at 10m
+      !!
+      !! Origin: Large & Yeager 2008 eq.(11a) and eq.(11b)
+      !!
+      !! Author: L. Brodeau, june 2014
+      !!----------------------------------------------------------------------    
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   zw10           ! scalar wind speed at 10m (m/s)
+      REAL(wp), DIMENSION(jpi,jpj)             ::   cd_neutral_10m
+      !
+      REAL(wp), DIMENSION(:,:), POINTER ::   rgt33
+      !!----------------------------------------------------------------------    
+      !
+      CALL wrk_alloc( jpi,jpj, rgt33 )
+      !
+      !! When wind speed > 33 m/s => Cyclone conditions => special treatment
+      rgt33 = 0.5_wp + SIGN( 0.5_wp, (zw10 - 33._wp) )   ! If zw10 < 33. => 0, else => 1  
+      cd_neutral_10m = 1.e-3 * ( &
+         &       (1._wp - rgt33)*( 2.7_wp/zw10 + 0.142_wp + zw10/13.09_wp - 3.14807E-10*zw10**6) & ! zw10< 33.
+         &      + rgt33         *      2.34   )                                                    ! zw10 >= 33.
+      !
+      CALL wrk_dealloc( jpi,jpj, rgt33)
+      !
+   END FUNCTION cd_neutral_10m
+
+
+   FUNCTION psi_m(pta)   !! Psis, L&Y 2004 eq. (8c), (8d), (8e)
       !-------------------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: zta
-
-      REAL(wp), PARAMETER :: pi = 3.141592653589793_wp
+      ! universal profile stability function for momentum
+      !-------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pta
+      !
       REAL(wp), DIMENSION(jpi,jpj)             :: psi_m
       REAL(wp), DIMENSION(:,:), POINTER        :: X2, X, stabit
       !-------------------------------------------------------------------------------
-
+      !
       CALL wrk_alloc( jpi,jpj, X2, X, stabit )
-
-      X2 = sqrt(abs(1. - 16.*zta))  ;  X2 = max(X2 , 1.0) ;  X  = sqrt(X2)
-      stabit    = 0.5 + sign(0.5,zta)
-      psi_m = -5.*zta*stabit  &                                                          ! Stable
-         &    + (1. - stabit)*(2*log((1. + X)/2) + log((1. + X2)/2) - 2*atan(X) + pi/2)  ! Unstable 
-
+      !
+      X2 = SQRT( ABS( 1. - 16.*pta ) )  ;  X2 = MAX( X2 , 1. )   ;   X = SQRT( X2 )
+      stabit = 0.5 + SIGN( 0.5 , pta )
+      psi_m = -5.*pta*stabit  &                                                          ! Stable
+         &    + (1. - stabit)*(2.*LOG((1. + X)*0.5) + LOG((1. + X2)*0.5) - 2.*ATAN(X) + rpi*0.5)  ! Unstable
+      !
       CALL wrk_dealloc( jpi,jpj, X2, X, stabit )
       !
-    END FUNCTION psi_m
-
-
-    FUNCTION psi_h( zta )    !! Psis, L & Y eq. (8c), (8d), (8e)
+   END FUNCTION psi_m
+
+
+   FUNCTION psi_h( pta )    !! Psis, L&Y 2004 eq. (8c), (8d), (8e)
       !-------------------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   zta
+      ! universal profile stability function for temperature and humidity
+      !-------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pta
       !
       REAL(wp), DIMENSION(jpi,jpj)             ::   psi_h
-      REAL(wp), DIMENSION(:,:), POINTER        :: X2, X, stabit
+      REAL(wp), DIMENSION(:,:), POINTER        ::   X2, X, stabit
       !-------------------------------------------------------------------------------
-
+      !
       CALL wrk_alloc( jpi,jpj, X2, X, stabit )
-
-      X2 = sqrt(abs(1. - 16.*zta))  ;  X2 = max(X2 , 1.) ;  X  = sqrt(X2)
-      stabit    = 0.5 + sign(0.5,zta)
-      psi_h = -5.*zta*stabit  &                                       ! Stable
-         &    + (1. - stabit)*(2.*log( (1. + X2)/2. ))                 ! Unstable
-
+      !
+      X2 = SQRT( ABS( 1. - 16.*pta ) )   ;   X2 = MAX( X2 , 1. )   ;   X = SQRT( X2 )
+      stabit = 0.5 + SIGN( 0.5 , pta )
+      psi_h = -5.*pta*stabit   &                                       ! Stable
+         &    + (1. - stabit)*(2.*LOG( (1. + X2)*0.5 ))                ! Unstable
+      !
       CALL wrk_dealloc( jpi,jpj, X2, X, stabit )
       !
-    END FUNCTION psi_h
-  
+   END FUNCTION psi_h
+
    !!======================================================================
 END MODULE sbcblk_core
Index: branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90
===================================================================
--- branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90	(revision 4771)
+++ branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90	(revision 5075)
@@ -82,5 +82,5 @@
       !!              - utau, vtau  i- and j-component of the wind stress
       !!              - taum        wind stress module at T-point
-      !!              - wndm        10m wind module at T-point
+      !!              - wndm        10m wind module at T-point over free ocean or leads in presence of sea-ice
       !!              - qns, qsr    non-slor and solar heat flux
       !!              - emp         evaporation minus precipitation
@@ -233,11 +233,14 @@
          ! Interpolate utau, vtau into the grid_V and grid_V
          !-------------------------------------------------
-
+      !     Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines
+      !     Note the use of MAX(tmask(i,j),tmask(i+1,j) is to mask tau over ice shelves
          DO jj = 1, jpjm1
             DO ji = 1, fs_jpim1
                utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( utau(ji,jj) * tmask(ji,jj,1) &
-               &                                + utau(ji+1,jj) * tmask(ji+1,jj,1) )
+               &                                + utau(ji+1,jj) * tmask(ji+1,jj,1) )        &
+               &                 * MAX(tmask(ji,jj,1),tmask(ji+1,jj  ,1))
                vtau(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( vtau(ji,jj) * tmask(ji,jj,1) &
-               &                                + vtau(ji,jj+1) * tmask(ji,jj+1,1) )
+               &                                + vtau(ji,jj+1) * tmask(ji,jj+1,1) )        &
+               &                 * MAX(tmask(ji,jj,1),tmask(ji  ,jj+1,1))
             END DO
          END DO
Index: branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
===================================================================
--- branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90	(revision 4771)
+++ branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90	(revision 5075)
@@ -9,7 +9,4 @@
    !!            3.4  ! 2011_11  (C. Harris) more flexibility + multi-category fields
    !!----------------------------------------------------------------------
-#if defined key_oasis3 || defined key_oasis4
-   !!----------------------------------------------------------------------
-   !!   'key_oasis3' or 'key_oasis4'   Coupled Ocean/Atmosphere formulation
    !!----------------------------------------------------------------------
    !!   namsbc_cpl      : coupled formulation namlist
@@ -34,10 +31,5 @@
    USE ice_2           ! ice variables
 #endif
-#if defined key_oasis3
    USE cpl_oasis3      ! OASIS3 coupling
-#endif
-#if defined key_oasis4
-   USE cpl_oasis4      ! OASIS4 coupling
-#endif
    USE geo2ocean       ! 
    USE oce   , ONLY : tsn, un, vn
@@ -52,5 +44,4 @@
    USE p4zflx, ONLY : oce_co2
 #endif
-   USE diaar5, ONLY :   lk_diaar5
 #if defined key_cice
    USE ice_domain_size, only: ncat
@@ -58,9 +49,11 @@
    IMPLICIT NONE
    PRIVATE
-
+!EM XIOS-OASIS-MCT compliance
+   PUBLIC   sbc_cpl_init       ! routine called by sbcmod.F90
    PUBLIC   sbc_cpl_rcv        ! routine called by sbc_ice_lim(_2).F90
    PUBLIC   sbc_cpl_snd        ! routine called by step.F90
    PUBLIC   sbc_cpl_ice_tau    ! routine called by sbc_ice_lim(_2).F90
    PUBLIC   sbc_cpl_ice_flx    ! routine called by sbc_ice_lim(_2).F90
+   PUBLIC   sbc_cpl_alloc      ! routine called in sbcice_cice.F90
 
    INTEGER, PARAMETER ::   jpr_otx1   =  1            ! 3 atmosphere-ocean stress components on grid 1
@@ -129,4 +122,10 @@
    TYPE(FLD_C) ::   sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, sn_rcv_qns, sn_rcv_emp, sn_rcv_rnf
    TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2                        
+   ! Other namelist parameters                        !
+   INTEGER     ::   nn_cplmodel            ! Maximum number of models to/from which NEMO is potentialy sending/receiving data
+   LOGICAL     ::   ln_usecplmask          !  use a coupling mask file to merge data received from several models
+                                           !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel)
+
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: xcplmask
 
    TYPE ::   DYNARR     
@@ -139,29 +138,4 @@
 
    INTEGER , ALLOCATABLE, SAVE, DIMENSION(    :) ::   nrcvinfo           ! OASIS info argument
-
-#if ! defined key_lim2   &&   ! defined key_lim3
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice,fr1_i0,fr2_i0          ! jpi, jpj
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice, alb_ice, qns_ice, dqns_ice  ! (jpi,jpj,jpl)
-#endif
-
-#if defined key_cice
-   INTEGER, PARAMETER ::   jpl = ncat
-#elif ! defined key_lim2   &&   ! defined key_lim3
-   INTEGER, PARAMETER ::   jpl = 1 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice
-#endif
-
-#if ! defined key_lim3   &&  ! defined key_cice
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i
-#endif
-
-#if ! defined key_lim3
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  ht_i, ht_s
-#endif
-
-#if ! defined key_cice
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  topmelt, botmelt
-#endif
 
    !! Substitution
@@ -179,24 +153,15 @@
       !!             ***  FUNCTION sbc_cpl_alloc  ***
       !!----------------------------------------------------------------------
-      INTEGER :: ierr(4),jn
+      INTEGER :: ierr(3)
       !!----------------------------------------------------------------------
       ierr(:) = 0
       !
       ALLOCATE( albedo_oce_mix(jpi,jpj), nrcvinfo(jprcv),  STAT=ierr(1) )
-      !
-#if ! defined key_lim2 && ! defined key_lim3
-      ! quick patch to be able to run the coupled model without sea-ice...
-      ALLOCATE( u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,1) ,     &
-                v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,1),      &
-                emp_ice(jpi,jpj) , qns_ice(jpi,jpj,1) , dqns_ice(jpi,jpj,1) , STAT=ierr(2) )
+      
+#if ! defined key_lim3 && ! defined key_lim2 && ! defined key_cice
+      ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) )  ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init)
 #endif
-
-#if ! defined key_lim3 && ! defined key_cice
-      ALLOCATE( a_i(jpi,jpj,jpl) , STAT=ierr(3) )
-#endif
-
-#if defined key_cice || defined key_lim2
-      ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(4) )
-#endif
+      ALLOCATE( xcplmask(jpi,jpj,nn_cplmodel) , STAT=ierr(3) )
+      !
       sbc_cpl_alloc = MAXVAL( ierr )
       IF( lk_mpp            )   CALL mpp_sum ( sbc_cpl_alloc )
@@ -210,5 +175,5 @@
       !!             ***  ROUTINE sbc_cpl_init  ***
       !!
-      !! ** Purpose :   Initialisation of send and recieved information from
+      !! ** Purpose :   Initialisation of send and received information from
       !!                the atmospheric component
       !!
@@ -222,9 +187,11 @@
       INTEGER ::   jn   ! dummy loop index
       INTEGER ::   ios  ! Local integer output status for namelist read
+      INTEGER ::   inum 
       REAL(wp), POINTER, DIMENSION(:,:) ::   zacs, zaos
       !!
-      NAMELIST/namsbc_cpl/  sn_snd_temp, sn_snd_alb   , sn_snd_thick, sn_snd_crt   , sn_snd_co2,   &
-         &                  sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr,   &
-         &                  sn_rcv_qns , sn_rcv_emp   , sn_rcv_rnf  , sn_rcv_cal   , sn_rcv_iceflx  , sn_rcv_co2
+      NAMELIST/namsbc_cpl/  sn_snd_temp, sn_snd_alb   , sn_snd_thick, sn_snd_crt   , sn_snd_co2,      &
+         &                  sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr,      &
+         &                  sn_rcv_qns , sn_rcv_emp   , sn_rcv_rnf  , sn_rcv_cal   , sn_rcv_iceflx,   &
+         &                  sn_rcv_co2 , nn_cplmodel  , ln_usecplmask
       !!---------------------------------------------------------------------
       !
@@ -274,4 +241,6 @@
          WRITE(numout,*)'                      - mesh          = ', sn_snd_crt%clvgrd
          WRITE(numout,*)'      oce co2 flux                    = ', TRIM(sn_snd_co2%cldes   ), ' (', TRIM(sn_snd_co2%clcat   ), ')'
+         WRITE(numout,*)'  nn_cplmodel                         = ', nn_cplmodel
+         WRITE(numout,*)'  ln_usecplmask                       = ', ln_usecplmask
       ENDIF
 
@@ -485,9 +454,9 @@
       END DO
       ! Allocate taum part of frcv which is used even when not received as coupling field
-      IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jn)%nct) )
+      IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) )
       ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE.
       IF( k_ice /= 0 ) THEN
-         IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jn)%nct) )
-         IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jn)%nct) )
+         IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) )
+         IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) )
       END IF
 
@@ -604,7 +573,16 @@
       ! ================================ !
 
-      CALL cpl_prism_define(jprcv, jpsnd)            
-      !
-      IF( ln_dm2dc .AND. ( cpl_prism_freq( jpr_qsroce ) + cpl_prism_freq( jpr_qsrmix ) /= 86400 ) )   &
+      CALL cpl_define(jprcv, jpsnd,nn_cplmodel)            
+      IF (ln_usecplmask) THEN 
+         xcplmask(:,:,:) = 0.
+         CALL iom_open( 'cplmask', inum )
+         CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(1:nlci,1:nlcj,1:nn_cplmodel),   &
+            &          kstart = (/ mig(1),mjg(1),1 /), kcount = (/ nlci,nlcj,nn_cplmodel /) )
+         CALL iom_close( inum )
+      ELSE
+         xcplmask(:,:,:) = 1.
+      ENDIF
+      !
+      IF( ln_dm2dc .AND. ( cpl_freq( jpr_qsroce ) + cpl_freq( jpr_qsrmix ) /= 86400 ) )   &
          &   CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' )
 
@@ -654,5 +632,6 @@
       !!
       !! ** Action  :   update  utau, vtau   ocean stress at U,V grid 
-      !!                        taum, wndm   wind stres and wind speed module at T-point
+      !!                        taum         wind stress module at T-point
+      !!                        wndm         wind speed  module at T-point over free ocean or leads in presence of sea-ice
       !!                        qns          non solar heat fluxes including emp heat content    (ocean only case)
       !!                                     and the latent heat flux of solid precip. melting
@@ -678,11 +657,8 @@
       !
       CALL wrk_alloc( jpi,jpj, ztx, zty )
-
-      IF( kt == nit000 )   CALL sbc_cpl_init( k_ice )          ! initialisation
-
       !                                                 ! Receive all the atmos. fields (including ice information)
       isec = ( kt - nit000 ) * NINT( rdttra(1) )             ! date of exchanges
       DO jn = 1, jprcv                                       ! received fields sent by the atmosphere
-         IF( srcv(jn)%laction )   CALL cpl_prism_rcv( jn, isec, frcv(jn)%z3, nrcvinfo(jn) )
+         IF( srcv(jn)%laction )   CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask, nrcvinfo(jn) )
       END DO
 
@@ -848,8 +824,8 @@
          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)
+         ! update qns over the free ocean with:
+         qns(:,:) =  qns(:,:) - emp(:,:) * sst_m(:,:) * rcp            ! remove heat content due to mass flux (assumed to be at SST)
+         IF( srcv(jpr_snow  )%laction )   THEN
+              qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus    ! energy for melting solid precipitation over the free ocean
          ENDIF
 
@@ -914,6 +890,5 @@
       CALL wrk_alloc( jpi,jpj, ztx, zty )
 
-!AC Pour eviter un stress nul sur la glace dans le cas mixed oce-ice
-      IF( srcv(jpr_itx1)%laction .AND. TRIM( sn_rcv_tau%cldes ) == 'oce and ice') THEN   ;   itx =  jpr_itx1   
+      IF( srcv(jpr_itx1)%laction ) THEN   ;   itx =  jpr_itx1   
       ELSE                                ;   itx =  jpr_otx1
       ENDIF
@@ -922,8 +897,7 @@
       IF(  nrcvinfo(itx) == OASIS_Rcv ) THEN
 
-         !                                                                                              ! ======================= !
-!AC Pour eviter un stress nul sur la glace dans le cas mixes oce-ice
-         IF( srcv(jpr_itx1)%laction .AND. TRIM( sn_rcv_tau%cldes ) == 'oce and ice') THEN               !   ice stress received   !
-            !                                                                                           ! ======================= !
+         !                                                      ! ======================= !
+         IF( srcv(jpr_itx1)%laction ) THEN                      !   ice stress received   !
+            !                                                   ! ======================= !
             !  
             IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN            ! 2 components on the sphere
@@ -1125,6 +1099,6 @@
       REAL(wp), INTENT(in   ), DIMENSION(:,:)   ::   p_frld     ! lead fraction                [0 to 1]
       ! optional arguments, used only in 'mixed oce-ice' case
-      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! ice albedo 
-      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature     [Celcius]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! all skies ice albedo 
+      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature     [Celsius]
       REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist    ! ice surface temperature     [Kelvin]
       !
@@ -1153,9 +1127,13 @@
          emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - tprecip(:,:)
          emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1)
-                           CALL iom_put( 'rain'         , frcv(jpr_rain)%z3(:,:,1)              )   ! liquid precipitation 
-         IF( lk_diaar5 )   CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from liq. precip. 
-         ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:)
-                           CALL iom_put( 'evap_ao_cea'  , ztmp                            )   ! ice-free oce evap (cell average)
-         IF( lk_diaar5 )   CALL iom_put( 'hflx_evap_cea', ztmp(:,:         ) * zcptn(:,:) )   ! heat flux from from evap (cell ave)
+            CALL iom_put( 'rain'         , frcv(jpr_rain)%z3(:,:,1)              )   ! liquid precipitation 
+         IF( iom_use('hflx_rain_cea') )   &
+            CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from liq. precip. 
+         IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') )   &
+            ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:)
+         IF( iom_use('evap_ao_cea'  ) )   &
+            CALL iom_put( 'evap_ao_cea'  , ztmp                   )   ! ice-free oce evap (cell average)
+         IF( iom_use('hflx_evap_cea') )   &
+            CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) )   ! heat flux from from evap (cell average)
       CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp
          emp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1)
@@ -1164,14 +1142,18 @@
       END SELECT
 
-      CALL iom_put( 'snowpre'    , sprecip                                )   ! Snow
-      CALL iom_put( 'snow_ao_cea', sprecip(:,:         ) * p_frld(:,:)    )   ! Snow        over ice-free ocean  (cell average)
-      CALL iom_put( 'snow_ai_cea', sprecip(:,:         ) * zicefr(:,:)    )   ! Snow        over sea-ice         (cell average)
-      CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )   ! Sublimation over sea-ice         (cell average)
+         CALL iom_put( 'snowpre'    , sprecip                                )   ! Snow
+      IF( iom_use('snow_ao_cea') )   &
+         CALL iom_put( 'snow_ao_cea', sprecip(:,:) * p_frld(:,:)             )   ! Snow        over ice-free ocean  (cell average)
+      IF( iom_use('snow_ai_cea') )   &
+         CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:)             )   ! Snow        over sea-ice         (cell average)
+      IF( iom_use('subl_ai_cea') )   &
+         CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )   ! Sublimation over sea-ice         (cell average)
       !   
       !                                                           ! runoffs and calving (put in emp_tot)
       IF( srcv(jpr_rnf)%laction ) THEN 
          emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1)
-                           CALL iom_put( 'runoffs'      , frcv(jpr_rnf)%z3(:,:,1)              )   ! rivers
-         IF( lk_diaar5 )   CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from rivers
+            CALL iom_put( 'runoffs'      , frcv(jpr_rnf)%z3(:,:,1)              )   ! rivers
+         IF( iom_use('hflx_rnf_cea') )   &
+            CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from rivers
       ENDIF
       IF( srcv(jpr_cal)%laction ) THEN 
@@ -1235,5 +1217,6 @@
          &          - (  emp_tot(:,:)                     &            ! remove the heat content of mass flux (assumed to be at SST)
          &             - emp_ice(:,:) * zicefr(:,:)  ) * zcptn(:,:) 
-      IF( lk_diaar5 )   CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average)
+      IF( iom_use('hflx_snow_cea') )   &
+         CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average)
 !!gm
 !!    currently it is taken into account in leads budget but not in the qns_tot, and thus not in 
@@ -1247,5 +1230,6 @@
          ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus               ! add the latent heat of iceberg melting 
          qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:)
-         IF( lk_diaar5 )   CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from calving
+         IF( iom_use('hflx_cal_cea') )   &
+            CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from calving
       ENDIF
 
@@ -1296,5 +1280,7 @@
       ENDIF
 
-      SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) )
+      !                                                      ! ========================= !
+      SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) )             !          d(qns)/dt        !
+      !                                                      ! ========================= !
       CASE ('coupled')
          IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN
@@ -1308,5 +1294,7 @@
       END SELECT
 
-      SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) )
+      !                                                      ! ========================= !
+      SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) )             !    topmelt and botmelt    !
+      !                                                      ! ========================= !
       CASE ('coupled')
          topmelt(:,:,:)=frcv(jpr_topm)%z3(:,:,:)
@@ -1314,12 +1302,10 @@
       END SELECT
 
-      !    Ice Qsr penetration used (only?)in lim2 or lim3 
-      ! fraction of net shortwave radiation which is not absorbed in the thin surface layer 
-      ! and penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 )
+      ! Surface transimission parameter io (Maykut Untersteiner , 1971 ; Ebert and Curry, 1993 )
+      ! Used for LIM2 and LIM3
       ! Coupled case: since cloud cover is not received from atmosphere 
-      !               ===> defined as constant value -> definition done in sbc_cpl_init
-      fr1_i0(:,:) = 0.18
-      fr2_i0(:,:) = 0.82
-
+      !               ===> used prescribed cloud fraction representative for polar oceans in summer (0.81)
+      fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )
+      fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )
 
       CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr )
@@ -1336,5 +1322,5 @@
       !! ** Purpose :   provide the ocean-ice informations to the atmosphere
       !!
-      !! ** Method  :   send to the atmosphere through a call to cpl_prism_snd
+      !! ** Method  :   send to the atmosphere through a call to cpl_snd
       !!              all the needed fields (as defined in sbc_cpl_init)
       !!----------------------------------------------------------------------
@@ -1355,5 +1341,4 @@
 
       zfr_l(:,:) = 1.- fr_i(:,:)
-
       !                                                      ! ------------------------- !
       !                                                      !    Surface temperature    !   in Kelvin
@@ -1374,5 +1359,5 @@
             END SELECT
          CASE( 'mixed oce-ice'        )   
-            ztmp1(:,:) = ( tsn(:,:,1,1) + rt0 ) * zfr_l(:,:) 
+            ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) 
             DO jl=1,jpl
                ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl)
@@ -1380,9 +1365,8 @@
          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 )
-      ENDIF
-      !
+         IF( ssnd(jps_toce)%laction )   CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
+         IF( ssnd(jps_tice)%laction )   CALL cpl_snd( jps_tice, isec, ztmp3, info )
+         IF( ssnd(jps_tmix)%laction )   CALL cpl_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
+      ENDIF
       !                                                      ! ------------------------- !
       !                                                      !           Albedo          !
@@ -1390,5 +1374,5 @@
       IF( ssnd(jps_albice)%laction ) THEN                         ! ice 
          ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
-         CALL cpl_prism_snd( jps_albice, isec, ztmp3, info )
+         CALL cpl_snd( jps_albice, isec, ztmp3, info )
       ENDIF
       IF( ssnd(jps_albmix)%laction ) THEN                         ! mixed ice-ocean
@@ -1397,5 +1381,5 @@
             ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl)
          ENDDO
-         CALL cpl_prism_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
+         CALL cpl_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
       ENDIF
       !                                                      ! ------------------------- !
@@ -1409,5 +1393,5 @@
          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 )
+         CALL cpl_snd( jps_fice, isec, ztmp3, info )
       ENDIF
 
@@ -1434,6 +1418,6 @@
          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( ssnd(jps_hice)%laction )   CALL cpl_snd( jps_hice, isec, ztmp3, info )
+         IF( ssnd(jps_hsnw)%laction )   CALL cpl_snd( jps_hsnw, isec, ztmp4, info )
       ENDIF
       !
@@ -1442,5 +1426,5 @@
       !                                                      !  CO2 flux from PISCES     ! 
       !                                                      ! ------------------------- !
-      IF( ssnd(jps_co2)%laction )   CALL cpl_prism_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info )
+      IF( ssnd(jps_co2)%laction )   CALL cpl_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info )
       !
 #endif
@@ -1565,11 +1549,11 @@
          ENDIF
          !
-         IF( ssnd(jps_ocx1)%laction )   CALL cpl_prism_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info )   ! ocean x current 1st grid
-         IF( ssnd(jps_ocy1)%laction )   CALL cpl_prism_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info )   ! ocean y current 1st grid
-         IF( ssnd(jps_ocz1)%laction )   CALL cpl_prism_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info )   ! ocean z current 1st grid
+         IF( ssnd(jps_ocx1)%laction )   CALL cpl_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info )   ! ocean x current 1st grid
+         IF( ssnd(jps_ocy1)%laction )   CALL cpl_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info )   ! ocean y current 1st grid
+         IF( ssnd(jps_ocz1)%laction )   CALL cpl_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info )   ! ocean z current 1st grid
          !
-         IF( ssnd(jps_ivx1)%laction )   CALL cpl_prism_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info )   ! ice   x current 1st grid
-         IF( ssnd(jps_ivy1)%laction )   CALL cpl_prism_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info )   ! ice   y current 1st grid
-         IF( ssnd(jps_ivz1)%laction )   CALL cpl_prism_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info )   ! ice   z current 1st grid
+         IF( ssnd(jps_ivx1)%laction )   CALL cpl_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info )   ! ice   x current 1st grid
+         IF( ssnd(jps_ivy1)%laction )   CALL cpl_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info )   ! ice   y current 1st grid
+         IF( ssnd(jps_ivz1)%laction )   CALL cpl_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info )   ! ice   z current 1st grid
          ! 
       ENDIF
@@ -1582,35 +1566,4 @@
    END SUBROUTINE sbc_cpl_snd
    
-#else
-   !!----------------------------------------------------------------------
-   !!   Dummy module                                            NO coupling
-   !!----------------------------------------------------------------------
-   USE par_kind        ! kind definition
-CONTAINS
-   SUBROUTINE sbc_cpl_snd( kt )
-      WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', kt
-   END SUBROUTINE sbc_cpl_snd
-   !
-   SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice )     
-      WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', kt, k_fsbc, k_ice
-   END SUBROUTINE sbc_cpl_rcv
-   !
-   SUBROUTINE sbc_cpl_ice_tau( p_taui, p_tauj )     
-      REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_taui   ! i- & j-components of atmos-ice stress [N/m2]
-      REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_tauj   ! at I-point (B-grid) or U & V-point (C-grid)
-      p_taui(:,:) = 0.   ;   p_tauj(:,:) = 0. ! stupid definition to avoid warning message when compiling...
-      WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?'
-   END SUBROUTINE sbc_cpl_ice_tau
-   !
-   SUBROUTINE sbc_cpl_ice_flx( p_frld , palbi   , psst    , pist  )
-      REAL(wp), INTENT(in   ), DIMENSION(:,:  ) ::   p_frld     ! lead fraction                [0 to 1]
-      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! ice albedo
-      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature      [Celcius]
-      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist    ! ice surface temperature      [Kelvin]
-      WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', p_frld(1,1), palbi(1,1,1), psst(1,1), pist(1,1,1) 
-   END SUBROUTINE sbc_cpl_ice_flx
-   
-#endif
-
    !!======================================================================
 END MODULE sbccpl
Index: branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90
===================================================================
--- branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90	(revision 4771)
+++ branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90	(revision 5075)
@@ -156,4 +156,5 @@
             END DO
          END DO
+         taum(:,:) = taum(:,:) * tmask(:,:,1) ; wndm(:,:) = wndm(:,:) * tmask(:,:,1)
          CALL lbc_lnk( taum(:,:), 'T', 1. )   ;   CALL lbc_lnk( wndm(:,:), 'T', 1. )
 
Index: branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90
===================================================================
--- branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90	(revision 4771)
+++ branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90	(revision 5075)
@@ -19,4 +19,5 @@
    USE phycst          ! physical constants
    USE sbcrnf          ! ocean runoffs
+   USE sbcisf          ! ice shelf melting contribution
    USE sbcssr          ! SS damping terms
    USE in_out_manager  ! I/O manager
@@ -57,4 +58,6 @@
       !!                =1 global mean of emp set to zero at each nn_fsbc time step
       !!                =2 annual global mean corrected from previous year
+      !!                =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 
       !!----------------------------------------------------------------------
@@ -81,9 +84,12 @@
             IF( kn_fwb == 1 )   WRITE(numout,*) '          instantaneously set to zero'
             IF( kn_fwb == 2 )   WRITE(numout,*) '          adjusted from previous year budget'
-         ENDIF
+            IF( kn_fwb == 3 )   WRITE(numout,*) '          fwf set to zero and spread out over erp area'
+         ENDIF
+         !
+         IF( kn_fwb == 3 .AND. nn_sssr /= 2 )   CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 requires nn_sssr = 2, we stop ' )
          !
          area = glob_sum( e1e2t(:,:) )           ! interior global domain surface
          !
-#if ! defined key_lim2 &&  ! defined key_lim3 && ! defined key_cice 
+#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
@@ -98,5 +104,5 @@
          !
          IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
-            z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) -  snwice_fmass(:,:) ) ) / area   ! sum over the global domain
+            z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + rdivisf * fwfisf(:,:) -  snwice_fmass(:,:) ) ) / area   ! sum over the global domain
             zcoef = z_fwf * rcp
             emp(:,:) = emp(:,:) - z_fwf 
@@ -142,6 +148,58 @@
          ENDIF
          !
+      CASE ( 3 )                             !==  global fwf set to zero and spread out over erp area  ==!
+         !
+         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
+            ztmsk_pos(:,:) = tmask_i(:,:)                      ! Select <0 and >0 area of erp
+            WHERE( erp < 0._wp )   ztmsk_pos = 0._wp
+            ztmsk_neg(:,:) = tmask_i(:,:) - ztmsk_pos(:,:)
+            !
+            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
+            !            
+            IF( z_fwf < 0._wp ) THEN         ! spread out over >0 erp area to increase evaporation
+                zsurf_tospread      = zsurf_pos
+                ztmsk_tospread(:,:) = ztmsk_pos(:,:)
+            ELSE                             ! spread out over <0 erp area to increase precipitation
+                zsurf_tospread      = zsurf_neg
+                ztmsk_tospread(:,:) = ztmsk_neg(:,:)
+            ENDIF
+            !
+            zsum_fwf   = glob_sum( e1e2t(:,:) * z_fwf )         ! fwf global mean over <0 or >0 erp area
+!!gm :  zsum_fwf   = z_fwf * area   ???  it is right?  I think so....
+            z_fwf_nsrf =  zsum_fwf / ( zsurf_tospread + rsmall )
+            !                                                  ! weight to respect erp field 2D structure 
+            zsum_erp   = glob_sum( ztmsk_tospread(:,:) * erp(:,:) * e1e2t(:,:) )
+            z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( zsum_erp + rsmall )
+            !                                                  ! final correction term to apply
+            zerp_cor(:,:) = -1. * z_fwf_nsrf * zsurf_tospread * z_wgt(:,:)
+            !
+!!gm   ===>>>>  lbc_lnk should be useless as all the computation is done over the whole domain !
+            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(:,:)
+            !
+            IF( nprint == 1 .AND. lwp ) THEN                   ! control print
+               IF( z_fwf < 0._wp ) THEN
+                  WRITE(numout,*)'   z_fwf < 0'
+                  WRITE(numout,*)'   SUM(erp+)     = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv'
+               ELSE
+                  WRITE(numout,*)'   z_fwf >= 0'
+                  WRITE(numout,*)'   SUM(erp-)     = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv'
+               ENDIF
+               WRITE(numout,*)'   SUM(empG)     = ', SUM( z_fwf*e1e2t(:,:) )*1.e-9,' Sv'
+               WRITE(numout,*)'   z_fwf         = ', z_fwf      ,' Kg/m2/s'
+               WRITE(numout,*)'   z_fwf_nsrf    = ', z_fwf_nsrf ,' Kg/m2/s'
+               WRITE(numout,*)'   MIN(zerp_cor) = ', MINVAL(zerp_cor) 
+               WRITE(numout,*)'   MAX(zerp_cor) = ', MAXVAL(zerp_cor) 
+            ENDIF
+         ENDIF
+         !
       CASE DEFAULT                           !==  you should never be there  ==!
-         CALL ctl_stop( 'sbc_fwb : wrong nn_fwb value for the FreshWater Budget correction, choose either 1 or 2' )
+         CALL ctl_stop( 'sbc_fwb : wrong nn_fwb value for the FreshWater Budget correction, choose either 1, 2 or 3' )
          !
       END SELECT
Index: branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
===================================================================
--- branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90	(revision 4771)
+++ branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90	(revision 5075)
@@ -17,4 +17,5 @@
    USE phycst, only : rcp, rau0, r1_rau0, rhosn, rhoic
    USE in_out_manager  ! I/O manager
+   USE iom, ONLY : iom_put,iom_use              ! I/O manager library !!Joakim edit
    USE lib_mpp         ! distributed memory computing library
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
@@ -23,5 +24,4 @@
    USE daymod          ! calendar
    USE fldread         ! read input fields
-
    USE sbc_oce         ! Surface boundary condition: ocean fields
    USE sbc_ice         ! Surface boundary condition: ice   fields
@@ -38,4 +38,5 @@
    USE ice_calendar, only: dt
    USE ice_state, only: aice,aicen,uvel,vvel,vsno,vsnon,vice,vicen
+# if defined key_cice4
    USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow,  &
                 sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_gbm,     &
@@ -44,7 +45,16 @@
                 uatm,vatm,wind,fsw,flw,Tair,potT,Qa,rhoa,zlvl,   &
                 swvdr,swvdf,swidr,swidf
+   USE ice_therm_vertical, only: calc_Tsfc
+#else
+   USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow,  &
+                sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_ai,     &
+                fresh_ai,fhocn_ai,fswthru_ai,frzmlt,          &
+                flatn_f,fsurfn_f,fcondtopn_f,                    &
+                uatm,vatm,wind,fsw,flw,Tair,potT,Qa,rhoa,zlvl,   &
+                swvdr,swvdf,swidr,swidf
+   USE ice_therm_shared, only: calc_Tsfc
+#endif
    USE ice_forcing, only: frcvdr,frcvdf,frcidr,frcidf
    USE ice_atmo, only: calc_strair
-   USE ice_therm_vertical, only: calc_Tsfc
 
    USE CICE_InitMod
@@ -95,5 +105,5 @@
    END FUNCTION sbc_ice_cice_alloc
 
-   SUBROUTINE sbc_ice_cice( kt, nsbc )
+   SUBROUTINE sbc_ice_cice( kt, ksbc )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE sbc_ice_cice  ***
@@ -113,5 +123,5 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt      ! ocean time step
-      INTEGER, INTENT(in) ::   nsbc    ! surface forcing type
+      INTEGER, INTENT(in) ::   ksbc    ! surface forcing type
       !!----------------------------------------------------------------------
       !
@@ -123,15 +133,15 @@
 
          ! Make sure any fluxes required for CICE are set
-         IF ( nsbc == 2 )  THEN
+         IF      ( ksbc == jp_flx ) THEN
             CALL cice_sbc_force(kt)
-         ELSE IF ( nsbc == 5 ) THEN
+         ELSE IF ( ksbc == jp_cpl ) THEN
             CALL sbc_cpl_ice_flx( 1.0-fr_i  )
          ENDIF
 
-         CALL cice_sbc_in ( kt, nsbc )
+         CALL cice_sbc_in  ( kt, ksbc )
          CALL CICE_Run
-         CALL cice_sbc_out ( kt, nsbc )
-
-         IF ( nsbc == 5 )  CALL cice_sbc_hadgam(kt+1)
+         CALL cice_sbc_out ( kt, ksbc )
+
+         IF ( ksbc == jp_cpl )  CALL cice_sbc_hadgam(kt+1)
 
       ENDIF                                          ! End sea-ice time step only
@@ -141,13 +151,13 @@
    END SUBROUTINE sbc_ice_cice
 
-   SUBROUTINE cice_sbc_init (nsbc)
+   SUBROUTINE cice_sbc_init (ksbc)
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE cice_sbc_init  ***
       !! ** Purpose: Initialise ice related fields for NEMO and coupling
       !!
-      INTEGER, INTENT( in  ) ::   nsbc                ! surface forcing type
+      INTEGER, INTENT( in  ) ::   ksbc                ! surface forcing type
       REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2
       REAL(wp) ::   zcoefu, zcoefv, zcoeff            ! local scalar
-      INTEGER  ::   ji, jj, jl                        ! dummy loop indices
+      INTEGER  ::   ji, jj, jl, jk                    ! dummy loop indices
       !!---------------------------------------------------------------------
 
@@ -161,13 +171,22 @@
       jj_off = INT ( (jpjglo - ny_global) / 2 )
 
+#if defined key_nemocice_decomp
+      ! Pass initial SST from NEMO to CICE so ice is initialised correctly if
+      ! there is no restart file.
+      ! Values from a CICE restart file would overwrite this
+      IF ( .NOT. ln_rstart ) THEN    
+         CALL nemo2cice( tsn(:,:,1,jp_tem) , sst , 'T' , 1.) 
+      ENDIF  
+#endif
+
 ! Initialize CICE
       CALL CICE_Initialize
 
 ! Do some CICE consistency checks
-      IF ( (nsbc == 2) .OR. (nsbc == 5) ) THEN
+      IF ( (ksbc == jp_flx) .OR. (ksbc == jp_cpl) ) THEN
          IF ( calc_strair .OR. calc_Tsfc ) THEN
             CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=F and calc_Tsfc=F in ice_in' )
          ENDIF
-      ELSEIF (nsbc == 4) THEN
+      ELSEIF (ksbc == jp_core) THEN
          IF ( .NOT. (calc_strair .AND. calc_Tsfc) ) THEN
             CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=T and calc_Tsfc=T in ice_in' )
@@ -190,5 +209,5 @@
 
       CALL cice2nemo(aice,fr_i, 'T', 1. )
-      IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN
+      IF ( (ksbc == jp_flx) .OR. (ksbc == jp_cpl) ) THEN
          DO jl=1,ncat
             CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. )
@@ -218,9 +237,44 @@
          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
-         !
+      IF( .NOT. ln_rstart ) THEN
+         IF( nn_ice_embd == 2 ) THEN            ! full embedment (case 2) deplete the initial ssh below sea-ice area
+            sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0
+            sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0
+#if defined key_vvl            
+           ! key_vvl necessary? clem: yes for compilation purpose
+            DO jk = 1,jpkm1                     ! adjust initial vertical scale factors
+               fse3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
+               fse3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
+            ENDDO
+            fse3t_a(:,:,:) = fse3t_b(:,:,:)
+            ! Reconstruction of all vertical scale factors at now and before time
+            ! steps
+            ! =============================================================================
+            ! Horizontal scale factor interpolations
+            ! --------------------------------------
+            CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3u_b(:,:,:), 'U' )
+            CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3v_b(:,:,:), 'V' )
+            CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3u_n(:,:,:), 'U' )
+            CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3v_n(:,:,:), 'V' )
+            CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3f_n(:,:,:), 'F' )
+            ! Vertical scale factor interpolations
+            ! ------------------------------------
+            CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3w_n (:,:,:), 'W'  )
+            CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3uw_n(:,:,:), 'UW' )
+            CALL dom_vvl_interpol( fse3v_n(:,:,:), fse3vw_n(:,:,:), 'VW' )
+            CALL dom_vvl_interpol( fse3u_b(:,:,:), fse3uw_b(:,:,:), 'UW' )
+            CALL dom_vvl_interpol( fse3v_b(:,:,:), fse3vw_b(:,:,:), 'VW' )
+            ! t- and w- points depth
+            ! ----------------------
+            fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1)
+            fsdepw_n(:,:,1) = 0.0_wp
+            fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:)
+            DO jk = 2, jpk
+               fsdept_n(:,:,jk) = fsdept_n(:,:,jk-1) + fse3w_n(:,:,jk)
+               fsdepw_n(:,:,jk) = fsdepw_n(:,:,jk-1) + fse3t_n(:,:,jk-1)
+               fsde3w_n(:,:,jk) = fsdept_n(:,:,jk  ) - sshn   (:,:)
+            END DO
+#endif
+         ENDIF
       ENDIF
  
@@ -232,5 +286,5 @@
 
    
-   SUBROUTINE cice_sbc_in (kt, nsbc)
+   SUBROUTINE cice_sbc_in (kt, ksbc)
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE cice_sbc_in  ***
@@ -238,5 +292,5 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in   ) ::   kt   ! ocean time step
-      INTEGER, INTENT(in   ) ::   nsbc ! surface forcing type
+      INTEGER, INTENT(in   ) ::   ksbc ! surface forcing type
 
       INTEGER  ::   ji, jj, jl                   ! dummy loop indices      
@@ -262,5 +316,5 @@
 ! forced and coupled case 
 
-      IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN
+      IF ( (ksbc == jp_flx).OR.(ksbc == jp_cpl) ) THEN
 
          ztmpn(:,:,:)=0.0
@@ -287,5 +341,5 @@
 
 ! Surface downward latent heat flux (CI_5)
-         IF (nsbc == 2) THEN
+         IF (ksbc == jp_flx) THEN
             DO jl=1,ncat
                ztmpn(:,:,jl)=qla_ice(:,:,1)*a_i(:,:,jl)
@@ -316,5 +370,5 @@
 ! GBM conductive flux through ice (CI_6)
 !  Convert to GBM
-            IF (nsbc == 2) THEN
+            IF (ksbc == jp_flx) THEN
                ztmp(:,:) = botmelt(:,:,jl)*a_i(:,:,jl)
             ELSE
@@ -325,5 +379,5 @@
 ! GBM surface heat flux (CI_7)
 !  Convert to GBM
-            IF (nsbc == 2) THEN
+            IF (ksbc == jp_flx) THEN
                ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i(:,:,jl) 
             ELSE
@@ -333,5 +387,5 @@
          ENDDO
 
-      ELSE IF (nsbc == 4) THEN
+      ELSE IF (ksbc == jp_core) THEN
 
 ! Pass CORE forcing fields to CICE (which will calculate heat fluxes etc itself)
@@ -375,9 +429,11 @@
 
 ! Snowfall
-! Ensure fsnow is positive (as in CICE routine prepare_forcing)  
+! Ensure fsnow is positive (as in CICE routine prepare_forcing)
+      IF( iom_use('snowpre') )   CALL iom_put('snowpre',MAX( (1.0-fr_i(:,:))*sprecip(:,:) ,0.0)) !!Joakim edit  
       ztmp(:,:)=MAX(fr_i(:,:)*sprecip(:,:),0.0)  
       CALL nemo2cice(ztmp,fsnow,'T', 1. ) 
 
 ! Rainfall
+      IF( iom_use('precip') )   CALL iom_put('precip', (1.0-fr_i(:,:))*(tprecip(:,:)-sprecip(:,:)) ) !!Joakim edit
       ztmp(:,:)=fr_i(:,:)*(tprecip(:,:)-sprecip(:,:))
       CALL nemo2cice(ztmp,frain,'T', 1. ) 
@@ -458,5 +514,5 @@
 
 
-   SUBROUTINE cice_sbc_out (kt,nsbc)
+   SUBROUTINE cice_sbc_out (kt,ksbc)
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE cice_sbc_out  ***
@@ -464,5 +520,5 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT( in  ) ::   kt   ! ocean time step
-      INTEGER, INTENT( in  ) ::   nsbc ! surface forcing type
+      INTEGER, INTENT( in  ) ::   ksbc ! surface forcing type
       
       INTEGER  ::   ji, jj, jl                 ! dummy loop indices
@@ -510,5 +566,5 @@
 ! Freshwater fluxes 
 
-      IF (nsbc == 2) THEN
+      IF (ksbc == jp_flx) THEN
 ! Note that emp from the forcing files is evap*(1-aice)-(tprecip-aice*sprecip)
 ! What we want here is evap*(1-aice)-tprecip*(1-aice) hence manipulation below
@@ -516,7 +572,7 @@
 ! Better to use evap and tprecip? (but for now don't read in evap in this case)
          emp(:,:)  = emp(:,:)+fr_i(:,:)*(tprecip(:,:)-sprecip(:,:))
-      ELSE IF (nsbc == 4) THEN
+      ELSE IF (ksbc == jp_core) THEN
          emp(:,:)  = (1.0-fr_i(:,:))*emp(:,:)        
-      ELSE IF (nsbc ==5) THEN
+      ELSE IF (ksbc == jp_cpl) 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
@@ -524,6 +580,11 @@
       ENDIF
 
+#if defined key_cice4
       CALL cice2nemo(fresh_gbm,ztmp1,'T', 1. )
       CALL cice2nemo(fsalt_gbm,ztmp2,'T', 1. )
+#else
+      CALL cice2nemo(fresh_ai,ztmp1,'T', 1. )
+      CALL cice2nemo(fsalt_ai,ztmp2,'T', 1. )
+#endif
 
 ! Check to avoid unphysical expression when ice is forming (ztmp1 negative)
@@ -535,5 +596,6 @@
       sfx(:,:)=ztmp2(:,:)*1000.0
       emp(:,:)=emp(:,:)-ztmp1(:,:)
- 
+      fmmflx(:,:) = ztmp1(:,:) !!Joakim edit
+      
       CALL lbc_lnk( emp , 'T', 1. )
       CALL lbc_lnk( sfx , 'T', 1. )
@@ -543,10 +605,10 @@
 ! Scale qsr and qns according to ice fraction (bulk formulae only)
 
-      IF (nsbc == 4) THEN
+      IF (ksbc == jp_core) THEN
          qsr(:,:)=qsr(:,:)*(1.0-fr_i(:,:))
          qns(:,:)=qns(:,:)*(1.0-fr_i(:,:))
       ENDIF
 ! Take into account snow melting except for fully coupled when already in qns_tot
-      IF (nsbc == 5) THEN
+      IF (ksbc == jp_cpl) THEN
          qsr(:,:)= qsr_tot(:,:)
          qns(:,:)= qns_tot(:,:)
@@ -557,5 +619,9 @@
 ! Now add in ice / snow related terms
 ! [fswthru will be zero unless running with calc_Tsfc=T in CICE]
+#if defined key_cice4
       CALL cice2nemo(fswthru_gbm,ztmp1,'T', 1. )
+#else
+      CALL cice2nemo(fswthru_ai,ztmp1,'T', 1. )
+#endif
       qsr(:,:)=qsr(:,:)+ztmp1(:,:)
       CALL lbc_lnk( qsr , 'T', 1. )
@@ -567,5 +633,9 @@
       ENDDO
 
+#if defined key_cice4
       CALL cice2nemo(fhocn_gbm,ztmp1,'T', 1. )
+#else
+      CALL cice2nemo(fhocn_ai,ztmp1,'T', 1. )
+#endif
       qns(:,:)=qns(:,:)+nfrzmlt(:,:)+ztmp1(:,:)
 
@@ -575,5 +645,5 @@
 
       CALL cice2nemo(aice,fr_i,'T', 1. )
-      IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN
+      IF ( (ksbc == jp_flx).OR.(ksbc == jp_cpl) ) THEN
          DO jl=1,ncat
             CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. )
@@ -611,5 +681,4 @@
 
 
-#if defined key_oasis3 || defined key_oasis4
    SUBROUTINE cice_sbc_hadgam( kt )
       !!---------------------------------------------------------------------
@@ -653,10 +722,4 @@
    END SUBROUTINE cice_sbc_hadgam
 
-#else
-   SUBROUTINE cice_sbc_hadgam( kt )    ! Dummy routine
-      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
-      WRITE(*,*) 'cice_sbc_hadgam: You should not have seen this print! error?'
-   END SUBROUTINE cice_sbc_hadgam
-#endif
 
    SUBROUTINE cice_sbc_final
@@ -713,4 +776,25 @@
       IF( kt == nit000 ) THEN                   !  First call kt=nit000  !
          !                                      ! ====================== !
+         ! namsbc_cice is not yet in the reference namelist
+         ! set file information (default values)
+         cn_dir = './'       ! directory in which the model is executed
+
+         ! (NB: frequency positive => hours, negative => months)
+         !            !    file          ! frequency !  variable    ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   ! landmask
+         !            !    name          !  (hours)  !   name       !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      ! file
+         sn_snow = FLD_N( 'snowfall_1m'  ,    -1.    ,  'snowfall'  ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    ) 
+         sn_rain = FLD_N( 'rainfall_1m'  ,    -1.    ,  'rainfall'  ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    ) 
+         sn_sblm = FLD_N( 'sublim_1m'    ,    -1.    ,  'sublim'    ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    )
+         sn_top1 = FLD_N( 'topmeltn1_1m' ,    -1.    ,  'topmeltn1' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    )
+         sn_top2 = FLD_N( 'topmeltn2_1m' ,    -1.    ,  'topmeltn2' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    )
+         sn_top3 = FLD_N( 'topmeltn3_1m' ,    -1.    ,  'topmeltn3' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    )
+         sn_top4 = FLD_N( 'topmeltn4_1m' ,    -1.    ,  'topmeltn4' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    )
+         sn_top5 = FLD_N( 'topmeltn5_1m' ,    -1.    ,  'topmeltn5' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    )
+         sn_bot1 = FLD_N( 'botmeltn1_1m' ,    -1.    ,  'botmeltn1' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    )
+         sn_bot2 = FLD_N( 'botmeltn2_1m' ,    -1.    ,  'botmeltn2' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    )
+         sn_bot3 = FLD_N( 'botmeltn3_1m' ,    -1.    ,  'botmeltn3' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    )
+         sn_bot4 = FLD_N( 'botmeltn4_1m' ,    -1.    ,  'botmeltn4' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    )
+         sn_bot5 = FLD_N( 'botmeltn5_1m' ,    -1.    ,  'botmeltn5' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    )
+
          REWIND( numnam_ref )              ! Namelist namsbc_cice in reference namelist : 
          READ  ( numnam_ref, namsbc_cice, IOSTAT = ios, ERR = 901)
@@ -1001,9 +1085,9 @@
 CONTAINS
 
-   SUBROUTINE sbc_ice_cice ( kt, nsbc )     ! Dummy routine
+   SUBROUTINE sbc_ice_cice ( kt, ksbc )     ! Dummy routine
       WRITE(*,*) 'sbc_ice_cice: You should not have seen this print! error?', kt
    END SUBROUTINE sbc_ice_cice
 
-   SUBROUTINE cice_sbc_init (nsbc)    ! Dummy routine
+   SUBROUTINE cice_sbc_init (ksbc)    ! Dummy routine
       WRITE(*,*) 'cice_sbc_init: You should not have seen this print! error?'
    END SUBROUTINE cice_sbc_init
Index: branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90
===================================================================
--- branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90	(revision 4771)
+++ branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90	(revision 5075)
@@ -16,5 +16,9 @@
    USE eosbn2         ! equation of state
    USE sbc_oce        ! surface boundary condition: ocean fields
-   USE sbccpl
+#if defined key_lim3
+   USE ice    , ONLY :   a_i 
+#else
+   USE sbc_ice, ONLY :   a_i 
+#endif
    USE fldread        ! read input field
    USE iom            ! I/O manager library
@@ -99,13 +103,9 @@
                                  ! ( d rho / dt ) / ( d rho / ds )      ( s = 34, t = -1.8 )
          
-         fr_i(:,:) = tfreez( sss_m ) * tmask(:,:,1)      ! sea surface freezing temperature [Celcius]
+         fr_i(:,:) = eos_fzp( sss_m ) * tmask(:,:,1)      ! sea surface freezing temperature [Celcius]
 
-! OM : probleme. a_i pas defini dans les cas lim3 et cice
-#if defined key_coupled && defined key_lim2
-         a_i(:,:,1) = fr_i(:,:)         
-#endif
+         IF( lk_cpl )   a_i(:,:,1) = fr_i(:,:)         
 
          ! Flux and ice fraction computation
-!CDIR COLLAPSE
          DO jj = 1, jpj
             DO ji = 1, jpi
Index: branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
===================================================================
--- branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90	(revision 4771)
+++ branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90	(revision 5075)
@@ -12,4 +12,5 @@
    !!            3.4  ! 2011-01  (A Porter)  dynamical allocation
    !!             -   ! 2012-10  (C. Rousset)  add lim_diahsb
+   !!            3.6  ! 2014-07  (M. Vancoppenolle, G. Madec, O. Marti) revise coupled interface
    !!----------------------------------------------------------------------
 #if defined key_lim3
@@ -68,4 +69,5 @@
 
    PUBLIC sbc_ice_lim  ! routine called by sbcmod.F90
+   PUBLIC lim_prt_state
    
    !! * Substitutions
@@ -78,33 +80,4 @@
    !!----------------------------------------------------------------------
 CONTAINS
-
-   FUNCTION fice_cell_ave ( ptab)
-      !!--------------------------------------------------------------------------
-      !! * Compute average over categories, for grid cell (ice covered and free ocean)
-      !!--------------------------------------------------------------------------
-      REAL (wp), DIMENSION (jpi,jpj) :: fice_cell_ave
-      REAL (wp), DIMENSION (jpi,jpj,jpl), INTENT (in) :: ptab
-      INTEGER :: jl ! Dummy loop index
-      
-      fice_cell_ave (:,:) = 0.0_wp
-      
-      DO jl = 1, jpl
-         fice_cell_ave (:,:) = fice_cell_ave (:,:) &
-            &                  + a_i (:,:,jl) * ptab (:,:,jl)
-      END DO
-      
-   END FUNCTION fice_cell_ave
-   
-   FUNCTION fice_ice_ave ( ptab)
-      !!--------------------------------------------------------------------------
-      !! * Compute average over categories, for ice covered part of grid cell
-      !!--------------------------------------------------------------------------
-      REAL (kind=wp), DIMENSION (jpi,jpj) :: fice_ice_ave
-      REAL (kind=wp), DIMENSION (jpi,jpj,jpl), INTENT(in) :: ptab
-
-      fice_ice_ave (:,:) = 0.0_wp
-      WHERE ( at_i (:,:) .GT. 0.0_wp ) fice_ice_ave (:,:) = fice_cell_ave ( ptab (:,:,:)) / at_i (:,:)
-
-   END FUNCTION fice_ice_ave
 
    !!======================================================================
@@ -131,32 +104,13 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt      ! ocean time step
-      INTEGER, INTENT(in) ::   kblk    ! type of bulk (=3 CLIO, =4 CORE)
+      INTEGER, INTENT(in) ::   kblk    ! type of bulk (=3 CLIO, =4 CORE, =5 COUPLED)
       !!
       INTEGER  ::   jl      ! dummy loop index
       REAL(wp) ::   zcoef   ! local scalar
-      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_ice_os, zalb_ice_cs  ! albedo of the ice under overcast/clear sky
-      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_ice      ! mean albedo of ice (for coupled)
-
-      REAL(wp), POINTER, DIMENSION(:,:) :: zalb_ice_all    ! Mean albedo over all categories
-      REAL(wp), POINTER, DIMENSION(:,:) :: ztem_ice_all    ! Mean temperature over all categories
-      
-      REAL(wp), POINTER, DIMENSION(:,:) :: z_qsr_ice_all   ! Mean solar heat flux over all categories
-      REAL(wp), POINTER, DIMENSION(:,:) :: z_qns_ice_all   ! Mean non solar heat flux over all categories
-      REAL(wp), POINTER, DIMENSION(:,:) :: z_qla_ice_all   ! Mean latent heat flux over all categories
-      REAL(wp), POINTER, DIMENSION(:,:) :: z_dqns_ice_all  ! Mean d(qns)/dT over all categories
-      REAL(wp), POINTER, DIMENSION(:,:) :: z_dqla_ice_all  ! Mean d(qla)/dT over all categories
+      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_os, zalb_cs  ! ice albedo under overcast/clear sky
+      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_ice          ! mean ice albedo (for coupled)
       !!----------------------------------------------------------------------
 
-      !- O.M. : why do we allocate all these arrays even when MOD( kt-1, nn_fsbc ) /= 0 ?????
-
       IF( nn_timing == 1 )  CALL timing_start('sbc_ice_lim')
-
-      CALL wrk_alloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs )
-
-#if defined key_coupled
-      IF ( ln_cpl .OR. ln_iceflx_ave .OR. ln_iceflx_linear ) CALL wrk_alloc( jpi,jpj,jpl, zalb_ice)
-      IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) &
-         &   CALL wrk_alloc( jpi,jpj, ztem_ice_all, zalb_ice_all, z_qsr_ice_all, z_qns_ice_all, z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all)
-#endif
 
       IF( kt == nit000 ) THEN
@@ -168,5 +122,5 @@
          !
          IF( ln_nicep ) THEN      ! control print at a given point
-            jiindx = 177   ;   jjindx = 112
+            jiindx = 15    ;   jjindx =  44
             IF(lwp) WRITE(numout,*) ' The debugging point is : jiindx : ',jiindx, ' jjindx : ',jjindx
          ENDIF
@@ -176,30 +130,33 @@
       IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !  Ice time-step only  !
          !                                     !----------------------!
-         !                                           !  Bulk Formulea !
+         !                                           !  Bulk Formulae !
          !                                           !----------------!
          !
-         u_oce(:,:) = ssu_m(:,:)                     ! mean surface ocean current at ice velocity point
-         v_oce(:,:) = ssv_m(:,:)                     ! (C-grid dynamics :  U- & V-points as the ocean)
-         !
-         t_bo(:,:) = tfreez( sss_m ) +  rt0          ! masked sea surface freezing temperature [Kelvin]
-         !                                           ! (set to rt0 over land)
-         CALL albedo_ice( t_su, ht_i, ht_s, zalb_ice_cs, zalb_ice_os )  ! ... ice albedo
-
+         u_oce(:,:) = ssu_m(:,:) * umask(:,:,1)                     ! mean surface ocean current at ice velocity point
+         v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1)                    ! (C-grid dynamics :  U- & V-points as the ocean)
+         !
+         t_bo(:,:) = ( eos_fzp( sss_m ) +  rt0 ) * tmask(:,:,1) + rt0 * ( 1. - tmask(:,:,1) )  ! masked sea surface freezing temperature [Kelvin]
+         !                                                                                  ! (set to rt0 over land)
+         !                                           ! Ice albedo
+         CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice )      
+
+         CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os )  ! cloud-sky and overcast-sky ice albedos
+
+         SELECT CASE( kblk )
+         CASE( jp_core , jp_cpl )   ! CORE and COUPLED bulk formulations
+
+            ! albedo depends on cloud fraction because of non-linear spectral effects
+            zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
+            ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo 
+            ! (zalb_ice) is computed within the bulk routine
+            
+         END SELECT
+         
+         !                                           ! Mask sea ice surface temperature
          DO jl = 1, jpl
             t_su(:,:,jl) = t_su(:,:,jl) +  rt0 * ( 1. - tmask(:,:,1) )
          END DO
-
-         IF ( ln_cpl ) zalb_ice (:,:,:) = 0.5 * ( zalb_ice_cs (:,:,:) +  zalb_ice_os (:,:,:) )
-         
-#if defined key_coupled
-         IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN
-            !
-            ! Compute mean albedo and temperature
-            zalb_ice_all (:,:) = fice_ice_ave ( zalb_ice (:,:,:) ) 
-            ztem_ice_all (:,:) = fice_ice_ave ( tn_ice   (:,:,:) ) 
-            !
-         ENDIF
-#endif
-                                               ! Bulk formulea - provides the following fields:
+     
+         ! Bulk formulae  - provides the following fields:
          ! utau_ice, vtau_ice : surface ice stress                     (U- & V-points)   [N/m2]
          ! qsr_ice , qns_ice  : solar & non solar heat flux over ice   (T-point)         [W/m2]
@@ -210,6 +167,6 @@
          !
          SELECT CASE( kblk )
-         CASE( 3 )                                       ! CLIO bulk formulation
-            CALL blk_ice_clio( t_su , zalb_ice_cs, zalb_ice_os,                           &
+         CASE( jp_clio )                                       ! CLIO bulk formulation
+            CALL blk_ice_clio( t_su , zalb_cs    , zalb_os    , zalb_ice  ,               &
                &                      utau_ice   , vtau_ice   , qns_ice   , qsr_ice   ,   &
                &                      qla_ice    , dqns_ice   , dqla_ice  ,               &
@@ -217,57 +174,34 @@
                &                      fr1_i0     , fr2_i0     , cp_ice_msh, jpl  )
             !         
-         CASE( 4 )                                       ! CORE bulk formulation
-            CALL blk_ice_core( t_su , u_ice     , v_ice     , zalb_ice_cs,               &
+            IF( nn_limflx /= 2 )   CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice ,   &
+               &                                           dqns_ice, qla_ice, dqla_ice, nn_limflx )
+
+         CASE( jp_core )                                       ! CORE bulk formulation
+            CALL blk_ice_core( t_su , u_ice     , v_ice     , zalb_ice   ,               &
                &                      utau_ice  , vtau_ice  , qns_ice    , qsr_ice   ,   &
                &                      qla_ice   , dqns_ice  , dqla_ice   ,               &
                &                      tprecip   , sprecip   ,                            &
                &                      fr1_i0    , fr2_i0    , cp_ice_msh, jpl  )
+               !
+            IF( nn_limflx /= 2 )   CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice ,   &
+               &                                           dqns_ice, qla_ice, dqla_ice, nn_limflx )
             !
-         CASE ( 5 )
-            zalb_ice (:,:,:) = 0.5 * ( zalb_ice_cs (:,:,:) +  zalb_ice_os (:,:,:) )
+         CASE ( jp_cpl )
             
             CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )
 
-            CALL sbc_cpl_ice_flx( p_frld=ato_i, palbi=zalb_ice, psst=sst_m, pist=tn_ice    )
-
-            ! Latent heat flux is forced to 0 in coupled :
-            !  it is included in qns (non-solar heat flux)
-            qla_ice  (:,:,:) = 0.0e0_wp
-            dqla_ice (:,:,:) = 0.0e0_wp
+            ! MV -> seb 
+!           CALL sbc_cpl_ice_flx( p_frld=ato_i, palbi=zalb_ice, psst=sst_m, pist=t_su    )
+
+!           IF( nn_limflx == 2 )   CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice ,   &
+!              &                                           dqns_ice, qla_ice, dqla_ice, nn_limflx )
+!           ! Latent heat flux is forced to 0 in coupled :
+!           !  it is included in qns (non-solar heat flux)
+!           qla_ice  (:,:,:) = 0._wp
+!           dqla_ice (:,:,:) = 0._wp
+            ! END MV -> seb
             !
          END SELECT
-
-         ! Average over all categories
-#if defined key_coupled
-         IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN
-
-            z_qns_ice_all  (:,:) = fice_ice_ave ( qns_ice  (:,:,:) )
-            z_qsr_ice_all  (:,:) = fice_ice_ave ( qsr_ice  (:,:,:) )
-            z_dqns_ice_all (:,:) = fice_ice_ave ( dqns_ice (:,:,:) )
-            z_qla_ice_all  (:,:) = fice_ice_ave ( qla_ice  (:,:,:) )
-            z_dqla_ice_all (:,:) = fice_ice_ave ( dqla_ice (:,:,:) )
-
-            DO jl = 1, jpl
-               dqns_ice (:,:,jl) = z_dqns_ice_all (:,:)
-               dqla_ice (:,:,jl) = z_dqla_ice_all (:,:)
-            END DO
-            !
-            IF ( ln_iceflx_ave ) THEN
-               DO jl = 1, jpl
-                  qns_ice  (:,:,jl) = z_qns_ice_all  (:,:)
-                  qsr_ice  (:,:,jl) = z_qsr_ice_all  (:,:)
-                  qla_ice  (:,:,jl) = z_qla_ice_all  (:,:)
-               END DO
-            END IF
-            !
-            IF ( ln_iceflx_linear ) THEN
-               DO jl = 1, jpl
-                  qns_ice  (:,:,jl) = z_qns_ice_all(:,:) + z_dqns_ice_all(:,:) * (tn_ice(:,:,jl) - ztem_ice_all(:,:))
-                  qla_ice  (:,:,jl) = z_qla_ice_all(:,:) + z_dqla_ice_all(:,:) * (tn_ice(:,:,jl) - ztem_ice_all(:,:))
-                  qsr_ice  (:,:,jl) = (1.0e0_wp-zalb_ice(:,:,jl)) / (1.0e0_wp-zalb_ice_all(:,:)) * z_qsr_ice_all(:,:)
-               END DO
-            END IF
-         END IF
-#endif
+         
          !                                           !----------------------!
          !                                           ! LIM-3  time-stepping !
@@ -277,54 +211,37 @@
          !
          !                                           ! Store previous ice values
-!!gm : remark   old_...   should becomes ...b  as tn versus tb  
-         old_a_i  (:,:,:)   = a_i  (:,:,:)     ! ice area
-         old_e_i  (:,:,:,:) = e_i  (:,:,:,:)   ! ice thermal energy
-         old_v_i  (:,:,:)   = v_i  (:,:,:)     ! ice volume
-         old_v_s  (:,:,:)   = v_s  (:,:,:)     ! snow volume 
-         old_e_s  (:,:,:,:) = e_s  (:,:,:,:)   ! snow thermal energy
-         old_smv_i(:,:,:)   = smv_i(:,:,:)     ! salt content
-         old_oa_i (:,:,:)   = oa_i (:,:,:)     ! areal age content
-         !
-         old_u_ice(:,:) = u_ice(:,:)
-         old_v_ice(:,:) = v_ice(:,:)
-         !                                           ! 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
-         !
-         d_u_ice_dyn(:,:) = 0._wp
-         d_v_ice_dyn(:,:) = 0._wp
-         !
-         sfx    (:,:) = 0._wp   ;   sfx_thd  (:,:) = 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
-         fmmflx (:,:) = 0._wp     
-         focea2D(:,:) = 0._wp
-         fsup2D (:,:) = 0._wp
-
-         ! used in limthd.F90
-         rdvosif(:,:) = 0._wp   ! variation of ice volume at surface
-         rdvobif(:,:) = 0._wp   ! variation of ice volume at bottom
-         fdvolif(:,:) = 0._wp   ! total variation of ice volume
-         rdvonif(:,:) = 0._wp   ! lateral variation of ice volume
-         fstric (:,:) = 0._wp   ! part of solar radiation transmitted through the ice
-         ffltbif(:,:) = 0._wp   ! linked with fstric
-         qfvbq  (:,:) = 0._wp   ! linked with fstric
-         rdm_snw(:,:) = 0._wp   ! variation of snow mass per unit area
-         rdm_ice(:,:) = 0._wp   ! variation of ice mass per unit area
-         hicifp (:,:) = 0._wp   ! daily thermodynamic ice production. 
-         !
-         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_res_pr(:,:) = 0._wp   ;   diag_trp_vi(:,:) = 0._wp
-         ! dynamical invariants
-         delta_i(:,:) = 0._wp       ;   divu_i(:,:) = 0._wp       ;   shear_i(:,:) = 0._wp
+         a_i_b  (:,:,:)   = a_i  (:,:,:)     ! ice area
+         e_i_b  (:,:,:,:) = e_i  (:,:,:,:)   ! ice thermal energy
+         v_i_b  (:,:,:)   = v_i  (:,:,:)     ! ice volume
+         v_s_b  (:,:,:)   = v_s  (:,:,:)     ! snow volume 
+         e_s_b  (:,:,:,:) = e_s  (:,:,:,:)   ! snow thermal energy
+         smv_i_b(:,:,:)   = smv_i(:,:,:)     ! salt content
+         oa_i_b (:,:,:)   = oa_i (:,:,:)     ! areal age content
+         u_ice_b(:,:)     = u_ice(:,:)
+         v_ice_b(:,:)     = v_ice(:,:)
+
+         ! salt, heat and mass fluxes
+         sfx    (:,:) = 0._wp   ;
+         sfx_bri(:,:) = 0._wp   ; 
+         sfx_sni(:,:) = 0._wp   ;   sfx_opw(:,:) = 0._wp
+         sfx_bog(:,:) = 0._wp   ;   sfx_dyn(:,:) = 0._wp
+         sfx_bom(:,:) = 0._wp   ;   sfx_sum(:,:) = 0._wp
+         sfx_res(:,:) = 0._wp
+
+         wfx_snw(:,:) = 0._wp   ;   wfx_ice(:,:) = 0._wp
+         wfx_sni(:,:) = 0._wp   ;   wfx_opw(:,:) = 0._wp
+         wfx_bog(:,:) = 0._wp   ;   wfx_dyn(:,:) = 0._wp
+         wfx_bom(:,:) = 0._wp   ;   wfx_sum(:,:) = 0._wp
+         wfx_res(:,:) = 0._wp   ;   wfx_sub(:,:) = 0._wp
+         wfx_spr(:,:) = 0._wp   ;   
+
+         hfx_in (:,:) = 0._wp   ;   hfx_out(:,:) = 0._wp
+         hfx_thd(:,:) = 0._wp   ;   
+         hfx_snw(:,:) = 0._wp   ;   hfx_opw(:,:) = 0._wp
+         hfx_bog(:,:) = 0._wp   ;   hfx_dyn(:,:) = 0._wp
+         hfx_bom(:,:) = 0._wp   ;   hfx_sum(:,:) = 0._wp
+         hfx_res(:,:) = 0._wp   ;   hfx_sub(:,:) = 0._wp
+         hfx_spr(:,:) = 0._wp   ;   hfx_dif(:,:) = 0._wp 
+         hfx_err(:,:) = 0._wp   ;   hfx_err_rem(:,:) = 0._wp
 
                           CALL lim_rst_opn( kt )     ! Open Ice restart file
@@ -352,13 +269,13 @@
          ENDIF
 !                         !- Change old values for new values
-                          old_u_ice(:,:)   = u_ice (:,:)
-                          old_v_ice(:,:)   = v_ice (:,:)
-                          old_a_i(:,:,:)   = a_i (:,:,:)
-                          old_v_s(:,:,:)   = v_s (:,:,:)
-                          old_v_i(:,:,:)   = v_i (:,:,:)
-                          old_e_s(:,:,:,:) = e_s (:,:,:,:)
-                          old_e_i(:,:,:,:) = e_i (:,:,:,:)
-                          old_oa_i(:,:,:)  = oa_i(:,:,:)
-                          old_smv_i(:,:,:) = smv_i (:,:,:)
+                          u_ice_b(:,:)     = u_ice(:,:)
+                          v_ice_b(:,:)     = v_ice(:,:)
+                          a_i_b  (:,:,:)   = a_i  (:,:,:)
+                          v_s_b  (:,:,:)   = v_s  (:,:,:)
+                          v_i_b  (:,:,:)   = v_i  (:,:,:)
+                          e_s_b  (:,:,:,:) = e_s  (:,:,:,:)
+                          e_i_b  (:,:,:,:) = e_i  (:,:,:,:)
+                          oa_i_b (:,:,:)   = oa_i (:,:,:)
+                          smv_i_b(:,:,:)   = smv_i(:,:,:)
  
          ! ----------------------------------------------
@@ -370,4 +287,17 @@
                           pfrld(:,:)   = 1._wp - at_i(:,:)
                           phicif(:,:)  = vt_i(:,:)
+
+                          ! MV -> seb
+                          SELECT CASE( kblk )
+                             CASE ( jp_cpl )
+                             CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su    )
+                             IF( nn_limflx == 2 )   CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice ,   &
+                          &                                           dqns_ice, qla_ice, dqla_ice, nn_limflx )
+                           ! Latent heat flux is forced to 0 in coupled :
+                           !  it is included in qns (non-solar heat flux)
+                             qla_ice  (:,:,:) = 0._wp
+                             dqla_ice (:,:,:) = 0._wp
+                          END SELECT
+                          ! END MV -> seb
                           !
                           CALL lim_var_bv                 ! bulk brine volume (diag)
@@ -375,5 +305,4 @@
                           zcoef = rdt_ice /rday           !  Ice natural aging
                           oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * zcoef
-                          CALL lim_var_glo2eqv            ! this CALL is maybe not necessary (Martin)
          IF( ln_nicep )   CALL lim_prt_state( kt, jiindx, jjindx, 1, ' - ice thermodyn. - ' )   ! control print
                           CALL lim_itd_th( kt )           !  Remap ice categories, lateral accretion  !
@@ -391,7 +320,7 @@
          !                                           ! Diagnostics and outputs 
          IF (ln_limdiaout) CALL lim_diahsb
-!clem # if ! defined key_iomput
+
                           CALL lim_wri( 1  )              ! Ice outputs 
-!clem # endif
+
          IF( kt == nit000 .AND. ln_rstart )   &
             &             CALL iom_close( numrir )        ! clem: close input ice restart file
@@ -401,4 +330,6 @@
          !
          IF( ln_nicep )   CALL lim_ctl( kt )              ! alerts in case of model crash
+         !
+         CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice )
          !
       ENDIF                                    ! End sea-ice time step only
@@ -411,20 +342,92 @@
       !                                                   ! otherwise the atm.-ocean stresses are used everywhere
       IF( ln_limdyn )     CALL lim_sbc_tau( kt, ub(:,:,1), vb(:,:,1) )  ! using before instantaneous surf. currents
-      
 !!gm   remark, the ocean-ice stress is not saved in ice diag call above .....  find a solution!!!
-      !
-      CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs )
-
-#if defined key_coupled
-      IF ( ln_cpl .OR. ln_iceflx_ave .OR. ln_iceflx_linear ) CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice)
-      IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) &
-         &    CALL wrk_dealloc( jpi,jpj, ztem_ice_all, zalb_ice_all, z_qsr_ice_all, z_qns_ice_all, z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all)
-#endif
+
       !
       IF( nn_timing == 1 )  CALL timing_stop('sbc_ice_lim')
       !
    END SUBROUTINE sbc_ice_lim
-
-
+   
+   
+      SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice,   &
+         &                          pdqn_ice, pqla_ice, pdql_ice, k_limflx )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_ice_lim  ***
+      !!                   
+      !! ** Purpose :   update the ice surface boundary condition by averaging and / or
+      !!                redistributing fluxes on ice categories                   
+      !!
+      !! ** Method  :   average then redistribute 
+      !!
+      !! ** Action  :   
+      !!---------------------------------------------------------------------
+      INTEGER                   , INTENT(in   ) ::   k_limflx   ! =-1 do nothing; =0 average ; 
+                                                                ! =1 average and redistribute ; =2 redistribute
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   ptn_ice    ! ice surface temperature 
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb_ice   ! ice albedo
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pqns_ice   ! non solar flux
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pqsr_ice   ! net solar flux
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdqn_ice   ! non solar flux sensitivity
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pqla_ice   ! latent heat flux
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdql_ice   ! latent heat flux sensitivity
+      !
+      INTEGER  ::   jl      ! dummy loop index
+      !
+      REAL(wp), POINTER, DIMENSION(:,:) :: zalb_m    ! Mean albedo over all categories
+      REAL(wp), POINTER, DIMENSION(:,:) :: ztem_m    ! Mean temperature over all categories
+      !
+      REAL(wp), POINTER, DIMENSION(:,:) :: z_qsr_m   ! Mean solar heat flux over all categories
+      REAL(wp), POINTER, DIMENSION(:,:) :: z_qns_m   ! Mean non solar heat flux over all categories
+      REAL(wp), POINTER, DIMENSION(:,:) :: z_qla_m   ! Mean latent heat flux over all categories
+      REAL(wp), POINTER, DIMENSION(:,:) :: z_dqn_m   ! Mean d(qns)/dT over all categories
+      REAL(wp), POINTER, DIMENSION(:,:) :: z_dql_m   ! Mean d(qla)/dT over all categories
+      !!----------------------------------------------------------------------
+
+      IF( nn_timing == 1 )  CALL timing_start('ice_lim_flx')
+      !
+      !
+      SELECT CASE( k_limflx )                              !==  averaged on all ice categories  ==!
+      CASE( 0 , 1 )
+         CALL wrk_alloc( jpi,jpj, z_qsr_m, z_qns_m, z_qla_m, z_dqn_m, z_dql_m)
+         !
+         z_qns_m(:,:) = fice_ice_ave ( pqns_ice (:,:,:) )
+         z_qsr_m(:,:) = fice_ice_ave ( pqsr_ice (:,:,:) )
+         z_dqn_m(:,:) = fice_ice_ave ( pdqn_ice (:,:,:) )
+         z_qla_m(:,:) = fice_ice_ave ( pqla_ice (:,:,:) )
+         z_dql_m(:,:) = fice_ice_ave ( pdql_ice (:,:,:) )
+         DO jl = 1, jpl
+            pdqn_ice(:,:,jl) = z_dqn_m(:,:)
+            pdql_ice(:,:,jl) = z_dql_m(:,:)
+         END DO
+         !
+         DO jl = 1, jpl
+            pqns_ice(:,:,jl) = z_qns_m(:,:)
+            pqsr_ice(:,:,jl) = z_qsr_m(:,:)
+            pqla_ice(:,:,jl) = z_qla_m(:,:)
+         END DO
+         !
+         CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_qla_m, z_dqn_m, z_dql_m)
+      END SELECT
+
+      SELECT CASE( k_limflx )                              !==  redistribution on all ice categories  ==!
+      CASE( 1 , 2 )
+         CALL wrk_alloc( jpi,jpj, zalb_m, ztem_m )
+         !
+         zalb_m(:,:) = fice_ice_ave ( palb_ice (:,:,:) ) 
+         ztem_m(:,:) = fice_ice_ave ( ptn_ice  (:,:,:) ) 
+         DO jl = 1, jpl
+            pqns_ice(:,:,jl) = pqns_ice(:,:,jl) + pdqn_ice(:,:,jl) * (ptn_ice(:,:,jl) - ztem_m(:,:))
+            pqla_ice(:,:,jl) = pqla_ice(:,:,jl) + pdql_ice(:,:,jl) * (ptn_ice(:,:,jl) - ztem_m(:,:))
+            pqsr_ice(:,:,jl) = pqsr_ice(:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) ) 
+         END DO
+         !
+         CALL wrk_dealloc( jpi,jpj, zalb_m, ztem_m )
+      END SELECT
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ice_lim_flx')
+      !
+   END SUBROUTINE ice_lim_flx
+   
+   
    SUBROUTINE lim_ctl( kt )
       !!-----------------------------------------------------------------------
@@ -456,6 +459,6 @@
                   !WRITE(numout,*) ' at_i     ', at_i(ji,jj)
                   !WRITE(numout,*) ' Point - category', ji, jj, jl
-                  !WRITE(numout,*) ' a_i *** a_i_old ', a_i      (ji,jj,jl), old_a_i  (ji,jj,jl)
-                  !WRITE(numout,*) ' v_i *** v_i_old ', v_i      (ji,jj,jl), old_v_i  (ji,jj,jl)
+                  !WRITE(numout,*) ' a_i *** a_i_b   ', a_i      (ji,jj,jl), a_i_b  (ji,jj,jl)
+                  !WRITE(numout,*) ' v_i *** v_i_b   ', v_i      (ji,jj,jl), v_i_b  (ji,jj,jl)
                   !WRITE(numout,*) ' d_a_i_thd/trp   ', d_a_i_thd(ji,jj,jl), d_a_i_trp(ji,jj,jl)
                   !WRITE(numout,*) ' d_v_i_thd/trp   ', d_v_i_thd(ji,jj,jl), d_v_i_trp(ji,jj,jl)
@@ -534,5 +537,4 @@
 !                 WRITE(numout,*) ' sst                  : ', sst_m(ji,jj)
 !                 WRITE(numout,*) ' sss                  : ', sss_m(ji,jj)
-!                 WRITE(numout,*) ' s_i_newice           : ', s_i_newice(ji,jj,1:jpl)
 !                 WRITE(numout,*) 
                   inb_alp(ialert_id) = inb_alp(ialert_id) + 1
@@ -568,7 +570,7 @@
                !DO jl = 1, jpl
                   !WRITE(numout,*) ' Category no: ', jl
-                  !WRITE(numout,*) ' a_i        : ', a_i      (ji,jj,jl) , ' old_a_i    : ', old_a_i  (ji,jj,jl)   
+                  !WRITE(numout,*) ' a_i        : ', a_i      (ji,jj,jl) , ' a_i_b      : ', a_i_b  (ji,jj,jl)   
                   !WRITE(numout,*) ' d_a_i_trp  : ', d_a_i_trp(ji,jj,jl) , ' d_a_i_thd  : ', d_a_i_thd(ji,jj,jl) 
-                  !WRITE(numout,*) ' v_i        : ', v_i      (ji,jj,jl) , ' old_v_i    : ', old_v_i  (ji,jj,jl)   
+                  !WRITE(numout,*) ' v_i        : ', v_i      (ji,jj,jl) , ' v_i_b      : ', v_i_b  (ji,jj,jl)   
                   !WRITE(numout,*) ' d_v_i_trp  : ', d_v_i_trp(ji,jj,jl) , ' d_v_i_thd  : ', d_v_i_thd(ji,jj,jl) 
                   !WRITE(numout,*) ' '
@@ -591,17 +593,4 @@
                !WRITE(numout,*) ' sst       : ', sst_m(ji,jj)
                !WRITE(numout,*) ' sss       : ', sss_m(ji,jj)
-               !WRITE(numout,*) ' qcmif     : ', qcmif(ji,jj)
-               !WRITE(numout,*) ' qldif     : ', qldif(ji,jj)
-               !WRITE(numout,*) ' qcmif     : ', qcmif(ji,jj) / rdt_ice
-               !WRITE(numout,*) ' qldif     : ', qldif(ji,jj) / rdt_ice
-               !WRITE(numout,*) ' qfvbq     : ', qfvbq(ji,jj)
-               !WRITE(numout,*) ' qdtcn     : ', qdtcn(ji,jj)
-               !WRITE(numout,*) ' qfvbq / dt: ', qfvbq(ji,jj) / rdt_ice
-               !WRITE(numout,*) ' qdtcn / dt: ', qdtcn(ji,jj) / rdt_ice
-               !WRITE(numout,*) ' fdtcn     : ', fdtcn(ji,jj) 
-               !WRITE(numout,*) ' fhmec     : ', fhmec(ji,jj) 
-               !WRITE(numout,*) ' fheat_mec : ', fheat_mec(ji,jj) 
-               !WRITE(numout,*) ' fheat_res : ', fheat_res(ji,jj) 
-               !WRITE(numout,*) ' fhbri     : ', fhbri(ji,jj) 
                !
                !CALL lim_prt_state( kt, ji, jj, 2, '   ')
@@ -672,5 +661,5 @@
       !!                n : number of the option
       !!-------------------------------------------------------------------
-      INTEGER         , INTENT(in) ::   kt      ! ocean time step
+      INTEGER         , INTENT(in) ::   kt            ! ocean time step
       INTEGER         , INTENT(in) ::   ki, kj, kn    ! ocean gridpoint indices
       CHARACTER(len=*), INTENT(in) ::   cd1           !
@@ -759,5 +748,5 @@
                WRITE(numout,*) ' strength      : ', strength(ji,jj)
                WRITE(numout,*) ' d_u_ice_dyn   : ', d_u_ice_dyn(ji,jj), ' d_v_ice_dyn   : ', d_v_ice_dyn(ji,jj)
-               WRITE(numout,*) ' old_u_ice     : ', old_u_ice(ji,jj)  , ' old_v_ice     : ', old_v_ice(ji,jj)  
+               WRITE(numout,*) ' u_ice_b       : ', u_ice_b(ji,jj)    , ' v_ice_b       : ', v_ice_b(ji,jj)  
                WRITE(numout,*)
                
@@ -769,19 +758,19 @@
                   WRITE(numout,*) ' t_su       : ', t_su(ji,jj,jl)             , ' t_s        : ', t_s(ji,jj,1,jl)
                   WRITE(numout,*) ' sm_i       : ', sm_i(ji,jj,jl)             , ' o_i        : ', o_i(ji,jj,jl)
-                  WRITE(numout,*) ' a_i        : ', a_i(ji,jj,jl)              , ' old_a_i    : ', old_a_i(ji,jj,jl)   
+                  WRITE(numout,*) ' a_i        : ', a_i(ji,jj,jl)              , ' a_i_b      : ', a_i_b(ji,jj,jl)   
                   WRITE(numout,*) ' d_a_i_trp  : ', d_a_i_trp(ji,jj,jl)        , ' d_a_i_thd  : ', d_a_i_thd(ji,jj,jl) 
-                  WRITE(numout,*) ' v_i        : ', v_i(ji,jj,jl)              , ' old_v_i    : ', old_v_i(ji,jj,jl)   
+                  WRITE(numout,*) ' v_i        : ', v_i(ji,jj,jl)              , ' v_i_b      : ', v_i_b(ji,jj,jl)   
                   WRITE(numout,*) ' d_v_i_trp  : ', d_v_i_trp(ji,jj,jl)        , ' d_v_i_thd  : ', d_v_i_thd(ji,jj,jl) 
-                  WRITE(numout,*) ' v_s        : ', v_s(ji,jj,jl)              , ' old_v_s    : ', old_v_s(ji,jj,jl)  
+                  WRITE(numout,*) ' v_s        : ', v_s(ji,jj,jl)              , ' v_s_b      : ', v_s_b(ji,jj,jl)  
                   WRITE(numout,*) ' d_v_s_trp  : ', d_v_s_trp(ji,jj,jl)        , ' d_v_s_thd  : ', d_v_s_thd(ji,jj,jl)
-                  WRITE(numout,*) ' e_i1       : ', e_i(ji,jj,1,jl)/1.0e9      , ' old_ei1    : ', old_e_i(ji,jj,1,jl)/1.0e9 
+                  WRITE(numout,*) ' e_i1       : ', e_i(ji,jj,1,jl)/1.0e9      , ' ei1        : ', e_i_b(ji,jj,1,jl)/1.0e9 
                   WRITE(numout,*) ' de_i1_trp  : ', d_e_i_trp(ji,jj,1,jl)/1.0e9, ' de_i1_thd  : ', d_e_i_thd(ji,jj,1,jl)/1.0e9
-                  WRITE(numout,*) ' e_i2       : ', e_i(ji,jj,2,jl)/1.0e9      , ' old_ei2    : ', old_e_i(ji,jj,2,jl)/1.0e9  
+                  WRITE(numout,*) ' e_i2       : ', e_i(ji,jj,2,jl)/1.0e9      , ' ei2_b      : ', e_i_b(ji,jj,2,jl)/1.0e9  
                   WRITE(numout,*) ' de_i2_trp  : ', d_e_i_trp(ji,jj,2,jl)/1.0e9, ' de_i2_thd  : ', d_e_i_thd(ji,jj,2,jl)/1.0e9
-                  WRITE(numout,*) ' e_snow     : ', e_s(ji,jj,1,jl)            , ' old_e_snow : ', old_e_s(ji,jj,1,jl) 
+                  WRITE(numout,*) ' e_snow     : ', e_s(ji,jj,1,jl)            , ' e_snow_b   : ', e_s_b(ji,jj,1,jl) 
                   WRITE(numout,*) ' d_e_s_trp  : ', d_e_s_trp(ji,jj,1,jl)      , ' d_e_s_thd  : ', d_e_s_thd(ji,jj,1,jl)
-                  WRITE(numout,*) ' smv_i      : ', smv_i(ji,jj,jl)            , ' old_smv_i  : ', old_smv_i(ji,jj,jl)   
+                  WRITE(numout,*) ' smv_i      : ', smv_i(ji,jj,jl)            , ' smv_i_b    : ', smv_i_b(ji,jj,jl)   
                   WRITE(numout,*) ' d_smv_i_trp: ', d_smv_i_trp(ji,jj,jl)      , ' d_smv_i_thd: ', d_smv_i_thd(ji,jj,jl) 
-                  WRITE(numout,*) ' oa_i       : ', oa_i(ji,jj,jl)             , ' old_oa_i   : ', old_oa_i(ji,jj,jl)
+                  WRITE(numout,*) ' oa_i       : ', oa_i(ji,jj,jl)             , ' oa_i_b     : ', oa_i_b(ji,jj,jl)
                   WRITE(numout,*) ' d_oa_i_trp : ', d_oa_i_trp(ji,jj,jl)       , ' d_oa_i_thd : ', d_oa_i_thd(ji,jj,jl)
                END DO !jl
@@ -790,14 +779,8 @@
                WRITE(numout,*) ' - Heat / FW fluxes '
                WRITE(numout,*) '   ~~~~~~~~~~~~~~~~ '
-               WRITE(numout,*) ' emp        : ', emp      (ji,jj)
-               WRITE(numout,*) ' sfx        : ', sfx      (ji,jj)
-               WRITE(numout,*) ' sfx_thd    : ', sfx_thd(ji,jj)
-               WRITE(numout,*) ' sfx_bri    : ', sfx_bri  (ji,jj)
-               WRITE(numout,*) ' sfx_mec    : ', sfx_mec  (ji,jj)
-               WRITE(numout,*) ' sfx_res    : ', sfx_res(ji,jj)
-               WRITE(numout,*) ' fmmec      : ', fmmec    (ji,jj)
-               WRITE(numout,*) ' fhmec      : ', fhmec    (ji,jj)
-               WRITE(numout,*) ' fhbri      : ', fhbri    (ji,jj)
-               WRITE(numout,*) ' fheat_mec  : ', fheat_mec(ji,jj)
+               WRITE(numout,*) ' - Heat fluxes in and out the ice ***'
+               WRITE(numout,*) ' qsr_ini       : ', pfrld(ji,jj) * qsr(ji,jj) + SUM( a_i_b(ji,jj,:) * qsr_ice(ji,jj,:) )
+               WRITE(numout,*) ' qns_ini       : ', pfrld(ji,jj) * qns(ji,jj) + SUM( a_i_b(ji,jj,:) * qns_ice(ji,jj,:) )
+               WRITE(numout,*)
                WRITE(numout,*) 
                WRITE(numout,*) ' sst        : ', sst_m(ji,jj)  
@@ -829,27 +812,65 @@
                WRITE(numout,*) ' qsr       : ', qsr(ji,jj)
                WRITE(numout,*) ' qns       : ', qns(ji,jj)
-               WRITE(numout,*) ' fdtcn     : ', fdtcn(ji,jj)
-               WRITE(numout,*) ' qcmif     : ', qcmif(ji,jj) * r1_rdtice
-               WRITE(numout,*) ' qldif     : ', qldif(ji,jj) * r1_rdtice
+               WRITE(numout,*)
+               WRITE(numout,*) ' hfx_mass     : ', hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_snw(ji,jj) + hfx_res(ji,jj)
+               WRITE(numout,*) ' hfx_in       : ', hfx_in(ji,jj)
+               WRITE(numout,*) ' hfx_out      : ', hfx_out(ji,jj)
+               WRITE(numout,*) ' dhc          : ', diag_heat_dhc(ji,jj)              
+               WRITE(numout,*)
+               WRITE(numout,*) ' hfx_dyn      : ', hfx_dyn(ji,jj)
+               WRITE(numout,*) ' hfx_thd      : ', hfx_thd(ji,jj)
+               WRITE(numout,*) ' hfx_res      : ', hfx_res(ji,jj)
+               WRITE(numout,*) ' fhtur        : ', fhtur(ji,jj) 
+               WRITE(numout,*) ' qlead        : ', qlead(ji,jj) * r1_rdtice
                WRITE(numout,*)
                WRITE(numout,*) ' - Salt fluxes at bottom interface ***'
                WRITE(numout,*) ' emp       : ', emp    (ji,jj)
-               WRITE(numout,*) ' sfx_bri   : ', sfx_bri(ji,jj)
                WRITE(numout,*) ' sfx       : ', sfx    (ji,jj)
                WRITE(numout,*) ' sfx_res   : ', sfx_res(ji,jj)
-               WRITE(numout,*) ' sfx_mec   : ', sfx_mec(ji,jj)
-               WRITE(numout,*) ' - Heat fluxes at bottom interface ***'
-               WRITE(numout,*) ' fheat_res : ', fheat_res(ji,jj)
+               WRITE(numout,*) ' sfx_bri   : ', sfx_bri(ji,jj)
+               WRITE(numout,*) ' sfx_dyn   : ', sfx_dyn(ji,jj)
                WRITE(numout,*)
                WRITE(numout,*) ' - Momentum fluxes '
                WRITE(numout,*) ' utau      : ', utau(ji,jj) 
                WRITE(numout,*) ' vtau      : ', vtau(ji,jj)
-            ENDIF
+            ENDIF 
             WRITE(numout,*) ' '
             !
          END DO
       END DO
-
+      !
    END SUBROUTINE lim_prt_state
+   
+     
+   FUNCTION fice_cell_ave ( ptab )
+      !!--------------------------------------------------------------------------
+      !! * Compute average over categories, for grid cell (ice covered and free ocean)
+      !!--------------------------------------------------------------------------
+      REAL (wp), DIMENSION (jpi,jpj) :: fice_cell_ave
+      REAL (wp), DIMENSION (jpi,jpj,jpl), INTENT (in) :: ptab
+      INTEGER :: jl ! Dummy loop index
+      
+      fice_cell_ave (:,:) = 0.0_wp
+      
+      DO jl = 1, jpl
+         fice_cell_ave (:,:) = fice_cell_ave (:,:) &
+            &                  + a_i (:,:,jl) * ptab (:,:,jl)
+      END DO
+      
+   END FUNCTION fice_cell_ave
+   
+   
+   FUNCTION fice_ice_ave ( ptab )
+      !!--------------------------------------------------------------------------
+      !! * Compute average over categories, for ice covered part of grid cell
+      !!--------------------------------------------------------------------------
+      REAL (kind=wp), DIMENSION (jpi,jpj) :: fice_ice_ave
+      REAL (kind=wp), DIMENSION (jpi,jpj,jpl), INTENT(in) :: ptab
+
+      fice_ice_ave (:,:) = 0.0_wp
+      WHERE ( at_i (:,:) .GT. 0.0_wp ) fice_ice_ave (:,:) = fice_cell_ave ( ptab (:,:,:)) / at_i (:,:)
+
+   END FUNCTION fice_ice_ave
+
 
 #else
Index: branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
===================================================================
--- branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90	(revision 4771)
+++ branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90	(revision 5075)
@@ -53,4 +53,8 @@
    USE agrif_lim2_update
 # endif
+
+#if defined key_bdy 
+   USE bdyice_lim       ! unstructured open boundary data  (bdy_ice_lim routine)
+#endif
 
    IMPLICIT NONE
@@ -93,10 +97,11 @@
       !!
       INTEGER  ::   ji, jj   ! dummy loop indices
-      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice_os   ! albedo of the ice under overcast sky
-      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice_cs   ! albedo of ice under clear sky
-      REAL(wp), DIMENSION(:,:,:), POINTER :: zsist         ! surface ice temperature (K)
+      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_os   ! ice albedo under overcast sky
+      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_cs   ! ice albedo under clear sky
+      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice  ! mean ice albedo
+      REAL(wp), DIMENSION(:,:,:), POINTER :: zsist     ! ice surface temperature (K)
       !!----------------------------------------------------------------------
 
-      CALL wrk_alloc( jpi,jpj,1, zalb_ice_os, zalb_ice_cs, zsist )
+      CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )
 
       IF( kt == nit000 ) THEN
@@ -126,6 +131,8 @@
             DO jj = 2, jpj
                DO ji = 2, jpi   ! NO vector opt. possible
-                  u_oce(ji,jj) = 0.5_wp * ( ssu_m(ji-1,jj  ) + ssu_m(ji-1,jj-1) ) * tmu(ji,jj)
-                  v_oce(ji,jj) = 0.5_wp * ( ssv_m(ji  ,jj-1) + ssv_m(ji-1,jj-1) ) * tmu(ji,jj)
+                  u_oce(ji,jj) = 0.5_wp * ( ssu_m(ji-1,jj  ) * umask(ji-1,jj  ,1) &
+                     &           + ssu_m(ji-1,jj-1) * umask(ji-1,jj-1,1) ) * tmu(ji,jj)
+                  v_oce(ji,jj) = 0.5_wp * ( ssv_m(ji  ,jj-1) * vmask(ji  ,jj-1,1) &
+                     &           + ssv_m(ji-1,jj-1) * vmask(ji-1,jj-1,1) ) * tmu(ji,jj)
                END DO
             END DO
@@ -134,18 +141,29 @@
             !
          CASE( 'C' )                  !== C-grid ice dynamics :   U & V-points (same as ocean)
-            u_oce(:,:) = ssu_m(:,:)                     ! mean surface ocean current at ice velocity point
-            v_oce(:,:) = ssv_m(:,:)
+            u_oce(:,:) = ssu_m(:,:) * umask(:,:,1)                     ! mean surface ocean current at ice velocity point
+            v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1)
             !
          END SELECT
 
          ! ... masked sea surface freezing temperature [Kelvin] (set to rt0 over land)
-         tfu(:,:) = tfreez( sss_m ) +  rt0 
+         tfu(:,:) = eos_fzp( sss_m ) +  rt0 
 
          zsist (:,:,1) = sist (:,:) + rt0 * ( 1. - tmask(:,:,1) )
 
-         ! ... ice albedo (clear sky and overcast sky)
+         ! Ice albedo
+
          CALL albedo_ice( zsist, reshape( hicif, (/jpi,jpj,1/) ), &
                                  reshape( hsnif, (/jpi,jpj,1/) ), &
-                          zalb_ice_cs, zalb_ice_os )
+                          zalb_cs, zalb_os )
+
+         SELECT CASE( ksbc )
+         CASE( jp_core , jp_cpl )   ! CORE and COUPLED bulk formulations
+
+            ! albedo depends on cloud fraction because of non-linear spectral effects
+            zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
+            ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo 
+            ! (zalb_ice) is computed within the bulk routine
+
+         END SELECT
 
          ! ... Sea-ice surface boundary conditions output from bulk formulae :
@@ -163,6 +181,6 @@
          !
          SELECT CASE( ksbc )
-         CASE( 3 )           ! CLIO bulk formulation
-            CALL blk_ice_clio( zsist, zalb_ice_cs, zalb_ice_os,                         &
+         CASE( jp_clio )           ! CLIO bulk formulation
+            CALL blk_ice_clio( zsist, zalb_cs    , zalb_os    , zalb_ice   ,            &
                &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   &
                &                      qla_ice    , dqns_ice   , dqla_ice   ,            &
@@ -170,13 +188,13 @@
                &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  )
 
-         CASE( 4 )           ! CORE bulk formulation
-            CALL blk_ice_core( zsist, u_ice      , v_ice      , zalb_ice_cs,            &
+         CASE( jp_core )           ! CORE bulk formulation
+            CALL blk_ice_core( zsist, u_ice      , v_ice      , zalb_ice   ,            &
                &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   &
                &                      qla_ice    , dqns_ice   , dqla_ice   ,            &
                &                      tprecip    , sprecip    ,                         &
                &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  )
-            IF( ltrcdm2dc_ice )   CALL blk_ice_meanqsr( zalb_ice_cs, qsr_ice_mean, jpl )
-
-         CASE( 5 )           ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics)
+            IF( ltrcdm2dc_ice )   CALL blk_ice_meanqsr( zalb_ice, qsr_ice_mean, jpl )
+
+         CASE( jp_cpl )            ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics)
             CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )
          END SELECT
@@ -205,15 +223,16 @@
                            CALL lim_trp_2      ( kt )      ! Ice transport   ( Advection/diffusion )
            IF( ln_limdmp ) CALL lim_dmp_2      ( kt )      ! Ice damping 
+#if defined key_bdy
+                           CALL bdy_ice_lim( kt ) ! bdy ice thermo
+#endif
          END IF
-#if defined key_coupled
          !                                             ! Ice surface fluxes in coupled mode 
-         IF( ksbc == 5 )   THEN
+         IF( ksbc == jp_cpl )   THEN
             a_i(:,:,1)=fr_i
             CALL sbc_cpl_ice_flx( frld,                                              &
             !                                optional arguments, used only in 'mixed oce-ice' case
-            &                                             palbi = zalb_ice_cs, psst = sst_m, pist = zsist )
+            &                                             palbi = zalb_ice, psst = sst_m, pist = zsist )
             sprecip(:,:) = - emp_ice(:,:)   ! Ugly patch, WARNING, in coupled mode, sublimation included in snow (parsub = 0.)
          ENDIF
-#endif
                            CALL lim_thd_2      ( kt )      ! Ice thermodynamics 
                            CALL lim_sbc_flx_2  ( kt )      ! update surface ocean mass, heat & salt fluxes 
@@ -245,5 +264,5 @@
       IF( ln_limdyn    )   CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) )  ! using before instantaneous surf. currents
       !
-      CALL wrk_dealloc( jpi,jpj,1, zalb_ice_os, zalb_ice_cs, zsist )
+      CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )
       !
    END SUBROUTINE sbc_ice_lim_2
Index: branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
===================================================================
--- branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90	(revision 5075)
+++ branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90	(revision 5075)
@@ -0,0 +1,904 @@
+MODULE sbcisf
+   !!======================================================================
+   !!                       ***  MODULE  sbcisf  ***
+   !! Surface module :  update surface ocean boundary condition under ice
+   !!                   shelf
+   !!======================================================================
+   !! History :  3.2   !  2011-02  (C.Harris  ) Original code isf cav
+   !!            X.X   !  2006-02  (C. Wang   ) Original code bg03
+   !!            3.4   !  2013-03  (P. Mathiot) Merging
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   sbc_isf        : update sbc under ice shelf
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE eosbn2          ! equation of state
+   USE sbc_oce         ! surface boundary condition: ocean fields
+   USE lbclnk          !
+   USE iom             ! I/O manager library
+   USE in_out_manager  ! I/O manager
+   USE wrk_nemo        ! Memory allocation
+   USE timing          ! Timing
+   USE lib_fortran     ! glob_sum
+   USE zdfbfr
+   USE fldread         ! read input field at current time step
+
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sbc_isf, sbc_isf_div, sbc_isf_alloc  ! routine called in sbcmod and divcur
+
+   ! public in order to be able to output then 
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   risf_tsc_b, risf_tsc   
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fwfisf_b, fwfisf  !: evaporation damping   [kg/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qisf            !: net heat flux from ice shelf
+   REAL(wp), PUBLIC ::   rn_hisf_tbl                 !: thickness of top boundary layer [m]
+   LOGICAL , PUBLIC ::   ln_divisf                   !: flag to correct divergence 
+   INTEGER , PUBLIC ::   nn_isfblk                   !: 
+   INTEGER , PUBLIC ::   nn_gammablk                 !:
+   LOGICAL , PUBLIC ::   ln_conserve                 !:
+   REAL(wp), PUBLIC ::   rn_gammat0                  !: temperature exchange coeficient
+   REAL(wp), PUBLIC ::   rn_gammas0                  !: salinity    exchange coeficient 
+   REAL(wp), PUBLIC ::   rdivisf                     !: flag to test if fwf apply on divergence
+
+   REAL(wp)   , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  rzisf_tbl              !:depth of calving front (shallowest point) nn_isf ==2/3
+   REAL(wp)   , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  rhisf_tbl, rhisf_tbl_0 !:thickness of tbl
+   REAL(wp)   , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  r1_hisf_tbl            !:1/thickness of tbl
+   REAL(wp)   , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  ralpha                 !:proportion of bottom cell influenced by tbl 
+   REAL(wp)   , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  risfLeff               !:effective length (Leff) BG03 nn_isf==2
+   REAL(wp)   , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  ttbl, stbl, utbl, vtbl !:top boundary layer variable at T point
+#if defined key_agrif
+   ! AGRIF can not handle these arrays as integers. The reason is a mystery but problems avoided by declaring them as reals
+   REAL(wp),    PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  misfkt, misfkb         !:Level of ice shelf base
+                                                                                          !: (first wet level and last level include in the tbl)
+#else
+   INTEGER,    PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  misfkt, misfkb         !:Level of ice shelf base
+#endif
+
+
+   REAL(wp), PUBLIC, SAVE ::   rcpi   = 2000.0_wp     ! phycst ?
+   REAL(wp), PUBLIC, SAVE ::   kappa  = 1.54e-6_wp    ! phycst ?
+   REAL(wp), PUBLIC, SAVE ::   rhoisf = 920.0_wp      ! phycst ?
+   REAL(wp), PUBLIC, SAVE ::   tsurf  = -20.0_wp      ! phycst ?
+   REAL(wp), PUBLIC, SAVE ::   lfusisf= 0.334e6_wp    ! phycst ?
+
+!: Variable used in fldread to read the forcing file (nn_isf == 4 .OR. nn_isf == 3)
+   CHARACTER(len=100), PUBLIC ::   cn_dirisf  = './'    !: Root directory for location of ssr files
+   TYPE(FLD_N)       , PUBLIC ::   sn_qisf, sn_fwfisf     !: information about the runoff file to be read
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_qisf, sf_fwfisf
+   TYPE(FLD_N)       , PUBLIC ::   sn_rnfisf              !: information about the runoff file to be read
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_rnfisf           
+   TYPE(FLD_N)       , PUBLIC ::   sn_depmax_isf, sn_depmin_isf, sn_Leff_isf     !: information about the runoff file to be read
+   
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008)
+   !! $Id: sbcice_if.F90 1730 2009-11-16 14:34:19Z smasson $
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+ 
+  SUBROUTINE sbc_isf(kt)
+    INTEGER, INTENT(in)          ::   kt         ! ocean time step
+    INTEGER                      ::   ji, jj, jk, ijkmin, inum, ierror
+    INTEGER                      ::   ikt, ikb   ! top and bottom level of the isf boundary layer
+    REAL(wp)                     ::   rmin
+    REAL(wp)                     ::   zhk
+    CHARACTER(len=256)           ::   cfisf, cvarzisf, cvarhisf   ! name for isf file
+    CHARACTER(LEN=256)           :: cnameis                     ! name of iceshelf file
+    CHARACTER (LEN=32)           :: cvarLeff                    ! variable name for efficient Length scale
+    INTEGER           ::   ios           ! Local integer output status for namelist read
+      !
+      !!---------------------------------------------------------------------
+      NAMELIST/namsbc_isf/ nn_isfblk, rn_hisf_tbl, ln_divisf, ln_conserve, rn_gammat0, rn_gammas0, nn_gammablk, &
+                         & sn_fwfisf, sn_qisf, sn_rnfisf, sn_depmax_isf, sn_depmin_isf, sn_Leff_isf
+      !
+      !
+      !                                         ! ====================== !
+      IF( kt == nit000 ) THEN                   !  First call kt=nit000  !
+         !                                      ! ====================== !
+         REWIND( numnam_ref )              ! Namelist namsbc_rnf in reference namelist : Runoffs 
+         READ  ( numnam_ref, namsbc_isf, IOSTAT = ios, ERR = 901)
+901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_isf in reference namelist', lwp )
+
+         REWIND( numnam_cfg )              ! Namelist namsbc_rnf in configuration namelist : Runoffs
+         READ  ( numnam_cfg, namsbc_isf, IOSTAT = ios, ERR = 902 )
+902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_isf in configuration namelist', lwp )
+         IF(lwm) WRITE ( numond, namsbc_isf )
+
+
+         IF ( lwp ) WRITE(numout,*)
+         IF ( lwp ) WRITE(numout,*) 'sbc_isf: heat flux of the ice shelf'
+         IF ( lwp ) WRITE(numout,*) '~~~~~~~~~'
+         IF ( lwp ) WRITE(numout,*) 'sbcisf :' 
+         IF ( lwp ) WRITE(numout,*) '~~~~~~~~'
+         IF ( lwp ) WRITE(numout,*) '        nn_isf      = ', nn_isf
+         IF ( lwp ) WRITE(numout,*) '        nn_isfblk   = ', nn_isfblk
+         IF ( lwp ) WRITE(numout,*) '        rn_hisf_tbl = ', rn_hisf_tbl
+         IF ( lwp ) WRITE(numout,*) '        ln_divisf   = ', ln_divisf 
+         IF ( lwp ) WRITE(numout,*) '        nn_gammablk = ', nn_gammablk 
+         IF ( lwp ) WRITE(numout,*) '        rn_tfri2    = ', rn_tfri2 
+         IF (ln_divisf) THEN       ! keep it in the namelist ??? used true anyway as for runoff ? (PM)
+            rdivisf = 1._wp
+         ELSE
+            rdivisf = 0._wp
+         END IF
+         !
+         ! Allocate public variable
+         IF ( sbc_isf_alloc()  /= 0 )         CALL ctl_stop( 'STOP', 'sbc_isf : unable to allocate arrays' )
+         !
+         ! initialisation
+         qisf(:,:)        = 0._wp  ; fwfisf(:,:) = 0._wp
+         risf_tsc(:,:,:)  = 0._wp
+         !
+         ! define isf tbl tickness, top and bottom indice
+         IF      (nn_isf == 1) THEN
+            rhisf_tbl(:,:) = rn_hisf_tbl
+            misfkt(:,:)    = mikt(:,:)         ! same indice for bg03 et cav => used in isfdiv
+         ELSE IF ((nn_isf == 3) .OR. (nn_isf == 2)) THEN
+            ALLOCATE( sf_rnfisf(1), STAT=ierror )
+            ALLOCATE( sf_rnfisf(1)%fnow(jpi,jpj,1), sf_rnfisf(1)%fdta(jpi,jpj,1,2) )
+            CALL fld_fill( sf_rnfisf, (/ sn_rnfisf /), cn_dirisf, 'sbc_isf_init', 'read fresh water flux isf data', 'namsbc_isf' )
+
+            !: read effective lenght (BG03)
+            IF (nn_isf == 2) THEN
+               ! Read Data and save some integral values
+               CALL iom_open( sn_Leff_isf%clname, inum )
+               cvarLeff  = 'soLeff'               !: variable name for Efficient Length scale
+               CALL iom_get( inum, jpdom_data, cvarLeff, risfLeff , 1)
+               CALL iom_close(inum)
+               !
+               risfLeff = risfLeff*1000           !: convertion in m
+            END IF
+
+           ! read depth of the top and bottom of the isf top boundary layer (in this case, isf front depth and grounding line depth)
+            CALL iom_open( sn_depmax_isf%clname, inum )
+            cvarhisf = TRIM(sn_depmax_isf%clvar)
+            CALL iom_get( inum, jpdom_data, cvarhisf, rhisf_tbl, 1) !: depth of deepest point of the ice shelf base
+            CALL iom_close(inum)
+            !
+            CALL iom_open( sn_depmin_isf%clname, inum )
+            cvarzisf = TRIM(sn_depmin_isf%clvar)
+            CALL iom_get( inum, jpdom_data, cvarzisf, rzisf_tbl, 1) !: depth of shallowest point of the ice shelves base
+            CALL iom_close(inum)
+            !
+            rhisf_tbl(:,:) = rhisf_tbl(:,:) - rzisf_tbl(:,:)        !: tickness isf boundary layer
+
+           !! compute first level of the top boundary layer
+           DO ji = 1, jpi
+              DO jj = 1, jpj
+                  jk = 2
+                  DO WHILE ( jk .LE. mbkt(ji,jj) .AND. fsdepw(ji,jj,jk) < rzisf_tbl(ji,jj) ) ;  jk = jk + 1 ;  END DO
+                  misfkt(ji,jj) = jk-1
+               END DO
+            END DO
+
+         ELSE IF ( nn_isf == 4 ) THEN
+            ! as in nn_isf == 1
+            rhisf_tbl(:,:) = rn_hisf_tbl
+            misfkt(:,:)    = mikt(:,:)         ! same indice for bg03 et cav => used in isfdiv
+            
+            ! load variable used in fldread (use for temporal interpolation of isf fwf forcing)
+            ALLOCATE( sf_fwfisf(1), sf_qisf(1), STAT=ierror )
+            ALLOCATE( sf_fwfisf(1)%fnow(jpi,jpj,1), sf_fwfisf(1)%fdta(jpi,jpj,1,2) )
+            ALLOCATE( sf_qisf(1)%fnow(jpi,jpj,1), sf_qisf(1)%fdta(jpi,jpj,1,2) )
+            CALL fld_fill( sf_fwfisf, (/ sn_fwfisf /), cn_dirisf, 'sbc_isf_init', 'read fresh water flux isf data', 'namsbc_isf' )
+            !CALL fld_fill( sf_qisf  , (/ sn_qisf   /), cn_dirisf, 'sbc_isf_init', 'read heat flux isf data'       , 'namsbc_isf' )
+         END IF
+         
+         rhisf_tbl_0(:,:) = rhisf_tbl(:,:)
+
+         ! compute bottom level of isf tbl and thickness of tbl below the ice shelf
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+               ikt = misfkt(ji,jj)
+               ikb = misfkt(ji,jj)
+               ! thickness of boundary layer at least the top level thickness
+               rhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), fse3t_n(ji,jj,ikt))
+
+               ! determine the deepest level influenced by the boundary layer
+               ! test on tmask useless ?????
+               DO jk = ikt, mbkt(ji,jj)
+                  IF ( (SUM(fse3t_n(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk
+               END DO
+               rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(fse3t_n(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness.
+               misfkb(ji,jj) = ikb                                                  ! last wet level of the tbl
+               r1_hisf_tbl(ji,jj) = 1._wp / rhisf_tbl(ji,jj)
+
+               zhk           = SUM( fse3t(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj)  ! proportion of tbl cover by cell from ikt to ikb - 1
+               ralpha(ji,jj) = rhisf_tbl(ji,jj) * (1._wp - zhk ) / fse3t(ji,jj,ikb)  ! proportion of bottom cell influenced by boundary layer
+            END DO
+         END DO
+         
+      END IF
+
+      !                                            ! ---------------------------------------- !
+      IF( kt /= nit000 ) THEN                      !          Swap of forcing fields          !
+         !                                         ! ---------------------------------------- !
+         fwfisf_b  (:,:  ) = fwfisf  (:,:  )               ! Swap the ocean forcing fields except at nit000
+         risf_tsc_b(:,:,:) = risf_tsc(:,:,:)               ! where before fields are set at the end of the routine
+         !
+      ENDIF
+
+      IF( MOD( kt-1, nn_fsbc) == 0 ) THEN
+
+
+         ! compute salf and heat flux
+         IF (nn_isf == 1) THEN
+            ! realistic ice shelf formulation
+            ! compute T/S/U/V for the top boundary layer
+            CALL sbc_isf_tbl(tsn(:,:,:,jp_tem),ttbl(:,:),'T')
+            CALL sbc_isf_tbl(tsn(:,:,:,jp_sal),stbl(:,:),'T')
+            CALL sbc_isf_tbl(un(:,:,:),utbl(:,:),'U')
+            CALL sbc_isf_tbl(vn(:,:,:),vtbl(:,:),'V')
+            ! iom print
+            CALL iom_put('ttbl',ttbl(:,:))
+            CALL iom_put('stbl',stbl(:,:))
+            CALL iom_put('utbl',utbl(:,:))
+            CALL iom_put('vtbl',vtbl(:,:))
+            ! compute fwf and heat flux
+            CALL sbc_isf_cav (kt)
+
+         ELSE IF (nn_isf == 2) THEN
+            ! Beckmann and Goosse parametrisation 
+            stbl(:,:)   = soce
+            CALL sbc_isf_bg03(kt)
+
+         ELSE IF (nn_isf == 3) THEN
+            ! specified runoff in depth (Mathiot et al., XXXX in preparation)
+            CALL fld_read ( kt, nn_fsbc, sf_rnfisf   )
+            fwfisf(:,:) = - sf_rnfisf(1)%fnow(:,:,1)         ! fresh water flux from the isf (fwfisf <0 mean melting) 
+            qisf(:,:)   = fwfisf(:,:) * lfusisf              ! heat        flux
+            stbl(:,:)   = soce
+
+         ELSE IF (nn_isf == 4) THEN
+            ! specified fwf and heat flux forcing beneath the ice shelf
+            CALL fld_read ( kt, nn_fsbc, sf_fwfisf   )
+            !CALL fld_read ( kt, nn_fsbc, sf_qisf   )
+            fwfisf(:,:) = sf_fwfisf(1)%fnow(:,:,1)            ! fwf
+            qisf(:,:)   = fwfisf(:,:) * lfusisf              ! heat        flux
+            !qisf(:,:)   = sf_qisf(1)%fnow(:,:,1)              ! heat flux
+            stbl(:,:)   = soce
+
+         END IF
+         ! compute tsc due to isf
+         ! WARNING water add at temp = 0C, correction term is added in trasbc, maybe better here but need a 3D variable).
+         risf_tsc(:,:,jp_tem) = qisf(:,:) * r1_rau0_rcp !
+         
+         ! salt effect already take into account in vertical advection
+         risf_tsc(:,:,jp_sal) = (1.0_wp-rdivisf) * fwfisf(:,:) * stbl(:,:) * r1_rau0
+          
+         ! lbclnk
+         CALL lbc_lnk(risf_tsc(:,:,jp_tem),'T',1.)
+         CALL lbc_lnk(risf_tsc(:,:,jp_sal),'T',1.)
+         CALL lbc_lnk(fwfisf(:,:)   ,'T',1.)
+         CALL lbc_lnk(qisf(:,:)     ,'T',1.)
+
+         IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    !
+            IF( ln_rstart .AND.    &                     ! Restart: read in restart file
+                 & iom_varid( numror, 'fwf_isf_b', ldstop = .FALSE. ) > 0 ) THEN
+               IF(lwp) WRITE(numout,*) '          nit000-1 isf tracer content forcing fields read in the restart file'
+               CALL iom_get( numror, jpdom_autoglo, 'fwf_isf_b', fwfisf_b(:,:) )   ! before salt content isf_tsc trend
+               CALL iom_get( numror, jpdom_autoglo, 'isf_sc_b', risf_tsc_b(:,:,jp_sal) )   ! before salt content isf_tsc trend
+               CALL iom_get( numror, jpdom_autoglo, 'isf_hc_b', risf_tsc_b(:,:,jp_tem) )   ! before salt content isf_tsc trend
+            ELSE
+               fwfisf_b(:,:)    = fwfisf(:,:)
+               risf_tsc_b(:,:,:)= risf_tsc(:,:,:)
+            END IF
+         ENDIF
+         ! 
+         ! output
+         CALL iom_put('qisf'  , qisf)
+         IF( iom_use('fwfisf') )   CALL iom_put('fwfisf', fwfisf * stbl(:,:) / soce )
+      END IF
+  
+  END SUBROUTINE sbc_isf
+
+  INTEGER FUNCTION sbc_isf_alloc()
+      !!----------------------------------------------------------------------
+      !!               ***  FUNCTION sbc_isf_rnf_alloc  ***
+      !!----------------------------------------------------------------------
+      sbc_isf_alloc = 0       ! set to zero if no array to be allocated
+      IF( .NOT. ALLOCATED( qisf ) ) THEN
+         ALLOCATE(  risf_tsc(jpi,jpj,jpts), risf_tsc_b(jpi,jpj,jpts)              , &
+               &    qisf(jpi,jpj)     , fwfisf(jpi,jpj)     , fwfisf_b(jpi,jpj)   , &
+               &    rhisf_tbl(jpi,jpj), r1_hisf_tbl(jpi,jpj), rzisf_tbl(jpi,jpj)  , &
+               &    ttbl(jpi,jpj)     , stbl(jpi,jpj)       , utbl(jpi,jpj)       , &
+               &    vtbl(jpi, jpj)    , risfLeff(jpi,jpj)   , rhisf_tbl_0(jpi,jpj), &
+               &    ralpha(jpi,jpj)   , misfkt(jpi,jpj)     , misfkb(jpi,jpj)     , &
+               &    STAT= sbc_isf_alloc )
+         !
+         IF( lk_mpp                  )   CALL mpp_sum ( sbc_isf_alloc )
+         IF( sbc_isf_alloc /= 0 )   CALL ctl_warn('sbc_isf_alloc: failed to allocate arrays.')
+         !
+      ENDIF
+  END FUNCTION
+
+  SUBROUTINE sbc_isf_bg03(kt)
+   !!==========================================================================
+   !!                 *** SUBROUTINE sbcisf_bg03  ***
+   !! add net heat and fresh water flux from ice shelf melting
+   !! into the adjacent ocean using the parameterisation by
+   !! Beckmann and Goosse (2003), "A parameterization of ice shelf-ocean
+   !!     interaction for climate models", Ocean Modelling 5(2003) 157-170.
+   !!  (hereafter BG)
+   !!==========================================================================
+   !!----------------------------------------------------------------------
+   !!   sbc_isf_bg03      : routine called from sbcmod
+   !!----------------------------------------------------------------------
+   !!
+   !! ** Purpose   :   Add heat and fresh water fluxes due to ice shelf melting
+   !! ** Reference :   Beckmann et Goosse, 2003, Ocean Modelling
+   !!
+   !! History :
+   !!      !  06-02  (C. Wang) Original code
+   !!----------------------------------------------------------------------
+
+    INTEGER, INTENT ( in ) :: kt
+
+    INTEGER :: ji, jj, jk, jish  !temporary integer
+    INTEGER :: ijkmin
+    INTEGER :: ii, ij, ik 
+    INTEGER :: inum
+
+    REAL(wp) :: zt_sum      ! sum of the temperature between 200m and 600m
+    REAL(wp) :: zt_ave      ! averaged temperature between 200m and 600m
+    REAL(wp) :: zt_frz      ! freezing point temperature at depth z
+    REAL(wp) :: zpress      ! pressure to compute the freezing point in depth
+    
+    !!----------------------------------------------------------------------
+    IF ( nn_timing == 1 ) CALL timing_start('sbc_isf_bg03')
+     !
+
+    ! This test is false only in the very first time step of a run (JMM ???- Initialy build to skip 1rst year of run )
+    DO ji = 1, jpi
+       DO jj = 1, jpj
+          ik = misfkt(ji,jj)
+          !! Initialize arrays to 0 (each step)
+          zt_sum = 0.e0_wp
+          IF ( ik .GT. 1 ) THEN
+    ! 3. -----------the average temperature between 200m and 600m ---------------------
+             DO jk = misfkt(ji,jj),misfkb(ji,jj)
+             ! freezing point temperature  at ice shelf base BG eq. 2 (JMM sign pb ??? +7.64e-4 !!!)
+             ! after verif with UNESCO, wrong sign in BG eq. 2
+             ! Calculate freezing temperature
+                zpress = grav*rau0*fsdept(ji,jj,ik)*1.e-04 
+                zt_frz = eos_fzp(tsb(ji,jj,ik,jp_sal), zpress) 
+                zt_sum = zt_sum + (tsn(ji,jj,ik,jp_tem)-zt_frz) * fse3t(ji,jj,ik) * tmask(ji,jj,ik)  ! sum temp
+             ENDDO
+             zt_ave = zt_sum/rhisf_tbl(ji,jj) ! calcul mean value
+    
+    ! 4. ------------Net heat flux and fresh water flux due to the ice shelf
+          ! For those corresponding to zonal boundary    
+             qisf(ji,jj) = - rau0 * rcp * rn_gammat0 * risfLeff(ji,jj) * e1t(ji,jj) * zt_ave  &
+                         & / (e1t(ji,jj) * e2t(ji,jj)) * tmask(ji,jj,ik) 
+             
+             fwfisf(ji,jj) = qisf(ji,jj) / lfusisf          !fresh water flux kg/(m2s)                  
+             fwfisf(ji,jj) = fwfisf(ji,jj) * ( soce / stbl(ji,jj) )
+             !add to salinity trend
+          ELSE
+             qisf(ji,jj) = 0._wp ; fwfisf(ji,jj) = 0._wp
+          END IF
+       ENDDO
+    ENDDO
+    !
+    IF( nn_timing == 1 )  CALL timing_stop('sbc_isf_bg03')
+  END SUBROUTINE sbc_isf_bg03
+
+   SUBROUTINE sbc_isf_cav( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE sbc_isf_cav  ***
+      !!
+      !! ** Purpose :   handle surface boundary condition under ice shelf
+      !!
+      !! ** Method  : -
+      !!
+      !! ** Action  :   utau, vtau : remain unchanged
+      !!                taum, wndm : remain unchanged
+      !!                qns        : update heat flux below ice shelf
+      !!                emp, emps  : update freshwater flux below ice shelf
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in)          ::   kt         ! ocean time step
+      !
+      LOGICAL :: ln_isomip = .true.
+      REAL(wp), DIMENSION(:,:), POINTER       ::   zfrz,zpress,zti
+      REAL(wp), DIMENSION(:,:), POINTER       ::   zgammat2d, zgammas2d 
+      !REAL(wp), DIMENSION(:,:), POINTER ::   zqisf, zfwfisf
+      REAL(wp) ::   zlamb1, zlamb2, zlamb3
+      REAL(wp) ::   zeps1,zeps2,zeps3,zeps4,zeps6,zeps7
+      REAL(wp) ::   zaqe,zbqe,zcqe,zaqer,zdis,zsfrz,zcfac
+      REAL(wp) ::   zfwflx, zhtflx, zhtflx_b
+      REAL(wp) ::   zgammat, zgammas
+      REAL(wp) ::   zeps   =  -1.e-20_wp        !==   Local constant initialization   ==!
+      INTEGER  ::   ji, jj     ! dummy loop indices
+      INTEGER  ::   ii0, ii1, ij0, ij1   ! temporary integers
+      INTEGER  ::   ierror     ! return error code
+      LOGICAL  ::   lit=.TRUE.
+      INTEGER  ::   nit
+      !!---------------------------------------------------------------------
+      !
+      ! coeficient for linearisation of tfreez
+      zlamb1=-0.0575
+      zlamb2=0.0901
+      zlamb3=-7.61e-04
+      IF( nn_timing == 1 )  CALL timing_start('sbc_isf_cav')
+      !
+      CALL wrk_alloc( jpi,jpj, zfrz,zpress,zti, zgammat2d, zgammas2d )
+
+      zcfac=0.0_wp 
+      IF (ln_conserve)  zcfac=1.0_wp
+      zpress(:,:)=0.0_wp
+      zgammat2d(:,:)=0.0_wp
+      zgammas2d(:,:)=0.0_wp
+      !
+      !
+!CDIR COLLAPSE
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ! Crude approximation for pressure (but commonly used)
+            ! 1e-04 to convert from Pa to dBar
+            zpress(ji,jj)=grav*rau0*fsdepw(ji,jj,mikt(ji,jj))*1.e-04
+            !
+         END DO
+      END DO
+
+! Calculate in-situ temperature (ref to surface)
+      zti(:,:)=tinsitu( ttbl, stbl, zpress )
+! Calculate freezing temperature
+      zfrz(:,:)=eos_fzp( sss_m(:,:), zpress )
+
+      
+      zhtflx=0._wp ; zfwflx=0._wp
+      IF (nn_isfblk == 1) THEN
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF (mikt(ji,jj) > 1 ) THEN
+                  nit = 1; lit = .TRUE.; zgammat=rn_gammat0; zgammas=rn_gammas0; zhtflx_b=0._wp
+                  DO WHILE ( lit )
+! compute gamma
+                     CALL sbc_isf_gammats(zgammat, zgammas, zhtflx, zfwflx, ji, jj, lit)
+! zhtflx is upward heat flux (out of ocean)
+                     zhtflx = zgammat*rcp*rau0*(zti(ji,jj)-zfrz(ji,jj))
+! zwflx is upward water flux
+                     zfwflx = - zhtflx/lfusisf
+! test convergence and compute gammat
+                     IF ( (zhtflx - zhtflx_b) .LE. 0.01 ) lit = .FALSE.
+
+                     nit = nit + 1
+                     IF (nit .GE. 100) THEN
+                        !WRITE(numout,*) "sbcisf : too many iteration ... ", zhtflx, zhtflx_b,zgammat, rn_gammat0, rn_tfri2, nn_gammablk, ji,jj
+                        !WRITE(numout,*) "sbcisf : too many iteration ... ", (zhtflx - zhtflx_b)/zhtflx
+                        CALL ctl_stop( 'STOP', 'sbc_isf_hol99 : too many iteration ...' )
+                     END IF
+! save gammat and compute zhtflx_b
+                     zgammat2d(ji,jj)=zgammat
+                     zhtflx_b = zhtflx
+                  END DO
+
+                  qisf(ji,jj) = - zhtflx
+! For genuine ISOMIP protocol this should probably be something like
+                  fwfisf(ji,jj) = zfwflx  * ( soce / MAX(stbl(ji,jj),zeps))
+               ELSE
+                  fwfisf(ji,jj) = 0._wp
+                  qisf(ji,jj)   = 0._wp
+               END IF
+            !
+            END DO
+         END DO
+
+      ELSE IF (nn_isfblk == 2 ) THEN
+
+! More complicated 3 equation thermodynamics as in MITgcm
+!CDIR COLLAPSE
+         DO jj = 2, jpj
+            DO ji = 2, jpi
+               IF (mikt(ji,jj) > 1 ) THEN
+                  nit=1; lit=.TRUE.; zgammat=rn_gammat0; zgammas=rn_gammas0; zhtflx_b=0._wp; zhtflx=0._wp
+                  DO WHILE ( lit )
+                     CALL sbc_isf_gammats(zgammat, zgammas, zhtflx, zfwflx, ji, jj, lit)
+
+                     zeps1=rcp*rau0*zgammat
+                     zeps2=lfusisf*rau0*zgammas
+                     zeps3=rhoisf*rcpi*kappa/risfdep(ji,jj)
+                     zeps4=zlamb2+zlamb3*risfdep(ji,jj)
+                     zeps6=zeps4-zti(ji,jj)
+                     zeps7=zeps4-tsurf
+                     zaqe=zlamb1 * (zeps1 + zeps3)
+                     zaqer=0.5/zaqe
+                     zbqe=zeps1*zeps6+zeps3*zeps7-zeps2
+                     zcqe=zeps2*stbl(ji,jj)
+                     zdis=zbqe*zbqe-4.0*zaqe*zcqe               
+! Presumably zdis can never be negative because gammas is very small compared to gammat
+                     zsfrz=(-zbqe-SQRT(zdis))*zaqer
+                     IF (zsfrz .lt. 0.0) zsfrz=(-zbqe+SQRT(zdis))*zaqer
+                     zfrz(ji,jj)=zeps4+zlamb1*zsfrz
+  
+! zfwflx is upward water flux
+                     zfwflx= rau0 * zgammas * ( (zsfrz-stbl(ji,jj)) / zsfrz )
+! zhtflx is upward heat flux (out of ocean)
+! If non conservative we have zcfac=0.0 so zhtflx is as ISOMIP but with different zfrz value
+                     zhtflx = ( zgammat*rau0 - zcfac*zfwflx ) * rcp * (zti(ji,jj) - zfrz(ji,jj) ) 
+! zwflx is upward water flux
+! If non conservative we have zcfac=0.0 so what follows is then zfwflx*sss_m/zsfrz
+                     zfwflx = ( zgammas*rau0 - zcfac*zfwflx ) * (zsfrz - stbl(ji,jj)) / stbl(ji,jj)
+! test convergence and compute gammat
+                     IF (( zhtflx - zhtflx_b) .LE. 0.01 ) lit = .FALSE.
+
+                     nit = nit + 1
+                     IF (nit .GE. 51) THEN
+                        WRITE(numout,*) "sbcisf : too many iteration ... ", &
+                            &  zhtflx, zhtflx_b, zgammat, zgammas, nn_gammablk, ji, jj, mikt(ji,jj), narea
+                        CALL ctl_stop( 'STOP', 'sbc_isf_hol99 : too many iteration ...' )
+                     END IF
+! save gammat and compute zhtflx_b
+                     zgammat2d(ji,jj)=zgammat
+                     zgammas2d(ji,jj)=zgammas
+                     zhtflx_b = zhtflx
+
+                  END DO
+! If non conservative we have zcfac=0.0 so zhtflx is as ISOMIP but with different zfrz value
+                  qisf(ji,jj) = - zhtflx 
+! If non conservative we have zcfac=0.0 so what follows is then zfwflx*sss_m/zsfrz
+                  fwfisf(ji,jj) = zfwflx 
+               ELSE
+                  fwfisf(ji,jj) = 0._wp
+                  qisf(ji,jj)   = 0._wp
+               ENDIF
+               !
+            END DO
+         END DO
+      ENDIF
+      ! lbclnk
+      CALL lbc_lnk(zgammas2d(:,:),'T',1.)
+      CALL lbc_lnk(zgammat2d(:,:),'T',1.)
+      ! output
+      CALL iom_put('isfgammat', zgammat2d)
+      CALL iom_put('isfgammas', zgammas2d)
+         !
+      !CALL wrk_dealloc( jpi,jpj, zfrz,zpress,zti, zqisf, zfwfisf  )
+      CALL wrk_dealloc( jpi,jpj, zfrz,zpress,zti, zgammat2d, zgammas2d )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('sbc_isf_cav')
+
+   END SUBROUTINE sbc_isf_cav
+
+   SUBROUTINE sbc_isf_gammats(gt, gs, zqhisf, zqwisf, ji, jj, lit )
+      !!----------------------------------------------------------------------
+      !! ** Purpose    : compute the coefficient echange for heat flux
+      !!
+      !! ** Method     : gamma assume constant or depends of u* and stability
+      !!
+      !! ** References : Holland and Jenkins, 1999, JPO, p1787-1800, eq 14
+      !!                Jenkins et al., 2010, JPO, p2298-2312
+      !!---------------------------------------------------------------------
+      REAL(wp), INTENT(inout) :: gt, gs, zqhisf, zqwisf
+      INTEGER , INTENT(in)    :: ji,jj
+      LOGICAL , INTENT(inout) :: lit
+
+      INTEGER  :: ikt                 ! loop index
+      REAL(wp) :: zut, zvt, zustar           ! U, V at T point and friction velocity
+      REAL(wp) :: zdku, zdkv                 ! U, V shear 
+      REAL(wp) :: zPr, zSc, zRc              ! Prandtl, Scmidth and Richardson number 
+      REAL(wp) :: zmob, zmols                ! Monin Obukov length, coriolis factor at T point
+      REAL(wp) :: zbuofdep, zhnu             ! Bouyancy length scale, sublayer tickness
+      REAL(wp) :: zhmax                      ! limitation of mol
+      REAL(wp) :: zetastar                   ! stability parameter
+      REAL(wp) :: zgmolet, zgmoles, zgturb   ! contribution of modelecular sublayer and turbulence 
+      REAL(wp) :: zcoef                      ! temporary coef
+      REAL(wp) :: zdep
+      REAL(wp), PARAMETER :: zxsiN = 0.052   ! dimensionless constant
+      REAL(wp), PARAMETER :: epsln = 1.0e-20 ! a small positive number
+      REAL(wp), PARAMETER :: znu   = 1.95e-6 ! kinamatic viscosity of sea water (m2.s-1)
+      REAL(wp) ::   rcs      = 1.0e-3_wp        ! conversion: mm/s ==> m/s
+      REAL(wp), DIMENSION(2) :: zts, zab
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_gammablk == 0 ) THEN
+      !! gamma is constant (specified in namelist)
+         gt = rn_gammat0
+         gs = rn_gammas0
+         lit = .FALSE.
+      ELSE IF ( nn_gammablk == 1 ) THEN
+      !! gamma is assume to be proportional to u* 
+      !! WARNING in case of Losh 2008 tbl parametrization, 
+      !! you have to used the mean value of u in the boundary layer) 
+      !! not yet coded
+      !! Jenkins et al., 2010, JPO, p2298-2312
+         ikt = mikt(ji,jj)
+      !! Compute U and V at T points
+   !      zut = 0.5 * ( utbl(ji-1,jj  ) + utbl(ji,jj) )
+   !      zvt = 0.5 * ( vtbl(ji  ,jj-1) + vtbl(ji,jj) )
+          zut = utbl(ji,jj)
+          zvt = vtbl(ji,jj)
+
+      !! compute ustar
+         zustar = SQRT( rn_tfri2 * (zut * zut + zvt * zvt) )
+      !! Compute mean value over the TBL
+
+      !! Compute gammats
+         gt = zustar * rn_gammat0
+         gs = zustar * rn_gammas0
+         lit = .FALSE.
+      ELSE IF ( nn_gammablk == 2 ) THEN
+      !! gamma depends of stability of boundary layer
+      !! WARNING in case of Losh 2008 tbl parametrization, 
+      !! you have to used the mean value of u in the boundary layer) 
+      !! not yet coded
+      !! Holland and Jenkins, 1999, JPO, p1787-1800, eq 14
+      !! as MOL depends of flux and flux depends of MOL, best will be iteration (TO DO)
+               ikt = mikt(ji,jj)
+
+      !! Compute U and V at T points
+               zut = 0.5 * ( utbl(ji-1,jj  ) + utbl(ji,jj) )
+               zvt = 0.5 * ( vtbl(ji  ,jj-1) + vtbl(ji,jj) )
+
+      !! compute ustar
+               zustar = SQRT( rn_tfri2 * (zut * zut + zvt * zvt) )
+               IF (zustar == 0._wp) THEN           ! only for kt = 1 I think
+                 gt = rn_gammat0
+                 gs = rn_gammas0
+               ELSE
+      !! compute Rc number (as done in zdfric.F90)
+               zcoef = 0.5 / fse3w(ji,jj,ikt)
+               !                                            ! shear of horizontal velocity
+               zdku = zcoef * (  un(ji-1,jj  ,ikt  ) + un(ji,jj,ikt  )   &
+                  &             -un(ji-1,jj  ,ikt+1) - un(ji,jj,ikt+1)  )
+               zdkv = zcoef * (  vn(ji  ,jj-1,ikt  ) + vn(ji,jj,ikt  )   &
+                  &             -vn(ji  ,jj-1,ikt+1) - vn(ji,jj,ikt+1)  )
+               !                                            ! richardson number (minimum value set to zero)
+               zRc = rn2(ji,jj,ikt+1) / ( zdku*zdku + zdkv*zdkv + 1.e-20 )
+
+      !! compute Pr and Sc number (can be improved)
+               zPr =   13.8
+               zSc = 2432.0
+
+      !! compute gamma mole
+               zgmolet = 12.5 * zPr ** (2.0/3.0) - 6.0
+               zgmoles = 12.5 * zSc ** (2.0/3.0) -6.0
+
+      !! compute bouyancy 
+               zts(jp_tem) = ttbl(ji,jj)
+               zts(jp_sal) = stbl(ji,jj)
+               zdep        = fsdepw(ji,jj,ikt)
+               !
+               CALL eos_rab( zts, zdep, zab )
+                  !
+      !! compute length scale 
+               zbuofdep = grav * ( zab(jp_tem) * zqhisf - zab(jp_sal) * zqwisf )  !!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      !! compute Monin Obukov Length
+               ! Maximum boundary layer depth
+               zhmax = fsdept(ji,jj,mbkt(ji,jj)) - fsdepw(ji,jj,mikt(ji,jj)) -0.001
+               ! Compute Monin obukhov length scale at the surface and Ekman depth:
+               zmob   = zustar ** 3 / (vkarmn * (zbuofdep + epsln))
+               zmols  = SIGN(1._wp, zmob) * MIN(ABS(zmob), zhmax) * tmask(ji,jj,ikt)
+
+      !! compute eta* (stability parameter)
+               zetastar = 1 / ( SQRT(1 + MAX(zxsiN * zustar / ( ABS(ff(ji,jj)) * zmols * zRc ), 0.0)))
+
+      !! compute the sublayer thickness
+               zhnu = 5 * znu / zustar
+      !! compute gamma turb
+               zgturb = 1/vkarmn * LOG(zustar * zxsiN * zetastar * zetastar / ( ABS(ff(ji,jj)) * zhnu )) &
+               &      + 1 / ( 2 * zxsiN * zetastar ) - 1/vkarmn
+
+      !! compute gammats
+               gt = zustar / (zgturb + zgmolet)
+               gs = zustar / (zgturb + zgmoles)
+               END IF
+      END IF
+
+   END SUBROUTINE
+
+   SUBROUTINE sbc_isf_tbl( varin, varout, cptin )
+      !!----------------------------------------------------------------------
+      !!                  ***  SUBROUTINE sbc_isf_tbl  ***
+      !!
+      !! ** Purpose : compute mean T/S/U/V in the boundary layer 
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(in) :: varin
+      REAL(wp), DIMENSION(:,:)  , INTENT(out):: varout
+      
+      CHARACTER(len=1), INTENT(in) :: cptin ! point of variable in/out
+
+      REAL(wp) :: ze3, zhk
+      REAL(wp), DIMENSION(:,:), POINTER :: zikt
+
+      INTEGER :: ji,jj,jk
+      INTEGER :: ikt,ikb
+      INTEGER, DIMENSION(:,:), POINTER :: mkt, mkb
+
+      CALL wrk_alloc( jpi,jpj, mkt, mkb  )
+      CALL wrk_alloc( jpi,jpj, zikt )
+
+      ! get first and last level of tbl
+      mkt(:,:) = misfkt(:,:)
+      mkb(:,:) = misfkb(:,:)
+
+      varout(:,:)=0._wp
+      DO jj = 2,jpj
+         DO ji = 2,jpi
+            IF (ssmask(ji,jj) == 1) THEN
+               ikt = mkt(ji,jj)
+               ikb = mkb(ji,jj)
+
+               ! level fully include in the ice shelf boundary layer
+               DO jk = ikt, ikb - 1
+                  ze3 = fse3t_n(ji,jj,jk)
+                  IF (cptin == 'T' ) varout(ji,jj) = varout(ji,jj) + varin(ji,jj,jk) * r1_hisf_tbl(ji,jj) * ze3
+                  IF (cptin == 'U' ) varout(ji,jj) = varout(ji,jj) + 0.5_wp * (varin(ji,jj,jk) + varin(ji-1,jj,jk)) &
+                     &                                                       * r1_hisf_tbl(ji,jj) * ze3
+                  IF (cptin == 'V' ) varout(ji,jj) = varout(ji,jj) + 0.5_wp * (varin(ji,jj,jk) + varin(ji,jj-1,jk)) &
+                     &                                                       * r1_hisf_tbl(ji,jj) * ze3
+               END DO
+
+               ! level partially include in ice shelf boundary layer 
+               zhk = SUM( fse3t_n(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj)
+               IF (cptin == 'T') &
+                   &  varout(ji,jj) = varout(ji,jj) + varin(ji,jj,ikb) * (1._wp - zhk)
+               IF (cptin == 'U') &
+                   &  varout(ji,jj) = varout(ji,jj) + 0.5_wp * (varin(ji,jj,ikb) + varin(ji-1,jj,ikb)) * (1._wp - zhk)
+               IF (cptin == 'V') &
+                   &  varout(ji,jj) = varout(ji,jj) + 0.5_wp * (varin(ji,jj,ikb) + varin(ji,jj-1,ikb)) * (1._wp - zhk)
+            END IF
+         END DO
+      END DO
+
+      CALL wrk_dealloc( jpi,jpj, mkt, mkb )      
+      CALL wrk_dealloc( jpi,jpj, zikt ) 
+
+      IF (cptin == 'T') CALL lbc_lnk(varout,'T',1.)
+      IF (cptin == 'U' .OR. cptin == 'V') CALL lbc_lnk(varout,'T',-1.)
+
+   END SUBROUTINE sbc_isf_tbl
+      
+
+   SUBROUTINE sbc_isf_div( phdivn )
+      !!----------------------------------------------------------------------
+      !!                  ***  SUBROUTINE sbc_isf_div  ***
+      !!       
+      !! ** Purpose :   update the horizontal divergence with the runoff inflow
+      !!
+      !! ** Method  :   
+      !!                CAUTION : risf_tsc(:,:,jp_sal) is negative (outflow) increase the 
+      !!                          divergence and expressed in m/s
+      !!
+      !! ** Action  :   phdivn   decreased by the runoff inflow
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   phdivn   ! horizontal divergence
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   ikt, ikb 
+      INTEGER  ::   nk_isf
+      REAL(wp)     ::   zhk, z1_hisf_tbl, zhisf_tbl
+      REAL(wp)     ::   zfact     ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      zfact   = 0.5_wp
+      !
+      IF (lk_vvl) THEN     ! need to re compute level distribution of isf fresh water
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+               ikt = misfkt(ji,jj)
+               ikb = misfkt(ji,jj)
+               ! thickness of boundary layer at least the top level thickness
+               rhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), fse3t(ji,jj,ikt))
+
+               ! determine the deepest level influenced by the boundary layer
+               ! test on tmask useless ?????
+               DO jk = ikt, mbkt(ji,jj)
+!                  IF ( (SUM(fse3t(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk
+               END DO
+               rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(fse3t(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness.
+               misfkb(ji,jj) = ikb                                                  ! last wet level of the tbl
+               r1_hisf_tbl(ji,jj) = 1._wp / rhisf_tbl(ji,jj)
+
+               zhk           = SUM( fse3t(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj)  ! proportion of tbl cover by cell from ikt to ikb - 1
+               ralpha(ji,jj) = rhisf_tbl(ji,jj) * (1._wp - zhk ) / fse3t(ji,jj,ikb)  ! proportion of bottom cell influenced by boundary layer
+            END DO
+         END DO
+      END IF ! vvl case
+      !
+      DO jj = 1,jpj
+         DO ji = 1,jpi
+               ikt = misfkt(ji,jj)
+               ikb = misfkb(ji,jj)
+               ! level fully include in the ice shelf boundary layer
+               DO jk = ikt, ikb - 1
+                  phdivn(ji,jj,jk) = phdivn(ji,jj,jk) + ( fwfisf(ji,jj) + fwfisf_b(ji,jj) ) &
+                    &               * r1_hisf_tbl(ji,jj) * r1_rau0 * zfact
+               END DO
+               ! level partially include in ice shelf boundary layer 
+               phdivn(ji,jj,ikb) = phdivn(ji,jj,ikb) + ( fwfisf(ji,jj) &
+                  &             + fwfisf_b(ji,jj) ) * r1_hisf_tbl(ji,jj) * r1_rau0 * zfact * ralpha(ji,jj) 
+            !==   ice shelf melting mass distributed over several levels   ==!
+         END DO
+      END DO
+      !
+   END SUBROUTINE sbc_isf_div
+                        
+   FUNCTION tinsitu( ptem, psal, ppress ) RESULT( pti )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_init  ***
+      !!
+      !! ** Purpose :   Compute the in-situ temperature [Celcius]
+      !!
+      !! ** Method  :   
+      !!
+      !! Reference  :   Bryden,h.,1973,deep-sea res.,20,401-408
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   ptem   ! potential temperature [Celcius]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity             [psu]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   ppress ! pressure             [dBar]
+      REAL(wp), DIMENSION(:,:), POINTER           ::   pti    ! in-situ temperature [Celcius]
+!      REAL(wp) :: fsatg
+!      REAL(wp) :: pfps, pfpt, pfphp 
+      REAL(wp) :: zt, zs, zp, zh, zq, zxk
+      INTEGER  :: ji, jj            ! dummy loop indices
+      !
+      CALL wrk_alloc( jpi,jpj, pti  )
+      ! 
+      DO jj=1,jpj
+         DO ji=1,jpi
+            zh = ppress(ji,jj)
+! Theta1
+            zt = ptem(ji,jj)
+            zs = psal(ji,jj)
+            zp = 0.0
+            zxk= zh * fsatg( zs, zt, zp )
+            zt = zt + 0.5 * zxk
+            zq = zxk
+! Theta2
+            zp = zp + 0.5 * zh
+            zxk= zh*fsatg( zs, zt, zp )
+            zt = zt + 0.29289322 * ( zxk - zq )
+            zq = 0.58578644 * zxk + 0.121320344 * zq
+! Theta3
+            zxk= zh * fsatg( zs, zt, zp )
+            zt = zt + 1.707106781 * ( zxk - zq )
+            zq = 3.414213562 * zxk - 4.121320344 * zq
+! Theta4
+            zp = zp + 0.5 * zh
+            zxk= zh * fsatg( zs, zt, zp )
+            pti(ji,jj) = zt + ( zxk - 2.0 * zq ) / 6.0
+         END DO
+      END DO
+      !
+      CALL wrk_dealloc( jpi,jpj, pti  )
+      !
+   END FUNCTION tinsitu
+   !
+   FUNCTION fsatg( pfps, pfpt, pfphp )
+      !!----------------------------------------------------------------------
+      !!                 ***  FUNCTION fsatg  ***
+      !!
+      !! ** Purpose    :   Compute the Adiabatic laspse rate [Celcius].[decibar]^-1
+      !!
+      !! ** Reference  :   Bryden,h.,1973,deep-sea res.,20,401-408
+      !! 
+      !! ** units      :   pressure        pfphp    decibars
+      !!                   temperature     pfpt     deg celsius (ipts-68)
+      !!                   salinity        pfps     (ipss-78)
+      !!                   adiabatic       fsatg    deg. c/decibar
+      !!----------------------------------------------------------------------
+      REAL(wp) :: pfps, pfpt, pfphp 
+      REAL(wp) :: fsatg
+      !
+      fsatg = (((-2.1687e-16*pfpt+1.8676e-14)*pfpt-4.6206e-13)*pfphp         &
+        &    +((2.7759e-12*pfpt-1.1351e-10)*(pfps-35.)+((-5.4481e-14*pfpt    &
+        &    +8.733e-12)*pfpt-6.7795e-10)*pfpt+1.8741e-8))*pfphp             &
+        &    +(-4.2393e-8*pfpt+1.8932e-6)*(pfps-35.)                         &
+        &    +((6.6228e-10*pfpt-6.836e-8)*pfpt+8.5258e-6)*pfpt+3.5803e-5
+      !
+    END FUNCTION fsatg
+    !!======================================================================
+END MODULE sbcisf
Index: branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
===================================================================
--- branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90	(revision 4771)
+++ branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90	(revision 5075)
@@ -37,7 +37,7 @@
    USE sbcice_cice      ! surface boundary condition: CICE    sea-ice model
    USE sbccpl           ! surface boundary condition: coupled florulation
-   USE cpl_oasis3, ONLY:lk_cpl      ! are we in coupled mode?
    USE sbcssr           ! surface boundary condition: sea surface restoring
    USE sbcrnf           ! surface boundary condition: runoffs
+   USE sbcisf           ! surface boundary condition: ice shelf
    USE sbcfwb           ! surface boundary condition: freshwater budget
    USE closea           ! closed sea
@@ -82,7 +82,7 @@
       INTEGER ::   icpt   ! local integer
       !!
-      NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx,  ln_blk_clio, ln_blk_core, ln_cpl,   &
+      NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx,  ln_blk_clio, ln_blk_core,           &
          &             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, nn_lsm, cn_iceflx
+         &             ln_ssr    ,  nn_isf , nn_fwb    , ln_cdgw , ln_wave , ln_sdw, nn_lsm, nn_limflx
       INTEGER  ::   ios
       !!----------------------------------------------------------------------
@@ -123,6 +123,6 @@
          WRITE(numout,*) '              CORE bulk  formulation                     ln_blk_core = ', ln_blk_core
          WRITE(numout,*) '              MFS  bulk  formulation                     ln_blk_mfs  = ', ln_blk_mfs
-         WRITE(numout,*) '              coupled    formulation (T if key_sbc_cpl)  ln_cpl      = ', ln_cpl
-         WRITE(numout,*) '              Flux handling over ice categories          cn_iceflx   = ', TRIM (cn_iceflx)
+         WRITE(numout,*) '              coupled    formulation (T if key_oasis3)   lk_cpl      = ', lk_cpl
+         WRITE(numout,*) '              Multicategory heat flux formulation (LIM3) nn_limflx   = ', nn_limflx
          WRITE(numout,*) '           Misc. options of sbc : '
          WRITE(numout,*) '              Patm gradient added in ocean & ice Eqs.    ln_apr_dyn  = ', ln_apr_dyn
@@ -131,4 +131,5 @@
          WRITE(numout,*) '              daily mean to diurnal cycle qsr            ln_dm2dc    = ', ln_dm2dc 
          WRITE(numout,*) '              runoff / runoff mouths                     ln_rnf      = ', ln_rnf
+         WRITE(numout,*) '              iceshelf formulation                       nn_isf      = ', nn_isf
          WRITE(numout,*) '              Sea Surface Restoring on SST and/or SSS    ln_ssr      = ', ln_ssr
          WRITE(numout,*) '              FreshWater Budget control  (=0/1/2)        nn_fwb      = ', nn_fwb
@@ -137,20 +138,15 @@
       ENDIF
 
-      !   Flux handling over ice categories
-#if defined key_coupled 
-      SELECT CASE ( TRIM (cn_iceflx))
-      CASE ('ave')
-         ln_iceflx_ave    = .TRUE.
-         ln_iceflx_linear = .FALSE.
-      CASE ('linear')
-         ln_iceflx_ave    = .FALSE.
-         ln_iceflx_linear = .TRUE.
-      CASE default
-         ln_iceflx_ave    = .FALSE.
-         ln_iceflx_linear = .FALSE.
+      ! LIM3 Multi-category heat flux formulation
+      SELECT CASE ( nn_limflx)
+      CASE ( -1 )
+         IF(lwp) WRITE(numout,*) '              Use of per-category fluxes (nn_limflx = -1) '
+      CASE ( 0  )
+         IF(lwp) WRITE(numout,*) '              Average per-category fluxes (nn_limflx = 0) ' 
+      CASE ( 1  )
+         IF(lwp) WRITE(numout,*) '              Average then redistribute per-category fluxes (nn_limflx = 1) '
+      CASE ( 2  )
+         IF(lwp) WRITE(numout,*) '              Redistribute a single flux over categories (nn_limflx = 2) '
       END SELECT
-      IF(lwp) WRITE(numout,*) '              Fluxes averaged over all ice categories         ln_iceflx_ave    = ', ln_iceflx_ave
-      IF(lwp) WRITE(numout,*) '              Fluxes distributed linearly over ice categories ln_iceflx_linear = ', ln_iceflx_linear
-#endif
       !
 #if defined key_top && ! defined key_offline
@@ -180,4 +176,8 @@
          rnfmsk_z(:)   = 0.0_wp
       ENDIF
+      IF( nn_isf .EQ. 0 ) THEN                      ! no specific treatment in vicinity of ice shelf 
+         IF( sbc_isf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_isf arrays' )
+         fwfisf  (:,:) = 0.0_wp
+      END IF
       IF( nn_ice == 0  )   fr_i(:,:) = 0.e0        ! no ice in the domain, ice fraction is always zero
 
@@ -186,4 +186,6 @@
  
       fmmflx(:,:) = 0.0_wp                        ! freezing-melting array initialisation
+      
+      taum(:,:) = 0.0_wp                           ! Initialise taum for use in gls in case of reduced restart
 
       !                                            ! restartability   
@@ -206,10 +208,11 @@
       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 defined key_coupled
-      IF( ln_iceflx_ave .AND. ln_iceflx_linear ) &
-         &   CALL ctl_stop( ' ln_iceflx_ave and ln_iceflx_linear options are not compatible' )
-      IF( ( nn_ice ==3 .AND. lk_cpl) .AND. .NOT. ( ln_iceflx_ave .OR. ln_iceflx_linear ) ) &
-         &   CALL ctl_stop( ' With lim3 coupled, either ln_iceflx_ave or ln_iceflx_linear must be set to .TRUE.' )
-#endif      
+      IF( ( nn_ice /= 3 ) .AND. ( nn_limflx >= 0 ) )   &
+         &   WRITE(numout,*) 'The nn_limflx>=0 option has no effect if sea ice model is not LIM3'
+      IF( ( nn_ice == 3 ) .AND. ( lk_cpl ) .AND. ( ( nn_limflx == -1 ) .OR. ( nn_limflx == 1 ) ) )   &
+         &   CALL ctl_stop( 'The chosen nn_limflx for LIM3 in coupled mode must be 0 or 2' )
+      IF( ( nn_ice == 3 ) .AND. ( .NOT. lk_cpl ) .AND. ( nn_limflx == 2 ) )   &
+         &   CALL ctl_stop( 'The chosen nn_limflx for LIM3 in forced mode cannot be 2' )
+
       IF( ln_dm2dc )   nday_qsr = -1   ! initialisation flag
 
@@ -236,12 +239,12 @@
       !                          ! Choice of the Surface Boudary Condition (set nsbc)
       icpt = 0
-      IF( ln_ana          ) THEN   ;   nsbc =  1   ; icpt = icpt + 1   ;   ENDIF       ! analytical      formulation
-      IF( ln_flx          ) THEN   ;   nsbc =  2   ; icpt = icpt + 1   ;   ENDIF       ! flux            formulation
-      IF( ln_blk_clio     ) THEN   ;   nsbc =  3   ; icpt = icpt + 1   ;   ENDIF       ! CLIO bulk       formulation
-      IF( ln_blk_core     ) THEN   ;   nsbc =  4   ; icpt = icpt + 1   ;   ENDIF       ! CORE bulk       formulation
-      IF( ln_blk_mfs      ) THEN   ;   nsbc =  6   ; icpt = icpt + 1   ;   ENDIF       ! MFS  bulk       formulation
-      IF( ln_cpl          ) THEN   ;   nsbc =  5   ; icpt = icpt + 1   ;   ENDIF       ! Coupled         formulation
-      IF( cp_cfg == 'gyre') THEN   ;   nsbc =  0                       ;   ENDIF       ! GYRE analytical formulation
-      IF( lk_esopa        )            nsbc = -1                                       ! esopa test, ALL formulations
+      IF( ln_ana          ) THEN   ;   nsbc = jp_ana    ; icpt = icpt + 1   ;   ENDIF       ! analytical      formulation
+      IF( ln_flx          ) THEN   ;   nsbc = jp_flx    ; icpt = icpt + 1   ;   ENDIF       ! flux            formulation
+      IF( ln_blk_clio     ) THEN   ;   nsbc = jp_clio   ; icpt = icpt + 1   ;   ENDIF       ! CLIO bulk       formulation
+      IF( ln_blk_core     ) THEN   ;   nsbc = jp_core   ; icpt = icpt + 1   ;   ENDIF       ! CORE bulk       formulation
+      IF( ln_blk_mfs      ) THEN   ;   nsbc = jp_mfs    ; icpt = icpt + 1   ;   ENDIF       ! MFS  bulk       formulation
+      IF( lk_cpl          ) THEN   ;   nsbc = jp_cpl    ; icpt = icpt + 1   ;   ENDIF       ! Coupled         formulation
+      IF( cp_cfg == 'gyre') THEN   ;   nsbc = jp_gyre                       ;   ENDIF       ! GYRE analytical formulation
+      IF( lk_esopa        )            nsbc = jp_esopa                                      ! esopa test, ALL formulations
       !
       IF( icpt /= 1 .AND. .NOT.lk_esopa ) THEN
@@ -254,20 +257,22 @@
       IF(lwp) THEN
          WRITE(numout,*)
-         IF( nsbc == -1 )   WRITE(numout,*) '              ESOPA test All surface boundary conditions'
-         IF( nsbc ==  0 )   WRITE(numout,*) '              GYRE analytical formulation'
-         IF( nsbc ==  1 )   WRITE(numout,*) '              analytical formulation'
-         IF( nsbc ==  2 )   WRITE(numout,*) '              flux formulation'
-         IF( nsbc ==  3 )   WRITE(numout,*) '              CLIO bulk formulation'
-         IF( nsbc ==  4 )   WRITE(numout,*) '              CORE bulk formulation'
-         IF( nsbc ==  5 )   WRITE(numout,*) '              coupled formulation'
-         IF( nsbc ==  6 )   WRITE(numout,*) '              MFS Bulk formulation'
-      ENDIF
-      !
-                          CALL sbc_ssm_init               ! Sea-surface mean fields initialisation
-      !
-      IF( ln_ssr      )   CALL sbc_ssr_init               ! Sea-Surface Restoring initialisation
-      !
-      IF( nn_ice == 4 )   CALL cice_sbc_init( nsbc )      ! CICE initialisation
-      !
+         IF( nsbc == jp_esopa )   WRITE(numout,*) '              ESOPA test All surface boundary conditions'
+         IF( nsbc == jp_gyre  )   WRITE(numout,*) '              GYRE analytical formulation'
+         IF( nsbc == jp_ana   )   WRITE(numout,*) '              analytical formulation'
+         IF( nsbc == jp_flx   )   WRITE(numout,*) '              flux formulation'
+         IF( nsbc == jp_clio  )   WRITE(numout,*) '              CLIO bulk formulation'
+         IF( nsbc == jp_core  )   WRITE(numout,*) '              CORE bulk formulation'
+         IF( nsbc == jp_cpl   )   WRITE(numout,*) '              coupled formulation'
+         IF( nsbc == jp_mfs   )   WRITE(numout,*) '              MFS Bulk formulation'
+      ENDIF
+      !
+                               CALL sbc_ssm_init               ! Sea-surface mean fields initialisation
+      !
+      IF( ln_ssr           )   CALL sbc_ssr_init               ! Sea-Surface Restoring initialisation
+      !
+      IF( nn_ice == 4      )   CALL cice_sbc_init( nsbc )      ! CICE initialisation
+      !
+      IF( nsbc   == jp_cpl )   CALL sbc_cpl_init (nn_ice)      ! OASIS initialisation. must be done before first time step
+
    END SUBROUTINE sbc_init
 
@@ -320,18 +325,18 @@
       SELECT CASE( nsbc )                                ! Compute ocean surface boundary condition
       !                                                  ! (i.e. utau,vtau, qns, qsr, emp, sfx)
-      CASE(  0 )   ;   CALL sbc_gyre    ( kt )                    ! analytical formulation : GYRE configuration
-      CASE(  1 )   ;   CALL sbc_ana     ( kt )                    ! analytical formulation : uniform sbc
-      CASE(  2 )   ;   CALL sbc_flx     ( kt )                    ! flux formulation
-      CASE(  3 )   ;   CALL sbc_blk_clio( kt )                    ! bulk formulation : CLIO for the ocean
-      CASE(  4 )   ;   CALL sbc_blk_core( kt )                    ! bulk formulation : CORE for the ocean
-      CASE(  5 )   ;   CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! coupled formulation
-      CASE(  6 )   ;   CALL sbc_blk_mfs ( kt )                    ! bulk formulation : MFS for the ocean
-      CASE( -1 )                                
-                       CALL sbc_ana     ( kt )                    ! ESOPA, test ALL the formulations
-                       CALL sbc_gyre    ( kt )                    !
-                       CALL sbc_flx     ( kt )                    !
-                       CALL sbc_blk_clio( kt )                    !
-                       CALL sbc_blk_core( kt )                    !
-                       CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   !
+      CASE( jp_gyre  )   ;   CALL sbc_gyre    ( kt )                    ! analytical formulation : GYRE configuration
+      CASE( jp_ana   )   ;   CALL sbc_ana     ( kt )                    ! analytical formulation : uniform sbc
+      CASE( jp_flx   )   ;   CALL sbc_flx     ( kt )                    ! flux formulation
+      CASE( jp_clio  )   ;   CALL sbc_blk_clio( kt )                    ! bulk formulation : CLIO for the ocean
+      CASE( jp_core  )   ;   CALL sbc_blk_core( kt )                    ! bulk formulation : CORE for the ocean
+      CASE( jp_cpl   )   ;   CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! coupled formulation
+      CASE( jp_mfs   )   ;   CALL sbc_blk_mfs ( kt )                    ! bulk formulation : MFS for the ocean
+      CASE( jp_esopa )                                
+                             CALL sbc_ana     ( kt )                    ! ESOPA, test ALL the formulations
+                             CALL sbc_gyre    ( kt )                    !
+                             CALL sbc_flx     ( kt )                    !
+                             CALL sbc_blk_clio( kt )                    !
+                             CALL sbc_blk_core( kt )                    !
+                             CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   !
       END SELECT
 
@@ -342,9 +347,10 @@
       CASE(  2 )   ;         CALL sbc_ice_lim_2( kt, nsbc )          ! LIM-2 ice model
       CASE(  3 )   ;         CALL sbc_ice_lim  ( kt, nsbc )          ! LIM-3 ice model
-      !is it useful?
       CASE(  4 )   ;         CALL sbc_ice_cice ( kt, nsbc )          ! CICE ice model
       END SELECT                                              
 
       IF( ln_icebergs    )   CALL icb_stp( kt )                   ! compute icebergs
+
+      IF( nn_isf   /= 0  )   CALL sbc_isf( kt )                    ! compute iceshelves
 
       IF( ln_rnf         )   CALL sbc_rnf( kt )                   ! add runoffs to fresh water fluxes
@@ -414,15 +420,15 @@
          CALL iom_put( "qsr"   ,       qsr  )                   ! solar heat flux
          IF( nn_ice > 0 )   CALL iom_put( "ice_cover", fr_i )   ! ice fraction 
+         CALL iom_put( "taum"  , taum       )                   ! wind stress module 
+         CALL iom_put( "wspd"  , wndm       )                   ! wind speed  module over free ocean or leads in presence of sea-ice
       ENDIF
       !
       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 iom_put( "taum", taum )   ! wind stress module 
-      CALL iom_put( "wspd", wndm )   ! wind speed  module 
       !
       IF(ln_ctl) THEN         ! print mean trends (used for debugging)
-         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=fr_i              , clinfo1=' fr_i     - : ', mask1=tmask, ovlap=1 )
+         CALL prt_ctl(tab2d_1=(emp-rnf + fwfisf), clinfo1=' emp-rnf  - : ', mask1=tmask, ovlap=1 )
+         CALL prt_ctl(tab2d_1=(sfx-rnf + fwfisf), clinfo1=' sfx-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 )
Index: branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
===================================================================
--- branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90	(revision 4771)
+++ branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90	(revision 5075)
@@ -19,4 +19,5 @@
    USE phycst          ! physical constants
    USE sbc_oce         ! surface boundary condition variables
+   USE sbcisf          ! PM we could remove it I think
    USE closea          ! closed seas
    USE fldread         ! read input field at current time step
@@ -24,4 +25,6 @@
    USE iom             ! I/O module
    USE lib_mpp         ! MPP library
+   USE eosbn2
+   USE wrk_nemo        ! Memory allocation
 
    IMPLICIT NONE
@@ -98,4 +101,8 @@
       INTEGER  ::   z_err = 0 ! dummy integer for error handling
       !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), POINTER       ::   ztfrz   ! freezing point used for temperature correction
+      !
+      CALL wrk_alloc( jpi,jpj, ztfrz)
+
       !
       IF( kt == nit000 )   CALL sbc_rnf_init                           ! Read namelist and allocate structures
@@ -134,4 +141,8 @@
                WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999._wp )             ! if missing data value use SST as runoffs temperature
                    rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0
+               END WHERE
+               WHERE( sf_t_rnf(1)%fnow(:,:,1) == -222._wp )             ! where fwf comes from melting of ice shelves or iceberg
+                   ztfrz(:,:) = -1.9 !tfreez( sss_m(:,:) ) !PM to be discuss (trouble if sensitivity study)
+                   rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rau0 - rnf(:,:) * lfusisf * r1_rau0_rcp
                END WHERE
             ELSE                                                        ! use SST as runoffs temperature
@@ -175,4 +186,5 @@
          CALL iom_rstput( kt, nitrst, numrow, 'rnf_sc_b', rnf_tsc(:,:,jp_sal) )
       ENDIF
+      CALL wrk_dealloc( jpi,jpj, ztfrz)
       !
    END SUBROUTINE sbc_rnf
Index: branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90
===================================================================
--- branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90	(revision 4771)
+++ branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90	(revision 5075)
@@ -14,10 +14,11 @@
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
-   USE sbc_oce         ! Surface boundary condition: ocean fields
    USE sbc_oce         ! surface boundary condition: ocean fields
    USE sbcapr          ! surface boundary condition: atmospheric pressure
-   USE prtctl          ! Print control                    (prt_ctl routine)
-   USE iom
+   USE eosbn2          ! equation of state and related derivatives
+   !
    USE in_out_manager  ! I/O manager
+   USE prtctl          ! Print control
+   USE iom             ! IOM library
 
    IMPLICIT NONE
@@ -54,13 +55,36 @@
       INTEGER, INTENT(in) ::   kt   ! ocean time step
       !
+      INTEGER  ::   ji, jj               ! loop index
       REAL(wp) ::   zcoef, zf_sbc       ! local scalar
+      REAL(wp), DIMENSION(jpi,jpj,jpts) :: zts
+      REAL(wp), DIMENSION(jpi,jpj)      :: zub, zvb,zdep
       !!---------------------------------------------------------------------
+      
+      !                                        !* first wet T-, U-, V- ocean level (ISF) variables (T, S, depth, velocity)
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zub(ji,jj)        = ub (ji,jj,miku(ji,jj))
+            zvb(ji,jj)        = vb (ji,jj,mikv(ji,jj))
+            zts(ji,jj,jp_tem) = tsn(ji,jj,mikt(ji,jj),jp_tem)
+            zts(ji,jj,jp_sal) = tsn(ji,jj,mikt(ji,jj),jp_sal)
+         END DO
+      END DO
+      !
+      IF( lk_vvl ) THEN
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zdep(ji,jj) = fse3t_n(ji,jj,mikt(ji,jj))
+            END DO
+         END DO
+      ENDIF
       !                                                   ! ---------------------------------------- !
       IF( nn_fsbc == 1 ) THEN                             !   Instantaneous surface fields        !
          !                                                ! ---------------------------------------- !
-         ssu_m(:,:) = ub(:,:,1)
-         ssv_m(:,:) = vb(:,:,1)
-         sst_m(:,:) = tsn(:,:,1,jp_tem)
-         sss_m(:,:) = tsn(:,:,1,jp_sal)
+         ssu_m(:,:) = zub(:,:)
+         ssv_m(:,:) = zvb(:,:)
+         IF( ln_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) )
+         ELSE                    ;   sst_m(:,:) = zts(:,:,jp_tem)
+         ENDIF
+         sss_m(:,:) = zts(:,:,jp_sal)
          !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics)
          IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
@@ -68,5 +92,5 @@
          ENDIF
          !
-         IF( lk_vvl )   fse3t_m(:,:) = fse3t_n(:,:,1)
+         IF( lk_vvl )   fse3t_m(:,:) = zdep(:,:)
          !
       ELSE
@@ -77,13 +101,16 @@
             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 
+            ssu_m(:,:) = zcoef * zub(:,:)
+            ssv_m(:,:) = zcoef * zvb(:,:)
+            IF( ln_useCT )  THEN    ;   sst_m(:,:) = zcoef * eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) )
+            ELSE                    ;   sst_m(:,:) = zcoef * zts(:,:,jp_tem)
+            ENDIF
+            sss_m(:,:) = zcoef * zts(:,:,jp_sal)
+            !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics)
             IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) )
-            ELSE                    ;   ssh_m(:,:) = zcoef *   sshn(:,:)
+            ELSE                    ;   ssh_m(:,:) = zcoef * sshn(:,:)
             ENDIF
-            IF( lk_vvl )   fse3t_m(:,:) = zcoef * fse3t_n(:,:,1)
+            !
+            IF( lk_vvl )   fse3t_m(:,:) = zcoef * zdep(:,:)
             !                                             ! ---------------------------------------- !
          ELSEIF( MOD( kt - 2 , nn_fsbc ) == 0 ) THEN      !   Initialisation: New mean computation   !
@@ -99,13 +126,16 @@
          !                                                !        Cumulate at each time step        !
          !                                                ! ---------------------------------------- !
-         ssu_m(:,:) = ssu_m(:,:) + ub(:,:,1)
-         ssv_m(:,:) = ssv_m(:,:) + vb(:,:,1)
-         sst_m(:,:) = sst_m(:,:) + tsn(:,:,1,jp_tem)
-         sss_m(:,:) = sss_m(:,:) + tsn(:,:,1,jp_sal)
+         ssu_m(:,:) = ssu_m(:,:) + zub(:,:)
+         ssv_m(:,:) = ssv_m(:,:) + zvb(:,:)
+         IF( ln_useCT )  THEN    ;   sst_m(:,:) = sst_m(:,:) + eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) )
+         ELSE                    ;   sst_m(:,:) = sst_m(:,:) + zts(:,:,jp_tem)
+         ENDIF
+         sss_m(:,:) = sss_m(:,:) + zts(:,:,jp_sal)
          !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics)
-         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) - 0.5 *  ( ssh_ib(:,:) + ssh_ibb(:,:) )
+         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
          ELSE                    ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:)
          ENDIF
-         IF( lk_vvl )   fse3t_m(:,:) = fse3t_m(:,:) + fse3t_n(:,:,1)
+         !
+         IF( lk_vvl )   fse3t_m(:,:) = fse3t_m(:,:) + zdep(:,:)
 
          !                                                ! ---------------------------------------- !
Index: branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90
===================================================================
--- branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90	(revision 4771)
+++ branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90	(revision 5075)
@@ -10,4 +10,5 @@
    !!----------------------------------------------------------------------
    !!   sbc_ssr       : add to sbc a restoring term toward SST/SSS climatology
+   !!   sbc_ssr_init  : initialisation of surface restoring
    !!----------------------------------------------------------------------
    USE oce            ! ocean dynamics and tracers
@@ -16,4 +17,5 @@
    USE phycst         ! physical constants
    USE sbcrnf         ! surface boundary condition : runoffs
+   !
    USE fldread        ! read input fields
    USE iom            ! I/O manager
@@ -93,5 +95,4 @@
             !
             IF( nn_sstr == 1 ) THEN                                   !* Temperature restoring term
-!CDIR COLLAPSE
                DO jj = 1, jpj
                   DO ji = 1, jpi
