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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 5965 for branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 – NEMO

Ignore:
Timestamp:
2015-12-01T16:35:30+01:00 (8 years ago)
Author:
timgraham
Message:

Upgraded branch to r5518 of trunk (v3.6 stable revision)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r4624 r5965  
    99   !!            3.4  ! 2011_11  (C. Harris) more flexibility + multi-category fields 
    1010   !!---------------------------------------------------------------------- 
    11 #if defined key_oasis3 || defined key_oasis4 
    12    !!---------------------------------------------------------------------- 
    13    !!   'key_oasis3' or 'key_oasis4'   Coupled Ocean/Atmosphere formulation 
    1411   !!---------------------------------------------------------------------- 
    1512   !!   namsbc_cpl      : coupled formulation namlist 
     
    2421   USE sbc_oce         ! Surface boundary condition: ocean fields 
    2522   USE sbc_ice         ! Surface boundary condition: ice fields 
     23   USE sbcapr 
    2624   USE sbcdcy          ! surface boundary condition: diurnal cycle 
    2725   USE phycst          ! physical constants 
    2826#if defined key_lim3 
    29    USE par_ice         ! ice parameters 
    3027   USE ice             ! ice variables 
    3128#endif 
     
    3431   USE ice_2           ! ice variables 
    3532#endif 
    36 #if defined key_oasis3 
    3733   USE cpl_oasis3      ! OASIS3 coupling 
    38 #endif 
    39 #if defined key_oasis4 
    40    USE cpl_oasis4      ! OASIS4 coupling 
    41 #endif 
    4234   USE geo2ocean       !  
    43    USE oce   , ONLY : tsn, un, vn 
     35   USE oce   , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev 
    4436   USE albedo          ! 
    4537   USE in_out_manager  ! I/O manager 
     
    4941   USE timing          ! Timing 
    5042   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     43   USE eosbn2 
     44   USE sbcrnf   , ONLY : l_rnfcpl 
    5145#if defined key_cpl_carbon_cycle 
    5246   USE p4zflx, ONLY : oce_co2 
    5347#endif 
    54    USE diaar5, ONLY :   lk_diaar5 
    5548#if defined key_cice 
    5649   USE ice_domain_size, only: ncat 
    5750#endif 
     51#if defined key_lim3 
     52   USE limthd_dh       ! for CALL lim_thd_snwblow 
     53#endif 
     54 
    5855   IMPLICIT NONE 
    5956   PRIVATE 
    6057 
     58   PUBLIC   sbc_cpl_init       ! routine called by sbcmod.F90 
    6159   PUBLIC   sbc_cpl_rcv        ! routine called by sbc_ice_lim(_2).F90 
    6260   PUBLIC   sbc_cpl_snd        ! routine called by step.F90 
    6361   PUBLIC   sbc_cpl_ice_tau    ! routine called by sbc_ice_lim(_2).F90 
    6462   PUBLIC   sbc_cpl_ice_flx    ! routine called by sbc_ice_lim(_2).F90 
     63   PUBLIC   sbc_cpl_alloc      ! routine called in sbcice_cice.F90 
    6564 
    6665   INTEGER, PARAMETER ::   jpr_otx1   =  1            ! 3 atmosphere-ocean stress components on grid 1 
     
    9796   INTEGER, PARAMETER ::   jpr_topm   = 32            ! topmeltn 
    9897   INTEGER, PARAMETER ::   jpr_botm   = 33            ! botmeltn 
    99    INTEGER, PARAMETER ::   jprcv      = 33            ! total number of fields received 
    100  
    101    INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction  
     98   INTEGER, PARAMETER ::   jpr_sflx   = 34            ! salt flux 
     99   INTEGER, PARAMETER ::   jpr_toce   = 35            ! ocean temperature 
     100   INTEGER, PARAMETER ::   jpr_soce   = 36            ! ocean salinity 
     101   INTEGER, PARAMETER ::   jpr_ocx1   = 37            ! ocean current on grid 1 
     102   INTEGER, PARAMETER ::   jpr_ocy1   = 38            ! 
     103   INTEGER, PARAMETER ::   jpr_ssh    = 39            ! sea surface height 
     104   INTEGER, PARAMETER ::   jpr_fice   = 40            ! ice fraction           
     105   INTEGER, PARAMETER ::   jpr_e3t1st = 41            ! first T level thickness  
     106   INTEGER, PARAMETER ::   jpr_fraqsr = 42            ! fraction of solar net radiation absorbed in the first ocean level 
     107   INTEGER, PARAMETER ::   jprcv      = 42            ! total number of fields received 
     108 
     109   INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction sent to the atmosphere 
    102110   INTEGER, PARAMETER ::   jps_toce   =  2            ! ocean temperature 
    103111   INTEGER, PARAMETER ::   jps_tice   =  3            ! ice   temperature 
     
    114122   INTEGER, PARAMETER ::   jps_ivz1   = 14            ! 
    115123   INTEGER, PARAMETER ::   jps_co2    = 15 
    116    INTEGER, PARAMETER ::   jpsnd      = 15            ! total number of fields sended 
     124   INTEGER, PARAMETER ::   jps_soce   = 16            ! ocean salinity 
     125   INTEGER, PARAMETER ::   jps_ssh    = 17            ! sea surface height 
     126   INTEGER, PARAMETER ::   jps_qsroce = 18            ! Qsr above the ocean 
     127   INTEGER, PARAMETER ::   jps_qnsoce = 19            ! Qns above the ocean 
     128   INTEGER, PARAMETER ::   jps_oemp   = 20            ! ocean freshwater budget (evap - precip) 
     129   INTEGER, PARAMETER ::   jps_sflx   = 21            ! salt flux 
     130   INTEGER, PARAMETER ::   jps_otx1   = 22            ! 2 atmosphere-ocean stress components on grid 1 
     131   INTEGER, PARAMETER ::   jps_oty1   = 23            !  
     132   INTEGER, PARAMETER ::   jps_rnf    = 24            ! runoffs 
     133   INTEGER, PARAMETER ::   jps_taum   = 25            ! wind stress module 
     134   INTEGER, PARAMETER ::   jps_fice2  = 26            ! ice fraction sent to OPA (by SAS when doing SAS-OPA coupling) 
     135   INTEGER, PARAMETER ::   jps_e3t1st = 27            ! first level depth (vvl) 
     136   INTEGER, PARAMETER ::   jps_fraqsr = 28            ! fraction of solar net radiation absorbed in the first ocean level 
     137   INTEGER, PARAMETER ::   jpsnd      = 28            ! total number of fields sended 
    117138 
    118139   !                                                         !!** namelist namsbc_cpl ** 
     
    129150   TYPE(FLD_C) ::   sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, sn_rcv_qns, sn_rcv_emp, sn_rcv_rnf 
    130151   TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2                         
    131  
     152   ! Other namelist parameters                        ! 
     153   INTEGER     ::   nn_cplmodel            ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 
     154   LOGICAL     ::   ln_usecplmask          !  use a coupling mask file to merge data received from several models 
     155                                           !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
    132156   TYPE ::   DYNARR      
    133157      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   z3    
     
    140164   INTEGER , ALLOCATABLE, SAVE, DIMENSION(    :) ::   nrcvinfo           ! OASIS info argument 
    141165 
    142 #if ! defined key_lim2   &&   ! defined key_lim3 
    143    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice,fr1_i0,fr2_i0          ! jpi, jpj 
    144    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice, alb_ice, qns_ice, dqns_ice  ! (jpi,jpj,jpl) 
    145 #endif 
    146  
    147 #if defined key_cice 
    148    INTEGER, PARAMETER ::   jpl = ncat 
    149 #elif ! defined key_lim2   &&   ! defined key_lim3 
    150    INTEGER, PARAMETER ::   jpl = 1  
    151    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice 
    152    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice 
    153 #endif 
    154  
    155 #if ! defined key_lim3   &&  ! defined key_cice 
    156    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i 
    157 #endif 
    158  
    159 #if ! defined key_lim3 
    160    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  ht_i, ht_s 
    161 #endif 
    162  
    163 #if ! defined key_cice 
    164    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  topmelt, botmelt 
    165 #endif 
    166  
    167166   !! Substitution 
     167#  include "domzgr_substitute.h90" 
    168168#  include "vectopt_loop_substitute.h90" 
    169169   !!---------------------------------------------------------------------- 
     
    179179      !!             ***  FUNCTION sbc_cpl_alloc  *** 
    180180      !!---------------------------------------------------------------------- 
    181       INTEGER :: ierr(4),jn 
     181      INTEGER :: ierr(3) 
    182182      !!---------------------------------------------------------------------- 
    183183      ierr(:) = 0 
    184184      ! 
    185185      ALLOCATE( albedo_oce_mix(jpi,jpj), nrcvinfo(jprcv),  STAT=ierr(1) ) 
    186       ! 
    187 #if ! defined key_lim2 && ! defined key_lim3 
    188       ! quick patch to be able to run the coupled model without sea-ice... 
    189       ALLOCATE( u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,1) ,     & 
    190                 v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,1),      & 
    191                 emp_ice(jpi,jpj) , qns_ice(jpi,jpj,1) , dqns_ice(jpi,jpj,1) , STAT=ierr(2) ) 
     186       
     187#if ! defined key_lim3 && ! defined key_lim2 && ! defined key_cice 
     188      ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) )  ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) 
    192189#endif 
    193  
    194 #if ! defined key_lim3 && ! defined key_cice 
    195       ALLOCATE( a_i(jpi,jpj,jpl) , STAT=ierr(3) ) 
    196 #endif 
    197  
    198 #if defined key_cice || defined key_lim2 
    199       ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(4) ) 
    200 #endif 
     190      ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 
     191      ! 
    201192      sbc_cpl_alloc = MAXVAL( ierr ) 
    202193      IF( lk_mpp            )   CALL mpp_sum ( sbc_cpl_alloc ) 
     
    210201      !!             ***  ROUTINE sbc_cpl_init  *** 
    211202      !! 
    212       !! ** Purpose :   Initialisation of send and recieved information from 
     203      !! ** Purpose :   Initialisation of send and received information from 
    213204      !!                the atmospheric component 
    214205      !! 
     
    218209      !!              * initialise the OASIS coupler 
    219210      !!---------------------------------------------------------------------- 
    220       INTEGER, INTENT(in) ::   k_ice    ! ice management in the sbc (=0/1/2/3) 
     211      INTEGER, INTENT(in) ::   k_ice       ! ice management in the sbc (=0/1/2/3) 
    221212      !! 
    222213      INTEGER ::   jn   ! dummy loop index 
    223214      INTEGER ::   ios  ! Local integer output status for namelist read 
     215      INTEGER ::   inum  
    224216      REAL(wp), POINTER, DIMENSION(:,:) ::   zacs, zaos 
    225217      !! 
    226       NAMELIST/namsbc_cpl/  sn_snd_temp, sn_snd_alb   , sn_snd_thick, sn_snd_crt   , sn_snd_co2,   & 
    227          &                  sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr,   & 
    228          &                  sn_rcv_qns , sn_rcv_emp   , sn_rcv_rnf  , sn_rcv_cal   , sn_rcv_iceflx  , sn_rcv_co2 
     218      NAMELIST/namsbc_cpl/  sn_snd_temp, sn_snd_alb   , sn_snd_thick, sn_snd_crt   , sn_snd_co2,      & 
     219         &                  sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr,      & 
     220         &                  sn_rcv_qns , sn_rcv_emp   , sn_rcv_rnf  , sn_rcv_cal   , sn_rcv_iceflx,   & 
     221         &                  sn_rcv_co2 , nn_cplmodel  , ln_usecplmask 
    229222      !!--------------------------------------------------------------------- 
    230223      ! 
     
    250243         WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist ' 
    251244         WRITE(numout,*)'~~~~~~~~~~~~' 
     245      ENDIF 
     246      IF( lwp .AND. ln_cpl ) THEN                        ! control print 
    252247         WRITE(numout,*)'  received fields (mutiple ice categogies)' 
    253248         WRITE(numout,*)'      10m wind module                 = ', TRIM(sn_rcv_w10m%cldes  ), ' (', TRIM(sn_rcv_w10m%clcat  ), ')' 
     
    274269         WRITE(numout,*)'                      - mesh          = ', sn_snd_crt%clvgrd 
    275270         WRITE(numout,*)'      oce co2 flux                    = ', TRIM(sn_snd_co2%cldes   ), ' (', TRIM(sn_snd_co2%clcat   ), ')' 
     271         WRITE(numout,*)'  nn_cplmodel                         = ', nn_cplmodel 
     272         WRITE(numout,*)'  ln_usecplmask                       = ', ln_usecplmask 
    276273      ENDIF 
    277274 
     
    391388      srcv(jpr_oemp)%clname = 'OOEvaMPr'      ! ocean water budget = ocean Evap - ocean precip 
    392389      SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 
     390      CASE( 'none'          )       ! nothing to do 
    393391      CASE( 'oce only'      )   ;   srcv(                                 jpr_oemp   )%laction = .TRUE.  
    394392      CASE( 'conservative'  ) 
     
    402400      !                                                      !     Runoffs & Calving     !    
    403401      !                                                      ! ------------------------- ! 
    404       srcv(jpr_rnf   )%clname = 'O_Runoff'   ;   IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' )   srcv(jpr_rnf)%laction = .TRUE. 
    405 ! This isn't right - really just want ln_rnf_emp changed 
    406 !                                                 IF( TRIM( sn_rcv_rnf%cldes ) == 'climato' )   THEN   ;   ln_rnf = .TRUE. 
    407 !                                                 ELSE                                                 ;   ln_rnf = .FALSE. 
    408 !                                                 ENDIF 
     402      srcv(jpr_rnf   )%clname = 'O_Runoff' 
     403      IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN 
     404         srcv(jpr_rnf)%laction = .TRUE. 
     405         l_rnfcpl              = .TRUE.                      ! -> no need to read runoffs in sbcrnf 
     406         ln_rnf                = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas 
     407         IF(lwp) WRITE(numout,*) 
     408         IF(lwp) WRITE(numout,*) '   runoffs received from oasis -> force ln_rnf = ', ln_rnf 
     409      ENDIF 
     410      ! 
    409411      srcv(jpr_cal   )%clname = 'OCalving'   ;   IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE. 
    410412 
     
    416418      srcv(jpr_qnsmix)%clname = 'O_QnsMix' 
    417419      SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) 
     420      CASE( 'none'          )       ! nothing to do 
    418421      CASE( 'oce only'      )   ;   srcv(               jpr_qnsoce   )%laction = .TRUE. 
    419422      CASE( 'conservative'  )   ;   srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE. 
     
    431434      srcv(jpr_qsrmix)%clname = 'O_QsrMix' 
    432435      SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) 
     436      CASE( 'none'          )       ! nothing to do 
    433437      CASE( 'oce only'      )   ;   srcv(               jpr_qsroce   )%laction = .TRUE. 
    434438      CASE( 'conservative'  )   ;   srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE. 
     
    446450      ! 
    447451      ! non solar sensitivity mandatory for LIM ice model 
    448       IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4) & 
     452      IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4 .AND. nn_components /= jp_iam_sas ) & 
    449453         CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' ) 
    450454      ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique 
     
    479483         srcv(jpr_topm:jpr_botm)%laction = .TRUE. 
    480484      ENDIF 
    481  
    482       ! Allocate all parts of frcv used for received fields 
     485      !                                                      ! ------------------------------- ! 
     486      !                                                      !   OPA-SAS coupling - rcv by opa !    
     487      !                                                      ! ------------------------------- ! 
     488      srcv(jpr_sflx)%clname = 'O_SFLX' 
     489      srcv(jpr_fice)%clname = 'RIceFrc' 
     490      ! 
     491      IF( nn_components == jp_iam_opa ) THEN    ! OPA coupled to SAS via OASIS: force received field by OPA (sent by SAS) 
     492         srcv(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling 
     493         srcv(:)%clgrid  = 'T'       ! force default definition in case of opa <-> sas coupling 
     494         srcv(:)%nsgn    = 1.        ! force default definition in case of opa <-> sas coupling 
     495         srcv( (/jpr_qsroce, jpr_qnsoce, jpr_oemp, jpr_sflx, jpr_fice, jpr_otx1, jpr_oty1, jpr_taum/) )%laction = .TRUE. 
     496         srcv(jpr_otx1)%clgrid = 'U'        ! oce components given at U-point 
     497         srcv(jpr_oty1)%clgrid = 'V'        !           and           V-point 
     498         ! Vectors: change of sign at north fold ONLY if on the local grid 
     499         srcv( (/jpr_otx1,jpr_oty1/) )%nsgn = -1. 
     500         sn_rcv_tau%clvgrd = 'U,V' 
     501         sn_rcv_tau%clvor = 'local grid' 
     502         sn_rcv_tau%clvref = 'spherical' 
     503         sn_rcv_emp%cldes = 'oce only' 
     504         ! 
     505         IF(lwp) THEN                        ! control print 
     506            WRITE(numout,*) 
     507            WRITE(numout,*)'               Special conditions for SAS-OPA coupling  ' 
     508            WRITE(numout,*)'               OPA component  ' 
     509            WRITE(numout,*) 
     510            WRITE(numout,*)'  received fields from SAS component ' 
     511            WRITE(numout,*)'                  ice cover ' 
     512            WRITE(numout,*)'                  oce only EMP  ' 
     513            WRITE(numout,*)'                  salt flux  ' 
     514            WRITE(numout,*)'                  mixed oce-ice solar flux  ' 
     515            WRITE(numout,*)'                  mixed oce-ice non solar flux  ' 
     516            WRITE(numout,*)'                  wind stress U,V on local grid and sperical coordinates ' 
     517            WRITE(numout,*)'                  wind stress module' 
     518            WRITE(numout,*) 
     519         ENDIF 
     520      ENDIF 
     521      !                                                      ! -------------------------------- ! 
     522      !                                                      !   OPA-SAS coupling - rcv by sas  !    
     523      !                                                      ! -------------------------------- ! 
     524      srcv(jpr_toce  )%clname = 'I_SSTSST' 
     525      srcv(jpr_soce  )%clname = 'I_SSSal' 
     526      srcv(jpr_ocx1  )%clname = 'I_OCurx1' 
     527      srcv(jpr_ocy1  )%clname = 'I_OCury1' 
     528      srcv(jpr_ssh   )%clname = 'I_SSHght' 
     529      srcv(jpr_e3t1st)%clname = 'I_E3T1st'    
     530      srcv(jpr_fraqsr)%clname = 'I_FraQsr'    
     531      ! 
     532      IF( nn_components == jp_iam_sas ) THEN 
     533         IF( .NOT. ln_cpl ) srcv(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling 
     534         IF( .NOT. ln_cpl ) srcv(:)%clgrid  = 'T'       ! force default definition in case of opa <-> sas coupling 
     535         IF( .NOT. ln_cpl ) srcv(:)%nsgn    = 1.        ! force default definition in case of opa <-> sas coupling 
     536         srcv( (/jpr_toce, jpr_soce, jpr_ssh, jpr_fraqsr, jpr_ocx1, jpr_ocy1/) )%laction = .TRUE. 
     537         srcv( jpr_e3t1st )%laction = lk_vvl 
     538         srcv(jpr_ocx1)%clgrid = 'U'        ! oce components given at U-point 
     539         srcv(jpr_ocy1)%clgrid = 'V'        !           and           V-point 
     540         ! Vectors: change of sign at north fold ONLY if on the local grid 
     541         srcv(jpr_ocx1:jpr_ocy1)%nsgn = -1. 
     542         ! Change first letter to couple with atmosphere if already coupled OPA 
     543         ! this is nedeed as each variable name used in the namcouple must be unique: 
     544         ! for example O_Runoff received by OPA from SAS and therefore O_Runoff received by SAS from the Atmosphere 
     545         DO jn = 1, jprcv 
     546            IF ( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname)) 
     547         END DO 
     548         ! 
     549         IF(lwp) THEN                        ! control print 
     550            WRITE(numout,*) 
     551            WRITE(numout,*)'               Special conditions for SAS-OPA coupling  ' 
     552            WRITE(numout,*)'               SAS component  ' 
     553            WRITE(numout,*) 
     554            IF( .NOT. ln_cpl ) THEN 
     555               WRITE(numout,*)'  received fields from OPA component ' 
     556            ELSE 
     557               WRITE(numout,*)'  Additional received fields from OPA component : ' 
     558            ENDIF 
     559            WRITE(numout,*)'               sea surface temperature (Celcius) ' 
     560            WRITE(numout,*)'               sea surface salinity '  
     561            WRITE(numout,*)'               surface currents '  
     562            WRITE(numout,*)'               sea surface height '  
     563            WRITE(numout,*)'               thickness of first ocean T level '         
     564            WRITE(numout,*)'               fraction of solar net radiation absorbed in the first ocean level' 
     565            WRITE(numout,*) 
     566         ENDIF 
     567      ENDIF 
     568       
     569      ! =================================================== ! 
     570      ! Allocate all parts of frcv used for received fields ! 
     571      ! =================================================== ! 
    483572      DO jn = 1, jprcv 
    484573         IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 
    485574      END DO 
    486575      ! Allocate taum part of frcv which is used even when not received as coupling field 
    487       IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jn)%nct) ) 
     576      IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 
     577      ! Allocate w10m part of frcv which is used even when not received as coupling field 
     578      IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 
     579      ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 
     580      IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 
     581      IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 
    488582      ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 
    489583      IF( k_ice /= 0 ) THEN 
    490          IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jn)%nct) ) 
    491          IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jn)%nct) ) 
     584         IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) ) 
     585         IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) ) 
    492586      END IF 
    493587 
     
    509603      ssnd(jps_tmix)%clname = 'O_TepMix' 
    510604      SELECT CASE( TRIM( sn_snd_temp%cldes ) ) 
    511       CASE( 'none'         )       ! nothing to do 
    512       CASE( 'oce only'             )   ;   ssnd(   jps_toce            )%laction = .TRUE. 
    513       CASE( 'weighted oce and ice' ) 
     605      CASE( 'none'                                 )       ! nothing to do 
     606      CASE( 'oce only'                             )   ;   ssnd( jps_toce )%laction = .TRUE. 
     607      CASE( 'oce and ice' , 'weighted oce and ice' ) 
    514608         ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 
    515609         IF ( TRIM( sn_snd_temp%clcat ) == 'yes' )  ssnd(jps_tice)%nct = jpl 
    516       CASE( 'mixed oce-ice'        )   ;   ssnd(   jps_tmix            )%laction = .TRUE. 
     610      CASE( 'mixed oce-ice'                        )   ;   ssnd( jps_tmix )%laction = .TRUE. 
    517611      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' ) 
    518612      END SELECT 
    519       
     613            
    520614      !                                                      ! ------------------------- ! 
    521615      !                                                      !          Albedo           ! 
     
    524618      ssnd(jps_albmix)%clname = 'O_AlbMix' 
    525619      SELECT CASE( TRIM( sn_snd_alb%cldes ) ) 
    526       CASE( 'none'               ! nothing to do 
    527       CASE( 'weighted ice'  )   ;  ssnd(jps_albice)%laction = .TRUE. 
    528       CASE( 'mixed oce-ice' )   ;  ssnd(jps_albmix)%laction = .TRUE. 
     620      CASE( 'none'                 )     ! nothing to do 
     621      CASE( 'ice' , 'weighted ice' )   ; ssnd(jps_albice)%laction = .TRUE. 
     622      CASE( 'mixed oce-ice'        )   ; ssnd(jps_albmix)%laction = .TRUE. 
    529623      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_alb%cldes' ) 
    530624      END SELECT 
     
    550644         IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl 
    551645      ENDIF 
    552  
     646       
    553647      SELECT CASE ( TRIM( sn_snd_thick%cldes ) ) 
    554648      CASE( 'none'         )       ! nothing to do 
     
    557651         IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN 
    558652            ssnd(jps_hice:jps_hsnw)%nct = jpl 
    559          ELSE 
    560             IF ( jpl > 1 ) THEN 
    561 CALL ctl_stop( 'sbc_cpl_init: use weighted ice and snow option for sn_snd_thick%cldes if not exchanging category fields' ) 
    562             ENDIF 
    563653         ENDIF 
    564654      CASE ( 'weighted ice and snow' )  
     
    599689      !                                                      ! ------------------------- ! 
    600690      ssnd(jps_co2)%clname = 'O_CO2FLX' ;  IF( TRIM(sn_snd_co2%cldes) == 'coupled' )    ssnd(jps_co2 )%laction = .TRUE. 
     691 
     692      !                                                      ! ------------------------------- ! 
     693      !                                                      !   OPA-SAS coupling - snd by opa !    
     694      !                                                      ! ------------------------------- ! 
     695      ssnd(jps_ssh   )%clname = 'O_SSHght'  
     696      ssnd(jps_soce  )%clname = 'O_SSSal'  
     697      ssnd(jps_e3t1st)%clname = 'O_E3T1st'    
     698      ssnd(jps_fraqsr)%clname = 'O_FraQsr' 
     699      ! 
     700      IF( nn_components == jp_iam_opa ) THEN 
     701         ssnd(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling 
     702         ssnd( (/jps_toce, jps_soce, jps_ssh, jps_fraqsr, jps_ocx1, jps_ocy1/) )%laction = .TRUE. 
     703         ssnd( jps_e3t1st )%laction = lk_vvl 
     704         ! vector definition: not used but cleaner... 
     705         ssnd(jps_ocx1)%clgrid  = 'U'        ! oce components given at U-point 
     706         ssnd(jps_ocy1)%clgrid  = 'V'        !           and           V-point 
     707         sn_snd_crt%clvgrd = 'U,V' 
     708         sn_snd_crt%clvor = 'local grid' 
     709         sn_snd_crt%clvref = 'spherical' 
     710         ! 
     711         IF(lwp) THEN                        ! control print 
     712            WRITE(numout,*) 
     713            WRITE(numout,*)'  sent fields to SAS component ' 
     714            WRITE(numout,*)'               sea surface temperature (T before, Celcius) ' 
     715            WRITE(numout,*)'               sea surface salinity '  
     716            WRITE(numout,*)'               surface currents U,V on local grid and spherical coordinates'  
     717            WRITE(numout,*)'               sea surface height '  
     718            WRITE(numout,*)'               thickness of first ocean T level '         
     719            WRITE(numout,*)'               fraction of solar net radiation absorbed in the first ocean level' 
     720            WRITE(numout,*) 
     721         ENDIF 
     722      ENDIF 
     723      !                                                      ! ------------------------------- ! 
     724      !                                                      !   OPA-SAS coupling - snd by sas !    
     725      !                                                      ! ------------------------------- ! 
     726      ssnd(jps_sflx  )%clname = 'I_SFLX'      
     727      ssnd(jps_fice2 )%clname = 'IIceFrc' 
     728      ssnd(jps_qsroce)%clname = 'I_QsrOce'    
     729      ssnd(jps_qnsoce)%clname = 'I_QnsOce'    
     730      ssnd(jps_oemp  )%clname = 'IOEvaMPr'  
     731      ssnd(jps_otx1  )%clname = 'I_OTaux1'    
     732      ssnd(jps_oty1  )%clname = 'I_OTauy1'    
     733      ssnd(jps_rnf   )%clname = 'I_Runoff'    
     734      ssnd(jps_taum  )%clname = 'I_TauMod'    
     735      ! 
     736      IF( nn_components == jp_iam_sas ) THEN 
     737         IF( .NOT. ln_cpl ) ssnd(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling 
     738         ssnd( (/jps_qsroce, jps_qnsoce, jps_oemp, jps_fice2, jps_sflx, jps_otx1, jps_oty1, jps_taum/) )%laction = .TRUE. 
     739         ! 
     740         ! Change first letter to couple with atmosphere if already coupled with sea_ice 
     741         ! this is nedeed as each variable name used in the namcouple must be unique: 
     742         ! for example O_SSTSST sent by OPA to SAS and therefore S_SSTSST sent by SAS to the Atmosphere 
     743         DO jn = 1, jpsnd 
     744            IF ( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname)) 
     745         END DO 
     746         ! 
     747         IF(lwp) THEN                        ! control print 
     748            WRITE(numout,*) 
     749            IF( .NOT. ln_cpl ) THEN 
     750               WRITE(numout,*)'  sent fields to OPA component ' 
     751            ELSE 
     752               WRITE(numout,*)'  Additional sent fields to OPA component : ' 
     753            ENDIF 
     754            WRITE(numout,*)'                  ice cover ' 
     755            WRITE(numout,*)'                  oce only EMP  ' 
     756            WRITE(numout,*)'                  salt flux  ' 
     757            WRITE(numout,*)'                  mixed oce-ice solar flux  ' 
     758            WRITE(numout,*)'                  mixed oce-ice non solar flux  ' 
     759            WRITE(numout,*)'                  wind stress U,V components' 
     760            WRITE(numout,*)'                  wind stress module' 
     761         ENDIF 
     762      ENDIF 
     763 
    601764      ! 
    602765      ! ================================ ! 
     
    604767      ! ================================ ! 
    605768 
    606       CALL cpl_prism_define(jprcv, jpsnd)             
    607       ! 
    608       IF( ln_dm2dc .AND. ( cpl_prism_freq( jpr_qsroce ) + cpl_prism_freq( jpr_qsrmix ) /= 86400 ) )   & 
     769      CALL cpl_define(jprcv, jpsnd, nn_cplmodel) 
     770       
     771      IF (ln_usecplmask) THEN  
     772         xcplmask(:,:,:) = 0. 
     773         CALL iom_open( 'cplmask', inum ) 
     774         CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(1:nlci,1:nlcj,1:nn_cplmodel),   & 
     775            &          kstart = (/ mig(1),mjg(1),1 /), kcount = (/ nlci,nlcj,nn_cplmodel /) ) 
     776         CALL iom_close( inum ) 
     777      ELSE 
     778         xcplmask(:,:,:) = 1. 
     779      ENDIF 
     780      xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 ) 
     781      ! 
     782      ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'I_QsrOce' ) + cpl_freq( 'I_QsrMix' ) 
     783      IF( ln_dm2dc .AND. ln_cpl .AND. ncpl_qsr_freq /= 86400 )   & 
    609784         &   CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 
     785      ncpl_qsr_freq = 86400 / ncpl_qsr_freq 
    610786 
    611787      CALL wrk_dealloc( jpi,jpj, zacs, zaos ) 
     
    654830      !! 
    655831      !! ** Action  :   update  utau, vtau   ocean stress at U,V grid  
    656       !!                        taum, wndm   wind stres and wind speed module at T-point 
     832      !!                        taum         wind stress module at T-point 
     833      !!                        wndm         wind speed  module at T-point over free ocean or leads in presence of sea-ice 
    657834      !!                        qns          non solar heat fluxes including emp heat content    (ocean only case) 
    658835      !!                                     and the latent heat flux of solid precip. melting 
     
    660837      !!                        emp          upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case) 
    661838      !!---------------------------------------------------------------------- 
    662       INTEGER, INTENT(in) ::   kt       ! ocean model time step index 
    663       INTEGER, INTENT(in) ::   k_fsbc   ! frequency of sbc (-> ice model) computation  
    664       INTEGER, INTENT(in) ::   k_ice    ! ice management in the sbc (=0/1/2/3) 
    665       !! 
    666       LOGICAL ::    llnewtx, llnewtau      ! update wind stress components and module?? 
     839      INTEGER, INTENT(in)           ::   kt          ! ocean model time step index 
     840      INTEGER, INTENT(in)           ::   k_fsbc      ! frequency of sbc (-> ice model) computation  
     841      INTEGER, INTENT(in)           ::   k_ice       ! ice management in the sbc (=0/1/2/3) 
     842 
     843      !! 
     844      LOGICAL  ::   llnewtx, llnewtau      ! update wind stress components and module?? 
    667845      INTEGER  ::   ji, jj, jn             ! dummy loop indices 
    668846      INTEGER  ::   isec                   ! number of seconds since nit000 (assuming rdttra did not change since nit000) 
     
    672850      REAL(wp) ::   zcdrag = 1.5e-3        ! drag coefficient 
    673851      REAL(wp) ::   zzx, zzy               ! temporary variables 
    674       REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty  
     852      REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty, zmsk, zemp, zqns, zqsr 
    675853      !!---------------------------------------------------------------------- 
    676854      ! 
    677855      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_rcv') 
    678856      ! 
    679       CALL wrk_alloc( jpi,jpj, ztx, zty ) 
    680  
    681       IF( kt == nit000 )   CALL sbc_cpl_init( k_ice )          ! initialisation 
    682  
    683       !                                                 ! Receive all the atmos. fields (including ice information) 
    684       isec = ( kt - nit000 ) * NINT( rdttra(1) )             ! date of exchanges 
    685       DO jn = 1, jprcv                                       ! received fields sent by the atmosphere 
    686          IF( srcv(jn)%laction )   CALL cpl_prism_rcv( jn, isec, frcv(jn)%z3, nrcvinfo(jn) ) 
     857      CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 
     858      ! 
     859      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0) 
     860      ! 
     861      !                                                      ! ======================================================= ! 
     862      !                                                      ! Receive all the atmos. fields (including ice information) 
     863      !                                                      ! ======================================================= ! 
     864      isec = ( kt - nit000 ) * NINT( rdttra(1) )                ! date of exchanges 
     865      DO jn = 1, jprcv                                          ! received fields sent by the atmosphere 
     866         IF( srcv(jn)%laction )   CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) 
    687867      END DO 
    688868 
     
    744924         ! 
    745925      ENDIF 
    746        
    747926      !                                                      ! ========================= ! 
    748927      !                                                      !    wind stress module     !   (taum) 
     
    773952         ENDIF 
    774953      ENDIF 
    775        
     954      ! 
    776955      !                                                      ! ========================= ! 
    777956      !                                                      !      10 m wind speed      !   (wndm) 
     
    786965!CDIR NOVERRCHK 
    787966               DO ji = 1, jpi  
    788                   wndm(ji,jj) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 
     967                  frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 
    789968               END DO 
    790969            END DO 
    791970         ENDIF 
    792       ELSE 
    793          IF ( nrcvinfo(jpr_w10m) == OASIS_Rcv ) wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1) 
    794971      ENDIF 
    795972 
     
    798975      IF( MOD( kt-1, k_fsbc ) == 0 ) THEN 
    799976         ! 
    800          utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 
    801          vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 
    802          taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 
     977         IF( ln_mixcpl ) THEN 
     978            utau(:,:) = utau(:,:) * xcplmask(:,:,0) + frcv(jpr_otx1)%z3(:,:,1) * zmsk(:,:) 
     979            vtau(:,:) = vtau(:,:) * xcplmask(:,:,0) + frcv(jpr_oty1)%z3(:,:,1) * zmsk(:,:) 
     980            taum(:,:) = taum(:,:) * xcplmask(:,:,0) + frcv(jpr_taum)%z3(:,:,1) * zmsk(:,:) 
     981            wndm(:,:) = wndm(:,:) * xcplmask(:,:,0) + frcv(jpr_w10m)%z3(:,:,1) * zmsk(:,:) 
     982         ELSE 
     983            utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 
     984            vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 
     985            taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 
     986            wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1) 
     987         ENDIF 
    803988         CALL iom_put( "taum_oce", taum )   ! output wind stress module 
    804989         !   
     
    806991 
    807992#if defined key_cpl_carbon_cycle 
    808       !                                                              ! atmosph. CO2 (ppm) 
     993      !                                                      ! ================== ! 
     994      !                                                      ! atmosph. CO2 (ppm) ! 
     995      !                                                      ! ================== ! 
    809996      IF( srcv(jpr_co2)%laction )   atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 
    810997#endif 
    811998 
     999      !  Fields received by SAS when OASIS coupling 
     1000      !  (arrays no more filled at sbcssm stage) 
     1001      !                                                      ! ================== ! 
     1002      !                                                      !        SSS         ! 
     1003      !                                                      ! ================== ! 
     1004      IF( srcv(jpr_soce)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling 
     1005         sss_m(:,:) = frcv(jpr_soce)%z3(:,:,1) 
     1006         CALL iom_put( 'sss_m', sss_m ) 
     1007      ENDIF 
     1008      !                                                
     1009      !                                                      ! ================== ! 
     1010      !                                                      !        SST         ! 
     1011      !                                                      ! ================== ! 
     1012      IF( srcv(jpr_toce)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling 
     1013         sst_m(:,:) = frcv(jpr_toce)%z3(:,:,1) 
     1014         IF( srcv(jpr_soce)%laction .AND. ln_useCT ) THEN    ! make sure that sst_m is the potential temperature 
     1015            sst_m(:,:) = eos_pt_from_ct( sst_m(:,:), sss_m(:,:) ) 
     1016         ENDIF 
     1017      ENDIF 
     1018      !                                                      ! ================== ! 
     1019      !                                                      !        SSH         ! 
     1020      !                                                      ! ================== ! 
     1021      IF( srcv(jpr_ssh )%laction ) THEN                      ! received by sas in case of opa <-> sas coupling 
     1022         ssh_m(:,:) = frcv(jpr_ssh )%z3(:,:,1) 
     1023         CALL iom_put( 'ssh_m', ssh_m ) 
     1024      ENDIF 
     1025      !                                                      ! ================== ! 
     1026      !                                                      !  surface currents  ! 
     1027      !                                                      ! ================== ! 
     1028      IF( srcv(jpr_ocx1)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling 
     1029         ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) 
     1030         ub (:,:,1) = ssu_m(:,:)                             ! will be used in sbcice_lim in the call of lim_sbc_tau 
     1031         CALL iom_put( 'ssu_m', ssu_m ) 
     1032      ENDIF 
     1033      IF( srcv(jpr_ocy1)%laction ) THEN 
     1034         ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) 
     1035         vb (:,:,1) = ssv_m(:,:)                             ! will be used in sbcice_lim in the call of lim_sbc_tau 
     1036         CALL iom_put( 'ssv_m', ssv_m ) 
     1037      ENDIF 
     1038      !                                                      ! ======================== ! 
     1039      !                                                      !  first T level thickness ! 
     1040      !                                                      ! ======================== ! 
     1041      IF( srcv(jpr_e3t1st )%laction ) THEN                   ! received by sas in case of opa <-> sas coupling 
     1042         e3t_m(:,:) = frcv(jpr_e3t1st )%z3(:,:,1) 
     1043         CALL iom_put( 'e3t_m', e3t_m(:,:) ) 
     1044      ENDIF 
     1045      !                                                      ! ================================ ! 
     1046      !                                                      !  fraction of solar net radiation ! 
     1047      !                                                      ! ================================ ! 
     1048      IF( srcv(jpr_fraqsr)%laction ) THEN                    ! received by sas in case of opa <-> sas coupling 
     1049         frq_m(:,:) = frcv(jpr_fraqsr)%z3(:,:,1) 
     1050         CALL iom_put( 'frq_m', frq_m ) 
     1051      ENDIF 
     1052       
    8121053      !                                                      ! ========================= ! 
    813       IF( k_ice <= 1 ) THEN                                  !  heat & freshwater fluxes ! (Ocean only case) 
     1054      IF( k_ice <= 1 .AND. MOD( kt-1, k_fsbc ) == 0 ) THEN   !  heat & freshwater fluxes ! (Ocean only case) 
    8141055         !                                                   ! ========================= ! 
    8151056         ! 
    8161057         !                                                       ! total freshwater fluxes over the ocean (emp) 
    817          SELECT CASE( TRIM( sn_rcv_emp%cldes ) )                                    ! evaporation - precipitation 
    818          CASE( 'conservative' ) 
    819             emp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) 
    820          CASE( 'oce only', 'oce and ice' ) 
    821             emp(:,:) = frcv(jpr_oemp)%z3(:,:,1) 
    822          CASE default 
    823             CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) 
    824          END SELECT 
     1058         IF( srcv(jpr_oemp)%laction .OR. srcv(jpr_rain)%laction ) THEN 
     1059            SELECT CASE( TRIM( sn_rcv_emp%cldes ) )                                    ! evaporation - precipitation 
     1060            CASE( 'conservative' ) 
     1061               zemp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) 
     1062            CASE( 'oce only', 'oce and ice' ) 
     1063               zemp(:,:) = frcv(jpr_oemp)%z3(:,:,1) 
     1064            CASE default 
     1065               CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) 
     1066            END SELECT 
     1067         ELSE 
     1068            zemp(:,:) = 0._wp 
     1069         ENDIF 
    8251070         ! 
    8261071         !                                                        ! runoffs and calving (added in emp) 
    827          IF( srcv(jpr_rnf)%laction )   emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 
    828          IF( srcv(jpr_cal)%laction )   emp(:,:) = emp(:,:) - frcv(jpr_cal)%z3(:,:,1) 
    829          ! 
    830 !!gm :  this seems to be internal cooking, not sure to need that in a generic interface  
    831 !!gm                                       at least should be optional... 
    832 !!         IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN     ! add to the total freshwater budget 
    833 !!            ! remove negative runoff 
    834 !!            zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )  
    835 !!            zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
    836 !!            IF( lk_mpp )   CALL mpp_sum( zcumulpos )   ! sum over the global domain 
    837 !!            IF( lk_mpp )   CALL mpp_sum( zcumulneg )  
    838 !!            IF( zcumulpos /= 0. ) THEN                 ! distribute negative runoff on positive runoff grid points 
    839 !!               zcumulneg = 1.e0 + zcumulneg / zcumulpos 
    840 !!               frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 
    841 !!            ENDIF      
    842 !!            ! add runoff to e-p  
    843 !!            emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 
    844 !!         ENDIF 
    845 !!gm  end of internal cooking 
     1072         IF( srcv(jpr_rnf)%laction )     rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
     1073         IF( srcv(jpr_cal)%laction )     zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1) 
     1074          
     1075         IF( ln_mixcpl ) THEN   ;   emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:) 
     1076         ELSE                   ;   emp(:,:) =                              zemp(:,:) 
     1077         ENDIF 
    8461078         ! 
    8471079         !                                                       ! non solar heat flux over the ocean (qns) 
    848          IF( srcv(jpr_qnsoce)%laction )   qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 
    849          IF( srcv(jpr_qnsmix)%laction )   qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
    850          ! add the latent heat of solid precip. melting 
    851          IF( srcv(jpr_snow  )%laction )   THEN                         ! update qns over the free ocean with: 
    852               qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus  & ! energy for melting solid precipitation over the free ocean 
    853            &           - emp(:,:) * sst_m(:,:) * rcp                   ! remove heat content due to mass flux (assumed to be at SST) 
     1080         IF(      srcv(jpr_qnsoce)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 
     1081         ELSE IF( srcv(jpr_qnsmix)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
     1082         ELSE                                       ;   zqns(:,:) = 0._wp 
     1083         END IF 
     1084         ! update qns over the free ocean with: 
     1085         IF( nn_components /= jp_iam_opa ) THEN 
     1086            zqns(:,:) =  zqns(:,:) - zemp(:,:) * sst_m(:,:) * rcp         ! remove heat content due to mass flux (assumed to be at SST) 
     1087            IF( srcv(jpr_snow  )%laction ) THEN 
     1088               zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus    ! energy for melting solid precipitation over the free ocean 
     1089            ENDIF 
     1090         ENDIF 
     1091         IF( ln_mixcpl ) THEN   ;   qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:) 
     1092         ELSE                   ;   qns(:,:) =                              zqns(:,:) 
    8541093         ENDIF 
    8551094 
    8561095         !                                                       ! solar flux over the ocean          (qsr) 
    857          IF( srcv(jpr_qsroce)%laction )   qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 
    858          IF( srcv(jpr_qsrmix)%laction )   qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 
    859          IF( ln_dm2dc )   qsr(:,:) = sbc_dcy( qsr )                           ! modify qsr to include the diurnal cycle 
     1096         IF     ( srcv(jpr_qsroce)%laction ) THEN   ;   zqsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 
     1097         ELSE IF( srcv(jpr_qsrmix)%laction ) then   ;   zqsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1098         ELSE                                       ;   zqsr(:,:) = 0._wp 
     1099         ENDIF 
     1100         IF( ln_dm2dc .AND. ln_cpl )   zqsr(:,:) = sbc_dcy( zqsr )   ! modify qsr to include the diurnal cycle 
     1101         IF( ln_mixcpl ) THEN   ;   qsr(:,:) = qsr(:,:) * xcplmask(:,:,0) + zqsr(:,:) * zmsk(:,:) 
     1102         ELSE                   ;   qsr(:,:) =                              zqsr(:,:) 
     1103         ENDIF 
    8601104         ! 
    861    
    862       ENDIF 
    863       ! 
    864       CALL wrk_dealloc( jpi,jpj, ztx, zty ) 
     1105         ! salt flux over the ocean (received by opa in case of opa <-> sas coupling) 
     1106         IF( srcv(jpr_sflx )%laction )   sfx(:,:) = frcv(jpr_sflx  )%z3(:,:,1) 
     1107         ! Ice cover  (received by opa in case of opa <-> sas coupling) 
     1108         IF( srcv(jpr_fice )%laction )   fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1) 
     1109         ! 
     1110 
     1111      ENDIF 
     1112      ! 
     1113      CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 
    8651114      ! 
    8661115      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_rcv') 
     
    9141163      CALL wrk_alloc( jpi,jpj, ztx, zty ) 
    9151164 
    916 !AC Pour eviter un stress nul sur la glace dans le cas mixed oce-ice 
    917       IF( srcv(jpr_itx1)%laction .AND. TRIM( sn_rcv_tau%cldes ) == 'oce and ice') THEN   ;   itx =  jpr_itx1    
     1165      IF( srcv(jpr_itx1)%laction ) THEN   ;   itx =  jpr_itx1    
    9181166      ELSE                                ;   itx =  jpr_otx1 
    9191167      ENDIF 
     
    9221170      IF(  nrcvinfo(itx) == OASIS_Rcv ) THEN 
    9231171 
    924          !                                                                                              ! ======================= ! 
    925 !AC Pour eviter un stress nul sur la glace dans le cas mixes oce-ice 
    926          IF( srcv(jpr_itx1)%laction .AND. TRIM( sn_rcv_tau%cldes ) == 'oce and ice') THEN               !   ice stress received   ! 
    927             !                                                                                           ! ======================= ! 
     1172         !                                                      ! ======================= ! 
     1173         IF( srcv(jpr_itx1)%laction ) THEN                      !   ice stress received   ! 
     1174            !                                                   ! ======================= ! 
    9281175            !   
    9291176            IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN            ! 2 components on the sphere 
     
    9611208            ! 
    9621209         ENDIF 
    963  
    9641210         !                                                      ! ======================= ! 
    9651211         !                                                      !     put on ice grid     ! 
     
    10831329    
    10841330 
    1085    SUBROUTINE sbc_cpl_ice_flx( p_frld  , palbi   , psst    , pist    ) 
     1331   SUBROUTINE sbc_cpl_ice_flx( p_frld, palbi, psst, pist ) 
    10861332      !!---------------------------------------------------------------------- 
    10871333      !!             ***  ROUTINE sbc_cpl_ice_flx  *** 
     
    11251371      REAL(wp), INTENT(in   ), DIMENSION(:,:)   ::   p_frld     ! lead fraction                [0 to 1] 
    11261372      ! optional arguments, used only in 'mixed oce-ice' case 
    1127       REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! ice albedo  
    1128       REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature     [Celcius] 
    1129       REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist    ! ice surface temperature     [Kelvin] 
    1130       ! 
    1131       INTEGER ::   jl   ! dummy loop index 
    1132       REAL(wp), POINTER, DIMENSION(:,:) ::   zcptn, ztmp, zicefr 
     1373      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi      ! all skies ice albedo  
     1374      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst       ! sea surface temperature     [Celsius] 
     1375      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist       ! ice surface temperature     [Kelvin] 
     1376      ! 
     1377      INTEGER ::   jl         ! dummy loop index 
     1378      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zcptn, ztmp, zicefr, zmsk 
     1379      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot 
     1380      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zqns_ice, zqsr_ice, zdqns_ice 
     1381      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zevap, zsnw, zqns_oce, zqsr_oce, zqprec_ice, zqemp_oce ! for LIM3 
    11331382      !!---------------------------------------------------------------------- 
    11341383      ! 
    11351384      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_ice_flx') 
    11361385      ! 
    1137       CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr ) 
    1138  
     1386      CALL wrk_alloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 
     1387      CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 
     1388 
     1389      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0) 
    11391390      zicefr(:,:) = 1.- p_frld(:,:) 
    11401391      zcptn(:,:) = rcp * sst_m(:,:) 
     
    11441395      !                                                      ! ========================= ! 
    11451396      ! 
    1146       !                                                           ! total Precipitations - total Evaporation (emp_tot) 
    1147       !                                                           ! solid precipitation  - sublimation       (emp_ice) 
    1148       !                                                           ! solid Precipitation                      (sprecip) 
     1397      !                                                           ! total Precipitation - total Evaporation (emp_tot) 
     1398      !                                                           ! solid precipitation - sublimation       (emp_ice) 
     1399      !                                                           ! solid Precipitation                     (sprecip) 
     1400      !                                                           ! liquid + solid Precipitation            (tprecip) 
    11491401      SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 
    11501402      CASE( 'conservative'  )   ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp 
    1151          sprecip(:,:) = frcv(jpr_snow)%z3(:,:,1)                 ! May need to ensure positive here 
    1152          tprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + sprecip (:,:) ! May need to ensure positive here 
    1153          emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - tprecip(:,:) 
    1154          emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 
    1155                            CALL iom_put( 'rain'         , frcv(jpr_rain)%z3(:,:,1)              )   ! liquid precipitation  
    1156          IF( lk_diaar5 )   CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from liq. precip.  
    1157          ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 
    1158                            CALL iom_put( 'evap_ao_cea'  , ztmp                            )   ! ice-free oce evap (cell average) 
    1159          IF( lk_diaar5 )   CALL iom_put( 'hflx_evap_cea', ztmp(:,:         ) * zcptn(:,:) )   ! heat flux from from evap (cell ave) 
     1403         zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1)                  ! May need to ensure positive here 
     1404         ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:)  ! May need to ensure positive here 
     1405         zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 
     1406         zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 
     1407            CALL iom_put( 'rain'         , frcv(jpr_rain)%z3(:,:,1)              )   ! liquid precipitation  
     1408         IF( iom_use('hflx_rain_cea') )   & 
     1409            CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from liq. precip.  
     1410         IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') )   & 
     1411            ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 
     1412         IF( iom_use('evap_ao_cea'  ) )   & 
     1413            CALL iom_put( 'evap_ao_cea'  , ztmp                   )   ! ice-free oce evap (cell average) 
     1414         IF( iom_use('hflx_evap_cea') )   & 
     1415            CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) )   ! heat flux from from evap (cell average) 
    11601416      CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 
    1161          emp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 
    1162          emp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 
    1163          sprecip(:,:) = - frcv(jpr_semp)%z3(:,:,1) + frcv(jpr_ievp)%z3(:,:,1) 
     1417         zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 
     1418         zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 
     1419         zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 
     1420         ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) 
    11641421      END SELECT 
    11651422 
    1166       CALL iom_put( 'snowpre'    , sprecip                                )   ! Snow 
    1167       CALL iom_put( 'snow_ao_cea', sprecip(:,:         ) * p_frld(:,:)    )   ! Snow        over ice-free ocean  (cell average) 
    1168       CALL iom_put( 'snow_ai_cea', sprecip(:,:         ) * zicefr(:,:)    )   ! Snow        over sea-ice         (cell average) 
    1169       CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )   ! Sublimation over sea-ice         (cell average) 
     1423      IF( iom_use('subl_ai_cea') )   & 
     1424         CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )   ! Sublimation over sea-ice         (cell average) 
    11701425      !    
    11711426      !                                                           ! runoffs and calving (put in emp_tot) 
    1172       IF( srcv(jpr_rnf)%laction ) THEN  
    1173          emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) 
    1174                            CALL iom_put( 'runoffs'      , frcv(jpr_rnf)%z3(:,:,1)              )   ! rivers 
    1175          IF( lk_diaar5 )   CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from rivers 
    1176       ENDIF 
     1427      IF( srcv(jpr_rnf)%laction )   rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
    11771428      IF( srcv(jpr_cal)%laction ) THEN  
    1178          emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 
    1179          CALL iom_put( 'calving', frcv(jpr_cal)%z3(:,:,1) ) 
    1180       ENDIF 
    1181       ! 
    1182 !!gm :  this seems to be internal cooking, not sure to need that in a generic interface  
    1183 !!gm                                       at least should be optional... 
    1184 !!       ! remove negative runoff                            ! sum over the global domain 
    1185 !!       zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )  
    1186 !!       zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
    1187 !!       IF( lk_mpp )   CALL mpp_sum( zcumulpos ) 
    1188 !!       IF( lk_mpp )   CALL mpp_sum( zcumulneg )  
    1189 !!       IF( zcumulpos /= 0. ) THEN                          ! distribute negative runoff on positive runoff grid points 
    1190 !!          zcumulneg = 1.e0 + zcumulneg / zcumulpos 
    1191 !!          frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 
    1192 !!       ENDIF      
    1193 !!       emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1)   ! add runoff to e-p  
    1194 !! 
    1195 !!gm  end of internal cooking 
     1429         zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 
     1430         CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) ) 
     1431      ENDIF 
     1432 
     1433      IF( ln_mixcpl ) THEN 
     1434         emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) 
     1435         emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:) 
     1436         sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 
     1437         tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 
     1438      ELSE 
     1439         emp_tot(:,:) =                                  zemp_tot(:,:) 
     1440         emp_ice(:,:) =                                  zemp_ice(:,:) 
     1441         sprecip(:,:) =                                  zsprecip(:,:) 
     1442         tprecip(:,:) =                                  ztprecip(:,:) 
     1443      ENDIF 
     1444 
     1445         CALL iom_put( 'snowpre'    , sprecip                                )   ! Snow 
     1446      IF( iom_use('snow_ao_cea') )   & 
     1447         CALL iom_put( 'snow_ao_cea', sprecip(:,:) * p_frld(:,:)             )   ! Snow        over ice-free ocean  (cell average) 
     1448      IF( iom_use('snow_ai_cea') )   & 
     1449         CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:)             )   ! Snow        over sea-ice         (cell average) 
    11961450 
    11971451      !                                                      ! ========================= ! 
     
    11991453      !                                                      ! ========================= ! 
    12001454      CASE( 'oce only' )                                     ! the required field is directly provided 
    1201          qns_tot(:,:  ) = frcv(jpr_qnsoce)%z3(:,:,1) 
     1455         zqns_tot(:,:  ) = frcv(jpr_qnsoce)%z3(:,:,1) 
    12021456      CASE( 'conservative' )                                      ! the required fields are directly provided 
    1203          qns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
     1457         zqns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
    12041458         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 
    1205             qns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 
     1459            zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 
    12061460         ELSE 
    12071461            ! Set all category values equal for the moment 
    12081462            DO jl=1,jpl 
    1209                qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
     1463               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
    12101464            ENDDO 
    12111465         ENDIF 
    12121466      CASE( 'oce and ice' )       ! the total flux is computed from ocean and ice fluxes 
    1213          qns_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 
     1467         zqns_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 
    12141468         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 
    12151469            DO jl=1,jpl 
    1216                qns_tot(:,:   ) = qns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)    
    1217                qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl) 
     1470               zqns_tot(:,:   ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)    
     1471               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl) 
    12181472            ENDDO 
    12191473         ELSE 
     1474            qns_tot(:,:   ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
    12201475            DO jl=1,jpl 
    1221                qns_tot(:,:   ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
    1222                qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
     1476               zqns_tot(:,:   ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
     1477               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
    12231478            ENDDO 
    12241479         ENDIF 
    12251480      CASE( 'mixed oce-ice' )     ! the ice flux is cumputed from the total flux, the SST and ice informations 
    12261481! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 
    1227          qns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
    1228          qns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1)    & 
     1482         zqns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
     1483         zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1)    & 
    12291484            &            + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,:  ) ) * p_frld(:,:)   & 
    12301485            &                                                   +          pist(:,:,1)   * zicefr(:,:) ) ) 
    12311486      END SELECT 
    1232       ztmp(:,:) = p_frld(:,:) * sprecip(:,:) * lfus 
    1233       qns_tot(:,:) = qns_tot(:,:)                         &            ! qns_tot update over free ocean with: 
    1234          &          - ztmp(:,:)                           &            ! remove the latent heat flux of solid precip. melting 
    1235          &          - (  emp_tot(:,:)                     &            ! remove the heat content of mass flux (assumed to be at SST) 
    1236          &             - emp_ice(:,:) * zicefr(:,:)  ) * zcptn(:,:)  
    1237       IF( lk_diaar5 )   CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average) 
    12381487!!gm 
    1239 !!    currently it is taken into account in leads budget but not in the qns_tot, and thus not in  
     1488!!    currently it is taken into account in leads budget but not in the zqns_tot, and thus not in  
    12401489!!    the flux that enter the ocean.... 
    12411490!!    moreover 1 - it is not diagnose anywhere....  
     
    12461495      IF( srcv(jpr_cal)%laction ) THEN                            ! Iceberg melting  
    12471496         ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus               ! add the latent heat of iceberg melting  
    1248          qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:) 
    1249          IF( lk_diaar5 )   CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from calving 
    1250       ENDIF 
     1497         zqns_tot(:,:) = zqns_tot(:,:) - ztmp(:,:) 
     1498         IF( iom_use('hflx_cal_cea') )   & 
     1499            CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from calving 
     1500      ENDIF 
     1501 
     1502      ztmp(:,:) = p_frld(:,:) * zsprecip(:,:) * lfus 
     1503      IF( iom_use('hflx_snow_cea') )    CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average) 
     1504 
     1505#if defined key_lim3 
     1506      CALL wrk_alloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce )  
     1507 
     1508      ! --- evaporation --- ! 
     1509      ! clem: evap_ice is set to 0 for LIM3 since we still do not know what to do with sublimation 
     1510      ! the problem is: the atm. imposes both mass evaporation and heat removed from the snow/ice 
     1511      !                 but it is incoherent WITH the ice model   
     1512      DO jl=1,jpl 
     1513         evap_ice(:,:,jl) = 0._wp  ! should be: frcv(jpr_ievp)%z3(:,:,1) 
     1514      ENDDO 
     1515      zevap(:,:) = zemp_tot(:,:) + ztprecip(:,:) ! evaporation over ocean 
     1516 
     1517      ! --- evaporation minus precipitation --- ! 
     1518      emp_oce(:,:) = emp_tot(:,:) - emp_ice(:,:) 
     1519 
     1520      ! --- non solar flux over ocean --- ! 
     1521      !         note: p_frld cannot be = 0 since we limit the ice concentration to amax 
     1522      zqns_oce = 0._wp 
     1523      WHERE( p_frld /= 0._wp )  zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:) 
     1524 
     1525      ! --- heat flux associated with emp --- ! 
     1526      zsnw(:,:) = 0._wp 
     1527      CALL lim_thd_snwblow( p_frld, zsnw )  ! snow distribution over ice after wind blowing 
     1528      zqemp_oce(:,:) = -      zevap(:,:)                   * p_frld(:,:)      *   zcptn(:,:)   &      ! evap 
     1529         &             + ( ztprecip(:,:) - zsprecip(:,:) )                    *   zcptn(:,:)   &      ! liquid precip 
     1530         &             +   zsprecip(:,:)                   * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean 
     1531      qemp_ice(:,:)  = -   frcv(jpr_ievp)%z3(:,:,1)        * zicefr(:,:)      *   zcptn(:,:)   &      ! ice evap 
     1532         &             +   zsprecip(:,:)                   * zsnw             * ( zcptn(:,:) - lfus ) ! solid precip over ice 
     1533 
     1534      ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 
     1535      zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus ) 
     1536 
     1537      ! --- total non solar flux --- ! 
     1538      zqns_tot(:,:) = zqns_tot(:,:) + qemp_ice(:,:) + zqemp_oce(:,:) 
     1539 
     1540      ! --- in case both coupled/forced are active, we must mix values --- !  
     1541      IF( ln_mixcpl ) THEN 
     1542         qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 
     1543         qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:) 
     1544         DO jl=1,jpl 
     1545            qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) +  zqns_ice(:,:,jl)* zmsk(:,:) 
     1546         ENDDO 
     1547         qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:) 
     1548         qemp_oce (:,:) =  qemp_oce(:,:) * xcplmask(:,:,0) +  zqemp_oce(:,:)* zmsk(:,:) 
     1549!!clem         evap_ice(:,:) = evap_ice(:,:) * xcplmask(:,:,0) 
     1550      ELSE 
     1551         qns_tot  (:,:  ) = zqns_tot  (:,:  ) 
     1552         qns_oce  (:,:  ) = zqns_oce  (:,:  ) 
     1553         qns_ice  (:,:,:) = zqns_ice  (:,:,:) 
     1554         qprec_ice(:,:)   = zqprec_ice(:,:) 
     1555         qemp_oce (:,:)   = zqemp_oce (:,:) 
     1556      ENDIF 
     1557 
     1558      CALL wrk_dealloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce )  
     1559#else 
     1560 
     1561      ! clem: this formulation is certainly wrong... but better than it was... 
     1562      zqns_tot(:,:) = zqns_tot(:,:)                       &            ! zqns_tot update over free ocean with: 
     1563         &          - ztmp(:,:)                           &            ! remove the latent heat flux of solid precip. melting 
     1564         &          - (  zemp_tot(:,:)                    &            ! remove the heat content of mass flux (assumed to be at SST) 
     1565         &             - zemp_ice(:,:) * zicefr(:,:)  ) * zcptn(:,:)  
     1566 
     1567     IF( ln_mixcpl ) THEN 
     1568         qns_tot(:,:) = qns(:,:) * p_frld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk 
     1569         qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) +  zqns_tot(:,:)* zmsk(:,:) 
     1570         DO jl=1,jpl 
     1571            qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) +  zqns_ice(:,:,jl)* zmsk(:,:) 
     1572         ENDDO 
     1573      ELSE 
     1574         qns_tot(:,:  ) = zqns_tot(:,:  ) 
     1575         qns_ice(:,:,:) = zqns_ice(:,:,:) 
     1576      ENDIF 
     1577 
     1578#endif 
    12511579 
    12521580      !                                                      ! ========================= ! 
     
    12541582      !                                                      ! ========================= ! 
    12551583      CASE( 'oce only' ) 
    1256          qsr_tot(:,:  ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 
     1584         zqsr_tot(:,:  ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 
    12571585      CASE( 'conservative' ) 
    1258          qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1586         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
    12591587         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 
    1260             qsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl) 
     1588            zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl) 
    12611589         ELSE 
    12621590            ! Set all category values equal for the moment 
    12631591            DO jl=1,jpl 
    1264                qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
     1592               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
    12651593            ENDDO 
    12661594         ENDIF 
    1267          qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
    1268          qsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 
     1595         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1596         zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 
    12691597      CASE( 'oce and ice' ) 
    1270          qsr_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 
     1598         zqsr_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 
    12711599         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 
    12721600            DO jl=1,jpl 
    1273                qsr_tot(:,:   ) = qsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)    
    1274                qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl) 
     1601               zqsr_tot(:,:   ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)    
     1602               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl) 
    12751603            ENDDO 
    12761604         ELSE 
     1605            qsr_tot(:,:   ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
    12771606            DO jl=1,jpl 
    1278                qsr_tot(:,:   ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
    1279                qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
     1607               zqsr_tot(:,:   ) = zqsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
     1608               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
    12801609            ENDDO 
    12811610         ENDIF 
    12821611      CASE( 'mixed oce-ice' ) 
    1283          qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1612         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
    12841613! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 
    12851614!       Create solar heat flux over ice using incoming solar heat flux and albedos 
    12861615!       ( see OASIS3 user guide, 5th edition, p39 ) 
    1287          qsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) )   & 
     1616         zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) )   & 
    12881617            &            / (  1.- ( albedo_oce_mix(:,:  ) * p_frld(:,:)       & 
    12891618            &                     + palbi         (:,:,1) * zicefr(:,:) ) ) 
    12901619      END SELECT 
    1291       IF( ln_dm2dc ) THEN   ! modify qsr to include the diurnal cycle 
    1292          qsr_tot(:,:  ) = sbc_dcy( qsr_tot(:,:  ) ) 
     1620      IF( ln_dm2dc .AND. ln_cpl ) THEN   ! modify qsr to include the diurnal cycle 
     1621         zqsr_tot(:,:  ) = sbc_dcy( zqsr_tot(:,:  ) ) 
    12931622         DO jl=1,jpl 
    1294             qsr_ice(:,:,jl) = sbc_dcy( qsr_ice(:,:,jl) ) 
     1623            zqsr_ice(:,:,jl) = sbc_dcy( zqsr_ice(:,:,jl) ) 
    12951624         ENDDO 
    12961625      ENDIF 
    12971626 
    1298       SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) 
     1627#if defined key_lim3 
     1628      CALL wrk_alloc( jpi,jpj, zqsr_oce )  
     1629      ! --- solar flux over ocean --- ! 
     1630      !         note: p_frld cannot be = 0 since we limit the ice concentration to amax 
     1631      zqsr_oce = 0._wp 
     1632      WHERE( p_frld /= 0._wp )  zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / p_frld(:,:) 
     1633 
     1634      IF( ln_mixcpl ) THEN   ;   qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) +  zqsr_oce(:,:)* zmsk(:,:) 
     1635      ELSE                   ;   qsr_oce(:,:) = zqsr_oce(:,:)   ;   ENDIF 
     1636 
     1637      CALL wrk_dealloc( jpi,jpj, zqsr_oce )  
     1638#endif 
     1639 
     1640      IF( ln_mixcpl ) THEN 
     1641         qsr_tot(:,:) = qsr(:,:) * p_frld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk 
     1642         qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) +  zqsr_tot(:,:)* zmsk(:,:) 
     1643         DO jl=1,jpl 
     1644            qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) +  zqsr_ice(:,:,jl)* zmsk(:,:) 
     1645         ENDDO 
     1646      ELSE 
     1647         qsr_tot(:,:  ) = zqsr_tot(:,:  ) 
     1648         qsr_ice(:,:,:) = zqsr_ice(:,:,:) 
     1649      ENDIF 
     1650 
     1651      !                                                      ! ========================= ! 
     1652      SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) )             !          d(qns)/dt        ! 
     1653      !                                                      ! ========================= ! 
    12991654      CASE ('coupled') 
    13001655         IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 
    1301             dqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 
     1656            zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 
    13021657         ELSE 
    13031658            ! Set all category values equal for the moment 
    13041659            DO jl=1,jpl 
    1305                dqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1) 
     1660               zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1) 
    13061661            ENDDO 
    13071662         ENDIF 
    13081663      END SELECT 
    1309  
    1310       SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) 
     1664       
     1665      IF( ln_mixcpl ) THEN 
     1666         DO jl=1,jpl 
     1667            dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:) 
     1668         ENDDO 
     1669      ELSE 
     1670         dqns_ice(:,:,:) = zdqns_ice(:,:,:) 
     1671      ENDIF 
     1672       
     1673      !                                                      ! ========================= ! 
     1674      SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) )             !    topmelt and botmelt    ! 
     1675      !                                                      ! ========================= ! 
    13111676      CASE ('coupled') 
    13121677         topmelt(:,:,:)=frcv(jpr_topm)%z3(:,:,:) 
     
    13141679      END SELECT 
    13151680 
    1316       !    Ice Qsr penetration used (only?)in lim2 or lim3  
    1317       ! fraction of net shortwave radiation which is not absorbed in the thin surface layer  
    1318       ! and penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) 
     1681      ! Surface transimission parameter io (Maykut Untersteiner , 1971 ; Ebert and Curry, 1993 ) 
     1682      ! Used for LIM2 and LIM3 
    13191683      ! Coupled case: since cloud cover is not received from atmosphere  
    1320       !               ===> defined as constant value -> definition done in sbc_cpl_init 
    1321       fr1_i0(:,:) = 0.18 
    1322       fr2_i0(:,:) = 0.82 
    1323  
    1324  
    1325       CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr ) 
     1684      !               ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 
     1685      fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 
     1686      fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 
     1687 
     1688      CALL wrk_dealloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 
     1689      CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 
    13261690      ! 
    13271691      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_ice_flx') 
     
    13361700      !! ** Purpose :   provide the ocean-ice informations to the atmosphere 
    13371701      !! 
    1338       !! ** Method  :   send to the atmosphere through a call to cpl_prism_snd 
     1702      !! ** Method  :   send to the atmosphere through a call to cpl_snd 
    13391703      !!              all the needed fields (as defined in sbc_cpl_init) 
    13401704      !!---------------------------------------------------------------------- 
     
    13431707      INTEGER ::   ji, jj, jl   ! dummy loop indices 
    13441708      INTEGER ::   isec, info   ! local integer 
     1709      REAL(wp) ::   zumax, zvmax 
    13451710      REAL(wp), POINTER, DIMENSION(:,:)   ::   zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 
    13461711      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmp3, ztmp4    
     
    13551720 
    13561721      zfr_l(:,:) = 1.- fr_i(:,:) 
    1357  
    13581722      !                                                      ! ------------------------- ! 
    13591723      !                                                      !    Surface temperature    !   in Kelvin 
    13601724      !                                                      ! ------------------------- ! 
    13611725      IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN 
    1362          SELECT CASE( sn_snd_temp%cldes) 
    1363          CASE( 'oce only'             )   ;   ztmp1(:,:) =   tsn(:,:,1,jp_tem) + rt0 
    1364          CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:)    
    1365             SELECT CASE( sn_snd_temp%clcat ) 
    1366             CASE( 'yes' )    
    1367                ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
    1368             CASE( 'no' ) 
    1369                ztmp3(:,:,:) = 0.0 
     1726          
     1727         IF ( nn_components == jp_iam_opa ) THEN 
     1728            ztmp1(:,:) = tsn(:,:,1,jp_tem)   ! send temperature as it is (potential or conservative) -> use of ln_useCT on the received part 
     1729         ELSE 
     1730            ! we must send the surface potential temperature  
     1731            IF( ln_useCT )  THEN    ;   ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 
     1732            ELSE                    ;   ztmp1(:,:) = tsn(:,:,1,jp_tem) 
     1733            ENDIF 
     1734            ! 
     1735            SELECT CASE( sn_snd_temp%cldes) 
     1736            CASE( 'oce only'             )   ;   ztmp1(:,:) =   ztmp1(:,:) + rt0 
     1737            CASE( 'oce and ice'          )   ;   ztmp1(:,:) =   ztmp1(:,:) + rt0 
     1738               SELECT CASE( sn_snd_temp%clcat ) 
     1739               CASE( 'yes' )    
     1740                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) 
     1741               CASE( 'no' ) 
     1742                  WHERE( SUM( a_i, dim=3 ) /= 0. ) 
     1743                     ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 ) 
     1744                  ELSEWHERE 
     1745                     ztmp3(:,:,1) = rt0 ! TODO: Is freezing point a good default? (Maybe SST is better?) 
     1746                  END WHERE 
     1747               CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
     1748               END SELECT 
     1749            CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)    
     1750               SELECT CASE( sn_snd_temp%clcat ) 
     1751               CASE( 'yes' )    
     1752                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
     1753               CASE( 'no' ) 
     1754                  ztmp3(:,:,:) = 0.0 
     1755                  DO jl=1,jpl 
     1756                     ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 
     1757                  ENDDO 
     1758               CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
     1759               END SELECT 
     1760            CASE( 'mixed oce-ice'        )    
     1761               ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)  
    13701762               DO jl=1,jpl 
    1371                   ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 
     1763                  ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 
    13721764               ENDDO 
    1373             CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
     1765            CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 
    13741766            END SELECT 
    1375          CASE( 'mixed oce-ice'        )    
    1376             ztmp1(:,:) = ( tsn(:,:,1,1) + rt0 ) * zfr_l(:,:)  
    1377             DO jl=1,jpl 
    1378                ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 
    1379             ENDDO 
    1380          CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 
     1767         ENDIF 
     1768         IF( ssnd(jps_toce)%laction )   CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
     1769         IF( ssnd(jps_tice)%laction )   CALL cpl_snd( jps_tice, isec, ztmp3, info ) 
     1770         IF( ssnd(jps_tmix)%laction )   CALL cpl_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
     1771      ENDIF 
     1772      !                                                      ! ------------------------- ! 
     1773      !                                                      !           Albedo          ! 
     1774      !                                                      ! ------------------------- ! 
     1775      IF( ssnd(jps_albice)%laction ) THEN                         ! ice  
     1776         SELECT CASE( sn_snd_alb%cldes ) 
     1777         CASE( 'ice'          )   ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) 
     1778         CASE( 'weighted ice' )   ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
     1779         CASE default             ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' ) 
    13811780         END SELECT 
    1382          IF( ssnd(jps_toce)%laction )   CALL cpl_prism_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
    1383          IF( ssnd(jps_tice)%laction )   CALL cpl_prism_snd( jps_tice, isec, ztmp3, info ) 
    1384          IF( ssnd(jps_tmix)%laction )   CALL cpl_prism_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
    1385       ENDIF 
    1386       ! 
    1387       !                                                      ! ------------------------- ! 
    1388       !                                                      !           Albedo          ! 
    1389       !                                                      ! ------------------------- ! 
    1390       IF( ssnd(jps_albice)%laction ) THEN                         ! ice  
    1391          ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
    1392          CALL cpl_prism_snd( jps_albice, isec, ztmp3, info ) 
     1781         CALL cpl_snd( jps_albice, isec, ztmp3, info ) 
    13931782      ENDIF 
    13941783      IF( ssnd(jps_albmix)%laction ) THEN                         ! mixed ice-ocean 
     
    13971786            ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl) 
    13981787         ENDDO 
    1399          CALL cpl_prism_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
     1788         CALL cpl_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
    14001789      ENDIF 
    14011790      !                                                      ! ------------------------- ! 
    14021791      !                                                      !  Ice fraction & Thickness !  
    14031792      !                                                      ! ------------------------- ! 
    1404       ! Send ice fraction field  
     1793      ! Send ice fraction field to atmosphere 
    14051794      IF( ssnd(jps_fice)%laction ) THEN 
    14061795         SELECT CASE( sn_snd_thick%clcat ) 
     
    14091798         CASE default    ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 
    14101799         END SELECT 
    1411          CALL cpl_prism_snd( jps_fice, isec, ztmp3, info ) 
     1800         IF( ssnd(jps_fice)%laction )   CALL cpl_snd( jps_fice, isec, ztmp3, info ) 
     1801      ENDIF 
     1802       
     1803      ! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling) 
     1804      IF( ssnd(jps_fice2)%laction ) THEN 
     1805         ztmp3(:,:,1) = fr_i(:,:) 
     1806         IF( ssnd(jps_fice2)%laction )   CALL cpl_snd( jps_fice2, isec, ztmp3, info ) 
    14121807      ENDIF 
    14131808 
     
    14301825            END SELECT 
    14311826         CASE( 'ice and snow'         )    
    1432             ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) 
    1433             ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) 
     1827            SELECT CASE( sn_snd_thick%clcat ) 
     1828            CASE( 'yes' ) 
     1829               ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) 
     1830               ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) 
     1831            CASE( 'no' ) 
     1832               WHERE( SUM( a_i, dim=3 ) /= 0. ) 
     1833                  ztmp3(:,:,1) = SUM( ht_i * a_i, dim=3 ) / SUM( a_i, dim=3 ) 
     1834                  ztmp4(:,:,1) = SUM( ht_s * a_i, dim=3 ) / SUM( a_i, dim=3 ) 
     1835               ELSEWHERE 
     1836                 ztmp3(:,:,1) = 0. 
     1837                 ztmp4(:,:,1) = 0. 
     1838               END WHERE 
     1839            CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 
     1840            END SELECT 
    14341841         CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' ) 
    14351842         END SELECT 
    1436          IF( ssnd(jps_hice)%laction )   CALL cpl_prism_snd( jps_hice, isec, ztmp3, info ) 
    1437          IF( ssnd(jps_hsnw)%laction )   CALL cpl_prism_snd( jps_hsnw, isec, ztmp4, info ) 
     1843         IF( ssnd(jps_hice)%laction )   CALL cpl_snd( jps_hice, isec, ztmp3, info ) 
     1844         IF( ssnd(jps_hsnw)%laction )   CALL cpl_snd( jps_hsnw, isec, ztmp4, info ) 
    14381845      ENDIF 
    14391846      ! 
     
    14421849      !                                                      !  CO2 flux from PISCES     !  
    14431850      !                                                      ! ------------------------- ! 
    1444       IF( ssnd(jps_co2)%laction )   CALL cpl_prism_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info ) 
     1851      IF( ssnd(jps_co2)%laction )   CALL cpl_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info ) 
    14451852      ! 
    14461853#endif 
     
    14571864         !                                                              i-1  i   i 
    14581865         !                                                               i      i+1 (for I) 
    1459          SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 
    1460          CASE( 'oce only'             )      ! C-grid ==> T 
    1461             DO jj = 2, jpjm1 
    1462                DO ji = fs_2, fs_jpim1   ! vector opt. 
    1463                   zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) ) 
    1464                   zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) )  
    1465                END DO 
    1466             END DO 
    1467          CASE( 'weighted oce and ice' )    
    1468             SELECT CASE ( cp_ice_msh ) 
    1469             CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T 
     1866         IF( nn_components == jp_iam_opa ) THEN 
     1867            zotx1(:,:) = un(:,:,1)   
     1868            zoty1(:,:) = vn(:,:,1)   
     1869         ELSE         
     1870            SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 
     1871            CASE( 'oce only'             )      ! C-grid ==> T 
    14701872               DO jj = 2, jpjm1 
    14711873                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    1472                      zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   
    1473                      zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj) 
    1474                      zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
    1475                      zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
     1874                     zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) ) 
     1875                     zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) )  
    14761876                  END DO 
    14771877               END DO 
    1478             CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T 
    1479                DO jj = 2, jpjm1 
    1480                   DO ji = 2, jpim1   ! NO vector opt. 
    1481                      zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   
    1482                      zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   
    1483                      zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     & 
    1484                         &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1485                      zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     & 
    1486                         &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1878            CASE( 'weighted oce and ice' )    
     1879               SELECT CASE ( cp_ice_msh ) 
     1880               CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T 
     1881                  DO jj = 2, jpjm1 
     1882                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     1883                        zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   
     1884                        zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj) 
     1885                        zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
     1886                        zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
     1887                     END DO 
    14871888                  END DO 
    1488                END DO 
    1489             CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T 
    1490                DO jj = 2, jpjm1 
    1491                   DO ji = 2, jpim1   ! NO vector opt. 
    1492                      zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   
    1493                      zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   
    1494                      zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     & 
    1495                         &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1496                      zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
    1497                         &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1889               CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T 
     1890                  DO jj = 2, jpjm1 
     1891                     DO ji = 2, jpim1   ! NO vector opt. 
     1892                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   
     1893                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   
     1894                        zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     & 
     1895                           &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1896                        zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     & 
     1897                           &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1898                     END DO 
    14981899                  END DO 
    1499                END DO 
     1900               CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T 
     1901                  DO jj = 2, jpjm1 
     1902                     DO ji = 2, jpim1   ! NO vector opt. 
     1903                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   
     1904                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   
     1905                        zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     & 
     1906                           &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1907                        zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
     1908                           &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1909                     END DO 
     1910                  END DO 
     1911               END SELECT 
     1912               CALL lbc_lnk( zitx1, 'T', -1. )   ;   CALL lbc_lnk( zity1, 'T', -1. ) 
     1913            CASE( 'mixed oce-ice'        ) 
     1914               SELECT CASE ( cp_ice_msh ) 
     1915               CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T 
     1916                  DO jj = 2, jpjm1 
     1917                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     1918                        zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   & 
     1919                           &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
     1920                        zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)   & 
     1921                           &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
     1922                     END DO 
     1923                  END DO 
     1924               CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T 
     1925                  DO jj = 2, jpjm1 
     1926                     DO ji = 2, jpim1   ! NO vector opt. 
     1927                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &    
     1928                           &         + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     & 
     1929                           &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1930                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   &  
     1931                           &         + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     & 
     1932                           &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1933                     END DO 
     1934                  END DO 
     1935               CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T 
     1936                  DO jj = 2, jpjm1 
     1937                     DO ji = 2, jpim1   ! NO vector opt. 
     1938                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &    
     1939                           &         + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     & 
     1940                           &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1941                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   &  
     1942                           &         + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
     1943                           &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1944                     END DO 
     1945                  END DO 
     1946               END SELECT 
    15001947            END SELECT 
    1501             CALL lbc_lnk( zitx1, 'T', -1. )   ;   CALL lbc_lnk( zity1, 'T', -1. ) 
    1502          CASE( 'mixed oce-ice'        ) 
    1503             SELECT CASE ( cp_ice_msh ) 
    1504             CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T 
    1505                DO jj = 2, jpjm1 
    1506                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    1507                      zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   & 
    1508                         &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
    1509                      zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)   & 
    1510                         &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
    1511                   END DO 
    1512                END DO 
    1513             CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T 
    1514                DO jj = 2, jpjm1 
    1515                   DO ji = 2, jpim1   ! NO vector opt. 
    1516                      zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &    
    1517                         &         + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     & 
    1518                         &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1519                      zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   &  
    1520                         &         + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     & 
    1521                         &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1522                   END DO 
    1523                END DO 
    1524             CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T 
    1525                DO jj = 2, jpjm1 
    1526                   DO ji = 2, jpim1   ! NO vector opt. 
    1527                      zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &    
    1528                         &         + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     & 
    1529                         &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1530                      zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   &  
    1531                         &         + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
    1532                         &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1533                   END DO 
    1534                END DO 
    1535             END SELECT 
    1536          END SELECT 
    1537          CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. )   ;   CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. ) 
     1948            CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. )   ;   CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. ) 
     1949            ! 
     1950         ENDIF 
    15381951         ! 
    15391952         ! 
     
    15651978         ENDIF 
    15661979         ! 
    1567          IF( ssnd(jps_ocx1)%laction )   CALL cpl_prism_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info )   ! ocean x current 1st grid 
    1568          IF( ssnd(jps_ocy1)%laction )   CALL cpl_prism_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info )   ! ocean y current 1st grid 
    1569          IF( ssnd(jps_ocz1)%laction )   CALL cpl_prism_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info )   ! ocean z current 1st grid 
     1980         IF( ssnd(jps_ocx1)%laction )   CALL cpl_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info )   ! ocean x current 1st grid 
     1981         IF( ssnd(jps_ocy1)%laction )   CALL cpl_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info )   ! ocean y current 1st grid 
     1982         IF( ssnd(jps_ocz1)%laction )   CALL cpl_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info )   ! ocean z current 1st grid 
    15701983         ! 
    1571          IF( ssnd(jps_ivx1)%laction )   CALL cpl_prism_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info )   ! ice   x current 1st grid 
    1572          IF( ssnd(jps_ivy1)%laction )   CALL cpl_prism_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info )   ! ice   y current 1st grid 
    1573          IF( ssnd(jps_ivz1)%laction )   CALL cpl_prism_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info )   ! ice   z current 1st grid 
     1984         IF( ssnd(jps_ivx1)%laction )   CALL cpl_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info )   ! ice   x current 1st grid 
     1985         IF( ssnd(jps_ivy1)%laction )   CALL cpl_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info )   ! ice   y current 1st grid 
     1986         IF( ssnd(jps_ivz1)%laction )   CALL cpl_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info )   ! ice   z current 1st grid 
    15741987         !  
    15751988      ENDIF 
    15761989      ! 
     1990      ! 
     1991      !  Fields sent by OPA to SAS when doing OPA<->SAS coupling 
     1992      !                                                        ! SSH 
     1993      IF( ssnd(jps_ssh )%laction )  THEN 
     1994         !                          ! removed inverse barometer ssh when Patm 
     1995         !                          forcing is used (for sea-ice dynamics) 
     1996         IF( ln_apr_dyn ) THEN   ;   ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
     1997         ELSE                    ;   ztmp1(:,:) = sshn(:,:) 
     1998         ENDIF 
     1999         CALL cpl_snd( jps_ssh   , isec, RESHAPE ( ztmp1            , (/jpi,jpj,1/) ), info ) 
     2000 
     2001      ENDIF 
     2002      !                                                        ! SSS 
     2003      IF( ssnd(jps_soce  )%laction )  THEN 
     2004         CALL cpl_snd( jps_soce  , isec, RESHAPE ( tsn(:,:,1,jp_sal), (/jpi,jpj,1/) ), info ) 
     2005      ENDIF 
     2006      !                                                        ! first T level thickness  
     2007      IF( ssnd(jps_e3t1st )%laction )  THEN 
     2008         CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( fse3t_n(:,:,1)   , (/jpi,jpj,1/) ), info ) 
     2009      ENDIF 
     2010      !                                                        ! Qsr fraction 
     2011      IF( ssnd(jps_fraqsr)%laction )  THEN 
     2012         CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( fraqsr_1lev(:,:) , (/jpi,jpj,1/) ), info ) 
     2013      ENDIF 
     2014      ! 
     2015      !  Fields sent by SAS to OPA when OASIS coupling 
     2016      !                                                        ! Solar heat flux 
     2017      IF( ssnd(jps_qsroce)%laction )  CALL cpl_snd( jps_qsroce, isec, RESHAPE ( qsr , (/jpi,jpj,1/) ), info ) 
     2018      IF( ssnd(jps_qnsoce)%laction )  CALL cpl_snd( jps_qnsoce, isec, RESHAPE ( qns , (/jpi,jpj,1/) ), info ) 
     2019      IF( ssnd(jps_oemp  )%laction )  CALL cpl_snd( jps_oemp  , isec, RESHAPE ( emp , (/jpi,jpj,1/) ), info ) 
     2020      IF( ssnd(jps_sflx  )%laction )  CALL cpl_snd( jps_sflx  , isec, RESHAPE ( sfx , (/jpi,jpj,1/) ), info ) 
     2021      IF( ssnd(jps_otx1  )%laction )  CALL cpl_snd( jps_otx1  , isec, RESHAPE ( utau, (/jpi,jpj,1/) ), info ) 
     2022      IF( ssnd(jps_oty1  )%laction )  CALL cpl_snd( jps_oty1  , isec, RESHAPE ( vtau, (/jpi,jpj,1/) ), info ) 
     2023      IF( ssnd(jps_rnf   )%laction )  CALL cpl_snd( jps_rnf   , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info ) 
     2024      IF( ssnd(jps_taum  )%laction )  CALL cpl_snd( jps_taum  , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info ) 
     2025 
    15772026      CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 
    15782027      CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 ) 
     
    15822031   END SUBROUTINE sbc_cpl_snd 
    15832032    
    1584 #else 
    1585    !!---------------------------------------------------------------------- 
    1586    !!   Dummy module                                            NO coupling 
    1587    !!---------------------------------------------------------------------- 
    1588    USE par_kind        ! kind definition 
    1589 CONTAINS 
    1590    SUBROUTINE sbc_cpl_snd( kt ) 
    1591       WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', kt 
    1592    END SUBROUTINE sbc_cpl_snd 
    1593    ! 
    1594    SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice )      
    1595       WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', kt, k_fsbc, k_ice 
    1596    END SUBROUTINE sbc_cpl_rcv 
    1597    ! 
    1598    SUBROUTINE sbc_cpl_ice_tau( p_taui, p_tauj )      
    1599       REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_taui   ! i- & j-components of atmos-ice stress [N/m2] 
    1600       REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_tauj   ! at I-point (B-grid) or U & V-point (C-grid) 
    1601       p_taui(:,:) = 0.   ;   p_tauj(:,:) = 0. ! stupid definition to avoid warning message when compiling... 
    1602       WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?' 
    1603    END SUBROUTINE sbc_cpl_ice_tau 
    1604    ! 
    1605    SUBROUTINE sbc_cpl_ice_flx( p_frld , palbi   , psst    , pist  ) 
    1606       REAL(wp), INTENT(in   ), DIMENSION(:,:  ) ::   p_frld     ! lead fraction                [0 to 1] 
    1607       REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! ice albedo 
    1608       REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature      [Celcius] 
    1609       REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist    ! ice surface temperature      [Kelvin] 
    1610       WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', p_frld(1,1), palbi(1,1,1), psst(1,1), pist(1,1,1)  
    1611    END SUBROUTINE sbc_cpl_ice_flx 
    1612     
    1613 #endif 
    1614  
    16152033   !!====================================================================== 
    16162034END MODULE sbccpl 
Note: See TracChangeset for help on using the changeset viewer.