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 5575 for branches/UKMO/dev_r5107_hadgem3_cplfld/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 – NEMO

Ignore:
Timestamp:
2015-07-09T12:44:22+02:00 (9 years ago)
Author:
davestorkey
Message:

Update UKMO/dev_r5107_hadgem3_cplfld branch to trunk revision 5518
(= branching point of NEMO 3.6_stable).

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5107_hadgem3_cplfld/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r5490 r5575  
    2121   USE sbc_oce         ! Surface boundary condition: ocean fields 
    2222   USE sbc_ice         ! Surface boundary condition: ice fields 
     23   USE sbcapr 
    2324   USE sbcdcy          ! surface boundary condition: diurnal cycle 
    2425   USE phycst          ! physical constants 
    2526#if defined key_lim3 
    26    USE par_ice         ! ice parameters 
    2727   USE ice             ! ice variables 
    2828#endif 
     
    3333   USE cpl_oasis3      ! OASIS3 coupling 
    3434   USE geo2ocean       !  
    35    USE oce   , ONLY : tsn, un, vn 
     35   USE oce   , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev 
    3636   USE albedo          ! 
    3737   USE in_out_manager  ! I/O manager 
     
    4141   USE timing          ! Timing 
    4242   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     43   USE eosbn2 
     44   USE sbcrnf   , ONLY : l_rnfcpl 
    4345#if defined key_cpl_carbon_cycle 
    4446   USE p4zflx, ONLY : oce_co2 
     
    4749   USE ice_domain_size, only: ncat 
    4850#endif 
     51#if defined key_lim3 
     52   USE limthd_dh       ! for CALL lim_thd_snwblow 
     53#endif 
     54 
    4955   IMPLICIT NONE 
    5056   PRIVATE 
    51 !EM XIOS-OASIS-MCT compliance 
     57 
    5258   PUBLIC   sbc_cpl_init       ! routine called by sbcmod.F90 
    5359   PUBLIC   sbc_cpl_rcv        ! routine called by sbc_ice_lim(_2).F90 
     
    9096   INTEGER, PARAMETER ::   jpr_topm   = 32            ! topmeltn 
    9197   INTEGER, PARAMETER ::   jpr_botm   = 33            ! botmeltn 
    92    INTEGER, PARAMETER ::   jprcv      = 33            ! total number of fields received 
    93  
    94    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 
    95110   INTEGER, PARAMETER ::   jps_toce   =  2            ! ocean temperature 
    96111   INTEGER, PARAMETER ::   jps_tice   =  3            ! ice   temperature 
     
    107122   INTEGER, PARAMETER ::   jps_ivz1   = 14            ! 
    108123   INTEGER, PARAMETER ::   jps_co2    = 15 
    109    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 
    110138 
    111139   !                                                         !!** namelist namsbc_cpl ** 
     
    126154   LOGICAL     ::   ln_usecplmask          !  use a coupling mask file to merge data received from several models 
    127155                                           !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
    128  
    129    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: xcplmask 
    130  
    131156   TYPE ::   DYNARR      
    132157      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   z3    
     
    140165 
    141166   !! Substitution 
     167#  include "domzgr_substitute.h90" 
    142168#  include "vectopt_loop_substitute.h90" 
    143169   !!---------------------------------------------------------------------- 
     
    162188      ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) )  ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) 
    163189#endif 
    164       ALLOCATE( xcplmask(jpi,jpj,nn_cplmodel) , STAT=ierr(3) ) 
     190      ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 
    165191      ! 
    166192      sbc_cpl_alloc = MAXVAL( ierr ) 
     
    183209      !!              * initialise the OASIS coupler 
    184210      !!---------------------------------------------------------------------- 
    185       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) 
    186212      !! 
    187213      INTEGER ::   jn   ! dummy loop index 
     
    217243         WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist ' 
    218244         WRITE(numout,*)'~~~~~~~~~~~~' 
     245      ENDIF 
     246      IF( lwp .AND. ln_cpl ) THEN                        ! control print 
    219247         WRITE(numout,*)'  received fields (mutiple ice categogies)' 
    220248         WRITE(numout,*)'      10m wind module                 = ', TRIM(sn_rcv_w10m%cldes  ), ' (', TRIM(sn_rcv_w10m%clcat  ), ')' 
     
    364392      srcv(jpr_oemp)%clname = 'OOEvaMPr'      ! ocean water budget = ocean Evap - ocean precip 
    365393      SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 
     394      CASE( 'none'          )       ! nothing to do 
    366395      CASE( 'oce only'      )   ;   srcv(                                 jpr_oemp   )%laction = .TRUE.  
    367396      CASE( 'conservative'  ) 
     
    375404      !                                                      !     Runoffs & Calving     !    
    376405      !                                                      ! ------------------------- ! 
    377       srcv(jpr_rnf   )%clname = 'O_Runoff'   ;   IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' )   srcv(jpr_rnf)%laction = .TRUE. 
    378 ! This isn't right - really just want ln_rnf_emp changed 
    379 !                                                 IF( TRIM( sn_rcv_rnf%cldes ) == 'climato' )   THEN   ;   ln_rnf = .TRUE. 
    380 !                                                 ELSE                                                 ;   ln_rnf = .FALSE. 
    381 !                                                 ENDIF 
     406      srcv(jpr_rnf   )%clname = 'O_Runoff' 
     407      IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN 
     408         srcv(jpr_rnf)%laction = .TRUE. 
     409         l_rnfcpl              = .TRUE.                      ! -> no need to read runoffs in sbcrnf 
     410         ln_rnf                = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas 
     411         IF(lwp) WRITE(numout,*) 
     412         IF(lwp) WRITE(numout,*) '   runoffs received from oasis -> force ln_rnf = ', ln_rnf 
     413      ENDIF 
     414      ! 
    382415      srcv(jpr_cal   )%clname = 'OCalving'   ;   IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE. 
    383416 
     
    389422      srcv(jpr_qnsmix)%clname = 'O_QnsMix' 
    390423      SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) 
     424      CASE( 'none'          )       ! nothing to do 
    391425      CASE( 'oce only'      )   ;   srcv(               jpr_qnsoce   )%laction = .TRUE. 
    392426      CASE( 'conservative'  )   ;   srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE. 
     
    404438      srcv(jpr_qsrmix)%clname = 'O_QsrMix' 
    405439      SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) 
     440      CASE( 'none'          )       ! nothing to do 
    406441      CASE( 'oce only'      )   ;   srcv(               jpr_qsroce   )%laction = .TRUE. 
    407442      CASE( 'conservative'  )   ;   srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE. 
     
    419454      ! 
    420455      ! non solar sensitivity mandatory for LIM ice model 
    421       IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4) & 
     456      IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4 .AND. nn_components /= jp_iam_sas ) & 
    422457         CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' ) 
    423458      ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique 
     
    452487         srcv(jpr_topm:jpr_botm)%laction = .TRUE. 
    453488      ENDIF 
    454  
    455       ! Allocate all parts of frcv used for received fields 
     489      !                                                      ! ------------------------------- ! 
     490      !                                                      !   OPA-SAS coupling - rcv by opa !    
     491      !                                                      ! ------------------------------- ! 
     492      srcv(jpr_sflx)%clname = 'O_SFLX' 
     493      srcv(jpr_fice)%clname = 'RIceFrc' 
     494      ! 
     495      IF( nn_components == jp_iam_opa ) THEN    ! OPA coupled to SAS via OASIS: force received field by OPA (sent by SAS) 
     496         srcv(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling 
     497         srcv(:)%clgrid  = 'T'       ! force default definition in case of opa <-> sas coupling 
     498         srcv(:)%nsgn    = 1.        ! force default definition in case of opa <-> sas coupling 
     499         srcv( (/jpr_qsroce, jpr_qnsoce, jpr_oemp, jpr_sflx, jpr_fice, jpr_otx1, jpr_oty1, jpr_taum/) )%laction = .TRUE. 
     500         srcv(jpr_otx1)%clgrid = 'U'        ! oce components given at U-point 
     501         srcv(jpr_oty1)%clgrid = 'V'        !           and           V-point 
     502         ! Vectors: change of sign at north fold ONLY if on the local grid 
     503         srcv( (/jpr_otx1,jpr_oty1/) )%nsgn = -1. 
     504         sn_rcv_tau%clvgrd = 'U,V' 
     505         sn_rcv_tau%clvor = 'local grid' 
     506         sn_rcv_tau%clvref = 'spherical' 
     507         sn_rcv_emp%cldes = 'oce only' 
     508         ! 
     509         IF(lwp) THEN                        ! control print 
     510            WRITE(numout,*) 
     511            WRITE(numout,*)'               Special conditions for SAS-OPA coupling  ' 
     512            WRITE(numout,*)'               OPA component  ' 
     513            WRITE(numout,*) 
     514            WRITE(numout,*)'  received fields from SAS component ' 
     515            WRITE(numout,*)'                  ice cover ' 
     516            WRITE(numout,*)'                  oce only EMP  ' 
     517            WRITE(numout,*)'                  salt flux  ' 
     518            WRITE(numout,*)'                  mixed oce-ice solar flux  ' 
     519            WRITE(numout,*)'                  mixed oce-ice non solar flux  ' 
     520            WRITE(numout,*)'                  wind stress U,V on local grid and sperical coordinates ' 
     521            WRITE(numout,*)'                  wind stress module' 
     522            WRITE(numout,*) 
     523         ENDIF 
     524      ENDIF 
     525      !                                                      ! -------------------------------- ! 
     526      !                                                      !   OPA-SAS coupling - rcv by sas  !    
     527      !                                                      ! -------------------------------- ! 
     528      srcv(jpr_toce  )%clname = 'I_SSTSST' 
     529      srcv(jpr_soce  )%clname = 'I_SSSal' 
     530      srcv(jpr_ocx1  )%clname = 'I_OCurx1' 
     531      srcv(jpr_ocy1  )%clname = 'I_OCury1' 
     532      srcv(jpr_ssh   )%clname = 'I_SSHght' 
     533      srcv(jpr_e3t1st)%clname = 'I_E3T1st'    
     534      srcv(jpr_fraqsr)%clname = 'I_FraQsr'    
     535      ! 
     536      IF( nn_components == jp_iam_sas ) THEN 
     537         IF( .NOT. ln_cpl ) srcv(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling 
     538         IF( .NOT. ln_cpl ) srcv(:)%clgrid  = 'T'       ! force default definition in case of opa <-> sas coupling 
     539         IF( .NOT. ln_cpl ) srcv(:)%nsgn    = 1.        ! force default definition in case of opa <-> sas coupling 
     540         srcv( (/jpr_toce, jpr_soce, jpr_ssh, jpr_fraqsr, jpr_ocx1, jpr_ocy1/) )%laction = .TRUE. 
     541         srcv( jpr_e3t1st )%laction = lk_vvl 
     542         srcv(jpr_ocx1)%clgrid = 'U'        ! oce components given at U-point 
     543         srcv(jpr_ocy1)%clgrid = 'V'        !           and           V-point 
     544         ! Vectors: change of sign at north fold ONLY if on the local grid 
     545         srcv(jpr_ocx1:jpr_ocy1)%nsgn = -1. 
     546         ! Change first letter to couple with atmosphere if already coupled OPA 
     547         ! this is nedeed as each variable name used in the namcouple must be unique: 
     548         ! for example O_Runoff received by OPA from SAS and therefore O_Runoff received by SAS from the Atmosphere 
     549         DO jn = 1, jprcv 
     550            IF ( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname)) 
     551         END DO 
     552         ! 
     553         IF(lwp) THEN                        ! control print 
     554            WRITE(numout,*) 
     555            WRITE(numout,*)'               Special conditions for SAS-OPA coupling  ' 
     556            WRITE(numout,*)'               SAS component  ' 
     557            WRITE(numout,*) 
     558            IF( .NOT. ln_cpl ) THEN 
     559               WRITE(numout,*)'  received fields from OPA component ' 
     560            ELSE 
     561               WRITE(numout,*)'  Additional received fields from OPA component : ' 
     562            ENDIF 
     563            WRITE(numout,*)'               sea surface temperature (Celcius) ' 
     564            WRITE(numout,*)'               sea surface salinity '  
     565            WRITE(numout,*)'               surface currents '  
     566            WRITE(numout,*)'               sea surface height '  
     567            WRITE(numout,*)'               thickness of first ocean T level '         
     568            WRITE(numout,*)'               fraction of solar net radiation absorbed in the first ocean level' 
     569            WRITE(numout,*) 
     570         ENDIF 
     571      ENDIF 
     572       
     573      ! =================================================== ! 
     574      ! Allocate all parts of frcv used for received fields ! 
     575      ! =================================================== ! 
    456576      DO jn = 1, jprcv 
    457577         IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 
     
    459579      ! Allocate taum part of frcv which is used even when not received as coupling field 
    460580      IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 
     581      ! Allocate w10m part of frcv which is used even when not received as coupling field 
     582      IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 
     583      ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 
     584      IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 
     585      IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 
    461586      ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 
    462587      IF( k_ice /= 0 ) THEN 
     
    482607      ssnd(jps_tmix)%clname = 'O_TepMix' 
    483608      SELECT CASE( TRIM( sn_snd_temp%cldes ) ) 
    484       CASE( 'none'         )       ! nothing to do 
    485       CASE( 'oce only'             )   ;   ssnd(   jps_toce            )%laction = .TRUE. 
    486       CASE( 'weighted oce and ice' ) 
     609      CASE( 'none'                                 )       ! nothing to do 
     610      CASE( 'oce only'                             )   ;   ssnd( jps_toce )%laction = .TRUE. 
     611      CASE( 'oce and ice' , 'weighted oce and ice' ) 
    487612         ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 
    488613         IF ( TRIM( sn_snd_temp%clcat ) == 'yes' )  ssnd(jps_tice)%nct = jpl 
    489       CASE( 'mixed oce-ice'        )   ;   ssnd(   jps_tmix            )%laction = .TRUE. 
     614      CASE( 'mixed oce-ice'                        )   ;   ssnd( jps_tmix )%laction = .TRUE. 
    490615      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' ) 
    491616      END SELECT 
    492       
     617            
    493618      !                                                      ! ------------------------- ! 
    494619      !                                                      !          Albedo           ! 
     
    497622      ssnd(jps_albmix)%clname = 'O_AlbMix' 
    498623      SELECT CASE( TRIM( sn_snd_alb%cldes ) ) 
    499       CASE( 'none'               ! nothing to do 
    500       CASE( 'weighted ice'  )   ;  ssnd(jps_albice)%laction = .TRUE. 
    501       CASE( 'mixed oce-ice' )   ;  ssnd(jps_albmix)%laction = .TRUE. 
     624      CASE( 'none'                 )     ! nothing to do 
     625      CASE( 'ice' , 'weighted ice' )   ; ssnd(jps_albice)%laction = .TRUE. 
     626      CASE( 'mixed oce-ice'        )   ; ssnd(jps_albmix)%laction = .TRUE. 
    502627      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_alb%cldes' ) 
    503628      END SELECT 
     
    523648         IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl 
    524649      ENDIF 
    525  
     650       
    526651      SELECT CASE ( TRIM( sn_snd_thick%cldes ) ) 
    527652      CASE( 'none'         )       ! nothing to do 
     
    530655         IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN 
    531656            ssnd(jps_hice:jps_hsnw)%nct = jpl 
    532          ELSE 
    533             IF ( jpl > 1 ) THEN 
    534 CALL ctl_stop( 'sbc_cpl_init: use weighted ice and snow option for sn_snd_thick%cldes if not exchanging category fields' ) 
    535             ENDIF 
    536657         ENDIF 
    537658      CASE ( 'weighted ice and snow' )  
     
    572693      !                                                      ! ------------------------- ! 
    573694      ssnd(jps_co2)%clname = 'O_CO2FLX' ;  IF( TRIM(sn_snd_co2%cldes) == 'coupled' )    ssnd(jps_co2 )%laction = .TRUE. 
     695 
     696      !                                                      ! ------------------------------- ! 
     697      !                                                      !   OPA-SAS coupling - snd by opa !    
     698      !                                                      ! ------------------------------- ! 
     699      ssnd(jps_ssh   )%clname = 'O_SSHght'  
     700      ssnd(jps_soce  )%clname = 'O_SSSal'  
     701      ssnd(jps_e3t1st)%clname = 'O_E3T1st'    
     702      ssnd(jps_fraqsr)%clname = 'O_FraQsr' 
     703      ! 
     704      IF( nn_components == jp_iam_opa ) THEN 
     705         ssnd(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling 
     706         ssnd( (/jps_toce, jps_soce, jps_ssh, jps_fraqsr, jps_ocx1, jps_ocy1/) )%laction = .TRUE. 
     707         ssnd( jps_e3t1st )%laction = lk_vvl 
     708         ! vector definition: not used but cleaner... 
     709         ssnd(jps_ocx1)%clgrid  = 'U'        ! oce components given at U-point 
     710         ssnd(jps_ocy1)%clgrid  = 'V'        !           and           V-point 
     711         sn_snd_crt%clvgrd = 'U,V' 
     712         sn_snd_crt%clvor = 'local grid' 
     713         sn_snd_crt%clvref = 'spherical' 
     714         ! 
     715         IF(lwp) THEN                        ! control print 
     716            WRITE(numout,*) 
     717            WRITE(numout,*)'  sent fields to SAS component ' 
     718            WRITE(numout,*)'               sea surface temperature (T before, Celcius) ' 
     719            WRITE(numout,*)'               sea surface salinity '  
     720            WRITE(numout,*)'               surface currents U,V on local grid and spherical coordinates'  
     721            WRITE(numout,*)'               sea surface height '  
     722            WRITE(numout,*)'               thickness of first ocean T level '         
     723            WRITE(numout,*)'               fraction of solar net radiation absorbed in the first ocean level' 
     724            WRITE(numout,*) 
     725         ENDIF 
     726      ENDIF 
     727      !                                                      ! ------------------------------- ! 
     728      !                                                      !   OPA-SAS coupling - snd by sas !    
     729      !                                                      ! ------------------------------- ! 
     730      ssnd(jps_sflx  )%clname = 'I_SFLX'      
     731      ssnd(jps_fice2 )%clname = 'IIceFrc' 
     732      ssnd(jps_qsroce)%clname = 'I_QsrOce'    
     733      ssnd(jps_qnsoce)%clname = 'I_QnsOce'    
     734      ssnd(jps_oemp  )%clname = 'IOEvaMPr'  
     735      ssnd(jps_otx1  )%clname = 'I_OTaux1'    
     736      ssnd(jps_oty1  )%clname = 'I_OTauy1'    
     737      ssnd(jps_rnf   )%clname = 'I_Runoff'    
     738      ssnd(jps_taum  )%clname = 'I_TauMod'    
     739      ! 
     740      IF( nn_components == jp_iam_sas ) THEN 
     741         IF( .NOT. ln_cpl ) ssnd(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling 
     742         ssnd( (/jps_qsroce, jps_qnsoce, jps_oemp, jps_fice2, jps_sflx, jps_otx1, jps_oty1, jps_taum/) )%laction = .TRUE. 
     743         ! 
     744         ! Change first letter to couple with atmosphere if already coupled with sea_ice 
     745         ! this is nedeed as each variable name used in the namcouple must be unique: 
     746         ! for example O_SSTSST sent by OPA to SAS and therefore S_SSTSST sent by SAS to the Atmosphere 
     747         DO jn = 1, jpsnd 
     748            IF ( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname)) 
     749         END DO 
     750         ! 
     751         IF(lwp) THEN                        ! control print 
     752            WRITE(numout,*) 
     753            IF( .NOT. ln_cpl ) THEN 
     754               WRITE(numout,*)'  sent fields to OPA component ' 
     755            ELSE 
     756               WRITE(numout,*)'  Additional sent fields to OPA component : ' 
     757            ENDIF 
     758            WRITE(numout,*)'                  ice cover ' 
     759            WRITE(numout,*)'                  oce only EMP  ' 
     760            WRITE(numout,*)'                  salt flux  ' 
     761            WRITE(numout,*)'                  mixed oce-ice solar flux  ' 
     762            WRITE(numout,*)'                  mixed oce-ice non solar flux  ' 
     763            WRITE(numout,*)'                  wind stress U,V components' 
     764            WRITE(numout,*)'                  wind stress module' 
     765         ENDIF 
     766      ENDIF 
     767 
    574768      ! 
    575769      ! ================================ ! 
     
    577771      ! ================================ ! 
    578772 
    579       CALL cpl_define(jprcv, jpsnd,nn_cplmodel)             
     773      CALL cpl_define(jprcv, jpsnd, nn_cplmodel) 
     774       
    580775      IF (ln_usecplmask) THEN  
    581776         xcplmask(:,:,:) = 0. 
     
    587782         xcplmask(:,:,:) = 1. 
    588783      ENDIF 
    589       ! 
    590       IF( ln_dm2dc .AND. ( cpl_freq( jpr_qsroce ) + cpl_freq( jpr_qsrmix ) /= 86400 ) )   & 
     784      xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 ) 
     785      ! 
     786      ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'I_QsrOce' ) + cpl_freq( 'I_QsrMix' ) 
     787      IF( ln_dm2dc .AND. ln_cpl .AND. ncpl_qsr_freq /= 86400 )   & 
    591788         &   CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 
     789      ncpl_qsr_freq = 86400 / ncpl_qsr_freq 
    592790 
    593791      CALL wrk_dealloc( jpi,jpj, zacs, zaos ) 
     
    643841      !!                        emp          upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case) 
    644842      !!---------------------------------------------------------------------- 
    645       INTEGER, INTENT(in) ::   kt       ! ocean model time step index 
    646       INTEGER, INTENT(in) ::   k_fsbc   ! frequency of sbc (-> ice model) computation  
    647       INTEGER, INTENT(in) ::   k_ice    ! ice management in the sbc (=0/1/2/3) 
    648       !! 
    649       LOGICAL ::    llnewtx, llnewtau      ! update wind stress components and module?? 
     843      INTEGER, INTENT(in)           ::   kt          ! ocean model time step index 
     844      INTEGER, INTENT(in)           ::   k_fsbc      ! frequency of sbc (-> ice model) computation  
     845      INTEGER, INTENT(in)           ::   k_ice       ! ice management in the sbc (=0/1/2/3) 
     846 
     847      !! 
     848      LOGICAL  ::   llnewtx, llnewtau      ! update wind stress components and module?? 
    650849      INTEGER  ::   ji, jj, jn             ! dummy loop indices 
    651850      INTEGER  ::   isec                   ! number of seconds since nit000 (assuming rdttra did not change since nit000) 
     
    656855      REAL(wp) ::   zcdrag = 1.5e-3        ! drag coefficient 
    657856      REAL(wp) ::   zzx, zzy               ! temporary variables 
    658       REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty , ztx2, zty2 
     857      REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 
    659858      !!---------------------------------------------------------------------- 
    660859      ! 
    661860      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_rcv') 
    662861      ! 
    663       CALL wrk_alloc( jpi,jpj, ztx, zty , ztx2, zty2) 
    664       !                                                 ! Receive all the atmos. fields (including ice information) 
    665       isec = ( kt - nit000 ) * NINT( rdttra(1) )             ! date of exchanges 
    666       DO jn = 1, jprcv                                       ! received fields sent by the atmosphere 
    667          IF( srcv(jn)%laction )   CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask, nrcvinfo(jn) ) 
     862      CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 ) 
     863      ! 
     864      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0) 
     865      ! 
     866      !                                                      ! ======================================================= ! 
     867      !                                                      ! Receive all the atmos. fields (including ice information) 
     868      !                                                      ! ======================================================= ! 
     869      isec = ( kt - nit000 ) * NINT( rdttra(1) )                ! date of exchanges 
     870      DO jn = 1, jprcv                                          ! received fields sent by the atmosphere 
     871         IF( srcv(jn)%laction )   CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) 
    668872      END DO 
    669873 
     
    747951         ! 
    748952      ENDIF 
    749        
    750953      !                                                      ! ========================= ! 
    751954      !                                                      !    wind stress module     !   (taum) 
     
    776979         ENDIF 
    777980      ENDIF 
    778        
     981      ! 
    779982      !                                                      ! ========================= ! 
    780983      !                                                      !      10 m wind speed      !   (wndm) 
     
    789992!CDIR NOVERRCHK 
    790993               DO ji = 1, jpi  
    791                   wndm(ji,jj) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 
     994                  frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 
    792995               END DO 
    793996            END DO 
    794997         ENDIF 
    795       ELSE 
    796          IF ( nrcvinfo(jpr_w10m) == OASIS_Rcv ) wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1) 
    797998      ENDIF 
    798999 
     
    8011002      IF( MOD( kt-1, k_fsbc ) == 0 ) THEN 
    8021003         ! 
    803          utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 
    804          vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 
    805          taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 
     1004         IF( ln_mixcpl ) THEN 
     1005            utau(:,:) = utau(:,:) * xcplmask(:,:,0) + frcv(jpr_otx1)%z3(:,:,1) * zmsk(:,:) 
     1006            vtau(:,:) = vtau(:,:) * xcplmask(:,:,0) + frcv(jpr_oty1)%z3(:,:,1) * zmsk(:,:) 
     1007            taum(:,:) = taum(:,:) * xcplmask(:,:,0) + frcv(jpr_taum)%z3(:,:,1) * zmsk(:,:) 
     1008            wndm(:,:) = wndm(:,:) * xcplmask(:,:,0) + frcv(jpr_w10m)%z3(:,:,1) * zmsk(:,:) 
     1009         ELSE 
     1010            utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 
     1011            vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 
     1012            taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 
     1013            wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1) 
     1014         ENDIF 
    8061015         CALL iom_put( "taum_oce", taum )   ! output wind stress module 
    8071016         !   
     
    8091018 
    8101019#if defined key_cpl_carbon_cycle 
    811       !                                                              ! atmosph. CO2 (ppm) 
     1020      !                                                      ! ================== ! 
     1021      !                                                      ! atmosph. CO2 (ppm) ! 
     1022      !                                                      ! ================== ! 
    8121023      IF( srcv(jpr_co2)%laction )   atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 
    8131024#endif 
    8141025 
     1026      !  Fields received by SAS when OASIS coupling 
     1027      !  (arrays no more filled at sbcssm stage) 
     1028      !                                                      ! ================== ! 
     1029      !                                                      !        SSS         ! 
     1030      !                                                      ! ================== ! 
     1031      IF( srcv(jpr_soce)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling 
     1032         sss_m(:,:) = frcv(jpr_soce)%z3(:,:,1) 
     1033         CALL iom_put( 'sss_m', sss_m ) 
     1034      ENDIF 
     1035      !                                                
     1036      !                                                      ! ================== ! 
     1037      !                                                      !        SST         ! 
     1038      !                                                      ! ================== ! 
     1039      IF( srcv(jpr_toce)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling 
     1040         sst_m(:,:) = frcv(jpr_toce)%z3(:,:,1) 
     1041         IF( srcv(jpr_soce)%laction .AND. ln_useCT ) THEN    ! make sure that sst_m is the potential temperature 
     1042            sst_m(:,:) = eos_pt_from_ct( sst_m(:,:), sss_m(:,:) ) 
     1043         ENDIF 
     1044      ENDIF 
     1045      !                                                      ! ================== ! 
     1046      !                                                      !        SSH         ! 
     1047      !                                                      ! ================== ! 
     1048      IF( srcv(jpr_ssh )%laction ) THEN                      ! received by sas in case of opa <-> sas coupling 
     1049         ssh_m(:,:) = frcv(jpr_ssh )%z3(:,:,1) 
     1050         CALL iom_put( 'ssh_m', ssh_m ) 
     1051      ENDIF 
     1052      !                                                      ! ================== ! 
     1053      !                                                      !  surface currents  ! 
     1054      !                                                      ! ================== ! 
     1055      IF( srcv(jpr_ocx1)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling 
     1056         ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) 
     1057         ub (:,:,1) = ssu_m(:,:)                             ! will be used in sbcice_lim in the call of lim_sbc_tau 
     1058         CALL iom_put( 'ssu_m', ssu_m ) 
     1059      ENDIF 
     1060      IF( srcv(jpr_ocy1)%laction ) THEN 
     1061         ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) 
     1062         vb (:,:,1) = ssv_m(:,:)                             ! will be used in sbcice_lim in the call of lim_sbc_tau 
     1063         CALL iom_put( 'ssv_m', ssv_m ) 
     1064      ENDIF 
     1065      !                                                      ! ======================== ! 
     1066      !                                                      !  first T level thickness ! 
     1067      !                                                      ! ======================== ! 
     1068      IF( srcv(jpr_e3t1st )%laction ) THEN                   ! received by sas in case of opa <-> sas coupling 
     1069         e3t_m(:,:) = frcv(jpr_e3t1st )%z3(:,:,1) 
     1070         CALL iom_put( 'e3t_m', e3t_m(:,:) ) 
     1071      ENDIF 
     1072      !                                                      ! ================================ ! 
     1073      !                                                      !  fraction of solar net radiation ! 
     1074      !                                                      ! ================================ ! 
     1075      IF( srcv(jpr_fraqsr)%laction ) THEN                    ! received by sas in case of opa <-> sas coupling 
     1076         frq_m(:,:) = frcv(jpr_fraqsr)%z3(:,:,1) 
     1077         CALL iom_put( 'frq_m', frq_m ) 
     1078      ENDIF 
     1079       
    8151080      !                                                      ! ========================= ! 
    816       IF( k_ice <= 1 ) THEN                                  !  heat & freshwater fluxes ! (Ocean only case) 
     1081      IF( k_ice <= 1 .AND. MOD( kt-1, k_fsbc ) == 0 ) THEN   !  heat & freshwater fluxes ! (Ocean only case) 
    8171082         !                                                   ! ========================= ! 
    8181083         ! 
    8191084         !                                                       ! total freshwater fluxes over the ocean (emp) 
    820          SELECT CASE( TRIM( sn_rcv_emp%cldes ) )                                    ! evaporation - precipitation 
    821          CASE( 'conservative' ) 
    822             emp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) 
    823          CASE( 'oce only', 'oce and ice' ) 
    824             emp(:,:) = frcv(jpr_oemp)%z3(:,:,1) 
    825          CASE default 
    826             CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) 
    827          END SELECT 
     1085         IF( srcv(jpr_oemp)%laction .OR. srcv(jpr_rain)%laction ) THEN 
     1086            SELECT CASE( TRIM( sn_rcv_emp%cldes ) )                                    ! evaporation - precipitation 
     1087            CASE( 'conservative' ) 
     1088               zemp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) 
     1089            CASE( 'oce only', 'oce and ice' ) 
     1090               zemp(:,:) = frcv(jpr_oemp)%z3(:,:,1) 
     1091            CASE default 
     1092               CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) 
     1093            END SELECT 
     1094         ELSE 
     1095            zemp(:,:) = 0._wp 
     1096         ENDIF 
    8281097         ! 
    8291098         !                                                        ! runoffs and calving (added in emp) 
    830          IF( srcv(jpr_rnf)%laction )   emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 
    831          IF( srcv(jpr_cal)%laction )   emp(:,:) = emp(:,:) - frcv(jpr_cal)%z3(:,:,1) 
    832          ! 
    833 !!gm :  this seems to be internal cooking, not sure to need that in a generic interface  
    834 !!gm                                       at least should be optional... 
    835 !!         IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN     ! add to the total freshwater budget 
    836 !!            ! remove negative runoff 
    837 !!            zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )  
    838 !!            zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
    839 !!            IF( lk_mpp )   CALL mpp_sum( zcumulpos )   ! sum over the global domain 
    840 !!            IF( lk_mpp )   CALL mpp_sum( zcumulneg )  
    841 !!            IF( zcumulpos /= 0. ) THEN                 ! distribute negative runoff on positive runoff grid points 
    842 !!               zcumulneg = 1.e0 + zcumulneg / zcumulpos 
    843 !!               frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 
    844 !!            ENDIF      
    845 !!            ! add runoff to e-p  
    846 !!            emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 
    847 !!         ENDIF 
    848 !!gm  end of internal cooking 
     1099         IF( srcv(jpr_rnf)%laction )     rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
     1100         IF( srcv(jpr_cal)%laction )     zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1) 
     1101          
     1102         IF( ln_mixcpl ) THEN   ;   emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:) 
     1103         ELSE                   ;   emp(:,:) =                              zemp(:,:) 
     1104         ENDIF 
    8491105         ! 
    8501106         !                                                       ! non solar heat flux over the ocean (qns) 
    851          IF( srcv(jpr_qnsoce)%laction )   qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 
    852          IF( srcv(jpr_qnsmix)%laction )   qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
     1107         IF(      srcv(jpr_qnsoce)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 
     1108         ELSE IF( srcv(jpr_qnsmix)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
     1109         ELSE                                       ;   zqns(:,:) = 0._wp 
     1110         END IF 
    8531111         ! update qns over the free ocean with: 
    854          qns(:,:) =  qns(:,:) - emp(:,:) * sst_m(:,:) * rcp            ! remove heat content due to mass flux (assumed to be at SST) 
    855          IF( srcv(jpr_snow  )%laction )   THEN 
    856               qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus    ! energy for melting solid precipitation over the free ocean 
     1112         IF( nn_components /= jp_iam_opa ) THEN 
     1113            zqns(:,:) =  zqns(:,:) - zemp(:,:) * sst_m(:,:) * rcp         ! remove heat content due to mass flux (assumed to be at SST) 
     1114            IF( srcv(jpr_snow  )%laction ) THEN 
     1115               zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus    ! energy for melting solid precipitation over the free ocean 
     1116            ENDIF 
     1117         ENDIF 
     1118         IF( ln_mixcpl ) THEN   ;   qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:) 
     1119         ELSE                   ;   qns(:,:) =                              zqns(:,:) 
    8571120         ENDIF 
    8581121 
    8591122         !                                                       ! solar flux over the ocean          (qsr) 
    860          IF( srcv(jpr_qsroce)%laction )   qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 
    861          IF( srcv(jpr_qsrmix)%laction )   qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 
    862          IF( ln_dm2dc )   qsr(:,:) = sbc_dcy( qsr )                           ! modify qsr to include the diurnal cycle 
     1123         IF     ( srcv(jpr_qsroce)%laction ) THEN   ;   zqsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 
     1124         ELSE IF( srcv(jpr_qsrmix)%laction ) then   ;   zqsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1125         ELSE                                       ;   zqsr(:,:) = 0._wp 
     1126         ENDIF 
     1127         IF( ln_dm2dc .AND. ln_cpl )   zqsr(:,:) = sbc_dcy( zqsr )   ! modify qsr to include the diurnal cycle 
     1128         IF( ln_mixcpl ) THEN   ;   qsr(:,:) = qsr(:,:) * xcplmask(:,:,0) + zqsr(:,:) * zmsk(:,:) 
     1129         ELSE                   ;   qsr(:,:) =                              zqsr(:,:) 
     1130         ENDIF 
    8631131         ! 
    864    
    865       ENDIF 
    866       ! 
    867       CALL wrk_dealloc( jpi,jpj, ztx, zty, ztx2, zty2) 
     1132         ! salt flux over the ocean (received by opa in case of opa <-> sas coupling) 
     1133         IF( srcv(jpr_sflx )%laction )   sfx(:,:) = frcv(jpr_sflx  )%z3(:,:,1) 
     1134         ! Ice cover  (received by opa in case of opa <-> sas coupling) 
     1135         IF( srcv(jpr_fice )%laction )   fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1) 
     1136         ! 
     1137 
     1138      ENDIF 
     1139      ! 
     1140      CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 ) 
    8681141      ! 
    8691142      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_rcv') 
     
    9621235            ! 
    9631236         ENDIF 
    964  
    9651237         !                                                      ! ======================= ! 
    9661238         !                                                      !     put on ice grid     ! 
     
    10841356    
    10851357 
    1086    SUBROUTINE sbc_cpl_ice_flx( p_frld  , palbi   , psst    , pist    ) 
     1358   SUBROUTINE sbc_cpl_ice_flx( p_frld, palbi, psst, pist ) 
    10871359      !!---------------------------------------------------------------------- 
    10881360      !!             ***  ROUTINE sbc_cpl_ice_flx  *** 
     
    11261398      REAL(wp), INTENT(in   ), DIMENSION(:,:)   ::   p_frld     ! lead fraction                [0 to 1] 
    11271399      ! optional arguments, used only in 'mixed oce-ice' case 
    1128       REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! all skies ice albedo  
    1129       REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature     [Celsius] 
    1130       REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist    ! ice surface temperature     [Kelvin] 
    1131       ! 
    1132       INTEGER ::   jl   ! dummy loop index 
    1133       REAL(wp), POINTER, DIMENSION(:,:) ::   zcptn, ztmp, zicefr 
     1400      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi      ! all skies ice albedo  
     1401      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst       ! sea surface temperature     [Celsius] 
     1402      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist       ! ice surface temperature     [Kelvin] 
     1403      ! 
     1404      INTEGER ::   jl         ! dummy loop index 
     1405      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zcptn, ztmp, zicefr, zmsk 
     1406      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot 
     1407      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zqns_ice, zqsr_ice, zdqns_ice 
     1408      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zevap, zsnw, zqns_oce, zqsr_oce, zqprec_ice, zqemp_oce ! for LIM3 
    11341409      !!---------------------------------------------------------------------- 
    11351410      ! 
    11361411      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_ice_flx') 
    11371412      ! 
    1138       CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr ) 
    1139  
     1413      CALL wrk_alloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 
     1414      CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 
     1415 
     1416      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0) 
    11401417      zicefr(:,:) = 1.- p_frld(:,:) 
    11411418      zcptn(:,:) = rcp * sst_m(:,:) 
     
    11451422      !                                                      ! ========================= ! 
    11461423      ! 
    1147       !                                                           ! total Precipitations - total Evaporation (emp_tot) 
    1148       !                                                           ! solid precipitation  - sublimation       (emp_ice) 
    1149       !                                                           ! solid Precipitation                      (sprecip) 
     1424      !                                                           ! total Precipitation - total Evaporation (emp_tot) 
     1425      !                                                           ! solid precipitation - sublimation       (emp_ice) 
     1426      !                                                           ! solid Precipitation                     (sprecip) 
     1427      !                                                           ! liquid + solid Precipitation            (tprecip) 
    11501428      SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 
    11511429      CASE( 'conservative'  )   ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp 
    1152          sprecip(:,:) = frcv(jpr_snow)%z3(:,:,1)                 ! May need to ensure positive here 
    1153          tprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + sprecip (:,:) ! May need to ensure positive here 
    1154          emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - tprecip(:,:) 
    1155          emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 
     1430         zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1)                  ! May need to ensure positive here 
     1431         ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 
     1432         zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 
     1433         zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 
    11561434            CALL iom_put( 'rain'         , frcv(jpr_rain)%z3(:,:,1)              )   ! liquid precipitation  
    11571435         IF( iom_use('hflx_rain_cea') )   & 
     
    11641442            CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) )   ! heat flux from from evap (cell average) 
    11651443      CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 
    1166          emp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 
    1167          emp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 
    1168          sprecip(:,:) = - frcv(jpr_semp)%z3(:,:,1) + frcv(jpr_ievp)%z3(:,:,1) 
     1444         zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 
     1445         zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 
     1446         zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 
     1447         ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) 
    11691448      END SELECT 
     1449 
     1450      IF( iom_use('subl_ai_cea') )   & 
     1451         CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )   ! Sublimation over sea-ice         (cell average) 
     1452      !    
     1453      !                                                           ! runoffs and calving (put in emp_tot) 
     1454      IF( srcv(jpr_rnf)%laction )   rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
     1455      IF( srcv(jpr_cal)%laction ) THEN  
     1456         zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 
     1457         CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) ) 
     1458      ENDIF 
     1459 
     1460      IF( ln_mixcpl ) THEN 
     1461         emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) 
     1462         emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:) 
     1463         sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 
     1464         tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 
     1465      ELSE 
     1466         emp_tot(:,:) =                                  zemp_tot(:,:) 
     1467         emp_ice(:,:) =                                  zemp_ice(:,:) 
     1468         sprecip(:,:) =                                  zsprecip(:,:) 
     1469         tprecip(:,:) =                                  ztprecip(:,:) 
     1470      ENDIF 
    11701471 
    11711472         CALL iom_put( 'snowpre'    , sprecip                                )   ! Snow 
     
    11741475      IF( iom_use('snow_ai_cea') )   & 
    11751476         CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:)             )   ! Snow        over sea-ice         (cell average) 
    1176       IF( iom_use('subl_ai_cea') )   & 
    1177          CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )   ! Sublimation over sea-ice         (cell average) 
    1178       !    
    1179       !                                                           ! runoffs and calving (put in emp_tot) 
    1180       IF( srcv(jpr_rnf)%laction ) THEN  
    1181          emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) 
    1182             CALL iom_put( 'runoffs'      , frcv(jpr_rnf)%z3(:,:,1)              )   ! rivers 
    1183          IF( iom_use('hflx_rnf_cea') )   & 
    1184             CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from rivers 
    1185       ENDIF 
    1186       IF( srcv(jpr_cal)%laction ) THEN  
    1187          emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 
    1188          CALL iom_put( 'calving', frcv(jpr_cal)%z3(:,:,1) ) 
    1189       ENDIF 
    1190       ! 
    1191 !!gm :  this seems to be internal cooking, not sure to need that in a generic interface  
    1192 !!gm                                       at least should be optional... 
    1193 !!       ! remove negative runoff                            ! sum over the global domain 
    1194 !!       zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )  
    1195 !!       zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
    1196 !!       IF( lk_mpp )   CALL mpp_sum( zcumulpos ) 
    1197 !!       IF( lk_mpp )   CALL mpp_sum( zcumulneg )  
    1198 !!       IF( zcumulpos /= 0. ) THEN                          ! distribute negative runoff on positive runoff grid points 
    1199 !!          zcumulneg = 1.e0 + zcumulneg / zcumulpos 
    1200 !!          frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 
    1201 !!       ENDIF      
    1202 !!       emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1)   ! add runoff to e-p  
    1203 !! 
    1204 !!gm  end of internal cooking 
    12051477 
    12061478      !                                                      ! ========================= ! 
     
    12081480      !                                                      ! ========================= ! 
    12091481      CASE( 'oce only' )                                     ! the required field is directly provided 
    1210          qns_tot(:,:  ) = frcv(jpr_qnsoce)%z3(:,:,1) 
     1482         zqns_tot(:,:  ) = frcv(jpr_qnsoce)%z3(:,:,1) 
    12111483      CASE( 'conservative' )                                      ! the required fields are directly provided 
    1212          qns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
     1484         zqns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
    12131485         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 
    1214             qns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 
     1486            zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 
    12151487         ELSE 
    12161488            ! Set all category values equal for the moment 
    12171489            DO jl=1,jpl 
    1218                qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
     1490               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
    12191491            ENDDO 
    12201492         ENDIF 
    12211493      CASE( 'oce and ice' )       ! the total flux is computed from ocean and ice fluxes 
    1222          qns_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 
     1494         zqns_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 
    12231495         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 
    12241496            DO jl=1,jpl 
    1225                qns_tot(:,:   ) = qns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)    
    1226                qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl) 
     1497               zqns_tot(:,:   ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)    
     1498               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl) 
    12271499            ENDDO 
    12281500         ELSE 
     1501            qns_tot(:,:   ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
    12291502            DO jl=1,jpl 
    1230                qns_tot(:,:   ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
    1231                qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
     1503               zqns_tot(:,:   ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
     1504               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
    12321505            ENDDO 
    12331506         ENDIF 
    12341507      CASE( 'mixed oce-ice' )     ! the ice flux is cumputed from the total flux, the SST and ice informations 
    12351508! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 
    1236          qns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
    1237          qns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1)    & 
     1509         zqns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
     1510         zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1)    & 
    12381511            &            + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,:  ) ) * p_frld(:,:)   & 
    12391512            &                                                   +          pist(:,:,1)   * zicefr(:,:) ) ) 
    12401513      END SELECT 
    1241       ztmp(:,:) = p_frld(:,:) * sprecip(:,:) * lfus 
    1242       qns_tot(:,:) = qns_tot(:,:)                         &            ! qns_tot update over free ocean with: 
    1243          &          - ztmp(:,:)                           &            ! remove the latent heat flux of solid precip. melting 
    1244          &          - (  emp_tot(:,:)                     &            ! remove the heat content of mass flux (assumed to be at SST) 
    1245          &             - emp_ice(:,:) * zicefr(:,:)  ) * zcptn(:,:)  
    1246       IF( iom_use('hflx_snow_cea') )   & 
    1247          CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average) 
    12481514!!gm 
    1249 !!    currently it is taken into account in leads budget but not in the qns_tot, and thus not in  
     1515!!    currently it is taken into account in leads budget but not in the zqns_tot, and thus not in  
    12501516!!    the flux that enter the ocean.... 
    12511517!!    moreover 1 - it is not diagnose anywhere....  
     
    12561522      IF( srcv(jpr_cal)%laction ) THEN                            ! Iceberg melting  
    12571523         ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus               ! add the latent heat of iceberg melting  
    1258          qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:) 
     1524         zqns_tot(:,:) = zqns_tot(:,:) - ztmp(:,:) 
    12591525         IF( iom_use('hflx_cal_cea') )   & 
    12601526            CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from calving 
    12611527      ENDIF 
     1528 
     1529      ztmp(:,:) = p_frld(:,:) * zsprecip(:,:) * lfus 
     1530      IF( iom_use('hflx_snow_cea') )    CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average) 
     1531 
     1532#if defined key_lim3 
     1533      CALL wrk_alloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce )  
     1534 
     1535      ! --- evaporation --- ! 
     1536      ! clem: evap_ice is set to 0 for LIM3 since we still do not know what to do with sublimation 
     1537      ! the problem is: the atm. imposes both mass evaporation and heat removed from the snow/ice 
     1538      !                 but it is incoherent WITH the ice model   
     1539      DO jl=1,jpl 
     1540         evap_ice(:,:,jl) = 0._wp  ! should be: frcv(jpr_ievp)%z3(:,:,1) 
     1541      ENDDO 
     1542      zevap(:,:) = zemp_tot(:,:) + ztprecip(:,:) ! evaporation over ocean 
     1543 
     1544      ! --- evaporation minus precipitation --- ! 
     1545      emp_oce(:,:) = emp_tot(:,:) - emp_ice(:,:) 
     1546 
     1547      ! --- non solar flux over ocean --- ! 
     1548      !         note: p_frld cannot be = 0 since we limit the ice concentration to amax 
     1549      zqns_oce = 0._wp 
     1550      WHERE( p_frld /= 0._wp )  zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:) 
     1551 
     1552      ! --- heat flux associated with emp --- ! 
     1553      zsnw(:,:) = 0._wp 
     1554      CALL lim_thd_snwblow( p_frld, zsnw )  ! snow distribution over ice after wind blowing 
     1555      zqemp_oce(:,:) = -      zevap(:,:)                   * p_frld(:,:)      *   zcptn(:,:)   &      ! evap 
     1556         &             + ( ztprecip(:,:) - zsprecip(:,:) )                    *   zcptn(:,:)   &      ! liquid precip 
     1557         &             +   zsprecip(:,:)                   * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean 
     1558      qemp_ice(:,:)  = -   frcv(jpr_ievp)%z3(:,:,1)        * zicefr(:,:)      *   zcptn(:,:)   &      ! ice evap 
     1559         &             +   zsprecip(:,:)                   * zsnw             * ( zcptn(:,:) - lfus ) ! solid precip over ice 
     1560 
     1561      ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 
     1562      zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus ) 
     1563 
     1564      ! --- total non solar flux --- ! 
     1565      zqns_tot(:,:) = zqns_tot(:,:) + qemp_ice(:,:) + zqemp_oce(:,:) 
     1566 
     1567      ! --- in case both coupled/forced are active, we must mix values --- !  
     1568      IF( ln_mixcpl ) THEN 
     1569         qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 
     1570         qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:) 
     1571         DO jl=1,jpl 
     1572            qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) +  zqns_ice(:,:,jl)* zmsk(:,:) 
     1573         ENDDO 
     1574         qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:) 
     1575         qemp_oce (:,:) =  qemp_oce(:,:) * xcplmask(:,:,0) +  zqemp_oce(:,:)* zmsk(:,:) 
     1576!!clem         evap_ice(:,:) = evap_ice(:,:) * xcplmask(:,:,0) 
     1577      ELSE 
     1578         qns_tot  (:,:  ) = zqns_tot  (:,:  ) 
     1579         qns_oce  (:,:  ) = zqns_oce  (:,:  ) 
     1580         qns_ice  (:,:,:) = zqns_ice  (:,:,:) 
     1581         qprec_ice(:,:)   = zqprec_ice(:,:) 
     1582         qemp_oce (:,:)   = zqemp_oce (:,:) 
     1583      ENDIF 
     1584 
     1585      CALL wrk_dealloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce )  
     1586#else 
     1587 
     1588      ! clem: this formulation is certainly wrong... but better than it was... 
     1589      zqns_tot(:,:) = zqns_tot(:,:)                       &            ! zqns_tot update over free ocean with: 
     1590         &          - ztmp(:,:)                           &            ! remove the latent heat flux of solid precip. melting 
     1591         &          - (  zemp_tot(:,:)                    &            ! remove the heat content of mass flux (assumed to be at SST) 
     1592         &             - zemp_ice(:,:) * zicefr(:,:)  ) * zcptn(:,:)  
     1593 
     1594     IF( ln_mixcpl ) THEN 
     1595         qns_tot(:,:) = qns(:,:) * p_frld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk 
     1596         qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) +  zqns_tot(:,:)* zmsk(:,:) 
     1597         DO jl=1,jpl 
     1598            qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) +  zqns_ice(:,:,jl)* zmsk(:,:) 
     1599         ENDDO 
     1600      ELSE 
     1601         qns_tot(:,:  ) = zqns_tot(:,:  ) 
     1602         qns_ice(:,:,:) = zqns_ice(:,:,:) 
     1603      ENDIF 
     1604 
     1605#endif 
    12621606 
    12631607      !                                                      ! ========================= ! 
     
    12651609      !                                                      ! ========================= ! 
    12661610      CASE( 'oce only' ) 
    1267          qsr_tot(:,:  ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 
     1611         zqsr_tot(:,:  ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 
    12681612      CASE( 'conservative' ) 
    1269          qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1613         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
    12701614         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 
    1271             qsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl) 
     1615            zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl) 
    12721616         ELSE 
    12731617            ! Set all category values equal for the moment 
    12741618            DO jl=1,jpl 
    1275                qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
     1619               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
    12761620            ENDDO 
    12771621         ENDIF 
    1278          qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
    1279          qsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 
     1622         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1623         zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 
    12801624      CASE( 'oce and ice' ) 
    1281          qsr_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 
     1625         zqsr_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 
    12821626         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 
    12831627            DO jl=1,jpl 
    1284                qsr_tot(:,:   ) = qsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)    
    1285                qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl) 
     1628               zqsr_tot(:,:   ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)    
     1629               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl) 
    12861630            ENDDO 
    12871631         ELSE 
     1632            qsr_tot(:,:   ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
    12881633            DO jl=1,jpl 
    1289                qsr_tot(:,:   ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
    1290                qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
     1634               zqsr_tot(:,:   ) = zqsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
     1635               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
    12911636            ENDDO 
    12921637         ENDIF 
    12931638      CASE( 'mixed oce-ice' ) 
    1294          qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1639         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
    12951640! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 
    12961641!       Create solar heat flux over ice using incoming solar heat flux and albedos 
    12971642!       ( see OASIS3 user guide, 5th edition, p39 ) 
    1298          qsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) )   & 
     1643         zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) )   & 
    12991644            &            / (  1.- ( albedo_oce_mix(:,:  ) * p_frld(:,:)       & 
    13001645            &                     + palbi         (:,:,1) * zicefr(:,:) ) ) 
    13011646      END SELECT 
    1302       IF( ln_dm2dc ) THEN   ! modify qsr to include the diurnal cycle 
    1303          qsr_tot(:,:  ) = sbc_dcy( qsr_tot(:,:  ) ) 
     1647      IF( ln_dm2dc .AND. ln_cpl ) THEN   ! modify qsr to include the diurnal cycle 
     1648         zqsr_tot(:,:  ) = sbc_dcy( zqsr_tot(:,:  ) ) 
    13041649         DO jl=1,jpl 
    1305             qsr_ice(:,:,jl) = sbc_dcy( qsr_ice(:,:,jl) ) 
     1650            zqsr_ice(:,:,jl) = sbc_dcy( zqsr_ice(:,:,jl) ) 
    13061651         ENDDO 
     1652      ENDIF 
     1653 
     1654#if defined key_lim3 
     1655      CALL wrk_alloc( jpi,jpj, zqsr_oce )  
     1656      ! --- solar flux over ocean --- ! 
     1657      !         note: p_frld cannot be = 0 since we limit the ice concentration to amax 
     1658      zqsr_oce = 0._wp 
     1659      WHERE( p_frld /= 0._wp )  zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / p_frld(:,:) 
     1660 
     1661      IF( ln_mixcpl ) THEN   ;   qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) +  zqsr_oce(:,:)* zmsk(:,:) 
     1662      ELSE                   ;   qsr_oce(:,:) = zqsr_oce(:,:)   ;   ENDIF 
     1663 
     1664      CALL wrk_dealloc( jpi,jpj, zqsr_oce )  
     1665#endif 
     1666 
     1667      IF( ln_mixcpl ) THEN 
     1668         qsr_tot(:,:) = qsr(:,:) * p_frld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk 
     1669         qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) +  zqsr_tot(:,:)* zmsk(:,:) 
     1670         DO jl=1,jpl 
     1671            qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) +  zqsr_ice(:,:,jl)* zmsk(:,:) 
     1672         ENDDO 
     1673      ELSE 
     1674         qsr_tot(:,:  ) = zqsr_tot(:,:  ) 
     1675         qsr_ice(:,:,:) = zqsr_ice(:,:,:) 
    13071676      ENDIF 
    13081677 
     
    13121681      CASE ('coupled') 
    13131682         IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 
    1314             dqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 
     1683            zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 
    13151684         ELSE 
    13161685            ! Set all category values equal for the moment 
    13171686            DO jl=1,jpl 
    1318                dqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1) 
     1687               zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1) 
    13191688            ENDDO 
    13201689         ENDIF 
    13211690      END SELECT 
    1322  
     1691       
     1692      IF( ln_mixcpl ) THEN 
     1693         DO jl=1,jpl 
     1694            dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:) 
     1695         ENDDO 
     1696      ELSE 
     1697         dqns_ice(:,:,:) = zdqns_ice(:,:,:) 
     1698      ENDIF 
     1699       
    13231700      !                                                      ! ========================= ! 
    13241701      SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) )             !    topmelt and botmelt    ! 
     
    13361713      fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 
    13371714 
    1338       CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr ) 
     1715      CALL wrk_dealloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 
     1716      CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 
    13391717      ! 
    13401718      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_ice_flx') 
     
    13571735      INTEGER ::   ikchoix 
    13581736      INTEGER ::   isec, info   ! local integer 
     1737      REAL(wp) ::   zumax, zvmax 
    13591738      REAL(wp), POINTER, DIMENSION(:,:)   ::   zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 
    13601739      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmp3, ztmp4    
     
    13731752      !                                                      ! ------------------------- ! 
    13741753      IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN 
    1375          SELECT CASE( sn_snd_temp%cldes) 
    1376          CASE( 'none'         )       ! nothing to do 
    1377          CASE( 'oce only'             )   ;   ztmp1(:,:) =   tsn(:,:,1,jp_tem) + rt0 
    1378          CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:)    
    1379             SELECT CASE( sn_snd_temp%clcat ) 
    1380             CASE( 'yes' )    
    1381                ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
    1382             CASE( 'no' ) 
    1383                ztmp3(:,:,:) = 0.0 
     1754          
     1755         IF ( nn_components == jp_iam_opa ) THEN 
     1756            ztmp1(:,:) = tsn(:,:,1,jp_tem)   ! send temperature as it is (potential or conservative) -> use of ln_useCT on the received part 
     1757         ELSE 
     1758            ! we must send the surface potential temperature  
     1759            IF( ln_useCT )  THEN    ;   ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 
     1760            ELSE                    ;   ztmp1(:,:) = tsn(:,:,1,jp_tem) 
     1761            ENDIF 
     1762            ! 
     1763            SELECT CASE( sn_snd_temp%cldes) 
     1764            CASE( 'oce only'             )   ;   ztmp1(:,:) =   ztmp1(:,:) + rt0 
     1765            CASE( 'oce and ice'          )   ;   ztmp1(:,:) =   ztmp1(:,:) + rt0 
     1766               SELECT CASE( sn_snd_temp%clcat ) 
     1767               CASE( 'yes' )    
     1768                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) 
     1769               CASE( 'no' ) 
     1770                  WHERE( SUM( a_i, dim=3 ) /= 0. ) 
     1771                     ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 ) 
     1772                  ELSEWHERE 
     1773                     ztmp3(:,:,1) = rt0 ! TODO: Is freezing point a good default? (Maybe SST is better?) 
     1774                  END WHERE 
     1775               CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
     1776               END SELECT 
     1777            CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)    
     1778               SELECT CASE( sn_snd_temp%clcat ) 
     1779               CASE( 'yes' )    
     1780                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
     1781               CASE( 'no' ) 
     1782                  ztmp3(:,:,:) = 0.0 
     1783                  DO jl=1,jpl 
     1784                     ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 
     1785                  ENDDO 
     1786               CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
     1787               END SELECT 
     1788            CASE( 'mixed oce-ice'        )    
     1789               ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)  
    13841790               DO jl=1,jpl 
    1385                   ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 
     1791                  ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 
    13861792               ENDDO 
    1387             CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
     1793            CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 
    13881794            END SELECT 
    1389          CASE( 'mixed oce-ice'        )    
    1390             ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:)  
    1391             DO jl=1,jpl 
    1392                ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 
    1393             ENDDO 
    1394          CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 
    1395          END SELECT 
     1795         ENDIF 
    13961796         IF( ssnd(jps_toce)%laction )   CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
    13971797         IF( ssnd(jps_tice)%laction )   CALL cpl_snd( jps_tice, isec, ztmp3, info ) 
     
    14021802      !                                                      ! ------------------------- ! 
    14031803      IF( ssnd(jps_albice)%laction ) THEN                         ! ice  
    1404          ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
     1804         SELECT CASE( sn_snd_alb%cldes ) 
     1805         CASE( 'ice'          )   ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) 
     1806         CASE( 'weighted ice' )   ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
     1807         CASE default             ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' ) 
     1808         END SELECT 
    14051809         CALL cpl_snd( jps_albice, isec, ztmp3, info ) 
    14061810      ENDIF 
     
    14151819      !                                                      !  Ice fraction & Thickness !  
    14161820      !                                                      ! ------------------------- ! 
    1417       ! Send ice fraction field  
     1821      ! Send ice fraction field to atmosphere 
    14181822      IF( ssnd(jps_fice)%laction ) THEN 
    14191823         SELECT CASE( sn_snd_thick%clcat ) 
     
    14221826         CASE default    ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 
    14231827         END SELECT 
    1424          CALL cpl_snd( jps_fice, isec, ztmp3, info ) 
     1828         IF( ssnd(jps_fice)%laction )   CALL cpl_snd( jps_fice, isec, ztmp3, info ) 
     1829      ENDIF 
     1830       
     1831      ! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling) 
     1832      IF( ssnd(jps_fice2)%laction ) THEN 
     1833         ztmp3(:,:,1) = fr_i(:,:) 
     1834         IF( ssnd(jps_fice2)%laction )   CALL cpl_snd( jps_fice2, isec, ztmp3, info ) 
    14251835      ENDIF 
    14261836 
     
    14431853            END SELECT 
    14441854         CASE( 'ice and snow'         )    
    1445             ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) 
    1446             ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) 
     1855            SELECT CASE( sn_snd_thick%clcat ) 
     1856            CASE( 'yes' ) 
     1857               ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) 
     1858               ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) 
     1859            CASE( 'no' ) 
     1860               WHERE( SUM( a_i, dim=3 ) /= 0. ) 
     1861                  ztmp3(:,:,1) = SUM( ht_i * a_i, dim=3 ) / SUM( a_i, dim=3 ) 
     1862                  ztmp4(:,:,1) = SUM( ht_s * a_i, dim=3 ) / SUM( a_i, dim=3 ) 
     1863               ELSEWHERE 
     1864                 ztmp3(:,:,1) = 0. 
     1865                 ztmp4(:,:,1) = 0. 
     1866               END WHERE 
     1867            CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 
     1868            END SELECT 
    14471869         CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' ) 
    14481870         END SELECT 
     
    14701892         !                                                              i-1  i   i 
    14711893         !                                                               i      i+1 (for I) 
    1472          SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 
    1473          CASE( 'oce only'             )      ! C-grid ==> T 
    1474             IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 
    1475                DO jj = 2, jpjm1 
    1476                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    1477                      zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) ) 
    1478                      zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) )  
    1479                   END DO 
    1480                END DO 
    1481             ELSE 
    1482 ! Temporarily Changed for UKV 
    1483                DO jj = 2, jpjm1 
    1484                   DO ji = 2, jpim1 
    1485                      zotx1(ji,jj) = un(ji,jj,1) 
    1486                      zoty1(ji,jj) = vn(ji,jj,1) 
    1487                   END DO 
    1488                END DO 
    1489             ENDIF  
    1490          CASE( 'weighted oce and ice' )    
    1491             SELECT CASE ( cp_ice_msh ) 
    1492             CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T 
    1493                DO jj = 2, jpjm1 
    1494                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    1495                      zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   
    1496                      zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj) 
    1497                      zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
    1498                      zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
    1499                   END DO 
    1500                END DO 
    1501             CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T 
    1502                DO jj = 2, jpjm1 
    1503                   DO ji = 2, jpim1   ! NO vector opt. 
    1504                      zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   
    1505                      zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   
    1506                      zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     & 
    1507                         &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1508                      zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     & 
    1509                         &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1510                   END DO 
    1511                END DO 
    1512             CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T 
    1513                DO jj = 2, jpjm1 
    1514                   DO ji = 2, jpim1   ! NO vector opt. 
    1515                      zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   
    1516                      zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   
    1517                      zitx1(ji,jj) = 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                      zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
    1520                         &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1521                   END DO 
    1522                END DO 
    1523             END SELECT 
    1524             CALL lbc_lnk( zitx1, 'T', -1. )   ;   CALL lbc_lnk( zity1, 'T', -1. ) 
    1525          CASE( 'mixed oce-ice'        ) 
    1526             SELECT CASE ( cp_ice_msh ) 
    1527             CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T 
    1528                DO jj = 2, jpjm1 
    1529                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    1530                      zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   & 
    1531                         &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
    1532                      zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)   & 
    1533                         &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
    1534                   END DO 
    1535                END DO 
    1536             CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T 
    1537                DO jj = 2, jpjm1 
    1538                   DO ji = 2, jpim1   ! NO vector opt. 
    1539                      zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &    
    1540                         &         + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     & 
    1541                         &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1542                      zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   &  
    1543                         &         + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     & 
    1544                         &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1545                   END DO 
    1546                END DO 
    1547             CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T 
     1894         IF( nn_components == jp_iam_opa ) THEN 
     1895            zotx1(:,:) = un(:,:,1)   
     1896            zoty1(:,:) = vn(:,:,1)   
     1897         ELSE         
     1898            SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 
     1899            CASE( 'oce only'             )      ! C-grid ==> T 
    15481900               IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 
    15491901                  DO jj = 2, jpjm1 
    1550                      DO ji = 2, jpim1   ! NO vector opt. 
    1551                         zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj,1) ) * zfr_l(ji,jj)   &    
    1552                              &         + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     & 
    1553                              &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1554                         zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji,jj-1,1) ) * zfr_l(ji,jj)   & 
    1555                              &         + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
    1556                              &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1557                     END DO 
     1902                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     1903                        zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) ) 
     1904                        zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) )  
     1905                     END DO 
    15581906                  END DO 
    1559 #if defined key_cice 
    15601907               ELSE 
    1561 ! Temporarily Changed for HadGEM3 
     1908! Temporarily Changed for UKV 
     1909                  DO jj = 2, jpjm1 
     1910                     DO ji = 2, jpim1 
     1911                        zotx1(ji,jj) = un(ji,jj,1) 
     1912                        zoty1(ji,jj) = vn(ji,jj,1) 
     1913                     END DO 
     1914                  END DO 
     1915               ENDIF  
     1916            CASE( 'weighted oce and ice' )    
     1917               SELECT CASE ( cp_ice_msh ) 
     1918               CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T 
     1919                  DO jj = 2, jpjm1 
     1920                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     1921                        zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   
     1922                        zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj) 
     1923                        zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
     1924                        zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
     1925                     END DO 
     1926                  END DO 
     1927               CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T 
    15621928                  DO jj = 2, jpjm1 
    15631929                     DO ji = 2, jpim1   ! NO vector opt. 
    1564                         zotx1(ji,jj) = (1.0-fr_iu(ji,jj)) * un(ji,jj,1)             & 
    1565                              &              + fr_iu(ji,jj) * 0.5 * ( u_ice(ji,jj-1) + u_ice(ji,jj) )  
    1566                         zoty1(ji,jj) = (1.0-fr_iv(ji,jj)) * vn(ji,jj,1)             & 
    1567                              &              + fr_iv(ji,jj) * 0.5 * ( v_ice(ji-1,jj) + v_ice(ji,jj) )  
     1930                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   
     1931                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   
     1932                        zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     & 
     1933                           &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1934                        zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     & 
     1935                           &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    15681936                     END DO 
    15691937                  END DO 
     1938               CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T 
     1939                  DO jj = 2, jpjm1 
     1940                     DO ji = 2, jpim1   ! NO vector opt. 
     1941                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   
     1942                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   
     1943                        zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     & 
     1944                           &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1945                        zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
     1946                           &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1947                     END DO 
     1948                  END DO 
     1949               END SELECT 
     1950               CALL lbc_lnk( zitx1, 'T', -1. )   ;   CALL lbc_lnk( zity1, 'T', -1. ) 
     1951            CASE( 'mixed oce-ice'        ) 
     1952               SELECT CASE ( cp_ice_msh ) 
     1953               CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T 
     1954                  DO jj = 2, jpjm1 
     1955                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     1956                        zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   & 
     1957                           &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
     1958                        zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)   & 
     1959                           &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
     1960                     END DO 
     1961                  END DO 
     1962               CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T 
     1963                  DO jj = 2, jpjm1 
     1964                     DO ji = 2, jpim1   ! NO vector opt. 
     1965                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &    
     1966                           &         + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     & 
     1967                           &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1968                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   &  
     1969                           &         + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     & 
     1970                           &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1971                     END DO 
     1972                  END DO 
     1973               CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T 
     1974                  IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 
     1975                     DO jj = 2, jpjm1 
     1976                        DO ji = 2, jpim1   ! NO vector opt. 
     1977                           zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj,1) ) * zfr_l(ji,jj)   &    
     1978                                &         + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     & 
     1979                                &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1980                           zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji,jj-1,1) ) * zfr_l(ji,jj)   & 
     1981                                &         + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
     1982                                &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1983                       END DO 
     1984#if defined key_cice 
     1985                  ELSE 
     1986! Temporarily Changed for HadGEM3 
     1987                     DO jj = 2, jpjm1 
     1988                        DO ji = 2, jpim1   ! NO vector opt. 
     1989                           zotx1(ji,jj) = (1.0-fr_iu(ji,jj)) * un(ji,jj,1)             & 
     1990                                &              + fr_iu(ji,jj) * 0.5 * ( u_ice(ji,jj-1) + u_ice(ji,jj) )  
     1991                           zoty1(ji,jj) = (1.0-fr_iv(ji,jj)) * vn(ji,jj,1)             & 
     1992                                &              + fr_iv(ji,jj) * 0.5 * ( v_ice(ji-1,jj) + v_ice(ji,jj) )  
     1993                        END DO 
     1994                     END DO 
    15701995#endif 
    1571                ENDIF 
     1996                  ENDIF 
     1997               END SELECT 
    15721998            END SELECT 
    1573          END SELECT 
    1574          CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. )   ;   CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. ) 
     1999            CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. )   ;   CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. ) 
     2000            ! 
     2001         ENDIF 
    15752002         ! 
    15762003         ! 
     
    16362063      ENDIF 
    16372064      ! 
     2065      ! 
     2066      !  Fields sent by OPA to SAS when doing OPA<->SAS coupling 
     2067      !                                                        ! SSH 
     2068      IF( ssnd(jps_ssh )%laction )  THEN 
     2069         !                          ! removed inverse barometer ssh when Patm 
     2070         !                          forcing is used (for sea-ice dynamics) 
     2071         IF( ln_apr_dyn ) THEN   ;   ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
     2072         ELSE                    ;   ztmp1(:,:) = sshn(:,:) 
     2073         ENDIF 
     2074         CALL cpl_snd( jps_ssh   , isec, RESHAPE ( ztmp1            , (/jpi,jpj,1/) ), info ) 
     2075 
     2076      ENDIF 
     2077      !                                                        ! SSS 
     2078      IF( ssnd(jps_soce  )%laction )  THEN 
     2079         CALL cpl_snd( jps_soce  , isec, RESHAPE ( tsn(:,:,1,jp_sal), (/jpi,jpj,1/) ), info ) 
     2080      ENDIF 
     2081      !                                                        ! first T level thickness  
     2082      IF( ssnd(jps_e3t1st )%laction )  THEN 
     2083         CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( fse3t_n(:,:,1)   , (/jpi,jpj,1/) ), info ) 
     2084      ENDIF 
     2085      !                                                        ! Qsr fraction 
     2086      IF( ssnd(jps_fraqsr)%laction )  THEN 
     2087         CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( fraqsr_1lev(:,:) , (/jpi,jpj,1/) ), info ) 
     2088      ENDIF 
     2089      ! 
     2090      !  Fields sent by SAS to OPA when OASIS coupling 
     2091      !                                                        ! Solar heat flux 
     2092      IF( ssnd(jps_qsroce)%laction )  CALL cpl_snd( jps_qsroce, isec, RESHAPE ( qsr , (/jpi,jpj,1/) ), info ) 
     2093      IF( ssnd(jps_qnsoce)%laction )  CALL cpl_snd( jps_qnsoce, isec, RESHAPE ( qns , (/jpi,jpj,1/) ), info ) 
     2094      IF( ssnd(jps_oemp  )%laction )  CALL cpl_snd( jps_oemp  , isec, RESHAPE ( emp , (/jpi,jpj,1/) ), info ) 
     2095      IF( ssnd(jps_sflx  )%laction )  CALL cpl_snd( jps_sflx  , isec, RESHAPE ( sfx , (/jpi,jpj,1/) ), info ) 
     2096      IF( ssnd(jps_otx1  )%laction )  CALL cpl_snd( jps_otx1  , isec, RESHAPE ( utau, (/jpi,jpj,1/) ), info ) 
     2097      IF( ssnd(jps_oty1  )%laction )  CALL cpl_snd( jps_oty1  , isec, RESHAPE ( vtau, (/jpi,jpj,1/) ), info ) 
     2098      IF( ssnd(jps_rnf   )%laction )  CALL cpl_snd( jps_rnf   , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info ) 
     2099      IF( ssnd(jps_taum  )%laction )  CALL cpl_snd( jps_taum  , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info ) 
     2100 
    16382101      CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 
    16392102      CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 ) 
Note: See TracChangeset for help on using the changeset viewer.