Changeset 5837 for branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/SBC

Timestamp:

2015-10-26T15:59:39+01:00 (9 years ago)

Author:

timgraham

Message:

Upgraded to r5518 of trunk (NEMO 3.6 stable)

Location:

branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/SBC

Files:

• cpl_oasis3.F90 (modified) (16 diffs)
• cpl_oasis4.F90 (deleted)
• cyclone.F90 (modified) (1 diff, 1 prop)
• fldread.F90 (modified) (13 diffs)
• oasis4_date.F90 (deleted)
• sbc_ice.F90 (modified) (7 diffs)
• sbc_oce.F90 (modified) (9 diffs)
• sbcapr.F90 (modified) (1 diff, 1 prop)
• sbcblk_clio.F90 (modified) (21 diffs)
• sbcblk_core.F90 (modified) (29 diffs)
• sbcblk_mfs.F90 (modified) (3 diffs, 1 prop)
• sbccpl.F90 (modified) (53 diffs)
• sbcflx.F90 (modified) (1 diff)
• sbcfwb.F90 (modified) (7 diffs)
• sbcice_cice.F90 (modified) (35 diffs, 1 prop)
• sbcice_if.F90 (modified) (2 diffs)
• sbcice_lim.F90 (modified) (10 diffs)
• sbcice_lim_2.F90 (modified) (9 diffs)
• sbcisf.F90 (copied) (copied from trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90)
• sbcmod.F90 (modified) (18 diffs)
• sbcrnf.F90 (modified) (14 diffs)
• sbcssm.F90 (modified) (11 diffs)
• sbcssr.F90 (modified) (3 diffs)
• sbctide.F90 (modified) (1 diff, 1 prop)
• sbcwave.F90 (modified) (1 diff, 1 prop)
• tide_mod.F90 (modified) (1 diff, 1 prop)
• tideini.F90 (modified) (2 diffs, 1 prop)
• updtide.F90 (modified) (1 diff, 1 prop)

branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

@@ -2 +2 @@
    !!======================================================================
    !!                    ***  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 +14 @@
    !!   3.4  !  11-11  (C. Harris) Changes to allow mutiple category fields
    !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   'key_oasis3'                    coupled Ocean/Atmosphere via OASIS3-MCT
+   !!   'key_oa3mct_v3'                 to be added for OASIS3-MCT version 3
+   !!----------------------------------------------------------------------
+   !!   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 +35 @@
    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                    ::   nrcv         ! total number of fields received 
+   INTEGER                    ::   nsnd         ! total number of fields sent 
+   INTEGER                    ::   ncplmodel    ! Maximum number of models to/from which NEMO is potentialy sending/receiving data
+   INTEGER, PUBLIC, PARAMETER ::   nmaxfld=50   ! 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 +74 @@
       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 +90 @@
 CONTAINS
 
-   SUBROUTINE cpl_prism_init( kl_comm )
+   SUBROUTINE cpl_init( cd_modname, kl_comm )
       !!-------------------------------------------------------------------
-      !!             ***  ROUTINE cpl_prism_init  ***
+      !!             ***  ROUTINE cpl_init  ***
       !!
       !! ** Purpose :   Initialize coupled mode communication for ocean
@@ -82 +99 @@
       !! ** Method  :   OASIS3 MPI communication 
       !!--------------------------------------------------------------------
-      INTEGER, INTENT(out) ::   kl_comm   ! local communicator of the model
+      CHARACTER(len = *), INTENT(in) ::   cd_modname   ! model name as set in namcouple file
+      INTEGER          , INTENT(out) ::   kl_comm      ! local communicator of the model
       !!--------------------------------------------------------------------
 
@@ -89 +107 @@
 
       !------------------------------------------------------------------
-      ! 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, TRIM(cd_modname), nerror )
+      IF ( nerror /= OASIS_Ok ) &
+         CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp')
 
       !------------------------------------------------------------------
@@ -99 +117 @@
       !------------------------------------------------------------------
 
-      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 +134 @@
       !!--------------------------------------------------------------------
       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,*)
+
+      ncplmodel = kcplmodel
+      IF( kcplmodel > nmaxcpl ) THEN
+         CALL oasis_abort ( ncomp_id, 'cpl_define', 'ncplmodel is larger than nmaxcpl, increase nmaxcpl')   ;   RETURN
+      ENDIF
+
+      nrcv = krcv
+      IF( nrcv > nmaxfld ) THEN
+         CALL oasis_abort ( ncomp_id, 'cpl_define', 'nrcv is larger than nmaxfld, increase nmaxfld')   ;   RETURN
+      ENDIF
+
+      nsnd = ksnd
+      IF( nsnd > nmaxfld ) THEN
+         CALL oasis_abort ( ncomp_id, 'cpl_define', 'nsnd is larger than nmaxfld, increase nmaxfld')   ;   RETURN
+      ENDIF
 
       !
@@ -141 +176 @@
       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 +196 @@
       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 +245 @@
       ! ... 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 +293 @@
       !------------------------------------------------------------------
       
-      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 +311 @@
       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pdata
       !!
-      INTEGER                                   ::   jc        ! local loop index
+      INTEGER                                   ::   jc,jm     ! local loop index
       !!--------------------------------------------------------------------
       !
@@ -233 +317 @@
       !
       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 +355 @@
       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( cdfieldname )  
       !!---------------------------------------------------------------------
-      !!              ***  ROUTINE cpl_prism_freq  ***
+      !!              ***  ROUTINE cpl_freq  ***
       !!
       !! ** Purpose : - send back the coupling frequency for a particular field
       !!----------------------------------------------------------------------
-      INTEGER,INTENT(in) ::   kid   ! variable index 
+      CHARACTER(len = *), INTENT(in) ::   cdfieldname    ! field name as set in namcouple file
+      !!
+      INTEGER               :: id
+      INTEGER               :: info
+      INTEGER, DIMENSION(1) :: itmp
+      INTEGER               :: ji,jm     ! local loop index
+      INTEGER               :: mop
       !!----------------------------------------------------------------------
-      cpl_prism_freq = ig_def_freq( kid )
-      !
-   END FUNCTION cpl_prism_freq
-
-
-   SUBROUTINE cpl_prism_finalize
+      cpl_freq = 0   ! defaut definition
+      id = -1        ! defaut definition
+      !
+      DO ji = 1, nsnd
+         IF (ssnd(ji)%laction ) THEN
+            DO jm = 1, ncplmodel
+               IF( ssnd(ji)%nid(1,jm) /= -1 ) THEN
+                  IF( TRIM(cdfieldname) == TRIM(ssnd(ji)%clname) ) THEN
+                     id = ssnd(ji)%nid(1,jm)
+                     mop = OASIS_Out
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDIF
+      ENDDO
+      DO ji = 1, nrcv
+         IF (srcv(ji)%laction ) THEN
+            DO jm = 1, ncplmodel
+               IF( srcv(ji)%nid(1,jm) /= -1 ) THEN
+                  IF( TRIM(cdfieldname) == TRIM(srcv(ji)%clname) ) THEN
+                     id = srcv(ji)%nid(1,jm)
+                     mop = OASIS_In
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDIF
+      ENDDO
+      !
+      IF( id /= -1 ) THEN
+#if defined key_oa3mct_v3
+         CALL oasis_get_freqs(id, mop, 1, itmp, info)
+#else
+         CALL oasis_get_freqs(id,      1, itmp, info)
+#endif
+         cpl_freq = itmp(1)
+      ENDIF
+      !
+   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
 

branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/SBC/cyclone.F90

@@ -41 +41 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
-   !! $Id: module_example 1146 2008-06-25 11:42:56Z rblod $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------

branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

@@ -40 +40 @@
       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   
@@ -69 +69 @@
    END TYPE FLD
 
-   TYPE, PUBLIC ::   MAP_POINTER      !: Array of integer pointers to 1D arrays
-      INTEGER, POINTER   ::  ptr(:)
+   TYPE, PUBLIC ::   MAP_POINTER      !: Map from input data file to local domain
+      INTEGER, POINTER, DIMENSION(:)  ::  ptr           ! Array of integer pointers to 1D arrays
+      LOGICAL                         ::  ll_unstruc    ! Unstructured (T) or structured (F) boundary data file
    END TYPE MAP_POINTER
 
@@ -153 +154 @@
       IF( PRESENT(kit) )   ll_firstcall = ll_firstcall .and. kit == 1
 
-      it_offset = 0
+      IF ( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc
+      ELSE                                      ;   it_offset = 0
+      ENDIF
       IF( PRESENT(kt_offset) )   it_offset = kt_offset
 
@@ -451 +454 @@
       ENDIF
       !
-      it_offset = 0
+      IF ( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc
+      ELSE                                      ;   it_offset = 0
+      ENDIF
       IF( PRESENT(kt_offset) )   it_offset = kt_offset
       IF( PRESENT(kit) ) THEN   ;   it_offset = ( kit + it_offset ) * NINT( rdt/REAL(nn_baro,wp) )
@@ -473 +478 @@
             !       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 +509 @@
             !       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/))
@@ -597 +606 @@
       !
       IF( ASSOCIATED(map%ptr) ) THEN
-         IF( sdjf%ln_tint ) THEN   ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map%ptr )
-         ELSE                      ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1), map%ptr )
+         IF( sdjf%ln_tint ) THEN   ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map )
+         ELSE                      ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1), map )
          ENDIF
       ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN
@@ -668 +677 @@
       REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   dta   ! output field on model grid (2 dimensional)
       INTEGER                   , INTENT(in ) ::   nrec    ! record number to read (ie time slice)
-      INTEGER,  DIMENSION(:)    , INTENT(in ) ::   map     ! global-to-local mapping indices
+      TYPE(MAP_POINTER)         , INTENT(in ) ::   map     ! global-to-local mapping indices
       !!
       INTEGER                                 ::   ipi      ! length of boundary data on local process
@@ -689 +698 @@
 #if defined key_bdy
       ipj = iom_file(num)%dimsz(2,idvar)
-      IF (ipj == 1) THEN ! we assume that this is a structured open boundary file
+      IF ( map%ll_unstruc) THEN ! unstructured open boundary data file
          dta_read => dta_global
-      ELSE
+      ELSE                      ! structured open boundary data file
          dta_read => dta_global2
       ENDIF
@@ -704 +713 @@
       END SELECT
       !
-      IF (ipj==1) THEN
+      IF ( map%ll_unstruc ) THEN ! unstructured open boundary data file
          DO ib = 1, ipi
             DO ik = 1, ipk
-               dta(ib,1,ik) =  dta_read(map(ib),1,ik)
+               dta(ib,1,ik) =  dta_read(map%ptr(ib),1,ik)
             END DO
          END DO
-      ELSE ! we assume that this is a structured open boundary file
+      ELSE                       ! structured open boundary data file
          DO ib = 1, ipi
-            jj=1+floor(REAL(map(ib)-1)/REAL(ilendta))
-            ji=map(ib)-(jj-1)*ilendta
+            jj=1+floor(REAL(map%ptr(ib)-1)/REAL(ilendta))
+            ji=map%ptr(ib)-(jj-1)*ilendta
             DO ik = 1, ipk
                dta(ib,1,ik) =  dta_read(ji,jj,ik)
@@ -1016 +1025 @@
       INTEGER                           ::   ipk           ! temporary vertical dimension
       CHARACTER (len=5)                 ::   aname
-      INTEGER , DIMENSION(3)            ::   ddims
+      INTEGER , DIMENSION(:), ALLOCATABLE ::   ddims
       INTEGER , POINTER, DIMENSION(:,:) ::   data_src
       REAL(wp), POINTER, DIMENSION(:,:) ::   data_tmp
@@ -1039 +1048 @@
 
       !! get dimensions
+      IF ( SIZE(sd%fnow, 3) > 1 ) THEN
+         ALLOCATE( ddims(4) )
+      ELSE
+         ALLOCATE( ddims(3) )
+      ENDIF
       id = iom_varid( inum, sd%clvar, ddims )
 
@@ -1135 +1149 @@
          CALL ctl_stop( '    fld_weight : unable to read the file ' )
       ENDIF
+
+      DEALLOCATE (ddims )
 
       CALL wrk_dealloc( jpi,jpj, data_src )   ! integer

branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90

@@ -14 +14 @@
    !!----------------------------------------------------------------------
    USE par_oce          ! ocean parameters
+   USE sbc_oce          ! surface boundary condition: ocean
 # if defined key_lim3
-   USE par_ice          ! LIM-3 parameters
+   USE ice              ! LIM-3 parameters
 # endif
 # if defined key_lim2
@@ -21 +22 @@
    USE ice_2
 # endif
-# if defined key_cice 
+# if defined key_cice
    USE ice_domain_size, only: ncat 
 #endif
@@ -55 +56 @@
 # 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(:,:,:) ::   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/s]
 
-# 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_lim3
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   evap_ice       !: sublimation                              [kg/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   devap_ice      !: sublimation sensitivity                [kg/m2/s/K]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qns_oce        !: non solar heat flux over ocean              [W/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qsr_oce        !: non solar heat flux over ocean              [W/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qemp_oce       !: heat flux of precip and evap over ocean     [W/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qemp_ice       !: heat flux of precip and evap over ice       [W/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qprec_ice      !: heat flux of precip over ice                [J/m3]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_oce        !: evap - precip over ocean                 [kg/m2/s]
+#endif
+#if defined key_lim3 || defined key_lim2
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wndm_ice       !: wind speed module at T-point                 [m/s]
+#endif
+
+#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 +101 @@
    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_cice
+   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 +130 @@
       !!                     ***  FUNCTION sbc_ice_alloc  ***
       !!----------------------------------------------------------------------
-      INTEGER :: ierr(2)
+      INTEGER :: ierr(5)
       !!----------------------------------------------------------------------
       ierr(:) = 0
@@ -118 +137 @@
       ALLOCATE( qns_ice (jpi,jpj,jpl) , qsr_ice (jpi,jpj,jpl) ,     &
          &      qla_ice (jpi,jpj,jpl) , dqla_ice(jpi,jpj,jpl) ,     &
-         &      dqns_ice(jpi,jpj,jpl) , tn_ice  (jpi,jpj,jpl) ,     &
-         &      alb_ice (jpi,jpj,jpl) ,                             &
-         &      utau_ice(jpi,jpj)     , vtau_ice(jpi,jpj)     ,     &
+         &      dqns_ice(jpi,jpj,jpl) , tn_ice  (jpi,jpj,jpl) , alb_ice (jpi,jpj,jpl) ,   &
+         &      utau_ice(jpi,jpj)     , vtau_ice(jpi,jpj)     , wndm_ice(jpi,jpj)     ,   &
          &      fr1_i0  (jpi,jpj)     , fr2_i0  (jpi,jpj)     ,     &
+#if defined key_lim2
+         &      a_i(jpi,jpj,jpl)      ,                             &
+#endif
 #if defined key_lim3
-         &      emp_ice(jpi,jpj)      , tatm_ice(jpi,jpj)     , STAT= ierr(1) )
-#else
-         &      emp_ice(jpi,jpj)                              , STAT= ierr(1) )
+         &      evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice(jpi,jpj) ,  &
+         &      qemp_ice(jpi,jpj)     , qemp_oce(jpi,jpj)      ,                       &
+         &      qns_oce (jpi,jpj)     , qsr_oce (jpi,jpj)      , emp_oce (jpi,jpj)  ,  &
 #endif
-#elif defined key_cice
+         &      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( ln_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 defined key_cice || defined key_lim2
+      IF( ln_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 +178 @@
    !!   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
 

branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

@@ -35 +35 @@
    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_oasis = .TRUE.  !: OASIS used
+#else
+   LOGICAL , PUBLIC ::   lk_oasis = .FALSE. !: OASIS unused
+#endif
+   LOGICAL , PUBLIC ::   ln_cpl         !: ocean-atmosphere coupled formulation
+   LOGICAL , PUBLIC ::   ln_mixcpl      !: ocean-atmosphere forced-coupled mixed formulation
    LOGICAL , PUBLIC ::   ln_dm2dc       !: Daily mean to Diurnal Cycle short wave (qsr)
    LOGICAL , PUBLIC ::   ln_rnf         !: runoffs / runoff mouths
@@ -41 +47 @@
    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_components  !: flag for sbc module (including sea-ice) coupling mode (see component definition below) 
+   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 +68 @@
    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
+   !!----------------------------------------------------------------------
+   !!           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_purecpl = 5        !: Pure ocean-atmosphere Coupled formulation
+   INTEGER , PUBLIC, PARAMETER ::   jp_mfs     = 6        !: MFS  bulk                     formulation
+   INTEGER , PUBLIC, PARAMETER ::   jp_none    = 7        !: for OPA when doing coupling via SAS module
+   INTEGER , PUBLIC, PARAMETER ::   jp_esopa   = -1       !: esopa test, ALL formulations
+   
+   !!----------------------------------------------------------------------
+   !!           component definition
+   !!----------------------------------------------------------------------
+   INTEGER , PUBLIC, PARAMETER ::   jp_iam_nemo = 0      !: Initial single executable configuration 
+                                                         !  (no internal OASIS coupling)
+   INTEGER , PUBLIC, PARAMETER ::   jp_iam_opa  = 1      !: Multi executable configuration - OPA component
+                                                         !  (internal OASIS coupling)
+   INTEGER , PUBLIC, PARAMETER ::   jp_iam_sas  = 2      !: Multi executable configuration - SAS component
+                                                         !  (internal OASIS coupling)
+   !!----------------------------------------------------------------------
+   !!              Ocean Surface Boundary Condition fields
+   !!----------------------------------------------------------------------
+   INTEGER , PUBLIC ::  ncpl_qsr_freq            !: qsr coupling frequency per days from atmosphere
    !
-   INTEGER , PUBLIC ::   nn_lsm        !: Number of iteration if seaoverland is applied
-   !!----------------------------------------------------------------------
-   !!              Ocean Surface Boundary Condition fields
-   !!----------------------------------------------------------------------
    LOGICAL , PUBLIC ::   lhftau = .FALSE.        !: HF tau used in TKE: mean(stress module) - module(mean stress)
-   LOGICAL , PUBLIC ::   ltrcdm2dc               !: In case of Diurnal Cycle short wave, compute a Daily Mean short waves flux
    !!                                   !!   now    ! before   !!
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau   , utau_b   !: sea surface i-stress (ocean referential)     [N/m2]
@@ -72 +104 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wndm              !: wind speed module at T-point (=|U10m-Uoce|)  [m/s]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr               !: sea heat flux:     solar                     [W/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr_mean          !: daily mean sea heat flux: solar              [W/m2]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qns    , qns_b    !: sea heat flux: non solar                     [W/m2]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr_tot           !: total     solar heat flux (over sea and ice) [W/m2]
@@ -80 +111 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emp_tot           !: total E-P over ocean and ice                 [Kg/m2/s]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fmmflx            !: freshwater budget: freezing/melting          [Kg/m2/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rnf    , rnf_b    !: river runoff   [Kg/m2/s]  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rnf    , rnf_b    !: river runoff        [Kg/m2/s]  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fwfisf , fwfisf_b !: ice shelf melting   [Kg/m2/s]  
    !!
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  sbc_tsc, sbc_tsc_b  !: sbc content trend                      [K.m/s] jpi,jpj,jpts
@@ -92 +124 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   atm_co2           !: atmospheric pCO2                             [ppm]
 #endif
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask          !: coupling mask for ln_mixcpl (warning: allocated in sbccpl)
 
    !!----------------------------------------------------------------------
@@ -102 +135 @@
    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]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   frq_m     !: mean (nn_fsbc time-step) fraction of solar net radiation absorbed in the 1st T level [-]
 
    !! * Substitutions
@@ -129 +163 @@
          &      sfx    (jpi,jpj) , sfx_b(jpi,jpj) , emp_tot(jpi,jpj), fmmflx(jpi,jpj), STAT=ierr(2) )
          !
-      ALLOCATE( rnf  (jpi,jpj) , sbc_tsc  (jpi,jpj,jpts) , qsr_hc  (jpi,jpj,jpk) ,     &
-         &      rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) , STAT=ierr(3) )
+      ALLOCATE( fwfisf  (jpi,jpj), rnf  (jpi,jpj) , sbc_tsc  (jpi,jpj,jpts) , qsr_hc  (jpi,jpj,jpk) ,     &
+         &      fwfisf_b(jpi,jpj), rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) , STAT=ierr(3) )
          !
       ALLOCATE( tprecip(jpi,jpj) , sprecip(jpi,jpj) , fr_i(jpi,jpj) ,     &
@@ -136 +170 @@
          &      atm_co2(jpi,jpj) ,                                        &
 #endif
-         &      ssu_m  (jpi,jpj) , sst_m(jpi,jpj) ,                       &
-         &      ssv_m  (jpi,jpj) , sss_m  (jpi,jpj), ssh_m(jpi,jpj) , STAT=ierr(4) )
+         &      ssu_m  (jpi,jpj) , sst_m(jpi,jpj) , frq_m(jpi,jpj) ,      &
+         &      ssv_m  (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) )
          !
 #if defined key_vvl
       ALLOCATE( e3t_m(jpi,jpj) , STAT=ierr(5) )
 #endif
-         !
-      IF( ltrcdm2dc ) ALLOCATE( qsr_mean(jpi,jpj) , STAT=ierr(5) )
          !
       sbc_oce_alloc = MAXVAL( ierr )

branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90

@@ -43 +43 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
-   !! $Id: $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------

branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90

@@ -34 +34 @@
    USE albedo
    USE prtctl          ! Print control
-#if defined key_lim3
+#if defined key_lim3 
    USE ice
    USE sbc_ice         ! Surface boundary condition: ice fields
+   USE limthd_dh       ! for CALL lim_thd_snwblow
 #elif defined key_lim2
    USE ice_2
+   USE sbc_ice         ! Surface boundary condition: ice fields
+   USE par_ice_2       ! Surface boundary condition: ice fields
 #endif
 
@@ -45 +48 @@
 
    PUBLIC sbc_blk_clio        ! routine called by sbcmod.F90 
-   PUBLIC blk_ice_clio        ! routine called by sbcice_lim.F90 
+#if defined key_lim2 || defined key_lim3
+   PUBLIC blk_ice_clio_tau    ! routine called by sbcice_lim.F90 
+   PUBLIC blk_ice_clio_flx    ! routine called by sbcice_lim.F90 
+#endif
 
    INTEGER , PARAMETER ::   jpfld   = 7           ! maximum number of files to read 
@@ -62 +68 @@
    LOGICAL ::   lbulk_init = .TRUE.               ! flag, bulk initialization done or not)
 
-#if ! defined key_lim3                          
-   ! in namicerun with LIM3
    REAL(wp) ::   cai = 1.40e-3 ! best estimate of atm drag in order to get correct FS export in ORCA2-LIM
    REAL(wp) ::   cao = 1.00e-3 ! chosen by default  ==> should depends on many things...  !!gmto be updated
-#endif
 
    REAL(wp) ::   rdtbs2      !:   
@@ -114 +117 @@
       !!              - 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 +207 @@
       !!               - 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 +260 @@
          END DO
       END DO
+      utau(:,:) = utau(:,:) * umask(:,:,1)
+      vtau(:,:) = vtau(:,:) * vmask(:,:,1)
+      taum(:,:) = taum(:,:) * tmask(:,:,1)
       CALL lbc_lnk( taum, 'T', 1. )
 
@@ -264 +270 @@
 !CDIR COLLAPSE
       wndm(:,:) = sf(jp_wndm)%fnow(:,:,1)
+      wndm(:,:) = wndm(:,:) * tmask(:,:,1)
 
       !------------------------------------------------!
@@ -270 +277 @@
       
       CALL blk_clio_qsr_oce( qsr )
-
+      qsr(:,:) = qsr(:,:) * tmask(:,:,1) ! no shortwave radiation into the ocean beneath ice shelf
       !------------------------!
       !   Other ocean fluxes   !
@@ -376 +383 @@
          &     - 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)
+#if defined key_lim3
+      qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)
+      qsr_oce(:,:) = qsr(:,:)
+#endif
       ! NB: if sea-ice model, the snow precip are computed and the associated heat is added to qns (see blk_ice_clio)
 
-      CALL iom_put( "qlw_oce",   zqlw )   ! output downward longwave  heat over the ocean
-      CALL iom_put( "qsb_oce", - zqsb )   ! output downward sensible  heat over the ocean
-      CALL iom_put( "qla_oce", - zqla )   ! output downward latent    heat over the ocean
-      CALL iom_put( "qns_oce",   qns  )   ! output downward non solar heat over the ocean
+      IF ( nn_ice == 0 ) THEN
+         CALL iom_put( "qlw_oce" ,   zqlw )                 ! output downward longwave  heat over the ocean
+         CALL iom_put( "qsb_oce" , - zqsb )                 ! output downward sensible  heat over the ocean
+         CALL iom_put( "qla_oce" , - zqla )                 ! output downward latent    heat over the ocean
+         CALL iom_put( "qemp_oce",   qns-zqlw+zqsb+zqla )   ! output downward heat content of E-P over the ocean
+         CALL iom_put( "qns_oce" ,   qns  )                 ! output downward non solar heat over the ocean
+         CALL iom_put( "qsr_oce" ,   qsr  )                 ! output downward solar heat over the ocean
+         CALL iom_put( "qt_oce"  ,   qns+qsr )              ! output total downward heat over the ocean
+      ENDIF
 
       IF(ln_ctl) THEN
@@ -397 +414 @@
    END SUBROUTINE blk_oce_clio
 
-
-   SUBROUTINE blk_ice_clio(  pst   , palb_cs, palb_os ,       &
-      &                      p_taui, p_tauj, p_qns , p_qsr,   &
-      &                      p_qla , p_dqns, p_dqla,          &
-      &                      p_tpr , p_spr ,                  &
-      &                      p_fr1 , p_fr2 , cd_grid, pdim  )
+# if defined key_lim2 || defined key_lim3
+   SUBROUTINE blk_ice_clio_tau
       !!---------------------------------------------------------------------------
-      !!                     ***  ROUTINE blk_ice_clio  ***
+      !!                     ***  ROUTINE blk_ice_clio_tau  ***
+      !!                 
+      !!  ** Purpose :   Computation momentum flux at the ice-atm interface  
+      !!         
+      !!  ** Method  :   Read utau from a forcing file. Rearrange if C-grid
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp) ::   zcoef
+      INTEGER  ::   ji, jj   ! dummy loop indices
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('blk_ice_clio_tau')
+
+      SELECT CASE( cp_ice_msh )
+
+      CASE( 'C' )                          ! C-grid ice dynamics
+
+         zcoef  = cai / cao                         ! Change from air-sea stress to air-ice stress
+         utau_ice(:,:) = zcoef * utau(:,:)
+         vtau_ice(:,:) = zcoef * vtau(:,:)
+
+      CASE( 'I' )                          ! I-grid ice dynamics:  I-point (i.e. F-point lower-left corner)
+
+         zcoef  = 0.5_wp * cai / cao                ! Change from air-sea stress to air-ice stress
+         DO jj = 2, jpj         ! stress from ocean U- and V-points to ice U,V point
+            DO ji = 2, jpi   ! I-grid : no vector opt.
+               utau_ice(ji,jj) = zcoef * ( utau(ji-1,jj  ) + utau(ji-1,jj-1) )
+               vtau_ice(ji,jj) = zcoef * ( vtau(ji  ,jj-1) + vtau(ji-1,jj-1) )
+            END DO
+         END DO
+
+         CALL lbc_lnk( utau_ice(:,:), 'I', -1. )   ;   CALL lbc_lnk( vtau_ice(:,:), 'I', -1. )   ! I-point
+
+      END SELECT
+
+      IF(ln_ctl) THEN
+         CALL prt_ctl(tab2d_1=utau_ice , clinfo1=' blk_ice_clio: utau_ice : ', tab2d_2=vtau_ice , clinfo2=' vtau_ice : ')
+      ENDIF
+
+      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_clio_tau')
+
+   END SUBROUTINE blk_ice_clio_tau
+#endif
+
+# if defined key_lim2 || defined key_lim3
+   SUBROUTINE blk_ice_clio_flx(  ptsu , palb_cs, palb_os, palb )
+      !!---------------------------------------------------------------------------
+      !!                     ***  ROUTINE blk_ice_clio_flx ***
       !!                 
       !!  ** Purpose :   Computation of the heat fluxes at ocean and snow/ice
@@ -426 +486 @@
       !!                         to take into account solid precip latent heat flux
       !!----------------------------------------------------------------------
-      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(  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]
-      REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_qns    ! non solar heat flux over ice (T-point)      [W/m2]
-      REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_qsr    !     solar heat flux over ice (T-point)      [W/m2]
-      REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_qla    ! latent    heat flux over ice (T-point)      [W/m2]
-      REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_dqns   ! non solar heat sensistivity  (T-point)      [W/m2]
-      REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_dqla   ! latent    heat sensistivity  (T-point)      [W/m2]
-      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         [%]
-      CHARACTER(len=1), INTENT(in   )             ::   cd_grid  ! type of sea-ice grid ("C" or "B" grid)
-      INTEGER, INTENT(in   )                      ::   pdim     ! number of ice categories
+      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   ptsu      ! 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(  out), DIMENSION(:,:,:)   ::   palb     ! ice albedo (actual value)                      [-]
       !!
       INTEGER  ::   ji, jj, jl    ! dummy loop indices
-      INTEGER  ::   ijpl          ! number of ice categories (size of 3rd dim of input arrays)
-      !!
-      REAL(wp) ::   zcoef, zmt1, zmt2, zmt3, ztatm3     ! temporary scalars
+      !!
+      REAL(wp) ::   zmt1, zmt2, zmt3, ztatm3                    ! temporary scalars
       REAL(wp) ::   ztaevbk, zind1, zind2, zind3, ztamr         !    -         -
       REAL(wp) ::   zesi, zqsati, zdesidt                       !    -         -
@@ -452 +499 @@
       REAL(wp) ::   zcshi, zclei, zrhovaclei, zrhovacshi        !    -         -
       REAL(wp) ::   ztice3, zticemb, zticemb2, zdqlw, zdqsb     !    -         -
+      REAL(wp) ::   z1_lsub                                     !    -         -
       !!
       REAL(wp), DIMENSION(:,:)  , POINTER ::   ztatm   ! Tair in Kelvin
@@ -458 +506 @@
       REAL(wp), DIMENSION(:,:)  , POINTER ::   zrhoa   ! air density
       REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw, z_qsb
+      REAL(wp), DIMENSION(:,:)  , POINTER ::   zevap, zsnw
       !!---------------------------------------------------------------------
       !
-      IF( nn_timing == 1 )  CALL timing_start('blk_ice_clio')
+      IF( nn_timing == 1 )  CALL timing_start('blk_ice_clio_flx')
       !
       CALL wrk_alloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa )
-      CALL wrk_alloc( jpi,jpj,pdim, z_qlw, z_qsb )
-
-      ijpl  = pdim                           ! number of ice categories
+      CALL wrk_alloc( jpi,jpj, jpl, z_qlw, z_qsb )
+
       zpatm = 101000.                        ! atmospheric pressure  (assumed constant  here)
-
-#if defined key_lim3      
-      tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1)   ! LIM3: make Tair available in sea-ice. WARNING allocated after call to ice_init
-#endif
-      !                                                        ! surface ocean fluxes computed with CLIO bulk formulea
-      !------------------------------------!
-      !   momentum fluxes  (utau, vtau )   !
-      !------------------------------------!
-
-      SELECT CASE( cd_grid )
-      CASE( 'C' )                          ! C-grid ice dynamics
-         zcoef  = cai / cao                         ! Change from air-sea stress to air-ice stress
-         p_taui(:,:) = zcoef * utau(:,:)
-         p_tauj(:,:) = zcoef * vtau(:,:)
-      CASE( 'I' )                          ! I-grid ice dynamics:  I-point (i.e. F-point lower-left corner)
-         zcoef  = 0.5_wp * cai / cao                ! Change from air-sea stress to air-ice stress
-         DO jj = 2, jpj         ! stress from ocean U- and V-points to ice U,V point
-            DO ji = 2, jpi   ! I-grid : no vector opt.
-               p_taui(ji,jj) = zcoef * ( utau(ji-1,jj  ) + utau(ji-1,jj-1) )
-               p_tauj(ji,jj) = zcoef * ( vtau(ji  ,jj-1) + vtau(ji-1,jj-1) )
-            END DO
-         END DO
-         CALL lbc_lnk( p_taui(:,:), 'I', -1. )   ;   CALL lbc_lnk( p_tauj(:,:), 'I', -1. )   ! I-point
-      END SELECT
-
-
+      !--------------------------------------------------------------------------------
       !  Determine cloud optical depths as a function of latitude (Chou et al., 1981).
       !  and the correction factor for taking into account  the effect of clouds 
-      !------------------------------------------------------
+      !--------------------------------------------------------------------------------
+
 !CDIR NOVERRCHK
 !CDIR COLLAPSE
@@ -522 +546 @@
             zmt2  = ( 272.0 - ztatm(ji,jj) ) / 38.0   ;   zind2 = MAX( 0.e0, SIGN( 1.e0, zmt2 ) )
             zmt3  = ( 281.0 - ztatm(ji,jj) ) / 18.0   ;   zind3 = MAX( 0.e0, SIGN( 1.e0, zmt3 ) )
-            p_spr(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) / rday   &      ! rday = converte mm/day to kg/m2/s
+            sprecip(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) / rday   &      ! rday = converte mm/day to kg/m2/s
                &         * (          zind1      &                   ! solid  (snow) precipitation [kg/m2/s]
                &            + ( 1.0 - zind1 ) * (          zind2   * ( 0.5 + zmt2 )   &
@@ -532 +556 @@
             ! fraction of qsr_ice which is NOT absorbed in the thin surface layer
             ! and thus which penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 )
-            p_fr1(ji,jj) = 0.18  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj,1) 
-            p_fr2(ji,jj) = 0.82  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj,1)
-         END DO
-      END DO
-      CALL iom_put( 'snowpre', p_spr )   ! Snow precipitation 
+            fr1_i0(ji,jj) = 0.18  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj,1) 
+            fr2_i0(ji,jj) = 0.82  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj,1)
+         END DO
+      END DO
+      CALL iom_put( 'snowpre', sprecip )   ! Snow precipitation 
       
       !-----------------------------------------------------------!
       !  snow/ice Shortwave radiation   (abedo already computed)  !
       !-----------------------------------------------------------!
-      CALL blk_clio_qsr_ice( palb_cs, palb_os, p_qsr )
+      CALL blk_clio_qsr_ice( palb_cs, palb_os, qsr_ice )
+      
+      DO jl = 1, jpl
+         palb(:,:,jl) = ( palb_cs(:,:,jl) * ( 1.e0 - sf(jp_ccov)%fnow(:,:,1) )   &
+            &         +   palb_os(:,:,jl) * sf(jp_ccov)%fnow(:,:,1) )
+      END DO
 
       !                                     ! ========================== !
-      DO jl = 1, ijpl                       !  Loop over ice categories  !
+      DO jl = 1, jpl                       !  Loop over ice categories  !
          !                                  ! ========================== !
 !CDIR NOVERRCHK
@@ -558 +587 @@
                ztaevbk = ztatm3 * ztatm(ji,jj) * zcldeff * ( 0.39 - 0.05 * zevsqr(ji,jj) ) 
                !
-               z_qlw(ji,jj,jl) = - emic * stefan * ( ztaevbk + 4. * ztatm3 * ( pst(ji,jj,jl) - ztatm(ji,jj) ) ) 
+               z_qlw(ji,jj,jl) = - emic * stefan * ( ztaevbk + 4. * ztatm3 * ( ptsu(ji,jj,jl) - ztatm(ji,jj) ) ) 
 
                !----------------------------------------
@@ -565 +594 @@
 
                ! vapour pressure at saturation of ice (tmask to avoid overflow in the exponential)
-               zesi =  611.0 * EXP( 21.8745587 * tmask(ji,jj,1) * ( pst(ji,jj,jl) - rtt )/ ( pst(ji,jj,jl) - 7.66 ) )
+               zesi =  611.0 * EXP( 21.8745587 * tmask(ji,jj,1) * ( ptsu(ji,jj,jl) - rtt )/ ( ptsu(ji,jj,jl) - 7.66 ) )
                ! humidity close to the ice surface (at saturation)
                zqsati   = ( 0.622 * zesi ) / ( zpatm - 0.378 * zesi )
                
                !  computation of intermediate values
-               zticemb  = pst(ji,jj,jl) - 7.66
+               zticemb  = ptsu(ji,jj,jl) - 7.66
                zticemb2 = zticemb * zticemb  
-               ztice3   = pst(ji,jj,jl) * pst(ji,jj,jl) * pst(ji,jj,jl)
+               ztice3   = ptsu(ji,jj,jl) * ptsu(ji,jj,jl) * ptsu(ji,jj,jl)
                zdesidt  = zesi * ( 9.5 * LOG( 10.0 ) * ( rtt - 7.66 )  / zticemb2 )
                
@@ -585 +614 @@
             
                !  sensible heat flux
-               z_qsb(ji,jj,jl) = zrhovacshi * ( pst(ji,jj,jl) - ztatm(ji,jj) )
+               z_qsb(ji,jj,jl) = zrhovacshi * ( ptsu(ji,jj,jl) - ztatm(ji,jj) )
             
                !  latent heat flux 
-               p_qla(ji,jj,jl) = MAX(  0.e0, zrhovaclei * ( zqsati - zqatm(ji,jj) )  )
+               qla_ice(ji,jj,jl) = MAX(  0.e0, zrhovaclei * ( zqsati - zqatm(ji,jj) )  )
               
                !  sensitivity of non solar fluxes (dQ/dT) (long-wave, sensible and latent fluxes)
@@ -595 +624 @@
                zdqla = zrhovaclei * ( zdesidt * ( zqsati * zqsati / ( zesi * zesi ) ) * ( zpatm / 0.622 ) )   
                !
-               p_dqla(ji,jj,jl) = zdqla                           ! latent flux sensitivity
-               p_dqns(ji,jj,jl) = -( zdqlw + zdqsb + zdqla )      !  total non solar sensitivity
+               dqla_ice(ji,jj,jl) = zdqla                           ! latent flux sensitivity
+               dqns_ice(ji,jj,jl) = -( zdqlw + zdqsb + zdqla )      !  total non solar sensitivity
             END DO
             !
@@ -608 +637 @@
       !
 !CDIR COLLAPSE
-      p_qns(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - p_qla (:,:,:)      ! Downward Non Solar flux
-!CDIR COLLAPSE
-      p_tpr(:,:)   = sf(jp_prec)%fnow(:,:,1) / rday                     ! total precipitation [kg/m2/s]
+      qns_ice(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - qla_ice (:,:,:)      ! Downward Non Solar flux
+!CDIR COLLAPSE
+      tprecip(:,:)   = sf(jp_prec)%fnow(:,:,1) / rday                     ! total precipitation [kg/m2/s]
       !
       ! ----------------------------------------------------------------------------- !
@@ -617 +646 @@
 !CDIR COLLAPSE
       qns(:,:) = qns(:,:)                                                           &   ! update the non-solar heat flux with:
-         &     - p_spr(:,:) * lfus                                                  &   ! remove melting solid precip
-         &     + p_spr(:,:) * MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow - rt0 ) * cpic &   ! add solid P at least below melting
-         &     - p_spr(:,:) * sf(jp_tair)%fnow(:,:,1)                        * rcp      ! remove solid precip. at Tair
-      !
+         &     - sprecip(:,:) * lfus                                                  &   ! remove melting solid precip
+         &     + sprecip(:,:) * MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow - rt0 ) * cpic &   ! add solid P at least below melting
+         &     - sprecip(:,:) * sf(jp_tair)%fnow(:,:,1)                        * rcp      ! remove solid precip. at Tair
+
+#if defined key_lim3
+      ! ----------------------------------------------------------------------------- !
+      !    Distribute evapo, precip & associated heat over ice and ocean
+      ! ---------------=====--------------------------------------------------------- !
+      CALL wrk_alloc( jpi,jpj, zevap, zsnw ) 
+
+      ! --- evaporation --- !
+      z1_lsub = 1._wp / Lsub
+      evap_ice (:,:,:) = qla_ice (:,:,:) * z1_lsub ! sublimation
+      devap_ice(:,:,:) = dqla_ice(:,:,:) * z1_lsub
+      zevap    (:,:)   = emp(:,:) + tprecip(:,:)   ! evaporation over ocean
+
+      ! --- evaporation minus precipitation --- !
+      zsnw(:,:) = 0._wp
+      CALL lim_thd_snwblow( pfrld, zsnw )          ! snow redistribution by wind
+      emp_oce(:,:) = pfrld(:,:) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * ( 1._wp - zsnw )
+      emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw
+      emp_tot(:,:) = emp_oce(:,:) + emp_ice(:,:)
+
+      ! --- heat flux associated with emp --- !
+      qemp_oce(:,:) = - pfrld(:,:) * zevap(:,:) * sst_m(:,:) * rcp                               & ! evap
+         &          + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp  & ! liquid precip
+         &          +   sprecip(:,:) * ( 1._wp - zsnw ) *                                        & ! solid precip
+         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus )
+      qemp_ice(:,:) =   sprecip(:,:) * zsnw *                                                    & ! solid precip (only)
+         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus )
+
+      ! --- total solar and non solar fluxes --- !
+      qns_tot(:,:) = pfrld(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:)
+      qsr_tot(:,:) = pfrld(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 )
+
+      ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- !
+      qprec_ice(:,:) = rhosn * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus )
+
+      CALL wrk_dealloc( jpi,jpj, zevap, zsnw ) 
+#endif
+
 !!gm : not necessary as all input data are lbc_lnk...
-      CALL lbc_lnk( p_fr1  (:,:) , 'T', 1. )
-      CALL lbc_lnk( p_fr2  (:,:) , 'T', 1. )
-      DO jl = 1, ijpl
-         CALL lbc_lnk( p_qns (:,:,jl) , 'T', 1. )
-         CALL lbc_lnk( p_dqns(:,:,jl) , 'T', 1. )
-         CALL lbc_lnk( p_qla (:,:,jl) , 'T', 1. )
-         CALL lbc_lnk( p_dqla(:,:,jl) , 'T', 1. )
+      CALL lbc_lnk( fr1_i0  (:,:) , 'T', 1. )
+      CALL lbc_lnk( fr2_i0  (:,:) , 'T', 1. )
+      DO jl = 1, jpl
+         CALL lbc_lnk( qns_ice (:,:,jl) , 'T', 1. )
+         CALL lbc_lnk( dqns_ice(:,:,jl) , 'T', 1. )
+         CALL lbc_lnk( qla_ice (:,:,jl) , 'T', 1. )
+         CALL lbc_lnk( dqla_ice(:,:,jl) , 'T', 1. )
       END DO
 
 !!gm : mask is not required on forcing
-      DO jl = 1, ijpl
-         p_qns (:,:,jl) = p_qns (:,:,jl) * tmask(:,:,1)
-         p_qla (:,:,jl) = p_qla (:,:,jl) * tmask(:,:,1)
-         p_dqns(:,:,jl) = p_dqns(:,:,jl) * tmask(:,:,1)
-         p_dqla(:,:,jl) = p_dqla(:,:,jl) * tmask(:,:,1)
-      END DO
+      DO jl = 1, jpl
+         qns_ice (:,:,jl) = qns_ice (:,:,jl) * tmask(:,:,1)
+         qla_ice (:,:,jl) = qla_ice (:,:,jl) * tmask(:,:,1)
+         dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * tmask(:,:,1)
+         dqla_ice(:,:,jl) = dqla_ice(:,:,jl) * tmask(:,:,1)
+      END DO
+
+      CALL wrk_dealloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa )
+      CALL wrk_dealloc( jpi,jpj, jpl  , z_qlw, z_qsb )
 
       IF(ln_ctl) THEN
-         CALL prt_ctl(tab3d_1=z_qsb  , clinfo1=' blk_ice_clio: z_qsb  : ', tab3d_2=z_qlw  , clinfo2=' z_qlw  : ', kdim=ijpl)
-         CALL prt_ctl(tab3d_1=p_qla  , clinfo1=' blk_ice_clio: z_qla  : ', tab3d_2=p_qsr  , clinfo2=' p_qsr  : ', kdim=ijpl)
-         CALL prt_ctl(tab3d_1=p_dqns , clinfo1=' blk_ice_clio: p_dqns : ', tab3d_2=p_qns  , clinfo2=' p_qns  : ', kdim=ijpl)
-         CALL prt_ctl(tab3d_1=p_dqla , clinfo1=' blk_ice_clio: p_dqla : ', tab3d_2=pst    , clinfo2=' pst    : ', kdim=ijpl)
-         CALL prt_ctl(tab2d_1=p_tpr  , clinfo1=' blk_ice_clio: p_tpr  : ', tab2d_2=p_spr  , clinfo2=' p_spr  : ')
-         CALL prt_ctl(tab2d_1=p_taui , clinfo1=' blk_ice_clio: p_taui : ', tab2d_2=p_tauj , clinfo2=' p_tauj : ')
+         CALL prt_ctl(tab3d_1=z_qsb  , clinfo1=' blk_ice_clio: z_qsb  : ', tab3d_2=z_qlw  , clinfo2=' z_qlw  : ', kdim=jpl)
+         CALL prt_ctl(tab3d_1=qla_ice  , clinfo1=' blk_ice_clio: z_qla  : ', tab3d_2=qsr_ice  , clinfo2=' qsr_ice  : ', kdim=jpl)
+         CALL prt_ctl(tab3d_1=dqns_ice , clinfo1=' blk_ice_clio: dqns_ice : ', tab3d_2=qns_ice  , clinfo2=' qns_ice  : ', kdim=jpl)
+         CALL prt_ctl(tab3d_1=dqla_ice , clinfo1=' blk_ice_clio: dqla_ice : ', tab3d_2=ptsu    , clinfo2=' ptsu    : ', kdim=jpl)
+         CALL prt_ctl(tab2d_1=tprecip  , clinfo1=' blk_ice_clio: tprecip  : ', tab2d_2=sprecip  , clinfo2=' sprecip  : ')
       ENDIF
 
-      CALL wrk_dealloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa )
-      CALL wrk_dealloc( jpi,jpj,pdim, z_qlw, z_qsb )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_clio')
-      !
-   END SUBROUTINE blk_ice_clio
-
+      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_clio_flx')
+      !
+   END SUBROUTINE blk_ice_clio_flx
+
+#endif
 
    SUBROUTINE blk_clio_qsr_oce( pqsr_oce )

branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

@@ -5 +5 @@
    !!=====================================================================
    !! 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
+   !!   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 +41 @@
    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
+   USE lib_fortran     ! to use key_nosignedzero
+#if defined key_lim3
+   USE ice, ONLY       : u_ice, v_ice, jpl, pfrld, a_i_b
+   USE limthd_dh       ! for CALL lim_thd_snwblow
+#elif defined key_lim2
+   USE ice_2, ONLY     : u_ice, v_ice
+   USE par_ice_2
 #endif
-   USE lib_fortran     ! to use key_nosignedzero
 
    IMPLICIT NONE
@@ -48 +56 @@
 
    PUBLIC   sbc_blk_core         ! routine called in sbcmod module
-   PUBLIC   blk_ice_core         ! routine called in sbc_ice_lim module
-   PUBLIC   blk_ice_meanqsr      ! routine called in sbc_ice_lim module
+#if defined key_lim2 || defined key_lim3
+   PUBLIC   blk_ice_core_tau     ! routine called in sbc_ice_lim module
+   PUBLIC   blk_ice_core_flx     ! routine called in sbc_ice_lim module
+#endif
    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 +72 @@
    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 +85 @@
 
    !                                  !!* 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 +96 @@
 #  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 +105 @@
       !!---------------------------------------------------------------------
       !!                    ***  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 +126 @@
       !! ** 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 +148 @@
       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 +161 @@
          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 +181 @@
          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/) )
@@ -190 +202 @@
       !                                            ! compute the surface ocean fluxes using CORE bulk formulea
       IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce_core( kt, sf, sst_m, ssu_m, ssv_m )
-
-      ! If diurnal cycle is activated, compute a daily mean short waves flux for biogeochemistery 
-      IF( ltrcdm2dc )   CALL blk_bio_meanqsr
 
 #if defined key_cice
@@ -226 +235 @@
       !!              - 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 +277 @@
       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 +284 @@
          END DO
       END DO
-#endif
-#if defined key_vectopt_loop
-!CDIR COLLAPSE
 #endif
       DO jj = 2, jpjm1
@@ -292 +294 @@
       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 +300 @@
       !      I   Radiative FLUXES                                                     !
       ! ----------------------------------------------------------------------------- !
-    
+
       ! ocean albedo assumed to be constant + modify now Qsr to include the diurnal cycle                    ! Short Wave
       zztmp = 1. - albo
@@ -306 +306 @@
       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 +313 @@
 
       ! ... 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 +330 @@
 
       ! ... 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 +337 @@
       ! ... 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 +349 @@
       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
-      ENDIF
-!CDIR COLLAPSE
+         !! 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
       zqla (:,:) = Lv * zevap(:,:)                                                              ! Latent Heat
 
@@ -409 +378 @@
       !     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
+      !
+      qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                &   ! Downward Non Solar 
          &     - sf(jp_snow)%fnow(:,:,1) * rn_pfac * lfus                         &   ! remove latent melting heat for solid precip
          &     - zevap(:,:) * pst(:,:) * rcp                                      &   ! remove evap heat content at SST
          &     + ( 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 
-      !
-      CALL iom_put( "qlw_oce",   zqlw )                 ! output downward longwave heat over the ocean
-      CALL iom_put( "qsb_oce", - zqsb )                 ! output downward sensible heat over the ocean
-      CALL iom_put( "qla_oce", - zqla )                 ! output downward latent   heat over the ocean
-      CALL iom_put( "qhc_oce",   qns-zqlw+zqsb+zqla )   ! output downward heat content of E-P over the ocean
-      CALL iom_put( "qns_oce",   qns  )                 ! output downward non solar heat over the ocean
+         &     * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1)
+      !
+#if defined key_lim3
+      qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                ! non solar without emp (only needed by LIM3)
+      qsr_oce(:,:) = qsr(:,:)
+#endif
+      !
+      IF ( nn_ice == 0 ) THEN
+         CALL iom_put( "qlw_oce" ,   zqlw )                 ! output downward longwave heat over the ocean
+         CALL iom_put( "qsb_oce" , - zqsb )                 ! output downward sensible heat over the ocean
+         CALL iom_put( "qla_oce" , - zqla )                 ! output downward latent   heat over the ocean
+         CALL iom_put( "qemp_oce",   qns-zqlw+zqsb+zqla )   ! output downward heat content of E-P over the ocean
+         CALL iom_put( "qns_oce" ,   qns  )                 ! output downward non solar heat over the ocean
+         CALL iom_put( "qsr_oce" ,   qsr  )                 ! output downward solar heat over the ocean
+         CALL iom_put( "qt_oce"  ,   qns+qsr )              ! output total downward heat over the ocean
+      ENDIF
       !
       IF(ln_ctl) THEN
@@ -442 +419 @@
       !
    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)
+   
+#if defined key_lim2 || defined key_lim3
+   SUBROUTINE blk_ice_core_tau
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE blk_ice_core_tau  ***
+      !!
+      !! ** Purpose :   provide the surface boundary condition over sea-ice
+      !!
+      !! ** Method  :   compute momentum using CORE bulk
+      !!                formulea, ice variables and read atmospheric fields.
+      !!                NB: ice drag coefficient is assumed to be a constant
+      !!---------------------------------------------------------------------
+      INTEGER  ::   ji, jj    ! dummy loop indices
+      REAL(wp) ::   zcoef_wnorm, zcoef_wnorm2
+      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
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('blk_ice_core_tau')
+      !
+      ! local scalars ( place there for vector optimisation purposes)
+      zcoef_wnorm  = rhoa * Cice
+      zcoef_wnorm2 = rhoa * Cice * 0.5
+
+!!gm brutal....
+      utau_ice  (:,:) = 0._wp
+      vtau_ice  (:,:) = 0._wp
+      wndm_ice  (:,:) = 0._wp
+!!gm end
+
+      ! ----------------------------------------------------------------------------- !
+      !    Wind components and module relative to the moving ocean ( U10m - U_ice )   !
+      ! ----------------------------------------------------------------------------- !
+      SELECT CASE( cp_ice_msh )
+      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)
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1   ! B grid : NO vector opt
+               ! ... scalar wind at I-point (fld being at T-point)
+               zwndi_f = 0.25 * (  sf(jp_wndi)%fnow(ji-1,jj  ,1) + sf(jp_wndi)%fnow(ji  ,jj  ,1)   &
+                  &              + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji  ,jj-1,1)  ) - rn_vfac * u_ice(ji,jj)
+               zwndj_f = 0.25 * (  sf(jp_wndj)%fnow(ji-1,jj  ,1) + sf(jp_wndj)%fnow(ji  ,jj  ,1)   &
+                  &              + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji  ,jj-1,1)  ) - rn_vfac * v_ice(ji,jj)
+               zwnorm_f = zcoef_wnorm * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f )
+               ! ... ice stress at I-point
+               utau_ice(ji,jj) = zwnorm_f * zwndi_f
+               vtau_ice(ji,jj) = zwnorm_f * zwndj_f
+               ! ... scalar wind at T-point (fld being at T-point)
+               zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  u_ice(ji,jj+1) + u_ice(ji+1,jj+1)   &
+                  &                                                    + u_ice(ji,jj  ) + u_ice(ji+1,jj  )  )
+               zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  v_ice(ji,jj+1) + v_ice(ji+1,jj+1)   &
+                  &                                                    + v_ice(ji,jj  ) + v_ice(ji+1,jj  )  )
+               wndm_ice(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
             END DO
          END DO
-      END DO
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_meanqsr')
-      !
-   END SUBROUTINE blk_ice_meanqsr  
- 
-   
-   SUBROUTINE blk_ice_core(  pst   , pui   , pvi   , palb ,   &
-      &                      p_taui, p_tauj, p_qns , p_qsr,   &
-      &                      p_qla , p_dqns, p_dqla,          &
-      &                      p_tpr , p_spr ,                  &
-      &                      p_fr1 , p_fr2 , cd_grid, pdim  ) 
-      !!---------------------------------------------------------------------
-      !!                     ***  ROUTINE blk_ice_core  ***
+         CALL lbc_lnk( utau_ice, 'I', -1. )
+         CALL lbc_lnk( vtau_ice, 'I', -1. )
+         CALL lbc_lnk( wndm_ice, 'T',  1. )
+         !
+      CASE( 'C' )                  ! C-grid ice dynamics :   U & V-points (same as ocean)
+         DO jj = 2, jpj
+            DO ji = fs_2, jpi   ! vect. opt.
+               zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( u_ice(ji-1,jj  ) + u_ice(ji,jj) )  )
+               zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( v_ice(ji  ,jj-1) + v_ice(ji,jj) )  )
+               wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
+            END DO
+         END DO
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vect. opt.
+               utau_ice(ji,jj) = zcoef_wnorm2 * ( wndm_ice(ji+1,jj  ) + wndm_ice(ji,jj) )                          &
+                  &          * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * u_ice(ji,jj) )
+               vtau_ice(ji,jj) = zcoef_wnorm2 * ( wndm_ice(ji,jj+1  ) + wndm_ice(ji,jj) )                          &
+                  &          * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * v_ice(ji,jj) )
+            END DO
+         END DO
+         CALL lbc_lnk( utau_ice, 'U', -1. )
+         CALL lbc_lnk( vtau_ice, 'V', -1. )
+         CALL lbc_lnk( wndm_ice, 'T',  1. )
+         !
+      END SELECT
+
+      IF(ln_ctl) THEN
+         CALL prt_ctl(tab2d_1=utau_ice  , clinfo1=' blk_ice_core: utau_ice : ', tab2d_2=vtau_ice  , clinfo2=' vtau_ice : ')
+         CALL prt_ctl(tab2d_1=wndm_ice  , clinfo1=' blk_ice_core: wndm_ice : ')
+      ENDIF
+
+      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_core_tau')
+      
+   END SUBROUTINE blk_ice_core_tau
+
+
+   SUBROUTINE blk_ice_core_flx( ptsu, palb )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE blk_ice_core_flx  ***
       !!
       !! ** Purpose :   provide the surface boundary condition over sea-ice
       !!
-      !! ** Method  :   compute momentum, heat and freshwater exchanged
+      !! ** Method  :   compute heat and freshwater exchanged
       !!                between atmosphere and sea-ice using CORE bulk
       !!                formulea, ice variables and read atmmospheric fields.
-      !!                NB: ice drag coefficient is assumed to be a constant
       !! 
       !! caution : the net upward water flux has with mm/day unit
       !!---------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pst      ! ice surface temperature (>0, =rt0 over land) [Kelvin]
-      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(  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)
-      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_qns    ! non solar heat flux over ice (T-point)         [W/m2]
-      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_qsr    !     solar heat flux over ice (T-point)         [W/m2]
-      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_qla    ! latent    heat flux over ice (T-point)         [W/m2]
-      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_dqns   ! non solar heat sensistivity  (T-point)         [W/m2]
-      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_dqla   ! latent    heat sensistivity  (T-point)         [W/m2]
-      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_tpr    ! total precipitation          (T-point)      [Kg/m2/s]
-      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_spr    ! solid precipitation          (T-point)      [Kg/m2/s]
-      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_fr1    ! 1sr fraction of qsr penetration in ice (T-point)  [%]
-      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_fr2    ! 2nd fraction of qsr penetration in ice (T-point)  [%]
-      CHARACTER(len=1)          , INTENT(in   ) ::   cd_grid  ! ice grid ( C or B-grid)
-      INTEGER                   , INTENT(in   ) ::   pdim     ! number of ice categories
+      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   ptsu          ! sea ice surface temperature
+      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   palb          ! ice albedo (all skies)
       !!
       INTEGER  ::   ji, jj, jl    ! dummy loop indices
-      INTEGER  ::   ijpl          ! number of ice categories (size of 3rd dim of input arrays)
       REAL(wp) ::   zst2, zst3
-      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
-      !!
-      REAL(wp), DIMENSION(:,:)  , POINTER ::   z_wnds_t          ! wind speed ( = | U10m - U_ice | ) at T-point
+      REAL(wp) ::   zcoef_dqlw, zcoef_dqla, zcoef_dqsb
+      REAL(wp) ::   zztmp, z1_lsub                               ! temporary variable
+      !!
       REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw             ! long wave heat flux over ice
       REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qsb             ! sensible  heat flux over ice
       REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqlw            ! long wave heat sensitivity over ice
       REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqsb            ! sensible  heat sensitivity over ice
-      !!---------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('blk_ice_core')
-      !
-      CALL wrk_alloc( jpi,jpj, z_wnds_t )
-      CALL wrk_alloc( jpi,jpj,pdim, z_qlw, z_qsb, z_dqlw, z_dqsb ) 
-
-      ijpl  = pdim                            ! number of ice categories
+      REAL(wp), DIMENSION(:,:)  , POINTER ::   zevap, zsnw       ! evaporation and snw distribution after wind blowing (LIM3)
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('blk_ice_core_flx')
+      !
+      CALL wrk_alloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb ) 
 
       ! local scalars ( place there for vector optimisation purposes)
-      zcoef_wnorm  = rhoa * Cice
-      zcoef_wnorm2 = rhoa * Cice * 0.5
       zcoef_dqlw   = 4.0 * 0.95 * Stef
       zcoef_dqla   = -Ls * Cice * 11637800. * (-5897.8)
       zcoef_dqsb   = rhoa * cpa * Cice
-      zcoef_frca   = 1.0  - 0.3
-
-!!gm brutal....
-      z_wnds_t(:,:) = 0.e0
-      p_taui  (:,:) = 0.e0
-      p_tauj  (:,:) = 0.e0
-!!gm end
-
-#if defined key_lim3
-      tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1)   ! LIM3: make Tair available in sea-ice. WARNING allocated after call to ice_init
-#endif
-      ! ----------------------------------------------------------------------------- !
-      !    Wind components and module relative to the moving ocean ( U10m - U_ice )   !
-      ! ----------------------------------------------------------------------------- !
-      SELECT CASE( cd_grid )
-      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
-               ! ... scalar wind at I-point (fld being at T-point)
-               zwndi_f = 0.25 * (  sf(jp_wndi)%fnow(ji-1,jj  ,1) + sf(jp_wndi)%fnow(ji  ,jj  ,1)   &
-                  &              + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji  ,jj-1,1)  ) - rn_vfac * pui(ji,jj)
-               zwndj_f = 0.25 * (  sf(jp_wndj)%fnow(ji-1,jj  ,1) + sf(jp_wndj)%fnow(ji  ,jj  ,1)   &
-                  &              + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji  ,jj-1,1)  ) - rn_vfac * pvi(ji,jj)
-               zwnorm_f = zcoef_wnorm * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f )
-               ! ... ice stress at I-point
-               p_taui(ji,jj) = zwnorm_f * zwndi_f
-               p_tauj(ji,jj) = zwnorm_f * zwndj_f
-               ! ... scalar wind at T-point (fld being at T-point)
-               zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  pui(ji,jj+1) + pui(ji+1,jj+1)   &
-                  &                                                    + pui(ji,jj  ) + pui(ji+1,jj  )  )
-               zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  pvi(ji,jj+1) + pvi(ji+1,jj+1)   &
-                  &                                                    + pvi(ji,jj  ) + pvi(ji+1,jj  )  )
-               z_wnds_t(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
-            END DO
-         END DO
-         CALL lbc_lnk( p_taui  , 'I', -1. )
-         CALL lbc_lnk( p_tauj  , 'I', -1. )
-         CALL lbc_lnk( z_wnds_t, 'T',  1. )
-         !
-      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.
-               zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pui(ji-1,jj  ) + pui(ji,jj) )  )
-               zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pvi(ji  ,jj-1) + pvi(ji,jj) )  )
-               z_wnds_t(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
-            END DO
-         END DO
-#if defined key_vectopt_loop
-!CDIR COLLAPSE
-#endif
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vect. opt.
-               p_taui(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji+1,jj  ) + z_wnds_t(ji,jj) )                          &
-                  &          * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * pui(ji,jj) )
-               p_tauj(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji,jj+1  ) + z_wnds_t(ji,jj) )                          &
-                  &          * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * pvi(ji,jj) )
-            END DO
-         END DO
-         CALL lbc_lnk( p_taui  , 'U', -1. )
-         CALL lbc_lnk( p_tauj  , 'V', -1. )
-         CALL lbc_lnk( z_wnds_t, 'T',  1. )
-         !
-      END SELECT
 
       zztmp = 1. / ( 1. - albo )
       !                                     ! ========================== !
-      DO jl = 1, ijpl                       !  Loop over ice categories  !
+      DO jl = 1, jpl                        !  Loop over ice categories  !
          !                                  ! ========================== !
-!CDIR NOVERRCHK
-!CDIR COLLAPSE
          DO jj = 1 , jpj
-!CDIR NOVERRCHK
             DO ji = 1, jpi
                ! ----------------------------!
                !      I   Radiative FLUXES   !
                ! ----------------------------!
-               zst2 = pst(ji,jj,jl) * pst(ji,jj,jl)
-               zst3 = pst(ji,jj,jl) * zst2
+               zst2 = ptsu(ji,jj,jl) * ptsu(ji,jj,jl)
+               zst3 = ptsu(ji,jj,jl) * zst2
                ! Short Wave (sw)
-               p_qsr(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj)
+               qsr_ice(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 * ptsu(ji,jj,jl) * zst3 ) * tmask(ji,jj,1)
                ! lw sensitivity
                z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3                                               
@@ -663 +571 @@
                ! ... turbulent heat fluxes
                ! Sensible Heat
-               z_qsb(ji,jj,jl) = rhoa * cpa * Cice * z_wnds_t(ji,jj) * ( pst(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) )
+               z_qsb(ji,jj,jl) = rhoa * cpa * Cice * wndm_ice(ji,jj) * ( ptsu(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) )
                ! Latent Heat
-               p_qla(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa * Ls  * Cice * z_wnds_t(ji,jj)   &                           
-                  &                         * (  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) )
+               qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa * Ls  * Cice * wndm_ice(ji,jj)   &                           
+                  &                         * (  11637800. * EXP( -5897.8 / ptsu(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1)  ) )
+              ! Latent heat sensitivity for ice (Dqla/Dt)
+               IF( qla_ice(ji,jj,jl) > 0._wp ) THEN
+                  dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * wndm_ice(ji,jj) / ( zst2 ) * EXP( -5897.8 / ptsu(ji,jj,jl) )
+               ELSE
+                  dqla_ice(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)
+               z_dqsb(ji,jj,jl) = zcoef_dqsb * wndm_ice(ji,jj)
 
                ! ----------------------------!
@@ -676 +589 @@
                ! ----------------------------!
                ! Downward Non Solar flux
-               p_qns (ji,jj,jl) =     z_qlw (ji,jj,jl) - z_qsb (ji,jj,jl) - p_qla (ji,jj,jl)      
+               qns_ice (ji,jj,jl) =     z_qlw (ji,jj,jl) - z_qsb (ji,jj,jl) - qla_ice (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) )    
+               dqns_ice(ji,jj,jl) = - ( z_dqlw(ji,jj,jl) + z_dqsb(ji,jj,jl) + dqla_ice(ji,jj,jl) )
             END DO
             !
@@ -685 +598 @@
       END DO
       !
+      tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac      ! total precipitation [kg/m2/s]
+      sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac      ! solid precipitation [kg/m2/s]
+      CALL iom_put( 'snowpre', sprecip * 86400. )                  ! Snow precipitation
+      CALL iom_put( 'precip' , tprecip * 86400. )                  ! Total precipitation
+
+#if defined  key_lim3
+      CALL wrk_alloc( jpi,jpj, zevap, zsnw ) 
+
+      ! --- evaporation --- !
+      z1_lsub = 1._wp / Lsub
+      evap_ice (:,:,:) = qla_ice (:,:,:) * z1_lsub ! sublimation
+      devap_ice(:,:,:) = dqla_ice(:,:,:) * z1_lsub
+      zevap    (:,:)   = emp(:,:) + tprecip(:,:)   ! evaporation over ocean
+
+      ! --- evaporation minus precipitation --- !
+      zsnw(:,:) = 0._wp
+      CALL lim_thd_snwblow( pfrld, zsnw )  ! snow distribution over ice after wind blowing 
+      emp_oce(:,:) = pfrld(:,:) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * (1._wp - zsnw )
+      emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw
+      emp_tot(:,:) = emp_oce(:,:) + emp_ice(:,:)
+
+      ! --- heat flux associated with emp --- !
+      qemp_oce(:,:) = - pfrld(:,:) * zevap(:,:) * sst_m(:,:) * rcp                               & ! evap at sst
+         &          + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp  & ! liquid precip at Tair
+         &          +   sprecip(:,:) * ( 1._wp - zsnw ) *                                        & ! solid precip at min(Tair,Tsnow)
+         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus )
+      qemp_ice(:,:) =   sprecip(:,:) * zsnw *                                                    & ! solid precip (only)
+         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus )
+
+      ! --- total solar and non solar fluxes --- !
+      qns_tot(:,:) = pfrld(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:)
+      qsr_tot(:,:) = pfrld(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 )
+
+      ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- !
+      qprec_ice(:,:) = rhosn * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus )
+
+      CALL wrk_dealloc( jpi,jpj, zevap, zsnw ) 
+#endif
+
       !--------------------------------------------------------------------
       ! FRACTIONs of net shortwave radiation which is not absorbed in the
       ! 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_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 
+      !
+      fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )
+      fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )
+      !
       !
       IF(ln_ctl) THEN
-         CALL prt_ctl(tab3d_1=p_qla   , clinfo1=' blk_ice_core: p_qla  : ', tab3d_2=z_qsb   , clinfo2=' z_qsb  : ', kdim=ijpl)
-         CALL prt_ctl(tab3d_1=z_qlw   , clinfo1=' blk_ice_core: z_qlw  : ', tab3d_2=p_dqla  , clinfo2=' p_dqla : ', kdim=ijpl)
-         CALL prt_ctl(tab3d_1=z_dqsb  , clinfo1=' blk_ice_core: z_dqsb : ', tab3d_2=z_dqlw  , clinfo2=' z_dqlw : ', kdim=ijpl)
-         CALL prt_ctl(tab3d_1=p_dqns  , clinfo1=' blk_ice_core: p_dqns : ', tab3d_2=p_qsr   , clinfo2=' p_qsr  : ', kdim=ijpl)
-         CALL prt_ctl(tab3d_1=pst     , clinfo1=' blk_ice_core: pst    : ', tab3d_2=p_qns   , clinfo2=' p_qns  : ', kdim=ijpl)
-         CALL prt_ctl(tab2d_1=p_tpr   , clinfo1=' blk_ice_core: p_tpr  : ', tab2d_2=p_spr   , clinfo2=' p_spr  : ')
-         CALL prt_ctl(tab2d_1=p_taui  , clinfo1=' blk_ice_core: p_taui : ', tab2d_2=p_tauj  , clinfo2=' p_tauj : ')
-         CALL prt_ctl(tab2d_1=z_wnds_t, clinfo1=' blk_ice_core: z_wnds_t : ')
-      ENDIF
-
-      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   )
+         CALL prt_ctl(tab3d_1=qla_ice , clinfo1=' blk_ice_core: qla_ice  : ', tab3d_2=z_qsb   , clinfo2=' z_qsb    : ', kdim=jpl)
+         CALL prt_ctl(tab3d_1=z_qlw   , clinfo1=' blk_ice_core: z_qlw    : ', tab3d_2=dqla_ice, clinfo2=' dqla_ice : ', kdim=jpl)
+         CALL prt_ctl(tab3d_1=z_dqsb  , clinfo1=' blk_ice_core: z_dqsb   : ', tab3d_2=z_dqlw  , clinfo2=' z_dqlw   : ', kdim=jpl)
+         CALL prt_ctl(tab3d_1=dqns_ice, clinfo1=' blk_ice_core: dqns_ice : ', tab3d_2=qsr_ice , clinfo2=' qsr_ice  : ', kdim=jpl)
+         CALL prt_ctl(tab3d_1=ptsu    , clinfo1=' blk_ice_core: ptsu     : ', tab3d_2=qns_ice , clinfo2=' qns_ice  : ', kdim=jpl)
+         CALL prt_ctl(tab2d_1=tprecip , clinfo1=' blk_ice_core: tprecip  : ', tab2d_2=sprecip , clinfo2=' sprecip  : ')
+      ENDIF
+
+      CALL wrk_dealloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_core_flx')
+      
+   END SUBROUTINE blk_ice_core_flx
+#endif
+
+   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 +692 @@
       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 +698 @@
       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 ) 
-      ENDIF
-      sqrt_Cd_n10 = sqrt(Cd_n10)
+         ztmp0 = cd_neutral_10m( U_zu )
+      ENDIF
+      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

branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90

@@ -46 +46 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
-   !! $Id: sbcblk_mfs.F90 1730 2009-11-16 14:34:19Z poddo $
+   !! $Id$
    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -82 +82 @@
       !!              - 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 +233 @@
          ! 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

branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

@@ -9 +9 @@
    !!            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
@@ -24 +21 @@
    USE sbc_oce         ! Surface boundary condition: ocean fields
    USE sbc_ice         ! Surface boundary condition: ice fields
+   USE sbcapr
    USE sbcdcy          ! surface boundary condition: diurnal cycle
    USE phycst          ! physical constants
 #if defined key_lim3
-   USE par_ice         ! ice parameters
    USE ice             ! ice variables
 #endif
@@ -34 +31 @@
    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
+   USE oce   , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev
    USE albedo          !
    USE in_out_manager  ! I/O manager
@@ -49 +41 @@
    USE timing          ! Timing
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE eosbn2
+   USE sbcrnf   , ONLY : l_rnfcpl
 #if defined key_cpl_carbon_cycle
    USE p4zflx, ONLY : oce_co2
 #endif
-   USE diaar5, ONLY :   lk_diaar5
 #if defined key_cice
    USE ice_domain_size, only: ncat
 #endif
+#if defined key_lim3
+   USE limthd_dh       ! for CALL lim_thd_snwblow
+#endif
+
    IMPLICIT NONE
    PRIVATE
 
+   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
@@ -97 +96 @@
    INTEGER, PARAMETER ::   jpr_topm   = 32            ! topmeltn
    INTEGER, PARAMETER ::   jpr_botm   = 33            ! botmeltn
-   INTEGER, PARAMETER ::   jprcv      = 33            ! total number of fields received
-
-   INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction 
+   INTEGER, PARAMETER ::   jpr_sflx   = 34            ! salt flux
+   INTEGER, PARAMETER ::   jpr_toce   = 35            ! ocean temperature
+   INTEGER, PARAMETER ::   jpr_soce   = 36            ! ocean salinity
+   INTEGER, PARAMETER ::   jpr_ocx1   = 37            ! ocean current on grid 1
+   INTEGER, PARAMETER ::   jpr_ocy1   = 38            !
+   INTEGER, PARAMETER ::   jpr_ssh    = 39            ! sea surface height
+   INTEGER, PARAMETER ::   jpr_fice   = 40            ! ice fraction          
+   INTEGER, PARAMETER ::   jpr_e3t1st = 41            ! first T level thickness 
+   INTEGER, PARAMETER ::   jpr_fraqsr = 42            ! fraction of solar net radiation absorbed in the first ocean level
+   INTEGER, PARAMETER ::   jprcv      = 42            ! total number of fields received
+
+   INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction sent to the atmosphere
    INTEGER, PARAMETER ::   jps_toce   =  2            ! ocean temperature
    INTEGER, PARAMETER ::   jps_tice   =  3            ! ice   temperature
@@ -114 +122 @@
    INTEGER, PARAMETER ::   jps_ivz1   = 14            !
    INTEGER, PARAMETER ::   jps_co2    = 15
-   INTEGER, PARAMETER ::   jpsnd      = 15            ! total number of fields sended
+   INTEGER, PARAMETER ::   jps_soce   = 16            ! ocean salinity
+   INTEGER, PARAMETER ::   jps_ssh    = 17            ! sea surface height
+   INTEGER, PARAMETER ::   jps_qsroce = 18            ! Qsr above the ocean
+   INTEGER, PARAMETER ::   jps_qnsoce = 19            ! Qns above the ocean
+   INTEGER, PARAMETER ::   jps_oemp   = 20            ! ocean freshwater budget (evap - precip)
+   INTEGER, PARAMETER ::   jps_sflx   = 21            ! salt flux
+   INTEGER, PARAMETER ::   jps_otx1   = 22            ! 2 atmosphere-ocean stress components on grid 1
+   INTEGER, PARAMETER ::   jps_oty1   = 23            ! 
+   INTEGER, PARAMETER ::   jps_rnf    = 24            ! runoffs
+   INTEGER, PARAMETER ::   jps_taum   = 25            ! wind stress module
+   INTEGER, PARAMETER ::   jps_fice2  = 26            ! ice fraction sent to OPA (by SAS when doing SAS-OPA coupling)
+   INTEGER, PARAMETER ::   jps_e3t1st = 27            ! first level depth (vvl)
+   INTEGER, PARAMETER ::   jps_fraqsr = 28            ! fraction of solar net radiation absorbed in the first ocean level
+   INTEGER, PARAMETER ::   jpsnd      = 28            ! total number of fields sended
 
    !                                                         !!** namelist namsbc_cpl **
@@ -129 +150 @@
    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)
    TYPE ::   DYNARR     
       REAL(wp), POINTER, DIMENSION(:,:,:)    ::   z3   
@@ -140 +164 @@
    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
+#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -179 +179 @@
       !!             ***  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,0:nn_cplmodel) , STAT=ierr(3) )
+      !
       sbc_cpl_alloc = MAXVAL( ierr )
       IF( lk_mpp            )   CALL mpp_sum ( sbc_cpl_alloc )
@@ -210 +201 @@
       !!             ***  ROUTINE sbc_cpl_init  ***
       !!
-      !! ** Purpose :   Initialisation of send and recieved information from
+      !! ** Purpose :   Initialisation of send and received information from
       !!                the atmospheric component
       !!
@@ -218 +209 @@
       !!              * initialise the OASIS coupler
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   k_ice    ! ice management in the sbc (=0/1/2/3)
+      INTEGER, INTENT(in) ::   k_ice       ! ice management in the sbc (=0/1/2/3)
       !!
       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
       !!---------------------------------------------------------------------
       !
@@ -250 +243 @@
          WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist '
          WRITE(numout,*)'~~~~~~~~~~~~'
+      ENDIF
+      IF( lwp .AND. ln_cpl ) THEN                        ! control print
          WRITE(numout,*)'  received fields (mutiple ice categogies)'
          WRITE(numout,*)'      10m wind module                 = ', TRIM(sn_rcv_w10m%cldes  ), ' (', TRIM(sn_rcv_w10m%clcat  ), ')'
@@ -274 +269 @@
          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
 
@@ -391 +388 @@
       srcv(jpr_oemp)%clname = 'OOEvaMPr'      ! ocean water budget = ocean Evap - ocean precip
       SELECT CASE( TRIM( sn_rcv_emp%cldes ) )
+      CASE( 'none'          )       ! nothing to do
       CASE( 'oce only'      )   ;   srcv(                                 jpr_oemp   )%laction = .TRUE. 
       CASE( 'conservative'  )
@@ -402 +400 @@
       !                                                      !     Runoffs & Calving     !   
       !                                                      ! ------------------------- !
-      srcv(jpr_rnf   )%clname = 'O_Runoff'   ;   IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' )   srcv(jpr_rnf)%laction = .TRUE.
-! This isn't right - really just want ln_rnf_emp changed
-!                                                 IF( TRIM( sn_rcv_rnf%cldes ) == 'climato' )   THEN   ;   ln_rnf = .TRUE.
-!                                                 ELSE                                                 ;   ln_rnf = .FALSE.
-!                                                 ENDIF
+      srcv(jpr_rnf   )%clname = 'O_Runoff'
+      IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN
+         srcv(jpr_rnf)%laction = .TRUE.
+         l_rnfcpl              = .TRUE.                      ! -> no need to read runoffs in sbcrnf
+         ln_rnf                = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '   runoffs received from oasis -> force ln_rnf = ', ln_rnf
+      ENDIF
+      !
       srcv(jpr_cal   )%clname = 'OCalving'   ;   IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE.
 
@@ -416 +418 @@
       srcv(jpr_qnsmix)%clname = 'O_QnsMix'
       SELECT CASE( TRIM( sn_rcv_qns%cldes ) )
+      CASE( 'none'          )       ! nothing to do
       CASE( 'oce only'      )   ;   srcv(               jpr_qnsoce   )%laction = .TRUE.
       CASE( 'conservative'  )   ;   srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE.
@@ -431 +434 @@
       srcv(jpr_qsrmix)%clname = 'O_QsrMix'
       SELECT CASE( TRIM( sn_rcv_qsr%cldes ) )
+      CASE( 'none'          )       ! nothing to do
       CASE( 'oce only'      )   ;   srcv(               jpr_qsroce   )%laction = .TRUE.
       CASE( 'conservative'  )   ;   srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE.
@@ -446 +450 @@
       !
       ! non solar sensitivity mandatory for LIM ice model
-      IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4) &
+      IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4 .AND. nn_components /= jp_iam_sas ) &
          CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' )
       ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique
@@ -479 +483 @@
          srcv(jpr_topm:jpr_botm)%laction = .TRUE.
       ENDIF
-
-      ! Allocate all parts of frcv used for received fields
+      !                                                      ! ------------------------------- !
+      !                                                      !   OPA-SAS coupling - rcv by opa !   
+      !                                                      ! ------------------------------- !
+      srcv(jpr_sflx)%clname = 'O_SFLX'
+      srcv(jpr_fice)%clname = 'RIceFrc'
+      !
+      IF( nn_components == jp_iam_opa ) THEN    ! OPA coupled to SAS via OASIS: force received field by OPA (sent by SAS)
+         srcv(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling
+         srcv(:)%clgrid  = 'T'       ! force default definition in case of opa <-> sas coupling
+         srcv(:)%nsgn    = 1.        ! force default definition in case of opa <-> sas coupling
+         srcv( (/jpr_qsroce, jpr_qnsoce, jpr_oemp, jpr_sflx, jpr_fice, jpr_otx1, jpr_oty1, jpr_taum/) )%laction = .TRUE.
+         srcv(jpr_otx1)%clgrid = 'U'        ! oce components given at U-point
+         srcv(jpr_oty1)%clgrid = 'V'        !           and           V-point
+         ! Vectors: change of sign at north fold ONLY if on the local grid
+         srcv( (/jpr_otx1,jpr_oty1/) )%nsgn = -1.
+         sn_rcv_tau%clvgrd = 'U,V'
+         sn_rcv_tau%clvor = 'local grid'
+         sn_rcv_tau%clvref = 'spherical'
+         sn_rcv_emp%cldes = 'oce only'
+         !
+         IF(lwp) THEN                        ! control print
+            WRITE(numout,*)
+            WRITE(numout,*)'               Special conditions for SAS-OPA coupling  '
+            WRITE(numout,*)'               OPA component  '
+            WRITE(numout,*)
+            WRITE(numout,*)'  received fields from SAS component '
+            WRITE(numout,*)'                  ice cover '
+            WRITE(numout,*)'                  oce only EMP  '
+            WRITE(numout,*)'                  salt flux  '
+            WRITE(numout,*)'                  mixed oce-ice solar flux  '
+            WRITE(numout,*)'                  mixed oce-ice non solar flux  '
+            WRITE(numout,*)'                  wind stress U,V on local grid and sperical coordinates '
+            WRITE(numout,*)'                  wind stress module'
+            WRITE(numout,*)
+         ENDIF
+      ENDIF
+      !                                                      ! -------------------------------- !
+      !                                                      !   OPA-SAS coupling - rcv by sas  !   
+      !                                                      ! -------------------------------- !
+      srcv(jpr_toce  )%clname = 'I_SSTSST'
+      srcv(jpr_soce  )%clname = 'I_SSSal'
+      srcv(jpr_ocx1  )%clname = 'I_OCurx1'
+      srcv(jpr_ocy1  )%clname = 'I_OCury1'
+      srcv(jpr_ssh   )%clname = 'I_SSHght'
+      srcv(jpr_e3t1st)%clname = 'I_E3T1st'   
+      srcv(jpr_fraqsr)%clname = 'I_FraQsr'   
+      !
+      IF( nn_components == jp_iam_sas ) THEN
+         IF( .NOT. ln_cpl ) srcv(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling
+         IF( .NOT. ln_cpl ) srcv(:)%clgrid  = 'T'       ! force default definition in case of opa <-> sas coupling
+         IF( .NOT. ln_cpl ) srcv(:)%nsgn    = 1.        ! force default definition in case of opa <-> sas coupling
+         srcv( (/jpr_toce, jpr_soce, jpr_ssh, jpr_fraqsr, jpr_ocx1, jpr_ocy1/) )%laction = .TRUE.
+         srcv( jpr_e3t1st )%laction = lk_vvl
+         srcv(jpr_ocx1)%clgrid = 'U'        ! oce components given at U-point
+         srcv(jpr_ocy1)%clgrid = 'V'        !           and           V-point
+         ! Vectors: change of sign at north fold ONLY if on the local grid
+         srcv(jpr_ocx1:jpr_ocy1)%nsgn = -1.
+         ! Change first letter to couple with atmosphere if already coupled OPA
+         ! this is nedeed as each variable name used in the namcouple must be unique:
+         ! for example O_Runoff received by OPA from SAS and therefore O_Runoff received by SAS from the Atmosphere
+         DO jn = 1, jprcv
+            IF ( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname))
+         END DO
+         !
+         IF(lwp) THEN                        ! control print
+            WRITE(numout,*)
+            WRITE(numout,*)'               Special conditions for SAS-OPA coupling  '
+            WRITE(numout,*)'               SAS component  '
+            WRITE(numout,*)
+            IF( .NOT. ln_cpl ) THEN
+               WRITE(numout,*)'  received fields from OPA component '
+            ELSE
+               WRITE(numout,*)'  Additional received fields from OPA component : '
+            ENDIF
+            WRITE(numout,*)'               sea surface temperature (Celcius) '
+            WRITE(numout,*)'               sea surface salinity ' 
+            WRITE(numout,*)'               surface currents ' 
+            WRITE(numout,*)'               sea surface height ' 
+            WRITE(numout,*)'               thickness of first ocean T level '        
+            WRITE(numout,*)'               fraction of solar net radiation absorbed in the first ocean level'
+            WRITE(numout,*)
+         ENDIF
+      ENDIF
+      
+      ! =================================================== !
+      ! Allocate all parts of frcv used for received fields !
+      ! =================================================== !
       DO jn = 1, jprcv
          IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) )
       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 w10m part of frcv which is used even when not received as coupling field
+      IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) )
+      ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field
+      IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) )
+      IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%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
 
@@ -509 +603 @@
       ssnd(jps_tmix)%clname = 'O_TepMix'
       SELECT CASE( TRIM( sn_snd_temp%cldes ) )
-      CASE( 'none'         )       ! nothing to do
-      CASE( 'oce only'             )   ;   ssnd(   jps_toce             )%laction = .TRUE.
-      CASE( 'weighted oce and ice' )
+      CASE( 'none'                                 )       ! nothing to do
+      CASE( 'oce only'                             )   ;   ssnd( jps_toce )%laction = .TRUE.
+      CASE( 'oce and ice' , 'weighted oce and ice' )
          ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE.
          IF ( TRIM( sn_snd_temp%clcat ) == 'yes' )  ssnd(jps_tice)%nct = jpl
-      CASE( 'mixed oce-ice'        )   ;   ssnd(   jps_tmix             )%laction = .TRUE.
+      CASE( 'mixed oce-ice'                        )   ;   ssnd( jps_tmix )%laction = .TRUE.
       CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' )
       END SELECT
-     
+           
       !                                                      ! ------------------------- !
       !                                                      !          Albedo           !
@@ -524 +618 @@
       ssnd(jps_albmix)%clname = 'O_AlbMix'
       SELECT CASE( TRIM( sn_snd_alb%cldes ) )
-      CASE( 'none'          )       ! nothing to do
-      CASE( 'weighted ice'  )   ;   ssnd(jps_albice)%laction = .TRUE.
-      CASE( 'mixed oce-ice' )   ;   ssnd(jps_albmix)%laction = .TRUE.
+      CASE( 'none'                 )     ! nothing to do
+      CASE( 'ice' , 'weighted ice' )   ; ssnd(jps_albice)%laction = .TRUE.
+      CASE( 'mixed oce-ice'        )   ; ssnd(jps_albmix)%laction = .TRUE.
       CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_alb%cldes' )
       END SELECT
@@ -550 +644 @@
          IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl
       ENDIF
-
+      
       SELECT CASE ( TRIM( sn_snd_thick%cldes ) )
       CASE( 'none'         )       ! nothing to do
@@ -557 +651 @@
          IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN
             ssnd(jps_hice:jps_hsnw)%nct = jpl
-         ELSE
-            IF ( jpl > 1 ) THEN
-CALL ctl_stop( 'sbc_cpl_init: use weighted ice and snow option for sn_snd_thick%cldes if not exchanging category fields' )
-            ENDIF
          ENDIF
       CASE ( 'weighted ice and snow' ) 
@@ -599 +689 @@
       !                                                      ! ------------------------- !
       ssnd(jps_co2)%clname = 'O_CO2FLX' ;  IF( TRIM(sn_snd_co2%cldes) == 'coupled' )    ssnd(jps_co2 )%laction = .TRUE.
+
+      !                                                      ! ------------------------------- !
+      !                                                      !   OPA-SAS coupling - snd by opa !   
+      !                                                      ! ------------------------------- !
+      ssnd(jps_ssh   )%clname = 'O_SSHght' 
+      ssnd(jps_soce  )%clname = 'O_SSSal' 
+      ssnd(jps_e3t1st)%clname = 'O_E3T1st'   
+      ssnd(jps_fraqsr)%clname = 'O_FraQsr'
+      !
+      IF( nn_components == jp_iam_opa ) THEN
+         ssnd(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling
+         ssnd( (/jps_toce, jps_soce, jps_ssh, jps_fraqsr, jps_ocx1, jps_ocy1/) )%laction = .TRUE.
+         ssnd( jps_e3t1st )%laction = lk_vvl
+         ! vector definition: not used but cleaner...
+         ssnd(jps_ocx1)%clgrid  = 'U'        ! oce components given at U-point
+         ssnd(jps_ocy1)%clgrid  = 'V'        !           and           V-point
+         sn_snd_crt%clvgrd = 'U,V'
+         sn_snd_crt%clvor = 'local grid'
+         sn_snd_crt%clvref = 'spherical'
+         !
+         IF(lwp) THEN                        ! control print
+            WRITE(numout,*)
+            WRITE(numout,*)'  sent fields to SAS component '
+            WRITE(numout,*)'               sea surface temperature (T before, Celcius) '
+            WRITE(numout,*)'               sea surface salinity ' 
+            WRITE(numout,*)'               surface currents U,V on local grid and spherical coordinates' 
+            WRITE(numout,*)'               sea surface height ' 
+            WRITE(numout,*)'               thickness of first ocean T level '        
+            WRITE(numout,*)'               fraction of solar net radiation absorbed in the first ocean level'
+            WRITE(numout,*)
+         ENDIF
+      ENDIF
+      !                                                      ! ------------------------------- !
+      !                                                      !   OPA-SAS coupling - snd by sas !   
+      !                                                      ! ------------------------------- !
+      ssnd(jps_sflx  )%clname = 'I_SFLX'     
+      ssnd(jps_fice2 )%clname = 'IIceFrc'
+      ssnd(jps_qsroce)%clname = 'I_QsrOce'   
+      ssnd(jps_qnsoce)%clname = 'I_QnsOce'   
+      ssnd(jps_oemp  )%clname = 'IOEvaMPr' 
+      ssnd(jps_otx1  )%clname = 'I_OTaux1'   
+      ssnd(jps_oty1  )%clname = 'I_OTauy1'   
+      ssnd(jps_rnf   )%clname = 'I_Runoff'   
+      ssnd(jps_taum  )%clname = 'I_TauMod'   
+      !
+      IF( nn_components == jp_iam_sas ) THEN
+         IF( .NOT. ln_cpl ) ssnd(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling
+         ssnd( (/jps_qsroce, jps_qnsoce, jps_oemp, jps_fice2, jps_sflx, jps_otx1, jps_oty1, jps_taum/) )%laction = .TRUE.
+         !
+         ! Change first letter to couple with atmosphere if already coupled with sea_ice
+         ! this is nedeed as each variable name used in the namcouple must be unique:
+         ! for example O_SSTSST sent by OPA to SAS and therefore S_SSTSST sent by SAS to the Atmosphere
+         DO jn = 1, jpsnd
+            IF ( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname))
+         END DO
+         !
+         IF(lwp) THEN                        ! control print
+            WRITE(numout,*)
+            IF( .NOT. ln_cpl ) THEN
+               WRITE(numout,*)'  sent fields to OPA component '
+            ELSE
+               WRITE(numout,*)'  Additional sent fields to OPA component : '
+            ENDIF
+            WRITE(numout,*)'                  ice cover '
+            WRITE(numout,*)'                  oce only EMP  '
+            WRITE(numout,*)'                  salt flux  '
+            WRITE(numout,*)'                  mixed oce-ice solar flux  '
+            WRITE(numout,*)'                  mixed oce-ice non solar flux  '
+            WRITE(numout,*)'                  wind stress U,V components'
+            WRITE(numout,*)'                  wind stress module'
+         ENDIF
+      ENDIF
+
       !
       ! ================================ !
@@ -604 +767 @@
       ! ================================ !
 
-      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
+      xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 )
+      !
+      ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'I_QsrOce' ) + cpl_freq( 'I_QsrMix' )
+      IF( ln_dm2dc .AND. ln_cpl .AND. ncpl_qsr_freq /= 86400 )   &
          &   CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' )
+      ncpl_qsr_freq = 86400 / ncpl_qsr_freq
 
       CALL wrk_dealloc( jpi,jpj, zacs, zaos )
@@ -654 +830 @@
       !!
       !! ** 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
@@ -660 +837 @@
       !!                        emp          upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case)
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt       ! ocean model time step index
-      INTEGER, INTENT(in) ::   k_fsbc   ! frequency of sbc (-> ice model) computation 
-      INTEGER, INTENT(in) ::   k_ice    ! ice management in the sbc (=0/1/2/3)
-      !!
-      LOGICAL ::    llnewtx, llnewtau      ! update wind stress components and module??
+      INTEGER, INTENT(in)           ::   kt          ! ocean model time step index
+      INTEGER, INTENT(in)           ::   k_fsbc      ! frequency of sbc (-> ice model) computation 
+      INTEGER, INTENT(in)           ::   k_ice       ! ice management in the sbc (=0/1/2/3)
+
+      !!
+      LOGICAL  ::   llnewtx, llnewtau      ! update wind stress components and module??
       INTEGER  ::   ji, jj, jn             ! dummy loop indices
       INTEGER  ::   isec                   ! number of seconds since nit000 (assuming rdttra did not change since nit000)
@@ -672 +850 @@
       REAL(wp) ::   zcdrag = 1.5e-3        ! drag coefficient
       REAL(wp) ::   zzx, zzy               ! temporary variables
-      REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty 
+      REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty, zmsk, zemp, zqns, zqsr
       !!----------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_rcv')
       !
-      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) )
+      CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr )
+      !
+      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0)
+      !
+      !                                                      ! ======================================================= !
+      !                                                      ! 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_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) )
       END DO
 
@@ -744 +924 @@
          !
       ENDIF
-      
       !                                                      ! ========================= !
       !                                                      !    wind stress module     !   (taum)
@@ -773 +952 @@
          ENDIF
       ENDIF
-      
+      !
       !                                                      ! ========================= !
       !                                                      !      10 m wind speed      !   (wndm)
@@ -786 +965 @@
 !CDIR NOVERRCHK
                DO ji = 1, jpi 
-                  wndm(ji,jj) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )
+                  frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )
                END DO
             END DO
          ENDIF
-      ELSE
-         IF ( nrcvinfo(jpr_w10m) == OASIS_Rcv ) wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1)
       ENDIF
 
@@ -798 +975 @@
       IF( MOD( kt-1, k_fsbc ) == 0 ) THEN
          !
-         utau(:,:) = frcv(jpr_otx1)%z3(:,:,1)
-         vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1)
-         taum(:,:) = frcv(jpr_taum)%z3(:,:,1)
+         IF( ln_mixcpl ) THEN
+            utau(:,:) = utau(:,:) * xcplmask(:,:,0) + frcv(jpr_otx1)%z3(:,:,1) * zmsk(:,:)
+            vtau(:,:) = vtau(:,:) * xcplmask(:,:,0) + frcv(jpr_oty1)%z3(:,:,1) * zmsk(:,:)
+            taum(:,:) = taum(:,:) * xcplmask(:,:,0) + frcv(jpr_taum)%z3(:,:,1) * zmsk(:,:)
+            wndm(:,:) = wndm(:,:) * xcplmask(:,:,0) + frcv(jpr_w10m)%z3(:,:,1) * zmsk(:,:)
+         ELSE
+            utau(:,:) = frcv(jpr_otx1)%z3(:,:,1)
+            vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1)
+            taum(:,:) = frcv(jpr_taum)%z3(:,:,1)
+            wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1)
+         ENDIF
          CALL iom_put( "taum_oce", taum )   ! output wind stress module
          !  
@@ -806 +991 @@
 
 #if defined key_cpl_carbon_cycle
-      !                                                              ! atmosph. CO2 (ppm)
+      !                                                      ! ================== !
+      !                                                      ! atmosph. CO2 (ppm) !
+      !                                                      ! ================== !
       IF( srcv(jpr_co2)%laction )   atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1)
 #endif
 
+      !  Fields received by SAS when OASIS coupling
+      !  (arrays no more filled at sbcssm stage)
+      !                                                      ! ================== !
+      !                                                      !        SSS         !
+      !                                                      ! ================== !
+      IF( srcv(jpr_soce)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling
+         sss_m(:,:) = frcv(jpr_soce)%z3(:,:,1)
+         CALL iom_put( 'sss_m', sss_m )
+      ENDIF
+      !                                               
+      !                                                      ! ================== !
+      !                                                      !        SST         !
+      !                                                      ! ================== !
+      IF( srcv(jpr_toce)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling
+         sst_m(:,:) = frcv(jpr_toce)%z3(:,:,1)
+         IF( srcv(jpr_soce)%laction .AND. ln_useCT ) THEN    ! make sure that sst_m is the potential temperature
+            sst_m(:,:) = eos_pt_from_ct( sst_m(:,:), sss_m(:,:) )
+         ENDIF
+      ENDIF
+      !                                                      ! ================== !
+      !                                                      !        SSH         !
+      !                                                      ! ================== !
+      IF( srcv(jpr_ssh )%laction ) THEN                      ! received by sas in case of opa <-> sas coupling
+         ssh_m(:,:) = frcv(jpr_ssh )%z3(:,:,1)
+         CALL iom_put( 'ssh_m', ssh_m )
+      ENDIF
+      !                                                      ! ================== !
+      !                                                      !  surface currents  !
+      !                                                      ! ================== !
+      IF( srcv(jpr_ocx1)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling
+         ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1)
+         ub (:,:,1) = ssu_m(:,:)                             ! will be used in sbcice_lim in the call of lim_sbc_tau
+         CALL iom_put( 'ssu_m', ssu_m )
+      ENDIF
+      IF( srcv(jpr_ocy1)%laction ) THEN
+         ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1)
+         vb (:,:,1) = ssv_m(:,:)                             ! will be used in sbcice_lim in the call of lim_sbc_tau
+         CALL iom_put( 'ssv_m', ssv_m )
+      ENDIF
+      !                                                      ! ======================== !
+      !                                                      !  first T level thickness !
+      !                                                      ! ======================== !
+      IF( srcv(jpr_e3t1st )%laction ) THEN                   ! received by sas in case of opa <-> sas coupling
+         e3t_m(:,:) = frcv(jpr_e3t1st )%z3(:,:,1)
+         CALL iom_put( 'e3t_m', e3t_m(:,:) )
+      ENDIF
+      !                                                      ! ================================ !
+      !                                                      !  fraction of solar net radiation !
+      !                                                      ! ================================ !
+      IF( srcv(jpr_fraqsr)%laction ) THEN                    ! received by sas in case of opa <-> sas coupling
+         frq_m(:,:) = frcv(jpr_fraqsr)%z3(:,:,1)
+         CALL iom_put( 'frq_m', frq_m )
+      ENDIF
+      
       !                                                      ! ========================= !
-      IF( k_ice <= 1 ) THEN                                  !  heat & freshwater fluxes ! (Ocean only case)
+      IF( k_ice <= 1 .AND. MOD( kt-1, k_fsbc ) == 0 ) THEN   !  heat & freshwater fluxes ! (Ocean only case)
          !                                                   ! ========================= !
          !
          !                                                       ! total freshwater fluxes over the ocean (emp)
-         SELECT CASE( TRIM( sn_rcv_emp%cldes ) )                                    ! evaporation - precipitation
-         CASE( 'conservative' )
-            emp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) )
-         CASE( 'oce only', 'oce and ice' )
-            emp(:,:) = frcv(jpr_oemp)%z3(:,:,1)
-         CASE default
-            CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' )
-         END SELECT
+         IF( srcv(jpr_oemp)%laction .OR. srcv(jpr_rain)%laction ) THEN
+            SELECT CASE( TRIM( sn_rcv_emp%cldes ) )                                    ! evaporation - precipitation
+            CASE( 'conservative' )
+               zemp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) )
+            CASE( 'oce only', 'oce and ice' )
+               zemp(:,:) = frcv(jpr_oemp)%z3(:,:,1)
+            CASE default
+               CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' )
+            END SELECT
+         ELSE
+            zemp(:,:) = 0._wp
+         ENDIF
          !
          !                                                        ! runoffs and calving (added in emp)
-         IF( srcv(jpr_rnf)%laction )   emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1)
-         IF( srcv(jpr_cal)%laction )   emp(:,:) = emp(:,:) - frcv(jpr_cal)%z3(:,:,1)
-         !
-!!gm :  this seems to be internal cooking, not sure to need that in a generic interface 
-!!gm                                       at least should be optional...
-!!         IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN     ! add to the total freshwater budget
-!!            ! remove negative runoff
-!!            zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
-!!            zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )
-!!            IF( lk_mpp )   CALL mpp_sum( zcumulpos )   ! sum over the global domain
-!!            IF( lk_mpp )   CALL mpp_sum( zcumulneg ) 
-!!            IF( zcumulpos /= 0. ) THEN                 ! distribute negative runoff on positive runoff grid points
-!!               zcumulneg = 1.e0 + zcumulneg / zcumulpos
-!!               frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg
-!!            ENDIF     
-!!            ! add runoff to e-p 
-!!            emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1)
-!!         ENDIF
-!!gm  end of internal cooking
+         IF( srcv(jpr_rnf)%laction )     rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
+         IF( srcv(jpr_cal)%laction )     zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1)
+         
+         IF( ln_mixcpl ) THEN   ;   emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:)
+         ELSE                   ;   emp(:,:) =                              zemp(:,:)
+         ENDIF
          !
          !                                                       ! non solar heat flux over the ocean (qns)
-         IF( srcv(jpr_qnsoce)%laction )   qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)
-         IF( srcv(jpr_qnsmix)%laction )   qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
-         ! add the latent heat of solid precip. melting
-         IF( srcv(jpr_snow  )%laction )   THEN                         ! update qns over the free ocean with:
-              qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus  & ! energy for melting solid precipitation over the free ocean
-           &           - emp(:,:) * sst_m(:,:) * rcp                   ! remove heat content due to mass flux (assumed to be at SST)
+         IF(      srcv(jpr_qnsoce)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)
+         ELSE IF( srcv(jpr_qnsmix)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
+         ELSE                                       ;   zqns(:,:) = 0._wp
+         END IF
+         ! update qns over the free ocean with:
+         IF( nn_components /= jp_iam_opa ) THEN
+            zqns(:,:) =  zqns(:,:) - zemp(:,:) * sst_m(:,:) * rcp         ! remove heat content due to mass flux (assumed to be at SST)
+            IF( srcv(jpr_snow  )%laction ) THEN
+               zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus    ! energy for melting solid precipitation over the free ocean
+            ENDIF
+         ENDIF
+         IF( ln_mixcpl ) THEN   ;   qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:)
+         ELSE                   ;   qns(:,:) =                              zqns(:,:)
          ENDIF
 
          !                                                       ! solar flux over the ocean          (qsr)
-         IF( srcv(jpr_qsroce)%laction )   qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1)
-         IF( srcv(jpr_qsrmix)%laction )   qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1)
-         IF( ln_dm2dc )   qsr(:,:) = sbc_dcy( qsr )                           ! modify qsr to include the diurnal cycle
+         IF     ( srcv(jpr_qsroce)%laction ) THEN   ;   zqsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1)
+         ELSE IF( srcv(jpr_qsrmix)%laction ) then   ;   zqsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1)
+         ELSE                                       ;   zqsr(:,:) = 0._wp
+         ENDIF
+         IF( ln_dm2dc .AND. ln_cpl )   zqsr(:,:) = sbc_dcy( zqsr )   ! modify qsr to include the diurnal cycle
+         IF( ln_mixcpl ) THEN   ;   qsr(:,:) = qsr(:,:) * xcplmask(:,:,0) + zqsr(:,:) * zmsk(:,:)
+         ELSE                   ;   qsr(:,:) =                              zqsr(:,:)
+         ENDIF
          !
-  
-      ENDIF
-      !
-      CALL wrk_dealloc( jpi,jpj, ztx, zty )
+         ! salt flux over the ocean (received by opa in case of opa <-> sas coupling)
+         IF( srcv(jpr_sflx )%laction )   sfx(:,:) = frcv(jpr_sflx  )%z3(:,:,1)
+         ! Ice cover  (received by opa in case of opa <-> sas coupling)
+         IF( srcv(jpr_fice )%laction )   fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1)
+         !
+
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr )
       !
       IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_rcv')
@@ -914 +1163 @@
       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 +1170 @@
       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
@@ -961 +1208 @@
             !
          ENDIF
-
          !                                                      ! ======================= !
          !                                                      !     put on ice grid     !
@@ -1083 +1329 @@
    
 
-   SUBROUTINE sbc_cpl_ice_flx( p_frld  , palbi   , psst    , pist    )
+   SUBROUTINE sbc_cpl_ice_flx( p_frld, palbi, psst, pist )
       !!----------------------------------------------------------------------
       !!             ***  ROUTINE sbc_cpl_ice_flx  ***
@@ -1125 +1371 @@
       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 ::   pist    ! ice surface temperature     [Kelvin]
-      !
-      INTEGER ::   jl   ! dummy loop index
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zcptn, ztmp, zicefr
+      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]
+      !
+      INTEGER ::   jl         ! dummy loop index
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zcptn, ztmp, zicefr, zmsk
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zqns_ice, zqsr_ice, zdqns_ice
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zevap, zsnw, zqns_oce, zqsr_oce, zqprec_ice, zqemp_oce ! for LIM3
       !!----------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_ice_flx')
       !
-      CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr )
-
+      CALL wrk_alloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot )
+      CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice )
+
+      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0)
       zicefr(:,:) = 1.- p_frld(:,:)
       zcptn(:,:) = rcp * sst_m(:,:)
@@ -1144 +1395 @@
       !                                                      ! ========================= !
       !
-      !                                                           ! total Precipitations - total Evaporation (emp_tot)
-      !                                                           ! solid precipitation  - sublimation       (emp_ice)
-      !                                                           ! solid Precipitation                      (sprecip)
+      !                                                           ! total Precipitation - total Evaporation (emp_tot)
+      !                                                           ! solid precipitation - sublimation       (emp_ice)
+      !                                                           ! solid Precipitation                     (sprecip)
+      !                                                           ! liquid + solid Precipitation            (tprecip)
       SELECT CASE( TRIM( sn_rcv_emp%cldes ) )
       CASE( 'conservative'  )   ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp
-         sprecip(:,:) = frcv(jpr_snow)%z3(:,:,1)                 ! May need to ensure positive here
-         tprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + sprecip (:,:) ! May need to ensure positive here
-         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)
+         zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1)                  ! May need to ensure positive here
+         ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:)  ! May need to ensure positive here
+         zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:)
+         zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1)
+            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)
-         emp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1)
-         sprecip(:,:) = - frcv(jpr_semp)%z3(:,:,1) + frcv(jpr_ievp)%z3(:,:,1)
+         zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1)
+         zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1)
+         zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1)
+         ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:)
       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)
+      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
-      ENDIF
+      IF( srcv(jpr_rnf)%laction )   rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
       IF( srcv(jpr_cal)%laction ) THEN 
-         emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
-         CALL iom_put( 'calving', frcv(jpr_cal)%z3(:,:,1) )
-      ENDIF
-      !
-!!gm :  this seems to be internal cooking, not sure to need that in a generic interface 
-!!gm                                       at least should be optional...
-!!       ! remove negative runoff                            ! sum over the global domain
-!!       zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
-!!       zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )
-!!       IF( lk_mpp )   CALL mpp_sum( zcumulpos )
-!!       IF( lk_mpp )   CALL mpp_sum( zcumulneg ) 
-!!       IF( zcumulpos /= 0. ) THEN                          ! distribute negative runoff on positive runoff grid points
-!!          zcumulneg = 1.e0 + zcumulneg / zcumulpos
-!!          frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg
-!!       ENDIF     
-!!       emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1)   ! add runoff to e-p 
-!!
-!!gm  end of internal cooking
+         zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
+         CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) )
+      ENDIF
+
+      IF( ln_mixcpl ) THEN
+         emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:)
+         emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:)
+         sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:)
+         tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:)
+      ELSE
+         emp_tot(:,:) =                                  zemp_tot(:,:)
+         emp_ice(:,:) =                                  zemp_ice(:,:)
+         sprecip(:,:) =                                  zsprecip(:,:)
+         tprecip(:,:) =                                  ztprecip(:,:)
+      ENDIF
+
+         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)
 
       !                                                      ! ========================= !
@@ -1199 +1453 @@
       !                                                      ! ========================= !
       CASE( 'oce only' )                                     ! the required field is directly provided
-         qns_tot(:,:  ) = frcv(jpr_qnsoce)%z3(:,:,1)
+         zqns_tot(:,:  ) = frcv(jpr_qnsoce)%z3(:,:,1)
       CASE( 'conservative' )                                      ! the required fields are directly provided
-         qns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1)
+         zqns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1)
          IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
-            qns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl)
+            zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl)
          ELSE
             ! Set all category values equal for the moment
             DO jl=1,jpl
-               qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)
+               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)
             ENDDO
          ENDIF
       CASE( 'oce and ice' )       ! the total flux is computed from ocean and ice fluxes
-         qns_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)
+         zqns_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)
          IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
             DO jl=1,jpl
-               qns_tot(:,:   ) = qns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)   
-               qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl)
+               zqns_tot(:,:   ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)   
+               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl)
             ENDDO
          ELSE
+            qns_tot(:,:   ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
             DO jl=1,jpl
-               qns_tot(:,:   ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
-               qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)
+               zqns_tot(:,:   ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
+               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)
             ENDDO
          ENDIF
       CASE( 'mixed oce-ice' )     ! the ice flux is cumputed from the total flux, the SST and ice informations
 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED **
-         qns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1)
-         qns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1)    &
+         zqns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1)
+         zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1)    &
             &            + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,:  ) ) * p_frld(:,:)   &
             &                                                   +          pist(:,:,1)   * zicefr(:,:) ) )
       END SELECT
-      ztmp(:,:) = p_frld(:,:) * sprecip(:,:) * lfus
-      qns_tot(:,:) = qns_tot(:,:)                         &            ! qns_tot update over free ocean with:
-         &          - ztmp(:,:)                           &            ! remove the latent heat flux of solid precip. melting
-         &          - (  emp_tot(:,:)                     &            ! remove the heat content of mass flux (assumed to be at SST)
-         &             - emp_ice(:,:) * zicefr(:,:)  ) * zcptn(:,:) 
-      IF( lk_diaar5 )   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 
+!!    currently it is taken into account in leads budget but not in the zqns_tot, and thus not in 
 !!    the flux that enter the ocean....
 !!    moreover 1 - it is not diagnose anywhere.... 
@@ -1246 +1495 @@
       IF( srcv(jpr_cal)%laction ) THEN                            ! Iceberg melting 
          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
-      ENDIF
+         zqns_tot(:,:) = zqns_tot(:,:) - ztmp(:,:)
+         IF( iom_use('hflx_cal_cea') )   &
+            CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from calving
+      ENDIF
+
+      ztmp(:,:) = p_frld(:,:) * zsprecip(:,:) * lfus
+      IF( iom_use('hflx_snow_cea') )    CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average)
+
+#if defined key_lim3
+      CALL wrk_alloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 
+
+      ! --- evaporation --- !
+      ! clem: evap_ice is set to 0 for LIM3 since we still do not know what to do with sublimation
+      ! the problem is: the atm. imposes both mass evaporation and heat removed from the snow/ice
+      !                 but it is incoherent WITH the ice model  
+      DO jl=1,jpl
+         evap_ice(:,:,jl) = 0._wp  ! should be: frcv(jpr_ievp)%z3(:,:,1)
+      ENDDO
+      zevap(:,:) = zemp_tot(:,:) + ztprecip(:,:) ! evaporation over ocean
+
+      ! --- evaporation minus precipitation --- !
+      emp_oce(:,:) = emp_tot(:,:) - emp_ice(:,:)
+
+      ! --- non solar flux over ocean --- !
+      !         note: p_frld cannot be = 0 since we limit the ice concentration to amax
+      zqns_oce = 0._wp
+      WHERE( p_frld /= 0._wp )  zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:)
+
+      ! --- heat flux associated with emp --- !
+      zsnw(:,:) = 0._wp
+      CALL lim_thd_snwblow( p_frld, zsnw )  ! snow distribution over ice after wind blowing
+      zqemp_oce(:,:) = -      zevap(:,:)                   * p_frld(:,:)      *   zcptn(:,:)   &      ! evap
+         &             + ( ztprecip(:,:) - zsprecip(:,:) )                    *   zcptn(:,:)   &      ! liquid precip
+         &             +   zsprecip(:,:)                   * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean
+      qemp_ice(:,:)  = -   frcv(jpr_ievp)%z3(:,:,1)        * zicefr(:,:)      *   zcptn(:,:)   &      ! ice evap
+         &             +   zsprecip(:,:)                   * zsnw             * ( zcptn(:,:) - lfus ) ! solid precip over ice
+
+      ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- !
+      zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus )
+
+      ! --- total non solar flux --- !
+      zqns_tot(:,:) = zqns_tot(:,:) + qemp_ice(:,:) + zqemp_oce(:,:)
+
+      ! --- in case both coupled/forced are active, we must mix values --- ! 
+      IF( ln_mixcpl ) THEN
+         qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:)
+         qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:)
+         DO jl=1,jpl
+            qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) +  zqns_ice(:,:,jl)* zmsk(:,:)
+         ENDDO
+         qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:)
+         qemp_oce (:,:) =  qemp_oce(:,:) * xcplmask(:,:,0) +  zqemp_oce(:,:)* zmsk(:,:)
+!!clem         evap_ice(:,:) = evap_ice(:,:) * xcplmask(:,:,0)
+      ELSE
+         qns_tot  (:,:  ) = zqns_tot  (:,:  )
+         qns_oce  (:,:  ) = zqns_oce  (:,:  )
+         qns_ice  (:,:,:) = zqns_ice  (:,:,:)
+         qprec_ice(:,:)   = zqprec_ice(:,:)
+         qemp_oce (:,:)   = zqemp_oce (:,:)
+      ENDIF
+
+      CALL wrk_dealloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 
+#else
+
+      ! clem: this formulation is certainly wrong... but better than it was...
+      zqns_tot(:,:) = zqns_tot(:,:)                       &            ! zqns_tot update over free ocean with:
+         &          - ztmp(:,:)                           &            ! remove the latent heat flux of solid precip. melting
+         &          - (  zemp_tot(:,:)                    &            ! remove the heat content of mass flux (assumed to be at SST)
+         &             - zemp_ice(:,:) * zicefr(:,:)  ) * zcptn(:,:) 
+
+     IF( ln_mixcpl ) THEN
+         qns_tot(:,:) = qns(:,:) * p_frld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk
+         qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) +  zqns_tot(:,:)* zmsk(:,:)
+         DO jl=1,jpl
+            qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) +  zqns_ice(:,:,jl)* zmsk(:,:)
+         ENDDO
+      ELSE
+         qns_tot(:,:  ) = zqns_tot(:,:  )
+         qns_ice(:,:,:) = zqns_ice(:,:,:)
+      ENDIF
+
+#endif
 
       !                                                      ! ========================= !
@@ -1254 +1582 @@
       !                                                      ! ========================= !
       CASE( 'oce only' )
-         qsr_tot(:,:  ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) )
+         zqsr_tot(:,:  ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) )
       CASE( 'conservative' )
-         qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
+         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
          IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
-            qsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl)
+            zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl)
          ELSE
             ! Set all category values equal for the moment
             DO jl=1,jpl
-               qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
+               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
             ENDDO
          ENDIF
-         qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
-         qsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1)
+         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
+         zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1)
       CASE( 'oce and ice' )
-         qsr_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)
+         zqsr_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)
          IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
             DO jl=1,jpl
-               qsr_tot(:,:   ) = qsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)   
-               qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl)
+               zqsr_tot(:,:   ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)   
+               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl)
             ENDDO
          ELSE
+            qsr_tot(:,:   ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
             DO jl=1,jpl
-               qsr_tot(:,:   ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
-               qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
+               zqsr_tot(:,:   ) = zqsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
+               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
             ENDDO
          ENDIF
       CASE( 'mixed oce-ice' )
-         qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
+         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED **
 !       Create solar heat flux over ice using incoming solar heat flux and albedos
 !       ( see OASIS3 user guide, 5th edition, p39 )
-         qsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) )   &
+         zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) )   &
             &            / (  1.- ( albedo_oce_mix(:,:  ) * p_frld(:,:)       &
             &                     + palbi         (:,:,1) * zicefr(:,:) ) )
       END SELECT
-      IF( ln_dm2dc ) THEN   ! modify qsr to include the diurnal cycle
-         qsr_tot(:,:  ) = sbc_dcy( qsr_tot(:,:  ) )
+      IF( ln_dm2dc .AND. ln_cpl ) THEN   ! modify qsr to include the diurnal cycle
+         zqsr_tot(:,:  ) = sbc_dcy( zqsr_tot(:,:  ) )
          DO jl=1,jpl
-            qsr_ice(:,:,jl) = sbc_dcy( qsr_ice(:,:,jl) )
+            zqsr_ice(:,:,jl) = sbc_dcy( zqsr_ice(:,:,jl) )
          ENDDO
       ENDIF
 
-      SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) )
+#if defined key_lim3
+      CALL wrk_alloc( jpi,jpj, zqsr_oce ) 
+      ! --- solar flux over ocean --- !
+      !         note: p_frld cannot be = 0 since we limit the ice concentration to amax
+      zqsr_oce = 0._wp
+      WHERE( p_frld /= 0._wp )  zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / p_frld(:,:)
+
+      IF( ln_mixcpl ) THEN   ;   qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) +  zqsr_oce(:,:)* zmsk(:,:)
+      ELSE                   ;   qsr_oce(:,:) = zqsr_oce(:,:)   ;   ENDIF
+
+      CALL wrk_dealloc( jpi,jpj, zqsr_oce ) 
+#endif
+
+      IF( ln_mixcpl ) THEN
+         qsr_tot(:,:) = qsr(:,:) * p_frld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk
+         qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) +  zqsr_tot(:,:)* zmsk(:,:)
+         DO jl=1,jpl
+            qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) +  zqsr_ice(:,:,jl)* zmsk(:,:)
+         ENDDO
+      ELSE
+         qsr_tot(:,:  ) = zqsr_tot(:,:  )
+         qsr_ice(:,:,:) = zqsr_ice(:,:,:)
+      ENDIF
+
+      !                                                      ! ========================= !
+      SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) )             !          d(qns)/dt        !
+      !                                                      ! ========================= !
       CASE ('coupled')
          IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN
-            dqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)
+            zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)
          ELSE
             ! Set all category values equal for the moment
             DO jl=1,jpl
-               dqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)
+               zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)
             ENDDO
          ENDIF
       END SELECT
-
-      SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) )
+      
+      IF( ln_mixcpl ) THEN
+         DO jl=1,jpl
+            dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:)
+         ENDDO
+      ELSE
+         dqns_ice(:,:,:) = zdqns_ice(:,:,:)
+      ENDIF
+      
+      !                                                      ! ========================= !
+      SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) )             !    topmelt and botmelt    !
+      !                                                      ! ========================= !
       CASE ('coupled')
          topmelt(:,:,:)=frcv(jpr_topm)%z3(:,:,:)
@@ -1314 +1679 @@
       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
-
-
-      CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr )
+      !               ===> 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, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot )
+      CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice )
       !
       IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_ice_flx')
@@ -1336 +1700 @@
       !! ** 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)
       !!----------------------------------------------------------------------
@@ -1343 +1707 @@
       INTEGER ::   ji, jj, jl   ! dummy loop indices
       INTEGER ::   isec, info   ! local integer
+      REAL(wp) ::   zumax, zvmax
       REAL(wp), POINTER, DIMENSION(:,:)   ::   zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmp3, ztmp4   
@@ -1355 +1720 @@
 
       zfr_l(:,:) = 1.- fr_i(:,:)
-
       !                                                      ! ------------------------- !
       !                                                      !    Surface temperature    !   in Kelvin
       !                                                      ! ------------------------- !
       IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN
-         SELECT CASE( sn_snd_temp%cldes)
-         CASE( 'oce only'             )   ;   ztmp1(:,:) =   tsn(:,:,1,jp_tem) + rt0
-         CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:)   
-            SELECT CASE( sn_snd_temp%clcat )
-            CASE( 'yes' )   
-               ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
-            CASE( 'no' )
-               ztmp3(:,:,:) = 0.0
+         
+         IF ( nn_components == jp_iam_opa ) THEN
+            ztmp1(:,:) = tsn(:,:,1,jp_tem)   ! send temperature as it is (potential or conservative) -> use of ln_useCT on the received part
+         ELSE
+            ! we must send the surface potential temperature 
+            IF( ln_useCT )  THEN    ;   ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) )
+            ELSE                    ;   ztmp1(:,:) = tsn(:,:,1,jp_tem)
+            ENDIF
+            !
+            SELECT CASE( sn_snd_temp%cldes)
+            CASE( 'oce only'             )   ;   ztmp1(:,:) =   ztmp1(:,:) + rt0
+            CASE( 'oce and ice'          )   ;   ztmp1(:,:) =   ztmp1(:,:) + rt0
+               SELECT CASE( sn_snd_temp%clcat )
+               CASE( 'yes' )   
+                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl)
+               CASE( 'no' )
+                  WHERE( SUM( a_i, dim=3 ) /= 0. )
+                     ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 )
+                  ELSEWHERE
+                     ztmp3(:,:,1) = rt0 ! TODO: Is freezing point a good default? (Maybe SST is better?)
+                  END WHERE
+               CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
+               END SELECT
+            CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)   
+               SELECT CASE( sn_snd_temp%clcat )
+               CASE( 'yes' )   
+                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
+               CASE( 'no' )
+                  ztmp3(:,:,:) = 0.0
+                  DO jl=1,jpl
+                     ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)
+                  ENDDO
+               CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
+               END SELECT
+            CASE( 'mixed oce-ice'        )   
+               ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) 
                DO jl=1,jpl
-                  ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)
+                  ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl)
                ENDDO
-            CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
+            CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' )
             END SELECT
-         CASE( 'mixed oce-ice'        )   
-            ztmp1(:,:) = ( tsn(:,:,1,1) + rt0 ) * zfr_l(:,:) 
-            DO jl=1,jpl
-               ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl)
-            ENDDO
-         CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' )
+         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          !
+      !                                                      ! ------------------------- !
+      IF( ssnd(jps_albice)%laction ) THEN                         ! ice 
+         SELECT CASE( sn_snd_alb%cldes )
+         CASE( 'ice'          )   ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl)
+         CASE( 'weighted ice' )   ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
+         CASE default             ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%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
-      !
-      !                                                      ! ------------------------- !
-      !                                                      !           Albedo          !
-      !                                                      ! ------------------------- !
-      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 +1786 @@
             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
       !                                                      ! ------------------------- !
       !                                                      !  Ice fraction & Thickness ! 
       !                                                      ! ------------------------- !
-      ! Send ice fraction field 
+      ! Send ice fraction field to atmosphere
       IF( ssnd(jps_fice)%laction ) THEN
          SELECT CASE( sn_snd_thick%clcat )
@@ -1409 +1798 @@
          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 )
+         IF( ssnd(jps_fice)%laction )   CALL cpl_snd( jps_fice, isec, ztmp3, info )
+      ENDIF
+      
+      ! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling)
+      IF( ssnd(jps_fice2)%laction ) THEN
+         ztmp3(:,:,1) = fr_i(:,:)
+         IF( ssnd(jps_fice2)%laction )   CALL cpl_snd( jps_fice2, isec, ztmp3, info )
       ENDIF
 
@@ -1430 +1825 @@
             END SELECT
          CASE( 'ice and snow'         )   
-            ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl)
-            ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl)
+            SELECT CASE( sn_snd_thick%clcat )
+            CASE( 'yes' )
+               ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl)
+               ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl)
+            CASE( 'no' )
+               WHERE( SUM( a_i, dim=3 ) /= 0. )
+                  ztmp3(:,:,1) = SUM( ht_i * a_i, dim=3 ) / SUM( a_i, dim=3 )
+                  ztmp4(:,:,1) = SUM( ht_s * a_i, dim=3 ) / SUM( a_i, dim=3 )
+               ELSEWHERE
+                 ztmp3(:,:,1) = 0.
+                 ztmp4(:,:,1) = 0.
+               END WHERE
+            CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
+            END SELECT
          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 +1849 @@
       !                                                      !  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
@@ -1457 +1864 @@
          !                                                              i-1  i   i
          !                                                               i      i+1 (for I)
-         SELECT CASE( TRIM( sn_snd_crt%cldes ) )
-         CASE( 'oce only'             )      ! C-grid ==> T
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) )
-                  zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) ) 
-               END DO
-            END DO
-         CASE( 'weighted oce and ice' )   
-            SELECT CASE ( cp_ice_msh )
-            CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T
+         IF( nn_components == jp_iam_opa ) THEN
+            zotx1(:,:) = un(:,:,1)  
+            zoty1(:,:) = vn(:,:,1)  
+         ELSE        
+            SELECT CASE( TRIM( sn_snd_crt%cldes ) )
+            CASE( 'oce only'             )      ! C-grid ==> T
                DO jj = 2, jpjm1
                   DO ji = fs_2, fs_jpim1   ! vector opt.
-                     zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)  
-                     zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)
-                     zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)
-                     zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)
+                     zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) )
+                     zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) ) 
                   END DO
                END DO
-            CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T
-               DO jj = 2, jpjm1
-                  DO ji = 2, jpim1   ! NO vector opt.
-                     zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)  
-                     zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)  
-                     zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     &
-                        &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
-                     zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     &
-                        &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
+            CASE( 'weighted oce and ice' )   
+               SELECT CASE ( cp_ice_msh )
+               CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                        zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)  
+                        zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)
+                        zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)
+                        zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)
+                     END DO
                   END DO
-               END DO
-            CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T
-               DO jj = 2, jpjm1
-                  DO ji = 2, jpim1   ! NO vector opt.
-                     zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)  
-                     zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)  
-                     zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     &
-                        &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
-                     zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     &
-                        &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
+               CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T
+                  DO jj = 2, jpjm1
+                     DO ji = 2, jpim1   ! NO vector opt.
+                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)  
+                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)  
+                        zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     &
+                           &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
+                        zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     &
+                           &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
+                     END DO
                   END DO
-               END DO
+               CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T
+                  DO jj = 2, jpjm1
+                     DO ji = 2, jpim1   ! NO vector opt.
+                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)  
+                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)  
+                        zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     &
+                           &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
+                        zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     &
+                           &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
+                     END DO
+                  END DO
+               END SELECT
+               CALL lbc_lnk( zitx1, 'T', -1. )   ;   CALL lbc_lnk( zity1, 'T', -1. )
+            CASE( 'mixed oce-ice'        )
+               SELECT CASE ( cp_ice_msh )
+               CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                        zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   &
+                           &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)
+                        zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)   &
+                           &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)
+                     END DO
+                  END DO
+               CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T
+                  DO jj = 2, jpjm1
+                     DO ji = 2, jpim1   ! NO vector opt.
+                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &   
+                           &         + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     &
+                           &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
+                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   & 
+                           &         + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     &
+                           &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
+                     END DO
+                  END DO
+               CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T
+                  DO jj = 2, jpjm1
+                     DO ji = 2, jpim1   ! NO vector opt.
+                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &   
+                           &         + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     &
+                           &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
+                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   & 
+                           &         + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     &
+                           &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
+                     END DO
+                  END DO
+               END SELECT
             END SELECT
-            CALL lbc_lnk( zitx1, 'T', -1. )   ;   CALL lbc_lnk( zity1, 'T', -1. )
-         CASE( 'mixed oce-ice'        )
-            SELECT CASE ( cp_ice_msh )
-            CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   &
-                        &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)
-                     zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)   &
-                        &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)
-                  END DO
-               END DO
-            CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T
-               DO jj = 2, jpjm1
-                  DO ji = 2, jpim1   ! NO vector opt.
-                     zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &   
-                        &         + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     &
-                        &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
-                     zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   & 
-                        &         + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     &
-                        &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
-                  END DO
-               END DO
-            CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T
-               DO jj = 2, jpjm1
-                  DO ji = 2, jpim1   ! NO vector opt.
-                     zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &   
-                        &         + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     &
-                        &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
-                     zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   & 
-                        &         + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     &
-                        &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
-                  END DO
-               END DO
-            END SELECT
-         END SELECT
-         CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. )   ;   CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. )
+            CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. )   ;   CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. )
+            !
+         ENDIF
          !
          !
@@ -1565 +1978 @@
          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
       !
+      !
+      !  Fields sent by OPA to SAS when doing OPA<->SAS coupling
+      !                                                        ! SSH
+      IF( ssnd(jps_ssh )%laction )  THEN
+         !                          ! removed inverse barometer ssh when Patm
+         !                          forcing is used (for sea-ice dynamics)
+         IF( ln_apr_dyn ) THEN   ;   ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
+         ELSE                    ;   ztmp1(:,:) = sshn(:,:)
+         ENDIF
+         CALL cpl_snd( jps_ssh   , isec, RESHAPE ( ztmp1            , (/jpi,jpj,1/) ), info )
+
+      ENDIF
+      !                                                        ! SSS
+      IF( ssnd(jps_soce  )%laction )  THEN
+         CALL cpl_snd( jps_soce  , isec, RESHAPE ( tsn(:,:,1,jp_sal), (/jpi,jpj,1/) ), info )
+      ENDIF
+      !                                                        ! first T level thickness 
+      IF( ssnd(jps_e3t1st )%laction )  THEN
+         CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( fse3t_n(:,:,1)   , (/jpi,jpj,1/) ), info )
+      ENDIF
+      !                                                        ! Qsr fraction
+      IF( ssnd(jps_fraqsr)%laction )  THEN
+         CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( fraqsr_1lev(:,:) , (/jpi,jpj,1/) ), info )
+      ENDIF
+      !
+      !  Fields sent by SAS to OPA when OASIS coupling
+      !                                                        ! Solar heat flux
+      IF( ssnd(jps_qsroce)%laction )  CALL cpl_snd( jps_qsroce, isec, RESHAPE ( qsr , (/jpi,jpj,1/) ), info )
+      IF( ssnd(jps_qnsoce)%laction )  CALL cpl_snd( jps_qnsoce, isec, RESHAPE ( qns , (/jpi,jpj,1/) ), info )
+      IF( ssnd(jps_oemp  )%laction )  CALL cpl_snd( jps_oemp  , isec, RESHAPE ( emp , (/jpi,jpj,1/) ), info )
+      IF( ssnd(jps_sflx  )%laction )  CALL cpl_snd( jps_sflx  , isec, RESHAPE ( sfx , (/jpi,jpj,1/) ), info )
+      IF( ssnd(jps_otx1  )%laction )  CALL cpl_snd( jps_otx1  , isec, RESHAPE ( utau, (/jpi,jpj,1/) ), info )
+      IF( ssnd(jps_oty1  )%laction )  CALL cpl_snd( jps_oty1  , isec, RESHAPE ( vtau, (/jpi,jpj,1/) ), info )
+      IF( ssnd(jps_rnf   )%laction )  CALL cpl_snd( jps_rnf   , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info )
+      IF( ssnd(jps_taum  )%laction )  CALL cpl_snd( jps_taum  , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info )
+
       CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )
       CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 )
@@ -1582 +2031 @@
    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

branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90

@@ -156 +156 @@
             END DO
          END DO
+         taum(:,:) = taum(:,:) * tmask(:,:,1) ; wndm(:,:) = wndm(:,:) * tmask(:,:,1)
          CALL lbc_lnk( taum(:,:), 'T', 1. )   ;   CALL lbc_lnk( wndm(:,:), 'T', 1. )
 

branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90

@@ -8 +8 @@
    !!            3.0  ! 2006-08  (G. Madec)  Surface module
    !!            3.2  ! 2009-07  (C. Talandier) emp mean s spread over erp area 
+   !!            3.6  ! 2014-11  (P. Mathiot  ) add ice shelf melting
    !!----------------------------------------------------------------------
 
@@ -19 +20 @@
    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 +59 @@
       !!                =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 +85 @@
             IF( kn_fwb == 1 )   WRITE(numout,*) '          instantaneously set to zero'
             IF( kn_fwb == 2 )   WRITE(numout,*) '          adjusted from previous year budget'
-         ENDIF
-         !
-         area = glob_sum( e1e2t(:,:) )           ! interior global domain surface
-         !
-#if ! defined key_lim2 &&  ! defined key_lim3 && ! defined key_cice 
+            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 ' )
+         IF( kn_fwb == 3 .AND. ln_isfcav    )   CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 with ln_isfcav = .TRUE. not working, we stop ' )
+         !
+         area = glob_sum( e1e2t(:,:) * tmask(:,:,1))           ! interior global domain surface
+         ! isf cavities are excluded because it can feedback to the melting with generation of inhibition of plumes
+         ! and in case of no melt, it can generate HSSW.
+         !
+#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 +108 @@
          !
          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 
-            qns(:,:) = qns(:,:) + zcoef * sst_m(:,:)  ! account for change to the heat budget due to fw correction
+            emp(:,:) = emp(:,:) - z_fwf              * tmask(:,:,1)
+            qns(:,:) = qns(:,:) + zcoef * sst_m(:,:) * tmask(:,:,1) ! account for change to the heat budget due to fw correction
          ENDIF
          !
@@ -132 +142 @@
          IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN         ! correct the freshwater fluxes
             zcoef = fwfold * rcp
-            emp(:,:) = emp(:,:) + fwfold
-            qns(:,:) = qns(:,:) - zcoef * sst_m(:,:)  ! account for change to the heat budget due to fw correction
+            emp(:,:) = emp(:,:) + fwfold             * tmask(:,:,1)
+            qns(:,:) = qns(:,:) - zcoef * sst_m(:,:) * tmask(:,:,1) ! account for change to the heat budget due to fw correction
          ENDIF
          !
@@ -142 +152 @@
          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(:,:) + rdivisf * fwfisf(:,:) - 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

branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

@@ -17 +17 @@
    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 +24 @@
    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 +38 @@
    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,  &
+                strocnxT,strocnyT,                               & 
                 sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_gbm,     &
                 fresh_gbm,fhocn_gbm,fswthru_gbm,frzmlt,          &
@@ -44 +46 @@
                 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,  &
+                strocnxT,strocnyT,                               & 
+                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
@@ -84 +96 @@
 #  include "domzgr_substitute.h90"
 
+   !! $Id$
 CONTAINS
 
@@ -95 +108 @@
    END FUNCTION sbc_ice_cice_alloc
 
-   SUBROUTINE sbc_ice_cice( kt, nsbc )
+   SUBROUTINE sbc_ice_cice( kt, ksbc )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE sbc_ice_cice  ***
@@ -113 +126 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt      ! ocean time step
-      INTEGER, INTENT(in) ::   nsbc    ! surface forcing type
+      INTEGER, INTENT(in) ::   ksbc    ! surface forcing type
       !!----------------------------------------------------------------------
       !
@@ -123 +136 @@
 
          ! 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_purecpl ) 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_purecpl )  CALL cice_sbc_hadgam(kt+1)
 
       ENDIF                                          ! End sea-ice time step only
@@ -141 +154 @@
    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 +174 @@
       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_purecpl) ) 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 +212 @@
 
       CALL cice2nemo(aice,fr_i, 'T', 1. )
-      IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN
+      IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN
          DO jl=1,ncat
             CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. )
@@ -218 +240 @@
          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 +289 @@
 
    
-   SUBROUTINE cice_sbc_in (kt, nsbc)
+   SUBROUTINE cice_sbc_in (kt, ksbc)
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE cice_sbc_in  ***
@@ -238 +295 @@
       !!---------------------------------------------------------------------
       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 +319 @@
 ! forced and coupled case 
 
-      IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN
+      IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN
 
          ztmpn(:,:,:)=0.0
@@ -287 +344 @@
 
 ! 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 +373 @@
 ! 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 +382 @@
 ! 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 +390 @@
          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 +432 @@
 
 ! 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. ) 
@@ -450 +509 @@
       CALL nemo2cice(ztmp,ss_tlty,'F', -1. )
 
-      CALL wrk_dealloc( jpi,jpj, ztmp )
+      CALL wrk_dealloc( jpi,jpj, ztmp, zpice )
       CALL wrk_dealloc( jpi,jpj,ncat, ztmpn )
       !
@@ -458 +517 @@
 
 
-   SUBROUTINE cice_sbc_out (kt,nsbc)
+   SUBROUTINE cice_sbc_out (kt,ksbc)
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE cice_sbc_out  ***
@@ -464 +523 @@
       !!---------------------------------------------------------------------
       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
@@ -504 +563 @@
 ! Combine wind stress and ocean-ice stress
 ! [Note that fr_iu hasn't yet been updated, so still from start of CICE timestep]
+! strocnx and strocny already weighted by ice fraction in CICE so not done here 
 
       utau(:,:)=(1.0-fr_iu(:,:))*utau(:,:)-ss_iou(:,:)
       vtau(:,:)=(1.0-fr_iv(:,:))*vtau(:,:)-ss_iov(:,:)     
+ 
+! Also need ice/ocean stress on T points so that taum can be updated 
+! This interpolation is already done in CICE so best to use those values 
+      CALL cice2nemo(strocnxT,ztmp1,'T',-1.) 
+      CALL cice2nemo(strocnyT,ztmp2,'T',-1.) 
+ 
+! Update taum with modulus of ice-ocean stress 
+! strocnxT and strocnyT are not weighted by ice fraction in CICE so must be done here 
+taum(:,:)=(1.0-fr_i(:,:))*taum(:,:)+fr_i(:,:)*SQRT(ztmp1**2. + ztmp2**2.) 
 
 ! 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 +585 @@
 ! 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_purecpl) 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 +593 @@
       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 +609 @@
       sfx(:,:)=ztmp2(:,:)*1000.0
       emp(:,:)=emp(:,:)-ztmp1(:,:)
- 
+      fmmflx(:,:) = ztmp1(:,:) !!Joakim edit
+      
       CALL lbc_lnk( emp , 'T', 1. )
       CALL lbc_lnk( sfx , 'T', 1. )
@@ -543 +618 @@
 ! 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_purecpl) THEN
          qsr(:,:)= qsr_tot(:,:)
          qns(:,:)= qns_tot(:,:)
@@ -557 +632 @@
 ! 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 +646 @@
       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 +658 @@
 
       CALL cice2nemo(aice,fr_i,'T', 1. )
-      IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN
+      IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN
          DO jl=1,ncat
             CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. )
@@ -611 +694 @@
 
 
-#if defined key_oasis3 || defined key_oasis4
    SUBROUTINE cice_sbc_hadgam( kt )
       !!---------------------------------------------------------------------
@@ -653 +735 @@
    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 +789 @@
       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)
@@ -999 +1096 @@
    !!   Default option           Dummy module         NO CICE sea-ice model
    !!----------------------------------------------------------------------
+   !! $Id$
 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

branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90

@@ -16 +16 @@
    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 +103 @@
                                  ! ( 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( ln_cpl )   a_i(:,:,1) = fr_i(:,:)         
 
          ! Flux and ice fraction computation
-!CDIR COLLAPSE
          DO jj = 1, jpj
             DO ji = 1, jpi

branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

@@ -12 +12 @@
    !!            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
@@ -18 +19 @@
    !!----------------------------------------------------------------------
    !!   sbc_ice_lim  : sea-ice model time-stepping and update ocean sbc over ice-covered area
-   !!   lim_ctl       : alerts in case of ice model crash
-   !!   lim_prt_state : ice control print at a given grid point
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
-   USE par_ice         ! sea-ice parameters
    USE ice             ! LIM-3: ice variables
-   USE iceini          ! LIM-3: ice initialisation
+   USE thd_ice         ! LIM-3: thermodynamical variables
    USE dom_ice         ! LIM-3: ice domain
 
@@ -39 +37 @@
    USE limdyn          ! Ice dynamics
    USE limtrp          ! Ice transport
+   USE limhdf          ! Ice horizontal diffusion
    USE limthd          ! Ice thermodynamics
-   USE limitd_th       ! Thermodynamics on ice thickness distribution 
    USE limitd_me       ! Mechanics on ice thickness distribution
    USE limsbc          ! sea surface boundary condition
@@ -46 +44 @@
    USE limwri          ! Ice outputs
    USE limrst          ! Ice restarts
-   USE limupdate1       ! update of global variables
-   USE limupdate2       ! update of global variables
+   USE limupdate1      ! update of global variables
+   USE limupdate2      ! update of global variables
    USE limvar          ! Ice variables switch
+
+   USE limmsh          ! LIM mesh
+   USE limistate       ! LIM initial state
+   USE limthd_sal      ! LIM ice thermodynamics: salinity
 
    USE c1d             ! 1D vertical configuration
@@ -59 +61 @@
    USE prtctl          ! Print control
    USE lib_fortran     ! 
+   USE limctl
 
 #if defined key_bdy 
@@ -68 +71 @@
 
    PUBLIC sbc_ice_lim  ! routine called by sbcmod.F90
+   PUBLIC sbc_lim_init ! routine called by sbcmod.F90
    
    !! * Substitutions
@@ -79 +83 @@
 CONTAINS
 
-   FUNCTION fice_cell_ave ( ptab)
+   !!======================================================================
+
+   SUBROUTINE sbc_ice_lim( kt, kblk )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_ice_lim  ***
+      !!                   
+      !! ** Purpose :   update the ocean surface boundary condition via the 
+      !!                Louvain la Neuve Sea Ice Model time stepping 
+      !!
+      !! ** Method  :   ice model time stepping
+      !!              - call the ice dynamics routine 
+      !!              - call the ice advection/diffusion routine 
+      !!              - call the ice thermodynamics routine 
+      !!              - call the routine that computes mass and 
+      !!                heat fluxes at the ice/ocean interface
+      !!              - save the outputs 
+      !!              - save the outputs for restart when necessary
+      !!
+      !! ** Action  : - time evolution of the LIM sea-ice model
+      !!              - update all sbc variables below sea-ice:
+      !!                utau, vtau, taum, wndm, qns , qsr, emp , sfx 
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt      ! ocean time step
+      INTEGER, INTENT(in) ::   kblk    ! type of bulk (=3 CLIO, =4 CORE, =5 COUPLED)
+      !!
+      INTEGER  ::   jl                 ! dummy loop index
+      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)
+      REAL(wp), POINTER, DIMENSION(:,:  )   ::   zutau_ice, zvtau_ice 
+      !!----------------------------------------------------------------------
+
+      IF( nn_timing == 1 )  CALL timing_start('sbc_ice_lim')
+
+      !-----------------------!
+      ! --- Ice time step --- !
+      !-----------------------!
+      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN
+
+         ! mean surface ocean current at ice velocity point (C-grid dynamics :  U- & V-points as the ocean)
+         u_oce(:,:) = ssu_m(:,:) * umask(:,:,1)
+         v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1)
+         
+         ! masked sea surface freezing temperature [Kelvin] (set to rt0 over land)
+         t_bo(:,:) = ( eos_fzp( sss_m ) + rt0 ) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) )  
+         
+         ! Mask sea ice surface temperature (set to rt0 over land)
+         DO jl = 1, jpl
+            t_su(:,:,jl) = t_su(:,:,jl) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) )
+         END DO     
+         !
+         !------------------------------------------------!                                           
+         ! --- Dynamical coupling with the atmosphere --- !                                           
+         !------------------------------------------------!
+         ! It provides the following fields:
+         ! utau_ice, vtau_ice : surface ice stress (U- & V-points)   [N/m2]
+         !-----------------------------------------------------------------
+         SELECT CASE( kblk )
+         CASE( jp_clio    )   ;   CALL blk_ice_clio_tau                         ! CLIO bulk formulation            
+         CASE( jp_core    )   ;   CALL blk_ice_core_tau                         ! CORE bulk formulation
+         CASE( jp_purecpl )   ;   CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )   ! Coupled   formulation
+         END SELECT
+         
+         IF( ln_mixcpl) THEN   ! Case of a mixed Bulk/Coupled formulation
+            CALL wrk_alloc( jpi,jpj    , zutau_ice, zvtau_ice)
+            CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice )
+            utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) )
+            vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) )
+            CALL wrk_dealloc( jpi,jpj  , zutau_ice, zvtau_ice)
+         ENDIF
+
+         !-------------------------------------------------------!
+         ! --- ice dynamics and transport (except in 1D case) ---!
+         !-------------------------------------------------------!
+         numit = numit + nn_fsbc                  ! Ice model time step
+         !                                                   
+         CALL sbc_lim_bef                         ! Store previous ice values
+         CALL sbc_lim_diag0                       ! set diag of mass, heat and salt fluxes to 0
+         CALL lim_rst_opn( kt )                   ! Open Ice restart file
+         !
+         IF( .NOT. lk_c1d ) THEN
+            !
+            CALL lim_dyn( kt )                    ! Ice dynamics    ( rheology/dynamics )   
+            !
+            CALL lim_trp( kt )                    ! Ice transport   ( Advection/diffusion )
+            !
+            IF( nn_monocat /= 2 ) CALL lim_itd_me ! Mechanical redistribution ! (ridging/rafting)
+            !
+#if defined key_bdy
+            CALL bdy_ice_lim( kt )                ! bdy ice thermo 
+            IF( ln_icectl )       CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' )
+#endif
+            !
+            CALL lim_update1( kt )                ! Corrections
+            !
+         ENDIF
+         
+         ! previous lead fraction and ice volume for flux calculations
+         CALL sbc_lim_bef                        
+         CALL lim_var_glo2eqv                     ! ht_i and ht_s for ice albedo calculation
+         CALL lim_var_agg(1)                      ! at_i for coupling (via pfrld) 
+         pfrld(:,:)   = 1._wp - at_i(:,:)
+         phicif(:,:)  = vt_i(:,:)
+         
+         !------------------------------------------------------!                                           
+         ! --- Thermodynamical coupling with the atmosphere --- !                                           
+         !------------------------------------------------------!
+         ! It provides the following fields:
+         ! qsr_ice , qns_ice  : solar & non solar heat flux over ice   (T-point)         [W/m2]
+         ! qla_ice            : latent heat flux over ice              (T-point)         [W/m2]
+         ! dqns_ice, dqla_ice : non solar & latent heat sensistivity   (T-point)         [W/m2]
+         ! tprecip , sprecip  : total & solid precipitation            (T-point)         [Kg/m2/s]
+         ! fr1_i0  , fr2_i0   : 1sr & 2nd fraction of qsr penetration in ice             [%]
+         !----------------------------------------------------------------------------------------
+         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_clio )                                       ! CLIO bulk formulation
+            ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo 
+            ! (zalb_ice) is computed within the bulk routine
+            CALL blk_ice_clio_flx( t_su, zalb_cs, zalb_os, zalb_ice )
+            IF( ln_mixcpl      ) 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, evap_ice, devap_ice, nn_limflx )
+         CASE( jp_core )                                       ! CORE bulk formulation
+            ! albedo depends on cloud fraction because of non-linear spectral effects
+            zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
+            CALL blk_ice_core_flx( t_su, zalb_ice )
+            IF( ln_mixcpl      ) 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, evap_ice, devap_ice, nn_limflx )
+         CASE ( jp_purecpl )
+            ! albedo depends on cloud fraction because of non-linear spectral effects
+            zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
+                                 CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su )
+            ! clem: evap_ice is forced to 0 in coupled mode for now 
+            !       but it needs to be changed (along with modif in limthd_dh) once heat flux from evap will be avail. from atm. models
+            evap_ice  (:,:,:) = 0._wp   ;   devap_ice (:,:,:) = 0._wp
+            IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx )
+         END SELECT
+         CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice )
+
+         !----------------------------!
+         ! --- ice thermodynamics --- !
+         !----------------------------!
+         CALL lim_thd( kt )                         ! Ice thermodynamics      
+         !
+         CALL lim_update2( kt )                     ! Corrections
+         !
+         CALL lim_sbc_flx( kt )                     ! Update surface ocean mass, heat and salt fluxes
+         !
+         IF(ln_limdiaout) CALL lim_diahsb           ! Diagnostics and outputs 
+         !
+         CALL lim_wri( 1 )                          ! Ice outputs 
+         !
+         IF( kt == nit000 .AND. ln_rstart )   &
+            &             CALL iom_close( numrir )  ! close input ice restart file
+         !
+         IF( lrst_ice )   CALL lim_rst_write( kt )  ! Ice restart file 
+         !
+         IF( ln_icectl )  CALL lim_ctl( kt )        ! alerts in case of model crash
+         !
+      ENDIF   ! End sea-ice time step only
+
+      !-------------------------!
+      ! --- Ocean time step --- !
+      !-------------------------!
+      ! Update surface ocean stresses (only in ice-dynamic case) 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!!!
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('sbc_ice_lim')
+      !
+   END SUBROUTINE sbc_ice_lim
+   
+
+   SUBROUTINE sbc_lim_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_lim_init  ***
+      !!
+      !! ** purpose :   Allocate all the dynamic arrays of the LIM-3 modules
+      !!----------------------------------------------------------------------
+      INTEGER :: ierr
+      !!----------------------------------------------------------------------
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'sbc_ice_lim : update ocean surface boudary condition' 
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   via Louvain la Neuve Ice Model (LIM-3) time stepping'
+      !
+                                       ! Open the reference and configuration namelist files and namelist output file 
+      CALL ctl_opn( numnam_ice_ref, 'namelist_ice_ref',    'OLD',     'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 
+      CALL ctl_opn( numnam_ice_cfg, 'namelist_ice_cfg',    'OLD',     'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
+      IF(lwm) CALL ctl_opn( numoni, 'output.namelist.ice', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, 1 )
+
+      CALL ice_run                     ! set some ice run parameters
+      !
+      !                                ! Allocate the ice arrays
+      ierr =        ice_alloc        ()      ! ice variables
+      ierr = ierr + dom_ice_alloc    ()      ! domain
+      ierr = ierr + sbc_ice_alloc    ()      ! surface forcing
+      ierr = ierr + thd_ice_alloc    ()      ! thermodynamics
+      ierr = ierr + lim_itd_me_alloc ()      ! ice thickness distribution - mechanics
+      !
+      IF( lk_mpp    )   CALL mpp_sum( ierr )
+      IF( ierr /= 0 )   CALL ctl_stop('STOP', 'sbc_lim_init : unable to allocate ice arrays')
+      !
+      !                                ! adequation jpk versus ice/snow layers/categories
+      IF( jpl > jpk .OR. (nlay_i+1) > jpk .OR. nlay_s > jpk )   &
+         &      CALL ctl_stop( 'STOP',                          &
+         &     'sbc_lim_init: the 3rd dimension of workspace arrays is too small.',   &
+         &     'use more ocean levels or less ice/snow layers/categories.' )
+      !
+      CALL lim_itd_init                ! ice thickness distribution initialization
+      !
+      CALL lim_hdf_init                ! set ice horizontal diffusion computation parameters
+      !
+      CALL lim_thd_init                ! set ice thermodynics parameters
+      !
+      CALL lim_thd_sal_init            ! set ice salinity parameters
+      !
+      CALL lim_msh                     ! ice mesh initialization
+      !
+      CALL lim_itd_me_init             ! ice thickness distribution initialization for mecanical deformation
+      !                                ! Initial sea-ice state
+      IF( .NOT. ln_rstart ) THEN              ! start from rest: sea-ice deduced from sst
+         numit = 0
+         numit = nit000 - 1
+         CALL lim_istate
+      ELSE                                    ! start from a restart file
+         CALL lim_rst_read
+         numit = nit000 - 1
+      ENDIF
+      CALL lim_var_agg(1)
+      CALL lim_var_glo2eqv
+      !
+      CALL lim_sbc_init                 ! ice surface boundary condition   
+      !
+      fr_i(:,:)     = at_i(:,:)         ! initialisation of sea-ice fraction
+      tn_ice(:,:,:) = t_su(:,:,:)       ! initialisation of surface temp for coupled simu
+      !
+      nstart = numit  + nn_fsbc      
+      nitrun = nitend - nit000 + 1 
+      nlast  = numit  + nitrun 
+      !
+      IF( nstock == 0 )   nstock = nlast + 1
+      !
+   END SUBROUTINE sbc_lim_init
+
+
+   SUBROUTINE ice_run
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE ice_run ***
+      !!                 
+      !! ** Purpose :   Definition some run parameter for ice model
+      !!
+      !! ** Method  :   Read the namicerun namelist and check the parameter 
+      !!              values called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namicerun
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      NAMELIST/namicerun/ jpl, nlay_i, nlay_s, cn_icerst_in, cn_icerst_indir, cn_icerst_out, cn_icerst_outdir,  &
+         &                ln_limdyn, rn_amax, ln_limdiahsb, ln_limdiaout, ln_icectl, iiceprt, jiceprt  
+      !!-------------------------------------------------------------------
+      !                    
+      REWIND( numnam_ice_ref )              ! Namelist namicerun in reference namelist : Parameters for ice
+      READ  ( numnam_ice_ref, namicerun, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )              ! Namelist namicerun in configuration namelist : Parameters for ice
+      READ  ( numnam_ice_cfg, namicerun, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namicerun )
+      !
+      !
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'ice_run : ice share parameters for dynamics/advection/thermo of sea-ice'
+         WRITE(numout,*) ' ~~~~~~'
+         WRITE(numout,*) '   number of ice  categories                               = ', jpl
+         WRITE(numout,*) '   number of ice  layers                                   = ', nlay_i
+         WRITE(numout,*) '   number of snow layers                                   = ', nlay_s
+         WRITE(numout,*) '   switch for ice dynamics (1) or not (0)      ln_limdyn   = ', ln_limdyn
+         WRITE(numout,*) '   maximum ice concentration                               = ', rn_amax 
+         WRITE(numout,*) '   Diagnose heat/salt budget or not          ln_limdiahsb  = ', ln_limdiahsb
+         WRITE(numout,*) '   Output   heat/salt budget or not          ln_limdiaout  = ', ln_limdiaout
+         WRITE(numout,*) '   control prints in ocean.out for (i,j)=(iiceprt,jiceprt) = ', ln_icectl
+         WRITE(numout,*) '   i-index for control prints (ln_icectl=true)             = ', iiceprt
+         WRITE(numout,*) '   j-index for control prints (ln_icectl=true)             = ', jiceprt
+      ENDIF
+      !
+      ! sea-ice timestep and inverse
+      rdt_ice   = nn_fsbc * rdttra(1)  
+      r1_rdtice = 1._wp / rdt_ice 
+
+      ! inverse of nlay_i and nlay_s
+      r1_nlay_i = 1._wp / REAL( nlay_i, wp )
+      r1_nlay_s = 1._wp / REAL( nlay_s, wp )
+      !
+#if defined key_bdy
+      IF( lwp .AND. ln_limdiahsb )  CALL ctl_warn('online conservation check activated but it does not work with BDY')
+#endif
+      !
+   END SUBROUTINE ice_run
+
+
+   SUBROUTINE lim_itd_init
+      !!------------------------------------------------------------------
+      !!                ***  ROUTINE lim_itd_init ***
+      !!
+      !! ** Purpose :   Initializes the ice thickness distribution
+      !! ** Method  :   ...
+      !! ** input   :   Namelist namiceitd
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      NAMELIST/namiceitd/ nn_catbnd, rn_himean
+      !
+      INTEGER  ::   jl                   ! dummy loop index
+      REAL(wp) ::   zc1, zc2, zc3, zx1   ! local scalars
+      REAL(wp) ::   zhmax, znum, zden, zalpha !
+      !!------------------------------------------------------------------
+      !
+      REWIND( numnam_ice_ref )              ! Namelist namiceitd in reference namelist : Parameters for ice
+      READ  ( numnam_ice_ref, namiceitd, IOSTAT = ios, ERR = 903)
+903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )              ! Namelist namiceitd in configuration namelist : Parameters for ice
+      READ  ( numnam_ice_cfg, namiceitd, IOSTAT = ios, ERR = 904 )
+904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namiceitd )
+      !
+      !
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'ice_itd : ice cat distribution'
+         WRITE(numout,*) ' ~~~~~~'
+         WRITE(numout,*) '   shape of ice categories distribution                          nn_catbnd = ', nn_catbnd
+         WRITE(numout,*) '   mean ice thickness in the domain (only active if nn_catbnd=2) rn_himean = ', rn_himean
+      ENDIF
+
+      !----------------------------------
+      !- Thickness categories boundaries 
+      !----------------------------------
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'lim_itd_init : Initialization of ice cat distribution '
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+
+      hi_max(:) = 0._wp
+
+      SELECT CASE ( nn_catbnd  )       
+                                   !----------------------
+         CASE (1)                  ! tanh function (CICE)
+                                   !----------------------
+         zc1 =  3._wp / REAL( jpl, wp )
+         zc2 = 10._wp * zc1
+         zc3 =  3._wp
+
+         DO jl = 1, jpl
+            zx1 = REAL( jl-1, wp ) / REAL( jpl, wp )
+            hi_max(jl) = hi_max(jl-1) + zc1 + zc2 * (1._wp + TANH( zc3 * (zx1 - 1._wp ) ) )
+         END DO
+
+                                   !----------------------
+         CASE (2)                  ! h^(-alpha) function
+                                   !----------------------
+         zalpha = 0.05             ! exponent of the transform function
+
+         zhmax  = 3.*rn_himean
+
+         DO jl = 1, jpl 
+            znum = jpl * ( zhmax+1 )**zalpha
+            zden = ( jpl - jl ) * ( zhmax+1 )**zalpha + jl
+            hi_max(jl) = ( znum / zden )**(1./zalpha) - 1
+         END DO
+
+      END SELECT
+
+      DO jl = 1, jpl
+         hi_mean(jl) = ( hi_max(jl) + hi_max(jl-1) ) * 0.5_wp
+      END DO
+
+      ! Set hi_max(jpl) to a big value to ensure that all ice is thinner than hi_max(jpl)
+      hi_max(jpl) = 99._wp
+
+      IF(lwp) WRITE(numout,*) ' Thickness category boundaries '
+      IF(lwp) WRITE(numout,*) ' hi_max ', hi_max(0:jpl)
+      !
+   END SUBROUTINE lim_itd_init
+
+   
+   SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_limflx )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE ice_lim_flx  ***
+      !!                   
+      !! ** 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) ::   pevap_ice  ! sublimation
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdevap_ice ! sublimation 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_evap_m  ! Mean sublimation over all categories
+      REAL(wp), POINTER, DIMENSION(:,:) :: z_dqn_m   ! Mean d(qns)/dT over all categories
+      REAL(wp), POINTER, DIMENSION(:,:) :: z_devap_m ! Mean d(evap)/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_evap_m, z_dqn_m, z_devap_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_evap_m (:,:) = fice_ice_ave ( pevap_ice (:,:,:) )
+         z_devap_m(:,:) = fice_ice_ave ( pdevap_ice (:,:,:) )
+         DO jl = 1, jpl
+            pdqn_ice  (:,:,jl) = z_dqn_m(:,:)
+            pdevap_ice(:,:,jl) = z_devap_m(:,:)
+         END DO
+         !
+         DO jl = 1, jpl
+            pqns_ice (:,:,jl) = z_qns_m(:,:)
+            pqsr_ice (:,:,jl) = z_qsr_m(:,:)
+            pevap_ice(:,:,jl) = z_evap_m(:,:)
+         END DO
+         !
+         CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_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(:,:) )
+            pevap_ice(:,:,jl) = pevap_ice(:,:,jl) + pdevap_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 sbc_lim_bef
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_lim_bef  ***
+      !!
+      !! ** purpose :  store ice variables at "before" time step 
+      !!----------------------------------------------------------------------
+      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(:,:)
+      
+   END SUBROUTINE sbc_lim_bef
+
+   SUBROUTINE sbc_lim_diag0
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_lim_diag0  ***
+      !!
+      !! ** purpose :  set ice-ocean and ice-atm. fluxes to zeros at the beggining
+      !!               of the time step
+      !!----------------------------------------------------------------------
+      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_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
+      hfx_err_dif(:,:) = 0._wp   ;
+
+      afx_tot(:,:) = 0._wp   ;
+      afx_dyn(:,:) = 0._wp   ;   afx_thd(:,:) = 0._wp
+
+      diag_heat(:,:) = 0._wp ;   diag_smvi(:,:) = 0._wp ;
+      diag_vice(:,:) = 0._wp ;   diag_vsnw(:,:) = 0._wp ;
+      
+   END SUBROUTINE sbc_lim_diag0
+
+     
+   FUNCTION fice_cell_ave ( ptab )
       !!--------------------------------------------------------------------------
       !! * Compute average over categories, for grid cell (ice covered and free ocean)
@@ -88 +614 @@
       
       fice_cell_ave (:,:) = 0.0_wp
-      
       DO jl = 1, jpl
-         fice_cell_ave (:,:) = fice_cell_ave (:,:) &
-            &                  + a_i (:,:,jl) * ptab (:,:,jl)
+         fice_cell_ave (:,:) = fice_cell_ave (:,:) + a_i (:,:,jl) * ptab (:,:,jl)
       END DO
       
    END FUNCTION fice_cell_ave
    
-   FUNCTION fice_ice_ave ( ptab)
+   
+   FUNCTION fice_ice_ave ( ptab )
       !!--------------------------------------------------------------------------
       !! * Compute average over categories, for ice covered part of grid cell
@@ -104 +629 @@
 
       fice_ice_ave (:,:) = 0.0_wp
-      WHERE ( at_i (:,:) .GT. 0.0_wp ) fice_ice_ave (:,:) = fice_cell_ave ( ptab (:,:,:)) / at_i (:,:)
+      WHERE ( at_i (:,:) > 0.0_wp ) fice_ice_ave (:,:) = fice_cell_ave ( ptab (:,:,:)) / at_i (:,:)
 
    END FUNCTION fice_ice_ave
 
-   !!======================================================================
-
-   SUBROUTINE sbc_ice_lim( kt, kblk )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE sbc_ice_lim  ***
-      !!                   
-      !! ** Purpose :   update the ocean surface boundary condition via the 
-      !!                Louvain la Neuve Sea Ice Model time stepping 
-      !!
-      !! ** Method  :   ice model time stepping
-      !!              - call the ice dynamics routine 
-      !!              - call the ice advection/diffusion routine 
-      !!              - call the ice thermodynamics routine 
-      !!              - call the routine that computes mass and 
-      !!                heat fluxes at the ice/ocean interface
-      !!              - save the outputs 
-      !!              - save the outputs for restart when necessary
-      !!
-      !! ** Action  : - time evolution of the LIM sea-ice model
-      !!              - update all sbc variables below sea-ice:
-      !!                utau, vtau, taum, wndm, qns , qsr, emp , sfx 
-      !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt      ! ocean time step
-      INTEGER, INTENT(in) ::   kblk    ! type of bulk (=3 CLIO, =4 CORE)
-      !!
-      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
-      !!----------------------------------------------------------------------
-
-      !- 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
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'sbc_ice_lim : update ocean surface boudary condition' 
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   via Louvain la Neuve Ice Model (LIM-3) time stepping'
-         !
-         CALL ice_init
-         !
-         IF( ln_nicep ) THEN      ! control print at a given point
-            jiindx = 177   ;   jjindx = 112
-            IF(lwp) WRITE(numout,*) ' The debugging point is : jiindx : ',jiindx, ' jjindx : ',jjindx
-         ENDIF
-      ENDIF
-
-      !                                        !----------------------!
-      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !  Ice time-step only  !
-         !                                     !----------------------!
-         !                                           !  Bulk Formulea !
-         !                                           !----------------!
-         !
-         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
-
-         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:
-         ! 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]
-         ! qla_ice            : latent heat flux over ice              (T-point)         [W/m2]
-         ! dqns_ice, dqla_ice : non solar & latent heat sensistivity   (T-point)         [W/m2]
-         ! tprecip , sprecip  : total & solid precipitation            (T-point)         [Kg/m2/s]
-         ! fr1_i0  , fr2_i0   : 1sr & 2nd fraction of qsr penetration in ice             [%]
-         !
-         SELECT CASE( kblk )
-         CASE( 3 )                                       ! CLIO bulk formulation
-            CALL blk_ice_clio( t_su , zalb_ice_cs, zalb_ice_os,                           &
-               &                      utau_ice   , vtau_ice   , qns_ice   , qsr_ice   ,   &
-               &                      qla_ice    , dqns_ice   , dqla_ice  ,               &
-               &                      tprecip    , sprecip    ,                           &
-               &                      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,               &
-               &                      utau_ice  , vtau_ice  , qns_ice    , qsr_ice   ,   &
-               &                      qla_ice   , dqns_ice  , dqla_ice   ,               &
-               &                      tprecip   , sprecip   ,                            &
-               &                      fr1_i0    , fr2_i0    , cp_ice_msh, jpl  )
-            !
-         CASE ( 5 )
-            zalb_ice (:,:,:) = 0.5 * ( zalb_ice_cs (:,:,:) +  zalb_ice_os (:,:,:) )
-            
-            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
-            !
-         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 !
-         !                                           !----------------------!
-         ! 
-         numit = numit + nn_fsbc                     ! Ice model time step
-         !
-         !                                           ! 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
-
-                          CALL lim_rst_opn( kt )     ! Open Ice restart file
-         !
-         IF( ln_nicep )   CALL lim_prt_state( kt, jiindx, jjindx, 1, ' - Beginning the time step - ' )   ! control print
-         ! ----------------------------------------------
-         ! ice dynamics and transport (except in 1D case)
-         ! ----------------------------------------------
-         IF( .NOT. lk_c1d ) THEN
-                          CALL lim_dyn( kt )              ! Ice dynamics    ( rheology/dynamics )
-                          CALL lim_trp( kt )              ! Ice transport   ( Advection/diffusion )
-                          CALL lim_var_glo2eqv            ! equivalent variables, requested for rafting
-         IF( ln_nicep )   CALL lim_prt_state( kt, jiindx, jjindx,-1, ' - ice dyn & trp - ' )   ! control print
-                          CALL lim_itd_me                 ! Mechanical redistribution ! (ridging/rafting)
-                          CALL lim_var_agg( 1 ) 
-#if defined key_bdy
-                          ! bdy ice thermo 
-                          CALL lim_var_glo2eqv            ! equivalent variables
-                          CALL bdy_ice_lim( kt )
-                          CALL lim_itd_me_zapsmall
-                          CALL lim_var_agg(1)
-         IF( ln_nicep )   CALL lim_prt_state( kt, jiindx, jjindx, 1, ' - ice thermo bdy - ' )   ! control print
-#endif
-                          CALL lim_update1
-         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 (:,:,:)
- 
-         ! ----------------------------------------------
-         ! ice thermodynamic
-         ! ----------------------------------------------
-                          CALL lim_var_glo2eqv            ! equivalent variables
-                          CALL lim_var_agg(1)             ! aggregate ice categories
-                          ! previous lead fraction and ice volume for flux calculations
-                          pfrld(:,:)   = 1._wp - at_i(:,:)
-                          phicif(:,:)  = vt_i(:,:)
-                          !
-                          CALL lim_var_bv                 ! bulk brine volume (diag)
-                          CALL lim_thd( kt )              ! Ice thermodynamics 
-                          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  !
-                          CALL lim_var_agg( 1 )           ! requested by limupdate
-                          CALL lim_update2                ! Global variables update
-
-                          CALL lim_var_glo2eqv            ! equivalent variables (outputs)
-                          CALL lim_var_agg(2)             ! aggregate ice thickness categories
-         IF( ln_nicep )   CALL lim_prt_state( kt, jiindx, jjindx, 2, ' - Final state - ' )   ! control print
-         !
-                          CALL lim_sbc_flx( kt )     ! Update surface ocean mass, heat and salt fluxes
-         !
-         IF( ln_nicep )   CALL lim_prt_state( kt, jiindx, jjindx, 3, ' - Final state lim_sbc - ' )   ! control print
-         !
-         !                                           ! 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
-         !
-         IF( lrst_ice )   CALL lim_rst_write( kt )        ! Ice restart file 
-                          CALL lim_var_glo2eqv            ! ???
-         !
-         IF( ln_nicep )   CALL lim_ctl( kt )              ! alerts in case of model crash
-         !
-      ENDIF                                    ! End sea-ice time step only
-
-      !                                        !--------------------------!
-      !                                        !  at all ocean time step  !
-      !                                        !--------------------------!
-      !                                               
-      !                                              ! Update surface ocean stresses (only in ice-dynamic case)
-      !                                                   ! 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 lim_ctl( kt )
-      !!-----------------------------------------------------------------------
-      !!                   ***  ROUTINE lim_ctl *** 
-      !!                 
-      !! ** Purpose :   Alerts in case of model crash
-      !!-------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt      ! ocean time step
-      INTEGER  ::   ji, jj, jk,  jl   ! dummy loop indices
-      INTEGER  ::   inb_altests       ! number of alert tests (max 20)
-      INTEGER  ::   ialert_id         ! number of the current alert
-      REAL(wp) ::   ztmelts           ! ice layer melting point
-      CHARACTER (len=30), DIMENSION(20)      ::   cl_alname   ! name of alert
-      INTEGER           , DIMENSION(20)      ::   inb_alp     ! number of alerts positive
-      !!-------------------------------------------------------------------
-
-      inb_altests = 10
-      inb_alp(:)  =  0
-
-      ! Alert if incompatible volume and concentration
-      ialert_id = 2 ! reference number of this alert
-      cl_alname(ialert_id) = ' Incompat vol and con         '    ! name of the alert
-
-      DO jl = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF(  v_i(ji,jj,jl) /= 0._wp   .AND.   a_i(ji,jj,jl) == 0._wp   ) THEN
-                  !WRITE(numout,*) ' ALERTE 2 :   Incompatible volume and concentration '
-                  !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,*) ' 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)
-                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-               ENDIF
-            END DO
-         END DO
-      END DO
-
-      ! Alerte if very thick ice
-      ialert_id = 3 ! reference number of this alert
-      cl_alname(ialert_id) = ' Very thick ice               ' ! name of the alert
-      jl = jpl 
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF(   ht_i(ji,jj,jl)  >  50._wp   ) THEN
-               !CALL lim_prt_state( kt, ji, jj, 2, ' ALERTE 3 :   Very thick ice ' )
-               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-            ENDIF
-         END DO
-      END DO
-
-      ! Alert if very fast ice
-      ialert_id = 4 ! reference number of this alert
-      cl_alname(ialert_id) = ' Very fast ice               ' ! name of the alert
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF(   MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 1.5  .AND.  &
-               &  at_i(ji,jj) > 0._wp   ) THEN
-               !CALL lim_prt_state( kt, ji, jj, 1, ' ALERTE 4 :   Very fast ice ' )
-               !WRITE(numout,*) ' ice strength             : ', strength(ji,jj)
-               !WRITE(numout,*) ' oceanic stress utau      : ', utau(ji,jj) 
-               !WRITE(numout,*) ' oceanic stress vtau      : ', vtau(ji,jj)
-               !WRITE(numout,*) ' sea-ice stress utau_ice  : ', utau_ice(ji,jj) 
-               !WRITE(numout,*) ' sea-ice stress vtau_ice  : ', vtau_ice(ji,jj)
-               !WRITE(numout,*) ' oceanic speed u          : ', u_oce(ji,jj)
-               !WRITE(numout,*) ' oceanic speed v          : ', v_oce(ji,jj)
-               !WRITE(numout,*) ' sst                      : ', sst_m(ji,jj)
-               !WRITE(numout,*) ' sss                      : ', sss_m(ji,jj)
-               !WRITE(numout,*) 
-               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-            ENDIF
-         END DO
-      END DO
-
-      ! Alert if there is ice on continents
-      ialert_id = 6 ! reference number of this alert
-      cl_alname(ialert_id) = ' Ice on continents           ' ! name of the alert
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF(   tms(ji,jj) <= 0._wp   .AND.   at_i(ji,jj) > 0._wp   ) THEN 
-               !CALL lim_prt_state( kt, ji, jj, 1, ' ALERTE 6 :   Ice on continents ' )
-               !WRITE(numout,*) ' masks s, u, v        : ', tms(ji,jj), tmu(ji,jj), tmv(ji,jj) 
-               !WRITE(numout,*) ' sst                  : ', sst_m(ji,jj)
-               !WRITE(numout,*) ' sss                  : ', sss_m(ji,jj)
-               !WRITE(numout,*) ' at_i(ji,jj)          : ', at_i(ji,jj)
-               !WRITE(numout,*) ' v_ice(ji,jj)         : ', v_ice(ji,jj)
-               !WRITE(numout,*) ' v_ice(ji,jj-1)       : ', v_ice(ji,jj-1)
-               !WRITE(numout,*) ' u_ice(ji-1,jj)       : ', u_ice(ji-1,jj)
-               !WRITE(numout,*) ' u_ice(ji,jj)         : ', v_ice(ji,jj)
-               !
-               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-            ENDIF
-         END DO
-      END DO
-
-!
-!     ! Alert if very fresh ice
-      ialert_id = 7 ! reference number of this alert
-      cl_alname(ialert_id) = ' Very fresh ice               ' ! name of the alert
-      DO jl = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( sm_i(ji,jj,jl) < 0.1 .AND. a_i(ji,jj,jl) > 0._wp ) THEN
-!                 CALL lim_prt_state(kt,ji,jj,1, ' ALERTE 7 :   Very fresh ice ' )
-!                 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
-               ENDIF
-            END DO
-         END DO
-      END DO
-!
-
-!     ! Alert if too old ice
-      ialert_id = 9 ! reference number of this alert
-      cl_alname(ialert_id) = ' Very old   ice               ' ! name of the alert
-      DO jl = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF ( ( ( ABS( o_i(ji,jj,jl) ) > rdt_ice ) .OR. &
-                      ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. &
-                             ( a_i(ji,jj,jl) > 0._wp ) ) THEN
-                  !CALL lim_prt_state( kt, ji, jj, 1, ' ALERTE 9 :   Wrong ice age ')
-                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-               ENDIF
-            END DO
-         END DO
-      END DO
- 
-      ! Alert on salt flux
-      ialert_id = 5 ! reference number of this alert
-      cl_alname(ialert_id) = ' High salt flux               ' ! name of the alert
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF( ABS( sfx (ji,jj) ) .GT. 1.0e-2 ) THEN  ! = 1 psu/day for 1m ocean depth
-               !CALL lim_prt_state( kt, ji, jj, 3, ' ALERTE 5 :   High salt flux ' )
-               !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,*) ' 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,*) ' d_v_i_trp  : ', d_v_i_trp(ji,jj,jl) , ' d_v_i_thd  : ', d_v_i_thd(ji,jj,jl) 
-                  !WRITE(numout,*) ' '
-               !END DO
-               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-            ENDIF
-         END DO
-      END DO
-
-      ! Alert if qns very big
-      ialert_id = 8 ! reference number of this alert
-      cl_alname(ialert_id) = ' fnsolar very big             ' ! name of the alert
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN
-               !
-               !WRITE(numout,*) ' ALERTE 8 :   Very high non-solar heat flux'
-               !WRITE(numout,*) ' ji, jj    : ', ji, jj
-               !WRITE(numout,*) ' qns       : ', qns(ji,jj)
-               !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, '   ')
-               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-               !
-            ENDIF
-         END DO
-      END DO
-      !+++++
- 
-      ! Alert if very warm ice
-      ialert_id = 10 ! reference number of this alert
-      cl_alname(ialert_id) = ' Very warm ice                ' ! name of the alert
-      inb_alp(ialert_id) = 0
-      DO jl = 1, jpl
-         DO jk = 1, nlay_i
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  ztmelts    =  -tmut * s_i(ji,jj,jk,jl) + rtt
-                  IF( t_i(ji,jj,jk,jl) >= ztmelts  .AND.  v_i(ji,jj,jl) > 1.e-10   &
-                     &                             .AND.  a_i(ji,jj,jl) > 0._wp   ) THEN
-                     !WRITE(numout,*) ' ALERTE 10 :   Very warm ice'
-                     !WRITE(numout,*) ' ji, jj, jk, jl : ', ji, jj, jk, jl
-                     !WRITE(numout,*) ' t_i : ', t_i(ji,jj,jk,jl)
-                     !WRITE(numout,*) ' e_i : ', e_i(ji,jj,jk,jl)
-                     !WRITE(numout,*) ' s_i : ', s_i(ji,jj,jk,jl)
-                     !WRITE(numout,*) ' ztmelts : ', ztmelts
-                     inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-                  ENDIF
-               END DO
-            END DO
-         END DO
-      END DO
-
-      ! sum of the alerts on all processors
-      IF( lk_mpp ) THEN
-         DO ialert_id = 1, inb_altests
-            CALL mpp_sum(inb_alp(ialert_id))
-         END DO
-      ENDIF
-
-      ! print alerts
-      IF( lwp ) THEN
-         ialert_id = 1                                 ! reference number of this alert
-         cl_alname(ialert_id) = ' NO alerte 1      '   ! name of the alert
-         WRITE(numout,*) ' time step ',kt
-         WRITE(numout,*) ' All alerts at the end of ice model '
-         DO ialert_id = 1, inb_altests
-            WRITE(numout,*) ialert_id, cl_alname(ialert_id)//' : ', inb_alp(ialert_id), ' times ! '
-         END DO
-      ENDIF
-     !
-   END SUBROUTINE lim_ctl
- 
-   
-   SUBROUTINE lim_prt_state( kt, ki, kj, kn, cd1 )
-      !!-----------------------------------------------------------------------
-      !!                   ***  ROUTINE lim_prt_state *** 
-      !!                 
-      !! ** Purpose :   Writes global ice state on the (i,j) point 
-      !!                in ocean.ouput 
-      !!                3 possibilities exist 
-      !!                n = 1/-1 -> simple ice state (plus Mechanical Check if -1)
-      !!                n = 2    -> exhaustive state
-      !!                n = 3    -> ice/ocean salt fluxes
-      !!
-      !! ** input   :   point coordinates (i,j) 
-      !!                n : number of the option
-      !!-------------------------------------------------------------------
-      INTEGER         , INTENT(in) ::   kt      ! ocean time step
-      INTEGER         , INTENT(in) ::   ki, kj, kn    ! ocean gridpoint indices
-      CHARACTER(len=*), INTENT(in) ::   cd1           !
-      !!
-      INTEGER :: jl, ji, jj
-      !!-------------------------------------------------------------------
-
-      DO ji = mi0(ki), mi1(ki)
-         DO jj = mj0(kj), mj1(kj)
-
-            WRITE(numout,*) ' time step ',kt,' ',cd1             ! print title
-
-            !----------------
-            !  Simple state
-            !----------------
-            
-            IF ( kn == 1 .OR. kn == -1 ) THEN
-               WRITE(numout,*) ' lim_prt_state - Point : ',ji,jj
-               WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
-               WRITE(numout,*) ' Simple state '
-               WRITE(numout,*) ' masks s,u,v   : ', tms(ji,jj), tmu(ji,jj), tmv(ji,jj)
-               WRITE(numout,*) ' lat - long    : ', gphit(ji,jj), glamt(ji,jj)
-               WRITE(numout,*) ' Time step     : ', numit
-               WRITE(numout,*) ' - Ice drift   '
-               WRITE(numout,*) '   ~~~~~~~~~~~ '
-               WRITE(numout,*) ' u_ice(i-1,j)  : ', u_ice(ji-1,jj)
-               WRITE(numout,*) ' u_ice(i  ,j)  : ', u_ice(ji,jj)
-               WRITE(numout,*) ' v_ice(i  ,j-1): ', v_ice(ji,jj-1)
-               WRITE(numout,*) ' v_ice(i  ,j)  : ', v_ice(ji,jj)
-               WRITE(numout,*) ' strength      : ', strength(ji,jj)
-               WRITE(numout,*)
-               WRITE(numout,*) ' - Cell values '
-               WRITE(numout,*) '   ~~~~~~~~~~~ '
-               WRITE(numout,*) ' cell area     : ', area(ji,jj)
-               WRITE(numout,*) ' at_i          : ', at_i(ji,jj)       
-               WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj)       
-               WRITE(numout,*) ' vt_s          : ', vt_s(ji,jj)       
-               DO jl = 1, jpl
-                  WRITE(numout,*) ' - Category (', jl,')'
-                  WRITE(numout,*) ' a_i           : ', a_i(ji,jj,jl)
-                  WRITE(numout,*) ' ht_i          : ', ht_i(ji,jj,jl)
-                  WRITE(numout,*) ' ht_s          : ', ht_s(ji,jj,jl)
-                  WRITE(numout,*) ' v_i           : ', v_i(ji,jj,jl)
-                  WRITE(numout,*) ' v_s           : ', v_s(ji,jj,jl)
-                  WRITE(numout,*) ' e_s           : ', e_s(ji,jj,1,jl)/1.0e9
-                  WRITE(numout,*) ' e_i           : ', e_i(ji,jj,1:nlay_i,jl)/1.0e9
-                  WRITE(numout,*) ' t_su          : ', t_su(ji,jj,jl)
-                  WRITE(numout,*) ' t_snow        : ', t_s(ji,jj,1,jl)
-                  WRITE(numout,*) ' t_i           : ', t_i(ji,jj,1:nlay_i,jl)
-                  WRITE(numout,*) ' sm_i          : ', sm_i(ji,jj,jl)
-                  WRITE(numout,*) ' smv_i         : ', smv_i(ji,jj,jl)
-                  WRITE(numout,*)
-               END DO
-            ENDIF
-            IF( kn == -1 ) THEN
-               WRITE(numout,*) ' Mechanical Check ************** '
-               WRITE(numout,*) ' Check what means ice divergence '
-               WRITE(numout,*) ' Total ice concentration ', at_i (ji,jj)
-               WRITE(numout,*) ' Total lead fraction     ', ato_i(ji,jj)
-               WRITE(numout,*) ' Sum of both             ', ato_i(ji,jj) + at_i(ji,jj)
-               WRITE(numout,*) ' Sum of both minus 1     ', ato_i(ji,jj) + at_i(ji,jj) - 1.00
-            ENDIF
-            
-
-            !--------------------
-            !  Exhaustive state
-            !--------------------
-            
-            IF ( kn .EQ. 2 ) THEN
-               WRITE(numout,*) ' lim_prt_state - Point : ',ji,jj
-               WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
-               WRITE(numout,*) ' Exhaustive state '
-               WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj)
-               WRITE(numout,*) ' Time step ', numit
-               WRITE(numout,*) 
-               WRITE(numout,*) ' - Cell values '
-               WRITE(numout,*) '   ~~~~~~~~~~~ '
-               WRITE(numout,*) ' cell area     : ', area(ji,jj)
-               WRITE(numout,*) ' at_i          : ', at_i(ji,jj)       
-               WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj)       
-               WRITE(numout,*) ' vt_s          : ', vt_s(ji,jj)       
-               WRITE(numout,*) ' u_ice(i-1,j)  : ', u_ice(ji-1,jj)
-               WRITE(numout,*) ' u_ice(i  ,j)  : ', u_ice(ji,jj)
-               WRITE(numout,*) ' v_ice(i  ,j-1): ', v_ice(ji,jj-1)
-               WRITE(numout,*) ' v_ice(i  ,j)  : ', v_ice(ji,jj)
-               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,*)
-               
-               DO jl = 1, jpl
-                  WRITE(numout,*) ' - Category (',jl,')'
-                  WRITE(numout,*) '   ~~~~~~~~         ' 
-                  WRITE(numout,*) ' ht_i       : ', ht_i(ji,jj,jl)             , ' ht_s       : ', ht_s(ji,jj,jl)
-                  WRITE(numout,*) ' t_i        : ', t_i(ji,jj,1:nlay_i,jl)
-                  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,*) ' 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,*) ' 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,*) ' 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,*) ' 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,*) ' 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,*) ' 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,*) ' 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,*) ' 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
-               
-               WRITE(numout,*)
-               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,*) 
-               WRITE(numout,*) ' sst        : ', sst_m(ji,jj)  
-               WRITE(numout,*) ' sss        : ', sss_m(ji,jj)  
-               WRITE(numout,*) 
-               WRITE(numout,*) ' - Stresses '
-               WRITE(numout,*) '   ~~~~~~~~ '
-               WRITE(numout,*) ' utau_ice   : ', utau_ice(ji,jj) 
-               WRITE(numout,*) ' vtau_ice   : ', vtau_ice(ji,jj)
-               WRITE(numout,*) ' utau       : ', utau    (ji,jj) 
-               WRITE(numout,*) ' vtau       : ', vtau    (ji,jj)
-               WRITE(numout,*) ' oc. vel. u : ', u_oce   (ji,jj)
-               WRITE(numout,*) ' oc. vel. v : ', v_oce   (ji,jj)
-            ENDIF
-            
-            !---------------------
-            ! Salt / heat fluxes
-            !---------------------
-            
-            IF ( kn .EQ. 3 ) THEN
-               WRITE(numout,*) ' lim_prt_state - Point : ',ji,jj
-               WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
-               WRITE(numout,*) ' - Salt / Heat Fluxes '
-               WRITE(numout,*) '   ~~~~~~~~~~~~~~~~ '
-               WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj)
-               WRITE(numout,*) ' Time step ', numit
-               WRITE(numout,*)
-               WRITE(numout,*) ' - Heat fluxes at bottom interface ***'
-               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,*) ' - 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,*)
-               WRITE(numout,*) ' - Momentum fluxes '
-               WRITE(numout,*) ' utau      : ', utau(ji,jj) 
-               WRITE(numout,*) ' vtau      : ', vtau(ji,jj)
-            ENDIF
-            WRITE(numout,*) ' '
-            !
-         END DO
-      END DO
-
-   END SUBROUTINE lim_prt_state
 
 #else
@@ -861 +642 @@
       WRITE(*,*) 'sbc_ice_lim: You should not have seen this print! error?', kt, kblk
    END SUBROUTINE sbc_ice_lim
+   SUBROUTINE sbc_lim_init                 ! Dummy routine
+   END SUBROUTINE sbc_lim_init
 #endif
 

branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

@@ -53 +53 @@
    USE agrif_lim2_update
 # endif
+
+#if defined key_bdy 
+   USE bdyice_lim       ! unstructured open boundary data  (bdy_ice_lim routine)
+#endif
 
    IMPLICIT NONE
@@ -93 +97 @@
       !!
       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)
+      REAL(wp), DIMENSION(:,:  ), POINTER :: zutau_ice, zvtau_ice 
       !!----------------------------------------------------------------------
-
-      CALL wrk_alloc( jpi,jpj,1, zalb_ice_os, zalb_ice_cs, zsist )
 
       IF( kt == nit000 ) THEN
@@ -119 +123 @@
          &*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc)) + 1
 # endif
+
+         CALL wrk_alloc( jpi,jpj  , zutau_ice, zvtau_ice)
+         CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )
+
          !  Bulk Formulea !
          !----------------!
@@ -126 +134 @@
             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 +144 @@
             !
          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_purecpl )   ! 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 +184 @@
          !
          SELECT CASE( ksbc )
-         CASE( 3 )           ! CLIO bulk formulation
-            CALL blk_ice_clio( zsist, zalb_ice_cs, zalb_ice_os,                         &
-               &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   &
-               &                      qla_ice    , dqns_ice   , dqla_ice   ,            &
-               &                      tprecip    , sprecip    ,                         &
-               &                      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,            &
-               &                      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)
+         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   ,            &
+!              &                      tprecip    , sprecip    ,                         &
+!              &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  )
+            CALL blk_ice_clio_tau
+            CALL blk_ice_clio_flx( zsist, zalb_cs, zalb_os, zalb_ice )
+
+         CASE( jp_core )           ! CORE bulk formulation
+            CALL blk_ice_core_tau
+            CALL blk_ice_core_flx( zsist, zalb_ice )
+
+         CASE( jp_purecpl )            ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics)
             CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )
          END SELECT
+         
+         IF( ln_mixcpl) THEN
+            CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice )
+            utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) )
+            vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) )
+         ENDIF
 
          CALL iom_put( 'utau_ice', utau_ice )     ! Wind stress over ice along i-axis at I-point
@@ -205 +230 @@
                            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( ln_cpl ) THEN   ! pure coupled and mixed forced-coupled configurations
             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 
-#if defined key_top
-        IF( ltrcdm2dc_ice )CALL lim_bio_meanqsr_2
-#endif
 
          IF(  .NOT. lk_mpp )THEN
@@ -234 +257 @@
          IF( .NOT. Agrif_Root() )   CALL agrif_update_lim2( kt )
 # endif
+         !
+         CALL wrk_dealloc( jpi,jpj  , zutau_ice, zvtau_ice)
+         CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )
          !
       ENDIF                                    ! End sea-ice time step only
@@ -245 +271 @@
       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 )
-      !
    END SUBROUTINE sbc_ice_lim_2
 

branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

@@ -13 +13 @@
    !!            3.4  ! 2011-11  (C. Harris) CICE added as an option
    !!            3.5  ! 2012-11  (A. Coward, G. Madec) Rethink of heat, mass and salt surface fluxes
+   !!            3.6  ! 2014-11  (P. Mathiot, C. Harris) add ice shelves melting                    
    !!----------------------------------------------------------------------
 
@@ -23 +24 @@
    USE phycst           ! physical constants
    USE sbc_oce          ! Surface boundary condition: ocean fields
+   USE trc_oce          ! shared ocean-passive tracers variables
    USE sbc_ice          ! Surface boundary condition: ice fields
    USE sbcdcy           ! surface boundary condition: diurnal cycle
@@ -37 +39 @@
    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 cpl_oasis3       ! OASIS routines for coupling
    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
@@ -50 +53 @@
    USE timing           ! Timing
    USE sbcwave          ! Wave module
+   USE bdy_par          ! Require lk_bdy
 
    IMPLICIT NONE
@@ -82 +86 @@
       INTEGER ::   icpt   ! local integer
       !!
-      NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx,  ln_blk_clio, ln_blk_core, ln_cpl,   &
-         &             ln_blk_mfs, ln_apr_dyn, nn_ice,  nn_ice_embd, ln_dm2dc   , ln_rnf,   &
-         &             ln_ssr    , nn_fwb    , ln_cdgw , ln_wave , ln_sdw, nn_lsm, cn_iceflx
+      NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx, ln_blk_clio, ln_blk_core, ln_mixcpl,   &
+         &             ln_blk_mfs, ln_apr_dyn, nn_ice, nn_ice_embd, ln_dm2dc   , ln_rnf   ,   &
+         &             ln_ssr    , nn_isf    , nn_fwb, ln_cdgw    , ln_wave    , ln_sdw   ,   &
+         &             nn_lsm    , nn_limflx , nn_components, ln_cpl
       INTEGER  ::   ios
+      INTEGER  ::   ierr, ierr0, ierr1, ierr2, ierr3, jpm
+      LOGICAL  ::   ll_purecpl
       !!----------------------------------------------------------------------
 
@@ -113 +120 @@
           nn_ice      =   0
       ENDIF
-     
+
       IF(lwp) THEN               ! Control print
          WRITE(numout,*) '        Namelist namsbc (partly overwritten with CPP key setting)'
@@ -123 +130 @@
          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,*) '              ocean-atmosphere coupled formulation       ln_cpl      = ', ln_cpl
+         WRITE(numout,*) '              forced-coupled mixed formulation           ln_mixcpl   = ', ln_mixcpl
+         WRITE(numout,*) '              OASIS coupling (with atm or sas)           lk_oasis    = ', lk_oasis
+         WRITE(numout,*) '              components of your executable              nn_components = ', nn_components
+         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 +141 @@
          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 +148 @@
       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
-      ltrcdm2dc = (ln_dm2dc .AND. ln_blk_core .AND. nn_ice==2)
-      IF( ltrcdm2dc )THEN
-         IF(lwp)THEN
-            WRITE(numout,*)"analytical diurnal cycle, core bulk formulation and LIM2 use: "
-            WRITE(numout,*)"Diurnal cycle on physics but not in passive tracers"
-         ENDIF
-      ENDIF
-#else 
-      ltrcdm2dc =  .FALSE.
-#endif
-
-      !
+      !
+      IF ( nn_components /= jp_iam_nemo .AND. .NOT. lk_oasis )   &
+         &      CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but key_oasis3 disabled' )
+      IF ( nn_components == jp_iam_opa .AND. ln_cpl )   &
+         &      CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but ln_cpl = T in OPA' )
+      IF ( nn_components == jp_iam_opa .AND. ln_mixcpl )   &
+         &      CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' )
+      IF ( ln_cpl .AND. .NOT. lk_oasis )    &
+         &      CALL ctl_stop( 'STOP', 'sbc_init : OASIS-coupled atmosphere model, but key_oasis3 disabled' )
+      IF( ln_mixcpl .AND. .NOT. lk_oasis )    &
+         &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires the cpp key key_oasis3' )
+      IF( ln_mixcpl .AND. .NOT. ln_cpl )    &
+         &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires ln_cpl = T' )
+      IF( ln_mixcpl .AND. nn_components /= jp_iam_nemo )    &
+         &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) is not yet working with sas-opa coupling via oasis' )
+
       !                              ! allocate sbc arrays
       IF( sbc_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_oce arrays' )
 
       !                          ! Checks:
-      IF( .NOT. ln_rnf ) THEN                      ! no specific treatment in vicinity of river mouths 
-         ln_rnf_mouth  = .false.                      
-         IF( sbc_rnf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_rnf arrays' )
-         nkrnf         = 0
-         rnf     (:,:) = 0.0_wp
-         rnf_b   (:,:) = 0.0_wp
-         rnfmsk  (:,:) = 0.0_wp
-         rnfmsk_z(:)   = 0.0_wp
-      ENDIF
-      IF( nn_ice == 0  )   fr_i(:,:) = 0.e0        ! no ice in the domain, ice fraction is always zero
+      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
+         fwfisf_b(:,:) = 0.0_wp
+      END IF
+      IF( nn_ice == 0 .AND. nn_components /= jp_iam_opa )   fr_i(:,:) = 0.e0 ! no ice in the domain, ice fraction is always zero
 
       sfx(:,:) = 0.0_wp                            ! the salt flux due to freezing/melting will be computed (i.e. will be non-zero) 
@@ -186 +190 @@
  
       fmmflx(:,:) = 0.0_wp                        ! freezing-melting array initialisation
+      
+      taum(:,:) = 0.0_wp                           ! Initialise taum for use in gls in case of reduced restart
 
       !                                            ! restartability   
-      IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR.   &
-          MOD( nstock             , nn_fsbc) /= 0 ) THEN 
-         WRITE(ctmp1,*) 'experiment length (', nitend - nit000 + 1, ') or nstock (', nstock,   &
-            &           ' is NOT a multiple of nn_fsbc (', nn_fsbc, ')'
-         CALL ctl_stop( ctmp1, 'Impossible to properly do model restart' )
-      ENDIF
-      !
-      IF( MOD( rday, REAL(nn_fsbc, wp) * rdt ) /= 0 )   &
-         &  CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' )
-      !
-      IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. lk_cpl ) )   &
+      IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. ln_cpl ) )   &
          &   CALL ctl_stop( 'LIM sea-ice model requires a bulk formulation or coupled configuration' )
-      IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. lk_cpl ) )   &
-         &   CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or lk_cpl' )
+      IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. ln_cpl ) )   &
+         &   CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or ln_cpl' )
       IF( nn_ice == 4 .AND. lk_agrif )   &
          &   CALL ctl_stop( 'CICE sea-ice model not currently available with AGRIF' )
       IF( ( nn_ice == 3 .OR. nn_ice == 4 ) .AND. nn_ice_embd == 0 )   &
          &   CALL ctl_stop( 'LIM3 and CICE sea-ice models require nn_ice_embd = 1 or 2' )
-#if 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. ( ln_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. ln_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
 
-      IF( ln_dm2dc .AND. .NOT.( ln_flx .OR. ln_blk_core ) )   &
+      IF( ln_dm2dc .AND. .NOT.( ln_flx .OR. ln_blk_core ) .AND. nn_components /= jp_iam_opa )   &
          &   CALL ctl_stop( 'diurnal cycle into qsr field from daily values requires a flux or core-bulk formulation' )
       
-      IF( ln_dm2dc .AND. ( ( NINT(rday) / ( nn_fsbc * NINT(rdt) ) )  < 8 ) )   &
-         &   CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' )
-
       IF ( ln_wave ) THEN
       !Activated wave module but neither drag nor stokes drift activated
@@ -233 +227 @@
          & asked coupling with drag coefficient (ln_cdgw =T) or Stokes drift (ln_sdw=T) ')
       ENDIF 
-      
       !                          ! Choice of the Surface Boudary Condition (set nsbc)
+      ll_purecpl = ln_cpl .AND. .NOT. ln_mixcpl
+      !
       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( ll_purecpl      ) THEN   ;   nsbc = jp_purecpl ; icpt = icpt + 1   ;   ENDIF       ! Pure Coupled         formulation
+      IF( cp_cfg == 'gyre') THEN   ;   nsbc = jp_gyre                        ;   ENDIF       ! GYRE analytical      formulation
+      IF( nn_components == jp_iam_opa )   &
+         &                  THEN   ;   nsbc = jp_none    ; icpt = icpt + 1   ;   ENDIF       ! opa coupling via SAS module
+      IF( lk_esopa        )            nsbc = jp_esopa                                       ! esopa test, ALL formulations
       !
       IF( icpt /= 1 .AND. .NOT.lk_esopa ) THEN
@@ -254 +251 @@
       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_purecpl )   WRITE(numout,*) '              pure coupled formulation'
+         IF( nsbc == jp_mfs     )   WRITE(numout,*) '              MFS Bulk formulation'
+         IF( nsbc == jp_none    )   WRITE(numout,*) '              OPA coupled to SAS via oasis'
+         IF( ln_mixcpl          )   WRITE(numout,*) '              + forced-coupled mixed formulation'
+         IF( nn_components/= jp_iam_nemo )  &
+            &                       WRITE(numout,*) '              + OASIS coupled SAS'
+      ENDIF
+      !
+      IF( lk_oasis )   CALL sbc_cpl_init (nn_ice)   ! OASIS initialisation. must be done before: (1) first time step
+      !                                                     !                                            (2) the use of nn_fsbc
+
+!     nn_fsbc initialization if OPA-SAS coupling via OASIS
+!     sas model time step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly
+      IF ( nn_components /= jp_iam_nemo ) THEN
+
+         IF ( nn_components == jp_iam_opa ) nn_fsbc = cpl_freq('O_SFLX') / NINT(rdt)
+         IF ( nn_components == jp_iam_sas ) nn_fsbc = cpl_freq('I_SFLX') / NINT(rdt)
+         !
+         IF(lwp)THEN
+            WRITE(numout,*)
+            WRITE(numout,*)"   OPA-SAS coupled via OASIS : nn_fsbc re-defined from OASIS namcouple ", nn_fsbc
+            WRITE(numout,*)
+         ENDIF
+      ENDIF
+
+      IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR.   &
+          MOD( nstock             , nn_fsbc) /= 0 ) THEN 
+         WRITE(ctmp1,*) 'experiment length (', nitend - nit000 + 1, ') or nstock (', nstock,   &
+            &           ' is NOT a multiple of nn_fsbc (', nn_fsbc, ')'
+         CALL ctl_stop( ctmp1, 'Impossible to properly do model restart' )
+      ENDIF
+      !
+      IF( MOD( rday, REAL(nn_fsbc, wp) * rdt ) /= 0 )   &
+         &  CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' )
+      !
+      IF( ln_dm2dc .AND. ( ( NINT(rday) / ( nn_fsbc * NINT(rdt) ) )  < 8 ) )   &
+         &   CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' )
+
+                               CALL sbc_ssm_init               ! Sea-surface mean fields initialisation
+      !
+      IF( ln_ssr           )   CALL sbc_ssr_init               ! Sea-Surface Restoring initialisation
+      !
+                               CALL sbc_rnf_init               ! Runof initialisation
+      !
+      IF( nn_ice == 3      )   CALL sbc_lim_init               ! LIM3 initialisation
+
+      IF( nn_ice == 4      )   CALL cice_sbc_init( nsbc )      ! CICE initialisation
+      
    END SUBROUTINE sbc_init
 
@@ -309 +344 @@
       !                                            ! ---------------------------------------- !
       !
-      IF( ln_apr_dyn ) CALL sbc_apr( kt )                ! atmospheric pressure provided at kt+0.5*nn_fsbc
+      IF ( .NOT. lk_bdy ) then
+         IF( ln_apr_dyn ) CALL sbc_apr( kt )                ! atmospheric pressure provided at kt+0.5*nn_fsbc
+      ENDIF
                                                          ! (caution called before sbc_ssm)
       !
-      CALL sbc_ssm( kt )                                 ! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m)
-      !                                                  ! averaged over nf_sbc time-step
+      IF( nn_components /= jp_iam_sas )   CALL sbc_ssm( kt )   ! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m)
+      !                                                        ! averaged over nf_sbc time-step
 
       IF (ln_wave) CALL sbc_wave( kt )
@@ -320 +357 @@
       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  )   
+         IF( nn_components == jp_iam_sas ) &
+            &                CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: SAS receiving fields from OPA 
+                             CALL sbc_blk_core( kt )                    ! bulk formulation : CORE for the ocean
+                                                                        ! from oce: sea surface variables (sst_m, sss_m,  ssu_m,  ssv_m)
+      CASE( jp_purecpl )  ;  CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! pure coupled formulation
+                                                                        !
+      CASE( jp_mfs   )   ;   CALL sbc_blk_mfs ( kt )                    ! bulk formulation : MFS for the ocean
+      CASE( jp_none  ) 
+         IF( nn_components == jp_iam_opa ) &
+                             CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: OPA receiving fields from SAS
+      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
+
+      IF( ln_mixcpl )        CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! forced-coupled mixed formulation after forcing
+
 
       !                                            !==  Misc. Options  ==!
@@ -342 +390 @@
       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
@@ -357 +406 @@
       !                                                           ! (update freshwater fluxes)
 !RBbug do not understand why see ticket 667
-      !clem-bugsal CALL lbc_lnk( emp, 'T', 1. )
+!clem: it looks like it is necessary for the north fold (in certain circumstances). Don't know why.
+      CALL lbc_lnk( emp, 'T', 1. )
       !
       IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    !
@@ -398 +448 @@
          ! CALL iom_rstput( kt, nitrst, numrow, 'qsr_b'  , qsr  )
          CALL iom_rstput( kt, nitrst, numrow, 'emp_b'  , emp  )
-         CALL iom_rstput( kt, nitrst, numrow, 'sfx_b' , sfx )
+         CALL iom_rstput( kt, nitrst, numrow, 'sfx_b'  , sfx  )
       ENDIF
 
@@ -413 +463 @@
          CALL iom_put( "qns"   , qns        )                   ! solar heat flux
          CALL iom_put( "qsr"   ,       qsr  )                   ! solar heat flux
-         IF( nn_ice > 0 )   CALL iom_put( "ice_cover", fr_i )   ! ice fraction 
+         IF( nn_ice > 0 .OR. nn_components == jp_iam_opa )   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 )

branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

@@ -19 +19 @@
    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 +25 @@
    USE iom             ! I/O module
    USE lib_mpp         ! MPP library
+   USE eosbn2
+   USE wrk_nemo        ! Memory allocation
 
    IMPLICIT NONE
@@ -29 +32 @@
 
    PUBLIC   sbc_rnf       ! routine call in sbcmod module
-   PUBLIC   sbc_rnf_div   ! routine called in sshwzv module
+   PUBLIC   sbc_rnf_div   ! routine called in divcurl module
    PUBLIC   sbc_rnf_alloc ! routine call in sbcmod module
    PUBLIC   sbc_rnf_init  ! (PUBLIC for TAM)
    !                                                     !!* namsbc_rnf namelist *
-   CHARACTER(len=100), PUBLIC ::   cn_dir          !: Root directory for location of ssr files
-   LOGICAL           , PUBLIC ::   ln_rnf_depth    !: depth       river runoffs attribute specified in a file
-   LOGICAL           , PUBLIC ::   ln_rnf_tem      !: temperature river runoffs attribute specified in a file
+   CHARACTER(len=100)         ::   cn_dir          !: Root directory for location of rnf files
+   LOGICAL                    ::   ln_rnf_depth      !: depth       river runoffs attribute specified in a file
+   LOGICAL                    ::   ln_rnf_depth_ini  !: depth       river runoffs  computed at the initialisation
+   REAL(wp)                   ::   rn_rnf_max        !: maximum value of the runoff climatologie ( ln_rnf_depth_ini = .true )
+   REAL(wp)                   ::   rn_dep_max        !: depth over which runoffs is spread ( ln_rnf_depth_ini = .true )
+   INTEGER                    ::   nn_rnf_depth_file !: create (=1) a runoff depth file or not (=0)
+   LOGICAL                    ::   ln_rnf_tem      !: temperature river runoffs attribute specified in a file
    LOGICAL           , PUBLIC ::   ln_rnf_sal      !: salinity    river runoffs attribute specified in a file
-   LOGICAL           , PUBLIC ::   ln_rnf_emp      !: runoffs into a file to be read or already into precipitation
    TYPE(FLD_N)       , PUBLIC ::   sn_rnf          !: information about the runoff file to be read
-   TYPE(FLD_N)       , PUBLIC ::   sn_cnf          !: information about the runoff mouth file to be read
+   TYPE(FLD_N)                ::   sn_cnf          !: information about the runoff mouth file to be read
    TYPE(FLD_N)                ::   sn_s_rnf        !: information about the salinities of runoff file to be read
    TYPE(FLD_N)                ::   sn_t_rnf        !: information about the temperatures of runoff file to be read
    TYPE(FLD_N)                ::   sn_dep_rnf      !: information about the depth which river inflow affects
    LOGICAL           , PUBLIC ::   ln_rnf_mouth    !: specific treatment in mouths vicinity
-   REAL(wp)          , PUBLIC ::   rn_hrnf         !: runoffs, depth over which enhanced vertical mixing is used
+   REAL(wp)                   ::   rn_hrnf         !: runoffs, depth over which enhanced vertical mixing is used
    REAL(wp)          , PUBLIC ::   rn_avt_rnf      !: runoffs, value of the additional vertical mixing coef. [m2/s]
-   REAL(wp)          , PUBLIC ::   rn_rfact        !: multiplicative factor for runoff
+   REAL(wp)                   ::   rn_rfact        !: multiplicative factor for runoff
+
+   LOGICAL           , PUBLIC ::   l_rnfcpl = .false.       ! runoffs recieved from oasis
 
    INTEGER , PUBLIC  ::   nkrnf = 0         !: nb of levels over which Kz is increased at river mouths
@@ -55 +63 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rnf_tsc_b, rnf_tsc  !: before and now T & S runoff contents   [K.m/s & PSU.m/s]   
 
-   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   sf_rnf       ! structure: river runoff (file information, fields read)
-   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   sf_s_rnf     ! structure: river runoff salinity (file information, fields read)  
-   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   sf_t_rnf     ! structure: river runoff temperature (file information, fields read)  
+   TYPE(FLD),        ALLOCATABLE, DIMENSION(:) ::   sf_rnf       ! structure: river runoff (file information, fields read)
+   TYPE(FLD),        ALLOCATABLE, DIMENSION(:) ::   sf_s_rnf     ! structure: river runoff salinity (file information, fields read)  
+   TYPE(FLD),        ALLOCATABLE, DIMENSION(:) ::   sf_t_rnf     ! structure: river runoff temperature (file information, fields read)  
  
    !! * Substitutions  
@@ -98 +106 @@
       INTEGER  ::   z_err = 0 ! dummy integer for error handling
       !!----------------------------------------------------------------------
-      !
-      IF( kt == nit000 )   CALL sbc_rnf_init                           ! Read namelist and allocate structures
+      REAL(wp), DIMENSION(:,:), POINTER       ::   ztfrz   ! freezing point used for temperature correction
+      !
+      CALL wrk_alloc( jpi,jpj, ztfrz)
 
       !                                            ! ---------------------------------------- !
@@ -109 +118 @@
       ENDIF
 
-      !                                                   !-------------------!
-      IF( .NOT. ln_rnf_emp ) THEN                         !   Update runoff   !
-         !                                                !-------------------!
-         !
-                             CALL fld_read ( kt, nn_fsbc, sf_rnf   )    ! Read Runoffs data and provide it at kt
-         IF( ln_rnf_tem  )   CALL fld_read ( kt, nn_fsbc, sf_t_rnf )    ! idem for runoffs temperature if required
-         IF( ln_rnf_sal  )   CALL fld_read ( kt, nn_fsbc, sf_s_rnf )    ! idem for runoffs salinity    if required
-         !
-         ! Runoff reduction only associated to the ORCA2_LIM configuration
-         ! when reading the NetCDF file runoff_1m_nomask.nc
-         IF( cp_cfg == 'orca' .AND. jp_cfg == 2 )   THEN
-            WHERE( 40._wp < gphit(:,:) .AND. gphit(:,:) < 65._wp )
-               sf_rnf(1)%fnow(:,:,1) = 0.85 * sf_rnf(1)%fnow(:,:,1)
+      !                                            !-------------------!
+      !                                            !   Update runoff   !
+      !                                            !-------------------!
+      !
+      IF( .NOT. l_rnfcpl )   CALL fld_read ( kt, nn_fsbc, sf_rnf   )    ! Read Runoffs data and provide it at kt
+      IF(   ln_rnf_tem   )   CALL fld_read ( kt, nn_fsbc, sf_t_rnf )    ! idem for runoffs temperature if required
+      IF(   ln_rnf_sal   )   CALL fld_read ( kt, nn_fsbc, sf_s_rnf )    ! idem for runoffs salinity    if required
+      !
+      ! Runoff reduction only associated to the ORCA2_LIM configuration
+      ! when reading the NetCDF file runoff_1m_nomask.nc
+      IF( cp_cfg == 'orca' .AND. jp_cfg == 2 .AND. .NOT. l_rnfcpl )   THEN
+         WHERE( 40._wp < gphit(:,:) .AND. gphit(:,:) < 65._wp )
+            sf_rnf(1)%fnow(:,:,1) = 0.85 * sf_rnf(1)%fnow(:,:,1)
+         END WHERE
+      ENDIF
+      !
+      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN
+         !
+         IF( .NOT. l_rnfcpl )   rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) )       ! updated runoff value at time step kt
+         !
+         !                                                     ! set temperature & salinity content of runoffs
+         IF( ln_rnf_tem ) THEN                                       ! use runoffs temperature data
+            rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0
+            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
-         ENDIF
-         !
-         IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN
-            !
-            rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) )       ! updated runoff value at time step kt
-            !
-            !                                                     ! set temperature & salinity content of runoffs
-            IF( ln_rnf_tem ) THEN                                       ! use runoffs temperature data
-               rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0
-               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
-            ELSE                                                        ! use SST as runoffs temperature
-               rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0
-            ENDIF
-            !                                                           ! use runoffs salinity data
-            IF( ln_rnf_sal )   rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0
-            !                                                           ! else use S=0 for runoffs (done one for all in the init)
-            IF ( ANY( rnf(:,:) < 0._wp ) ) z_err=1
-            IF(lk_mpp) CALL mpp_sum(z_err)
-            IF( z_err > 0 ) CALL ctl_stop( 'sbc_rnf : negative runnoff values exist' )
-            !
-            CALL iom_put( "runoffs", rnf )         ! output runoffs arrays
-         ENDIF
-         !
-      ENDIF
-      !
+            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
+            rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0
+         ENDIF
+         !                                                           ! use runoffs salinity data
+         IF( ln_rnf_sal )   rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0
+         !                                                           ! else use S=0 for runoffs (done one for all in the init)
+         CALL iom_put( "runoffs", rnf )         ! output runoffs arrays
+      ENDIF
+      !
+      !                                                ! ---------------------------------------- !
       IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    !
          !                                             ! ---------------------------------------- !
@@ -160 +168 @@
          ELSE                                                   !* no restart: set from nit000 values
             IF(lwp) WRITE(numout,*) '          nit000-1 runoff forcing fields set to nit000'
-             rnf_b    (:,:  ) = rnf    (:,:  )
-             rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)
+            rnf_b    (:,:  ) = rnf    (:,:  )
+            rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)
          ENDIF
       ENDIF
@@ -176 +184 @@
       ENDIF
       !
+      CALL wrk_dealloc( jpi,jpj, ztfrz)
+      !
    END SUBROUTINE sbc_rnf
 
@@ -199 +209 @@
       zfact = 0.5_wp
       !
-      IF( ln_rnf_depth ) THEN      !==   runoff distributed over several levels   ==!
+      IF( ln_rnf_depth .OR. ln_rnf_depth_ini ) THEN      !==   runoff distributed over several levels   ==!
          IF( lk_vvl ) THEN             ! variable volume case
             DO jj = 1, jpj                   ! update the depth over which runoffs are distributed
@@ -243 +253 @@
       !!----------------------------------------------------------------------
       CHARACTER(len=32) ::   rn_dep_file   ! runoff file name
-      INTEGER           ::   ji, jj, jk    ! dummy loop indices
+      INTEGER           ::   ji, jj, jk, jm    ! dummy loop indices
       INTEGER           ::   ierror, inum  ! temporary integer
       INTEGER           ::   ios           ! Local integer output status for namelist read
-      !
-      NAMELIST/namsbc_rnf/ cn_dir, ln_rnf_emp, ln_rnf_depth, ln_rnf_tem, ln_rnf_sal,   &
+      INTEGER           ::   nbrec         ! temporary integer
+      REAL(wp)          ::   zacoef  
+      REAL(wp), DIMENSION(12)                 :: zrec             ! times records
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zrnfcl    
+      REAL(wp), DIMENSION(:,:  ), ALLOCATABLE :: zrnf
+      !
+      NAMELIST/namsbc_rnf/ cn_dir            , ln_rnf_depth, ln_rnf_tem, ln_rnf_sal,   &
          &                 sn_rnf, sn_cnf    , sn_s_rnf    , sn_t_rnf  , sn_dep_rnf,   &
-         &                 ln_rnf_mouth      , rn_hrnf     , rn_avt_rnf, rn_rfact
-      !!----------------------------------------------------------------------
+         &                 ln_rnf_mouth      , rn_hrnf     , rn_avt_rnf, rn_rfact,     &
+         &                 ln_rnf_depth_ini  , rn_dep_max  , rn_rnf_max, nn_rnf_depth_file
+      !!----------------------------------------------------------------------
+      !
+      !                                         !==  allocate runoff arrays
+      IF( sbc_rnf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_rnf_alloc : unable to allocate arrays' )
+      !
+      IF( .NOT. ln_rnf ) THEN                      ! no specific treatment in vicinity of river mouths 
+         ln_rnf_mouth  = .FALSE.                   ! default definition needed for example by sbc_ssr or by tra_adv_muscl
+         nkrnf         = 0
+         rnf     (:,:) = 0.0_wp
+         rnf_b   (:,:) = 0.0_wp
+         rnfmsk  (:,:) = 0.0_wp
+         rnfmsk_z(:)   = 0.0_wp
+         RETURN
+      ENDIF
       !
       !                                   ! ============
@@ -271 +300 @@
          WRITE(numout,*) '~~~~~~~ '
          WRITE(numout,*) '   Namelist namsbc_rnf'
-         WRITE(numout,*) '      runoff in a file to be read                ln_rnf_emp   = ', ln_rnf_emp
          WRITE(numout,*) '      specific river mouths treatment            ln_rnf_mouth = ', ln_rnf_mouth
          WRITE(numout,*) '      river mouth additional Kz                  rn_avt_rnf   = ', rn_avt_rnf
@@ -277 +305 @@
          WRITE(numout,*) '      multiplicative factor for runoff           rn_rfact     = ', rn_rfact
       ENDIF
-      !
       !                                   ! ==================
       !                                   !   Type of runoff
       !                                   ! ==================
-      !                                         !==  allocate runoff arrays
-      IF( sbc_rnf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_rnf_alloc : unable to allocate arrays' )
-      !
-      IF( ln_rnf_emp ) THEN                     !==  runoffs directly provided in the precipitations  ==!
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '          runoffs directly provided in the precipitations'
-         IF( ln_rnf_depth .OR. ln_rnf_tem .OR. ln_rnf_sal ) THEN
-           CALL ctl_warn( 'runoffs already included in precipitations, so runoff (T,S, depth) attributes will not be used' )
-           ln_rnf_depth = .FALSE.   ;   ln_rnf_tem = .FALSE.   ;   ln_rnf_sal = .FALSE.
-         ENDIF
-         !
-      ELSE                                      !==  runoffs read in a file : set sf_rnf structure  ==!
-         !
+      !
+      IF( .NOT. l_rnfcpl ) THEN                    
          ALLOCATE( sf_rnf(1), STAT=ierror )         ! Create sf_rnf structure (runoff inflow)
          IF(lwp) WRITE(numout,*)
@@ -302 +318 @@
          ALLOCATE( sf_rnf(1)%fnow(jpi,jpj,1)   )
          IF( sn_rnf%ln_tint ) ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) )
-         !                                          ! fill sf_rnf with the namelist (sn_rnf) and control print
          CALL fld_fill( sf_rnf, (/ sn_rnf /), cn_dir, 'sbc_rnf_init', 'read runoffs data', 'namsbc_rnf' )
-         !
-         IF( ln_rnf_tem ) THEN                      ! Create (if required) sf_t_rnf structure
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '          runoffs temperatures read in a file'
-            ALLOCATE( sf_t_rnf(1), STAT=ierror  )
-            IF( ierror > 0 ) THEN
-               CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_t_rnf structure' )   ;   RETURN
-            ENDIF
-            ALLOCATE( sf_t_rnf(1)%fnow(jpi,jpj,1)   )
-            IF( sn_t_rnf%ln_tint ) ALLOCATE( sf_t_rnf(1)%fdta(jpi,jpj,1,2) )
-            CALL fld_fill (sf_t_rnf, (/ sn_t_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf' )
-         ENDIF
-         !
-         IF( ln_rnf_sal  ) THEN                     ! Create (if required) sf_s_rnf and sf_t_rnf structures
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '          runoffs salinities read in a file'
-            ALLOCATE( sf_s_rnf(1), STAT=ierror  )
-            IF( ierror > 0 ) THEN
-               CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_s_rnf structure' )   ;   RETURN
-            ENDIF
-            ALLOCATE( sf_s_rnf(1)%fnow(jpi,jpj,1)   )
-            IF( sn_s_rnf%ln_tint ) ALLOCATE( sf_s_rnf(1)%fdta(jpi,jpj,1,2) )
-            CALL fld_fill (sf_s_rnf, (/ sn_s_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf' )
-         ENDIF
-         !
-         IF( ln_rnf_depth ) THEN                    ! depth of runoffs set from a file
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '          runoffs depth read in a file'
-            rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname )
-            IF( .NOT. sn_dep_rnf%ln_clim ) THEN   ;   WRITE(rn_dep_file, '(a,"_y",i4)' ) TRIM( rn_dep_file ), nyear    ! add year 
-               IF( sn_dep_rnf%cltype == 'monthly' )   WRITE(rn_dep_file, '(a,"m",i2)'  ) TRIM( rn_dep_file ), nmonth   ! add month 
-            ENDIF 
-            CALL iom_open ( rn_dep_file, inum )                           ! open file
-            CALL iom_get  ( inum, jpdom_data, sn_dep_rnf%clvar, h_rnf )   ! read the river mouth array
-            CALL iom_close( inum )                                        ! close file
-            !
-            nk_rnf(:,:) = 0                               ! set the number of level over which river runoffs are applied
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  IF( h_rnf(ji,jj) > 0._wp ) THEN
-                     jk = 2
-                     DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1 ;  END DO
-                     nk_rnf(ji,jj) = jk
-                  ELSEIF( h_rnf(ji,jj) == -1._wp   ) THEN   ;  nk_rnf(ji,jj) = 1
-                  ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN   ;  nk_rnf(ji,jj) = mbkt(ji,jj)
-                  ELSE
-                     CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999'  )
-                     WRITE(999,*) 'ji, jj, h_rnf(ji,jj) :', ji, jj, h_rnf(ji,jj)
-                  ENDIF
+      ENDIF
+      !
+      IF( ln_rnf_tem ) THEN                      ! Create (if required) sf_t_rnf structure
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          runoffs temperatures read in a file'
+         ALLOCATE( sf_t_rnf(1), STAT=ierror  )
+         IF( ierror > 0 ) THEN
+            CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_t_rnf structure' )   ;   RETURN
+         ENDIF
+         ALLOCATE( sf_t_rnf(1)%fnow(jpi,jpj,1)   )
+         IF( sn_t_rnf%ln_tint ) ALLOCATE( sf_t_rnf(1)%fdta(jpi,jpj,1,2) )
+         CALL fld_fill (sf_t_rnf, (/ sn_t_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf' )
+      ENDIF
+      !
+      IF( ln_rnf_sal  ) THEN                     ! Create (if required) sf_s_rnf and sf_t_rnf structures
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          runoffs salinities read in a file'
+         ALLOCATE( sf_s_rnf(1), STAT=ierror  )
+         IF( ierror > 0 ) THEN
+            CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_s_rnf structure' )   ;   RETURN
+         ENDIF
+         ALLOCATE( sf_s_rnf(1)%fnow(jpi,jpj,1)   )
+         IF( sn_s_rnf%ln_tint ) ALLOCATE( sf_s_rnf(1)%fdta(jpi,jpj,1,2) )
+         CALL fld_fill (sf_s_rnf, (/ sn_s_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf' )
+      ENDIF
+      !
+      IF( ln_rnf_depth ) THEN                    ! depth of runoffs set from a file
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          runoffs depth read in a file'
+         rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname )
+         IF( .NOT. sn_dep_rnf%ln_clim ) THEN   ;   WRITE(rn_dep_file, '(a,"_y",i4)' ) TRIM( rn_dep_file ), nyear    ! add year 
+            IF( sn_dep_rnf%cltype == 'monthly' )   WRITE(rn_dep_file, '(a,"m",i2)'  ) TRIM( rn_dep_file ), nmonth   ! add month 
+         ENDIF
+         CALL iom_open ( rn_dep_file, inum )                           ! open file
+         CALL iom_get  ( inum, jpdom_data, sn_dep_rnf%clvar, h_rnf )   ! read the river mouth array
+         CALL iom_close( inum )                                        ! close file
+         !
+         nk_rnf(:,:) = 0                               ! set the number of level over which river runoffs are applied
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( h_rnf(ji,jj) > 0._wp ) THEN
+                  jk = 2
+                  DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1
+                  END DO
+                  nk_rnf(ji,jj) = jk
+               ELSEIF( h_rnf(ji,jj) == -1._wp   ) THEN   ;  nk_rnf(ji,jj) = 1
+               ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN   ;  nk_rnf(ji,jj) = mbkt(ji,jj)
+               ELSE
+                  CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999'  )
+                  WRITE(999,*) 'ji, jj, h_rnf(ji,jj) :', ji, jj, h_rnf(ji,jj)
+               ENDIF
+            END DO
+         END DO
+         DO jj = 1, jpj                                ! set the associated depth
+            DO ji = 1, jpi
+               h_rnf(ji,jj) = 0._wp
+               DO jk = 1, nk_rnf(ji,jj)
+                  h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk)
                END DO
             END DO
-            DO jj = 1, jpj                                ! set the associated depth
-               DO ji = 1, jpi
-                  h_rnf(ji,jj) = 0._wp
-                  DO jk = 1, nk_rnf(ji,jj)
-                     h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk)
+         END DO
+         !
+      ELSE IF( ln_rnf_depth_ini ) THEN           ! runoffs applied at the surface
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '    depth of runoff computed once from max value of runoff'
+         IF(lwp) WRITE(numout,*) '    max value of the runoff climatologie (over global domain) rn_rnf_max = ', rn_rnf_max
+         IF(lwp) WRITE(numout,*) '    depth over which runoffs is spread                        rn_dep_max = ', rn_dep_max
+         IF(lwp) WRITE(numout,*) '     create (=1) a runoff depth file or not (=0)      nn_rnf_depth_file  = ', nn_rnf_depth_file
+
+         CALL iom_open( TRIM( sn_rnf%clname ), inum )    !  open runoff file
+         CALL iom_gettime( inum, zrec, kntime=nbrec)
+         ALLOCATE( zrnfcl(jpi,jpj,nbrec) )     ;      ALLOCATE( zrnf(jpi,jpj) )
+         DO jm = 1, nbrec
+            CALL iom_get( inum, jpdom_data, TRIM( sn_rnf%clvar ), zrnfcl(:,:,jm), jm )
+         END DO
+         CALL iom_close( inum )
+         zrnf(:,:) = MAXVAL( zrnfcl(:,:,:), DIM=3 )   !  maximum value in time
+         DEALLOCATE( zrnfcl )
+         !
+         h_rnf(:,:) = 1.
+         !
+         zacoef = rn_dep_max / rn_rnf_max            ! coef of linear relation between runoff and its depth (150m for max of runoff)
+         !
+         WHERE( zrnf(:,:) > 0._wp )  h_rnf(:,:) = zacoef * zrnf(:,:)   ! compute depth for all runoffs
+         !
+         DO jj = 1, jpj                     ! take in account min depth of ocean rn_hmin
+            DO ji = 1, jpi
+               IF( zrnf(ji,jj) > 0._wp ) THEN
+                  jk = mbkt(ji,jj)
+                  h_rnf(ji,jj) = MIN( h_rnf(ji,jj), gdept_0(ji,jj,jk ) )
+               ENDIF
+            END DO
+         END DO
+         !
+         nk_rnf(:,:) = 0                       ! number of levels on which runoffs are distributed
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( zrnf(ji,jj) > 0._wp ) THEN
+                  jk = 2
+                  DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1
                   END DO
+                  nk_rnf(ji,jj) = jk
+               ELSE
+                  nk_rnf(ji,jj) = 1
+               ENDIF
+            END DO
+         END DO
+         !
+         DEALLOCATE( zrnf )
+         !
+         DO jj = 1, jpj                                ! set the associated depth
+            DO ji = 1, jpi
+               h_rnf(ji,jj) = 0._wp
+               DO jk = 1, nk_rnf(ji,jj)
+                  h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk)
                END DO
             END DO
-         ELSE                                       ! runoffs applied at the surface
-            nk_rnf(:,:) = 1
-            h_rnf (:,:) = fse3t(:,:,1)
-         ENDIF
-         !
+         END DO
+         !
+         IF( nn_rnf_depth_file == 1 ) THEN      !  save  output nb levels for runoff
+            IF(lwp) WRITE(numout,*) '              create runoff depht file'
+            CALL iom_open  ( TRIM( sn_dep_rnf%clname ), inum, ldwrt = .TRUE., kiolib = jprstlib )
+            CALL iom_rstput( 0, 0, inum, 'rodepth', h_rnf )
+            CALL iom_close ( inum )
+         ENDIF
+      ELSE                                       ! runoffs applied at the surface
+         nk_rnf(:,:) = 1
+         h_rnf (:,:) = fse3t(:,:,1)
       ENDIF
       !
@@ -388 +468 @@
          IF( rn_hrnf > 0._wp ) THEN
             nkrnf = 2
-            DO WHILE( nkrnf /= jpkm1 .AND. gdepw_1d(nkrnf+1) < rn_hrnf )   ;   nkrnf = nkrnf + 1   ;   END DO
+            DO WHILE( nkrnf /= jpkm1 .AND. gdepw_1d(nkrnf+1) < rn_hrnf )   ;   nkrnf = nkrnf + 1
+            END DO
             IF( ln_sco )   CALL ctl_warn( 'sbc_rnf: number of levels over which Kz is increased is computed for zco...' )
          ENDIF

branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90

@@ -14 +14 @@
    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 +55 @@
       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
       !!---------------------------------------------------------------------
-      !                                                   ! ---------------------------------------- !
+
+      !                                        !* surface T-, U-, V- ocean level variables (T, S, depth, velocity)
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            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( 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)
+         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 +81 @@
          ENDIF
          !
-         IF( lk_vvl )   fse3t_m(:,:) = fse3t_n(:,:,1)
+         IF( lk_vvl )   e3t_m(:,:) = fse3t_n(:,:,1)
+         !
+         frq_m(:,:) = fraqsr_1lev(:,:)
          !
       ELSE
@@ -79 +94 @@
             ssu_m(:,:) = zcoef * ub(:,:,1)
             ssv_m(:,:) = zcoef * vb(:,:,1)
-            sst_m(:,:) = zcoef * tsn(:,:,1,jp_tem)
-            sss_m(:,:) = zcoef * tsn(:,:,1,jp_sal)
-            !                          ! removed inverse barometer ssh when Patm forcing is used 
+            IF( ln_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(:,:)
-            ENDIF
-            IF( lk_vvl )   fse3t_m(:,:) = zcoef * fse3t_n(:,:,1)
+            ELSE                    ;   ssh_m(:,:) = zcoef * sshn(:,:)
+            ENDIF
+            !
+            IF( lk_vvl )   e3t_m(:,:) = zcoef * fse3t_n(:,:,1)
+            !
+            frq_m(:,:) = zcoef * fraqsr_1lev(:,:)
             !                                             ! ---------------------------------------- !
          ELSEIF( MOD( kt - 2 , nn_fsbc ) == 0 ) THEN      !   Initialisation: New mean computation   !
@@ -94 +114 @@
             sss_m(:,:) = 0.e0
             ssh_m(:,:) = 0.e0
-            IF( lk_vvl )   fse3t_m(:,:) = 0.e0
+            IF( lk_vvl )   e3t_m(:,:) = 0.e0
+            frq_m(:,:) = 0.e0
          ENDIF
          !                                                ! ---------------------------------------- !
@@ -101 +122 @@
          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)
+         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 )   e3t_m(:,:) = fse3t_m(:,:) + fse3t_n(:,:,1)
+         !
+         frq_m(:,:) =   frq_m(:,:) + fraqsr_1lev(:,:)
 
          !                                                ! ---------------------------------------- !
@@ -118 +144 @@
             ssv_m(:,:) = ssv_m(:,:) * zcoef           !
             ssh_m(:,:) = ssh_m(:,:) * zcoef           ! mean SSH             [m]
-            IF( lk_vvl )   fse3t_m(:,:) = fse3t_m(:,:) * zcoef   ! mean vertical scale factor [m]
+            IF( lk_vvl )   e3t_m(:,:) = fse3t_m(:,:) * zcoef   ! mean vertical scale factor [m]
+            frq_m(:,:) = frq_m(:,:) * zcoef   ! mean fraction of solar net radiation absorbed in the 1st T level [-]
             !
          ENDIF
@@ -135 +162 @@
             CALL iom_rstput( kt, nitrst, numrow, 'sss_m'  , sss_m  )
             CALL iom_rstput( kt, nitrst, numrow, 'ssh_m'  , ssh_m  )
-            IF( lk_vvl ) THEN
-               CALL iom_rstput( kt, nitrst, numrow, 'fse3t_m'  , fse3t_m(:,:)  )
-            END IF
-            !
-         ENDIF
-         !
+            IF( lk_vvl )   CALL iom_rstput( kt, nitrst, numrow, 'e3t_m'  , e3t_m  )
+            CALL iom_rstput( kt, nitrst, numrow, 'frq_m'  , frq_m  )
+            !
+         ENDIF
+         !
+      ENDIF
+      !
+      IF( MOD( kt - 1 , nn_fsbc ) == 0 ) THEN          !   Mean value at each nn_fsbc time-step   !
+         CALL iom_put( 'ssu_m', ssu_m )
+         CALL iom_put( 'ssv_m', ssv_m )
+         CALL iom_put( 'sst_m', sst_m )
+         CALL iom_put( 'sss_m', sss_m )
+         CALL iom_put( 'ssh_m', ssh_m )
+         IF( lk_vvl )   CALL iom_put( 'e3t_m', e3t_m )
+         CALL iom_put( 'frq_m', frq_m )
       ENDIF
       !
@@ -176 +212 @@
             CALL iom_get( numror, jpdom_autoglo, 'sss_m'  , sss_m  )   !   "         "    salinity    (T-point)
             CALL iom_get( numror, jpdom_autoglo, 'ssh_m'  , ssh_m  )   !   "         "    height      (T-point)
-            IF( lk_vvl ) CALL iom_get( numror, jpdom_autoglo, 'fse3t_m', fse3t_m(:,:) )
+            IF( lk_vvl ) CALL iom_get( numror, jpdom_autoglo, 'e3t_m', e3t_m )
+            ! fraction of solar net radiation absorbed in 1st T level
+            IF( iom_varid( numror, 'frq_m', ldstop = .FALSE. ) > 0 ) THEN
+               CALL iom_get( numror, jpdom_autoglo, 'frq_m'  , frq_m  )
+            ELSE
+               frq_m(:,:) = 1._wp   ! default definition
+            ENDIF
             !
             IF( zf_sbc /= REAL( nn_fsbc, wp ) ) THEN      ! nn_fsbc has changed between 2 runs
@@ -187 +229 @@
                sss_m(:,:) = zcoef * sss_m(:,:)
                ssh_m(:,:) = zcoef * ssh_m(:,:)
-               IF( lk_vvl ) fse3t_m(:,:) = zcoef * fse3t_m(:,:)
+               IF( lk_vvl )   e3t_m(:,:) = zcoef * fse3t_m(:,:)
+               frq_m(:,:) = zcoef * frq_m(:,:)
             ELSE
                IF(lwp) WRITE(numout,*) '~~~~~~~   mean fields read in the ocean restart file'
@@ -194 +237 @@
       ENDIF
       !
+      IF( .NOT. l_ssm_mean ) THEN   ! default initialisation. needed by lim_istate
+         !
+         IF(lwp) WRITE(numout,*) '          default initialisation of ss?_m arrays'
+         ssu_m(:,:) = ub(:,:,1)
+         ssv_m(:,:) = vb(:,:,1)
+         IF( ln_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) )
+         ELSE                    ;   sst_m(:,:) = tsn(:,:,1,jp_tem)
+         ENDIF
+         sss_m(:,:) = tsn(:,:,1,jp_sal)
+         ssh_m(:,:) = sshn(:,:)
+         IF( lk_vvl )   e3t_m(:,:) = fse3t_n(:,:,1)
+         frq_m(:,:) = 1._wp
+         !
+      ENDIF
+      !
    END SUBROUTINE sbc_ssm_init
 

branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90

@@ -10 +10 @@
    !!----------------------------------------------------------------------
    !!   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 +17 @@
    USE phycst         ! physical constants
    USE sbcrnf         ! surface boundary condition : runoffs
+   !
    USE fldread        ! read input fields
    USE iom            ! I/O manager
@@ -93 +95 @@
             !
             IF( nn_sstr == 1 ) THEN                                   !* Temperature restoring term
-!CDIR COLLAPSE
                DO jj = 1, jpj
                   DO ji = 1, jpi

branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90

@@ -36 +36 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.5 , NEMO Consortium (2013)
-   !! $Id: $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------

branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90

@@ -39 +39 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
-   !! $Id: $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------

branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/SBC/tide_mod.F90

@@ -35 +35 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
-   !! $Id:$ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------

branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/SBC/tideini.F90

@@ -36 +36 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.5 , NEMO Consortium (2013)
-   !! $Id: $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -80 +80 @@
           END DO
        END DO
+       !       
+       ! Ensure that tidal components have been set in namelist_cfg
+       IF( nb_harmo .EQ. 0 ) CALL ctl_stop( 'tide_init : No tidal components set in nam_tide' )
        !
        IF(lwp) THEN

branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90

@@ -26 +26 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: sbcfwb.F90 3625 2012-11-21 13:19:18Z acc $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------