Changeset 1218

Timestamp:

2008-10-28T10:12:16+01:00 (16 years ago)

Author:

smasson

Message:

first implementation of the new coupling interface in the trunk, see ticket:155

Location:

trunk

Files:

• CONFIG/ORCA2_LIM/EXP00/namelist (modified) (1 diff)
• NEMO/LIM_SRC_2/limsbc_2.F90 (modified) (6 diffs)
• NEMO/LIM_SRC_2/limthd_2.F90 (modified) (24 diffs)
• NEMO/LIM_SRC_2/limthd_zdf_2.F90 (modified) (7 diffs)
• NEMO/OPA_SRC/SBC/cpl_oasis3.F90 (modified) (8 diffs)
• NEMO/OPA_SRC/SBC/sbc_ice.F90 (modified) (3 diffs)
• NEMO/OPA_SRC/SBC/sbc_oce.F90 (modified) (3 diffs)
• NEMO/OPA_SRC/SBC/sbccpl.F90 (modified) (1 diff)
• NEMO/OPA_SRC/SBC/sbcfwb.F90 (modified) (1 diff)
• NEMO/OPA_SRC/SBC/sbcice_lim.F90 (modified) (1 diff)
• NEMO/OPA_SRC/SBC/sbcice_lim_2.F90 (modified) (9 diffs)
• NEMO/OPA_SRC/SBC/sbcmod.F90 (modified) (8 diffs)
• NEMO/OPA_SRC/cpl_oce.F90 (deleted)
• NEMO/OPA_SRC/geo2ocean.F90 (modified) (9 diffs)
• NEMO/OPA_SRC/ice_oce.F90 (modified) (5 diffs)
• NEMO/OPA_SRC/opa.F90 (modified) (1 diff)
• NEMO/OPA_SRC/restart.F90 (modified) (1 diff)
• NEMO/OPA_SRC/step.F90 (modified) (3 diffs)

trunk/CONFIG/ORCA2_LIM/EXP00/namelist

@@ -177 +177 @@
 &namsbc_cpl    !   coupled ocean/atmosphere model                        ("key_coupled")
 !-----------------------------------------------------------------------
+! SEND
+cn_snd_temperature= 'weighted oce and ice'  ! 'oce only' 'weighted oce and ice' 'mixed oce-ice'
+cn_snd_albedo     = 'weighted ice'          ! 'none' 'weighted ice' 'mixed oce-ice'
+cn_snd_thickness  = 'none'                  ! 'none' 'weighted ice and snow'
+cn_snd_crt_nature = 'none'                  ! 'none' 'oce only' 'weighted oce and ice' 'mixed oce-ice'
+cn_snd_crt_refere = 'spherical'             ! 'spherical' 'cartesian'
+cn_snd_crt_orient = 'eastward-northward'    ! 'eastward-northward' or 'local grid'
+cn_snd_crt_grid   = 'T'                     ! 'T'
+! RECEIVE
+cn_rcv_w10m       = 'coupled'               ! 'none' 'coupled'
+cn_rcv_tau_nature = 'oce only'              ! 'oce only' 'oce and ice' 'mixed oce-ice'
+cn_rcv_tau_refere = 'cartesian'             ! 'spherical' 'cartesian'
+cn_rcv_tau_orient = 'eastward-northward'    ! 'eastward-northward' or 'local grid'
+cn_rcv_tau_grid   = 'U,V'                   ! 'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V'
+cn_rcv_dqnsdt     = 'coupled'               ! 'none' 'coupled'
+cn_rcv_qsr        = 'oce and ice'           ! 'conservative' 'oce and ice' 'mixed oce-ice'
+cn_rcv_qns        = 'oce and ice'           ! 'conservative' 'oce and ice' 'mixed oce-ice'
+cn_rcv_emp        = 'conservative'          ! 'conservative' 'oce and ice' 'mixed oce-ice'
+cn_rcv_rnf        = 'coupled'               ! 'coupled' 'climato' 'mixed'
+cn_rcv_cal        = 'coupled'               ! 'none' 'coupled'
 /
 !-----------------------------------------------------------------------

trunk/NEMO/LIM_SRC_2/limsbc_2.F90

@@ -29 +29 @@
    USE albedo           ! albedo parameters
    USE prtctl           ! Print control
+   USE cpl_oasis3, ONLY : lk_cpl
 
    IMPLICIT NONE
@@ -85 +86 @@
       REAL(wp) ::   zutau , zvtau    ! lead fraction at U- & V-points
       REAL(wp) ::   zu_io , zv_io    ! 2 components of the ice-ocean velocity
-#if defined key_coupled    
-      REAL(wp), DIMENSION(jpi,jpj) ::   zalb     ! albedo of ice under overcast sky
-      REAL(wp), DIMENSION(jpi,jpj) ::   zalbp    ! albedo of ice under clear sky
-#endif
+! interface 2D --> 3D
+      REAL(wp), DIMENSION(jpi,jpj,1) ::   zalb     ! albedo of ice under overcast sky
+      REAL(wp), DIMENSION(jpi,jpj,1) ::   zalbp    ! albedo of ice under clear sky
+      REAL(wp), DIMENSION(jpi,jpj,1) ::   zsist    ! surface ice temperature (K)
+      REAL(wp), DIMENSION(jpi,jpj,1) ::   zhicif   ! ice thickness
+      REAL(wp), DIMENSION(jpi,jpj,1) ::   zhsnif   ! snow thickness
       REAL(wp) ::   zsang, zmod, zfm
       REAL(wp), DIMENSION(jpi,jpj) ::   ztio_u, ztio_v   ! ocean stress below sea-ice
@@ -119 +122 @@
             ifral   = ( 1  - i1mfr * ( 1 - ial ) )   
             ifrdv   = ( 1  - ifral * ( 1 - ial ) ) * iadv 
+
+!!$            zinda   = 1.0 - AINT( pfrld(ji,jj) )                   !   = 0. if pure ocean else 1. (at previous time)
+!!$
+!!$            i1mfr   = 1.0 - AINT(  frld(ji,jj) )                   !   = 0. if pure ocean else 1. (at current  time)
+!!$
+!!$            IF( phicif(ji,jj) <= 0. ) THEN   ;   ifvt = zinda      !   = 1. if (snow and no ice at previous time) else 0. ???
+!!$            ELSE                             ;   ifvt = 0.
+!!$            ENDIF
+!!$
+!!$            IF( frld(ji,jj) >= pfrld(ji,jj) ) THEN   ;   idfr = 0.  !   = 0. if lead fraction increases from previous to current
+!!$            ELSE                                     ;   idfr = 1.   
+!!$            ENDIF
+!!$
+!!$            iflt    = zinda  * (1 - i1mfr) * (1 - ifvt )    !   = 1. if ice (not only snow) at previous and pure ocean at current
+!!$
+!!$            ial     = ifvt   * i1mfr    +    ( 1 - ifvt ) * idfr
+!!$!                 snow no ice   ice         ice or nothing  lead fraction increases
+!!$!                 at previous   now           at previous
+!!$!                -> ice aera increases  ???         -> ice aera decreases ???
+!!$
+!!$            iadv    = ( 1  - i1mfr ) * zinda  
+!!$!                     pure ocean      ice at
+!!$!                     at current      previous
+!!$!                        -> = 1. if ice disapear between previous and current
+!!$
+!!$            ifral   = ( 1  - i1mfr * ( 1 - ial ) )  
+!!$!                            ice at     ???
+!!$!                            current         
+!!$!                         -> ???
+!!$ 
+!!$            ifrdv   = ( 1  - ifral * ( 1 - ial ) ) * iadv 
+!!$!                                                    ice disapear                           
+!!$
+!!$
+
             !   computation the solar flux at ocean surface
-            zqsr    = pfrld(ji,jj) * qsr(ji,jj)  + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj)
+#if defined key_coupled 
+            zqsr = tqsr(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj) ) * ( 1.0 - pfrld(ji,jj) )
+#else
+            zqsr = pfrld(ji,jj) * qsr(ji,jj)  + ( 1.  - pfrld(ji,jj) ) * fstric(ji,jj)
+#endif            
             !  computation the non solar heat flux at ocean surface
             zqns    =  - ( 1. - thcm(ji,jj) ) * zqsr   &   ! part of the solar energy used in leads
@@ -145 +187 @@
          DO ji = 1, jpi
             
+#if defined key_coupled
+          zemp = emp_tot(ji,jj) - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )    &   ! 
+             &   + rdmsnif(ji,jj) / rdt_ice                                     !  freshwaterflux due to snow melting 
+#else
+!!$            !  computing freshwater exchanges at the ice/ocean interface
+!!$            zpme = - evap(ji,jj)    *   frld(ji,jj)           &   !  evaporation over oceanic fraction
+!!$               &   + tprecip(ji,jj)                           &   !  total precipitation
+!!$               &   - sprecip(ji,jj) * ( 1. - pfrld(ji,jj) )   &   !  remov. snow precip over ice
+!!$               &   - rdmsnif(ji,jj) / rdt_ice                     !  freshwaterflux due to snow melting 
             !  computing freshwater exchanges at the ice/ocean interface
             zemp = + emp(ji,jj)     *         frld(ji,jj)      &   !  e-p budget over open ocean fraction 
@@ -151 +202 @@
                &   + rdmsnif(ji,jj) / rdt_ice                      !  freshwaterflux due to snow melting 
                !                                                   !  ice-covered fraction:
+#endif            
 
             !  computing salt exchanges at the ice/ocean interface
@@ -217 +269 @@
 
       fr_i  (:,:) = 1.0 - frld(:,:)       ! sea-ice fraction
-      tn_ice(:,:) = sist(:,:)             ! sea-ice surface temperature                      
-
-#if defined key_coupled            
-      !------------------------------------------------!
-      !    Computation of snow/ice and ocean albedo    !
-      !------------------------------------------------!
-      zalb  (:,:) = 0.e0
-      zalbp (:,:) = 0.e0
-
-      CALL albedo_ice( sist, hicif, hsnif, zalbp, zalb )
-
-      alb_ice(:,:) =  0.5 * zalbp(:,:) + 0.5 * zalb (:,:)   ! Ice albedo (mean clear and overcast skys)
-#endif
+
+      IF ( lk_cpl ) THEN           
+         ! Ice surface temperature 
+         tn_ice(:,:) = sist(:,:)          ! sea-ice surface temperature       
+         ! Computation of snow/ice and ocean albedo
+         ! INTERFACE 3D versus 2D
+         zsist (:,:,1) = sist (:,:)
+         zhicif(:,:,1) = hicif(:,:)   ;   zhsnif(:,:,1) = hsnif(:,:)
+         CALL albedo_ice( zsist, zhicif, zhsnif, zalbp, zalb )
+         alb_ice(:,:) =  0.5 * ( zalbp(:,:,1) + zalb (:,:,1) )   ! Ice albedo (mean clear and overcast skys)
+      ENDIF
 
       IF(ln_ctl) THEN

trunk/NEMO/LIM_SRC_2/limthd_2.F90

@@ -7 +7 @@
    !!            2.0  !  02-07 (C. Ethe, G. Madec) F90
    !!            2.0  !  03-08 (C. Ethe)  add lim_thd_init
+   !!             -   !  08-2008  (A. Caubel, G. Madec, E. Maisonnave, S. Masson ) generic coupled interface
    !!---------------------------------------------------------------------
 #if defined key_lim2
@@ -15 +16 @@
    !!   lim_thd_init_2 : initialisation of sea-ice thermodynamic
    !!----------------------------------------------------------------------
-   !! * Modules used
    USE phycst          ! physical constants
    USE dom_oce         ! ocean space and time domain variables
@@ -31 +31 @@
    USE limtab_2
    USE prtctl          ! Print control
+   USE cpl_oasis3, ONLY : lk_cpl
       
    IMPLICIT NONE
@@ -37 +38 @@
    PUBLIC   lim_thd_2  ! called by lim_step
 
-   REAL(wp)  ::   epsi20 = 1.e-20   ,  &  ! constant values
-      &           epsi16 = 1.e-16   ,  &
-      &           epsi04 = 1.e-04   ,  &
-      &           zzero  = 0.e0     ,  &
-      &           zone   = 1.e0
+   REAL(wp) ::   epsi20 = 1.e-20   ! constant values
+   REAL(wp) ::   epsi16 = 1.e-16   !
+   REAL(wp) ::   epsi04 = 1.e-04   !
+   REAL(wp) ::   rzero  = 0.e0     !
+   REAL(wp) ::   rone   = 1.e0     !
 
    !! * Substitutions
@@ -47 +48 @@
 #  include "vectopt_loop_substitute.h90"
    !!-------- -------------------------------------------------------------
-   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005) 
+   !! NEMO/LIM 2.0,  UCL-LOCEAN-IPSL (2008) 
    !! $Id$
    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
@@ -74 +75 @@
       INTEGER, INTENT(in) ::   kt     ! number of iteration
       !!
-      INTEGER  ::   ji, jj,    &   ! dummy loop indices
-         nbpb  ,               &   ! nb of icy pts for thermo. cal.
-         nbpac                     ! nb of pts for lateral accretion 
+      INTEGER  ::   ji, jj               ! dummy loop indices
+      INTEGER  ::   nbpb                 ! nb of icy pts for thermo. cal.
+      INTEGER  ::   nbpac                ! nb of pts for lateral accretion 
       CHARACTER (len=22) :: charout
-      REAL(wp) ::  &
-         zfric_umin = 5e-03 ,  &   ! lower bound for the friction velocity
-         zfric_umax = 2e-02        ! upper bound for the friction velocity
-      REAL(wp) ::   &
-         zinda              ,  &   ! switch for test. the val. of concen.
-         zindb, zindg       ,  &   ! switches for test. the val of arg
-         za , zh, zthsnice  ,  &
-         zfric_u            ,  &   ! friction velocity 
-         zfnsol             ,  &   ! total non solar heat
-         zfontn             ,  &   ! heat flux from snow thickness
-         zfntlat, zpareff          ! test. the val. of lead heat budget
-      REAL(wp), DIMENSION(jpi,jpj) ::   zhicifp,   &  ! ice thickness for outputs
-         &                              zqlbsbq       ! link with lead energy budget qldif
+      REAL(wp) ::   zfric_umin = 5e-03   ! lower bound for the friction velocity
+      REAL(wp) ::   zfric_umax = 2e-02   ! upper bound for the friction velocity
+      REAL(wp) ::   zinda                ! switch for test. the val. of concen.
+      REAL(wp) ::   zindb, zindg         ! switches for test. the val of arg
+      REAL(wp) ::   za , zh, zthsnice    !
+      REAL(wp) ::   zfric_u              ! friction velocity 
+      REAL(wp) ::   zfnsol               ! total non solar heat
+      REAL(wp) ::   zfontn               ! heat flux from snow thickness
+      REAL(wp) ::   zfntlat, zpareff     ! test. the val. of lead heat budget
+      REAL(wp) ::   zfi                  ! temporary scalar
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zhicifp   ! ice thickness for outputs
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zqlbsbq   ! link with lead energy budget qldif
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmsk      ! working array
       !!-------------------------------------------------------------------
@@ -100 +100 @@
       !-------------------------------------------!
       
-!i est-ce utile?  oui au moins en partie
+!!gm needed?  yes at least for some of these arrays 
       rdvosif(:,:) = 0.e0   ! variation of ice volume at surface
       rdvobif(:,:) = 0.e0   ! variation of ice volume at bottom
@@ -114 +114 @@
       zmsk (:,:,:) = 0.e0
 
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            hsnif(ji,jj)  = hsnif(ji,jj) *  MAX( zzero, SIGN( zone , hsnif(ji,jj) - epsi04 ) )
-         END DO
-      END DO
-
-      IF(ln_ctl)   CALL prt_ctl(tab2d_1=hsnif     , clinfo1=' lim_thd: hsnif   : ')
+      ! set to zero snow thickness smaller than epsi04
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            hsnif(ji,jj)  = hsnif(ji,jj) *  MAX( rzero, SIGN( rone , hsnif(ji,jj) - epsi04 ) )
+         END DO
+      END DO
+!!gm better coded (do not use SIGN...)
+!     WHERE( hsnif(:,:) < epsi04 )   hsnif(:,:) = 0.e0
+!!gm
+
+      IF(ln_ctl)   CALL prt_ctl( tab2d_1=hsnif, clinfo1=' lim_thd: hsnif   : ' )
       
       !-----------------------------------!
@@ -129 +133 @@
          DO ji = 1, jpi
             !  snow is transformed into ice if the original ice cover disappears.
-            zindg         = tms(ji,jj) *  MAX( zzero , SIGN( zone , -hicif(ji,jj) ) )
+            zindg         = tms(ji,jj) *  MAX( rzero , SIGN( rone , -hicif(ji,jj) ) )
             hicif(ji,jj)  = hicif(ji,jj) + zindg * rhosn * hsnif(ji,jj) / rau0
-            hsnif(ji,jj)  = ( zone - zindg ) * hsnif(ji,jj) + zindg * hicif(ji,jj) * ( rau0 - rhoic ) / rhosn
+            hsnif(ji,jj)  = ( rone - zindg ) * hsnif(ji,jj) + zindg * hicif(ji,jj) * ( rau0 - rhoic ) / rhosn
             dmgwi(ji,jj)  = zindg * (1.0 - frld(ji,jj)) * rhoic * hicif(ji,jj)   ! snow/ice mass
             
             !  the lead fraction, frld, must be little than or equal to amax (ice ridging).
             zthsnice      = hsnif(ji,jj) + hicif(ji,jj)
-            zindb         = tms(ji,jj) * ( 1.0 - MAX( zzero , SIGN( zone , - zthsnice ) ) ) 
-            za            = zindb * MIN( zone, ( 1.0 - frld(ji,jj) ) * uscomi )
+            zindb         = tms(ji,jj) * ( 1.0 - MAX( rzero , SIGN( rone , - zthsnice ) ) ) 
+            za            = zindb * MIN( rone, ( 1.0 - frld(ji,jj) ) * uscomi )
             hsnif (ji,jj) = hsnif(ji,jj)  * za
             hicif (ji,jj) = hicif(ji,jj)  * za
             qstoif(ji,jj) = qstoif(ji,jj) * za
-            frld  (ji,jj) = 1.0 - zindb * ( 1.0 - frld(ji,jj) ) / MAX( za , epsi20 )
+            frld  (ji,jj) = 1.0 - zindb * ( 1.0 - frld(ji,jj) ) / MAX( za, epsi20 )
             
             !  the in situ ice thickness, hicif, must be equal to or greater than hiclim.
-            zh            = MAX( zone , zindb * hiclim  / MAX( hicif(ji,jj) , epsi20 ) )
+            zh            = MAX( rone , zindb * hiclim  / MAX( hicif(ji,jj), epsi20 ) )
             hsnif (ji,jj) = hsnif(ji,jj)  * zh
             hicif (ji,jj) = hicif(ji,jj)  * zh
@@ -153 +157 @@
 
       IF(ln_ctl) THEN
-         CALL prt_ctl(tab2d_1=hicif  , clinfo1=' lim_thd: hicif   : ')
-         CALL prt_ctl(tab2d_1=hsnif  , clinfo1=' lim_thd: hsnif   : ')
-         CALL prt_ctl(tab2d_1=dmgwi  , clinfo1=' lim_thd: dmgwi   : ')
-         CALL prt_ctl(tab2d_1=qstoif , clinfo1=' lim_thd: qstoif  : ')
-         CALL prt_ctl(tab2d_1=frld   , clinfo1=' lim_thd: frld    : ')
+         CALL prt_ctl( tab2d_1=hicif , clinfo1=' lim_thd: hicif   : ' )
+         CALL prt_ctl( tab2d_1=hsnif , clinfo1=' lim_thd: hsnif   : ' )
+         CALL prt_ctl( tab2d_1=dmgwi , clinfo1=' lim_thd: dmgwi   : ' )
+         CALL prt_ctl( tab2d_1=qstoif, clinfo1=' lim_thd: qstoif  : ' )
+         CALL prt_ctl( tab2d_1=frld  , clinfo1=' lim_thd: frld    : ' )
       ENDIF
 
@@ -175 +179 @@
          DO ji = 1, jpi
             zthsnice       = hsnif(ji,jj) + hicif(ji,jj)
-            zindb          = tms(ji,jj) * ( 1.0 - MAX( zzero , SIGN( zone , - zthsnice ) ) ) 
+            zindb          = tms(ji,jj) * ( 1.0 - MAX( rzero , SIGN( rone , - zthsnice ) ) ) 
             pfrld(ji,jj)   = frld(ji,jj)
-            zinda          = 1.0 - MAX( zzero , SIGN( zone , - ( 1.0 - pfrld(ji,jj) ) ) )
+            zinda          = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) )
             
             !  solar irradiance transmission at the mixed layer bottom and used in the lead heat budget
@@ -189 +193 @@
                         
             !  partial computation of the lead energy budget (qldif)
-            zfontn         = ( sprecip(ji,jj) / rhosn ) * xlsn  !   energy for melting
+#if defined key_coupled 
+            zfi = 1.0 - pfrld(ji,jj)
+            qldif(ji,jj)   = tms(ji,jj) * rdt_ice                                             &
+               &    * (   ( qsr_tot(ji,jj) - qsr_ice(ji,jj) * zfi ) * ( 1.0 - thcm(ji,jj) )   &
+               &        + ( qns_tot(ji,jj) - qns_ice(ji,jj) * zfi )                           &
+               &        + frld(ji,jj) * ( fdtcn(ji,jj) + ( 1.0 - zindb ) * fsbbq(ji,jj) )   )
+#else
+            zfontn         = ( sprecip(ji,jj) / rhosn ) * xlsn  !   energy for melting solid precipitation
             zfnsol         = qns(ji,jj)                         !  total non solar flux over the ocean
             qldif(ji,jj)   = tms(ji,jj) * ( qsr(ji,jj) * ( 1.0 - thcm(ji,jj) )   &
                &                               + zfnsol + fdtcn(ji,jj) - zfontn     &
                &                               + ( 1.0 - zindb ) * fsbbq(ji,jj) )   &
-               &                               * frld(ji,jj) * rdt_ice    
+               &                        * frld(ji,jj) * rdt_ice    
+!!$            qldif(ji,jj)   = tms(ji,jj) * rdt_ice * frld(ji,jj) 
+!!$               &           * ( qsr(ji,jj) * ( 1.0 - thcm(ji,jj) )      &
+!!$               &             + qns(ji,jj)  + fdtcn(ji,jj) - zfontn     &
+!!$               &             + ( 1.0 - zindb ) * fsbbq(ji,jj)      )   &
+#endif
             !  parlat : percentage of energy used for lateral ablation (0.0) 
-            zfntlat        = 1.0 - MAX( zzero , SIGN( zone ,  - qldif(ji,jj) ) )
+            zfntlat        = 1.0 - MAX( rzero , SIGN( rone ,  - qldif(ji,jj) ) )
             zpareff        = 1.0 + ( parlat - 1.0 ) * zinda * zfntlat
             zqlbsbq(ji,jj) = qldif(ji,jj) * ( 1.0 - zpareff ) / MAX( (1.0 - frld(ji,jj)) * rdt_ice , epsi16 )
@@ -243 +259 @@
       !------------------------------------------------------------------------------------ 
 
-      IF ( nbpb > 0) THEN
-         
+      IF( nbpb > 0 ) THEN
+         !    
          !  put the variable in a 1-D array for thermodynamics process
          CALL tab_2d_1d_2( nbpb, frld_1d    (1:nbpb)     , frld       , jpi, jpj, npb(1:nbpb) )
@@ -257 +273 @@
          CALL tab_2d_1d_2( nbpb, fr2_i0_1d  (1:nbpb)     , fr2_i0     , jpi, jpj, npb(1:nbpb) )
          CALL tab_2d_1d_2( nbpb, qns_ice_1d (1:nbpb)     , qns_ice    , jpi, jpj, npb(1:nbpb) )
-#if ! defined key_coupled
-         CALL tab_2d_1d_2( nbpb, qla_ice_1d (1:nbpb)     , qla_ice    , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d_2( nbpb, dqla_ice_1d(1:nbpb)     , dqla_ice   , jpi, jpj, npb(1:nbpb) )
-#endif
+         IF( .NOT. lk_cpl ) THEN 
+            CALL tab_2d_1d_2( nbpb, qla_ice_1d (1:nbpb)     , qla_ice    , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d_2( nbpb, dqla_ice_1d(1:nbpb)     , dqla_ice   , jpi, jpj, npb(1:nbpb) )
+         ENDIF
          CALL tab_2d_1d_2( nbpb, dqns_ice_1d(1:nbpb)     , dqns_ice   , jpi, jpj, npb(1:nbpb) )
          CALL tab_2d_1d_2( nbpb, tfu_1d     (1:nbpb)     , tfu        , jpi, jpj, npb(1:nbpb) )
@@ -271 +287 @@
          CALL tab_2d_1d_2( nbpb, dmgwi_1d   (1:nbpb)     , dmgwi      , jpi, jpj, npb(1:nbpb) )
          CALL tab_2d_1d_2( nbpb, qlbbq_1d   (1:nbpb)     , zqlbsbq    , jpi, jpj, npb(1:nbpb) )
- 
+         !
          CALL lim_thd_zdf_2( 1, nbpb )       !  compute ice growth
-         
+         !
          !  back to the geographic grid.
          CALL tab_1d_2d_2( nbpb, frld       , npb, frld_1d   (1:nbpb)     , jpi, jpj )
@@ -295 +311 @@
          CALL tab_1d_2d_2( nbpb, fdvolif    , npb, dvlbq_1d  (1:nbpb)     , jpi, jpj )
          CALL tab_1d_2d_2( nbpb, rdvonif    , npb, dvnbq_1d  (1:nbpb)     , jpi, jpj ) 
-
- 
-      ENDIF
-
-      
-      !      Up-date sea ice thickness.
-      !---------------------------------
+         !
+      ENDIF
+
+      
+      ! Up-date sea ice thickness
+      !--------------------------
       DO jj = 1, jpj
          DO ji = 1, jpi
             phicif(ji,jj) = hicif(ji,jj)  
-            hicif(ji,jj)  = hicif(ji,jj) *  ( zone -  MAX( zzero, SIGN( zone, - ( 1.0 - frld(ji,jj) ) ) ) )
-         END DO
-      END DO
-
-      
-      !      Tricky trick : add 2 to frld in the Southern Hemisphere.
-      !----------------------------------------------------------
+            hicif(ji,jj)  = hicif(ji,jj) *  ( rone -  MAX( rzero, SIGN( rone, - ( 1.0 - frld(ji,jj) ) ) ) )
+         END DO
+      END DO
+
+      
+      ! Tricky trick : add 2 to frld in the Southern Hemisphere
+      !--------------------------------------------------------
       IF( fcor(1,1) < 0.e0 ) THEN
          DO jj = 1, njeqm1
@@ -321 +336 @@
       
       
-      !     Select points for lateral accretion (this occurs when heat exchange
-      !     between ice and ocean is negative; ocean losing heat) 
+      ! Select points for lateral accretion (this occurs when heat exchange
+      ! between ice and ocean is negative; ocean losing heat) 
       !-----------------------------------------------------------------
       nbpac = 0
@@ -341 +356 @@
       ENDIF
 
-      
-      !
-      !     If ocean gains heat do nothing ; otherwise, one performs lateral accretion
+
+      ! If ocean gains heat do nothing ; otherwise, one performs lateral accretion
       !--------------------------------------------------------------------------------
-
       IF( nbpac > 0 ) THEN
-         
+         !
          !...Put the variable in a 1-D array for lateral accretion
          CALL tab_2d_1d_2( nbpac, frld_1d   (1:nbpac)     , frld       , jpi, jpj, npac(1:nbpac) )
@@ -361 +374 @@
          CALL tab_2d_1d_2( nbpac, dvlbq_1d  (1:nbpac)     , fdvolif    , jpi, jpj, npac(1:nbpac) )
          CALL tab_2d_1d_2( nbpac, tfu_1d    (1:nbpac)     , tfu        , jpi, jpj, npac(1:nbpac) )
-        
-         !  call lateral accretion routine.
-         CALL lim_thd_lac_2( 1 , nbpac )
-         
+         !
+         CALL lim_thd_lac_2( 1 , nbpac )         ! lateral accretion routine.
+         !
          !   back to the geographic grid
          CALL tab_1d_2d_2( nbpac, frld       , npac(1:nbpac), frld_1d   (1:nbpac)     , jpi, jpj )
@@ -375 +387 @@
          CALL tab_1d_2d_2( nbpac, rdmicif    , npac(1:nbpac), rdmicif_1d(1:nbpac)     , jpi, jpj )
          CALL tab_1d_2d_2( nbpac, fdvolif    , npac(1:nbpac), dvlbq_1d  (1:nbpac)     , jpi, jpj )
-        
+         !
       ENDIF
        
        
-      !      Recover frld values between 0 and 1 in the Southern Hemisphere (tricky trick)
-      !      Update daily thermodynamic ice production.    
+      ! Recover frld values between 0 and 1 in the Southern Hemisphere (tricky trick)
+      ! Update daily thermodynamic ice production.    
       !------------------------------------------------------------------------------
-       
       DO jj = 1, jpj
          DO ji = 1, jpi
@@ -392 +403 @@
       IF(ln_ctl) THEN
          CALL prt_ctl_info(' lim_thd  end  ')
-         CALL prt_ctl(tab2d_1=hicif , clinfo1=' lim_thd: hicif   : ', tab2d_2=hsnif , clinfo2=' hsnif  : ')
-         CALL prt_ctl(tab2d_1=frld  , clinfo1=' lim_thd: frld    : ', tab2d_2=hicifp, clinfo2=' hicifp : ')
-         CALL prt_ctl(tab2d_1=phicif, clinfo1=' lim_thd: phicif  : ', tab2d_2=pfrld , clinfo2=' pfrld  : ')
-         CALL prt_ctl(tab2d_1=sist  , clinfo1=' lim_thd: sist    : ')
-         CALL prt_ctl(tab2d_1=tbif(:,:,1), clinfo1=' lim_thd: tbif 1  : ')
-         CALL prt_ctl(tab2d_1=tbif(:,:,2), clinfo1=' lim_thd: tbif 2  : ')
-         CALL prt_ctl(tab2d_1=tbif(:,:,3), clinfo1=' lim_thd: tbif 3  : ')
-         CALL prt_ctl(tab2d_1=fdtcn , clinfo1=' lim_thd: fdtcn   : ', tab2d_2=qdtcn , clinfo2=' qdtcn  : ')
-         CALL prt_ctl(tab2d_1=qstoif, clinfo1=' lim_thd: qstoif  : ', tab2d_2=fsbbq , clinfo2=' fsbbq  : ')
+         CALL prt_ctl( tab2d_1=hicif      , clinfo1=' lim_thd: hicif   : ', tab2d_2=hsnif , clinfo2=' hsnif  : ' )
+         CALL prt_ctl( tab2d_1=frld       , clinfo1=' lim_thd: frld    : ', tab2d_2=hicifp, clinfo2=' hicifp : ' )
+         CALL prt_ctl( tab2d_1=phicif     , clinfo1=' lim_thd: phicif  : ', tab2d_2=pfrld , clinfo2=' pfrld  : ' )
+         CALL prt_ctl( tab2d_1=sist       , clinfo1=' lim_thd: sist    : ' )
+         CALL prt_ctl( tab2d_1=tbif(:,:,1), clinfo1=' lim_thd: tbif 1  : ' )
+         CALL prt_ctl( tab2d_1=tbif(:,:,2), clinfo1=' lim_thd: tbif 2  : ' )
+         CALL prt_ctl( tab2d_1=tbif(:,:,3), clinfo1=' lim_thd: tbif 3  : ' )
+         CALL prt_ctl( tab2d_1=fdtcn      , clinfo1=' lim_thd: fdtcn   : ', tab2d_2=qdtcn , clinfo2=' qdtcn  : ' )
+         CALL prt_ctl( tab2d_1=qstoif     , clinfo1=' lim_thd: qstoif  : ', tab2d_2=fsbbq , clinfo2=' fsbbq  : ' )
       ENDIF
        !
@@ -422 +433 @@
          &                hakdif, hnzst  , thth  , parsub, alphs
       !!-------------------------------------------------------------------
-      
-
-      ! Define the initial parameters
-      ! -------------------------
-      REWIND( numnam_ice )
+      !
+      REWIND( numnam_ice )                  ! read namelist
       READ  ( numnam_ice , namicethd )
-      IF(lwp) THEN
+      IF( lk_cpl .AND. parsub /= 0.0 )   CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' )
+      !
+      IF(lwp) THEN                          ! control print
          WRITE(numout,*)
          WRITE(numout,*)'lim_thd_init_2: ice parameters for ice thermodynamic computation '
@@ -437 +447 @@
          WRITE(numout,*)'       minimum ice thickness                                   hiclim       = ', hiclim 
          WRITE(numout,*)'       maximum lead fraction                                   amax         = ', amax 
-         WRITE(numout,*)'       energy stored in brine pocket (=1) or not (=0)     swiqst       = ', swiqst 
+         WRITE(numout,*)'       energy stored in brine pocket (=1) or not (=0)          swiqst       = ', swiqst 
          WRITE(numout,*)'       numerical carac. of the scheme for diffusion in ice '
          WRITE(numout,*)'       Cranck-Nicholson (=0.5), implicit (=1), explicit (=0)   sbeta        = ', sbeta
@@ -450 +460 @@
          WRITE(numout,*)'       coefficient for snow density when snow ice formation    alphs        = ', alphs
       ENDIF
-            
+      !          
       uscomi = 1.0 / ( 1.0 - amax )   ! inverse of minimum lead fraction
       rcdsn = hakdif * rcdsn 
       rcdic = hakdif * rcdic
-      
-      IF ( ( hsndif > 100.e0 ) .OR. ( hicdif > 100.e0 ) ) THEN
+      !
+      IF( hsndif > 100.e0 .OR. hicdif > 100.e0 ) THEN
          cnscg = 0.e0
       ELSE
          cnscg = rcpsn / rcpic   ! ratio  rcpsn/rcpic
       ENDIF
- 
+      !
    END SUBROUTINE lim_thd_init_2
 

trunk/NEMO/LIM_SRC_2/limthd_zdf_2.F90

@@ -22 +22 @@
    USE limistate_2
    USE in_out_manager
+   USE cpl_oasis3, ONLY : lk_cpl
       
    IMPLICIT NONE
@@ -213 +214 @@
           zghe     = ( 1.0 - zihe ) * zheshth * ( 2.0 - zheshth )   &
              &     +         zihe   * 0.5 * ( 1.5 + LOG( 2.0 * zheshth ) )
-#if defined key_lim_cp3
-          zghe = 1.0
-#endif 
 
           !---effective conductivities 
@@ -297 +295 @@
        DO ji = kideb, kiut
           !---computation of the derivative of energy balance function 
-#if defined key_coupled
-#   if defined key_lim_cp2
-          zdfts   =   zksndh(ji)   & ! contribution of the conductive heat flux
-             &      + zrcpdt(ji)   & ! contribution of hsu * rcp / dt
-             &      - dqns_ice_1d(ji)      ! contribution of the total non solar radiation 
-#   else
-          zdfts   =   zksndh(ji)   & ! contribution of the conductive heat flux
-             &      + zrcpdt(ji)    ! contribution of hsu * rcp / dt
-#   endif
-
-#else
           zdfts    =  zksndh(ji)   & ! contribution of the conductive heat flux
              &      + zrcpdt(ji)   & ! contribution of hsu * rcp / dt
              &      - dqns_ice_1d (ji)     ! contribution of the total non solar radiation 
-#endif
           !---computation of the energy balance function 
           zfts    = - z1mi0 (ji) * qsr_ice_1d(ji)   & ! net absorbed solar radiation
@@ -318 +304 @@
           !---computation of surface temperature increment  
           zdts    = -zfts / zdfts
-#if defined key_lim_cp3
-          zdts = zdts / 3.0
-#endif
           !---computation of the new surface temperature 
           sist_1d(ji) = sist_1d(ji) + zdts
-
        END DO
 
@@ -338 +320 @@
        !----------------------------------------------------------------------  
                      
-       DO ji = kideb, kiut
-          sist_1d(ji) = MIN( ztsmlt(ji) , sist_1d(ji) )
-#if ! defined key_coupled
-          qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( sist_1d(ji) - zts_old(ji) )
-          qla_ice_1d (ji) = qla_ice_1d (ji) + dqla_ice_1d(ji) * ( sist_1d(ji) - zts_old(ji) )
-#endif
-          zfcsu(ji)  = zksndh(ji) * ( ztbif(ji) - sist_1d(ji) )
-       END DO
+       IF ( .NOT. lk_cpl ) THEN   ! duplicate the loop for performances issues
+          DO ji = kideb, kiut
+             sist_1d(ji) = MIN( ztsmlt(ji) , sist_1d(ji) )
+             qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( sist_1d(ji) - zts_old(ji) )
+             qla_ice_1d(ji) = qla_ice_1d(ji) + dqla_ice_1d(ji) * ( sist_1d(ji) - zts_old(ji) )
+             zfcsu(ji)  = zksndh(ji) * ( ztbif(ji) - sist_1d(ji) )
+          END DO
+       ELSE
+          DO ji = kideb, kiut
+             sist_1d(ji) = MIN( ztsmlt(ji) , sist_1d(ji) )
+             zfcsu(ji)  = zksndh(ji) * ( ztbif(ji) - sist_1d(ji) )
+          END DO
+       ENDIF
 
        !     5.2. Calculate available heat for surface ablation. 
@@ -517 +504 @@
 
           qstbif_1d(ji) =         ziqf   * ( qstbif_1d(ji) - zqsn_mlt_rem )   &
-             &        + ( 1.0 - ziqf ) * ( qstbif_1d(ji) - qstbif_1d(ji)  )
+             &          + ( 1.0 - ziqf ) * ( qstbif_1d(ji) - qstbif_1d(ji)  )
 
           !--    The contribution of the energy stored in brine pockets qstbif_1d to melt
@@ -529 +516 @@
 
           qstbif_1d(ji) =         zihq   * qstbif_1d(ji)   &
-             &        + ( 1.0 - zihq ) * zqstbif_old
+             &          + ( 1.0 - zihq ) * zqstbif_old
 
           !--change in ice thickness due to melt at the top surface

trunk/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

@@ -21 +21 @@
    !!   cpl_prism_init     : initialization of coupled mode communication
    !!   cpl_prism_define   : definition of grid and fields
-   !!   cpl_prism_send     : send out fields in coupled mode
-   !!   cpl_prism_recv     : receive fields in coupled mode
+   !!   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
    !!----------------------------------------------------------------------
-   !! * Modules used
-!##################### WARNING coupled mode ###############################
-!##################### WARNING coupled mode ###############################
-!   Following lines must be enabled if coupling with OASIS
+   USE mod_prism_proto              ! OASIS3 prism module
+   USE mod_prism_def_partition_proto! OASIS3 prism module for partitioning
+   USE mod_prism_grids_writing      ! OASIS3 prism module for writing grid files
+   USE mod_prism_put_proto          ! OASIS3 prism module for snding
+   USE mod_prism_get_proto          ! OASIS3 prism module for receiving
+   USE mod_prism_grids_writing      ! OASIS3 prism module for writing grids
+   USE par_oce                      ! ocean parameters
+   USE dom_oce                      ! ocean space and time domain
+   USE in_out_manager               ! I/O manager
+   USE lib_mpp
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   IMPLICIT NONE
+   PRIVATE
 !
-!   USE mod_prism_proto              ! OASIS3 prism module
-!   USE mod_prism_def_partition_proto! OASIS3 prism module for partitioning
-!   USE mod_prism_grids_writing      ! OASIS3 prism module for writing grid files
-!   USE mod_prism_put_proto          ! OASIS3 prism module for sending
-!   USE mod_prism_get_proto          ! OASIS3 prism module for receiving
-!   USE mod_prism_grids_writing      ! OASIS3 prism module for writing grids
-!##################### WARNING coupled mode ###############################
-!##################### WARNING coupled mode ###############################
-#if defined key_mpp_mpi
-   USE lib_mpp, only : mppsize, mpprank ! message passing
-   USE lib_mpp, only : mppsend          ! message passing
-   USE lib_mpp, only : mpprecv          ! message passing
-#endif
-   USE daymod                       ! date and time info
-   USE dom_oce                      ! ocean space and time domain
-   USE sbc_ice                      ! surface boundary condition: ice
-   USE in_out_manager               ! I/O manager
-   USE par_oce                      !
-   USE phycst, only : rt0           ! freezing point of sea water
-
-   USE oce, only: tn, un, vn
-#if defined key_lim2
-   USE ice_2, only: frld, hicif, hsnif
-#endif
-
-   IMPLICIT NONE
-!
-! Exchange parameters for coupling ORCA-LIM with ECHAM5
-!
-#if defined key_cpl_ocevel
-   INTEGER, PARAMETER         :: nsend =  6
-#else
-   INTEGER, PARAMETER         :: nsend =  4
-#endif
-
-#if defined key_cpl_discharge
-   INTEGER, PARAMETER         :: nrecv = 20
-#else
-   INTEGER, PARAMETER         :: nrecv = 17
-#endif
-
-   INTEGER, DIMENSION(nsend)  :: send_id
-   INTEGER, DIMENSION(nrecv)  :: recv_id
-
-   CHARACTER(len=32)          :: cpl_send (nsend)
-   CHARACTER(len=32)          :: cpl_recv (nrecv)
-
-   PRIVATE
-
-   INTEGER                    :: localRank      ! local MPI rank
-   INTEGER                    :: comp_id        ! id returned by prism_init_comp
-
-   INTEGER                    :: range(5)
-
-   INTEGER, PARAMETER         :: localRoot  = 0
-   INTEGER                    :: localSize      ! local MPI size
-   INTEGER                    :: localComm      ! local MPI size
-   LOGICAL                    :: commRank       ! true for ranks doing OASIS communication
-
-   LOGICAL, SAVE              :: prism_was_initialized
-   LOGICAL, SAVE              :: prism_was_terminated
-   INTEGER, SAVE              :: write_grid
-
-   INTEGER                    :: ierror         ! return error code
+   INTEGER, PUBLIC            :: nlocalComm
+   LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .TRUE.   ! coupled flag
+   INTEGER                    :: ncomp_id          ! id returned by prism_init_comp
+   INTEGER                    :: nerror            ! return error code
+
+   INTEGER, PUBLIC :: nrcv, nsnd    ! Number of received and sent coupling fields
+
+   INTEGER, PARAMETER :: nmaxfld=40    ! Maximum number of coupling fields
+   
+   TYPE, PUBLIC ::   FLD_CPL            ! Type for coupling field information
+      LOGICAL            ::   laction   ! To be coupled or not
+      CHARACTER(len = 8) ::   clname    ! Name of the coupling field   
+      CHARACTER(len = 1) ::   clgrid    ! Grid type  
+      REAL(wp)           ::   nsgn      ! Control of the sign change
+      INTEGER            ::   nid       ! Id of the field
+   END TYPE FLD_CPL
+
+   TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC :: srcv, ssnd   ! Coupling fields
 
    REAL(wp), DIMENSION(:,:), ALLOCATABLE :: exfld  ! Temporary buffer for receiving
-
-#ifdef key_cpl_rootexchg
-   LOGICAL                               :: rootexchg =.true.     ! logical switch 
-#else
-   LOGICAL                               :: rootexchg =.false.    ! logical switch
-#endif
-
-   REAL(wp), DIMENSION(:),   ALLOCATABLE :: buffer ! Temporary buffer for exchange
-   INTEGER, DIMENSION(:,:),  ALLOCATABLE :: ranges ! Temporary buffer for exchange
 
    !! Routine accessibility
    PUBLIC cpl_prism_init
    PUBLIC cpl_prism_define
-   PUBLIC cpl_prism_send
-   PUBLIC cpl_prism_recv
+   PUBLIC cpl_prism_snd
+   PUBLIC cpl_prism_rcv
    PUBLIC cpl_prism_finalize
 
-   PUBLIC send_id, recv_id
-
    !!----------------------------------------------------------------------
    !!   OPA 9.0 , LOCEAN-IPSL (2006) 
-   !! $Id$
+   !! $Header$ 
    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -123 +75 @@
 CONTAINS
 
-   SUBROUTINE cpl_prism_init( localCommunicator )
-
-      IMPLICIT NONE
+   SUBROUTINE cpl_prism_init
 
       !!-------------------------------------------------------------------
@@ -135 +85 @@
       !! ** Method  :   OASIS3 MPI communication 
       !!--------------------------------------------------------------------
-      !! * Arguments
-      !!
-      INTEGER, INTENT(OUT)       :: localCommunicator
-      !!
-      !! * Local declarations
-      !!
-      CHARACTER(len=4)           :: comp_name      ! name of this PRISM component
-      !!
-      !!--------------------------------------------------------------------
-      !!
-      IF(lwp) WRITE(numout,*)
+      !!
+
       IF(lwp) WRITE(numout,*) 'cpl_prism_init : initialization in coupled ocean/atmosphere case'
       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~'
       IF(lwp) WRITE(numout,*)
-     
-#if defined key_flx_bulk_monthly || defined key_flx_bulk_daily || defined key_flx_forced_daily
-      IF(lwp)WRITE(numout,cform_err)
-      IF(lwp)WRITE(numout,*) ' key_coupled and key_flx_bulk_* key_flx_forced_daily are incompatible'
-      nstop = nstop + 1
-#endif
-
-      comp_name = 'opa9'
-
       !------------------------------------------------------------------
       ! 1st Initialize the PRISM system for the application
       !------------------------------------------------------------------
-
-      CALL prism_init_comp_proto ( comp_id, comp_name, ierror )
-      IF ( ierror /= PRISM_Ok ) &
-         CALL prism_abort_proto (comp_id, 'cpl_prism_init', 'Failure in prism_init_comp_proto')
-      prism_was_initialized = .true.
+      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')
 
       !------------------------------------------------------------------
@@ -171 +101 @@
       !------------------------------------------------------------------
 
-      CALL prism_get_localcomm_proto ( localComm, ierror )
-      IF ( ierror /= PRISM_Ok ) &
-         CALL prism_abort_proto (comp_id, 'cpl_prism_init','Failure in prism_get_localcomm_proto' )
-
-      localCommunicator = localComm
+      CALL prism_get_localcomm_proto ( nlocalComm, 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
@@ -181 +109 @@
 
    SUBROUTINE cpl_prism_define ()
-
-      IMPLICIT NONE
 
       !!-------------------------------------------------------------------
@@ -196 +122 @@
       !! * Local declarations
       !!
-      INTEGER                    :: grid_id(2)     ! id returned by prism_def_grid
-      INTEGER                    :: part_id
-
+      INTEGER                    :: id_part
       INTEGER                    :: paral(5)       ! OASIS3 box partition
-
-      INTEGER                    :: shape(2,3)     ! shape of arrays passed to PSMILe
-      INTEGER                    :: nodim(2)
-      INTEGER                    :: data_type      ! data type of transients
-
-      INTEGER                    :: ji, jj         ! local loop indicees
-      INTEGER                    :: nx, ny, nc     ! local variables
-      INTEGER                    :: im1, ip1
-      INTEGER                    :: jm1, jp1
-      INTEGER                    :: i_grid         ! loop index
-      INTEGER                    :: info
-      INTEGER                    :: maxlen
-      INTEGER                    :: mask(jpi,jpj)
-      REAL(kind=wp)              :: area(jpi,jpj)
-
-      CHARACTER(len=4)           :: point_name     ! name of the grid points
-
-      REAL(kind=wp)              :: rclam(jpi,jpj,4)
-      REAL(kind=wp)              :: rcphi(jpi,jpj,4)
-
-      REAL(kind=wp)              :: glam_b(jpi,jpj) ! buffer for orca2 grid correction
-      REAL(kind=wp)              :: gphi_b(jpi,jpj) ! buffer for orca2 grid correction
-      !!
-      !!--------------------------------------------------------------------
-     
+      INTEGER                    :: ishape(2,2)    ! shape of arrays passed to PSMILe
+      INTEGER                    :: ji             ! local loop indicees
+      !!
+      !!--------------------------------------------------------------------
+
       IF(lwp) WRITE(numout,*)
       IF(lwp) WRITE(numout,*) 'cpl_prism_define : initialization in coupled ocean/atmosphere case'
       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~'
       IF(lwp) WRITE(numout,*)
-     
-#if defined key_flx_bulk_monthly || defined key_flx_bulk_daily || defined key_flx_forced_daily
-      IF(lwp)WRITE(numout,cform_err)
-      IF(lwp)WRITE(numout,*) ' key_coupled and key_flx_bulk_... are incompatible'
-      nstop = nstop + 1
-#endif
-
-      ! -----------------------------------------------------------------
-      ! ... Some initialisation
-      ! -----------------------------------------------------------------
-
-      send_id = 0
-      recv_id = 0
-
-#if defined key_mpp_mpi
-
-      ! -----------------------------------------------------------------
-      ! ... Some MPI stuff relevant for optional exchange via root only
-      ! -----------------------------------------------------------------
-
-      commRank = .false.
-
-      localRank = mpprank ! from lib_mpp
-      localSize = mppsize ! from lib_mpp
-
-      IF ( rootexchg ) THEN
-         IF ( localRank == localRoot ) commRank = .true.
-      ELSE
-         commRank = .true.
+
+      !
+      ! ... Define the shape for the area that excludes the halo
+      !     For serial configuration (key_mpp_mpi not being active)
+      !     nl* is set to the global values 1 and jp*glo.
+      !
+      ishape(:,1) = (/ 1, nlei-nldi+1 /)
+      ishape(:,2) = (/ 1, nlej-nldj+1 /)
+      !
+      ! ... Allocate memory for data exchange
+      !
+      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
       ENDIF
-
-      IF ( rootexchg .and. localRank == localRoot ) THEN
-         ALLOCATE(ranges(5,0:localSize-1), stat = ierror)
-         IF (ierror > 0) THEN
-            CALL prism_abort_proto ( comp_id, 'cpl_prism_define', 'Failure in allocating Integer')
-            RETURN
-         ENDIF
-      ENDIF
-
-#else
-      !
-      ! For non-parallel configurations the one and only process ("localRoot")
-      ! takes part in the communication
-      ! 
-      localRank = localRoot
-      commRank = .true.
-
-#endif
-
-      ! -----------------------------------------------------------------
-      ! ... If necessary the root process writes the global grid info
-      ! -----------------------------------------------------------------
-
-      IF ( localRank == localRoot ) THEN
-
-         WRITE(numout,*)'Opening file SSTOCEAN, unit= 199'
-
-         OPEN (199,STATUS='NEW',FILE="sstocean",FORM='UNFORMATTED',err=310)
-
-         ! In case the sstocean of OASIS3 from a previous run exists
-         ! the programs jumps to the end of the if-block
-!    
-!*    2.0    Write exchange fields to OASIS data file.
-!            -----------------------------------------
-
-         WHERE (tmask(:,:,1) > 0.5 )
-            mask(:,:) = 0
-         ELSE WHERE
-            mask(:,:) = 1
-         END WHERE
-
-! Initialise ice mask at the very first start only
-         frld = 1.
-
-         WRITE(199) 'SSTOCEAN'
-         WRITE(199) (tn(:,:,1)*mask(:,:))+rt0
-
-         WRITE(199) 'SICOCEAN'
-         WRITE(199) (1.-frld(:,:))*mask(:,:)
-
-#if defined key_cpl_albedo
-# if defined key_lim3
-         Must be adapted for LIM3
-# endif
-         tn_ice  = 271.285
-    alb_ice =   0.75
-
-         WRITE(199) 'STIOCEAN'
-         WRITE(199) tn_ice(:,:)
-
-         WRITE(199) 'SAIOCEAN'
-         WRITE(199) alb_ice(:,:)
-#else
-         hicit = 0.
-         hsnit = 0.
-         WRITE(199) 'SITOCEAN'
-         WRITE(199) hicif(:,:)*mask(:,:)
-
-         WRITE(199) 'SNTOCEAN'
-         WRITE(199) hsnif(:,:)*mask(:,:)
-#endif
-
-#if defined key_cpl_ocevel
-         un(:,:,1) = 0.
-         vn(:,:,1) = 0.
-
-         WHERE (umask(:,:,1) > 0.5 )
-            mask(:,:) = 0
-         ELSE WHERE
-            mask(:,:) = 1
-         END WHERE
-
-         WRITE(199) 'SUNOCEAN'
-         WRITE(199) un(:,:,1)*mask(:,:)
-
-         WHERE (vmask(:,:,1) > 0.5 )
-            mask(:,:) = 0
-         ELSE WHERE
-            mask(:,:) = 1
-         END WHERE
-
-         WRITE(199) 'SVNOCEAN'
-         WRITE(199) vn(:,:,1)*mask(:,:)
-#endif
-
-         WRITE(numout,*)
-         WRITE(numout,*)' sstocean written'
-         WRITE(numout,*)' ***************'
-
-         CLOSE(199)
-
- 310     CONTINUE
-
-         CALL prism_start_grids_writing ( write_grid )
-
-      ENDIF  ! localRank == localRoot
-
-      IF ( localRank == localRoot .and. write_grid == 1 ) THEN
-
-         !------------------------------------------------------------------
-         ! 1st write global grid information (ORCA tripolar) characteristics
-         !     for surface coupling into a OASIS3 specific grid file. For
-         !     surface coupling it is sufficient to specify only one vertical
-         !     z-level.
-         !------------------------------------------------------------------
-         !
-         ! ... Treat corners in the horizontal plane
-         !
-         nx = jpi
-         ny = jpj
-         nc = 4
-
-         DO i_grid = 1, 3
-
-            IF ( i_grid == 1 ) THEN
-
-               ! --------------------------------------------------------
-               ! ... Write the grid info for T points
-               ! --------------------------------------------------------
-
-               point_name = 'opat'
-
-               glam_b = glamt
-               gphi_b = gphit
-
-               DO ji = 1, jpi
-                  DO jj = 1, jpj
-
-                     im1 = ji-1
-                     jm1 = jj-1
-                     IF (ji == 1) im1 = jpi-2
-                     IF (jj == 1) jm1 = jj
-
-                     rclam(ji,jj,1) = glamf(ji,jj)
-                     rclam(ji,jj,2) = glamf(im1,jj)
-                     rclam(ji,jj,3) = glamf(im1,jm1)
-                     rclam(ji,jj,4) = glamf(ji,jm1)
-
-                     rcphi(ji,jj,1) = gphif(ji,jj)
-                     rcphi(ji,jj,2) = gphif(im1,jj)
-                     rcphi(ji,jj,3) = gphif(im1,jm1)
-                     rcphi(ji,jj,4) = gphif(ji,jm1)
-
-                  END DO
-               END DO
-
-               ! Correction of one (land) grid cell of the orca2 grid.
-               ! It was causing problems with the SCRIP interpolation.
-
-               IF (jpiglo == 182 .AND. jpjglo == 149) THEN
-                  rclam(145,106,2) = -1.0
-                  rcphi(145,106,2) = 41.0
-               ENDIF
-
-               WHERE (tmask(:,:,1) > 0.5 )
-                  mask(:,:) = 0
-               ELSE WHERE
-                  mask(:,:) = 1
-               END WHERE
-
-               area = e1t * e2t
-
-            ELSE IF ( i_grid == 2 ) THEN
-
-               ! --------------------------------------------------------
-               ! ... Write the grid info for u points
-               ! --------------------------------------------------------
-
-               point_name = 'opau'
-
-               glam_b = glamu
-               gphi_b = gphiu
-
-               DO ji = 1, jpi
-                  DO jj = 1, jpj
-
-                     ip1 = ji+1
-                     jm1 = jj-1
-
-                     IF (ji == jpiglo) ip1 = 3
-                     IF (jj == 1) jm1 = jj
-
-                     rclam(ji,jj,1) = glamv(ip1,jj)
-                     rclam(ji,jj,2) = glamv(ji,jj)
-                     rclam(ji,jj,3) = glamv(ji,jm1)
-                     rclam(ji,jj,4) = glamv(ip1,jm1)
-
-                     rcphi(ji,jj,1) = gphiv(ip1,jj)
-                     rcphi(ji,jj,2) = gphiv(ji,jj)
-                     rcphi(ji,jj,3) = gphiv(ji,jm1)
-                     rcphi(ji,jj,4) = gphiv(ip1,jm1)
-
-                  END DO
-               END DO
-
-               ! Correction of three (land) grid cell of the orca2 grid.
-               ! It was causing problems with the SCRIP interpolation.
-
-               IF (jpiglo == 182 .AND. jpjglo == 149) THEN
-                  glam_b(144,106)   = -1.0
-                  gphi_b(144,106)   = 40.5
-                  rclam (144,106,2) = -1.5  
-                  rcphi (144,106,2) = 41.0
-
-                  glam_b(144,107)   = -1.0
-                  gphi_b(144,107)   = 41.5
-                  rclam (144,107,2) = -1.5  
-                  rcphi (144,107,2) = 42.0
-                  rclam (144,107,3) = -1.5  
-                  rcphi (144,107,3) = 41.0
-
-                  glam_b(144,108)   = -1.0
-                  gphi_b(144,108)   = 42.5
-                  rclam (144,108,2) = -1.5  
-                  rcphi (144,108,2) = 43.0
-                  rclam (144,108,3) = -1.5  
-                  rcphi (144,108,3) = 42.0
-               ENDIF
-
-               WHERE (umask(:,:,1) > 0.5 )
-                  mask(:,:) = 0
-               ELSE WHERE
-                  mask(:,:) = 1
-               END WHERE
-
-               area = e1u * e2u
-
-            ELSE IF ( i_grid == 3 ) THEN
-
-               ! --------------------------------------------------------
-               ! ... Write the grid info for v points
-               ! --------------------------------------------------------
-
-               point_name = 'opav'
-
-               glam_b = glamv
-               gphi_b = gphiv
-
-               DO ji = 1, jpi
-                  DO jj = 1, jpj
-
-                     im1 = ji-1
-                     jp1 = jj+1
-                     IF (ji == 1) im1 = jpiglo-2
-                     IF (jj == jpjglo) jp1 = jj
-
-                     rclam(ji,jj,1) = glamu(ji,jp1)
-                     rclam(ji,jj,2) = glamu(im1,jp1)
-                     rclam(ji,jj,3) = glamu(im1,jj)
-                     rclam(ji,jj,4) = glamu(ji,jj)
-
-                     rcphi(ji,jj,1) = gphiu(ji,jp1)
-                     rcphi(ji,jj,2) = gphiu(im1,jp1)
-                     rcphi(ji,jj,3) = gphiu(im1,jj)
-                     rcphi(ji,jj,4) = gphiu(ji,jj)
-
-                  END DO
-               END DO
-
-               ! Correction of one (land) grid cell of the orca2 grid.
-               ! It was causing problems with the SCRIP interpolation.
-
-               IF (jpiglo == 182 .AND. jpjglo == 149) THEN
-                  rclam(145,105,2) = -1.0  
-                  rcphi(145,105,2) = 40.5
-               ENDIF
-
-               WHERE (vmask(:,:,1) > 0.5 )
-                  mask(:,:) = 0
-               ELSE WHERE
-                  mask(:,:) = 1
-               END WHERE
-
-               area = e1v * e2v
-
-            ENDIF ! i_grid
-
-            WHERE (glam_b(:,:) < 0.)
-               glam_b(:,:) = glam_b(:,:) + 360.
-            END WHERE
-            WHERE (glam_b(:,:) > 360.)
-               glam_b(:,:) = glam_b(:,:) - 360.
-            END WHERE
-
-            WHERE (rclam(:,:,:) < 0.)
-               rclam(:,:,:) = rclam(:,:,:) + 360.
-            END WHERE
-            WHERE (rclam(:,:,:) > 360.)
-               rclam(:,:,:) = rclam(:,:,:) - 360.
-            END WHERE
-
-            mask(:,jpjglo)=1
-
-            CALL prism_write_grid   ( point_name, nx, ny, glam_b, gphi_b ) 
-            CALL prism_write_corner ( point_name, nx, ny, nc, rclam, rcphi )
-            CALL prism_write_mask   ( point_name, nx, ny, mask )
-            CALL prism_write_area   ( point_name, nx, ny, area )
-
-         END DO ! i_grid
-
-         CALL prism_terminate_grids_writing ()
-
-      ENDIF ! localRank == localRoot .and. write_grid == 1
-
+      !
       ! -----------------------------------------------------------------
       ! ... Define the partition 
       ! -----------------------------------------------------------------
-
-      IF ( rootexchg ) THEN
-
-         paral(1) = 2              ! box partitioning
-         paral(2) = 0              ! NEMO lower left corner global offset    
-         paral(3) = jpiglo         ! local extent in i 
-         paral(4) = jpjglo         ! local extent in j
-         paral(5) = jpiglo         ! global extent in x
-
-         range(1) = nimpp-1+nldi   ! global start in i
-         range(2) = nlei-nldi+1    ! local size in i of valid region
-         range(3) = njmpp-1+nldj   ! global start in j
-         range(4) = nlej-nldj+1    ! local size in j of valid region
-         range(5) = range(2) &
-                  * range(4)       ! local horizontal size
-
-         IF(ln_ctl) THEN
-         write(numout,*) ' rootexchg: range(1:5)', range
+      
+      paral(1) = 2                                              ! box partitioning
+      paral(2) = jpiglo * (nldj-1+njmpp-1) + (nldi-1+nimpp-1)   ! NEMO lower left corner global offset    
+      paral(3) = nlei-nldi+1                                    ! local extent in i 
+      paral(4) = nlej-nldj+1                                    ! local extent in j
+      paral(5) = jpiglo                                         ! global extent in x
+      
+      IF( ln_ctl ) THEN
+         WRITE(numout,*) ' multiexchg: paral (1:5)', paral
+         WRITE(numout,*) ' multiexchg: jpi, jpj =', jpi, jpj
+         WRITE(numout,*) ' multiexchg: nldi, nlei, nimpp =', nldi, nlei, nimpp
+         WRITE(numout,*) ' multiexchg: nldj, nlej, njmpp =', nldj, nlej, njmpp
+      ENDIF
+      
+      CALL prism_def_partition_proto ( id_part, paral, nerror )
+      !
+      ! ... Announce send variables. 
+      !
+      DO ji = 1, nsnd
+         IF ( ssnd(ji)%laction ) THEN 
+            CALL prism_def_var_proto (ssnd(ji)%nid, ssnd(ji)%clname, id_part, (/ 2, 0/),  &
+               &                      PRISM_Out   , ishape   , PRISM_REAL, nerror)
+            IF ( nerror /= PRISM_Ok ) THEN
+               WRITE(numout,*) 'Failed to define transient ', ji, TRIM(ssnd(ji)%clname)
+               CALL prism_abort_proto ( ssnd(ji)%nid, 'cpl_prism_define', 'Failure in prism_def_var')
+            ENDIF
          ENDIF
-
-         !
-         ! Collect ranges from all NEMO procs on the local root process
-         !
-         CALL mpi_gather(range,  5, MPI_INTEGER, &
-                         ranges, 5, MPI_INTEGER, localRoot, localComm, ierror)
-
-         IF ( localRank == localRoot ) THEN
-
-            maxlen = maxval(ranges(5,:))
-            
-            ALLOCATE(buffer(1:maxlen), stat = ierror)
-            IF (ierror > 0) THEN
-               CALL prism_abort_proto ( comp_id, 'cpl_prism_define', 'Failure in allocating buffer')
-               RETURN
+      END DO
+      !
+      ! ... Announce received variables. 
+      !
+      DO ji = 1, nrcv
+         IF ( srcv(ji)%laction ) THEN 
+            CALL prism_def_var_proto ( srcv(ji)%nid, srcv(ji)%clname, id_part, (/ 2, 0/),   &
+               &                      PRISM_In    , ishape   , PRISM_REAL, nerror)
+            IF ( nerror /= PRISM_Ok ) THEN
+               WRITE(numout,*) 'Failed to define transient ', ji, TRIM(srcv(ji)%clname)
+               CALL prism_abort_proto ( srcv(ji)%nid, 'cpl_prism_define', 'Failure in prism_def_var')
             ENDIF
-
-          ENDIF
-
-      ELSE
-
-         paral(1) = 2                  ! box partitioning
-!2dtest         paral(2) = jpiglo           &
-!2dtest                  * (nldj-1+njmpp-1) &
-!2dtest                  + (nldi-1+nimpp-1)   ! NEMO lower left corner global offset    
-         paral(2) = jpiglo &
-                  * (nldj-1+njmpp-1)   ! NEMO lower left corner global offset    
-         paral(3) = nlei-nldi+1        ! local extent in i 
-         paral(4) = nlej-nldj+1        ! local extent in j
-         paral(5) = jpiglo             ! global extent in x
-
-         IF(ln_ctl) THEN
-            print*, ' multiexchg: paral (1:5)', paral
-            print*, ' multiexchg: jpi, jpj =', jpi, jpj
-            print*, ' multiexchg: nldi, nlei, nimpp =', nldi, nlei, nimpp
-            print*, ' multiexchg: nldj, nlej, njmpp =', nldj, nlej, njmpp
          ENDIF
-
-         IF ( paral(3) /= nlei-nldi+1 ) THEN
-              print*, 'WARNING!!! in cpl_oasis3 - cpl_prism_define'
-              print*, 'cpl_prism_define: local extend in i is ', paral(3), ' should equal ', nlei-nldi+1
-         ENDIF
-         IF ( paral(4) /= nlej-nldj+1 ) THEN
-              print*, 'WARNING!!! in cpl_oasis3 - cpl_prism_define'
-              print*, 'cpl_prism_define: local extend in j is ', paral(4), ' should equal ', nlej-nldj+1
-         ENDIF
-
-      ENDIF
-
-      IF ( commRank ) &
-      CALL prism_def_partition_proto ( part_id, paral, ierror )
-
-      grid_id(1)= part_id
-
-      !------------------------------------------------------------------
-      ! 3rd Declare the transient variables
-      !------------------------------------------------------------------
-      !
-      ! ... Define symbolic names for the transient fields send by the ocean
-      !     These must be identical to the names specified in the SMIOC file.
-      !
-      cpl_send( 1)='SSTOCEAN' ! sea surface temperature              -> sst_io
-      cpl_send( 2)='SICOCEAN' ! sea ice area fraction                -> 1.-frld
-#if defined key_cpl_albedo
-      cpl_send( 3)='STIOCEAN' ! surface temperature over sea ice     -> tn_ice
-      cpl_send( 4)='SAIOCEAN' ! albedo over sea ice                  -> alb_ice
-#else
-      cpl_send( 3)='SITOCEAN' ! sea ice thickness                    -> hicif (only 1 layer available!)
-      cpl_send( 4)='SNTOCEAN' ! surface snow thickness over sea ice  -> hsnif
-#endif
-#if defined key_cpl_ocevel
-      cpl_send( 5)='SUNOCEAN' ! U-velocity                           -> un
-      cpl_send( 6)='SVNOCEAN' ! V-velocity                           -> vn
-#endif
-      !
-      ! ...  Define symbolic names for transient fields received by the ocean.
-      !      These must be identical to the names specified in the SMIOC file.
-      !
-      ! ...  a) U-Grid fields
-      !
-      cpl_recv( 1)='TXWOCEWU' ! weighted surface downward eastward stress
-      cpl_recv( 2)='TYWOCEWU' ! weighted surface downward northward stress
-      cpl_recv( 3)='TXIOCEWU' ! weighted surface downward eastward stress over ice
-      cpl_recv( 4)='TYIOCEWU' ! weighted surface downward northward stress over ice
-      !
-      ! ...  a) V-Grid fields
-      !
-      cpl_recv( 5)='TXWOCEWV' ! weighted surface downward eastward stress
-      cpl_recv( 6)='TYWOCEWV' ! weighted surface downward northward stress
-      cpl_recv( 7)='TXIOCEWV' ! weighted surface downward eastward stress over ice
-      cpl_recv( 8)='TYIOCEWV' ! weighted surface downward northward stress over ice
-      !
-      ! ...  a) T-Grid fields
-      !
-      cpl_recv( 9)='FRWOCEPE' ! P-E over water                               -> zpew
-      cpl_recv(10)='FRIOCEPE' ! P-E over ice                                 -> zpei
-      cpl_recv(11)='FRROCESN' ! surface downward snow fall                   -> zpsol
-      cpl_recv(12)='FRIOCEEV' ! surface upward snow flux where sea ice       -> zevice
-
-      cpl_recv(13)='QSWOCESR' ! surface net downward shortwave flux          -> qsr_oce
-      cpl_recv(14)='QSWOCENS' ! surface downward non-solar heat flux in air  -> qnsr_oce
-      cpl_recv(15)='QSIOCESR' ! solar heat flux on sea ice                   -> qsr_ice
-      cpl_recv(16)='QSIOCENS' ! non-solar heat flux on sea ice               -> qnsr_ice
-      cpl_recv(17)='QSIOCEDQ' ! non-solar heat flux derivative               -> dqns_ice
-
-#ifdef key_cpl_discharge
-      cpl_recv(18)='FRWOCEIS' ! ice discharge into ocean                     -> calving
-      cpl_recv(19)='FRWOCERD' ! river discharge into ocean                   -> zrunriv
-      cpl_recv(20)='FRWOCECD' ! continental discharge into ocean             -> zruncot
-#endif
-      !
-      ! data_type has to be PRISM_REAL as PRISM_DOUBLE is not supported.
-      ! For exchange of double precision fields the OASIS3 has to be compiled
-      ! with use_realtype_single. (see OASIS3 User Guide prism_2-4, 5th Ed.,
-      ! p. 13 and p. 53 for further explanation.)
-      !
-      data_type = PRISM_REAL
-
-      nodim(1) = 3 ! check
-      nodim(2) = 0
-
-      !
-      ! ... Define the shape for the area that excludes the halo
-      !     For serial configuration (key_mpp_mpi not being active)
-      !     nl* is set to the global values 1 and jp*glo.
-      !
-      IF ( rootexchg ) THEN
-         shape(1,1) = 1
-         shape(2,1) = jpiglo
-         shape(1,2) = 1
-         shape(2,2) = jpjglo
-         shape(1,3) = 1
-         shape(2,3) = 1
-       ELSE
-         shape(1,1) = 1
-         shape(2,1) = nlei-nldi+1 ! jpi
-         shape(1,2) = 1
-         shape(2,2) = nlej-nldj+1 ! jpj
-         shape(1,3) = 1
-         shape(2,3) = 1
-      ENDIF
-      !
-      ! -----------------------------------------------------------------
-      ! ... Allocate memory for data exchange
-      ! -----------------------------------------------------------------
-      !
-      ALLOCATE(exfld(shape(1,1):shape(2,1),shape(1,2):shape(2,2)), stat = ierror)
-      IF (ierror > 0) THEN
-         CALL prism_abort_proto ( comp_id, 'cpl_prism_define', 'Failure in allocating exfld')
-         RETURN
-      ENDIF
-      !
-      ! ... Announce send variables, all on T points. 
-      !
-      info = PRISM_Out
-      !
-
-      IF ( commRank ) THEN
-
-         DO ji = 1, nsend
-            !        if ( ji == 2 ) ; then ; nodim(2) = 2 ; else ; nodim(2) = 0 ; endif
-            CALL prism_def_var_proto (send_id(ji), cpl_send(ji), grid_id(1), &
-                 nodim, info, shape, data_type, ierror)
-            IF ( ierror /= PRISM_Ok ) THEN
-               PRINT *, 'Failed to define transient ', ji, TRIM(cpl_send(ji))
-               CALL prism_abort_proto ( comp_id, 'cpl_prism_define', 'Failure in prism_def_var')
-            ENDIF
-         ENDDO
-         !
-         nodim(1) = 3 ! check
-         nodim(2) = 0
-         !
-         ! ... Announce recv variables. 
-         !
-         info = PRISM_In
-         !
-         ! ... a) on U points
-         !
-         DO ji = 1, 4
-            CALL prism_def_var_proto (recv_id(ji), cpl_recv(ji), grid_id(1), &
-                 nodim, info, shape, data_type, ierror)
-            IF ( ierror /= PRISM_Ok ) THEN
-               PRINT *, 'Failed to define transient ', ji, TRIM(cpl_recv(ji))
-               CALL prism_abort_proto ( comp_id, 'cpl_prism_define', 'Failure in prism_def_var')
-            ENDIF
-         ENDDO
-         !
-         ! ... b) on V points
-         !
-         DO ji = 5, 8
-            CALL prism_def_var_proto (recv_id(ji), cpl_recv(ji), grid_id(1), &
-                 nodim, info, shape, data_type, ierror)
-            IF ( ierror /= PRISM_Ok ) THEN
-               PRINT *, 'Failed to define transient ', TRIM(cpl_recv(ji))
-               CALL prism_abort_proto ( comp_id, 'cpl_prism_define', 'Failure in prism_def_var')
-            ENDIF
-         ENDDO
-         !
-         ! ... c) on T points
-         !
-         DO ji = 9, nrecv
-            CALL prism_def_var_proto (recv_id(ji), cpl_recv(ji), grid_id(1), &
-                 nodim, info, shape, data_type, ierror)
-            IF ( ierror /= PRISM_Ok ) THEN
-               PRINT *, 'Failed to define transient ', TRIM(cpl_recv(ji))
-               CALL prism_abort_proto ( comp_id, 'cpl_prism_define', 'Failure in prism_def_var')
-            ENDIF
-         ENDDO
-
-      ENDIF ! commRank
-
-      !------------------------------------------------------------------
-      ! 4th End of definition phase
-      !------------------------------------------------------------------
-
-      IF ( commRank ) THEN
-         CALL prism_enddef_proto(ierror)
-         IF ( ierror /= PRISM_Ok ) &
-              CALL prism_abort_proto ( comp_id, 'cpl_prism_define', 'Failure in prism_enddef')
-      ENDIF
-
+      END DO
+      
+      !------------------------------------------------------------------
+      ! End of definition phase
+      !------------------------------------------------------------------
+      
+      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
-
-
-
-   SUBROUTINE cpl_prism_send( var_id, date, data_array, info )
-
-      IMPLICIT NONE
+   
+   
+   SUBROUTINE cpl_prism_snd( kid, kstep, pdata, kinfo )
 
       !!---------------------------------------------------------------------
-      !!              ***  ROUTINE cpl_prism_send  ***
+      !!              ***  ROUTINE cpl_prism_snd  ***
       !!
       !! ** Purpose : - At each coupling time-step,this routine sends fields
@@ -832 +215 @@
       !! * Arguments
       !!
-      INTEGER, INTENT( IN )  :: var_id    ! variable Id
-      INTEGER, INTENT( OUT ) :: info      ! OASIS3 info argument
-      INTEGER, INTENT( IN )  :: date      ! ocean time-step in seconds
-      REAL(wp)               :: data_array(:,:)
-      !!
-      !! * Local declarations
-      !!
-#if defined key_mpp_mpi
-      REAL(wp)               :: global_array(jpiglo,jpjglo)
-      !
-!mpi  INTEGER                :: status(MPI_STATUS_SIZE)
-!mpi  INTEGER                :: type       ! MPI data type
-      INTEGER                :: request    ! MPI isend request
-      INTEGER                :: ji, jj, jn ! local loop indicees
-#else
-      INTEGER                :: ji
-#endif
-      !!
-      !!--------------------------------------------------------------------
-      !!
-
-#if defined key_mpp_mpi
-
-      request = 0
-
-      IF ( rootexchg ) THEN
-         !
-!mpi     IF ( wp == 4 ) type = MPI_REAL
-!mpi     IF ( wp == 8 ) type = MPI_DOUBLE_PRECISION
-         !
-         ! collect data on the local root process
-         !
-
-         if ( var_id == 1 .and. localRank == localRoot .and. ln_ctl )  then
-             do ji = 0, localSize-1
-                WRITE(numout,*) ' rootexchg: ranges for rank ', ji, ' are ', ranges(:,ji) 
-             enddo
-         endif
-
-         IF ( localRank /= localRoot ) THEN
-
-            DO jj = nldj, nlej
-               DO ji = nldi, nlei
-                  exfld(ji-nldi+1,jj-nldj+1)=data_array(ji,jj)
-               ENDDO
-            ENDDO
-
-!mpi        CALL mpi_send(exfld, range(5), type, localRoot, localRank, localComm, ierror)
-            CALL mppsend (localRank, exfld, range(5), localRoot, request)  
-
-            if ( var_id == 1 .and. ln_ctl )  then
-               WRITE(numout,*) ' rootexchg: This is process       ', localRank
-               WRITE(numout,*) ' rootexchg: We have a range of    ', range 
-!               WRITE(numout,*) ' rootexchg: We got SST to process ', data_array 
-            endif
-
-         ENDIF
-
-         IF ( localRank == localRoot ) THEN
-
-            DO jj = ranges(3,localRoot), ranges(3,localRoot)+ranges(4,localRoot)-1
-               DO ji = ranges(1,localRoot), ranges(1,localRoot)+ranges(2,localRoot)-1
-                  global_array(ji,jj) = data_array(ji,jj) ! workaround
-               ENDDO
-            ENDDO
-
-            DO jn = 1, localSize-1
-
-!mpi           CALL mpi_recv(buffer, ranges(5,jn), type, localRoot, jn, localComm, status, ierror)
-               CALL mpprecv(jn, buffer, ranges(5,jn))
-
-               if ( var_id == 1 .and. ln_ctl )  then
-                   WRITE(numout,*) ' rootexchg: Handling data from process ', jn
-!                   WRITE(numout,*) ' rootexchg: We got SST to process      ', buffer
-               endif
-
-
-               DO jj = ranges(3,jn), ranges(3,jn)+ranges(4,jn)-1
-                  DO ji = ranges(1,jn), ranges(1,jn)+ranges(2,jn)-1
-                     global_array(ji,jj) = buffer((jj-ranges(3,jn))*ranges(2,jn) + ji-ranges(1,jn)+1)
-                  ENDDO
-               ENDDO
-
-            ENDDO
-
-            CALL prism_put_proto ( var_id, date, global_array, info )
-
-         ENDIF
-
-      ELSE
-
-         DO jj = nldj, nlej
-            DO ji = nldi, nlei
-               exfld(ji-nldi+1,jj-nldj+1)=data_array(ji,jj)
-            ENDDO
-         ENDDO
-
-         CALL prism_put_proto ( var_id, date, exfld, info )
-
+      INTEGER,                      INTENT( IN    )   :: kid       ! variable intex in the array
+      INTEGER,                      INTENT(   OUT )   :: kinfo     ! OASIS3 info argument
+      INTEGER,                      INTENT( IN    )   :: kstep     ! ocean time-step in seconds
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( IN    )   :: pdata
+      !!
+      !!
+      !!--------------------------------------------------------------------
+      !
+      ! snd data to OASIS3
+      !
+      IF( lk_mpp ) THEN   ;   CALL prism_put_proto ( ssnd(kid)%nid, kstep, pdata(nldi:nlei, nldj:nlej), kinfo )
+      ELSE                ;   CALL prism_put_proto ( ssnd(kid)%nid, kstep, pdata                      , kinfo )
       ENDIF
-
-#else
-
-      !
-      ! send local data from every process to OASIS3
-      !
-      IF ( commRank ) &
-      CALL prism_put_proto ( var_id, date, data_array, info )
-
-#endif
-
-      IF ( commRank ) THEN
-
-         IF (ln_ctl .and. lwp) THEN        
-
-            IF ( info == PRISM_Sent     .OR. &
-                 info == PRISM_ToRest   .OR. &
-                 info == PRISM_SentOut  .OR. &
-                 info == PRISM_ToRestOut       ) THEN
-               WRITE(numout,*) '****************'
-               DO ji = 1, nsend
-                  IF (var_id == send_id(ji) ) THEN
-                     WRITE(numout,*) 'prism_put_proto: Outgoing ', cpl_send(ji)
-                     EXIT
-                  ENDIF
-               ENDDO
-               WRITE(numout,*) 'prism_put_proto: var_id ', var_id
-               WRITE(numout,*) 'prism_put_proto:   date ', date
-               WRITE(numout,*) 'prism_put_proto:   info ', info
-               WRITE(numout,*) '     - Minimum value is ', MINVAL(data_array)
-               WRITE(numout,*) '     - Maximum value is ', MAXVAL(data_array)
-               WRITE(numout,*) '     -     Sum value is ', SUM(data_array)
-               WRITE(numout,*) '****************'
-            ENDIF
-
-         ENDIF
-
-      ENDIF
-
-   END SUBROUTINE cpl_prism_send
-
-
-
-   SUBROUTINE cpl_prism_recv( var_id, date, data_array, info )
-
-      IMPLICIT NONE
+      
+      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
+            WRITE(numout,*) 'prism_put_proto:  kstep ', kstep
+            WRITE(numout,*) 'prism_put_proto:   info ', kinfo
+            WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata)
+            WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata)
+            WRITE(numout,*) '     -     Sum value is ', SUM(pdata)
+            WRITE(numout,*) '****************'
+        ENDIF
+     ENDIF
+    END SUBROUTINE cpl_prism_snd
+
+
+   SUBROUTINE cpl_prism_rcv( kid, kstep, pdata, kinfo )
 
       !!---------------------------------------------------------------------
-      !!              ***  ROUTINE cpl_prism_recv  ***
+      !!              ***  ROUTINE cpl_prism_rcv  ***
       !!
       !! ** Purpose : - At each coupling time-step,this routine receives fields
       !!      like stresses and fluxes from the coupler or remote application.
       !!----------------------------------------------------------------------
-      !! * Arguments
-      !!
-      INTEGER, INTENT( IN )  :: var_id    ! variable Id
-      INTEGER, INTENT( OUT ) :: info      ! variable Id
-      INTEGER, INTENT( IN )  :: date      ! ocean time-step in seconds
-      REAL(wp),INTENT( OUT ) :: data_array(:,:)
-      !!
-      !! * Local declarations
-      !!
-#if defined key_mpp_mpi
-      REAL(wp)               :: global_array(jpiglo,jpjglo)
-      !
-!      LOGICAL                :: action = .false.
-      LOGICAL                :: action
-!mpi  INTEGER                :: status(MPI_STATUS_SIZE)
-!mpi  INTEGER                :: type       ! MPI data type
-      INTEGER                :: request    ! MPI isend request
-      INTEGER                :: ji, jj, jn ! local loop indices
-#else
-      INTEGER                :: ji
-#endif
-      !!
-      !!--------------------------------------------------------------------
-      !!
-#ifdef key_mpp_mpi
-      action = .false.
-      request = 0
-
-      IF ( rootexchg ) THEN
-         !
-         ! receive data from OASIS3 on local root
-         !
-         IF ( commRank ) &
-              CALL prism_get_proto ( var_id, date, global_array, info )
-
-         CALL MPI_BCAST ( info, 1, MPI_INTEGER, localRoot, localComm, ierror )
-
-      ELSE
-         !
-         ! receive local data from OASIS3 on every process
-         !
-         CALL prism_get_proto ( var_id, date, exfld, info )
-
+      INTEGER,                      INTENT( IN    )   :: kid       ! variable intex in the array
+      INTEGER,                      INTENT( IN    )   :: kstep     ! ocean time-step in seconds
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( INOUT )   :: pdata     ! IN to keep the value if nothing is done
+      INTEGER,                      INTENT(   OUT )   :: kinfo     ! OASIS3 info argument
+      !!
+      LOGICAL                :: llaction
+      !!--------------------------------------------------------------------
+      !
+      ! receive local data from OASIS3 on every process
+      !
+      CALL prism_get_proto ( srcv(kid)%nid, 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
+
+      IF ( llaction ) THEN
+
+         IF( lk_mpp ) THEN   ;   pdata(nldi:nlei, nldj:nlej) = exfld(:,:)
+         ELSE                ;   pdata(    :    ,     :    ) = exfld(:,:)
+         ENDIF
+         
+         !--- Fill the overlap areas and extra hallows (mpp)
+         !--- check periodicity conditions (all cases)
+         CALL lbc_lnk( pdata, srcv(kid)%clgrid, srcv(kid)%nsgn )   
+         
+         IF ( ln_ctl ) THEN        
+            WRITE(numout,*) '****************'
+            WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%clname
+            WRITE(numout,*) 'prism_get_proto: ivarid '  , srcv(kid)%nid
+            WRITE(numout,*) 'prism_get_proto:   kstep', kstep
+            WRITE(numout,*) 'prism_get_proto:   info ', kinfo
+            WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata)
+            WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata)
+            WRITE(numout,*) '     -     Sum value is ', SUM(pdata)
+            WRITE(numout,*) '****************'
+            call flush(numout)
+         ENDIF
+      
       ENDIF
 
-      IF ( info == PRISM_Recvd        .OR. &
-           info == PRISM_FromRest     .OR. &
-           info == PRISM_RecvOut      .OR. &
-           info == PRISM_FromRestOut ) action = .true.
-
-      IF (ln_ctl .and. lwp) THEN        
-         WRITE(numout,*) "info", info, var_id
-         WRITE(numout,*) "date", date, var_id
-         WRITE(numout,*) "action", action, var_id
-      ENDIF
-
-      IF ( rootexchg .and. action ) THEN
-         !
-!mpi     IF ( wp == 4 ) type = MPI_REAL
-!mpi     IF ( wp == 8 ) type = MPI_DOUBLE_PRECISION
-         !
-         ! distribute data to processes
-         !
-         IF ( localRank == localRoot ) THEN
-
-            DO jj = ranges(3,localRoot), ranges(3,localRoot)+ranges(4,localRoot)-1
-               DO ji = ranges(1,localRoot), ranges(1,localRoot)+ranges(2,localRoot)-1
-                  exfld(ji-ranges(1,localRoot)+1,jj-ranges(3,localRoot)+1) = global_array(ji,jj)
-               ENDDO
-            ENDDO
-
-            DO jn = 1, localSize-1
-
-               DO jj = ranges(3,jn), ranges(3,jn)+ranges(4,jn)-1
-                  DO ji = ranges(1,jn), ranges(1,jn)+ranges(2,jn)-1
-                     buffer((jj-ranges(3,jn))*ranges(2,jn) + ji-ranges(1,jn)+1) = global_array(ji,jj)
-                  ENDDO
-               ENDDO
-
-!mpi           CALL mpi_send(buffer, ranges(5,jn), type, jn, jn, localComm, ierror)
-               CALL mppsend (jn, buffer, ranges(5,jn), jn, request)  
-
-            ENDDO
-
-         ENDIF
-
-         IF ( localRank /= localRoot ) THEN
-!mpi         CALL mpi_recv(exfld, range(5), type, localRoot, localRank, localComm, status, ierror)
-             CALL mpprecv(localRank, exfld, range(5))
-         ENDIF
-
-      ENDIF
-
-      IF ( action ) THEN
-
-         data_array = 0.0
-
-         DO jj = nldj, nlej
-            DO ji = nldi, nlei
-               data_array(ji,jj)=exfld(ji-nldi+1,jj-nldj+1)
-            ENDDO
-         ENDDO
-
-         IF (ln_ctl .and. lwp) THEN        
-            WRITE(numout,*) '****************'
-            DO ji = 1, nrecv
-               IF (var_id == recv_id(ji) ) THEN
-                  WRITE(numout,*) 'prism_get_proto: Incoming ', cpl_recv(ji)
-                  EXIT
-               ENDIF
-            ENDDO
-            WRITE(numout,*) 'prism_get_proto: var_id ', var_id
-            WRITE(numout,*) 'prism_get_proto:   date ', date
-            WRITE(numout,*) 'prism_get_proto:   info ', info
-            WRITE(numout,*) '     - Minimum value is ', MINVAL(data_array)
-            WRITE(numout,*) '     - Maximum value is ', MAXVAL(data_array)
-            WRITE(numout,*) '     -     Sum value is ', SUM(data_array)
-            WRITE(numout,*) '****************'
-         ENDIF
-
-      ENDIF
-#else
-      CALL prism_get_proto ( var_id, date, exfld, info)
-      
-      IF (info == PRISM_Recvd        .OR. &
-          info == PRISM_FromRest     .OR. &
-          info == PRISM_RecvOut      .OR. &
-          info == PRISM_FromRestOut )      THEN
-             data_array = exfld
-
-         IF (ln_ctl .and. lwp ) THEN        
-            WRITE(numout,*) '****************'
-            DO ji = 1, nrecv
-               IF (var_id == recv_id(ji) ) THEN
-                  WRITE(numout,*) 'prism_get_proto: Incoming ', cpl_recv(ji)
-                  EXIT
-               ENDIF
-            ENDDO
-            WRITE(numout,*) 'prism_get_proto: var_id ', var_id
-            WRITE(numout,*) 'prism_get_proto:   date ', date
-            WRITE(numout,*) 'prism_get_proto:   info ', info
-            WRITE(numout,*) '     - Minimum value is ', MINVAL(data_array)
-            WRITE(numout,*) '     - Maximum value is ', MAXVAL(data_array)
-            WRITE(numout,*) '     -     Sum value is ', SUM(data_array)
-            WRITE(numout,*) '****************'
-         ENDIF
-
-       ENDIF
-#endif
-
-   END SUBROUTINE cpl_prism_recv
-
+   END SUBROUTINE cpl_prism_rcv
 
 
    SUBROUTINE cpl_prism_finalize
-
-      IMPLICIT NONE
 
       !!---------------------------------------------------------------------
@@ -1152 +311 @@
 
       DEALLOCATE(exfld)
-
-      if ( prism_was_initialized ) then
-
-         if ( prism_was_terminated ) then
-            print *, 'prism has already been terminated.'
-         else
-            call prism_terminate_proto ( ierror )
-            prism_was_terminated = .true.
-         endif
-
-      else
-
-         print *, 'Initialize prism before terminating it.'
-
-      endif
-
+      CALL prism_terminate_proto ( nerror )         
 
    END SUBROUTINE cpl_prism_finalize
 
+#else
+
+   !!----------------------------------------------------------------------
+   !!   Default case                                Forced Ocean/Atmosphere
+   !!----------------------------------------------------------------------
+   !!   Empty module
+   !!----------------------------------------------------------------------
+   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
+      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
+
 #endif
 

trunk/NEMO/OPA_SRC/SBC/sbc_ice.F90

@@ -23 +23 @@
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   dqns_ice    !: non solar heat flux sensibility over ice (LW+SEN+LA) [W/m2/K]
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   tn_ice      !: ice surface temperature       [K]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   alb_ice   !: albedo of ice
 #else
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qns_ice     !: non solar heat flux over ice  [W/m2]
@@ -28 +29 @@
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   dqns_ice    !: non solar heat flux sensibility over ice (LW+SEN+LA) [W/m2/K]
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tn_ice      !: ice surface temperature       [K]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   alb_ice       !: albedo of ice
 #endif
 
@@ -49 +51 @@
 #else
 
-# if defined key_lim3 
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   alb_ice   !: albedo of ice
-# else
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   alb_ice       !: albedo of ice
-# endif
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rrunoff       !: runoff
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   calving       !: calving
+!!$   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rrunoff       !: runoff
+!!$   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   calving       !: calving
 
 #endif

trunk/NEMO/OPA_SRC/SBC/sbc_oce.F90

@@ -4 +4 @@
    !! Surface module :   variables defined in core memory 
    !!======================================================================
-   !! History :  9.0   !  06-06  (G. Madec)  Original code
+   !! History :  3.0   !  2006-06  (G. Madec)  Original code
+   !!             -    !  2008-08  (G. Madec)  namsbc moved from sbcmod
    !!----------------------------------------------------------------------
    USE par_oce          ! ocean parameters
@@ -11 +12 @@
    PRIVATE
    
+   !!----------------------------------------------------------------------
+   !!           Namelist for the Ocean Surface Boundary Condition
+   !!----------------------------------------------------------------------
+   !                                             !! * namsbc namelist *
+   LOGICAL , PUBLIC ::   ln_ana      = .FALSE.   !: analytical boundary condition flag
+   LOGICAL , PUBLIC ::   ln_flx      = .FALSE.   !: flux      formulation
+   LOGICAL , PUBLIC ::   ln_blk_clio = .FALSE.   !: CLIO bulk formulation
+   LOGICAL , PUBLIC ::   ln_blk_core = .FALSE.   !: CORE bulk formulation
+   LOGICAL , PUBLIC ::   ln_cpl      = .FALSE.   !: coupled   formulation (overwritten by key_sbc_coupled )
+   LOGICAL , PUBLIC ::   ln_dm2dc    = .FALSE.   !: Daily mean to Diurnal Cycle short wave (qsr)
+   LOGICAL , PUBLIC ::   ln_rnf      = .FALSE.   !: runoffs / runoff mouths
+   LOGICAL , PUBLIC ::   ln_ssr      = .FALSE.   !: Sea Surface restoring on SST and/or SSS      
+   INTEGER , PUBLIC ::   nn_ice      = 0         !: flag on ice in the surface boundary condition (=0/1/2/3)
+   INTEGER , PUBLIC ::   nn_fwb      = 0         !: type of FreshWater Budget control (=0/1/2)
+   INTEGER , PUBLIC ::   nn_ico_cpl  = 0         !: ice-ocean coupling indicator
+   !                                             !  = 0   LIM-3 old case
+   !                                             !  = 1   stresses computed using now ocean velocity
+   !                                             !  = 2   combination of 0 and 1 cases
+
    !!----------------------------------------------------------------------
    !!              Ocean Surface Boundary Condition fields
@@ -34 +54 @@
    !!----------------------------------------------------------------------
    !!   OPA 9.0 , LOCEAN-IPSL (2006) 
-   !! $Id$
+   !! $ Id: $
    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
    !!======================================================================

trunk/NEMO/OPA_SRC/SBC/sbccpl.F90

@@ -2 +2 @@
    !!======================================================================
    !!                       ***  MODULE  sbccpl  ***
-   !! Ocean forcing:  momentum, heat and freshwater coupled formulation
-   !!=====================================================================
-   !! History :  9.0   !  06-07  (R. Redler, N. Keenlyside, W. Park) 
-   !!                            Original code split into flxmod & taumod
-   !!            9.0   !  06-07  (G. Madec)  surface module
+   !! Surface Boundary Condition :  momentum, heat and freshwater fluxes in coupled mode
+   !!======================================================================
+   !! History :  2.0  !  06-2007  (R. Redler, N. Keenlyside, W. Park) Original code split into flxmod & taumod
+   !!            3.0  !  02-2008  (G. Madec, C Talandier)  surface module
+   !!             -   !  08-2008  (S. Masson, E. ....  ) generic coupled interface
    !!----------------------------------------------------------------------
-#if defined key_sbc_cpl
+#if defined key_oasis3 || defined key_oasis4
    !!----------------------------------------------------------------------
-   !!   'key_sbc_cpl'                   Coupled Ocean/Atmosphere formulation
+   !!   'key_oasis3' or 'key_oasis4'   Coupled Ocean/Atmosphere formulation
    !!----------------------------------------------------------------------
+   !!   namsbc_cpl      : coupled formulation namlist
+   !!   sbc_cpl_init    : initialisation of the coupled exchanges
+   !!   sbc_cpl_rcv     : receive fields from the atmosphere over the ocean (ocean only)
+   !!                     receive stress from the atmosphere over the ocean (ocean-ice case)
+   !!   sbc_cpl_ice_tau : receive stress from the atmosphere over ice
+   !!   sbc_cpl_ice_flx : receive fluxes from the atmosphere over ice
+   !!   sbc_cpl_snd     : send     fields to the atmosphere
    !!----------------------------------------------------------------------
-   !!   namsbc_cpl   : coupled formulation namlist
-   !!   sbc_cpl      : coupled formulation for the ocean surface boundary condition
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
-   USE phycst          ! physical constants
+   USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE sbc_ice         ! Surface boundary condition: ice fields
+   USE ice_oce         ! Shared variables between ice and ocean
+#if defined key_lim3
+   USE par_ice         ! ice parameters
+#endif
+   USE cpl_oasis3      ! OASIS3 coupling
+   USE geo2ocean       ! 
+   USE restart         !
+   USE oce   , ONLY : tn, un, vn
+   USE phycst, ONLY : rt0
+   USE albedo          !
    USE in_out_manager  ! I/O manager
+   USE iom             ! NetCDF library
    USE lib_mpp         ! distribued memory computing library
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE daymod          ! calendar
-
-   USE cpl_oasis3      ! OASIS3 coupling (to ECHAM5)
-   USE cpl_oasis4      ! OASIS4 coupling (to ECHAM5)
-   USE geo2ocean, ONLY : repere, repcmo
-   USE ice_2, only     : frld       ! : leads fraction = 1-a/totalarea
-
-   USE sbc_oce         ! Surface boundary condition: ocean fields
-
-   USE iom             ! NetCDF library
-
+   USE mod_prism_proto ! OASIS3 prism module: PRISM_* variables...
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   sbc_cpl       ! routine called by step.F90
-
-   LOGICAL, PUBLIC ::   lk_sbc_cpl = .TRUE.   !: coupled formulation flag
-
-   INTEGER , PARAMETER                 ::   jpfld   = 5    ! maximum number of files to read 
-   INTEGER , PARAMETER                 ::   jp_taux = 1    ! index of wind stress (i-component) file
-   INTEGER , PARAMETER                 ::   jp_tauy = 2    ! index of wind stress (j-component) file
-   INTEGER , PARAMETER                 ::   jp_qtot = 3    ! index of total (non solar+solar) heat file
-   INTEGER , PARAMETER                 ::   jp_qsr  = 4    ! index of solar heat file
-   INTEGER , PARAMETER                 ::   jp_emp  = 5    ! index of evaporation-precipation file
+   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
    
-!!wonsun         
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &
-      taux, tauy       &  !: surface stress components in (i,j) referential
-
-
-   USE sbc_ice, only : dqns_ice , & ! : derivative of non solar heat flux on sea ice
-                       qsr_ice  , & ! : solar flux over ice
-                       qns_ice  , & ! : total non solar heat flux (Longwave downward radiation) over ice
-                       tn_ice   , & ! : ice surface temperature
-                       alb_ice  , & ! : albedo of ice
-                       sprecip  , & ! : solid (snow) precipitation over water (!) what about ice?
-                       tprecip  , & ! : total precipitation ( or liquid precip minus evaporation in coupled mode)
-                       calving  , & ! : calving
-                       rrunoff  , & ! : monthly runoff (kg/m2/s)
-                       fr1_i0   , & ! : 1st part of the fraction of sol.rad. which penetrate inside the ice cover
-                       fr2_i0       ! : 2nd part of the fraction of sol.rad. which penetrate inside the ice cover
-
-   USE ice_2, only  : hicif ,     & ! : ice thickness
-                      frld  ,     & ! : leads fraction = 1-a/totalarea
-                      hsnif  ,    & ! : snow thickness
-                      u_ice , v_ice ! : ice velocity
-
-   USE sbc_oce, only : sst_m        ! : sea surface temperature
-
-   REAL(wp), PUBLIC ::            & !!! surface fluxes namelist (namflx)
-      q0    = 0.e0,               &  ! net heat flux
-      qsr0  = 0.e0,               &  ! solar heat flux
-      emp0  = 0.e0,               &  ! net freshwater flux
-      dqdt0 = -40.,               &  ! coefficient for SST damping (W/m2/K)
-      deds0 = 27.7                   ! coefficient for SSS damping (mm/day)
+   INTEGER, PARAMETER ::   jpr_otx1   =  1            ! 3 atmosphere-ocean stress components on grid 1
+   INTEGER, PARAMETER ::   jpr_oty1   =  2            ! 
+   INTEGER, PARAMETER ::   jpr_otz1   =  3            ! 
+   INTEGER, PARAMETER ::   jpr_otx2   =  4            ! 3 atmosphere-ocean stress components on grid 2
+   INTEGER, PARAMETER ::   jpr_oty2   =  5            ! 
+   INTEGER, PARAMETER ::   jpr_otz2   =  6            ! 
+   INTEGER, PARAMETER ::   jpr_itx1   =  7            ! 3 atmosphere-ice   stress components on grid 1
+   INTEGER, PARAMETER ::   jpr_ity1   =  8            ! 
+   INTEGER, PARAMETER ::   jpr_itz1   =  9            ! 
+   INTEGER, PARAMETER ::   jpr_itx2   = 10            ! 3 atmosphere-ice   stress components on grid 2
+   INTEGER, PARAMETER ::   jpr_ity2   = 11            ! 
+   INTEGER, PARAMETER ::   jpr_itz2   = 12            ! 
+   INTEGER, PARAMETER ::   jpr_qsroce = 13            ! Qsr above the ocean
+   INTEGER, PARAMETER ::   jpr_qsrice = 14            ! Qsr above the ice
+   INTEGER, PARAMETER ::   jpr_qsrmix =  jpr_qsroce   ! Qsr above ocean+ice
+   INTEGER, PARAMETER ::   jpr_qnsoce = 15            ! Qns above the ocean
+   INTEGER, PARAMETER ::   jpr_qnsice = 16            ! Qns above the ice
+   INTEGER, PARAMETER ::   jpr_qnsmix =  jpr_qnsoce   ! Qns above ocean+ice
+   INTEGER, PARAMETER ::   jpr_rain   = 17            ! total liquid precipitation (rain)
+   INTEGER, PARAMETER ::   jpr_snow   = 18            ! solid precipitation over the ocean (snow)
+   INTEGER, PARAMETER ::   jpr_tevp   = 19            ! total evaporation
+   INTEGER, PARAMETER ::   jpr_ievp   = 20            ! solid evaporation (sublimation)
+   INTEGER, PARAMETER ::   jpr_prsb   = 21            ! total precipitation (liquid + solid)
+   INTEGER, PARAMETER ::   jpr_semp   = 22            ! solid freshwater budget (sublimation - snow)
+   INTEGER, PARAMETER ::   jpr_oemp   = 23            ! ocean freshwater budget (evap - precip)
+   INTEGER, PARAMETER ::   jpr_w10m   = 24            ! 
+   INTEGER, PARAMETER ::   jpr_dqnsdt = 25            ! 
+   INTEGER, PARAMETER ::   jpr_rnf    = 26            ! 
+   INTEGER, PARAMETER ::   jpr_cal    = 27            ! 
+   INTEGER, PARAMETER ::   jprcv      = 27            ! total number of fields recieved
    
-    REAL(wp), DIMENSION(jpi,jpj) ::   qsr_oce_recv , qsr_ice_recv 
-    REAL(wp), DIMENSION(jpi,jpj) ::   qns_oce_recv, qns_ice_recv
-    REAL(wp), DIMENSION(jpi,jpj) ::   dqns_ice_recv
-    REAL(wp), DIMENSION(jpi,jpj) ::   tprecip_recv , precip_recv
-    REAL(wp), DIMENSION(jpi,jpj) ::   fr1_i0_recv  , fr2_i0_recv     
-    REAL(wp), DIMENSION(jpi,jpj) ::   rrunoff_recv , calving_recv   
-#if defined key_cpl_ocevel
-    REAL(wp), DIMENSION(jpi,jpj) :: un_weighted, vn_weighted
-    REAL(wp), DIMENSION(jpi,jpj) :: un_send    , vn_send 
-#endif
-    REAL(wp), DIMENSION(jpi,jpj) :: zrunriv   ! river discharge into ocean
-    REAL(wp), DIMENSION(jpi,jpj) :: zruncot   ! continental discharge into ocean
-
-    REAL(wp), DIMENSION(jpi,jpj) :: zpew      ! P-E over water
-    REAL(wp), DIMENSION(jpi,jpj) :: zpei      ! P-E over ice
-    REAL(wp), DIMENSION(jpi,jpj) :: zpsol     ! surface downward snow fall
-    REAL(wp), DIMENSION(jpi,jpj) :: zevice    ! surface upward snow flux where sea ice
-!!wonsun         
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
+   INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction 
+   INTEGER, PARAMETER ::   jps_toce   =  2            ! ocean temperature
+   INTEGER, PARAMETER ::   jps_tice   =  3            ! ice   temperature
+   INTEGER, PARAMETER ::   jps_tmix   =  4            ! mixed temperature (ocean+ice)
+   INTEGER, PARAMETER ::   jps_albice =  5            ! ice   albedo
+   INTEGER, PARAMETER ::   jps_albmix =  6            ! mixed albedo
+   INTEGER, PARAMETER ::   jps_hice   =  7            ! ice  thickness
+   INTEGER, PARAMETER ::   jps_hsnw   =  8            ! snow thickness
+   INTEGER, PARAMETER ::   jps_ocx1   =  9            ! ocean current on grid 1
+   INTEGER, PARAMETER ::   jps_ocy1   = 10            !
+   INTEGER, PARAMETER ::   jps_ocz1   = 11            !
+   INTEGER, PARAMETER ::   jps_ivx1   = 12            ! ice   current on grid 1
+   INTEGER, PARAMETER ::   jps_ivy1   = 13            !
+   INTEGER, PARAMETER ::   jps_ivz1   = 14            !
+   INTEGER, PARAMETER ::   jpsnd      = 14            ! total number of fields sended
+   
+   !                                                         !!** namelist namsbc_cpl **
+   ! Send to the atmosphere                                   !
+   CHARACTER(len=100) ::   cn_snd_temperature = 'oce only'    ! 'oce only' 'weighted oce and ice' or 'mixed oce-ice'
+   CHARACTER(len=100) ::   cn_snd_albedo      = 'none'        ! 'none' 'weighted ice' or 'mixed oce-ice'
+   CHARACTER(len=100) ::   cn_snd_thickness   = 'none'        ! 'none' or 'weighted ice and snow'
+   CHARACTER(len=100) ::   cn_snd_crt_nature  = 'none'        ! 'none' 'oce only' 'weighted oce and ice' or 'mixed oce-ice'   
+   CHARACTER(len=100) ::   cn_snd_crt_refere  = 'spherical'   ! 'spherical' or 'cartesian'
+   CHARACTER(len=100) ::   cn_snd_crt_orient  = 'local grid'  ! 'eastward-northward' or 'local grid'
+   CHARACTER(len=100) ::   cn_snd_crt_grid    = 'T'           ! always at 'T' point
+   
+   ! Recieved from the atmosphere                             !
+   CHARACTER(len=100) ::   cn_rcv_tau_nature  = 'oce only'    ! 'oce only' 'oce and ice' or 'mixed oce-ice'
+   CHARACTER(len=100) ::   cn_rcv_tau_refere  = 'spherical'   ! 'spherical' or 'cartesian'
+   CHARACTER(len=100) ::   cn_rcv_tau_orient  = 'local grid'  ! 'eastward-northward' or 'local grid'
+   CHARACTER(len=100) ::   cn_rcv_tau_grid    = 'T'           ! 'T', 'U,V', 'U,V,I', 'T,I', or 'T,U,V'
+   CHARACTER(len=100) ::   cn_rcv_w10m        = 'none'        ! 'none' or 'coupled'
+   CHARACTER(len=100) ::   cn_rcv_dqnsdt      = 'none'        ! 'none' or 'coupled'
+   CHARACTER(len=100) ::   cn_rcv_qsr         = 'oce only'    ! 'oce only' 'conservative' 'oce and ice' or 'mixed oce-ice'
+   CHARACTER(len=100) ::   cn_rcv_qns         = 'oce only'    ! 'oce only' 'conservative' 'oce and ice' or 'mixed oce-ice'
+   CHARACTER(len=100) ::   cn_rcv_emp         = 'oce only'    ! 'oce only' 'conservative' 'oce and ice' or 'mixed oce-ice'
+   CHARACTER(len=100) ::   cn_rcv_rnf         = 'coupled'     ! 'coupled' 'climato' or 'mixed'
+   CHARACTER(len=100) ::   cn_rcv_cal         = 'none'        ! 'none' or 'coupled'
+
+!!   CHARACTER(len=100), PUBLIC ::   cn_rcv_rnf   !: ???             ==>>  !!gm   treat this case in a different maner
+   
+   CHARACTER(len=100), DIMENSION(4) ::   cn_snd_crt           ! array combining cn_snd_crt_*
+   CHARACTER(len=100), DIMENSION(4) ::   cn_rcv_tau           ! array combining cn_rcv_tau_*
+
+   REAL(wp), DIMENSION(jpi,jpj)       ::   albedo_oce_mix     ! ocean albedo sent to atmosphere (mix clear/overcast sky)
+
+   REAL(wp), DIMENSION(jpi,jpj,jprcv) ::   frcv               ! all fields recieved from the atmosphere
+   INTEGER , DIMENSION(        jprcv) ::   nrcvinfo           ! OASIS info argument
+
+   !! Substitution
+#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006) 
-   !! $Id$
+   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   !! $Id:$
    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
 CONTAINS
-
-   SUBROUTINE sbc_cpl( kt )
+  
+   SUBROUTINE sbc_cpl_init( k_ice )     
+      !!----------------------------------------------------------------------
+      !!             ***  ROUTINE sbc_cpl_init  ***
+      !!
+      !! ** Purpose :   Initialisation of send and recieved information from
+      !!                the atmospheric component
+      !!
+      !! ** Method  : * Read namsbc_cpl namelist 
+      !!              * define the receive interface
+      !!              * define the send    interface
+      !!              * initialise the OASIS coupler
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   k_ice    ! ice management in the sbc (=0/1/2/3)
+      !!
+      INTEGER                      ::   jn           ! dummy loop index
+      REAL(wp), DIMENSION(jpi,jpj) ::   zacs, zaos   ! 2D workspace (clear & overcast sky albedos)
+      !!
+      NAMELIST/namsbc_cpl/  cn_snd_temperature, cn_snd_albedo    , cn_snd_thickness,                 &          
+         cn_snd_crt_nature, cn_snd_crt_refere , cn_snd_crt_orient, cn_snd_crt_grid , cn_rcv_w10m,    &
+         cn_rcv_tau_nature, cn_rcv_tau_refere , cn_rcv_tau_orient, cn_rcv_tau_grid ,                 &
+         cn_rcv_dqnsdt    , cn_rcv_qsr        , cn_rcv_qns       , cn_rcv_emp      , cn_rcv_rnf , cn_rcv_cal
       !!---------------------------------------------------------------------
-      !!                    ***  ROUTINE sbc_cpl  ***
-      !!                   
-      !! ** Purpose :   provide at each time step the surface ocean fluxes
-      !!                (momentum, heat, freshwater and runoff) in coupled mode
-      !!
-      !! ** Method  : - Recieve from a Atmospheric model via OASIS coupler :
-      !!                   i-component of the stress              taux  (N/m2)
-      !!                   j-component of the stress              tauy  (N/m2)
-      !!                   net downward heat flux                 qtot  (watt/m2)
-      !!                   net downward radiative flux            qsr   (watt/m2)
-      !!                   net upward freshwater (evapo - precip) emp   (kg/m2/s)
-      !!              - send to the Atmospheric model via OASIS coupler :
-      !!
-      !! ** Action  :   update at each time-step the two components of the 
-      !!                surface stress in both (i,j) and geographical ref.
-      !!
-      !!
-      !!      CAUTION :  - never mask the surface stress fields
-      !!
-      !! ** Action  :   update at each time-step
-      !!              - taux  & tauy    : stress components in (i,j) referential
-      !!              - qns             : non solar heat flux
-      !!              - qsr             : solar heat flux
-      !!              - emp             : evap - precip (volume flux)
-      !!              - emps            : evap - precip (concentration/dillution)
-      !!
-      !! References : The OASIS User Guide, Version 3.0 and 4.0
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time step
-      !!
-      INTEGER  ::   ji, jj      ! dummy loop indices
-#if defined key_cpl_ocevel
-      INTEGER  ::   ikchoix 
-#endif
-      INTEGER  ::   var_id, info
-      INTEGER  ::   date          !????  !!gm bug  this is a real !!!
-      REAL(wp) ::   zfacflx, zfacwat, zfact
-
-      REAL(wp), DIMENSION(jpi,jpj) ::   ztaueuw, ztauevw   ! eastward  wind stress over water at U and V-points
-      REAL(wp), DIMENSION(jpi,jpj) ::   ztaunuw, ztaunvw   ! northward wind stress over water at U and V-points
-      REAL(wp), DIMENSION(jpi,jpj) ::   ztaueui, ztauevi   ! eastward  wind stress over ice   at U and V-points
-      REAL(wp), DIMENSION(jpi,jpj) ::   ztaunui, ztaunvi   ! northward wind stress over ice   at U and V-points
-      REAL(wp), DIMENSION(jpi,jpj) ::   ztaueu , ztauev    ! eastward wind stress combined
-      REAL(wp), DIMENSION(jpi,jpj) ::   ztaunu , ztaunv    ! northward wind stress combined 
-      !!---------------------------------------------------------------------
-
-      date = ( kt - nit000 ) * rdttra(1)        ! date of exxhanges
-      !                                         ! Conversion factor (ocean units are W/m2 and Kg/m2/s]
-      zfacflx = 1.e0  ! no conversion    [W/m2]         ! W/m2 heat fluxes are send by the Atmosphere 
-      zfacwat = 1.e3  ! convert [m/s] to [kg/m2/s]      ! m/s freshwater fluxes are send by the atmosphere
-
-
-      !                                         ! =========================== !
-      !                                         !     Send Coupling fields    !
-      !                                         ! =========================== !
+
+      ! ================================ !
+      !      Namelist informations       !
+      ! ================================ !
+
+      REWIND( numnam )                    ! ... read namlist namsbc_cpl
+      READ  ( numnam, namsbc_cpl )
+
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist '
+         WRITE(numout,*)'~~~~~~~~~~~~'
+         WRITE(numout,*)'   received fields'
+         WRITE(numout,*)'       10m wind module                    cn_rcv_w10m        = ', cn_rcv_w10m 
+         WRITE(numout,*)'       surface stress - nature            cn_rcv_tau_nature  = ', cn_rcv_tau_nature
+         WRITE(numout,*)'                      - referential       cn_rcv_tau_refere  = ', cn_rcv_tau_refere
+         WRITE(numout,*)'                      - orientation       cn_rcv_tau_orient  = ', cn_rcv_tau_orient
+         WRITE(numout,*)'                      - mesh              cn_rcv_tau_grid    = ', cn_rcv_tau_grid
+         WRITE(numout,*)'       non-solar heat flux sensitivity    cn_rcv_dqnsdt      = ', cn_rcv_dqnsdt
+         WRITE(numout,*)'       solar heat flux                    cn_rcv_qsr         = ', cn_rcv_qsr  
+         WRITE(numout,*)'       non-solar heat flux                cn_rcv_qns         = ', cn_rcv_qns
+         WRITE(numout,*)'       freshwater budget                  cn_rcv_emp         = ', cn_rcv_emp
+         WRITE(numout,*)'       runoffs                            cn_rcv_rnf         = ', cn_rcv_rnf
+         WRITE(numout,*)'       calving                            cn_rcv_cal         = ', cn_rcv_cal 
+         WRITE(numout,*)'   sent fields'
+         WRITE(numout,*)'       surface temperature                cn_snd_temperature = ', cn_snd_temperature
+         WRITE(numout,*)'       albedo                             cn_snd_albedo      = ', cn_snd_albedo
+         WRITE(numout,*)'       ice/snow thickness                 cn_snd_thickness   = ', cn_snd_thickness  
+         WRITE(numout,*)'       surface current - nature           cn_snd_crt_nature  = ', cn_snd_crt_nature 
+         WRITE(numout,*)'                       - referential      cn_snd_crt_refere  = ', cn_snd_crt_refere 
+         WRITE(numout,*)'                       - orientation      cn_snd_crt_orient  = ', cn_snd_crt_orient
+         WRITE(numout,*)'                       - mesh             cn_snd_crt_grid    = ', cn_snd_crt_grid 
+      ENDIF
+
+      ! save current & stress in an array and suppress possible blank in the name
+      cn_snd_crt(1) = TRIM( cn_snd_crt_nature )   ;   cn_snd_crt(2) = TRIM( cn_snd_crt_refere )
+      cn_snd_crt(3) = TRIM( cn_snd_crt_orient )   ;   cn_snd_crt(4) = TRIM( cn_snd_crt_grid   )
+      cn_rcv_tau(1) = TRIM( cn_rcv_tau_nature )   ;   cn_rcv_tau(2) = TRIM( cn_rcv_tau_refere )
+      cn_rcv_tau(3) = TRIM( cn_rcv_tau_orient )   ;   cn_rcv_tau(4) = TRIM( cn_rcv_tau_grid   )
+     
+      ! ================================ !
+      !   Define the receive interface   !
+      ! ================================ !
+      nrcvinfo(:) = PRISM_NotDef   ! needed by nrcvinfo(jpr_otx1) if we do not receive ocea stress 
+
+      ! for each field: define the OASIS name                              (srcv(:)%clname)
+      !                 define receive or not from the namelist parameters (srcv(:)%laction)
+      !                 define the north fold type of lbc                  (srcv(:)%nsgn)
+
+      ! default definitions of srcv
+      srcv(:)%laction = .FALSE.   ;   srcv(:)%clgrid = 'T'   ;   srcv(:)%nsgn = 1
+
+      !                                                      ! ------------------------- !
+      !                                                      ! ice and ocean wind stress !   
+      !                                                      ! ------------------------- !
+      !                                                           ! Name 
+      srcv(jpr_otx1)%clname = 'O_OTaux1'      ! 1st ocean component on grid ONE (T or U)
+      srcv(jpr_oty1)%clname = 'O_OTauy1'      ! 2nd   -      -         -     - 
+      srcv(jpr_otz1)%clname = 'O_OTauz1'      ! 3rd   -      -         -     - 
+      srcv(jpr_otx2)%clname = 'O_OTaux2'      ! 1st ocean component on grid TWO (V)
+      srcv(jpr_oty2)%clname = 'O_OTauy2'      ! 2nd   -      -         -     - 
+      srcv(jpr_otz2)%clname = 'O_OTauz2'      ! 3rd   -      -         -     - 
+      !
+      srcv(jpr_itx1)%clname = 'O_ITaux1'      ! 1st  ice  component on grid ONE (T, F, I or U)
+      srcv(jpr_ity1)%clname = 'O_ITauy1'      ! 2nd   -      -         -     - 
+      srcv(jpr_itz1)%clname = 'O_ITauz1'      ! 3rd   -      -         -     - 
+      srcv(jpr_itx2)%clname = 'O_ITaux2'      ! 1st  ice  component on grid TWO (V)
+      srcv(jpr_ity2)%clname = 'O_ITauy2'      ! 2nd   -      -         -     - 
+      srcv(jpr_itz2)%clname = 'O_ITauz2'      ! 3rd   -      -         -     - 
       ! 
-!!gm bug ?  here send instantaneous SST, not mean over the coupling period....
-      var_id = send_id(1)   ;   CALL cpl_prism_send( var_id, date, tn(:,:,1)+rt0, info )   ! ocean surface temperature [K]
-      var_id = send_id(2)   ;   CALL cpl_prism_send( var_id, date, 1.0-frld     , info )   ! fraction of ice-cover
-#if defined key_cpl_albedo
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF( ( tn_ice(ji,jj) < 50 .OR. tn_ice(ji,jj) > 400 ) .AND. frld(ji,jj) < 1. ) THEN
-              WRITE(numout,*) ' tn_ice, ERROR ', ji, jj, ' = ', tn_ice(ji,jj),   &
-                 &            ' qns_ice_recv=', qns_ice_recv(ji,jj), ' dqns_ice_recv=', dqns_ice_recv(ji,jj)
+      srcv(jpr_otx1:jpr_itz2)%nsgn = -1                           ! Vectors: change of sign at north fold
+      
+      !                                                           ! Set grid and action
+      SELECT CASE( TRIM( cn_rcv_tau(4) ) )      !  'T', 'U,V', 'U,V,I', 'U,V,F', 'T,I', 'T,F', or 'T,U,V'
+      CASE( 'T' ) 
+         srcv(jpr_otx1:jpr_itz2)%clgrid  = 'T'        ! oce and ice components given at T-point
+         srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1 
+         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 
+      CASE( 'U,V' ) 
+         srcv(jpr_otx1:jpr_otz1)%clgrid  = 'U'        ! oce components given at U-point
+         srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point
+         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'U'        ! ice components given at U-point
+         srcv(jpr_itx2:jpr_itz2)%clgrid  = 'V'        !           and           V-point
+         srcv(jpr_otx1:jpr_itz2)%laction = .TRUE.     ! receive oce and ice components on both grid 1 & 2
+      CASE( 'U,V,T' )
+         srcv(jpr_otx1:jpr_otz1)%clgrid  = 'U'        ! oce components given at U-point
+         srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point
+         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'T'        ! ice components given at T-point
+         srcv(jpr_otx1:jpr_otz2)%laction = .TRUE.     ! receive oce components on grid 1 & 2
+         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 only
+      CASE( 'U,V,I' )
+         srcv(jpr_otx1:jpr_otz1)%clgrid  = 'U'        ! oce components given at U-point
+         srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point
+         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'I'        ! ice components given at I-point
+         srcv(jpr_otx1:jpr_otz2)%laction = .TRUE.     ! receive oce components on grid 1 & 2
+         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 only
+      CASE( 'U,V,F' )
+         srcv(jpr_otx1:jpr_otz1)%clgrid  = 'U'        ! oce components given at U-point
+         srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point
+         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'F'        ! ice components given at F-point
+         srcv(jpr_otx1:jpr_otz2)%laction = .TRUE.     ! receive oce components on grid 1 & 2
+         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 only
+      CASE( 'T,I' ) 
+         srcv(jpr_otx1:jpr_itz2)%clgrid  = 'T'        ! oce and ice components given at T-point
+         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'I'        ! ice components given at I-point
+         srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1 
+         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 
+      CASE( 'T,F' ) 
+         srcv(jpr_otx1:jpr_itz2)%clgrid  = 'T'        ! oce and ice components given at T-point
+         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'F'        ! ice components given at F-point
+         srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1 
+         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 
+      CASE( 'T,U,V' )
+         srcv(jpr_otx1:jpr_otz1)%clgrid  = 'T'        ! oce components given at T-point
+         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'U'        ! ice components given at U-point
+         srcv(jpr_itx2:jpr_itz2)%clgrid  = 'V'        !           and           V-point
+         srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1 only
+         srcv(jpr_itx1:jpr_itz2)%laction = .TRUE.     ! receive ice components on grid 1 & 2
+      CASE default   
+         CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_tau(4)' )
+      END SELECT
+      !
+      IF( TRIM( cn_rcv_tau(2) ) == 'spherical' )   &           ! spherical: 3rd component not received
+         &     srcv( (/jpr_otz1, jpr_otz2, jpr_itz1, jpr_itz2/) )%laction = .FALSE. 
+      !
+      IF( TRIM( cn_rcv_tau(1) ) /= 'oce and ice' ) THEN        ! 'oce and ice' case ocean stress on ocean mesh used
+         srcv(jpr_itx1:jpr_itz2)%laction = .FALSE.    ! ice components not received
+         srcv(jpr_itx1)%clgrid = 'U'                  ! ocean stress used after its transformation
+         srcv(jpr_ity1)%clgrid = 'V'                  ! i.e. it is always at U- & V-points for i- & j-comp. resp.
+      ENDIF
+       
+      !                                                      ! ------------------------- !
+      !                                                      !    freshwater budget      !   E-P
+      !                                                      ! ------------------------- !
+      ! we suppose that atmosphere modele do not make the difference between precipiration (liquide or solid)
+      ! over ice of free ocean within the same atmospheric cell.cd 
+      srcv(jpr_rain)%clname = 'OTotRain'      ! Rain = liquid precipitation
+      srcv(jpr_snow)%clname = 'OTotSnow'      ! Snow = solid precipitation
+      srcv(jpr_tevp)%clname = 'OTotEvap'      ! total evaporation (over oce + ice sublimation)
+      srcv(jpr_ievp)%clname = 'OIceEvap'      ! evaporation over ice = sublimation
+      srcv(jpr_prsb)%clname = 'OPre-Sub'      ! liquid precipitation + solid precipitation - sublimation
+      srcv(jpr_semp)%clname = 'OISub-Sn'      ! ice solid water budget = sublimation - solid precipitation
+      srcv(jpr_oemp)%clname = 'OOEva-Pr'      ! ocean water budget = ocean Evap - ocean precip
+      SELECT CASE( TRIM( cn_rcv_emp ) )
+      CASE( 'oce only'      )   ;   srcv(                                 jpr_oemp   )%laction = .TRUE. 
+      CASE( 'conservative'  )   ;   srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE.
+      CASE( 'oce and ice'   )   ;   srcv( (/          jpr_prsb, jpr_semp, jpr_oemp/) )%laction = .TRUE.
+      CASE( 'mixed oce-ice' )   ;   srcv( (/jpr_rain,           jpr_semp, jpr_tevp/) )%laction = .TRUE. 
+      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_emp' )
+      END SELECT
+
+      !                                                      ! ------------------------- !
+      !                                                      !     Runoffs & Calving     !   
+      !                                                      ! ------------------------- !
+      srcv(jpr_rnf   )%clname = 'O_Runoff'   ;   IF( TRIM( cn_rcv_rnf ) == 'coupled' )   srcv(jpr_rnf)%laction = .TRUE.
+                                                 IF( TRIM( cn_rcv_rnf ) == 'climato' )   THEN   ;   ln_rnf = .TRUE.
+                                                 ELSE                                           ;   ln_rnf = .FALSE.
+                                                 ENDIF
+      srcv(jpr_cal   )%clname = 'OCalving'   ;   IF( TRIM( cn_rcv_cal ) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE.
+
+      !                                                      ! ------------------------- !
+      !                                                      !    non solar radiation    !   Qns
+      !                                                      ! ------------------------- !
+      srcv(jpr_qnsoce)%clname = 'O_QnsOce'
+      srcv(jpr_qnsice)%clname = 'O_QnsIce'
+      srcv(jpr_qnsmix)%clname = 'O_QnsMix'
+      SELECT CASE( TRIM( cn_rcv_qns ) )
+      CASE( 'oce only'      )   ;   srcv(               jpr_qnsoce   )%laction = .TRUE.
+      CASE( 'conservative'  )   ;   srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE.
+      CASE( 'oce and ice'   )   ;   srcv( (/jpr_qnsice, jpr_qnsoce/) )%laction = .TRUE.
+      CASE( 'mixed oce-ice' )   ;   srcv(               jpr_qnsmix   )%laction = .TRUE. 
+      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_qns' )
+      END SELECT
+
+      !                                                      ! ------------------------- !
+      !                                                      !    solar radiation        !   Qsr
+      !                                                      ! ------------------------- !
+      srcv(jpr_qsroce)%clname = 'O_QsrOce'
+      srcv(jpr_qsrice)%clname = 'O_QsrIce'
+      srcv(jpr_qsrmix)%clname = 'O_QsrMix'
+      SELECT CASE( TRIM( cn_rcv_qsr ) )
+      CASE( 'oce only'      )   ;   srcv(               jpr_qsroce   )%laction = .TRUE.
+      CASE( 'conservative'  )   ;   srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE.
+      CASE( 'oce and ice'   )   ;   srcv( (/jpr_qsrice, jpr_qsroce/) )%laction = .TRUE.
+      CASE( 'mixed oce-ice' )   ;   srcv(               jpr_qsrmix   )%laction = .TRUE. 
+      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_qsr' )
+      END SELECT
+
+      !                                                      ! ------------------------- !
+      !                                                      !   non solar sensitivity   !   d(Qns)/d(T)
+      !                                                      ! ------------------------- !
+      srcv(jpr_dqnsdt)%clname = 'O_dQnsdT'   
+      IF( TRIM( cn_rcv_dqnsdt ) == 'coupled' )   srcv(jpr_dqnsdt)%laction = .TRUE.
+
+      !                                                      ! ------------------------- !
+      !                                                      !    Ice Qsr penetration    !   
+      !                                                      ! ------------------------- !
+      ! 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 )
+      ! 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
+      !                                                      ! ------------------------- !
+      !                                                      !      10m wind module      !   
+      !                                                      ! ------------------------- !
+      srcv(jpr_w10m  )%clname = 'O_Wind10'   ;   IF( TRIM(cn_rcv_w10m) == 'coupled' )   srcv(jpr_w10m)%laction = .TRUE.
+!     ! +++ ---> A brancher et a blinder dans tke  si cn_rcv_w10m == 'none'
+     
+     
+      ! ================================ !
+      !     Define the send interface    !
+      ! ================================ !
+      ! for each field: define the OASIS name                           (srcv(:)%clname)
+      !                 define send or not from the namelist parameters (srcv(:)%laction)
+      !                 define the north fold type of lbc               (srcv(:)%nsgn)
+      
+      ! default definitions of nsnd
+      ssnd(:)%laction = .FALSE.   ;   ssnd(:)%clgrid = 'T'   ;   ssnd(:)%nsgn = 1
+         
+      !                                                      ! ------------------------- !
+      !                                                      !    Surface temperature    !
+      !                                                      ! ------------------------- !
+      ssnd(jps_toce)%clname = 'O_SSTSST'
+      ssnd(jps_tice)%clname = 'O_TepIce'
+      ssnd(jps_tmix)%clname = 'O_TepMix'
+      SELECT CASE( TRIM( cn_snd_temperature ) )
+      CASE( 'oce only'             )   ;   ssnd(   jps_toce             )%laction = .TRUE.
+      CASE( 'weighted oce and ice' )   ;   ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE.
+      CASE( 'mixed oce-ice'        )   ;   ssnd(   jps_tmix             )%laction = .TRUE.
+      END SELECT
+     
+      !                                                      ! ------------------------- !
+      !                                                      !          Albedo           !
+      !                                                      ! ------------------------- !
+      ssnd(jps_albice)%clname = 'O_AlbIce' 
+      ssnd(jps_albmix)%clname = 'O_AlbMix'
+      SELECT CASE( TRIM( cn_snd_albedo ) )
+      CASE( 'none'          )       ! nothing to do
+      CASE( 'weighted ice'  )   ;   ssnd(jps_albice)%laction = .TRUE.
+      CASE( 'mixed oce-ice' )   ;   ssnd(jps_albmix)%laction = .TRUE.
+                                    CALL albedo_oce( zaos, zacs )
+                                    ! Due to lack of information on nebulosity : mean clear/overcast sky
+                                    albedo_oce_mix(:,:) = ( zacs(:,:) + zaos(:,:) ) * 0.5
+      END SELECT
+         
+      !                                                      ! ------------------------- !
+      !                                                      !  Ice fraction & Thickness ! 
+      !                                                      ! ------------------------- !
+      ssnd(jps_fice)%clname = 'OIceFrac'   
+      ssnd(jps_hice)%clname = 'O_IceTck'
+      ssnd(jps_hsnw)%clname = 'O_SnwTck'
+      IF( k_ice /= 0 )   ssnd(jps_fice)%laction = .TRUE.       ! if ice treated in the ocean (even in climato case)
+      IF( TRIM( cn_snd_thickness ) == 'weighted ice and snow' )   ssnd( (/jps_hice, jps_hsnw/) )%laction = .TRUE.
+         
+      !                                                      ! ------------------------- !
+      !                                                      !      Surface current      !
+      !                                                      ! ------------------------- !
+      !        ocean currents              !            ice velocities
+      ssnd(jps_ocx1)%clname = 'O_OCurx1'   ;   ssnd(jps_ivx1)%clname = 'O_IVelx1'
+      ssnd(jps_ocy1)%clname = 'O_OCury1'   ;   ssnd(jps_ivy1)%clname = 'O_IVely1'
+      ssnd(jps_ocz1)%clname = 'O_OCurz1'   ;   ssnd(jps_ivz1)%clname = 'O_IVelz1'
+      !
+      ssnd(jps_ocx1:jps_ivz2)%nsgn = -1    ! vectors: change of the sign at the north fold
+
+      IF( cn_snd_crt(4) /= 'T' )   CALL ctl_stop( 'cn_snd_crt(4) must be equal to T' )
+      ssnd(jps_ocx1:jps_ivz2)%clgrid  = 'T'      ! all oce and ice components on the same unique grid
+      ssnd(jps_ocx1:jps_ocz1)%laction = .TRUE.   ! oce components on 1 grid 
+      ssnd(jps_ivx1:jps_ivz1)%laction = .TRUE.   ! ice components on 1 grid 
+      
+      IF( TRIM( cn_snd_crt(2) ) == 'spherical' )   &                        ! 3rd component not used
+         &     srcv( (/jps_otz1, jps_otz2, jps_itz1, jps_itz2/) )%laction = .FALSE. 
+      !
+      IF( TRIM( cn_snd_crt(1) ) /= 'oce only' .OR. 'oce and ice' )   &      ! ice components not used
+         &     srcv(jps_itx1:jps_itz2)%laction = FALSE.
+
+      SELECT CASE( TRIM( cn_snd_crt(1) ) )
+      CASE( 'none'                 )   ;   ssnd(jps_ocx1:jps_ivz2)%laction = .FALSE.
+      CASE( 'oce only'             )   ;   ssnd(jps_ivx1:jps_ivz2)%laction = .FALSE.
+      CASE( 'weighted oce and ice' )   !   nothing to do
+      CASE( 'mixed oce-ice'        )   ;   ssnd(jps_ivx1:jps_ivz2)%laction = .FALSE.
+      END SELECT
+
+      ! ================================ !
+      !   initialisation of the coupler  !
+      ! ================================ !
+      CALL cpl_prism_define            
+      !
+   END SUBROUTINE sbc_cpl_init
+
+
+   SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice )     
+      !!----------------------------------------------------------------------
+      !!             ***  ROUTINE sbc_cpl_rcv  ***
+      !!
+      !! ** Purpose :   provide the stress over the ocean and, if no sea-ice,
+      !!                provide the ocean heat and freshwater fluxes.
+      !!
+      !! ** Method  : - Receive all the atmospheric fields (stored in frcv array). called at each time step.
+      !!                OASIS controls if there is something do receive or not. nrcvinfo contains the info
+      !!                to know if the field was really received or not
+      !!
+      !!              --> If ocean stress was really received:
+      !!
+      !!                  - transform the received ocean stress vector from the received
+      !!                 referential and grid into an atmosphere-ocean stress in 
+      !!                 the (i,j) ocean referencial and at the ocean velocity point. 
+      !!                    The received stress are :
+      !!                     - defined by 3 components (if cartesian coordinate)
+      !!                            or by 2 components (if spherical)
+      !!                     - oriented along geographical   coordinate (if eastward-northward)
+      !!                            or  along the local grid coordinate (if local grid)
+      !!                     - given at U- and V-point, resp.   if received on 2 grids
+      !!                            or at T-point               if received on 1 grid
+      !!                    Therefore and if necessary, they are successively 
+      !!                  processed in order to obtain them 
+      !!                     first  as  2 components on the sphere 
+      !!                     second as  2 components oriented along the local grid
+      !!                     third  as  2 components on the U,V grid 
+      !!
+      !!              --> 
+      !!
+      !!              - In 'ocean only' case, non solar and solar ocean heat fluxes 
+      !!             and total ocean freshwater fluxes  
+      !!
+      !! ** Method  :   receive all fields from the atmosphere and transform 
+      !!              them into ocean surface boundary condition fields 
+      !!
+      !! ** Action  :   update  utau, vtau   ocean stress at U,V grid 
+      !!                        qns , qsr    non solar and solar ocean heat fluxes   ('ocean only case)
+      !!                        emp = emps   evap. - precip. (- runoffs) (- calving) ('ocean only case)
+      !!                        wind10m      10m wind speed  !!!!gm  to be checked
+      !!----------------------------------------------------------------------
+      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)
+      !!
+      INTEGER  ::   ji, jj, jn             ! dummy loop indices
+      INTEGER  ::   isec                   ! number of seconds since nit000 (assuming rdttra did not change since nit000)
+      REAL(wp) ::   zcumulneg, zcumulpos   ! temporary scalars     
+      REAL(wp), DIMENSION(jpi,jpj) ::   ztx, ztx   ! 2D workspace 
+      !!----------------------------------------------------------------------
+
+      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), nrcvinfo(jn) )
+      END DO
+
+      !                                                      ! ========================= !
+      IF( srcv(jpr_otx1)%laction ) THEN                      !       ocean stress        !
+         !                                                   ! ========================= !
+         ! define frcv(:,:,jpr_otx1) and frcv(:,:,jpr_oty1): stress at U/V point along model grid
+         ! => need to be done only when we receive the field
+         IF(  nrcvinfo(jpr_otx1) == PRISM_Recvd   .OR. nrcvinfo(jpr_otx1) == PRISM_FromRest .OR.   &
+            & nrcvinfo(jpr_otx1) == PRISM_RecvOut .OR. nrcvinfo(jpr_otx1) == PRISM_FromRestOut ) THEN
+            !
+            IF( TRIM( cn_rcv_tau(2) ) == 'cartesian' ) THEN            ! 2 components on the sphere
+               !                                                       ! (cartesian to spherical -> 3 to 2 components)
+               !
+               CALL geo2oce( frcv(:,:,jpr_otx1), frcv(:,:,jpr_oty1), frcv(:,:,jpr_otz1),   &
+                  &          srcv(jpr_otx1)%clgrid, ztx, zty )
+               frcv(:,:,jpr_otx1) = ztx(:,:)   ! overwrite 1st comp. on the 1st grid
+               frcv(:,:,jpr_oty1) = zty(:,:)   ! overwrite 2nd comp. on the 1st grid
+               !
+               IF( srcv(jpr_otx2)%laction ) THEN
+                  CALL geo2oce( frcv(:,:,jpr_otx2), frcv(:,:,jpr_oty2), frcv(:,:,jpr_otz2),   &
+                     &          srcv(jpr_otx2)%clgrid, ztx, zty )
+                  frcv(:,:,jpr_otx2) = ztx(:,:)   ! overwrite 1st comp. on the 2nd grid
+                  frcv(:,:,jpr_oty2) = zty(:,:)   ! overwrite 2nd comp. on the 2nd grid
+               ENDIF
+               !
             ENDIF
-         END DO
-      END DO
-      var_id = send_id(3)   ;   CALL cpl_prism_send( var_id, date, tn_ice      , info )    ! ice surface temperature [K]  
-      var_id = send_id(4)   ;   CALL cpl_prism_send( var_id, date, alb_ice     , info )    ! ice albedo [%]
-#else
-      var_id = send_id(3)   ;   CALL cpl_prism_send( var_id, date, hicif       , info )    ! ice  thickness [m]
-      var_id = send_id(4)   ;   CALL cpl_prism_send( var_id, date, hsnif       , info )    ! snow thickness [m]
-#endif
-#if defined key_cpl_ocevel
-!!gm bug???  I have to check the grid point position...
-!!           a priori there is a error here as un, vn are not at the same grid point....
-!!           there should be a averaged to set u and v at T-point.... with caution for sea-ice velocity at I-point....
-      un_weighted = un(:,:,1) * frld + u_ice * ( 1. - frld )
-      vn_weighted = vn(:,:,1) * frld + v_ice * ( 1. - frld )
-      ikchoix = - 1         ! converte from (i,j) to geographic referential
-      CALL repere( un_weighted, vn_weighted, un_send, vn_send, ikchoix )
-!!gm bug : at lbc_lnk is to be added on un_send and vn_send  
-      var_id = send_id(5)   ;   CALL cpl_prism_send( var_id, date, un_send    , info )        ! surface current [m/s]
-      var_id = send_id(6)   ;   CALL cpl_prism_send( var_id, date, vn_send    , info )        ! surface current [m/s]
-#endif
-
-      !                                         ! =========================== !
-      !                                         !   Recieve Momentum fluxes   !
-      !                                         ! =========================== !
-      ! 
-      ! ... Receive wind stress fields in geographic component over water and ice
-      var_id = recv_id(1)   ;   CALL cpl_prism_recv( var_id, date, ztaueuw, info )           ! ???
-      var_id = recv_id(2)   ;   CALL cpl_prism_recv( var_id, date, ztaunuw, info )
-      var_id = recv_id(3)   ;   CALL cpl_prism_recv( var_id, date, ztaueui, info )
-      var_id = recv_id(4)   ;   CALL cpl_prism_recv( var_id, date, ztaunui, info )
-      var_id = recv_id(5)   ;   CALL cpl_prism_recv( var_id, date, ztauevw, info )
-      var_id = recv_id(6)   ;   CALL cpl_prism_recv( var_id, date, ztaunvw, info )
-      var_id = recv_id(7)   ;   CALL cpl_prism_recv( var_id, date, ztauevi, info )
-      var_id = recv_id(8)   ;   CALL cpl_prism_recv( var_id, date, ztaunvi, info )
-      !
-!!gm bug : keep separate ice and ocean stress !
-      ! ... combine water / ice stresses
-      ztaueu(:,:) = ztaueuw(:,:) * frld(:,:) + ztaueui(:,:) * ( 1.0 - frld(:,:) )
-      ztaunu(:,:) = ztaunuw(:,:) * frld(:,:) + ztaunui(:,:) * ( 1.0 - frld(:,:) )
-      ztauev(:,:) = ztauevw(:,:) * frld(:,:) + ztauevi(:,:) * ( 1.0 - frld(:,:) )
-      ztaunv(:,:) = ztaunvw(:,:) * frld(:,:) + ztaunvi(:,:) * ( 1.0 - frld(:,:) )
-      !
-      ! ... rotate vector components from geographic to (i,j) referential
-      CALL repcmo ( ztaueu, ztaunu, ztauev, ztaunv, utau, vtau, kt )
-      !
-!!gm bug??  not sure but put that for security
-      CALL lbc_lnk( utau , 'U', -1. )
-      CALL lbc_lnk( vtau , 'V', -1. )
-!!gm end bug??
-      !
-      !                                         ! =========================== !
-      !                                         !     Recieve heat fluxes     !
-      !                                         ! =========================== !
-      !
-      var_id = recv_id(13)   ;   CALL cpl_prism_recv( var_id, date, qsr_oce_recv , info )   ! ocean surface net downward shortwave flux
-      var_id = recv_id(14)   ;   CALL cpl_prism_recv( var_id, date, qns_oce_recv , info )   ! ocean surface downward non-solar heat flux
-      var_id = recv_id(15)   ;   CALL cpl_prism_recv( var_id, date, qsr_ice_recv , info )   ! ice solar heat flux
-      var_id = recv_id(16)   ;   CALL cpl_prism_recv( var_id, date, qns_ice_recv , info )   ! ice non-solar heat flux
-      var_id = recv_id(17)   ;   CALL cpl_prism_recv( var_id, date, dqns_ice_recv, info )   ! ice non-solar heat flux sensitivity
-
-      qsr_oce_recv (:,:) = qsr_oce_recv (:,:) * tmask(:,:,1) * zfacflx
-      qns_oce_recv (:,:) = qns_oce_recv (:,:) * tmask(:,:,1) * zfacflx
-      qsr_ice_recv (:,:) = qsr_ice_recv (:,:) * tmask(:,:,1) * zfacflx
-      qns_ice_recv (:,:) = qns_ice_recv (:,:) * tmask(:,:,1) * zfacflx
-      dqns_ice_recv(:,:) = dqns_ice_recv(:,:) * tmask(:,:,1) * zfacflx
-
-      IF( kt == nit000 ) THEN                   ! set once for all qsr penetration in sea-ice
-         !                                      ! Since cloud cover catm not transmitted from atmosphere, it is set to 0. 
-         !                                      ! i.e. constant penetration fractions of 0.18 and 0.82
-         !  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 )
-         fr1_i0_recv(:,:) = 0.18 
-         fr2_i0_recv(:,:) = 0.82
+            !
+            IF( TRIM( cn_rcv_tau(3) ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid
+               !                                                       ! (geographical to local grid -> rotate the components)
+               CALL rot_rep( frcv(:,:,jpr_otx1), frcv(:,:,jpr_oty1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )   
+               frcv(:,:,jpr_otx1) = ztx(:,:)      ! overwrite 1st component on the 1st grid
+               IF( srcv(jpr_otx2)%laction ) THEN
+                  CALL rot_rep( frcv(:,:,jpr_otx2), frcv(:,:,jpr_oty2), srcv(jpr_otx2)%clgrid, 'en->j', zty )   
+               ELSE
+                  CALL rot_rep( frcv(:,:,jpr_otx1), frcv(:,:,jpr_oty1), srcv(jpr_otx1)%clgrid, 'en->j', zty )  
+               ENDIF
+               frcv(:,:,jpr_oty1) = zty(:,:)      ! overwrite 2nd component on the 2nd grid
+            ENDIF
+            !                              
+            IF( srcv(jpr_otx1)%clgrid == 'T' ) THEN
+               DO jj = 2, jpjm1                                          ! T ==> (U,V)
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     frcv(ji,jj,jpr_otx1) = 0.5 * ( frcv(ji+1,jj  ,jpr_otx1) + frcv(ji,jj,jpr_otx1) )
+                     frcv(ji,jj,jpr_oty1) = 0.5 * ( frcv(ji  ,jj+1,jpr_oty1) + frcv(ji,jj,jpr_oty1) )
+                  END DO
+               END DO
+               CALL lbc_lnk( frcv(:,:,jpr_otx1), 'U',  -1. )   ;   CALL lbc_lnk( frcv(:,:,jpr_oty1), 'V',  -1. )
+            ENDIF
+         ENDIF
+         !                                                   ! ========================= !
+      ELSE                                                   !   No dynamical coupling   !
+         !                                                   ! ========================= !
+         frcv(:,:,jpr_otx1) = 0.e0                               ! here simply set to zero 
+         frcv(:,:,jpr_oty1) = 0.e0                               ! an external read in a file can be added instead
+         !
       ENDIF
-      !
-      !                                         ! =========================== !
-      !                                         !  Recieve freshwater fluxes  !
-      !                                         ! =========================== !
-      !
-      var_id = recv_id( 9)   ;   CALL cpl_prism_recv( var_id, date, zpew  , info )      ! P-E over water
-      var_id = recv_id(10)   ;   CALL cpl_prism_recv( var_id, date, zpei  , info )      ! P-E over ice
-      var_id = recv_id(11)   ;   CALL cpl_prism_recv( var_id, date, zpsol , info )      ! Snow fall over water and ice
-      var_id = recv_id(12)   ;   CALL cpl_prism_recv( var_id, date, zevice, info )      ! Evaporation over ice (sublimination)
-      !
-      ! ... calculate water flux (P-E over open ocean and ice) and solid precipitation  (positive upward)
-      tprecip_recv(:,:) = ( zpew (:,:) + zpei  (:,:) ) * tmask(:,:,1) * zfacwat
-      sprecip_recv(:,:) = ( zpsol(:,:) + zevice(:,:) ) * tmask(:,:,1) * zfacwat
       
-      ! ... Control print & check
-      IF(ln_ctl) THEN
-         WRITE(numout,*) ' flx:tprecip_recv    - Minimum value is ', MINVAL( tprecip_recv )
-         WRITE(numout,*) ' flx:tprecip_recv    - Maximum value is ', MAXVAL( tprecip_recv )
-         WRITE(numout,*) ' flx:tprecip_recv    -     Sum value is ', SUM   ( tprecip_recv )
+      ! u(v)tau will be modified by ice model -> need to be reset before each call of the ice/fsbc      
+      IF( MOD( kt-1, k_fsbc ) == 0 ) THEN
+         utau(:,:) = frcv(:,:,jpr_otx1)                   
+         vtau(:,:) = frcv(:,:,jpr_oty1)
       ENDIF
-!!gm bug in mpp SUM require a mmp_sum call
-!!gm further more this test is quite expensive ...  only needed at the first time-step???
-      IF( SUM( zpew*e1t*e2t ) /= SUM( zpew*e1t*e2t*tmask(:,:,1) ) ) THEN
-         WRITE(numout,*) ' flx: Forcing values outside Orca mask'
-         WRITE(numout,*) ' flx: Losses in water conservation'
-         WRITE(numout,*) ' flx:   Masked ', SUM(zpew*e1t*e2t*tmask(:,:,1))
-         WRITE(numout,*) ' flx: Unmasked ', SUM(zpew*e1t*e2t)
-         WRITE(numout,*) ' flx: Simulation STOP'
-         CALL FLUSH(numout)
-         STOP
-      END IF
-      !
-#if defined key_cpl_discharge
-      ! Runoffs
-      var_id = recv_id(18)   ;   CALL cpl_prism_recv ( var_id, date, calving_recv, info )   ! ice discharge into ocean
-      var_id = recv_id(19)   ;   CALL cpl_prism_recv ( var_id, date, zrunriv     , info )   ! river discharge into ocean
-      var_id = recv_id(20)   ;   CALL cpl_prism_recv ( var_id, date, zruncot     , info )   ! continental discharge into ocean
-
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zfact = zfacwat * tmask(ji,jj,1) 
-            calving_recv(ji,jj) =               calving_recv(ji,jj)   * zfact
-            rrunoff_recv(ji,jj) = ( zrunriv(ji,jj) + zruncot(ji,jj) ) * zfact
-         END DO
-      END DO
-#else
-      calving_recv(:,:) = 0.
-      rrunoff_recv(:,:) = 0.
-#endif
-
-!!gm  bug  :  this is not valid in mpp
-!!gm          and I presum this is not required at all as a lbc_lnk is applied to all the fields at the end of the routine
-      ! Oasis mask shift and update lateral boundary conditions (E. Maisonnave)
-      ! not tested when mpp is used, W. Park
-!WSPTEST
-      qsr_oce_recv (jpi-1,:) = qsr_oce_recv (1,:)
-      qsr_ice_recv (jpi-1,:) = qsr_ice_recv (1,:)
-      qns_oce_recv (jpi-1,:) = qns_oce_recv (1,:)
-      qns_ice_recv (jpi-1,:) = qns_ice_recv (1,:)
-      dqns_ice_recv(jpi-1,:) = dqns_ice_recv(1,:)
-      tprecip_recv (jpi-1,:) = tprecip_recv (1,:)
-      sprecip_recv (jpi-1,:) = sprecip_recv (1,:)
-      fr1_i0_recv  (jpi-1,:) = fr1_i0_recv  (1,:)
-      fr2_i0_recv  (jpi-1,:) = fr2_i0_recv  (1,:)
-      rrunoff_recv (jpi-1,:) = rrunoff_recv (1,:)
-      calving_recv (jpi-1,:) = calving_recv (1,:)
-!!gm end bug
-
-      qsr     (:,:) = qsr_oce_recv (:,:)      ! ocean surface boundary condition
-      qns     (:,:) = qns_oce_recv (:,:)
-      emp     (:,:) = zpew         (:,:)
-      emps    (:,:) = zpew         (:,:)
-      
-      qsr_ice (:,:) = qsr_ice_recv (:,:)      ! ice forcing fields
-      qns_ice (:,:) = qns_ice_recv (:,:)
-      dqns_ice(:,:) = dqns_ice_recv(:,:)
-      tprecip (:,:) = tprecip_recv (:,:)
-      sprecip (:,:) = sprecip_recv (:,:)
-      fr1_i0  (:,:) = fr1_i0_recv  (:,:)
-      fr2_i0  (:,:) = fr2_i0_recv  (:,:)
-      
-!WSP    rrunoff = rrunoff_recv 
-!WSP    calving = calving_recv
-      rrunoff (:,:) = 0.e0   !WSP runoff and calving included in tprecip
-      calving (:,:) = 0.e0   !WSP
- 
-      IF(ln_ctl) THEN
-         WRITE(numout,*) 'flx:qsr_oce     - Minimum value is ', MINVAL( qsr_oce )
-         WRITE(numout,*) 'flx:qsr_oce     - Maximum value is ', MAXVAL( qsr_oce )
-         WRITE(numout,*) 'flx:qsr_oce     -     Sum value is ', SUM   ( qsr_oce )
-         !
-         WRITE(numout,*) 'flx:tprecip     - Minimum value is ', MINVAL( tprecip )
-         WRITE(numout,*) 'flx:tprecip     - Maximum value is ', MAXVAL( tprecip )
-         WRITE(numout,*) 'flx:tprecip     -     Sum value is ', SUM   ( tprecip )
+      !                                                      ! ========================= !
+      IF( k_ice <= 1 ) THEN                                 !  heat & freshwater fluxes ! (Ocean only case)
+         !                                                   ! ========================= !
+         !
+         !                                                       ! non solar heat flux over the ocean (qns)
+         IF( srcv(jpr_qnsoce)%laction )   qns(:,:) = frcv(:,:,jpr_qnsoce)
+         IF( srcv(jpr_qnsmix)%laction )   qns(:,:) = frcv(:,:,jpr_qnsmix)        
+         !                                                       ! solar flux over the ocean          (qsr)
+         IF( srcv(jpr_qsroce)%laction )   qsr(:,:) = frcv(:,:,jpr_qsroce) 
+         IF( srcv(jpr_qsrmix)%laction )   qsr(:,:) = frcv(:,:,jpr_qsrmix)
+         !
+         !                                                       ! total freshwater fluxes over the ocean (emp, emps)
+         SELECT CASE( TRIM( cn_rcv_emp ) )                                    ! evaporation - precipitation
+         CASE( 'conservative' )
+            emp(:,:) = frcv(:,:,jpr_tevp) - ( frcv(:,:,jpr_rain) + frcv(:,:,jpr_snow) )
+         CASE( 'mixed oce-ice' )
+            emp(:,:) = frcv(:,:,jpr_tevp) - ( frcv(:,:,jpr_rain) + frcv(:,:,jpr_semp) )
+         CASE( 'ocean only', 'oce and ice' )
+            emp(:,:) = frcv(:,:,jpr_oemp)
+         END SELECT
+         !
+         !                                                        ! runoffs and calving (added in emp)
+         IF( srcv(jpr_rnf)%laction )   emp(:,:) = emp(:,:) -      frcv(:,:,jpr_rnf)        
+         IF( srcv(jpr_cal)%laction )   emp(:,:) = emp(:,:) - ABS( frcv(:,:,jpr_cal) )      
+         !
+!!gm :  this seems to be internal cooking, not sure to need that in a generic interface 
+!!gm                                       at least should be optional...
+!!         IF( TRIM( cn_rcv_rnf ) == 'coupled' ) THEN     ! add to the total freshwater budget
+!!            ! remove negative runoff
+!!            zcumulpos = SUM( MAX( frcv(:,:,jpr_rnf), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
+!!            zcumulneg = SUM( MIN( frcv(:,:,jpr_rnf), 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) = MAX( frcv(:,:,jpr_rnf), 0.e0 ) * zcumulneg
+!!            ENDIF     
+!!            ! add runoff to e-p 
+!!            emp(:,:) = emp(:,:) - frcv(:,:,jpr_rnf)
+!!         ENDIF
+!!gm  end of internal cooking
+         !
+         emps(:,:) = emp(:,:)                                        ! concentration/dilution = emp
+
+         !                                                       ! 10 m wind speed
+         IF( srcv(jpr_w10m)%laction )   wind10m(:,:) = frcv(:,:,jpr_w10m)
+!!gm ---> blinder dans tke  si cn_rcv_w10m == 'none'
+         !
       ENDIF
-
-      CALL lbc_lnk( qsr_oce , 'T', 1. )
-      CALL lbc_lnk( qsr_ice , 'T', 1. )
-      CALL lbc_lnk( qns_oce , 'T', 1. )
-      CALL lbc_lnk( qns_ice , 'T', 1. )
-      CALL lbc_lnk( tprecip , 'T', 1. )
-      CALL lbc_lnk( sprecip , 'T', 1. )
-      CALL lbc_lnk( rrunoff , 'T', 1. )
-      CALL lbc_lnk( dqns_ice, 'T', 1. )
-      CALL lbc_lnk( calving , 'T', 1. )
-      CALL lbc_lnk( fr1_i0  , 'T', 1. )
-      CALL lbc_lnk( fr2_i0  , 'T', 1. )
-
-      IF(ln_ctl) THEN
-         WRITE(numout,*) 'flx(af lbc_lnk):qsr_oce     - Minimum value is ', MINVAL( qsr_oce )
-         WRITE(numout,*) 'flx(af lbc_lnk):qsr_oce     - Maximum value is ', MAXVAL( qsr_oce )
-         WRITE(numout,*) 'flx(af lbc_lnk):qsr_oce     -     Sum value is ', SUM   ( qsr_oce )
-         !
-         WRITE(numout,*) 'flx(af lbc_lnk):tprecip     - Minimum value is ', MINVAL( tprecip )
-         WRITE(numout,*) 'flx(af lbc_lnk):tprecip     - Maximum value is ', MAXVAL( tprecip )
-         WRITE(numout,*) 'flx(af lbc_lnk):tprecip     -     Sum value is ', SUM   ( tprecip )
+      !
+   END SUBROUTINE sbc_cpl_rcv
+   
+
+   SUBROUTINE sbc_cpl_ice_tau( p_taui, p_tauj )     
+      !!----------------------------------------------------------------------
+      !!             ***  ROUTINE sbc_cpl_ice_tau  ***
+      !!
+      !! ** Purpose :   provide the stress over sea-ice in coupled mode 
+      !!
+      !! ** Method  :   transform the received stress from the atmosphere into
+      !!             an atmosphere-ice stress in the (i,j) ocean referencial
+      !!             and at the velocity point of the sea-ice model (cice_grid):
+      !!                'C'-grid : i- (j-) components given at U- (V-) point 
+      !!                'B'-grid : both components given at I-point 
+      !!
+      !!                The received stress are :
+      !!                 - defined by 3 components (if cartesian coordinate)
+      !!                        or by 2 components (if spherical)
+      !!                 - oriented along geographical   coordinate (if eastward-northward)
+      !!                        or  along the local grid coordinate (if local grid)
+      !!                 - given at U- and V-point, resp.   if received on 2 grids
+      !!                        or at a same point (T or I) if received on 1 grid
+      !!                Therefore and if necessary, they are successively 
+      !!             processed in order to obtain them 
+      !!                 first  as  2 components on the sphere 
+      !!                 second as  2 components oriented along the local grid
+      !!                 third  as  2 components on the cice_grid point 
+      !!
+      !!                In 'oce and ice' case, only one vector stress field 
+      !!             is received. It has already been processed in sbc_cpl_rcv
+      !!             so that it is now defined as (i,j) components given at U-
+      !!             and V-points, respectively. Therefore, here only the third
+      !!             transformation is done and only if the ice-grid is a 'B'-grid. 
+      !!
+      !! ** Action  :   return ptau_i, ptau_j, the stress over the ice at cice_grid point
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::   p_taui   ! i- & j-components of atmos-ice stress [N/m2]
+      REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::   p_tauj   ! at I-point (B-grid) or U & V-point (C-grid)
+      !!
+      INTEGER ::   ji, jj                          ! dummy loop indices
+      INTEGER ::   itx                             ! index of taux over ice
+      REAL(wp), DIMENSION(jpi,jpj) ::   ztx, ztx   ! 2D workspace
+      !!----------------------------------------------------------------------
+
+      IF( srcv(jpr_itx1)%laction ) THEN   ;   itx =  jpr_itx1   
+      ELSE                                ;   itx =  jpr_otx1
       ENDIF
-      !
-   END SUBROUTINE sbc_cpl
-
+
+      ! do something only if we just received the stress from atmosphere
+      IF(  nrcvinfo(itx) == PRISM_Recvd   .OR. nrcvinfo(itx) == PRISM_FromRest .OR.   &
+         & nrcvinfo(itx) == PRISM_RecvOut .OR. nrcvinfo(itx) == PRISM_FromRestOut ) THEN
+
+         !                                                      ! ======================= !
+         IF( srcv(jpr_itx1)%laction ) THEN                      !   ice stress received   !
+            !                                                   ! ======================= !
+            !  
+            IF( TRIM( cn_rcv_tau(2) ) == 'cartesian' ) THEN            ! 2 components on the sphere
+               !                                                       ! (cartesian to spherical -> 3 to 2 components)
+               CALL geo2oce( frcv(:,:,jpr_itx1), frcv(:,:,jpr_ity1), frcv(:,:,jpr_itz1),   &
+                  &          srcv(jpr_itx1)%clgrid, ztx, zty )
+               frcv(:,:,jpr_itx1) = ztx(:,:)   ! overwrite 1st comp. on the 1st grid
+               frcv(:,:,jpr_itx1) = zty(:,:)   ! overwrite 2nd comp. on the 1st grid
+               !
+               IF( srcv(jpr_itx2)%laction ) THEN
+                  CALL geo2oce( frcv(:,:,jpr_itx2), frcv(:,:,jpr_ity2), frcv(:,:,jpr_itz2),   &
+                     &          srcv(jpr_itx2)%clgrid, ztx, zty )
+                  frcv(:,:,jpr_itx2) = ztx(:,:)   ! overwrite 1st comp. on the 2nd grid
+                  frcv(:,:,jpr_ity2) = zty(:,:)   ! overwrite 2nd comp. on the 2nd grid
+               ENDIF
+               !
+            ENDIF
+            !
+            IF( TRIM( cn_rcv_tau(3) ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid
+               !                                                       ! (geographical to local grid -> rotate the components)
+               CALL rot_rep( frcv(:,:,jpr_itx1), frcv(:,:,jpr_ity1), srcv(jpr_itx1)%clgrid, 'en->i', ztx )   
+               frcv(:,:,jpr_itx1) = ztx(:,:)      ! overwrite 1st component on the 1st grid
+               IF( srcv(jpr_itx2)%laction ) THEN
+                  CALL rot_rep( frcv(:,:,jpr_itx2), frcv(:,:,jpr_ity2), srcv(jpr_itx2)%clgrid, 'en->j', zty )   
+               ELSE
+                  CALL rot_rep( frcv(:,:,jpr_itx1), frcv(:,:,jpr_ity1), srcv(jpr_itx1)%clgrid, 'en->j', zty )  
+               ENDIF
+               frcv(:,:,jpr_ity1) = zty(:,:)      ! overwrite 2nd component on the 1st grid
+            ENDIF
+            !                                                   ! ======================= !
+         ELSE                                                   !     use ocean stress    !
+            !                                                   ! ======================= !
+            frcv(:,:,jpr_itx1) = frcv(:,:,jpr_otx1)
+            frcv(:,:,jpr_ity1) = frcv(:,:,jpr_oty1)
+            !
+         ENDIF
+
+         !                                                      ! ======================= !
+         !                                                      !     put on ice grid     !
+         !                                                      ! ======================= !
+         !    
+         !                                                  j+1   j     -----V---F
+         ! ice stress on ice velocity point (cice_grid)                  !       |
+         ! (C-grid ==>(U,V) or B-grid ==> I)                      j      |   T   U
+         !                                                               |       |
+         !                                                   j    j-1   -I-------|
+         !                                               (for I)         |       |
+         !                                                              i-1  i   i
+         !                                                               i      i+1 (for I)
+         SELECT CASE ( cice_grid )
+            !
+         CASE( 'B' )                                         ! B-grid ==> I
+            SELECT CASE ( srcv(jpr_itx1)%clgrid )
+            CASE( 'U' )
+               DO jj = 2, jpjm1                                   ! (U,V) ==> I
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     p_taui(ji,jj) = 0.5 * ( frcv(ji-1,jj  ,jpr_itx1) + frcv(ji-1,jj-1,jpr_itx1) )
+                     p_tauj(ji,jj) = 0.5 * ( frcv(ji  ,jj-1,jpr_ity1) + frcv(ji-1,jj-1,jpr_ity1) )
+                  END DO
+               END DO
+            CASE( 'F' )
+               DO jj = 2, jpjm1                                   ! F ==> I
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     p_taui(ji,jj) = frcv(ji-1,jj-1,jpr_itx1) 
+                     p_tauj(ji,jj) = frcv(ji-1,jj-1,jpr_ity1)  
+                  END DO
+               END DO
+            CASE( 'T' )
+               DO jj = 2, jpjm1                                   ! T ==> I
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     p_taui(ji,jj) = 0.25 * ( frcv(ji,jj  ,jpr_itx1) + frcv(ji-1,jj  ,jpr_itx1)   &
+                        &                   + frcv(ji,jj-1,jpr_itx1) + frcv(ji-1,jj-1,jpr_itx1) ) 
+                     p_tauj(ji,jj) = 0.25 * ( frcv(ji,jj  ,jpr_ity1) + frcv(ji-1,jj  ,jpr_ity1)   &
+                        &                   + frcv(ji,jj-1,jpr_ity1) + frcv(ji-1,jj-1,jpr_ity1) )
+                  END DO
+               END DO
+            CASE( 'I' )
+               p_taui(:,:) = frcv(:,:,jpr_itx1)                   ! I ==> I
+               p_tauj(:,:) = frcv(:,:,jpr_ity1)
+            END SELECT
+            IF( srcv(jpr_itx1)%clgrid /= 'I' ) THEN 
+               CALL lbc_lnk( p_taui, 'I',  -1. )   ;   CALL lbc_lnk( p_tauj, 'I',  -1. )
+            ENDIF
+            !
+         CASE( 'C' )                                         ! C-grid ==> U,V
+            SELECT CASE ( srcv(jpr_itx1)%clgrid )
+            CASE( 'U' )
+               p_taui(:,:) = frcv(:,:,jpr_itx1)                   ! (U,V) ==> (U,V)
+               p_tauj(:,:) = frcv(:,:,jpr_ity1)
+            CASE( 'F' )
+               DO jj = 2, jpjm1                                   ! F ==> (U,V)
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     p_taui(ji,jj) = 0.5 * ( frcv(ji,jj,jpr_itx1) + frcv(ji  ,jj-1,jpr_itx1) )
+                     p_tauj(ji,jj) = 0.5 * ( frcv(ji,jj,jpr_ity1) + frcv(ji-1,jj  ,jpr_ity1) )
+                  END DO
+               END DO
+            CASE( 'T' )
+               DO jj = 2, jpjm1                                   ! T ==> (U,V)
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     p_taui(ji,jj) = 0.5 * ( frcv(ji+1,jj  ,jpr_itx1) + frcv(ji,jj,jpr_itx1) )
+                     p_tauj(ji,jj) = 0.5 * ( frcv(ji  ,jj+1,jpr_ity1) + frcv(ji,jj,jpr_ity1) )
+                  END DO
+               END DO
+            CASE( 'I' )
+               DO jj = 2, jpjm1                                   ! I ==> (U,V)
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     p_taui(ji,jj) = 0.5 * ( frcv(ji+1,jj+1,jpr_itx1) + frcv(ji+1,jj  ,jpr_itx1) )
+                     p_tauj(ji,jj) = 0.5 * ( frcv(ji+1,jj+1,jpr_ity1) + frcv(ji  ,jj+1,jpr_ity1) )
+                  END DO
+               END DO
+            END SELECT
+            IF( srcv(jpr_itx1)%clgrid /= 'U' ) THEN 
+               CALL lbc_lnk( p_taui, 'U',  -1. )   ;   CALL lbc_lnk( p_tauj, 'V',  -1. )
+            ENDIF
+         END SELECT
+
+         !!gm Should be useless as sbc_cpl_ice_tau only called at coupled frequency
+         ! The receive stress are transformed such that in all case frcv(:,:,jpr_itx1), frcv(:,:,jpr_ity1)
+         ! become the i-component and j-component of the stress at the right grid point 
+         !!gm  frcv(:,:,jpr_itx1) = p_taui(:,:)
+         !!gm  frcv(:,:,jpr_ity1) = p_tauj(:,:)
+         !!gm
+      ENDIF
+      !   
+   END SUBROUTINE sbc_cpl_ice_tau
+   
+
+   SUBROUTINE sbc_cpl_ice_flx( p_frld, palbi   , psst    , pist,   &
+      &                                pqns_tot, pqns_ice,         &
+      &                                pqsr_tot, pqsr_ice,         &
+      &                                pemp_tot, pemp_ice, psprecip )
+      !!----------------------------------------------------------------------
+      !!             ***  ROUTINE sbc_cpl_ice_flx_rcv  ***
+      !!
+      !! ** Purpose :   provide the heat and freshwater fluxes of the 
+      !!              ocean-ice system.
+      !!
+      !! ** Method  :   transform the fields received from the atmosphere into
+      !!             surface heat and fresh water boundary condition for the 
+      !!             ice-ocean system. The following fields are provided:
+      !!              * total non solar, solar and freshwater fluxes (qns_tot, 
+      !!             qsr_tot and emp_tot) (total means weighted ice-ocean flux)
+      !!             NB: emp_tot include runoffs and calving.
+      !!              * fluxes over ice (qns_ice, qsr_ice, emp_ice) where
+      !!             emp_ice = sublimation - solid precipitation as liquid
+      !!             precipitation are re-routed directly to the ocean and 
+      !!             runoffs and calving directly enter the ocean.
+      !!              * solid precipitation (sprecip), used to add to qns_tot 
+      !!             the heat lost associated to melting solid precipitation
+      !!             over the ocean fraction.
+      !!       ===>> CAUTION here this changes the net heat flux received from
+      !!             the atmosphere
+      !!              * 10m wind module (wind10m)   
+      !!
+      !!             N.B. - fields over sea-ice are passed in argument so that
+      !!                 the module can be compile without sea-ice.
+      !!                  - the fluxes have been separated from the stress as
+      !!                 (a) they are updated at each ice time step compare to
+      !!                 an update at each coupled time step for the stress, and
+      !!                 (b) the conservative computation of the fluxes over the
+      !!                 sea-ice area requires the knowledge of the ice fraction
+      !!                 after the ice advection and before the ice thermodynamics,
+      !!                 so that the stress is updated before the ice dynamics
+      !!                 while the fluxes are updated after it.
+      !!
+      !! ** Action  :   update at each nf_ice time step:
+      !!                   pqns_tot, pqsr_tot  non-solar and solar total heat fluxes
+      !!                   pqns_ice, pqsr_ice  non-solar and solar heat fluxes over the ice
+      !!                   pemp_tot            total evaporation - precipitation(liquid and solid) (-runoff)(-calving)
+      !!                   pemp_ice            ice sublimation - solid precipitation over the ice
+      !!                   sprecip             solid precipitation over the ocean   
+      !!                   wind10m             10m wind module
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   p_frld     ! lead fraction                [0 to 1]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   palbi      ! ice albedo
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   psst       ! sea surface temperature      [Celcius]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   pist       ! ice surface temperature      [Celcius]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   pqns_tot   ! total non solar heat flux    [W/m2]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   pqns_ice   ! ice   non solar heat flux    [W/m2]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   pqsr_tot   ! total     solar heat flux    [W/m2]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   pqsr_ice   ! ice       solar heat flux    [W/m2]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   pemp_tot   ! total     freshwater budget  [Kg/m2/s]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   pemp_ice   ! ice solid freshwater budget  [Kg/m2/s]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   psprecip   ! solid precipitation          [Kg/m2/s]
+     !!
+      INTEGER ::   ji, jj           ! dummy loop indices
+      INTEGER ::   isec, info       ! temporary integer
+      REAL(wp)::   zcoef, ztsurf    ! temporary scalar
+      REAL(wp), DIMENSION(jpi,jpj) ::   ztx, ztx   ! 2D workspace
+      !!----------------------------------------------------------------------
+      !
+      !                                                      ! ========================= !
+      !                                                      !    freshwater budget      !   (emp)
+      !                                                      ! ========================= !
+      !
+      !                                                           ! total Precipitations - total Evaporation (emp_tot)
+      !                                                           ! solid precipitation  - sublimation       (emp_ice)
+      !                                                           ! solid Precipitation                      (sprecip)
+      SELECT CASE( TRIM( cn_rcv_emp ) )
+      CASE( 'conservative'  )   ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp
+         pemp_tot(:,:) = frcv(:,:,jpr_tevp) - frcv(:,:,jpr_rain) - frcv(:,:,jpr_snow)
+         pemp_ice(:,:) = frcv(:,:,jpr_ievp) - frcv(:,:,jpr_snow)
+         psprecip(:,:) = frcv(:,:,jpr_snow)
+      CASE( 'oce and ice'   )   ! received fields: jpr_prsb, jpr_semp, jpr_oemp
+         pemp_tot(:,:) = p_frld(:,:) * frcv(:,:,jpr_oemp) + (1.- p_frld(:,:)) * frcv(:,:,jpr_semp) !!sm: rain over ice is missing??
+         pemp_ice(:,:) = frcv(:,:,jpr_semp)
+         psprecip(:,:) = frcv(:,:,jpr_semp)                            !!gm here error due to sublimation
+      CASE( 'mixed oce-ice' )   ! received fields: jpr_rain, jpr_semp, jpr_tevp
+         pemp_tot(:,:) = frcv(:,:,jpr_tevp) - frcv(:,:,jpr_rain) + frcv(:,:,jpr_semp)       !!gm here sublimation error  ???
+         pemp_ice(:,:) = frcv(:,:,jpr_semp)
+         psprecip(:,:) = frcv(:,:,jpr_semp)                            !!gm here error due to sublimation
+      END SELECT
+      !   
+
+      !                                                           ! runoffs and calving (put in emp_tot)
+      IF( srcv(jpr_rnf)%laction )   pemp_tot(:,:) = pemp_tot(:,:) -      frcv(:,:,jpr_rnf)
+      IF( srcv(jpr_cal)%laction )   pemp_tot(:,:) = pemp_tot(:,:) - ABS( frcv(:,:,jpr_cal) )
+      !
+!!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), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
+!!       zcumulneg = SUM( MIN( frcv(:,:,jpr_rnf), 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) = MAX( frcv(:,:,jpr_rnf), 0.e0 ) * zcumulneg
+!!       ENDIF     
+!!       pemp_tot(:,:) = pemp_tot(:,:) - frcv(:,:,jpr_rnf)   ! add runoff to e-p 
+!!
+!!gm  end of internal cooking
+
+
+      !                                                      ! ========================= !
+      SELECT CASE( TRIM( cn_rcv_qns ) )                      !   non solar heat fluxes   !   (qns)
+      !                                                      ! ========================= !
+      CASE( 'conservative' )                                      ! the required fields are directly provided
+         pqns_tot(:,:) = frcv(:,:,jpr_qnsmix)
+         pqns_ice(:,:) = frcv(:,:,jpr_qnsice)
+      CASE( 'oce and ice' )       ! the total flux is computed from ocean and ice fluxes
+         pqns_tot(:,:) =  p_frld(:,:) * frcv(:,:,jpr_qnsoce) + ( 1.- p_frld(:,:) ) * frcv(:,:,jpr_qnsice)
+         pqns_ice(:,:) =  frcv(:,:,jpr_qnsice)
+      CASE( 'mixed oce-ice' )     ! the ice flux is cumputed from the total flux, the SST and ice informations
+         pqns_tot(:,:) = frcv(:,:,jpr_qnsmix)
+         pqns_ice(:,:) = frcv(:,:,jpr_qnsmix)    &
+            &          + frcv(:,:,jpr_dqnsdt) * ( pist(:,:) - psst(:,:) ) * ( 1. - p_frld(:,:) )
+      END SELECT
+      !                                                           ! snow melting heat flux ....
+      !   energy for melting solid precipitation over free ocean
+      zcoef = xlsn / rhosn
+      pqns_tot(:,:) = pqns_tot(:,:) - p_frld(:,:) * psprecip(:,:) * zcoef  
+!!gm
+!!    currently it is taken into account in leads budget but not in the qns_tot, and thus not in 
+!!    the flux that enter the ocean....
+!!    moreover 1 - it is not diagnose anywhere.... 
+!!             2 - it is unclear for me whether this heat lost is taken into account in the atmosphere or not...
+!!
+!! similar job should be done for snow and precipitation temperature
+
+      !                                                      ! ========================= !
+      SELECT CASE( TRIM( cn_rcv_qsr ) )                      !      solar heat fluxes    !   (qsr)
+      !                                                      ! ========================= !
+      CASE( 'conservative' )
+         pqsr_tot(:,:) = frcv(:,:,jpr_qsrmix)
+         pqsr_ice(:,:) = frcv(:,:,jpr_qsrice)
+      CASE( 'oce and ice' )
+         pqsr_tot(:,:) =  p_frld(:,:) * frcv(:,:,jpr_qsroce) + ( 1.- p_frld(:,:) ) * frcv(:,:,jpr_qsrice)
+         pqsr_ice(:,:) =  frcv(:,:,jpr_qsrice)
+      CASE( 'mixed oce-ice' )
+         pqsr_tot(:,:) = frcv(:,:,jpr_qsrmix)
+!!gm  cpl_albedo ???? kezako ?????   je pige pas grand chose ici....
+         pqsr_ice(:,:) = qsr_mix(:,:) * ( 1.- palbi(:,:) )   &
+            &          / (  1.- ( cpl_ocean_albedo(ji,jj) * ( 1.- p_frld(ji,jj) )   &
+            &                   + palbi           (ji,jj) *       p_frld(ji,jj)   )  )
+      END SELECT
+
+
+      !                                                      ! ========================= !
+      !                                                      !      10 m wind speed      !   (wind10m)
+      !                                                      ! ========================= !
+      !
+      IF( srcv(jpr_w10m  )%laction )   wind10m(:,:) = frcv(:,:,jpr_w10m)
+!!gm ---> blinder dans tke  si cn_rcv_w10m == 'none'
+      !
+   END SUBROUTINE sbc_cpl_ice_flx_rcv
+   
+   
+   SUBROUTINE sbc_cpl_snd( kt )
+      !!----------------------------------------------------------------------
+      !!             ***  ROUTINE sbc_cpl_snd  ***
+      !!
+      !! ** Purpose :   provide the ocean-ice informations to the atmosphere
+      !!
+      !! ** Method  :   send to the atmosphere through a call to cpl_prism_snd
+      !!              all the needed fields (as defined in sbc_cpl_init)
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt
+      !!
+      INTEGER ::   ji, jj          ! dummy loop indices
+      INTEGER ::   isec, info      ! temporary integer
+      REAL(wp), DIMENSION(jpi,jpj) ::   zfr_l   ! 1. - fr_i(:,:)
+      REAL(wp), DIMENSION(jpi,jpj) ::   ztmp1, ztmp2
+      REAL(wp), DIMENSION(jpi,jpj) ::   zotx1 , zoty1 , zotz1, zitx1, zity1, zitz1
+      !!----------------------------------------------------------------------
+
+      isec = ( kt - nit000 ) * NINT(rdttra(1))        ! date of exchanges
+
+      zfr_l(:,:) = 1.- fr_i(:,:)
+
+      !                                                      ! ------------------------- !
+      !                                                      !    Surface temperature    !   in Kelvin
+      !                                                      ! ------------------------- !
+      SELECT CASE( cn_snd_temperature)
+      CASE( 'oce only'             )   ;   ztmp1(:,:) =   tn(:,:,1) + rt0
+      CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( tn(:,:,1) + rt0 ) * zfr_l(:,:)   
+                                           ztmp2(:,:) =   tn_ice(:,:)       *  fr_i(:,:)
+      CASE( 'mixed oce-ice'        )   ;   ztmp1(:,:) = ( tn(:,:,1) + rt0 ) * zfr_l(:,:) + tn_ice(:,:) * fr_i(:,:)
+      END SELECT
+      IF( ssnd(jps_toce)%laction )   CALL cpl_prism_snd( jps_toce, isec, ztmp1, info )
+      IF( ssnd(jps_tice)%laction )   CALL cpl_prism_snd( jps_tice, isec, ztmp2, info )
+      IF( ssnd(jps_tmix)%laction )   CALL cpl_prism_snd( jps_tmix, isec, ztmp1, info )
+      !
+      !                                                      ! ------------------------- !
+      !                                                      !           Albedo          !
+      !                                                      ! ------------------------- !
+      IF( ssnd(jps_albice)%laction ) THEN                         ! ice 
+         ztmp(:,:) = alb_ice(:,:) * fr_i(:,:)
+         CALL cpl_prism_snd( jps_albice, isec, ztmp, info )
+      ENDIF
+      IF( ssnd(jps_albmix)%laction ) THEN                         ! mixed ice-ocean
+         ztmp(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:) + alb_ice(:,:) * fr_i(:,:)
+         CALL cpl_prism_snd( jps_albmix, isec, ztmp, info )
+      ENDIF
+      !                                                      ! ------------------------- !
+      !                                                      !  Ice fraction & Thickness ! 
+      !                                                      ! ------------------------- !
+      IF( ssnd(jps_fice)%laction )   CALL cpl_prism_snd( jps_fice, isec, fr_i                 , info )
+      IF( ssnd(jps_hice)%laction )   CALL cpl_prism_snd( jps_hice, isec, hice(:,:) * fr_i(:,:), info )
+      IF( ssnd(jps_hsnw)%laction )   CALL cpl_prism_snd( jps_hsnw, isec, hsnw(:,:) * fr_i(:,:), info )
+      !
+      !                                                      ! ------------------------- !
+      IF( ssnd(jps_ocx1)%laction ) THEN                      !      Surface current      !
+         !                                                   ! ------------------------- !
+         SELECT CASE( TRIM( cn_snd_crt(1) ) )
+         CASE( 'oce only'             )
+            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) + un(ji  ,jj-1,1) ) 
+               END DO
+            END DO
+         CASE( 'weighted oce and ice' )   
+            IF( cice_grid = 'C' ) THEN      ! 'C'-grid ice velocity
+               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(:,:)  
+                     zoty1(ji,jj) = 0.5 * ( vn       (ji,jj,1) + un       (ji  ,jj-1,1) ) * zfr_l(:,:)
+                     zitx1(ji,jj) = 0.5 * ( utaui_ice(ji,jj)   + utaui_ice(ji-1,jj  )   ) *  fr_i(:,:)
+                     zity1(ji,jj) = 0.5 * ( vtaui_ice(ji,jj)   + vtaui_ice(ji  ,jj-1)   ) *  fr_i(:,:)
+                  END DO
+               END DO
+            ELSE                            ! 'B'-grid ice velocity
+               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,1)    ) * zfr_l(:,:)  
+                     zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)          + un(ji  ,jj-1,1)    ) * zfr_l(:,:)  
+                     zitx1(ji,jj) = 0.25 * ( utaui_ice(ji+1,jj+1) + utaui_ice(ji,jj+1)   &
+                        &                  + utaui_ice(ji+1,jj  ) + utaui_ice(ji,jj  ) ) * fr_i(:,:)
+                     zity1(ji,jj) = 0.25 * ( vtaui_ice(ji+1,jj+1) + vtaui_ice(ji,jj+1)   &
+                        &                  + vtaui_ice(ji+1,jj  ) + vtaui_ice(ji,jj  ) ) * fr_i(:,:)
+                  END DO
+               END DO
+            ENDIF
+            CALL lbc_lnk( zitx1, 'T', -1. )   ;   CALL lbc_lnk( zity1, 'T', -1. )
+         CASE( 'mixed oce-ice'        )
+            IF( cice_grid = 'C' ) THEN      ! 'C'-grid ice velocity
+               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(:,:)
+                     &            + 0.5 * ( utaui_ice(ji,jj)   + utaui_ice(ji-1,jj  )   ) *  fr_i(:,:)
+                     zoty1(ji,jj) = 0.5 * ( vn       (ji,jj,1) + un       (ji  ,jj-1,1) ) * zfr_l(:,:)
+                     &            + 0.5 * ( vtaui_ice(ji,jj)   + vtaui_ice(ji  ,jj-1)   ) *  fr_i(:,:)
+                  END DO
+               END DO
+            ELSE                            ! 'B'-grid ice velocity
+               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,1)    ) * zfr_l(:,:)    
+                     &            + 0.25 * ( utaui_ice(ji+1,jj+1) + utaui_ice(ji,jj+1)   &
+                        &                  + utaui_ice(ji+1,jj  ) + utaui_ice(ji,jj  ) ) *  fr_i(:,:)
+                     zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)          + un(ji  ,jj-1,1)    ) * zfr_l(:,:)  
+                     &            + 0.25 * ( vtaui_ice(ji+1,jj+1) + vtaui_ice(ji,jj+1)   &
+                        &                  + vtaui_ice(ji+1,jj  ) + vtaui_ice(ji,jj  ) ) *  fr_i(:,:)
+                  END DO
+               END DO
+            ENDIF
+         END SELECT
+         CALL lbc_lnk( zotx1, 'T', -1. )   ;   CALL lbc_lnk( zoty1, 'T', -1. )
+         !
+         !
+         IF( TRIM( cn_snd_crt(3) ) == 'eastward-northward' ) THEN             ! Rotation of the components
+            !                                                                     ! Ocean component
+            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 )       ! 1st component 
+            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 )       ! 2nd component 
+            zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components 
+            zoty1(:,:) = ztmp2(:,:)
+            IF( ssnd(jps_ivx1)%laction ) THEN                                     ! Ice component
+               CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component 
+               CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component 
+               zitx1(:,:) = ztmp1(:,:)                                                ! overwrite the components 
+               zity1(:,:) = ztmp2(:,:)
+            ENDIF
+         ENDIF
+         !
+         !!gm  Eric : Arnaud, je te laisse coder oce2geo !     
+         ! spherical coordinates to cartesian -> 2 components to 3 components
+         IF( TRIM( cn_snd_crt(2) ) == 'cartesian' ) THEN
+            ztmp1(:,:) = zotx1(:,:)                     ! ocean currents
+            ztmp2(:,:) = zoty1(:,:)
+            CALL oce2geo ( ztmp1, ztmp2, 't', glamt, gphit, zotx1, zoty1, zotz1 )
+            !
+            IF( ssnd(jps_ivx1)%laction ) THEN           ! ice velocities
+               ztmp1(:,:) = zitx1(:,:)
+               ztmp1(:,:) = zity1(:,:)
+               CALL oce2geo ( ztmp1, ztmp2, 't', glamt, gphit, zitx1, zity1, zitz1 )
+            ENDIF
+         ENDIF
+         !
+         IF( ssnd(jps_ocx1)%laction )   CALL cpl_prism_snd( jps_ocx1, isec, zotx1, info )   ! ocean x current 1st grid
+         IF( ssnd(jps_ocy1)%laction )   CALL cpl_prism_snd( jps_ocy1, isec, zoty1, info )   ! ocean y current 1st grid
+         IF( ssnd(jps_ocz1)%laction )   CALL cpl_prism_snd( jps_ocz1, isec, zotz1, info )   ! ocean z current 1st grid
+         !
+         IF( ssnd(jps_ivx1)%laction )   CALL cpl_prism_snd( jps_ivx1, isec, zitx1, info )   ! ice   x current 1st grid
+         IF( ssnd(jps_ivy1)%laction )   CALL cpl_prism_snd( jps_ivy1, isec, zity1, info )   ! ice   y current 1st grid
+         IF( ssnd(jps_ivz1)%laction )   CALL cpl_prism_snd( jps_ivz1, isec, zitz1, info )   ! ice   z current 1st grid
+         !
+      ENDIF
+   !
+END SUBROUTINE sbc_cpl_snd
+   
 #else
    !!----------------------------------------------------------------------
-   !!   Dummy routine                              NO sea surface restoring
+   !!   Dummy module                                            NO coupling
    !!----------------------------------------------------------------------
-   LOGICAL, PUBLIC ::   lk_sbc_cpl = .FALSE.   !: coupled formulation flag
+   USE par_kind        ! kind definition
 CONTAINS
-   SUBROUTINE sbc_cpl( kt )         ! Dummy routine
-      WRITE(*,*) 'sbc_cpl: you should not have seen that print! error?', kt
-   END SUBROUTINE sbc_cpl
+   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,   &
+      &                                pqns_tot, pqns_ice,         &
+      &                                pqsr_tot, pqsr_ice,         &
+      &                                pemp_tot, pemp_ice, psprecip )
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   p_frld     ! lead fraction                [0 to 1]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   palbi      ! ice albedo
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   psst       ! sea surface temperature      [Celcius]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pist       ! ice surface temperature      [Celcius]
+      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pqns_tot   ! total non solar heat flux    [W/m2]
+      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pqns_ice   ! ice   non solar heat flux    [W/m2]
+      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pqsr_tot   ! total     solar heat flux    [W/m2]
+      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pqsr_ice   ! ice       solar heat flux    [W/m2]
+      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pemp_tot   ! total     freshwater budget  [Kg/m2/s]
+      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pemp_ice   ! ice solid freshwater budget  [Kg/m2/s]
+      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   psprecip   ! solid precipitation          [Kg/m2/s]
+      WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', p_frld(1,1), palbi(1,1), psst(1,1), pist(1,1)
+      ! stupid definition to avoid warning message when compiling...
+      pqns_tot(:,:) = 0. ; pqns_ice(:,:) = 0. 
+      pqsr_tot(:,:) = 0. ; pqsr_ice(:,:) = 0. 
+      pemp_tot(:,:) = 0. ; pemp_ice(:,:) = 0. ; psprecip(:,:) = 0.
+   END SUBROUTINE sbc_cpl_ice_flx
+   
 #endif
 

trunk/NEMO/OPA_SRC/SBC/sbcfwb.F90

@@ -16 +16 @@
    USE dom_oce         ! ocean space and time domain
    USE sbc_oce         ! surface ocean boundary condition
-   USE cpl_oce         ! coupled atmosphere/ocean
    USE phycst          ! physical constants
    USE sbcrnf          ! ocean runoffs

trunk/NEMO/OPA_SRC/SBC/sbcice_lim.F90

@@ -27 +27 @@
    USE ice_oce         ! ice variables
    USE dom_ice
-   USE cpl_oce
 
    USE sbc_oce         ! Surface boundary condition: ocean fields

trunk/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

@@ -6 +6 @@
    !! Sea-Ice model  :  LIM 2.0 Sea ice model time-stepping
    !!======================================================================
-   !! History :  9.0   !  06-06  (G. Madec)  from icestp_2.F90
+   !! History :  1.0   !  06-2006  (G. Madec)  from icestp_2.F90
+   !!            3.0   !  08-2008  (S. Masson, E. .... ) coupled interface
    !!----------------------------------------------------------------------
 #if defined key_lim2
@@ -23 +24 @@
    USE ice_oce         ! ice variables
    USE dom_ice_2
-   USE cpl_oce
 
    USE sbc_oce         ! Surface boundary condition: ocean fields
@@ -29 +29 @@
    USE sbcblk_core     ! Surface boundary condition: CORE bulk
    USE sbcblk_clio     ! Surface boundary condition: CLIO bulk
+   USE sbccpl          ! Surface boundary condition: coupled interface
    USE albedo
 
@@ -66 +67 @@
 CONTAINS
 
-   SUBROUTINE sbc_ice_lim_2( kt, kblk )
+   SUBROUTINE sbc_ice_lim_2( kt, ksbc )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE sbc_ice_lim_2  ***
@@ -87 +88 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt      ! ocean time step
-      INTEGER, INTENT(in) ::   kblk    ! type of bulk (=3 CLIO, =4 CORE)
+      INTEGER, INTENT(in) ::   ksbc    ! type of sbc ( =3 CLIO bulk ; =4 CORE bulk ; =5 coupled )
       !!
       INTEGER  ::   ji, jj   ! dummy loop indices
@@ -131 +132 @@
          zhsnif(:,:,1) = hsnif(:,:)
 
-         ! ... ice albedo
+         ! ... ice albedo (clear sky and overcast sky)
          CALL albedo_ice( zsist, zhicif, zhsnif, alb_ice_cs, alb_ice_os )
 
@@ -147 +148 @@
          !     - fr2_i0     ! 2nd fraction of qsr penetration in ice     [%]
          !
-         SELECT CASE( kblk )
+         SELECT CASE( ksbc )
          CASE( 3 )           ! CLIO bulk formulation
-            CALL blk_ice_clio( zsist , alb_ice_cs , alb_ice_os ,                                 &
-               &                               utaui_ice , vtaui_ice  , zqns_ice   , zqsr_ice,   &
-               &                               zqla_ice  , zdqns_ice  , zdqla_ice  ,             &
-               &                               tprecip   , sprecip    ,                          &
-               &                               fr1_i0    , fr2_i0     , cl_grid  )
+            CALL blk_ice_clio( zsist, alb_ice_cs, alb_ice_os ,                         &
+               &                      utaui_ice , vtaui_ice  , zqns_ice  , zqsr_ice,   &
+               &                      zqla_ice  , zdqns_ice  , zdqla_ice ,             &
+               &                      tprecip   , sprecip    ,                         &
+               &                      fr1_i0    , fr2_i0     , cl_grid  )
 
          CASE( 4 )           ! CORE bulk formulation
-            CALL blk_ice_core( zsist , ui_ice , vi_ice   , alb_ice_cs ,                         &
-               &                               utaui_ice , vtaui_ice  , zqns_ice  , zqsr_ice,   &
-               &                               zqla_ice  , zdqns_ice  , zdqla_ice ,             &
-               &                               tprecip   , sprecip    ,                         &
-               &                               fr1_i0    , fr2_i0     , cl_grid)
+            CALL blk_ice_core( zsist, ui_ice    , vi_ice     , alb_ice_cs,             &
+               &                      utaui_ice , vtaui_ice  , zqns_ice  , zqsr_ice,   &
+               &                      zqla_ice  , zdqns_ice  , zdqla_ice ,             &
+               &                      tprecip   , sprecip    ,                         &
+               &                      fr1_i0    , fr2_i0     , cl_grid  )
+         CASE( 5 )           ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics)
+            CALL sbc_cpl_ice_tau( utaui_ice , vtaui_ice )
          END SELECT
 
@@ -186 +189 @@
             IF( ln_limdmp )             CALL lim_dmp_2      ( kt )           ! Ice damping 
          ENDIF
+#if defined key_coupled
+         IF( ksbc == 5    )             CALL sbc_cpl_ice_flx( frld, alb_ice_cs , sst_m, sist,   &
+      &                                                             qns_tot, qns_ice,   &
+      &                                                             qsr_tot, qsr_ice,   &
+      &                                                             emp_tot, emp_ice, sprecip )
+#endif
                                         CALL lim_thd_2      ( kt )      ! Ice thermodynamics 
                                         CALL lim_sbc_2      ( kt )      ! Ice/Ocean Mass & Heat fluxes 
@@ -202 +211 @@
    !!----------------------------------------------------------------------
 CONTAINS
-   SUBROUTINE sbc_ice_lim_2 ( kt, kblk )     ! Dummy routine
-      WRITE(*,*) 'sbc_ice_lim_2: You should not have seen this print! error?', kt, kblk
+   SUBROUTINE sbc_ice_lim_2 ( kt, ksbc )     ! Dummy routine
+      WRITE(*,*) 'sbc_ice_lim_2: You should not have seen this print! error?', kt, ksbc
    END SUBROUTINE sbc_ice_lim_2
 #endif

trunk/NEMO/OPA_SRC/SBC/sbcmod.F90

@@ -4 +4 @@
    !! Surface module :  provide to the ocean its surface boundary condition
    !!======================================================================
-   !! History :  3.0   !  2006-07  (G. Madec)  Original code
+   !! History :  3.0   !  07-2006  (G. Madec)  Original code
+   !!             -    !  08-2008  (S. Masson, E. .... ) coupled interface
    !!----------------------------------------------------------------------
 
@@ -42 +43 @@
    PUBLIC   sbc        ! routine called by step.F90
    
-   !! * namsbc namelist (public variables)
-   LOGICAL , PUBLIC ::   ln_ana      = .FALSE.   !: analytical boundary condition flag
-   LOGICAL , PUBLIC ::   ln_flx      = .FALSE.   !: flux      formulation
-   LOGICAL , PUBLIC ::   ln_blk_clio = .FALSE.   !: CLIO bulk formulation
-   LOGICAL , PUBLIC ::   ln_blk_core = .FALSE.   !: CORE bulk formulation
-   LOGICAL , PUBLIC ::   ln_cpl      = .FALSE.   !: coupled   formulation (overwritten by key_sbc_coupled )
-   LOGICAL , PUBLIC ::   ln_dm2dc    = .FALSE.   !: Daily mean to Diurnal Cycle short wave (qsr)
-   LOGICAL , PUBLIC ::   ln_rnf      = .FALSE.   !: runoffs / runoff mouths
-   LOGICAL , PUBLIC ::   ln_ssr      = .FALSE.   !: Sea Surface restoring on SST and/or SSS      
-   INTEGER , PUBLIC ::   nn_ice      = 0         !: flag on ice in the surface boundary condition (=0/1/2)
-   INTEGER , PUBLIC ::   nn_fwb      = 0         !: type of FreshWater Budget control (=0/1/2)
-   INTEGER          ::   nn_ico_cpl  = 0         !: ice-ocean coupling indicator
-   !                                             !  = 0   LIM-3 old case
-   !                                             !  = 1   stresses computed using now ocean velocity
-   !                                             !  = 2   combination of 0 and 1 cases
-
    INTEGER ::   nsbc   ! type of surface boundary condition (deduced from namsbc informations)
-   INTEGER ::   nice   ! type of ice in the surface boundary condition (deduced from namsbc informations)
       
    !! * Substitutions
@@ -94 +78 @@
       ENDIF
 
-      REWIND ( numnam )                   ! Read Namelist namsbc
-      READ   ( numnam, namsbc )
+      REWIND( numnam )                   ! Read Namelist namsbc
+      READ  ( numnam, namsbc )
 
       ! overwrite namelist parameter using CPP key information
-!!gmhere no overwrite, test all option via namelist change: require more incore memory
+!!gm here no overwrite, test all option via namelist change: require more incore memory
 !!gm  IF( lk_sbc_cpl       ) THEN   ;   ln_cpl      = .TRUE.   ;   ELSE   ;   ln_cpl      = .FALSE.   ;   ENDIF
       IF( lk_lim2 )            nn_ice      = 2
@@ -109 +93 @@
       ! Control print
       IF(lwp) THEN
-         WRITE(numout,*) '        Namelist namsbc (overwritten using CPP key defined)'
+         WRITE(numout,*) '        Namelist namsbc (partly overwritten with CPP key setting)'
          WRITE(numout,*) '           frequency update of sbc (and ice)             nn_fsbc     = ', nn_fsbc
          WRITE(numout,*) '           Type of sbc : '
@@ -115 +99 @@
          WRITE(numout,*) '              flux       formulation                     ln_flx      = ', ln_flx
          WRITE(numout,*) '              CLIO bulk  formulation                     ln_blk_clio = ', ln_blk_clio
-         WRITE(numout,*) '              CORE bulk  formulation                     ln_blk_core = ', ln_blk_core
+         WRITE(numout,*) '              CLIO bulk  formulation                     ln_blk_core = ', ln_blk_core
          WRITE(numout,*) '              coupled    formulation (T if key_sbc_cpl)  ln_cpl      = ', ln_cpl
          WRITE(numout,*) '           Misc. options of sbc : '
@@ -127 +111 @@
       ENDIF
 
-      IF( .NOT. ln_rnf )   THEN                      ! no specific treatment in rivers mouths vicinity
-         ln_rnf_mouth = .false.                      
-         nkrnf = 0
-         rnfmsk(:,:) = 0.e0
-         rnfmsk_z(:) = 0.e0
-      ENDIF
-      IF( nn_ice == 0  )   fr_i(:,:) = 0.e0          ! no ice in the domain, ice fraction is always zero
-
-      ! Check consistancy   !!gm mixture of real and integer : coding to be changed....
-
-      IF( nn_ice == 2 )   THEN
-         IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 ) THEN 
-            WRITE(ctmp1,*) 'experiment length (', nitend - nit000 + 1, ') is NOT a multiple of nn_fsbc (', nn_fsbc, ')'
-            CALL ctl_stop( ctmp1, 'Impossible to do proper restart files' )
-         ENDIF
-         IF( MOD( nstock, nn_fsbc) /= 0 ) THEN 
-            WRITE(ctmp1,*) 'nstock ('           , nstock             , ') is NOT a multiple of nn_fsbc (', nn_fsbc, ')'
-            CALL ctl_stop( ctmp1, 'Impossible to do proper restart files' )
-         ENDIF
-      ENDIF
-
-      IF( MOD( rday, nn_fsbc*rdt ) /= 0 )   CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' )
-
+      IF( .NOT. ln_rnf ) THEN                      ! no specific treatment in vicinity of river mouths 
+         ln_rnf_mouth  = .false.                      
+         nkrnf         = 0
+         rnfmsk  (:,:) = 0.e0
+         rnfmsk_z(:)   = 0.e0
+      ENDIF
+      IF( nn_ice == 0  )   fr_i(:,:) = 0.e0        ! no ice in the domain, ice fraction is always zero
+
+      !                                            ! 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 .AND. .NOT.( ln_blk_clio .OR. ln_blk_core ) )   &
-         &   CALL ctl_stop( 'sbc_init: sea-ice model requires a bulk formulation' )
+         &   CALL ctl_stop( 'sea-ice model requires a bulk formulation' )
       
       ! Choice of the Surface Boudary Condition (set nsbc)
@@ -214 +194 @@
       SELECT CASE( nsbc )                        ! Compute ocean surface boundary condition
       !                                          ! (i.e. utau,vtau, qns, qsr, emp, emps)
-      CASE(  0 )   ;   CALL sbc_gyre    ( kt )      ! analytical formulation : GYRE configuration
-      CASE(  1 )   ;   CALL sbc_ana     ( kt )      ! analytical formulation : uniform sbc
-      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     ( kt )      ! coupled formulation
+      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( -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     ( kt )
+                       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
 
@@ -234 +214 @@
 !!gm  IF( ln_dm2dc       )   CALL sbc_dcy( kt )                 ! Daily mean qsr distributed over the Diurnal Cycle
       
-      SELECT CASE( nn_ice )                                     ! Update heat and freshwater fluxes over ice-covered areas
-      CASE(  1 )   ;       CALL sbc_ice_if ( kt )                     ! Ice-cover climatology ("Ice-if" model)
+      SELECT CASE( nn_ice )                                     ! Update heat and freshwater fluxes over sea-ice areas
+      CASE(  1 )   ;       CALL sbc_ice_if   ( kt )                   ! Ice-cover climatology ("Ice-if" model)
          !                                                      
       CASE(  2 )   ;       CALL sbc_ice_lim_2( kt, nsbc )             ! LIM 2.0 ice model

trunk/NEMO/OPA_SRC/geo2ocean.F90

@@ -3 +3 @@
    !!                     ***  MODULE  geo2ocean  ***
    !! Ocean mesh    :  ???
-   !!=====================================================================
+   !!======================================================================
+   !! History :  OPA  !  07-1996  (O. Marti)  Original code
+   !!   NEMO     1.0  !  02-2008  (G. Madec)  F90: Free form
+   !!            3.0  !  
+   !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
@@ -11 +15 @@
    !!   repere      :   old routine suppress it ???
    !!----------------------------------------------------------------------
-   !! * Modules used
    USE dom_oce         ! mesh and scale factors
    USE phycst          ! physical constants
@@ -18 +21 @@
 
    IMPLICIT NONE
-
-   !! * Accessibility
    PRIVATE
-   PUBLIC rot_rep, repcmo, repere, geo2oce   ! only rot_rep should be used
+
+   PUBLIC   rot_rep, repcmo, repere, geo2oce, oce2geo   ! only rot_rep should be used
                                              ! repcmo and repere are keep only for compatibility.
                                              ! they are only a useless overlay of rot_rep
 
-   !! * Module variables
    REAL(wp), DIMENSION(jpi,jpj) ::   &
       gsint, gcost,   &  ! cos/sin between model grid lines and NP direction at T point
@@ -34 +35 @@
    LOGICAL ::   lmust_init = .TRUE.        !: used to initialize the cos/sin variables (se above)
 
-  !! * Substitutions
+   !! * Substitutions
 #  include "vectopt_loop_substitute.h90"
-   !!---------------------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!---------------------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   !! $Id:$ 
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 
 CONTAINS
@@ -54 +55 @@
       !! ** Method  :   Initialization of arrays at the first call.
       !!
-      !! ** Action  : - px2 : first componante (defined at u point)
+      !! ** Action  : - px2 : first  componante (defined at u point)
       !!              - py2 : second componante (defined at v point)
-      !!
-      !! History :
-      !!   7.0  !  07-96  (O. Marti)  Original code
-      !!   8.5  !  02-08  (G. Madec)  F90: Free form
-      !!----------------------------------------------------------------------
-      !! * Arguments 
-      REAL(wp), INTENT( in ), DIMENSION(jpi,jpj) ::   & 
-         pxu1, pyu1,     & ! geographic vector componantes at u-point
-         pxv1, pyv1        ! geographic vector componantes at v-point
-      REAL(wp), INTENT( out ), DIMENSION(jpi,jpj) ::   & 
-         px2,            & ! i-componante (defined at u-point)
-         py2               ! j-componante (defined at v-point)
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   pxu1, pyu1   ! geographic vector componantes at u-point
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   pxv1, pyv1   ! geographic vector componantes at v-point
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   px2          ! i-componante (defined at u-point)
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   py2          ! j-componante (defined at v-point)
       !!----------------------------------------------------------------------
       
       ! Change from geographic to stretched coordinate
       ! ----------------------------------------------
-      
       CALL rot_rep( pxu1, pyu1, 'U', 'en->i',px2 )
       CALL rot_rep( pxv1, pyv1, 'V', 'en->j',py2 )
@@ -90 +83 @@
       !!                  (O. Marti ) Original code (repere and repcmo)
       !!----------------------------------------------------------------------
-      !! * Arguments 
       REAL(wp), DIMENSION(jpi,jpj), INTENT( IN ) ::   pxin, pyin   ! vector componantes
       CHARACTER(len=1),             INTENT( IN ) ::   cd_type      ! define the nature of pt2d array grid-points
@@ -172 +164 @@
       !!   9.2  !  07-04  (S. Masson)  Add T, F points and bugfix in cos lateral boundary
       !!----------------------------------------------------------------------
-      !! * local declarations
       INTEGER ::   ji, jj      ! dummy loop indices
-
+      !!
       REAL(wp) ::   &
          zlam, zphi,            &  ! temporary scalars
@@ -328 +319 @@
 
 
-   SUBROUTINE geo2oce ( pxx , pyy , pzz, cgrid,     &
-                        plon, plat, pte, ptn  , ptv )
+   SUBROUTINE geo2oce ( pxx, pyy, pzz, cgrid,     &
+                        pte, ptn )
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE geo2oce  ***
@@ -344 +335 @@
       !!        !  00-08  (D. Ludicone) Reduced section at Bab el Mandeb
       !!   8.5  !  02-06  (G. Madec)  F90: Free form
-      !!----------------------------------------------------------------------
-      !! * Local declarations
-      REAL(wp), INTENT( in ), DIMENSION(jpi,jpj) ::   &
-         pxx, pyy, pzz
-      CHARACTER (len=1), INTENT( in) ::   &
-         cgrid
-      REAL(wp), INTENT( in ), DIMENSION(jpi,jpj) ::   &
-         plon, plat
-      REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::    &
-         pte, ptn, ptv
+      !!   3.0  !  07-08  (G. Madec)  geo2oce suppress lon/lat agruments
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::  pxx, pyy, pzz
+      CHARACTER(len=1)            , INTENT(in   ) ::  cgrid
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::  pte, ptn
+      !!
       REAL(wp), PARAMETER :: rpi = 3.141592653E0
       REAL(wp), PARAMETER :: rad = rpi / 180.e0
-
-      !! * Local variables
       INTEGER ::   ig     !
-
       !! * Local save
-      REAL(wp), SAVE, DIMENSION(jpi,jpj,4) ::   &
-         zsinlon, zcoslon,   &
-         zsinlat, zcoslat
-      LOGICAL, SAVE, DIMENSION (4) ::   &
-         linit = .FALSE.
+      REAL(wp), SAVE, DIMENSION(jpi,jpj,4) ::   zsinlon, zcoslon, zsinlat, zcoslat
+      LOGICAL , SAVE, DIMENSION(4)         ::   linit = .FALSE.
       !!----------------------------------------------------------------------
 
       SELECT CASE( cgrid)
-
+         CASE ( 't' )   
+            ig = 1
+            IF( .NOT. linit(ig) ) THEN 
+               zsinlon (:,:,ig) = SIN (rad * glamt)
+               zcoslon (:,:,ig) = COS (rad * glamt)
+               zsinlat (:,:,ig) = SIN (rad * gphit)
+               zcoslat (:,:,ig) = COS (rad * gphit)
+               linit (ig) = .TRUE.
+            ENDIF
+         CASE ( 'u' )   
+            ig = 2
+            IF( .NOT. linit(ig) ) THEN 
+               zsinlon (:,:,ig) = SIN (rad * glamu)
+               zcoslon (:,:,ig) = COS (rad * glamu)
+               zsinlat (:,:,ig) = SIN (rad * gphiu)
+               zcoslat (:,:,ig) = COS (rad * gphiu)
+               linit (ig) = .TRUE.
+            ENDIF
+         CASE ( 'v' )   
+            ig = 3
+            IF( .NOT. linit(ig) ) THEN 
+               zsinlon (:,:,ig) = SIN (rad * glamv)
+               zcoslon (:,:,ig) = COS (rad * glamv)
+               zsinlat (:,:,ig) = SIN (rad * gphiv)
+               zcoslat (:,:,ig) = COS (rad * gphiv)
+               linit (ig) = .TRUE.
+            ENDIF
+         CASE ( 'f' )   
+            ig = 4
+            IF( .NOT. linit(ig) ) THEN 
+               zsinlon (:,:,ig) = SIN (rad * glamf)
+               zcoslon (:,:,ig) = COS (rad * glamf)
+               zsinlat (:,:,ig) = SIN (rad * gphif)
+               zcoslat (:,:,ig) = COS (rad * gphif)
+               linit (ig) = .TRUE.
+            ENDIF
+         CASE default   
+            WRITE(ctmp1,*) 'geo2oce : bad grid argument : ', cgrid
+            CALL ctl_stop( ctmp1 )
+      END SELECT
+      
+      pte = - zsinlon (:,:,ig) * pxx + zcoslon (:,:,ig) * pyy
+      ptn = - zcoslon (:,:,ig) * zsinlat (:,:,ig) * pxx    &
+            - zsinlon (:,:,ig) * zsinlat (:,:,ig) * pyy    &
+            + zcoslat (:,:,ig) * pzz
+!!$   ptv =   zcoslon (:,:,ig) * zcoslat (:,:,ig) * pxx    &
+!!$         + zsinlon (:,:,ig) * zcoslat (:,:,ig) * pyy    &
+!!$         + zsinlat (:,:,ig) * pzz
+      !
+   END SUBROUTINE geo2oce
+
+   SUBROUTINE oce2geo ( pte, ptn, cgrid,     &
+                        plon, plat, pxx , pyy , pzz )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE oce2geo  ***
+      !!      
+      !! ** Purpose :
+      !!
+      !! ** Method  :   Change vector from east/north to geocentric
+      !!
+      !! History :
+      !!        !         (A. Caubel)  oce2geo - Original code
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( IN    ) ::  pte, ptn
+      CHARACTER(len=1)            , INTENT( IN    ) ::  cgrid
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( IN    ) ::  plon, plat
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(   OUT ) ::  pxx , pyy , pzz
+      !!
+      REAL(wp), PARAMETER :: rpi = 3.141592653E0
+      REAL(wp), PARAMETER :: rad = rpi / 180.e0
+      INTEGER ::   ig     !
+      !! * Local save
+      REAL(wp), SAVE, DIMENSION(jpi,jpj,4) ::   zsinlon, zcoslon, zsinlat, zcoslat
+      LOGICAL , SAVE, DIMENSION(4)         ::   linit = .FALSE.
+      !!----------------------------------------------------------------------
+
+      WRITE(ctmp1,*) 'oce2geo : Arnaud, au boulot '
+      CALL ctl_stop( ctmp1 )
+
+      SELECT CASE( cgrid)
          CASE ( 't' ) ;; ig = 1
          CASE ( 'u' ) ;; ig = 2
          CASE ( 'v' ) ;; ig = 3
          CASE ( 'f' ) ;; ig = 4
-
          CASE default
-            WRITE(ctmp1,*) 'geo2oce : bad grid argument : ', cgrid
+            WRITE(ctmp1,*) 'oce2geo : bad grid argument : ', cgrid
             CALL ctl_stop( ctmp1 )
        END SELECT
-      
-      IF( .NOT. linit(ig) ) THEN 
-         zsinlon (:,:,ig) = SIN (rad * plon)
-         zcoslon (:,:,ig) = COS (rad * plon)
-         zsinlat (:,:,ig) = SIN (rad * plat)
-         zcoslat (:,:,ig) = COS (rad * plat)
-         linit (ig) = .TRUE.
-      ENDIF
-      
-      pte = - zsinlon (:,:,ig) * pxx + zcoslon (:,:,ig) * pyy
-      ptn = - zcoslon (:,:,ig) * zsinlat (:,:,ig) * pxx    &
-            - zsinlon (:,:,ig) * zsinlat (:,:,ig) * pyy    &
-            + zcoslat (:,:,ig) * pzz
-      ptv =   zcoslon (:,:,ig) * zcoslat (:,:,ig) * pxx    &
-            + zsinlon (:,:,ig) * zcoslat (:,:,ig) * pyy    &
-            + zsinlat (:,:,ig) * pzz
-
-   END SUBROUTINE geo2oce
+       pxx(:,:) = 0. ; pyy(:,:) = 0. ; pzz(:,:) = 0. ! stupid definition to avoid warning message when compiling...
+      
+   END SUBROUTINE oce2geo
 
 

trunk/NEMO/OPA_SRC/ice_oce.F90

@@ -4 +4 @@
    !! Ocean - ice  :  ice variables defined in memory 
    !!======================================================================
-   !! History :
-   !!   8.5  !  02-11  (G. Madec)  F90: Free form and module
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! History :  1.0  !  02-11  (G. Madec)  F90: Free form and module
    !!----------------------------------------------------------------------
 #if defined key_lim3 || defined key_lim2
@@ -15 +10 @@
    !!   'key_lim2' or 'key_lim3'   :               LIM 2.0 or 3.0 ice model
    !!----------------------------------------------------------------------
-   !! * Modules used
    USE par_oce         ! ocean parameters
 
@@ -21 +15 @@
    PRIVATE
  
-   !! Shared module variables
 # if defined  key_lim2
-   LOGICAL, PUBLIC, PARAMETER ::   lk_lim2        = .TRUE.    !: LIM2 ice model
-   LOGICAL, PUBLIC, PARAMETER ::   lk_lim3        = .FALSE.   !: LIM3 ice model
-# else
-   LOGICAL, PUBLIC, PARAMETER ::   lk_lim2        = .FALSE.   !: LIM2 ice model
-   LOGICAL, PUBLIC, PARAMETER ::   lk_lim3        = .TRUE.    !: LIM3 ice model
+   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2        = .TRUE.    !: LIM-2 ice model
+   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3        = .FALSE.   !: no LIM-3
+   CHARACTER(len=1), PUBLIC            ::   cice_grid      = 'B'       !: 'B'-grid ice-velocity
+# endif
+# if defined  key_lim3
+   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2        = .FALSE.   !: no LIM-2
+   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3        = .TRUE.    !: LIM-3 ice model
+   CHARACTER(len=1), PUBLIC            ::   cice_grid      = 'C'       !: 'B'-grid ice-velocity
 # endif
 
@@ -33 +29 @@
    !! ice-ocean common variables
    !!----------------------------------------------------------------------
-# if defined key_coupled
-   REAL(wp), PUBLIC, DIMENSION(jpiglo,jpjglo) ::   &  !: cumulated fields
-      fqsr_oce ,      &   !: Net short wave heat flux on free ocean 
-      fqsr_ice ,      &   !: Net short wave heat flux on sea ice 
-      fqnsr_oce,      &   !: Net longwave heat flux on free ocean
-      fqnsr_ice,      &   !: Net longwave heat flux on sea ice
-      fdqns_ice,      &   !: Derivative of non solar heat flux on sea ice
-      ftprecip ,      &   !: Water flux (liquid precipitation - evaporation) 
-      fsprecip ,      &   !: Solid (snow) precipitation
-      frunoff  ,      &   !: runoff
-      fcalving            !: Iceberg calving 
-# endif
 
 # if defined key_lim3
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !: field exchanges with ice model to ocean
-      catm_ice       , &  !: cloud cover
-      tatm_ice       , &  !: air temperature
-      icethi              !: icethickness
+   ! LIM-3                                             !!! ice to ocean fields
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   catm_ice   !: cloud cover              !!gm never used
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tatm_ice   !: air temperature          !!gm nothing to do here...
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   icethi     !: ice thickness            !!gm never used
 # endif
    
-   REAL(wp), PUBLIC ::   &  !:
-      rdt_ice,           &  !: ice time step
-      dtsd2                 !: ice time step divide by 2
+   REAL(wp), PUBLIC ::   rdt_ice      !: ice time step
+   REAL(wp), PUBLIC ::   dtsd2        !: ice time step divide by 2
 
 #else
@@ -61 +44 @@
    !!   Default option                      NO LIM 2.0 or 3.0 sea-ice model
    !!----------------------------------------------------------------------
-   LOGICAL, PUBLIC, PARAMETER ::   lk_lim2        = .FALSE.  !: No LIM 2.0 ice model
-   LOGICAL, PUBLIC, PARAMETER ::   lk_lim3        = .FALSE.  !: No LIM 3.0 ice model
+   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2        = .FALSE.  !: no LIM-2 ice model
+   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3        = .FALSE.  !: no LIM-3 ice model
+   CHARACTER(len=1), PUBLIC            ::   cice_grid      = 'C'      !: 'B'-grid ice-velocity
 #endif
 
    !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 END MODULE ice_oce

trunk/NEMO/OPA_SRC/opa.F90

@@ -38 +38 @@
    !! * Modules used
    USE oce             ! dynamics and tracers variables
-   USE cpl_oce         ! ocean-atmosphere-sea ice coupled exchanges
    USE dom_oce         ! ocean space domain variables
    USE sbc_oce         ! surface boundary condition: ocean

trunk/NEMO/OPA_SRC/restart.F90

@@ -18 +18 @@
    USE oce             ! ocean dynamics and tracers 
    USE phycst          ! physical constants
-   USE cpl_oce, ONLY : lk_cpl              !
    USE in_out_manager  ! I/O manager
    USE iom             ! I/O module

trunk/NEMO/OPA_SRC/step.F90

@@ -31 +31 @@
    USE ldftra_oce      ! ocean tracer   - trends
    USE ldfdyn_oce      ! ocean dynamics - trends
-   USE cpl_oce         ! coupled ocean-atmosphere variables
    USE in_out_manager  ! I/O manager
    USE iom             !
@@ -42 +41 @@
    USE sbcmod          ! surface boundary condition       (sbc     routine)
    USE sbcrnf          ! surface boundary condition: runoff variables
+   USE sbccpl          ! surface boundary condition: coupled formulation (call send at end of step)
+   USE cpl_oasis3, ONLY : lk_cpl
 
    USE trcstp          ! passive tracer time-stepping      (trc_stp routine)
@@ -361 +362 @@
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 
-#if defined key_oasis3
-      IF( lk_cpl    )   CALL cpl_stp( kstp )                 ! coupled mode : field exchanges
-#endif
+      IF( lk_cpl )   CALL sbc_cpl_snd( kstp )                 ! coupled mode : field exchanges
       !
    END SUBROUTINE stp