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.
sbccpl.F90 in NEMO/branches/UKMO/r14075_coupling_sequence/src/OCE/SBC – NEMO

source: NEMO/branches/UKMO/r14075_coupling_sequence/src/OCE/SBC/sbccpl.F90 @ 15424

Last change on this file since 15424 was 15424, checked in by jcastill, 12 months ago

Compiling code

File size: 159.4 KB
Line 
1MODULE sbccpl
2   !!======================================================================
3   !!                       ***  MODULE  sbccpl  ***
4   !! Surface Boundary Condition :  momentum, heat and freshwater fluxes in coupled mode
5   !!======================================================================
6   !! History :  2.0  ! 2007-06  (R. Redler, N. Keenlyside, W. Park) Original code split into flxmod & taumod
7   !!            3.0  ! 2008-02  (G. Madec, C Talandier)  surface module
8   !!            3.1  ! 2009_02  (G. Madec, S. Masson, E. Maisonave, A. Caubel) generic coupled interface
9   !!            3.4  ! 2011_11  (C. Harris) more flexibility + multi-category fields
10   !!----------------------------------------------------------------------
11
12   !!----------------------------------------------------------------------
13   !!   namsbc_cpl      : coupled formulation namlist
14   !!   sbc_cpl_init    : initialisation of the coupled exchanges
15   !!   sbc_cpl_rcv     : receive fields from the atmosphere over the ocean (ocean only)
16   !!                     receive stress from the atmosphere over the ocean (ocean-ice case)
17   !!   sbc_cpl_ice_tau : receive stress from the atmosphere over ice
18   !!   sbc_cpl_ice_flx : receive fluxes from the atmosphere over ice
19   !!   sbc_cpl_snd     : send     fields to the atmosphere
20   !!----------------------------------------------------------------------
21   USE dom_oce         ! ocean space and time domain
22   USE sbc_oce         ! Surface boundary condition: ocean fields
23   USE trc_oce         ! share SMS/Ocean variables
24   USE sbc_ice         ! Surface boundary condition: ice fields
25   USE sbcapr          ! Stochastic param. : ???
26   USE sbcdcy          ! surface boundary condition: diurnal cycle
27   USE sbcwave         ! surface boundary condition: waves
28   USE phycst          ! physical constants
29#if defined key_si3
30   USE ice            ! ice variables
31#endif
32   USE cpl_oasis3     ! OASIS3 coupling
33   USE geo2ocean      !
34   USE oce     , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev
35   USE ocealb         !
36   USE eosbn2         !
37   USE sbcrnf  , ONLY : l_rnfcpl
38   USE sbcisf  , ONLY : l_isfcpl
39#if defined key_cice
40   USE ice_domain_size, only: ncat
41#endif
42#if defined key_si3
43   USE icevar         ! for CALL ice_var_snwblow
44#endif
45   !
46   USE in_out_manager ! I/O manager
47   USE iom            ! NetCDF library
48   USE lib_mpp        ! distribued memory computing library
49   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
50
51#if defined key_oasis3 
52   USE mod_oasis, ONLY : OASIS_Sent, OASIS_ToRest, OASIS_SentOut, OASIS_ToRestOut 
53#endif
54
55   IMPLICIT NONE
56   PRIVATE
57
58   PUBLIC   sbc_cpl_init      ! routine called by sbcmod.F90
59   PUBLIC   sbc_cpl_rcv       ! routine called by icestp.F90
60   PUBLIC   sbc_cpl_snd       ! routine called by step.F90
61   PUBLIC   sbc_cpl_ice_tau   ! routine called by icestp.F90
62   PUBLIC   sbc_cpl_ice_flx   ! routine called by icestp.F90
63   PUBLIC   sbc_cpl_alloc     ! routine called in sbcice_cice.F90
64
65   INTEGER, PARAMETER ::   jpr_otx1   =  1   ! 3 atmosphere-ocean stress components on grid 1
66   INTEGER, PARAMETER ::   jpr_oty1   =  2   !
67   INTEGER, PARAMETER ::   jpr_otz1   =  3   !
68   INTEGER, PARAMETER ::   jpr_otx2   =  4   ! 3 atmosphere-ocean stress components on grid 2
69   INTEGER, PARAMETER ::   jpr_oty2   =  5   !
70   INTEGER, PARAMETER ::   jpr_otz2   =  6   !
71   INTEGER, PARAMETER ::   jpr_itx1   =  7   ! 3 atmosphere-ice   stress components on grid 1
72   INTEGER, PARAMETER ::   jpr_ity1   =  8   !
73   INTEGER, PARAMETER ::   jpr_itz1   =  9   !
74   INTEGER, PARAMETER ::   jpr_itx2   = 10   ! 3 atmosphere-ice   stress components on grid 2
75   INTEGER, PARAMETER ::   jpr_ity2   = 11   !
76   INTEGER, PARAMETER ::   jpr_itz2   = 12   !
77   INTEGER, PARAMETER ::   jpr_qsroce = 13   ! Qsr above the ocean
78   INTEGER, PARAMETER ::   jpr_qsrice = 14   ! Qsr above the ice
79   INTEGER, PARAMETER ::   jpr_qsrmix = 15 
80   INTEGER, PARAMETER ::   jpr_qnsoce = 16   ! Qns above the ocean
81   INTEGER, PARAMETER ::   jpr_qnsice = 17   ! Qns above the ice
82   INTEGER, PARAMETER ::   jpr_qnsmix = 18
83   INTEGER, PARAMETER ::   jpr_rain   = 19   ! total liquid precipitation (rain)
84   INTEGER, PARAMETER ::   jpr_snow   = 20   ! solid precipitation over the ocean (snow)
85   INTEGER, PARAMETER ::   jpr_tevp   = 21   ! total evaporation
86   INTEGER, PARAMETER ::   jpr_ievp   = 22   ! solid evaporation (sublimation)
87   INTEGER, PARAMETER ::   jpr_sbpr   = 23   ! sublimation - liquid precipitation - solid precipitation
88   INTEGER, PARAMETER ::   jpr_semp   = 24   ! solid freshwater budget (sublimation - snow)
89   INTEGER, PARAMETER ::   jpr_oemp   = 25   ! ocean freshwater budget (evap - precip)
90   INTEGER, PARAMETER ::   jpr_w10m   = 26   ! 10m wind
91   INTEGER, PARAMETER ::   jpr_dqnsdt = 27   ! d(Q non solar)/d(temperature)
92   INTEGER, PARAMETER ::   jpr_rnf    = 28   ! runoffs
93   INTEGER, PARAMETER ::   jpr_cal    = 29   ! calving
94   INTEGER, PARAMETER ::   jpr_taum   = 30   ! wind stress module
95   INTEGER, PARAMETER ::   jpr_co2    = 31
96   INTEGER, PARAMETER ::   jpr_topm   = 32   ! topmeltn
97   INTEGER, PARAMETER ::   jpr_botm   = 33   ! botmeltn
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 ::   jpr_mslp   = 43   ! mean sea level pressure
108   INTEGER, PARAMETER ::   jpr_hsig   = 44   ! Hsig
109   INTEGER, PARAMETER ::   jpr_phioc  = 45   ! Wave=>ocean energy flux
110   INTEGER, PARAMETER ::   jpr_sdrftx = 46   ! Stokes drift on grid 1
111   INTEGER, PARAMETER ::   jpr_sdrfty = 47   ! Stokes drift on grid 2
112   INTEGER, PARAMETER ::   jpr_wper   = 48   ! Mean wave period
113   INTEGER, PARAMETER ::   jpr_wnum   = 49   ! Mean wavenumber
114   INTEGER, PARAMETER ::   jpr_tauwoc = 50   ! Stress fraction adsorbed by waves
115   INTEGER, PARAMETER ::   jpr_wdrag  = 51   ! Neutral surface drag coefficient
116   INTEGER, PARAMETER ::   jpr_isf    = 52
117   INTEGER, PARAMETER ::   jpr_icb    = 53
118   INTEGER, PARAMETER ::   jpr_wfreq  = 54   ! Wave peak frequency
119   INTEGER, PARAMETER ::   jpr_tauwx  = 55   ! x component of the ocean stress from waves
120   INTEGER, PARAMETER ::   jpr_tauwy  = 56   ! y component of the ocean stress from waves
121   INTEGER, PARAMETER ::   jpr_ts_ice = 57   ! Sea ice surface temp
122
123   INTEGER, PARAMETER ::   jprcv      = 57   ! total number of fields received 
124
125   INTEGER, PARAMETER ::   jps_fice   =  1   ! ice fraction sent to the atmosphere
126   INTEGER, PARAMETER ::   jps_toce   =  2   ! ocean temperature
127   INTEGER, PARAMETER ::   jps_tice   =  3   ! ice   temperature
128   INTEGER, PARAMETER ::   jps_tmix   =  4   ! mixed temperature (ocean+ice)
129   INTEGER, PARAMETER ::   jps_albice =  5   ! ice   albedo
130   INTEGER, PARAMETER ::   jps_albmix =  6   ! mixed albedo
131   INTEGER, PARAMETER ::   jps_hice   =  7   ! ice  thickness
132   INTEGER, PARAMETER ::   jps_hsnw   =  8   ! snow thickness
133   INTEGER, PARAMETER ::   jps_ocx1   =  9   ! ocean current on grid 1
134   INTEGER, PARAMETER ::   jps_ocy1   = 10   !
135   INTEGER, PARAMETER ::   jps_ocz1   = 11   !
136   INTEGER, PARAMETER ::   jps_ivx1   = 12   ! ice   current on grid 1
137   INTEGER, PARAMETER ::   jps_ivy1   = 13   !
138   INTEGER, PARAMETER ::   jps_ivz1   = 14   !
139   INTEGER, PARAMETER ::   jps_co2    = 15
140   INTEGER, PARAMETER ::   jps_soce   = 16   ! ocean salinity
141   INTEGER, PARAMETER ::   jps_ssh    = 17   ! sea surface height
142   INTEGER, PARAMETER ::   jps_qsroce = 18   ! Qsr above the ocean
143   INTEGER, PARAMETER ::   jps_qnsoce = 19   ! Qns above the ocean
144   INTEGER, PARAMETER ::   jps_oemp   = 20   ! ocean freshwater budget (evap - precip)
145   INTEGER, PARAMETER ::   jps_sflx   = 21   ! salt flux
146   INTEGER, PARAMETER ::   jps_otx1   = 22   ! 2 atmosphere-ocean stress components on grid 1
147   INTEGER, PARAMETER ::   jps_oty1   = 23   !
148   INTEGER, PARAMETER ::   jps_rnf    = 24   ! runoffs
149   INTEGER, PARAMETER ::   jps_taum   = 25   ! wind stress module
150   INTEGER, PARAMETER ::   jps_fice2  = 26   ! ice fraction sent to OPA (by SAS when doing SAS-OPA coupling)
151   INTEGER, PARAMETER ::   jps_e3t1st = 27   ! first level depth (vvl)
152   INTEGER, PARAMETER ::   jps_fraqsr = 28   ! fraction of solar net radiation absorbed in the first ocean level
153   INTEGER, PARAMETER ::   jps_ficet  = 29   ! total ice fraction 
154   INTEGER, PARAMETER ::   jps_ocxw   = 30   ! currents on grid 1 
155   INTEGER, PARAMETER ::   jps_ocyw   = 31   ! currents on grid 2
156   INTEGER, PARAMETER ::   jps_wlev   = 32   ! water level
157   INTEGER, PARAMETER ::   jps_fice1  = 33   ! first-order ice concentration (for semi-implicit coupling of atmos-ice fluxes)
158   INTEGER, PARAMETER ::   jps_a_p    = 34   ! meltpond area fraction
159   INTEGER, PARAMETER ::   jps_ht_p   = 35   ! meltpond thickness
160   INTEGER, PARAMETER ::   jps_kice   = 36   ! sea ice effective conductivity
161   INTEGER, PARAMETER ::   jps_sstfrz = 37   ! sea surface freezing temperature
162   INTEGER, PARAMETER ::   jps_ttilyr = 38   ! sea ice top layer temp
163
164   INTEGER, PARAMETER ::   jpsnd      = 38   ! total number of fields sent
165
166#if ! defined key_oasis3
167   ! Dummy variables to enable compilation when oasis3 is not being used
168   INTEGER                    ::   OASIS_Sent        = -1 
169   INTEGER                    ::   OASIS_SentOut     = -1 
170   INTEGER                    ::   OASIS_ToRest      = -1 
171   INTEGER                    ::   OASIS_ToRestOut   = -1 
172#endif 
173
174   !                                  !!** namelist namsbc_cpl **
175   TYPE ::   FLD_C                     !   
176      CHARACTER(len = 32) ::   cldes      ! desciption of the coupling strategy
177      CHARACTER(len = 32) ::   clcat      ! multiple ice categories strategy
178      CHARACTER(len = 32) ::   clvref     ! reference of vector ('spherical' or 'cartesian')
179      CHARACTER(len = 32) ::   clvor      ! orientation of vector fields ('eastward-northward' or 'local grid')
180      CHARACTER(len = 32) ::   clvgrd     ! grids on which is located the vector fields
181   END TYPE FLD_C
182   !                                   ! Send to the atmosphere 
183   TYPE(FLD_C) ::   sn_snd_temp  , sn_snd_alb , sn_snd_thick, sn_snd_crt   , sn_snd_co2,  &
184      &             sn_snd_thick1, sn_snd_cond, sn_snd_mpnd , sn_snd_sstfrz, sn_snd_ttilyr
185   !                                   ! Received from the atmosphere
186   TYPE(FLD_C) ::   sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_tauw, sn_rcv_dqnsdt, sn_rcv_qsr,  &
187      &             sn_rcv_qns , sn_rcv_emp   , sn_rcv_rnf, sn_rcv_ts_ice
188   TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_mslp, sn_rcv_icb, sn_rcv_isf
189   ! Send to waves
190   TYPE(FLD_C) ::   sn_snd_ifrac, sn_snd_crtw, sn_snd_wlev 
191   ! Received from waves
192   TYPE(FLD_C) ::   sn_rcv_hsig, sn_rcv_phioc, sn_rcv_sdrfx, sn_rcv_sdrfy, sn_rcv_wper, sn_rcv_wnum, sn_rcv_tauwoc, &
193                    sn_rcv_wdrag, sn_rcv_wfreq
194   !                                   ! Other namelist parameters
195   INTEGER     ::   nn_cplmodel           ! Maximum number of models to/from which NEMO is potentialy sending/receiving data
196   LOGICAL     ::   ln_usecplmask         !  use a coupling mask file to merge data received from several models
197                                          !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel)
198   LOGICAL     ::   ln_scale_ice_flux     !  use ice fluxes that are already "ice weighted" ( i.e. multiplied ice concentration)
199
200   TYPE ::   DYNARR     
201      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z3   
202   END TYPE DYNARR
203
204   TYPE( DYNARR ), SAVE, DIMENSION(jprcv) ::   frcv                ! all fields recieved from the atmosphere
205
206   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   alb_oce_mix    ! ocean albedo sent to atmosphere (mix clear/overcast sky)
207#if defined key_si3 || defined key_cice
208   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i_last_couple !: Ice fractional area at last coupling time
209#endif
210
211   REAL(wp) ::   rpref = 101000._wp   ! reference atmospheric pressure[N/m2]
212   REAL(wp) ::   r1_grau              ! = 1.e0 / (grav * rau0)
213
214   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) ::   nrcvinfo           ! OASIS info argument
215
216   !! Substitution
217#  include "vectopt_loop_substitute.h90"
218   !!----------------------------------------------------------------------
219   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
220   !! $Id$
221   !! Software governed by the CeCILL license (see ./LICENSE)
222   !!----------------------------------------------------------------------
223CONTAINS
224 
225   INTEGER FUNCTION sbc_cpl_alloc()
226      !!----------------------------------------------------------------------
227      !!             ***  FUNCTION sbc_cpl_alloc  ***
228      !!----------------------------------------------------------------------
229      INTEGER :: ierr(5)
230      !!----------------------------------------------------------------------
231      ierr(:) = 0
232      !
233      ALLOCATE( alb_oce_mix(jpi,jpj), nrcvinfo(jprcv),  STAT=ierr(1) )
234     
235#if ! defined key_si3 && ! defined key_cice
236      ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) )  ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init)
237#endif
238      !ALLOCATE( xcplmask(jpi,jpj,nn_cplmodel) , STAT=ierr(3) )     
239      ! Hardwire three models as nn_cplmodel has not been read in from the namelist yet.     
240      ALLOCATE( xcplmask(jpi,jpj,0:3) , STAT=ierr(3) )
241#if defined key_si3 || defined key_cice
242      ALLOCATE( a_i_last_couple(jpi,jpj,jpl) , STAT=ierr(4) )
243#endif
244      !
245      IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(5) )
246
247      sbc_cpl_alloc = MAXVAL( ierr )
248      CALL mpp_sum ( 'sbccpl', sbc_cpl_alloc )
249      IF( sbc_cpl_alloc > 0 )   CALL ctl_warn('sbc_cpl_alloc: allocation of arrays failed')
250      !
251   END FUNCTION sbc_cpl_alloc
252
253
254   SUBROUTINE sbc_cpl_init( k_ice )     
255      !!----------------------------------------------------------------------
256      !!             ***  ROUTINE sbc_cpl_init  ***
257      !!
258      !! ** Purpose :   Initialisation of send and received information from
259      !!                the atmospheric component
260      !!
261      !! ** Method  : * Read namsbc_cpl namelist
262      !!              * define the receive interface
263      !!              * define the send    interface
264      !!              * initialise the OASIS coupler
265      !!----------------------------------------------------------------------
266      INTEGER, INTENT(in) ::   k_ice   ! ice management in the sbc (=0/1/2/3)
267      !
268      INTEGER ::   jn          ! dummy loop index
269      INTEGER ::   ios, inum   ! Local integer
270      REAL(wp), DIMENSION(jpi,jpj) ::   zacs, zaos
271      !!
272      NAMELIST/namsbc_cpl/  nn_cplmodel  , ln_usecplmask, nn_cats_cpl , ln_scale_ice_flux,             &
273         &                  sn_snd_temp  , sn_snd_alb   , sn_snd_thick, sn_snd_crt   , sn_snd_co2   ,  & 
274         &                  sn_snd_ttilyr, sn_snd_cond  , sn_snd_mpnd , sn_snd_sstfrz, sn_snd_thick1,  & 
275         &                  sn_snd_ifrac , sn_snd_crtw  , sn_snd_wlev , sn_rcv_hsig  , sn_rcv_phioc ,  & 
276         &                  sn_rcv_w10m  , sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr   ,  & 
277         &                  sn_rcv_sdrfx , sn_rcv_sdrfy , sn_rcv_wper , sn_rcv_wnum  , sn_rcv_tauwoc,  &
278         &                  sn_rcv_wdrag , sn_rcv_qns   , sn_rcv_emp  , sn_rcv_rnf   , sn_rcv_cal   ,  &
279         &                  sn_rcv_iceflx, sn_rcv_co2   , sn_rcv_mslp ,                                &
280         &                  sn_rcv_icb   , sn_rcv_isf   , sn_rcv_wfreq, sn_rcv_tauw  ,                 &
281         &                  sn_rcv_ts_ice
282      !!---------------------------------------------------------------------
283      !
284      ! ================================ !
285      !      Namelist informations       !
286      ! ================================ !
287      !
288      REWIND( numnam_ref )              ! Namelist namsbc_cpl in reference namelist : Variables for OASIS coupling
289      READ  ( numnam_ref, namsbc_cpl, IOSTAT = ios, ERR = 901)
290901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_cpl in reference namelist' )
291      !
292      REWIND( numnam_cfg )              ! Namelist namsbc_cpl in configuration namelist : Variables for OASIS coupling
293      READ  ( numnam_cfg, namsbc_cpl, IOSTAT = ios, ERR = 902 )
294902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_cpl in configuration namelist' )
295      IF(lwm) WRITE ( numond, namsbc_cpl )
296      !
297      IF(lwp) THEN                        ! control print
298         WRITE(numout,*)
299         WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist '
300         WRITE(numout,*)'~~~~~~~~~~~~'
301      ENDIF
302      IF( lwp .AND. ln_cpl ) THEN                        ! control print
303         WRITE(numout,*)'  nn_cplmodel                         = ', nn_cplmodel
304         WRITE(numout,*)'  ln_usecplmask                       = ', ln_usecplmask
305         WRITE(numout,*)'  ln_scale_ice_flux                   = ', ln_scale_ice_flux
306         WRITE(numout,*)'  nn_cats_cpl                         = ', nn_cats_cpl
307         WRITE(numout,*)'  received fields (mutiple ice categogies)'
308         WRITE(numout,*)'      10m wind module                 = ', TRIM(sn_rcv_w10m%cldes  ), ' (', TRIM(sn_rcv_w10m%clcat  ), ')'
309         WRITE(numout,*)'      stress module                   = ', TRIM(sn_rcv_taumod%cldes), ' (', TRIM(sn_rcv_taumod%clcat), ')'
310         WRITE(numout,*)'      surface stress                  = ', TRIM(sn_rcv_tau%cldes   ), ' (', TRIM(sn_rcv_tau%clcat   ), ')'
311         WRITE(numout,*)'                     - referential    = ', sn_rcv_tau%clvref
312         WRITE(numout,*)'                     - orientation    = ', sn_rcv_tau%clvor
313         WRITE(numout,*)'                     - mesh           = ', sn_rcv_tau%clvgrd
314         WRITE(numout,*)'      non-solar heat flux sensitivity = ', TRIM(sn_rcv_dqnsdt%cldes), ' (', TRIM(sn_rcv_dqnsdt%clcat), ')'
315         WRITE(numout,*)'      solar heat flux                 = ', TRIM(sn_rcv_qsr%cldes   ), ' (', TRIM(sn_rcv_qsr%clcat   ), ')'
316         WRITE(numout,*)'      non-solar heat flux             = ', TRIM(sn_rcv_qns%cldes   ), ' (', TRIM(sn_rcv_qns%clcat   ), ')'
317         WRITE(numout,*)'      freshwater budget               = ', TRIM(sn_rcv_emp%cldes   ), ' (', TRIM(sn_rcv_emp%clcat   ), ')'
318         WRITE(numout,*)'      runoffs                         = ', TRIM(sn_rcv_rnf%cldes   ), ' (', TRIM(sn_rcv_rnf%clcat   ), ')'
319         WRITE(numout,*)'      calving                         = ', TRIM(sn_rcv_cal%cldes   ), ' (', TRIM(sn_rcv_cal%clcat   ), ')'
320         WRITE(numout,*)'      iceberg                         = ', TRIM(sn_rcv_icb%cldes   ), ' (', TRIM(sn_rcv_icb%clcat   ), ')'
321         WRITE(numout,*)'      ice shelf                       = ', TRIM(sn_rcv_isf%cldes   ), ' (', TRIM(sn_rcv_isf%clcat   ), ')'
322         WRITE(numout,*)'      sea ice heat fluxes             = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')'
323         WRITE(numout,*)'      atm co2                         = ', TRIM(sn_rcv_co2%cldes   ), ' (', TRIM(sn_rcv_co2%clcat   ), ')'
324         WRITE(numout,*)'      significant wave heigth         = ', TRIM(sn_rcv_hsig%cldes  ), ' (', TRIM(sn_rcv_hsig%clcat  ), ')' 
325         WRITE(numout,*)'      wave to oce energy flux         = ', TRIM(sn_rcv_phioc%cldes ), ' (', TRIM(sn_rcv_phioc%clcat ), ')' 
326         WRITE(numout,*)'      Surface Stokes drift grid u     = ', TRIM(sn_rcv_sdrfx%cldes ), ' (', TRIM(sn_rcv_sdrfx%clcat ), ')' 
327         WRITE(numout,*)'      Surface Stokes drift grid v     = ', TRIM(sn_rcv_sdrfy%cldes ), ' (', TRIM(sn_rcv_sdrfy%clcat ), ')' 
328         WRITE(numout,*)'      Mean wave period                = ', TRIM(sn_rcv_wper%cldes  ), ' (', TRIM(sn_rcv_wper%clcat  ), ')' 
329         WRITE(numout,*)'      Mean wave number                = ', TRIM(sn_rcv_wnum%cldes  ), ' (', TRIM(sn_rcv_wnum%clcat  ), ')' 
330         WRITE(numout,*)'      Wave peak frequency             = ', TRIM(sn_rcv_wfreq%cldes ), ' (', TRIM(sn_rcv_wfreq%clcat ), ')'
331         WRITE(numout,*)'      Stress frac adsorbed by waves   = ', TRIM(sn_rcv_tauwoc%cldes), ' (', TRIM(sn_rcv_tauwoc%clcat ), ')' 
332         WRITE(numout,*)'      Stress components by waves      = ', TRIM(sn_rcv_tauw%cldes  ), ' (', TRIM(sn_rcv_tauw%clcat  ), ')'
333         WRITE(numout,*)'      Neutral surf drag coefficient   = ', TRIM(sn_rcv_wdrag%cldes ), ' (', TRIM(sn_rcv_wdrag%clcat ), ')' 
334         WRITE(numout,*)'      Sea ice surface skin temperature= ', TRIM(sn_rcv_ts_ice%cldes), ' (', TRIM(sn_rcv_ts_ice%clcat), ')' 
335         WRITE(numout,*)'  sent fields (multiple ice categories)'
336         WRITE(numout,*)'      surface temperature             = ', TRIM(sn_snd_temp%cldes  ), ' (', TRIM(sn_snd_temp%clcat  ), ')'
337         WRITE(numout,*)'      top ice layer temperature       = ', TRIM(sn_snd_ttilyr%cldes), ' (', TRIM(sn_snd_ttilyr%clcat), ')'
338         WRITE(numout,*)'      albedo                          = ', TRIM(sn_snd_alb%cldes   ), ' (', TRIM(sn_snd_alb%clcat   ), ')'
339         WRITE(numout,*)'      ice/snow thickness              = ', TRIM(sn_snd_thick%cldes ), ' (', TRIM(sn_snd_thick%clcat ), ')'
340         WRITE(numout,*)'      total ice fraction              = ', TRIM(sn_snd_ifrac%cldes ), ' (', TRIM(sn_snd_ifrac%clcat ), ')' 
341         WRITE(numout,*)'      surface current                 = ', TRIM(sn_snd_crt%cldes   ), ' (', TRIM(sn_snd_crt%clcat   ), ')'
342         WRITE(numout,*)'                      - referential   = ', sn_snd_crt%clvref 
343         WRITE(numout,*)'                      - orientation   = ', sn_snd_crt%clvor
344         WRITE(numout,*)'                      - mesh          = ', sn_snd_crt%clvgrd
345         WRITE(numout,*)'      oce co2 flux                    = ', TRIM(sn_snd_co2%cldes   ), ' (', TRIM(sn_snd_co2%clcat   ), ')'
346         WRITE(numout,*)'      ice effective conductivity      = ', TRIM(sn_snd_cond%cldes  ), ' (', TRIM(sn_snd_cond%clcat  ), ')'
347         WRITE(numout,*)'      meltponds fraction and depth    = ', TRIM(sn_snd_mpnd%cldes  ), ' (', TRIM(sn_snd_mpnd%clcat  ), ')'
348         WRITE(numout,*)'      sea surface freezing temp       = ', TRIM(sn_snd_sstfrz%cldes), ' (', TRIM(sn_snd_sstfrz%clcat), ')'
349         WRITE(numout,*)'      water level                     = ', TRIM(sn_snd_wlev%cldes  ), ' (', TRIM(sn_snd_wlev%clcat  ), ')' 
350         WRITE(numout,*)'      mean sea level pressure         = ', TRIM(sn_rcv_mslp%cldes  ), ' (', TRIM(sn_rcv_mslp%clcat  ), ')' 
351         WRITE(numout,*)'      surface current to waves        = ', TRIM(sn_snd_crtw%cldes  ), ' (', TRIM(sn_snd_crtw%clcat  ), ')' 
352         WRITE(numout,*)'                      - referential   = ', sn_snd_crtw%clvref 
353         WRITE(numout,*)'                      - orientation   = ', sn_snd_crtw%clvor 
354         WRITE(numout,*)'                      - mesh          = ', sn_snd_crtw%clvgrd 
355      ENDIF
356
357      !                                   ! allocate sbccpl arrays
358!      IF( sbc_cpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' )
359     
360      ! ================================ !
361      !   Define the receive interface   !
362      ! ================================ !
363      nrcvinfo(:) = OASIS_idle   ! needed by nrcvinfo(jpr_otx1) if we do not receive ocean stress
364
365      ! for each field: define the OASIS name                              (srcv(:)%clname)
366      !                 define receive or not from the namelist parameters (srcv(:)%laction)
367      !                 define the north fold type of lbc                  (srcv(:)%nsgn)
368
369      ! default definitions of srcv
370      srcv(:)%laction = .FALSE.   ;   srcv(:)%clgrid = 'T'   ;   srcv(:)%nsgn = 1.   ;   srcv(:)%nct = 1
371
372      !                                                      ! ------------------------- !
373      !                                                      ! ice and ocean wind stress !   
374      !                                                      ! ------------------------- !
375      !                                                           ! Name
376      srcv(jpr_otx1)%clname = 'O_OTaux1'      ! 1st ocean component on grid ONE (T or U)
377      srcv(jpr_oty1)%clname = 'O_OTauy1'      ! 2nd   -      -         -     -
378      srcv(jpr_otz1)%clname = 'O_OTauz1'      ! 3rd   -      -         -     -
379      srcv(jpr_otx2)%clname = 'O_OTaux2'      ! 1st ocean component on grid TWO (V)
380      srcv(jpr_oty2)%clname = 'O_OTauy2'      ! 2nd   -      -         -     -
381      srcv(jpr_otz2)%clname = 'O_OTauz2'      ! 3rd   -      -         -     -
382      !
383      srcv(jpr_itx1)%clname = 'O_ITaux1'      ! 1st  ice  component on grid ONE (T, F, I or U)
384      srcv(jpr_ity1)%clname = 'O_ITauy1'      ! 2nd   -      -         -     -
385      srcv(jpr_itz1)%clname = 'O_ITauz1'      ! 3rd   -      -         -     -
386      srcv(jpr_itx2)%clname = 'O_ITaux2'      ! 1st  ice  component on grid TWO (V)
387      srcv(jpr_ity2)%clname = 'O_ITauy2'      ! 2nd   -      -         -     -
388      srcv(jpr_itz2)%clname = 'O_ITauz2'      ! 3rd   -      -         -     -
389      !
390      ! Vectors: change of sign at north fold ONLY if on the local grid
391      IF(       TRIM( sn_rcv_tau%cldes ) == 'oce only' .OR. TRIM( sn_rcv_tau%cldes ) == 'oce and ice'  &
392           .OR. TRIM( sn_rcv_tau%cldes ) == 'mixed oce-ice' ) THEN ! avoid working with the atmospheric fields if they are not coupled
393      !
394      IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' )   srcv(jpr_otx1:jpr_itz2)%nsgn = -1.
395     
396      !                                                           ! Set grid and action
397      SELECT CASE( TRIM( sn_rcv_tau%clvgrd ) )      !  'T', 'U,V', 'U,V,I', 'U,V,F', 'T,I', 'T,F', or 'T,U,V'
398      CASE( 'T' ) 
399         srcv(jpr_otx1:jpr_itz2)%clgrid  = 'T'        ! oce and ice components given at T-point
400         srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1
401         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1
402      CASE( 'U,V' ) 
403         srcv(jpr_otx1:jpr_otz1)%clgrid  = 'U'        ! oce components given at U-point
404         srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point
405         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'U'        ! ice components given at U-point
406         srcv(jpr_itx2:jpr_itz2)%clgrid  = 'V'        !           and           V-point
407         srcv(jpr_otx1:jpr_itz2)%laction = .TRUE.     ! receive oce and ice components on both grid 1 & 2
408      CASE( 'U,V,T' )
409         srcv(jpr_otx1:jpr_otz1)%clgrid  = 'U'        ! oce components given at U-point
410         srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point
411         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'T'        ! ice components given at T-point
412         srcv(jpr_otx1:jpr_otz2)%laction = .TRUE.     ! receive oce components on grid 1 & 2
413         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 only
414      CASE( 'U,V,I' )
415         srcv(jpr_otx1:jpr_otz1)%clgrid  = 'U'        ! oce components given at U-point
416         srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point
417         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'I'        ! ice components given at I-point
418         srcv(jpr_otx1:jpr_otz2)%laction = .TRUE.     ! receive oce components on grid 1 & 2
419         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 only
420      CASE( 'U,V,F' )
421         srcv(jpr_otx1:jpr_otz1)%clgrid  = 'U'        ! oce components given at U-point
422         srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point
423         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'F'        ! ice components given at F-point
424         srcv(jpr_otx1:jpr_otz2)%laction = .TRUE.     ! receive oce components on grid 1 & 2
425         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 only
426      CASE( 'T,I' ) 
427         srcv(jpr_otx1:jpr_itz2)%clgrid  = 'T'        ! oce and ice components given at T-point
428         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'I'        ! ice components given at I-point
429         srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1
430         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1
431      CASE( 'T,F' ) 
432         srcv(jpr_otx1:jpr_itz2)%clgrid  = 'T'        ! oce and ice components given at T-point
433         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'F'        ! ice components given at F-point
434         srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1
435         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1
436      CASE( 'T,U,V' )
437         srcv(jpr_otx1:jpr_otz1)%clgrid  = 'T'        ! oce components given at T-point
438         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'U'        ! ice components given at U-point
439         srcv(jpr_itx2:jpr_itz2)%clgrid  = 'V'        !           and           V-point
440         srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1 only
441         srcv(jpr_itx1:jpr_itz2)%laction = .TRUE.     ! receive ice components on grid 1 & 2
442      CASE default   
443         CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_tau%clvgrd' )
444      END SELECT
445      !
446      IF( TRIM( sn_rcv_tau%clvref ) == 'spherical' )   &           ! spherical: 3rd component not received
447         &     srcv( (/jpr_otz1, jpr_otz2, jpr_itz1, jpr_itz2/) )%laction = .FALSE. 
448      !
449      IF( TRIM( sn_rcv_tau%clvor  ) == 'local grid' ) THEN        ! already on local grid -> no need of the second grid
450            srcv(jpr_otx2:jpr_otz2)%laction = .FALSE. 
451            srcv(jpr_itx2:jpr_itz2)%laction = .FALSE. 
452            srcv(jpr_oty1)%clgrid = srcv(jpr_oty2)%clgrid   ! not needed but cleaner...
453            srcv(jpr_ity1)%clgrid = srcv(jpr_ity2)%clgrid   ! not needed but cleaner...
454      ENDIF
455      !
456      IF( TRIM( sn_rcv_tau%cldes ) /= 'oce and ice' ) THEN        ! 'oce and ice' case ocean stress on ocean mesh used
457         srcv(jpr_itx1:jpr_itz2)%laction = .FALSE.    ! ice components not received
458         srcv(jpr_itx1)%clgrid = 'U'                  ! ocean stress used after its transformation
459         srcv(jpr_ity1)%clgrid = 'V'                  ! i.e. it is always at U- & V-points for i- & j-comp. resp.
460      ENDIF
461      ENDIF
462
463      !                                                      ! ------------------------- !
464      !                                                      !    freshwater budget      !   E-P
465      !                                                      ! ------------------------- !
466      ! we suppose that atmosphere modele do not make the difference between precipiration (liquide or solid)
467      ! over ice of free ocean within the same atmospheric cell.cd
468      srcv(jpr_rain)%clname = 'OTotRain'      ! Rain = liquid precipitation
469      srcv(jpr_snow)%clname = 'OTotSnow'      ! Snow = solid precipitation
470      srcv(jpr_tevp)%clname = 'OTotEvap'      ! total evaporation (over oce + ice sublimation)
471      srcv(jpr_ievp)%clname = 'OIceEvap'      ! evaporation over ice = sublimation
472      srcv(jpr_sbpr)%clname = 'OSubMPre'      ! sublimation - liquid precipitation - solid precipitation
473      srcv(jpr_semp)%clname = 'OISubMSn'      ! ice solid water budget = sublimation - solid precipitation
474      srcv(jpr_oemp)%clname = 'OOEvaMPr'      ! ocean water budget = ocean Evap - ocean precip
475      SELECT CASE( TRIM( sn_rcv_emp%cldes ) )
476      CASE( 'none'          )       ! nothing to do
477      CASE( 'oce only'      )   ;   srcv(jpr_oemp)%laction = .TRUE. 
478      CASE( 'conservative'  )
479         srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE.
480         IF ( k_ice <= 1 )  srcv(jpr_ievp)%laction = .FALSE.
481      CASE( 'oce and ice'   )   ;   srcv( (/jpr_ievp, jpr_sbpr, jpr_semp, jpr_oemp/) )%laction = .TRUE.
482      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' )
483      END SELECT
484      !
485      !                                                      ! ------------------------- !
486      !                                                      !     Runoffs & Calving     !   
487      !                                                      ! ------------------------- !
488      srcv(jpr_rnf   )%clname = 'O_Runoff'
489      IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN
490         srcv(jpr_rnf)%laction = .TRUE.
491         l_rnfcpl              = .TRUE.                      ! -> no need to read runoffs in sbcrnf
492         ln_rnf                = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas
493         IF(lwp) WRITE(numout,*)
494         IF(lwp) WRITE(numout,*) '   runoffs received from oasis -> force ln_rnf = ', ln_rnf
495      ENDIF
496      !
497      srcv(jpr_cal)%clname = 'OCalving'   ;  IF( TRIM( sn_rcv_cal%cldes) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE.
498      srcv(jpr_isf)%clname = 'OIcshelf'   ;  IF( TRIM( sn_rcv_isf%cldes) == 'coupled' )   srcv(jpr_isf)%laction = .TRUE.
499      srcv(jpr_icb)%clname = 'OIceberg'   ;  IF( TRIM( sn_rcv_icb%cldes) == 'coupled' )   srcv(jpr_icb)%laction = .TRUE.
500
501      IF( srcv(jpr_isf)%laction .AND. ln_isf ) THEN
502         l_isfcpl             = .TRUE.                      ! -> no need to read isf in sbcisf
503         IF(lwp) WRITE(numout,*)
504         IF(lwp) WRITE(numout,*) '   iceshelf received from oasis '
505      ENDIF
506      !
507      !                                                      ! ------------------------- !
508      !                                                      !    non solar radiation    !   Qns
509      !                                                      ! ------------------------- !
510      srcv(jpr_qnsoce)%clname = 'O_QnsOce'
511      srcv(jpr_qnsice)%clname = 'O_QnsIce'
512      srcv(jpr_qnsmix)%clname = 'O_QnsMix'
513      SELECT CASE( TRIM( sn_rcv_qns%cldes ) )
514      CASE( 'none'          )       ! nothing to do
515      CASE( 'oce only'      )   ;   srcv(               jpr_qnsoce   )%laction = .TRUE.
516      CASE( 'conservative'  )   ;   srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE.
517      CASE( 'oce and ice'   )   ;   srcv( (/jpr_qnsice, jpr_qnsoce/) )%laction = .TRUE.
518      CASE( 'mixed oce-ice' )   ;   srcv(               jpr_qnsmix   )%laction = .TRUE. 
519      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qns%cldes' )
520      END SELECT
521      IF( TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' .AND. nn_cats_cpl > 1 ) &
522         CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qns%cldes not currently allowed to be mixed oce-ice for multi-category ice' )
523      !
524      !                                                      ! ------------------------- !
525      !                                                      !    solar radiation        !   Qsr
526      !                                                      ! ------------------------- !
527      srcv(jpr_qsroce)%clname = 'O_QsrOce'
528      srcv(jpr_qsrice)%clname = 'O_QsrIce'
529      srcv(jpr_qsrmix)%clname = 'O_QsrMix'
530      SELECT CASE( TRIM( sn_rcv_qsr%cldes ) )
531      CASE( 'none'          )       ! nothing to do
532      CASE( 'oce only'      )   ;   srcv(               jpr_qsroce   )%laction = .TRUE.
533      CASE( 'conservative'  )   ;   srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE.
534      CASE( 'oce and ice'   )   ;   srcv( (/jpr_qsrice, jpr_qsroce/) )%laction = .TRUE.
535      CASE( 'mixed oce-ice' )   ;   srcv(               jpr_qsrmix   )%laction = .TRUE. 
536      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qsr%cldes' )
537      END SELECT
538      IF( TRIM( sn_rcv_qsr%cldes ) == 'mixed oce-ice' .AND. nn_cats_cpl > 1 ) &
539         CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qsr%cldes not currently allowed to be mixed oce-ice for multi-category ice' )
540      !
541      !                                                      ! ------------------------- !
542      !                                                      !   non solar sensitivity   !   d(Qns)/d(T)
543      !                                                      ! ------------------------- !
544      srcv(jpr_dqnsdt)%clname = 'O_dQnsdT'   
545      IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'coupled' )   srcv(jpr_dqnsdt)%laction = .TRUE.
546      !
547      ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique
548      IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' )  &
549         &   CALL ctl_stop( 'sbc_cpl_init: namsbc_cpl namelist mismatch between sn_rcv_qns%cldes and sn_rcv_dqnsdt%cldes' )
550      !
551      !                                                      ! ------------------------- !
552      !                                                      !      10m wind module      !   
553      !                                                      ! ------------------------- !
554      srcv(jpr_w10m)%clname = 'O_Wind10'   ;   IF( TRIM(sn_rcv_w10m%cldes  ) == 'coupled' )   srcv(jpr_w10m)%laction = .TRUE. 
555      !
556      !                                                      ! ------------------------- !
557      !                                                      !   wind stress module      !   
558      !                                                      ! ------------------------- !
559      srcv(jpr_taum)%clname = 'O_TauMod'   ;   IF( TRIM(sn_rcv_taumod%cldes) == 'coupled' )   srcv(jpr_taum)%laction = .TRUE.
560      lhftau = srcv(jpr_taum)%laction
561      !
562      !                                                      ! ------------------------- !
563      !                                                      !      Atmospheric CO2      !
564      !                                                      ! ------------------------- !
565      srcv(jpr_co2 )%clname = 'O_AtmCO2'   
566      IF( TRIM(sn_rcv_co2%cldes   ) == 'coupled' )  THEN
567         srcv(jpr_co2 )%laction = .TRUE.
568         l_co2cpl = .TRUE.
569         IF(lwp) WRITE(numout,*)
570         IF(lwp) WRITE(numout,*) '   Atmospheric pco2 received from oasis '
571         IF(lwp) WRITE(numout,*)
572      ENDIF
573      !
574      !                                                      ! ------------------------- !
575      !                                                      ! Mean Sea Level Pressure   !
576      !                                                      ! ------------------------- !
577      srcv(jpr_mslp)%clname = 'O_MSLP'     ;   IF( TRIM(sn_rcv_mslp%cldes  ) == 'coupled' )    srcv(jpr_mslp)%laction = .TRUE. 
578      !
579      !                                                      ! ------------------------- !
580      !                                                      !  ice topmelt and botmelt  !   
581      !                                                      ! ------------------------- !
582      srcv(jpr_topm )%clname = 'OTopMlt'
583      srcv(jpr_botm )%clname = 'OBotMlt'
584      IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN
585         IF ( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN
586            srcv(jpr_topm:jpr_botm)%nct = nn_cats_cpl
587         ELSE
588            CALL ctl_stop( 'sbc_cpl_init: sn_rcv_iceflx%clcat should always be set to yes currently' )
589         ENDIF
590         srcv(jpr_topm:jpr_botm)%laction = .TRUE.
591      ENDIF
592      !                                                      ! ------------------------- !
593      !                                                      !    ice skin temperature   !   
594      !                                                      ! ------------------------- !
595      srcv(jpr_ts_ice)%clname = 'OTsfIce'    ! needed by Met Office
596      IF ( TRIM( sn_rcv_ts_ice%cldes ) == 'ice' )   srcv(jpr_ts_ice)%laction = .TRUE.
597      IF ( TRIM( sn_rcv_ts_ice%clcat ) == 'yes' )   srcv(jpr_ts_ice)%nct     = nn_cats_cpl
598      IF ( TRIM( sn_rcv_emp%clcat    ) == 'yes' )   srcv(jpr_ievp)%nct       = nn_cats_cpl
599
600#if defined key_si3
601      IF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN
602         IF( .NOT.srcv(jpr_ts_ice)%laction )  &
603            &   CALL ctl_stop( 'sbc_cpl_init: srcv(jpr_ts_ice)%laction should be set to true when ln_cndflx=T' )     
604      ENDIF
605#endif
606      !                                                      ! ------------------------- !
607      !                                                      !      Wave breaking        !   
608      !                                                      ! ------------------------- !
609      srcv(jpr_hsig)%clname  = 'O_Hsigwa'    ! significant wave height
610      IF( TRIM(sn_rcv_hsig%cldes  ) == 'coupled' )  THEN
611         srcv(jpr_hsig)%laction = .TRUE.
612         cpl_hsig = .TRUE.
613      ENDIF
614      srcv(jpr_phioc)%clname = 'O_PhiOce'    ! wave to ocean energy
615      IF( TRIM(sn_rcv_phioc%cldes ) == 'coupled' )  THEN
616         srcv(jpr_phioc)%laction = .TRUE.
617         cpl_phioc = .TRUE.
618      ENDIF
619      srcv(jpr_sdrftx)%clname = 'O_Sdrfx'    ! Stokes drift in the u direction
620      IF( TRIM(sn_rcv_sdrfx%cldes ) == 'coupled' )  THEN
621         srcv(jpr_sdrftx)%laction = .TRUE.
622         cpl_sdrftx = .TRUE.
623      ENDIF
624      srcv(jpr_sdrfty)%clname = 'O_Sdrfy'    ! Stokes drift in the v direction
625      IF( TRIM(sn_rcv_sdrfy%cldes ) == 'coupled' )  THEN
626         srcv(jpr_sdrfty)%laction = .TRUE.
627         cpl_sdrfty = .TRUE.
628      ENDIF
629      srcv(jpr_wper)%clname = 'O_WPer'       ! mean wave period
630      IF( TRIM(sn_rcv_wper%cldes  ) == 'coupled' )  THEN
631         srcv(jpr_wper)%laction = .TRUE.
632         cpl_wper = .TRUE.
633      ENDIF
634      srcv(jpr_wfreq)%clname = 'O_WFreq'     ! wave peak frequency
635      IF( TRIM(sn_rcv_wfreq%cldes ) == 'coupled' )  THEN
636         srcv(jpr_wfreq)%laction = .TRUE.
637         cpl_wfreq = .TRUE.
638      ENDIF
639      srcv(jpr_wnum)%clname = 'O_WNum'       ! mean wave number
640      IF( TRIM(sn_rcv_wnum%cldes ) == 'coupled' )  THEN
641         srcv(jpr_wnum)%laction = .TRUE.
642         cpl_wnum = .TRUE.
643      ENDIF
644      srcv(jpr_tauwoc)%clname = 'O_TauOce'   ! stress fraction adsorbed by the wave
645      IF( TRIM(sn_rcv_tauwoc%cldes ) == 'coupled' )  THEN
646         srcv(jpr_tauwoc)%laction = .TRUE.
647         cpl_tauwoc = .TRUE.
648      ENDIF
649      srcv(jpr_tauwx)%clname = 'O_Tauwx'      ! ocean stress from wave in the x direction
650      srcv(jpr_tauwy)%clname = 'O_Tauwy'      ! ocean stress from wave in the y direction
651      IF( TRIM(sn_rcv_tauw%cldes ) == 'coupled' )  THEN
652         srcv(jpr_tauwx)%laction = .TRUE.
653         srcv(jpr_tauwy)%laction = .TRUE.
654         cpl_tauw = .TRUE.
655      ENDIF
656      srcv(jpr_wdrag)%clname = 'O_WDrag'     ! neutral surface drag coefficient
657      IF( TRIM(sn_rcv_wdrag%cldes ) == 'coupled' )  THEN
658         srcv(jpr_wdrag)%laction = .TRUE.
659         cpl_wdrag = .TRUE.
660      ENDIF
661      IF( srcv(jpr_tauwoc)%laction .AND. srcv(jpr_tauwx)%laction .AND. srcv(jpr_tauwy)%laction ) &
662            CALL ctl_stop( 'More than one method for modifying the ocean stress has been selected ', &
663                                     '(sn_rcv_tauwoc=coupled and sn_rcv_tauw=coupled)' )
664      !
665      !                                                      ! ------------------------------- !
666      !                                                      !   OPA-SAS coupling - rcv by opa !   
667      !                                                      ! ------------------------------- !
668      srcv(jpr_sflx)%clname = 'O_SFLX'
669      srcv(jpr_fice)%clname = 'RIceFrc'
670      !
671      IF( nn_components == jp_iam_opa ) THEN    ! OPA coupled to SAS via OASIS: force received field by OPA (sent by SAS)
672         srcv(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling
673         srcv(:)%clgrid  = 'T'       ! force default definition in case of opa <-> sas coupling
674         srcv(:)%nsgn    = 1.        ! force default definition in case of opa <-> sas coupling
675         srcv( (/jpr_qsroce, jpr_qnsoce, jpr_oemp, jpr_sflx, jpr_fice, jpr_otx1, jpr_oty1, jpr_taum/) )%laction = .TRUE.
676         srcv(jpr_otx1)%clgrid = 'U'        ! oce components given at U-point
677         srcv(jpr_oty1)%clgrid = 'V'        !           and           V-point
678         ! Vectors: change of sign at north fold ONLY if on the local grid
679         srcv( (/jpr_otx1,jpr_oty1/) )%nsgn = -1.
680         sn_rcv_tau%clvgrd = 'U,V'
681         sn_rcv_tau%clvor = 'local grid'
682         sn_rcv_tau%clvref = 'spherical'
683         sn_rcv_emp%cldes = 'oce only'
684         !
685         IF(lwp) THEN                        ! control print
686            WRITE(numout,*)
687            WRITE(numout,*)'               Special conditions for SAS-OPA coupling  '
688            WRITE(numout,*)'               OPA component  '
689            WRITE(numout,*)
690            WRITE(numout,*)'  received fields from SAS component '
691            WRITE(numout,*)'                  ice cover '
692            WRITE(numout,*)'                  oce only EMP  '
693            WRITE(numout,*)'                  salt flux  '
694            WRITE(numout,*)'                  mixed oce-ice solar flux  '
695            WRITE(numout,*)'                  mixed oce-ice non solar flux  '
696            WRITE(numout,*)'                  wind stress U,V on local grid and sperical coordinates '
697            WRITE(numout,*)'                  wind stress module'
698            WRITE(numout,*)
699         ENDIF
700      ENDIF
701      !                                                      ! -------------------------------- !
702      !                                                      !   OPA-SAS coupling - rcv by sas  !   
703      !                                                      ! -------------------------------- !
704      srcv(jpr_toce  )%clname = 'I_SSTSST'
705      srcv(jpr_soce  )%clname = 'I_SSSal'
706      srcv(jpr_ocx1  )%clname = 'I_OCurx1'
707      srcv(jpr_ocy1  )%clname = 'I_OCury1'
708      srcv(jpr_ssh   )%clname = 'I_SSHght'
709      srcv(jpr_e3t1st)%clname = 'I_E3T1st'   
710      srcv(jpr_fraqsr)%clname = 'I_FraQsr'   
711      !
712      IF( nn_components == jp_iam_sas ) THEN
713         IF( .NOT. ln_cpl ) srcv(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling
714         IF( .NOT. ln_cpl ) srcv(:)%clgrid  = 'T'       ! force default definition in case of opa <-> sas coupling
715         IF( .NOT. ln_cpl ) srcv(:)%nsgn    = 1.        ! force default definition in case of opa <-> sas coupling
716         srcv( (/jpr_toce, jpr_soce, jpr_ssh, jpr_fraqsr, jpr_ocx1, jpr_ocy1/) )%laction = .TRUE.
717         srcv( jpr_e3t1st )%laction = .NOT.ln_linssh
718         srcv(jpr_ocx1)%clgrid = 'U'        ! oce components given at U-point
719         srcv(jpr_ocy1)%clgrid = 'V'        !           and           V-point
720         ! Vectors: change of sign at north fold ONLY if on the local grid
721         srcv(jpr_ocx1:jpr_ocy1)%nsgn = -1.
722         ! Change first letter to couple with atmosphere if already coupled OPA
723         ! this is nedeed as each variable name used in the namcouple must be unique:
724         ! for example O_Runoff received by OPA from SAS and therefore O_Runoff received by SAS from the Atmosphere
725         DO jn = 1, jprcv
726            IF ( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname))
727         END DO
728         !
729         IF(lwp) THEN                        ! control print
730            WRITE(numout,*)
731            WRITE(numout,*)'               Special conditions for SAS-OPA coupling  '
732            WRITE(numout,*)'               SAS component  '
733            WRITE(numout,*)
734            IF( .NOT. ln_cpl ) THEN
735               WRITE(numout,*)'  received fields from OPA component '
736            ELSE
737               WRITE(numout,*)'  Additional received fields from OPA component : '
738            ENDIF
739            WRITE(numout,*)'               sea surface temperature (Celsius) '
740            WRITE(numout,*)'               sea surface salinity ' 
741            WRITE(numout,*)'               surface currents ' 
742            WRITE(numout,*)'               sea surface height ' 
743            WRITE(numout,*)'               thickness of first ocean T level '       
744            WRITE(numout,*)'               fraction of solar net radiation absorbed in the first ocean level'
745            WRITE(numout,*)
746         ENDIF
747      ENDIF
748     
749      ! =================================================== !
750      ! Allocate all parts of frcv used for received fields !
751      ! =================================================== !
752      DO jn = 1, jprcv
753         IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) )
754      END DO
755      ! Allocate taum part of frcv which is used even when not received as coupling field
756      IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) )
757      ! Allocate w10m part of frcv which is used even when not received as coupling field
758      IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) )
759      ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field
760      IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) )
761      IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) )
762      ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE.
763      IF( k_ice /= 0 ) THEN
764         IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) )
765         IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) )
766      END IF
767
768      ! ================================ !
769      !     Define the send interface    !
770      ! ================================ !
771      ! for each field: define the OASIS name                           (ssnd(:)%clname)
772      !                 define send or not from the namelist parameters (ssnd(:)%laction)
773      !                 define the north fold type of lbc               (ssnd(:)%nsgn)
774     
775      ! default definitions of nsnd
776      ssnd(:)%laction = .FALSE.   ;   ssnd(:)%clgrid = 'T'   ;   ssnd(:)%nsgn = 1.  ; ssnd(:)%nct = 1
777         
778      !                                                      ! ------------------------- !
779      !                                                      !    Surface temperature    !
780      !                                                      ! ------------------------- !
781      ssnd(jps_toce)%clname   = 'O_SSTSST'
782      ssnd(jps_tice)%clname   = 'O_TepIce'
783      ssnd(jps_ttilyr)%clname = 'O_TtiLyr'
784      ssnd(jps_tmix)%clname   = 'O_TepMix'
785      SELECT CASE( TRIM( sn_snd_temp%cldes ) )
786      CASE( 'none'                                 )       ! nothing to do
787      CASE( 'oce only'                             )   ;   ssnd( jps_toce )%laction = .TRUE.
788      CASE( 'oce and ice' , 'weighted oce and ice' , 'oce and weighted ice' )
789         ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE.
790         IF ( TRIM( sn_snd_temp%clcat ) == 'yes' )  ssnd(jps_tice)%nct = nn_cats_cpl
791      CASE( 'mixed oce-ice'                        )   ;   ssnd( jps_tmix )%laction = .TRUE.
792      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' )
793      END SELECT
794           
795      !                                                      ! ------------------------- !
796      !                                                      !          Albedo           !
797      !                                                      ! ------------------------- !
798      ssnd(jps_albice)%clname = 'O_AlbIce' 
799      ssnd(jps_albmix)%clname = 'O_AlbMix'
800      SELECT CASE( TRIM( sn_snd_alb%cldes ) )
801      CASE( 'none'                 )     ! nothing to do
802      CASE( 'ice' , 'weighted ice' )   ; ssnd(jps_albice)%laction = .TRUE.
803      CASE( 'mixed oce-ice'        )   ; ssnd(jps_albmix)%laction = .TRUE.
804      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_alb%cldes' )
805      END SELECT
806      !
807      ! Need to calculate oceanic albedo if
808      !     1. sending mixed oce-ice albedo or
809      !     2. receiving mixed oce-ice solar radiation
810      IF ( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN
811         CALL oce_alb( zaos, zacs )
812         ! Due to lack of information on nebulosity : mean clear/overcast sky
813         alb_oce_mix(:,:) = ( zacs(:,:) + zaos(:,:) ) * 0.5
814      ENDIF
815      !                                                      ! ------------------------- !
816      !                                                      !  Ice fraction & Thickness !
817      !                                                      ! ------------------------- !
818      ssnd(jps_fice)%clname  = 'OIceFrc'
819      ssnd(jps_ficet)%clname = 'OIceFrcT' 
820      ssnd(jps_hice)%clname  = 'OIceTck'
821      ssnd(jps_a_p)%clname   = 'OPndFrc'
822      ssnd(jps_ht_p)%clname  = 'OPndTck'
823      ssnd(jps_hsnw)%clname  = 'OSnwTck'
824      ssnd(jps_fice1)%clname = 'OIceFrd'
825      IF( k_ice /= 0 ) THEN
826         ssnd(jps_fice)%laction  = .TRUE.                 ! if ice treated in the ocean (even in climato case)
827         ssnd(jps_fice1)%laction = .TRUE.                 ! First-order regridded ice concentration, to be used producing atmos-to-ice fluxes (Met Office requirement)
828! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now
829         IF ( TRIM( sn_snd_thick%clcat  ) == 'yes' ) ssnd(jps_fice)%nct  = nn_cats_cpl
830         IF ( TRIM( sn_snd_thick1%clcat ) == 'yes' ) ssnd(jps_fice1)%nct = nn_cats_cpl
831      ENDIF
832     
833      IF (TRIM( sn_snd_ifrac%cldes )  == 'coupled') ssnd(jps_ficet)%laction = .TRUE. 
834
835      SELECT CASE ( TRIM( sn_snd_thick%cldes ) )
836      CASE( 'none'         )       ! nothing to do
837      CASE( 'ice and snow' ) 
838         ssnd(jps_hice:jps_hsnw)%laction = .TRUE.
839         IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN
840            ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl
841         ENDIF
842      CASE ( 'weighted ice and snow' ) 
843         ssnd(jps_hice:jps_hsnw)%laction = .TRUE.
844         IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl
845      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_thick%cldes' )
846      END SELECT
847
848      ! Initialise ice fractions from last coupling time to zero (needed by Met-Office)
849#if defined key_si3 || defined key_cice
850       a_i_last_couple(:,:,:) = 0._wp
851#endif
852      !                                                      ! ------------------------- !
853      !                                                      !      Ice Meltponds        !
854      !                                                      ! ------------------------- !
855      ! Needed by Met Office
856      ssnd(jps_a_p)%clname  = 'OPndFrc'   
857      ssnd(jps_ht_p)%clname = 'OPndTck'   
858      SELECT CASE ( TRIM( sn_snd_mpnd%cldes ) ) 
859      CASE ( 'none' ) 
860         ssnd(jps_a_p)%laction  = .FALSE. 
861         ssnd(jps_ht_p)%laction = .FALSE. 
862      CASE ( 'ice only' ) 
863         ssnd(jps_a_p)%laction  = .TRUE. 
864         ssnd(jps_ht_p)%laction = .TRUE. 
865         IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN
866            ssnd(jps_a_p)%nct  = nn_cats_cpl 
867            ssnd(jps_ht_p)%nct = nn_cats_cpl 
868         ELSE
869            IF ( nn_cats_cpl > 1 ) THEN
870               CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_mpnd%cldes if not exchanging category fields' ) 
871            ENDIF
872         ENDIF
873      CASE ( 'weighted ice' ) 
874         ssnd(jps_a_p)%laction  = .TRUE. 
875         ssnd(jps_ht_p)%laction = .TRUE. 
876         IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN
877            ssnd(jps_a_p)%nct  = nn_cats_cpl 
878            ssnd(jps_ht_p)%nct = nn_cats_cpl 
879         ENDIF
880      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_mpnd%cldes; '//sn_snd_mpnd%cldes ) 
881      END SELECT 
882 
883      !                                                      ! ------------------------- !
884      !                                                      !      Surface current      !
885      !                                                      ! ------------------------- !
886      !        ocean currents              !            ice velocities
887      ssnd(jps_ocx1)%clname = 'O_OCurx1'   ;   ssnd(jps_ivx1)%clname = 'O_IVelx1'
888      ssnd(jps_ocy1)%clname = 'O_OCury1'   ;   ssnd(jps_ivy1)%clname = 'O_IVely1'
889      ssnd(jps_ocz1)%clname = 'O_OCurz1'   ;   ssnd(jps_ivz1)%clname = 'O_IVelz1'
890      ssnd(jps_ocxw)%clname = 'O_OCurxw' 
891      ssnd(jps_ocyw)%clname = 'O_OCuryw' 
892      !
893      ssnd(jps_ocx1:jps_ivz1)%nsgn = -1.   ! vectors: change of the sign at the north fold
894
895      IF( sn_snd_crt%clvgrd == 'U,V' ) THEN
896         ssnd(jps_ocx1)%clgrid = 'U' ; ssnd(jps_ocy1)%clgrid = 'V'
897      ELSE IF( sn_snd_crt%clvgrd /= 'T' ) THEN 
898         CALL ctl_stop( 'sn_snd_crt%clvgrd must be equal to T' )
899      ENDIF
900      ssnd(jps_ocx1:jps_ivz1)%laction = .TRUE.   ! default: all are send
901      IF( TRIM( sn_snd_crt%clvref ) == 'spherical' )   ssnd( (/jps_ocz1, jps_ivz1/) )%laction = .FALSE. 
902      IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) ssnd(jps_ocx1:jps_ivz1)%nsgn = 1.
903      SELECT CASE( TRIM( sn_snd_crt%cldes ) )
904      CASE( 'none'                 )   ;   ssnd(jps_ocx1:jps_ivz1)%laction = .FALSE.
905      CASE( 'oce only'             )   ;   ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE.
906      CASE( 'weighted oce and ice' )   !   nothing to do
907      CASE( 'mixed oce-ice'        )   ;   ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE.
908      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_crt%cldes' )
909      END SELECT
910
911      ssnd(jps_ocxw:jps_ocyw)%nsgn = -1.   ! vectors: change of the sign at the north fold
912       
913      IF( sn_snd_crtw%clvgrd == 'U,V' ) THEN
914         ssnd(jps_ocxw)%clgrid = 'U' ; ssnd(jps_ocyw)%clgrid = 'V' 
915      ELSE IF( sn_snd_crtw%clvgrd /= 'T' ) THEN
916         CALL ctl_stop( 'sn_snd_crtw%clvgrd must be equal to T' ) 
917      ENDIF
918      IF( TRIM( sn_snd_crtw%clvor ) == 'eastward-northward' ) ssnd(jps_ocxw:jps_ocyw)%nsgn = 1. 
919      SELECT CASE( TRIM( sn_snd_crtw%cldes ) ) 
920         CASE( 'none'                 )   ; ssnd(jps_ocxw:jps_ocyw)%laction = .FALSE. 
921         CASE( 'oce only'             )   ; ssnd(jps_ocxw:jps_ocyw)%laction = .TRUE. 
922         CASE( 'weighted oce and ice' )   !   nothing to do
923         CASE( 'mixed oce-ice'        )   ; ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE. 
924         CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_crtw%cldes' ) 
925      END SELECT 
926
927      !                                                      ! ------------------------- !
928      !                                                      !          CO2 flux         !
929      !                                                      ! ------------------------- !
930      ssnd(jps_co2)%clname = 'O_CO2FLX' ;  IF( TRIM(sn_snd_co2%cldes) == 'coupled' )    ssnd(jps_co2 )%laction = .TRUE.
931      !
932      !                                                      ! ------------------------- !
933      !                                                      ! Sea surface freezing temp !
934      !                                                      ! ------------------------- !
935      ! needed by Met Office
936      ssnd(jps_sstfrz)%clname = 'O_SSTFrz' ; IF( TRIM(sn_snd_sstfrz%cldes) == 'coupled' )  ssnd(jps_sstfrz)%laction = .TRUE. 
937      !
938      !                                                      ! ------------------------- !
939      !                                                      !    Ice conductivity       !
940      !                                                      ! ------------------------- !
941      ! needed by Met Office
942      ! Note that ultimately we will move to passing an ocean effective conductivity as well so there
943      ! will be some changes to the parts of the code which currently relate only to ice conductivity
944      ssnd(jps_ttilyr )%clname = 'O_TtiLyr' 
945      SELECT CASE ( TRIM( sn_snd_ttilyr%cldes ) ) 
946      CASE ( 'none' ) 
947         ssnd(jps_ttilyr)%laction = .FALSE. 
948      CASE ( 'ice only' ) 
949         ssnd(jps_ttilyr)%laction = .TRUE. 
950         IF ( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) THEN
951            ssnd(jps_ttilyr)%nct = nn_cats_cpl 
952         ELSE
953            IF ( nn_cats_cpl > 1 ) THEN
954               CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_ttilyr%cldes if not exchanging category fields' ) 
955            ENDIF
956         ENDIF
957      CASE ( 'weighted ice' ) 
958         ssnd(jps_ttilyr)%laction = .TRUE. 
959         IF ( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) ssnd(jps_ttilyr)%nct = nn_cats_cpl 
960      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_ttilyr%cldes;'//sn_snd_ttilyr%cldes ) 
961      END SELECT
962
963      ssnd(jps_kice )%clname = 'OIceKn' 
964      SELECT CASE ( TRIM( sn_snd_cond%cldes ) ) 
965      CASE ( 'none' ) 
966         ssnd(jps_kice)%laction = .FALSE. 
967      CASE ( 'ice only' ) 
968         ssnd(jps_kice)%laction = .TRUE. 
969         IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN
970            ssnd(jps_kice)%nct = nn_cats_cpl 
971         ELSE
972            IF ( nn_cats_cpl > 1 ) THEN
973               CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_cond%cldes if not exchanging category fields' ) 
974            ENDIF
975         ENDIF
976      CASE ( 'weighted ice' ) 
977         ssnd(jps_kice)%laction = .TRUE. 
978         IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = nn_cats_cpl 
979      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_cond%cldes;'//sn_snd_cond%cldes ) 
980      END SELECT 
981      !
982      !                                                      ! ------------------------- !
983      !                                                      !     Sea surface height    !
984      !                                                      ! ------------------------- !
985      ssnd(jps_wlev)%clname = 'O_Wlevel' ;  IF( TRIM(sn_snd_wlev%cldes) == 'coupled' )   ssnd(jps_wlev)%laction = .TRUE. 
986
987      !                                                      ! ------------------------------- !
988      !                                                      !   OPA-SAS coupling - snd by opa !   
989      !                                                      ! ------------------------------- !
990      ssnd(jps_ssh   )%clname = 'O_SSHght' 
991      ssnd(jps_soce  )%clname = 'O_SSSal' 
992      ssnd(jps_e3t1st)%clname = 'O_E3T1st'   
993      ssnd(jps_fraqsr)%clname = 'O_FraQsr'
994      !
995      IF( nn_components == jp_iam_opa ) THEN
996         ssnd(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling
997         ssnd( (/jps_toce, jps_soce, jps_ssh, jps_fraqsr, jps_ocx1, jps_ocy1/) )%laction = .TRUE.
998         ssnd( jps_e3t1st )%laction = .NOT.ln_linssh
999         ! vector definition: not used but cleaner...
1000         ssnd(jps_ocx1)%clgrid  = 'U'        ! oce components given at U-point
1001         ssnd(jps_ocy1)%clgrid  = 'V'        !           and           V-point
1002         sn_snd_crt%clvgrd = 'U,V'
1003         sn_snd_crt%clvor = 'local grid'
1004         sn_snd_crt%clvref = 'spherical'
1005         !
1006         IF(lwp) THEN                        ! control print
1007            WRITE(numout,*)
1008            WRITE(numout,*)'  sent fields to SAS component '
1009            WRITE(numout,*)'               sea surface temperature (T before, Celsius) '
1010            WRITE(numout,*)'               sea surface salinity ' 
1011            WRITE(numout,*)'               surface currents U,V on local grid and spherical coordinates' 
1012            WRITE(numout,*)'               sea surface height ' 
1013            WRITE(numout,*)'               thickness of first ocean T level '       
1014            WRITE(numout,*)'               fraction of solar net radiation absorbed in the first ocean level'
1015            WRITE(numout,*)
1016         ENDIF
1017      ENDIF
1018      !                                                      ! ------------------------------- !
1019      !                                                      !   OPA-SAS coupling - snd by sas !   
1020      !                                                      ! ------------------------------- !
1021      ssnd(jps_sflx  )%clname = 'I_SFLX'     
1022      ssnd(jps_fice2 )%clname = 'IIceFrc'
1023      ssnd(jps_qsroce)%clname = 'I_QsrOce'   
1024      ssnd(jps_qnsoce)%clname = 'I_QnsOce'   
1025      ssnd(jps_oemp  )%clname = 'IOEvaMPr' 
1026      ssnd(jps_otx1  )%clname = 'I_OTaux1'   
1027      ssnd(jps_oty1  )%clname = 'I_OTauy1'   
1028      ssnd(jps_rnf   )%clname = 'I_Runoff'   
1029      ssnd(jps_taum  )%clname = 'I_TauMod'   
1030      !
1031      IF( nn_components == jp_iam_sas ) THEN
1032         IF( .NOT. ln_cpl ) ssnd(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling
1033         ssnd( (/jps_qsroce, jps_qnsoce, jps_oemp, jps_fice2, jps_sflx, jps_otx1, jps_oty1, jps_taum/) )%laction = .TRUE.
1034         !
1035         ! Change first letter to couple with atmosphere if already coupled with sea_ice
1036         ! this is nedeed as each variable name used in the namcouple must be unique:
1037         ! for example O_SSTSST sent by OPA to SAS and therefore S_SSTSST sent by SAS to the Atmosphere
1038         DO jn = 1, jpsnd
1039            IF ( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname))
1040         END DO
1041         !
1042         IF(lwp) THEN                        ! control print
1043            WRITE(numout,*)
1044            IF( .NOT. ln_cpl ) THEN
1045               WRITE(numout,*)'  sent fields to OPA component '
1046            ELSE
1047               WRITE(numout,*)'  Additional sent fields to OPA component : '
1048            ENDIF
1049            WRITE(numout,*)'                  ice cover '
1050            WRITE(numout,*)'                  oce only EMP  '
1051            WRITE(numout,*)'                  salt flux  '
1052            WRITE(numout,*)'                  mixed oce-ice solar flux  '
1053            WRITE(numout,*)'                  mixed oce-ice non solar flux  '
1054            WRITE(numout,*)'                  wind stress U,V components'
1055            WRITE(numout,*)'                  wind stress module'
1056         ENDIF
1057      ENDIF
1058
1059      !
1060      ! ================================ !
1061      !   initialisation of the coupler  !
1062      ! ================================ !
1063
1064      CALL cpl_define(jprcv, jpsnd, nn_cplmodel)
1065     
1066      IF (ln_usecplmask) THEN
1067         xcplmask(:,:,:) = 0.
1068         CALL iom_open( 'cplmask', inum )
1069         CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(1:nlci,1:nlcj,1:nn_cplmodel),   &
1070            &          kstart = (/ mig(1),mjg(1),1 /), kcount = (/ nlci,nlcj,nn_cplmodel /) )
1071         CALL iom_close( inum )
1072      ELSE
1073         xcplmask(:,:,:) = 1.
1074      ENDIF
1075      xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 )
1076      !
1077   END SUBROUTINE sbc_cpl_init
1078
1079
1080   SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice )     
1081      !!----------------------------------------------------------------------
1082      !!             ***  ROUTINE sbc_cpl_rcv  ***
1083      !!
1084      !! ** Purpose :   provide the stress over the ocean and, if no sea-ice,
1085      !!                provide the ocean heat and freshwater fluxes.
1086      !!
1087      !! ** Method  : - Receive all the atmospheric fields (stored in frcv array). called at each time step.
1088      !!                OASIS controls if there is something do receive or not. nrcvinfo contains the info
1089      !!                to know if the field was really received or not
1090      !!
1091      !!              --> If ocean stress was really received:
1092      !!
1093      !!                  - transform the received ocean stress vector from the received
1094      !!                 referential and grid into an atmosphere-ocean stress in
1095      !!                 the (i,j) ocean referencial and at the ocean velocity point.
1096      !!                    The received stress are :
1097      !!                     - defined by 3 components (if cartesian coordinate)
1098      !!                            or by 2 components (if spherical)
1099      !!                     - oriented along geographical   coordinate (if eastward-northward)
1100      !!                            or  along the local grid coordinate (if local grid)
1101      !!                     - given at U- and V-point, resp.   if received on 2 grids
1102      !!                            or at T-point               if received on 1 grid
1103      !!                    Therefore and if necessary, they are successively
1104      !!                  processed in order to obtain them
1105      !!                     first  as  2 components on the sphere
1106      !!                     second as  2 components oriented along the local grid
1107      !!                     third  as  2 components on the U,V grid
1108      !!
1109      !!              -->
1110      !!
1111      !!              - In 'ocean only' case, non solar and solar ocean heat fluxes
1112      !!             and total ocean freshwater fluxes 
1113      !!
1114      !! ** Method  :   receive all fields from the atmosphere and transform
1115      !!              them into ocean surface boundary condition fields
1116      !!
1117      !! ** Action  :   update  utau, vtau   ocean stress at U,V grid
1118      !!                        taum         wind stress module at T-point
1119      !!                        wndm         wind speed  module at T-point over free ocean or leads in presence of sea-ice
1120      !!                        qns          non solar heat fluxes including emp heat content    (ocean only case)
1121      !!                                     and the latent heat flux of solid precip. melting
1122      !!                        qsr          solar ocean heat fluxes   (ocean only case)
1123      !!                        emp          upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case)
1124      !!----------------------------------------------------------------------
1125      USE zdf_oce,  ONLY :   ln_zdfswm
1126      !
1127      INTEGER, INTENT(in) ::   kt          ! ocean model time step index
1128      INTEGER, INTENT(in) ::   k_fsbc      ! frequency of sbc (-> ice model) computation
1129      INTEGER, INTENT(in) ::   k_ice       ! ice management in the sbc (=0/1/2/3)
1130      !!
1131      LOGICAL  ::   llnewtx, llnewtau      ! update wind stress components and module??
1132      INTEGER  ::   ji, jj, jn             ! dummy loop indices
1133      INTEGER  ::   isec                   ! number of seconds since nit000 (assuming rdt did not change since nit000)
1134      REAL(wp) ::   zcumulneg, zcumulpos   ! temporary scalars     
1135      REAL(wp) ::   zcoef                  ! temporary scalar
1136      REAL(wp) ::   zrhoa  = 1.22          ! Air density kg/m3
1137      REAL(wp) ::   zcdrag = 1.5e-3        ! drag coefficient
1138      REAL(wp) ::   zzx, zzy               ! temporary variables
1139      REAL(wp), DIMENSION(jpi,jpj) ::   ztx, zty, zmsk, zemp, zqns, zqsr, zcloud_fra
1140      !!----------------------------------------------------------------------
1141      !
1142      IF( kt == nit000 ) THEN
1143      !   cannot be done in the init phase when we use agrif as cpl_freq requires that oasis_enddef is done
1144         ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'I_QsrOce' ) + cpl_freq( 'I_QsrMix' )
1145         IF( ln_dm2dc .AND. ncpl_qsr_freq /= 86400 )   &
1146            &   CALL ctl_stop( 'sbc_cpl_rcv: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' )
1147         ncpl_qsr_freq = 86400 / ncpl_qsr_freq   ! used by top
1148      ENDIF
1149      !
1150      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0)
1151      !
1152      !                                                      ! ======================================================= !
1153      !                                                      ! Receive all the atmos. fields (including ice information)
1154      !                                                      ! ======================================================= !
1155      isec = ( kt - nit000 ) * NINT( rdt )                      ! date of exchanges
1156      DO jn = 1, jprcv                                          ! received fields sent by the atmosphere
1157         IF( srcv(jn)%laction )   CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) )
1158      END DO
1159
1160      !                                                      ! ========================= !
1161      IF( srcv(jpr_otx1)%laction ) THEN                      !  ocean stress components  !
1162         !                                                   ! ========================= !
1163         ! define frcv(jpr_otx1)%z3(:,:,1) and frcv(jpr_oty1)%z3(:,:,1): stress at U/V point along model grid
1164         ! => need to be done only when we receive the field
1165         IF(  nrcvinfo(jpr_otx1) == OASIS_Rcv ) THEN
1166            !
1167            IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN            ! 2 components on the sphere
1168               !                                                       ! (cartesian to spherical -> 3 to 2 components)
1169               !
1170               CALL geo2oce( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), frcv(jpr_otz1)%z3(:,:,1),   &
1171                  &          srcv(jpr_otx1)%clgrid, ztx, zty )
1172               frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 1st grid
1173               frcv(jpr_oty1)%z3(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 1st grid
1174               !
1175               IF( srcv(jpr_otx2)%laction ) THEN
1176                  CALL geo2oce( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), frcv(jpr_otz2)%z3(:,:,1),   &
1177                     &          srcv(jpr_otx2)%clgrid, ztx, zty )
1178                  frcv(jpr_otx2)%z3(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 2nd grid
1179                  frcv(jpr_oty2)%z3(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 2nd grid
1180               ENDIF
1181               !
1182            ENDIF
1183            !
1184            IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid
1185               !                                                       ! (geographical to local grid -> rotate the components)
1186               CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )   
1187               IF( srcv(jpr_otx2)%laction ) THEN
1188                  CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty )   
1189               ELSE
1190                  CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 
1191               ENDIF
1192               frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid
1193               frcv(jpr_oty1)%z3(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 2nd grid
1194            ENDIF
1195            !                             
1196            IF( srcv(jpr_otx1)%clgrid == 'T' ) THEN
1197               DO jj = 2, jpjm1                                          ! T ==> (U,V)
1198                  DO ji = fs_2, fs_jpim1   ! vector opt.
1199                     frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1) )
1200                     frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji  ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) )
1201                  END DO
1202               END DO
1203               CALL lbc_lnk_multi( 'sbccpl', frcv(jpr_otx1)%z3(:,:,1), 'U',  -1., frcv(jpr_oty1)%z3(:,:,1), 'V',  -1. )
1204            ENDIF
1205            llnewtx = .TRUE.
1206         ELSE
1207            llnewtx = .FALSE.
1208         ENDIF
1209         !                                                   ! ========================= !
1210      ELSE                                                   !   No dynamical coupling   !
1211         !                                                   ! ========================= !
1212         frcv(jpr_otx1)%z3(:,:,1) = 0.e0                               ! here simply set to zero
1213         frcv(jpr_oty1)%z3(:,:,1) = 0.e0                               ! an external read in a file can be added instead
1214         llnewtx = .TRUE.
1215         !
1216      ENDIF
1217      !                                                      ! ========================= !
1218      !                                                      !    wind stress module     !   (taum)
1219      !                                                      ! ========================= !
1220      IF( .NOT. srcv(jpr_taum)%laction ) THEN                    ! compute wind stress module from its components if not received
1221         ! => need to be done only when otx1 was changed
1222         IF( llnewtx ) THEN
1223            DO jj = 2, jpjm1
1224               DO ji = fs_2, fs_jpim1   ! vect. opt.
1225                  zzx = frcv(jpr_otx1)%z3(ji-1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1)
1226                  zzy = frcv(jpr_oty1)%z3(ji  ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1)
1227                  frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy )
1228               END DO
1229            END DO
1230            CALL lbc_lnk( 'sbccpl', frcv(jpr_taum)%z3(:,:,1), 'T', 1. )
1231            llnewtau = .TRUE.
1232         ELSE
1233            llnewtau = .FALSE.
1234         ENDIF
1235      ELSE
1236         llnewtau = nrcvinfo(jpr_taum) == OASIS_Rcv
1237         ! Stress module can be negative when received (interpolation problem)
1238         IF( llnewtau ) THEN
1239            frcv(jpr_taum)%z3(:,:,1) = MAX( 0._wp, frcv(jpr_taum)%z3(:,:,1) )
1240         ENDIF
1241      ENDIF
1242      !
1243      !                                                      ! ========================= !
1244      !                                                      !      10 m wind speed      !   (wndm)
1245      !                                                      ! ========================= !
1246      IF( .NOT. srcv(jpr_w10m)%laction ) THEN                    ! compute wind spreed from wind stress module if not received 
1247         ! => need to be done only when taumod was changed
1248         IF( llnewtau ) THEN
1249            zcoef = 1. / ( zrhoa * zcdrag ) 
1250            DO jj = 1, jpj
1251               DO ji = 1, jpi 
1252                  frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )
1253               END DO
1254            END DO
1255         ENDIF
1256      ENDIF
1257!!$      !                                                      ! ========================= !
1258!!$      SELECT CASE( TRIM( sn_rcv_clouds%cldes ) )             !       cloud fraction      !
1259!!$      !                                                      ! ========================= !
1260!!$      cloud_fra(:,:) = frcv(jpr_clfra)*z3(:,:,1)
1261!!$      END SELECT
1262!!$
1263      zcloud_fra(:,:) = pp_cldf   ! should be real cloud fraction instead (as in the bulk) but needs to be read from atm.
1264      IF( ln_mixcpl ) THEN
1265         cloud_fra(:,:) = cloud_fra(:,:) * xcplmask(:,:,0) + zcloud_fra(:,:)* zmsk(:,:)
1266      ELSE
1267         cloud_fra(:,:) = zcloud_fra(:,:)
1268      ENDIF
1269      !                                                      ! ========================= !
1270      ! u(v)tau and taum will be modified by ice model
1271      ! -> need to be reset before each call of the ice/fsbc     
1272      IF( MOD( kt-1, k_fsbc ) == 0 ) THEN
1273         !
1274         IF( ln_mixcpl ) THEN
1275            utau(:,:) = utau(:,:) * xcplmask(:,:,0) + frcv(jpr_otx1)%z3(:,:,1) * zmsk(:,:)
1276            vtau(:,:) = vtau(:,:) * xcplmask(:,:,0) + frcv(jpr_oty1)%z3(:,:,1) * zmsk(:,:)
1277            taum(:,:) = taum(:,:) * xcplmask(:,:,0) + frcv(jpr_taum)%z3(:,:,1) * zmsk(:,:)
1278            wndm(:,:) = wndm(:,:) * xcplmask(:,:,0) + frcv(jpr_w10m)%z3(:,:,1) * zmsk(:,:)
1279         ELSE
1280            utau(:,:) = frcv(jpr_otx1)%z3(:,:,1)
1281            vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1)
1282            taum(:,:) = frcv(jpr_taum)%z3(:,:,1)
1283            wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1)
1284         ENDIF
1285         CALL iom_put( "taum_oce", taum )   ! output wind stress module
1286         
1287      ENDIF
1288
1289      !                                                      ! ================== !
1290      !                                                      ! atmosph. CO2 (ppm) !
1291      !                                                      ! ================== !
1292      IF( srcv(jpr_co2)%laction )   atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1)
1293      !
1294      !                                                      ! ========================= !
1295      !                                                      ! Mean Sea Level Pressure   !   (taum)
1296      !                                                      ! ========================= !
1297      IF( srcv(jpr_mslp)%laction ) THEN                    ! UKMO SHELF effect of atmospheric pressure on SSH
1298          IF( kt /= nit000 )   ssh_ibb(:,:) = ssh_ib(:,:)    !* Swap of ssh_ib fields
1299
1300          r1_grau = 1.e0 / (grav * rau0)               !* constant for optimization
1301          ssh_ib(:,:) = - ( frcv(jpr_mslp)%z3(:,:,1) - rpref ) * r1_grau    ! equivalent ssh (inverse barometer)
1302          apr   (:,:) =     frcv(jpr_mslp)%z3(:,:,1)                         !atmospheric pressure
1303   
1304          IF( kt == nit000 ) ssh_ibb(:,:) = ssh_ib(:,:)  ! correct this later (read from restart if possible)
1305      END IF 
1306      !
1307      IF( ln_sdw ) THEN  ! Stokes Drift correction activated
1308      !                                                      ! ========================= !
1309      !                                                      !       Stokes drift u      !
1310      !                                                      ! ========================= !
1311         IF( srcv(jpr_sdrftx)%laction ) ut0sd(:,:) = frcv(jpr_sdrftx)%z3(:,:,1)
1312      !
1313      !                                                      ! ========================= !
1314      !                                                      !       Stokes drift v      !
1315      !                                                      ! ========================= !
1316         IF( srcv(jpr_sdrfty)%laction ) vt0sd(:,:) = frcv(jpr_sdrfty)%z3(:,:,1)
1317      !
1318      !                                                      ! ========================= !
1319      !                                                      !      Wave mean period     !
1320      !                                                      ! ========================= !
1321         IF( srcv(jpr_wper)%laction ) wmp(:,:) = frcv(jpr_wper)%z3(:,:,1)
1322      !
1323      !                                                      ! ========================= !
1324      !                                                      !  Significant wave height  !
1325      !                                                      ! ========================= !
1326         IF( srcv(jpr_hsig)%laction ) hsw(:,:) = frcv(jpr_hsig)%z3(:,:,1)
1327      !
1328      !                                                      ! ========================= ! 
1329      !                                                      !    Wave peak frequency    !
1330      !                                                      ! ========================= ! 
1331         IF( srcv(jpr_wfreq)%laction ) wfreq(:,:) = frcv(jpr_wfreq)%z3(:,:,1)
1332      !
1333      !                                                      ! ========================= !
1334      !                                                      !    Vertical mixing Qiao   !
1335      !                                                      ! ========================= !
1336         IF( srcv(jpr_wnum)%laction .AND. ln_zdfswm ) wnum(:,:) = frcv(jpr_wnum)%z3(:,:,1)
1337
1338         ! Calculate the 3D Stokes drift both in coupled and not fully uncoupled mode
1339         IF( srcv(jpr_sdrftx)%laction .OR. srcv(jpr_sdrfty)%laction .OR. srcv(jpr_wper)%laction &
1340                                      .OR. srcv(jpr_hsig)%laction   .OR. srcv(jpr_wfreq)%laction) THEN
1341            CALL sbc_stokes()
1342         ENDIF
1343      ENDIF
1344      !                                                      ! ========================= !
1345      !                                                      ! Stress adsorbed by waves  !
1346      !                                                      ! ========================= !
1347      IF( srcv(jpr_tauwoc)%laction .AND. ln_tauwoc ) tauoc_wave(:,:) = frcv(jpr_tauwoc)%z3(:,:,1)
1348
1349      !                                                      ! ========================= ! 
1350      !                                                      ! Stress component by waves !
1351      !                                                      ! ========================= ! 
1352      IF( srcv(jpr_tauwx)%laction .AND. srcv(jpr_tauwy)%laction .AND. ln_tauw ) THEN
1353         tauw_x(:,:) = frcv(jpr_tauwx)%z3(:,:,1)
1354         tauw_y(:,:) = frcv(jpr_tauwy)%z3(:,:,1)
1355      ENDIF
1356
1357      !                                                      ! ========================= !
1358      !                                                      !   Wave drag coefficient   !
1359      !                                                      ! ========================= !
1360      IF( srcv(jpr_wdrag)%laction .AND. ln_cdgw )   cdn_wave(:,:) = frcv(jpr_wdrag)%z3(:,:,1)
1361
1362      !  Fields received by SAS when OASIS coupling
1363      !  (arrays no more filled at sbcssm stage)
1364      !                                                      ! ================== !
1365      !                                                      !        SSS         !
1366      !                                                      ! ================== !
1367      IF( srcv(jpr_soce)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling
1368         sss_m(:,:) = frcv(jpr_soce)%z3(:,:,1)
1369         CALL iom_put( 'sss_m', sss_m )
1370      ENDIF
1371      !                                               
1372      !                                                      ! ================== !
1373      !                                                      !        SST         !
1374      !                                                      ! ================== !
1375      IF( srcv(jpr_toce)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling
1376         sst_m(:,:) = frcv(jpr_toce)%z3(:,:,1)
1377         IF( srcv(jpr_soce)%laction .AND. l_useCT ) THEN    ! make sure that sst_m is the potential temperature
1378            sst_m(:,:) = eos_pt_from_ct( sst_m(:,:), sss_m(:,:) )
1379         ENDIF
1380      ENDIF
1381      !                                                      ! ================== !
1382      !                                                      !        SSH         !
1383      !                                                      ! ================== !
1384      IF( srcv(jpr_ssh )%laction ) THEN                      ! received by sas in case of opa <-> sas coupling
1385         ssh_m(:,:) = frcv(jpr_ssh )%z3(:,:,1)
1386         CALL iom_put( 'ssh_m', ssh_m )
1387      ENDIF
1388      !                                                      ! ================== !
1389      !                                                      !  surface currents  !
1390      !                                                      ! ================== !
1391      IF( srcv(jpr_ocx1)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling
1392         ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1)
1393         ub (:,:,1) = ssu_m(:,:)                             ! will be used in icestp in the call of ice_forcing_tau
1394         un (:,:,1) = ssu_m(:,:)                             ! will be used in sbc_cpl_snd if atmosphere coupling
1395         CALL iom_put( 'ssu_m', ssu_m )
1396      ENDIF
1397      IF( srcv(jpr_ocy1)%laction ) THEN
1398         ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1)
1399         vb (:,:,1) = ssv_m(:,:)                             ! will be used in icestp in the call of ice_forcing_tau
1400         vn (:,:,1) = ssv_m(:,:)                             ! will be used in sbc_cpl_snd if atmosphere coupling
1401         CALL iom_put( 'ssv_m', ssv_m )
1402      ENDIF
1403      !                                                      ! ======================== !
1404      !                                                      !  first T level thickness !
1405      !                                                      ! ======================== !
1406      IF( srcv(jpr_e3t1st )%laction ) THEN                   ! received by sas in case of opa <-> sas coupling
1407         e3t_m(:,:) = frcv(jpr_e3t1st )%z3(:,:,1)
1408         CALL iom_put( 'e3t_m', e3t_m(:,:) )
1409      ENDIF
1410      !                                                      ! ================================ !
1411      !                                                      !  fraction of solar net radiation !
1412      !                                                      ! ================================ !
1413      IF( srcv(jpr_fraqsr)%laction ) THEN                    ! received by sas in case of opa <-> sas coupling
1414         frq_m(:,:) = frcv(jpr_fraqsr)%z3(:,:,1)
1415         CALL iom_put( 'frq_m', frq_m )
1416      ENDIF
1417     
1418      !                                                      ! ========================= !
1419      IF( k_ice <= 1 .AND. MOD( kt-1, k_fsbc ) == 0 ) THEN   !  heat & freshwater fluxes ! (Ocean only case)
1420         !                                                   ! ========================= !
1421         !
1422         !                                                       ! total freshwater fluxes over the ocean (emp)
1423         IF( srcv(jpr_oemp)%laction .OR. srcv(jpr_rain)%laction ) THEN
1424            SELECT CASE( TRIM( sn_rcv_emp%cldes ) )                                    ! evaporation - precipitation
1425            CASE( 'conservative' )
1426               zemp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) )
1427            CASE( 'oce only', 'oce and ice' )
1428               zemp(:,:) = frcv(jpr_oemp)%z3(:,:,1)
1429            CASE default
1430               CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' )
1431            END SELECT
1432         ELSE
1433            zemp(:,:) = 0._wp
1434         ENDIF
1435         !
1436         !                                                        ! runoffs and calving (added in emp)
1437         IF( srcv(jpr_rnf)%laction )     rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
1438         IF( srcv(jpr_cal)%laction )     zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1)
1439 
1440         IF( srcv(jpr_icb)%laction )  THEN
1441             fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1)
1442             rnf(:,:)    = rnf(:,:) + fwficb(:,:)   ! iceberg added to runfofs
1443         ENDIF
1444         IF( srcv(jpr_isf)%laction )  fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1)  ! fresh water flux from the isf (fwfisf <0 mean melting) 
1445       
1446         IF( ln_mixcpl ) THEN   ;   emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:)
1447         ELSE                   ;   emp(:,:) =                              zemp(:,:)
1448         ENDIF
1449         !
1450         !                                                       ! non solar heat flux over the ocean (qns)
1451         IF(      srcv(jpr_qnsoce)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)
1452         ELSE IF( srcv(jpr_qnsmix)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
1453         ELSE                                       ;   zqns(:,:) = 0._wp
1454         END IF
1455         ! update qns over the free ocean with:
1456         IF( nn_components /= jp_iam_opa ) THEN
1457            zqns(:,:) =  zqns(:,:) - zemp(:,:) * sst_m(:,:) * rcp         ! remove heat content due to mass flux (assumed to be at SST)
1458            IF( srcv(jpr_snow  )%laction ) THEN
1459               zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * rLfus   ! energy for melting solid precipitation over the free ocean
1460            ENDIF
1461         ENDIF
1462         !
1463         IF( srcv(jpr_icb)%laction )  zqns(:,:) = zqns(:,:) - frcv(jpr_icb)%z3(:,:,1) * rLfus ! remove heat content associated to iceberg melting
1464         !
1465         IF( ln_mixcpl ) THEN   ;   qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:)
1466         ELSE                   ;   qns(:,:) =                              zqns(:,:)
1467         ENDIF
1468
1469         !                                                       ! solar flux over the ocean          (qsr)
1470         IF     ( srcv(jpr_qsroce)%laction ) THEN   ;   zqsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1)
1471         ELSE IF( srcv(jpr_qsrmix)%laction ) then   ;   zqsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1)
1472         ELSE                                       ;   zqsr(:,:) = 0._wp
1473         ENDIF
1474         IF( ln_dm2dc .AND. ln_cpl )   zqsr(:,:) = sbc_dcy( zqsr )   ! modify qsr to include the diurnal cycle
1475         IF( ln_mixcpl ) THEN   ;   qsr(:,:) = qsr(:,:) * xcplmask(:,:,0) + zqsr(:,:) * zmsk(:,:)
1476         ELSE                   ;   qsr(:,:) =                              zqsr(:,:)
1477         ENDIF
1478         !
1479         ! salt flux over the ocean (received by opa in case of opa <-> sas coupling)
1480         IF( srcv(jpr_sflx )%laction )   sfx(:,:) = frcv(jpr_sflx  )%z3(:,:,1)
1481         ! Ice cover  (received by opa in case of opa <-> sas coupling)
1482         IF( srcv(jpr_fice )%laction )   fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1)
1483         !
1484      ENDIF
1485      !
1486   END SUBROUTINE sbc_cpl_rcv
1487   
1488
1489   SUBROUTINE sbc_cpl_ice_tau( p_taui, p_tauj )     
1490      !!----------------------------------------------------------------------
1491      !!             ***  ROUTINE sbc_cpl_ice_tau  ***
1492      !!
1493      !! ** Purpose :   provide the stress over sea-ice in coupled mode
1494      !!
1495      !! ** Method  :   transform the received stress from the atmosphere into
1496      !!             an atmosphere-ice stress in the (i,j) ocean referencial
1497      !!             and at the velocity point of the sea-ice model:
1498      !!                'C'-grid : i- (j-) components given at U- (V-) point
1499      !!
1500      !!                The received stress are :
1501      !!                 - defined by 3 components (if cartesian coordinate)
1502      !!                        or by 2 components (if spherical)
1503      !!                 - oriented along geographical   coordinate (if eastward-northward)
1504      !!                        or  along the local grid coordinate (if local grid)
1505      !!                 - given at U- and V-point, resp.   if received on 2 grids
1506      !!                        or at a same point (T or I) if received on 1 grid
1507      !!                Therefore and if necessary, they are successively
1508      !!             processed in order to obtain them
1509      !!                 first  as  2 components on the sphere
1510      !!                 second as  2 components oriented along the local grid
1511      !!                 third  as  2 components on the ice grid point
1512      !!
1513      !!                Except in 'oce and ice' case, only one vector stress field
1514      !!             is received. It has already been processed in sbc_cpl_rcv
1515      !!             so that it is now defined as (i,j) components given at U-
1516      !!             and V-points, respectively. 
1517      !!
1518      !! ** Action  :   return ptau_i, ptau_j, the stress over the ice
1519      !!----------------------------------------------------------------------
1520      REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_taui   ! i- & j-components of atmos-ice stress [N/m2]
1521      REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_tauj   ! at I-point (B-grid) or U & V-point (C-grid)
1522      !!
1523      INTEGER ::   ji, jj   ! dummy loop indices
1524      INTEGER ::   itx      ! index of taux over ice
1525      REAL(wp)                     ::   zztmp1, zztmp2
1526      REAL(wp), DIMENSION(jpi,jpj) ::   ztx, zty 
1527      !!----------------------------------------------------------------------
1528      !
1529      IF( srcv(jpr_itx1)%laction ) THEN   ;   itx =  jpr_itx1   
1530      ELSE                                ;   itx =  jpr_otx1
1531      ENDIF
1532
1533      ! do something only if we just received the stress from atmosphere
1534      IF(  nrcvinfo(itx) == OASIS_Rcv ) THEN
1535         !                                                      ! ======================= !
1536         IF( srcv(jpr_itx1)%laction ) THEN                      !   ice stress received   !
1537            !                                                   ! ======================= !
1538           
1539            IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN            ! 2 components on the sphere
1540               !                                                       ! (cartesian to spherical -> 3 to 2 components)
1541               CALL geo2oce(  frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), frcv(jpr_itz1)%z3(:,:,1),   &
1542                  &          srcv(jpr_itx1)%clgrid, ztx, zty )
1543               frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 1st grid
1544               frcv(jpr_ity1)%z3(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 1st grid
1545               !
1546               IF( srcv(jpr_itx2)%laction ) THEN
1547                  CALL geo2oce( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), frcv(jpr_itz2)%z3(:,:,1),   &
1548                     &          srcv(jpr_itx2)%clgrid, ztx, zty )
1549                  frcv(jpr_itx2)%z3(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 2nd grid
1550                  frcv(jpr_ity2)%z3(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 2nd grid
1551               ENDIF
1552               !
1553            ENDIF
1554            !
1555            IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid
1556               !                                                       ! (geographical to local grid -> rotate the components)
1557               CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->i', ztx )   
1558               IF( srcv(jpr_itx2)%laction ) THEN
1559                  CALL rot_rep( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), srcv(jpr_itx2)%clgrid, 'en->j', zty )   
1560               ELSE
1561                  CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->j', zty ) 
1562               ENDIF
1563               frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid
1564               frcv(jpr_ity1)%z3(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 1st grid
1565            ENDIF
1566            !                                                   ! ======================= !
1567         ELSE                                                   !     use ocean stress    !
1568            !                                                   ! ======================= !
1569            frcv(jpr_itx1)%z3(:,:,1) = frcv(jpr_otx1)%z3(:,:,1)
1570            frcv(jpr_ity1)%z3(:,:,1) = frcv(jpr_oty1)%z3(:,:,1)
1571            !
1572         ENDIF
1573         !                                                      ! ======================= !
1574         !                                                      !     put on ice grid     !
1575         !                                                      ! ======================= !
1576         !   
1577         !                                                  j+1   j     -----V---F
1578         ! ice stress on ice velocity point                              !       |
1579         ! (C-grid ==>(U,V))                                      j      |   T   U
1580         !                                                               |       |
1581         !                                                   j    j-1   -I-------|
1582         !                                               (for I)         |       |
1583         !                                                              i-1  i   i
1584         !                                                               i      i+1 (for I)
1585         SELECT CASE ( srcv(jpr_itx1)%clgrid )
1586         CASE( 'U' )
1587            p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1)                   ! (U,V) ==> (U,V)
1588            p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)
1589         CASE( 'T' )
1590            DO jj = 2, jpjm1                                   ! T ==> (U,V)
1591               DO ji = fs_2, fs_jpim1   ! vector opt.
1592                  ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and  rheology
1593                  zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj  ,1) )
1594                  zztmp2 = 0.5_wp * ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji  ,jj+1,1) )
1595                  p_taui(ji,jj) = zztmp1 * ( frcv(jpr_itx1)%z3(ji+1,jj  ,1) + frcv(jpr_itx1)%z3(ji,jj,1) )
1596                  p_tauj(ji,jj) = zztmp2 * ( frcv(jpr_ity1)%z3(ji  ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) )
1597               END DO
1598            END DO
1599            CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U',  -1., p_tauj, 'V',  -1. )
1600         END SELECT
1601         
1602      ENDIF
1603      !
1604   END SUBROUTINE sbc_cpl_ice_tau
1605   
1606
1607   SUBROUTINE sbc_cpl_ice_flx( picefr, palbi, psst, pist, phs, phi )
1608      !!----------------------------------------------------------------------
1609      !!             ***  ROUTINE sbc_cpl_ice_flx  ***
1610      !!
1611      !! ** Purpose :   provide the heat and freshwater fluxes of the ocean-ice system
1612      !!
1613      !! ** Method  :   transform the fields received from the atmosphere into
1614      !!             surface heat and fresh water boundary condition for the
1615      !!             ice-ocean system. The following fields are provided:
1616      !!               * total non solar, solar and freshwater fluxes (qns_tot,
1617      !!             qsr_tot and emp_tot) (total means weighted ice-ocean flux)
1618      !!             NB: emp_tot include runoffs and calving.
1619      !!               * fluxes over ice (qns_ice, qsr_ice, emp_ice) where
1620      !!             emp_ice = sublimation - solid precipitation as liquid
1621      !!             precipitation are re-routed directly to the ocean and
1622      !!             calving directly enter the ocean (runoffs are read but included in trasbc.F90)
1623      !!               * solid precipitation (sprecip), used to add to qns_tot
1624      !!             the heat lost associated to melting solid precipitation
1625      !!             over the ocean fraction.
1626      !!               * heat content of rain, snow and evap can also be provided,
1627      !!             otherwise heat flux associated with these mass flux are
1628      !!             guessed (qemp_oce, qemp_ice)
1629      !!
1630      !!             - the fluxes have been separated from the stress as
1631      !!               (a) they are updated at each ice time step compare to
1632      !!               an update at each coupled time step for the stress, and
1633      !!               (b) the conservative computation of the fluxes over the
1634      !!               sea-ice area requires the knowledge of the ice fraction
1635      !!               after the ice advection and before the ice thermodynamics,
1636      !!               so that the stress is updated before the ice dynamics
1637      !!               while the fluxes are updated after it.
1638      !!
1639      !! ** Details
1640      !!             qns_tot = (1-a) * qns_oce + a * qns_ice               => provided
1641      !!                     + qemp_oce + qemp_ice                         => recalculated and added up to qns
1642      !!
1643      !!             qsr_tot = (1-a) * qsr_oce + a * qsr_ice               => provided
1644      !!
1645      !!             emp_tot = emp_oce + emp_ice                           => calving is provided and added to emp_tot (and emp_oce).
1646      !!                                                                      runoff (which includes rivers+icebergs) and iceshelf
1647      !!                                                                      are provided but not included in emp here. Only runoff will
1648      !!                                                                      be included in emp in other parts of NEMO code
1649      !! ** Action  :   update at each nf_ice time step:
1650      !!                   qns_tot, qsr_tot  non-solar and solar total heat fluxes
1651      !!                   qns_ice, qsr_ice  non-solar and solar heat fluxes over the ice
1652      !!                   emp_tot           total evaporation - precipitation(liquid and solid) (-calving)
1653      !!                   emp_ice           ice sublimation - solid precipitation over the ice
1654      !!                   dqns_ice          d(non-solar heat flux)/d(Temperature) over the ice
1655      !!                   sprecip           solid precipitation over the ocean 
1656      !!----------------------------------------------------------------------
1657      REAL(wp), INTENT(in)   , DIMENSION(:,:)             ::   picefr     ! ice fraction                [0 to 1]
1658      !                                                   !!           ! optional arguments, used only in 'mixed oce-ice' case or for Met-Office coupling
1659      REAL(wp), INTENT(in)   , DIMENSION(:,:,:), OPTIONAL ::   palbi      ! all skies ice albedo
1660      REAL(wp), INTENT(in)   , DIMENSION(:,:  ), OPTIONAL ::   psst       ! sea surface temperature     [Celsius]
1661      REAL(wp), INTENT(inout), DIMENSION(:,:,:), OPTIONAL ::   pist       ! ice surface temperature     [Kelvin] => inout for Met-Office
1662      REAL(wp), INTENT(in)   , DIMENSION(:,:,:), OPTIONAL ::   phs        ! snow depth                  [m]
1663      REAL(wp), INTENT(in)   , DIMENSION(:,:,:), OPTIONAL ::   phi        ! ice thickness               [m]
1664      !
1665      INTEGER  ::   ji, jj, jl   ! dummy loop index
1666      REAL(wp), DIMENSION(jpi,jpj)     ::   zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw
1667      REAL(wp), DIMENSION(jpi,jpj)     ::   zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip  , zevap_oce, zdevap_ice
1668      REAL(wp), DIMENSION(jpi,jpj)     ::   zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice
1669      REAL(wp), DIMENSION(jpi,jpj)     ::   zevap_ice_total
1670      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice, zqtr_ice_top, ztsu
1671      REAL(wp), DIMENSION(jpi,jpj)     ::   ztri
1672      !!----------------------------------------------------------------------
1673      !
1674      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0)
1675      ziceld(:,:) = 1._wp - picefr(:,:)
1676      zcptn (:,:) = rcp * sst_m(:,:)
1677      !
1678      !                                                      ! ========================= !
1679      !                                                      !    freshwater budget      !   (emp_tot)
1680      !                                                      ! ========================= !
1681      !
1682      !                                                           ! solid Precipitation                                (sprecip)
1683      !                                                           ! liquid + solid Precipitation                       (tprecip)
1684      !                                                           ! total Evaporation - total Precipitation            (emp_tot)
1685      !                                                           ! sublimation - solid precipitation (cell average)   (emp_ice)
1686      SELECT CASE( TRIM( sn_rcv_emp%cldes ) )
1687      CASE( 'conservative' )   ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp
1688         zsprecip(:,:) =   frcv(jpr_snow)%z3(:,:,1)                  ! May need to ensure positive here
1689         ztprecip(:,:) =   frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:)  ! May need to ensure positive here
1690         zemp_tot(:,:) =   frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:)
1691      CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp
1692         zemp_tot(:,:) = ziceld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + picefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1)
1693         zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * picefr(:,:)
1694         zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1)
1695         ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:)
1696      CASE( 'none'      )       ! Not available as for now: needs additional coding below when computing zevap_oce
1697      !                         ! since fields received are not defined with none option
1698         CALL ctl_stop( 'STOP', 'sbccpl/sbc_cpl_ice_flx: some fields are not defined. Change sn_rcv_emp value in namelist namsbc_cpl' )
1699      END SELECT
1700
1701#if defined key_si3
1702
1703      ! --- evaporation over ice (kg/m2/s) --- !
1704      IF (ln_scale_ice_flux) THEN ! typically met-office requirements
1705         IF (sn_rcv_emp%clcat == 'yes') THEN
1706            WHERE( a_i(:,:,:) > 1.e-10 )  ; zevap_ice(:,:,:) = frcv(jpr_ievp)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:)
1707            ELSEWHERE                     ; zevap_ice(:,:,:) = 0._wp
1708            END WHERE
1709            WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) / picefr(:,:)
1710            ELSEWHERE                     ; zevap_ice_total(:,:) = 0._wp
1711            END WHERE
1712         ELSE
1713            WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1) * SUM( a_i_last_couple, dim=3 ) / picefr(:,:)
1714            ELSEWHERE                     ; zevap_ice(:,:,1) = 0._wp
1715            END WHERE
1716            zevap_ice_total(:,:) = zevap_ice(:,:,1)
1717            DO jl = 2, jpl
1718               zevap_ice(:,:,jl) = zevap_ice(:,:,1)
1719            ENDDO
1720         ENDIF
1721      ELSE
1722         IF (sn_rcv_emp%clcat == 'yes') THEN
1723            zevap_ice(:,:,1:jpl) = frcv(jpr_ievp)%z3(:,:,1:jpl)
1724            WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) / picefr(:,:)
1725            ELSEWHERE                     ; zevap_ice_total(:,:) = 0._wp
1726            END WHERE
1727         ELSE
1728            zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1)
1729            zevap_ice_total(:,:) = zevap_ice(:,:,1)
1730            DO jl = 2, jpl
1731               zevap_ice(:,:,jl) = zevap_ice(:,:,1)
1732            ENDDO
1733         ENDIF
1734      ENDIF
1735
1736      IF ( TRIM( sn_rcv_emp%cldes ) == 'conservative' ) THEN
1737         ! For conservative case zemp_ice has not been defined yet. Do it now.
1738         zemp_ice(:,:) = zevap_ice_total(:,:) * picefr(:,:) - frcv(jpr_snow)%z3(:,:,1) * picefr(:,:)
1739      ENDIF
1740
1741      ! zsnw = snow fraction over ice after wind blowing (=picefr if no blowing)
1742      zsnw(:,:) = 0._wp   ;   CALL ice_var_snwblow( ziceld, zsnw )
1743     
1744      ! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- !
1745      zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( picefr(:,:) - zsnw(:,:) )  ! emp_ice = A * sublimation - zsnw * sprecip
1746      zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:)                                ! emp_oce = emp_tot - emp_ice
1747
1748      ! --- evaporation over ocean (used later for qemp) --- !
1749      zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - zevap_ice_total(:,:) * picefr(:,:)
1750
1751      ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0
1752      ! therefore, sublimation is not redistributed over the ice categories when no subgrid scale fluxes are provided by atm.
1753      zdevap_ice(:,:) = 0._wp
1754     
1755      ! --- Continental fluxes --- !
1756      IF( srcv(jpr_rnf)%laction ) THEN   ! runoffs (included in emp later on)
1757         rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
1758      ENDIF
1759      IF( srcv(jpr_cal)%laction ) THEN   ! calving (put in emp_tot and emp_oce)
1760         zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
1761         zemp_oce(:,:) = zemp_oce(:,:) - frcv(jpr_cal)%z3(:,:,1)
1762      ENDIF
1763      IF( srcv(jpr_icb)%laction ) THEN   ! iceberg added to runoffs
1764         fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1)
1765         rnf(:,:)    = rnf(:,:) + fwficb(:,:)
1766      ENDIF
1767      IF( srcv(jpr_isf)%laction ) THEN   ! iceshelf (fwfisf <0 mean melting)
1768        fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1) 
1769      ENDIF
1770
1771      IF( ln_mixcpl ) THEN
1772         emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:)
1773         emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:)
1774         emp_oce(:,:) = emp_oce(:,:) * xcplmask(:,:,0) + zemp_oce(:,:) * zmsk(:,:)
1775         sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:)
1776         tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:)
1777         DO jl = 1, jpl
1778            evap_ice (:,:,jl) = evap_ice (:,:,jl) * xcplmask(:,:,0) + zevap_ice (:,:,jl) * zmsk(:,:)
1779            devap_ice(:,:,jl) = devap_ice(:,:,jl) * xcplmask(:,:,0) + zdevap_ice(:,:)    * zmsk(:,:)
1780         END DO
1781      ELSE
1782         emp_tot (:,:)   = zemp_tot (:,:)
1783         emp_ice (:,:)   = zemp_ice (:,:)
1784         emp_oce (:,:)   = zemp_oce (:,:)     
1785         sprecip (:,:)   = zsprecip (:,:)
1786         tprecip (:,:)   = ztprecip (:,:)
1787         evap_ice(:,:,:) = zevap_ice(:,:,:)
1788         DO jl = 1, jpl
1789            devap_ice(:,:,jl) = zdevap_ice(:,:)
1790         END DO
1791      ENDIF
1792
1793#else
1794      zsnw(:,:) = picefr(:,:)
1795      ! --- Continental fluxes --- !
1796      IF( srcv(jpr_rnf)%laction ) THEN   ! runoffs (included in emp later on)
1797         rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
1798      ENDIF
1799      IF( srcv(jpr_cal)%laction ) THEN   ! calving (put in emp_tot)
1800         zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
1801      ENDIF
1802      IF( srcv(jpr_icb)%laction ) THEN   ! iceberg added to runoffs
1803         fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1)
1804         rnf(:,:)    = rnf(:,:) + fwficb(:,:)
1805      ENDIF
1806      IF( srcv(jpr_isf)%laction ) THEN   ! iceshelf (fwfisf <0 mean melting)
1807        fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1)
1808      ENDIF
1809      !
1810      IF( ln_mixcpl ) THEN
1811         emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:)
1812         emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:)
1813         sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:)
1814         tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:)
1815      ELSE
1816         emp_tot(:,:) =                                  zemp_tot(:,:)
1817         emp_ice(:,:) =                                  zemp_ice(:,:)
1818         sprecip(:,:) =                                  zsprecip(:,:)
1819         tprecip(:,:) =                                  ztprecip(:,:)
1820      ENDIF
1821      !
1822#endif
1823
1824      ! outputs
1825!!      IF( srcv(jpr_rnf)%laction )   CALL iom_put( 'runoffs' , rnf(:,:) * tmask(:,:,1)                                 )  ! runoff
1826!!      IF( srcv(jpr_isf)%laction )   CALL iom_put( 'iceshelf_cea', -fwfisf(:,:) * tmask(:,:,1)                         )  ! iceshelf
1827      IF( srcv(jpr_cal)%laction )    CALL iom_put( 'calving_cea' , frcv(jpr_cal)%z3(:,:,1) * tmask(:,:,1)                )  ! calving
1828      IF( srcv(jpr_icb)%laction )    CALL iom_put( 'iceberg_cea' , frcv(jpr_icb)%z3(:,:,1) * tmask(:,:,1)                )  ! icebergs
1829      IF( iom_use('snowpre') )       CALL iom_put( 'snowpre'     , sprecip(:,:)                                          )  ! Snow
1830      IF( iom_use('precip') )        CALL iom_put( 'precip'      , tprecip(:,:)                                          )  ! total  precipitation
1831      IF( iom_use('rain') )          CALL iom_put( 'rain'        , tprecip(:,:) - sprecip(:,:)                           )  ! liquid precipitation
1832      IF( iom_use('snow_ao_cea') )   CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) )                  )  ! Snow over ice-free ocean  (cell average)
1833      IF( iom_use('snow_ai_cea') )   CALL iom_put( 'snow_ai_cea' , sprecip(:,:) *           zsnw(:,:)                    )  ! Snow over sea-ice         (cell average)
1834      IF( iom_use('rain_ao_cea') )   CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * picefr(:,:)         )  ! liquid precipitation over ocean (cell average)
1835      IF( iom_use('subl_ai_cea') )   CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * tmask(:,:,1) )     ! Sublimation over sea-ice (cell average)
1836      IF( iom_use('evap_ao_cea') )   CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1)  &
1837         &                                                         - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average)
1838      ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf
1839      !
1840      !                                                      ! ========================= !
1841      SELECT CASE( TRIM( sn_rcv_qns%cldes ) )                !   non solar heat fluxes   !   (qns)
1842      !                                                      ! ========================= !
1843      CASE( 'oce only' )         ! the required field is directly provided
1844         zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)
1845         ! For Met Office sea ice non-solar fluxes are already delt with by JULES so setting to zero
1846         ! here so the only flux is the ocean only one.
1847         zqns_ice(:,:,:) = 0._wp 
1848      CASE( 'conservative' )     ! the required fields are directly provided
1849         zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
1850         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
1851            zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl)
1852         ELSE
1853            DO jl = 1, jpl
1854               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) ! Set all category values equal
1855            END DO
1856         ENDIF
1857      CASE( 'oce and ice' )      ! the total flux is computed from ocean and ice fluxes
1858         zqns_tot(:,:) =  ziceld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)
1859         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
1860            DO jl=1,jpl
1861               zqns_tot(:,:   ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)   
1862               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl)
1863            ENDDO
1864         ELSE
1865            zqns_tot(:,:) = zqns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
1866            DO jl = 1, jpl
1867               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)
1868            END DO
1869         ENDIF
1870      CASE( 'mixed oce-ice' )    ! the ice flux is cumputed from the total flux, the SST and ice informations
1871! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED **
1872         zqns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1)
1873         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
1874            DO jl = 1, jpl
1875               zqns_ice(:,:,jl) = frcv(jpr_qnsmix)%z3(:,:,jl)    &
1876                  &             + frcv(jpr_dqnsdt)%z3(:,:,jl) * ( pist(:,:,jl) - ( ( rt0 + psst(:,:) ) * ziceld(:,:)   &
1877                  &                                             + pist(:,:,jl) * picefr(:,:) ) )
1878            END DO
1879         ELSE
1880            DO jl = 1, jpl
1881               zqns_ice(:,:,jl) = frcv(jpr_qnsmix)%z3(:,:, 1)    &
1882                  &             + frcv(jpr_dqnsdt)%z3(:,:, 1) * ( pist(:,:,jl) - ( ( rt0 + psst(:,:) ) * ziceld(:,:)   &
1883                  &                                             + pist(:,:,jl) * picefr(:,:) ) )
1884            END DO
1885         ENDIF
1886      END SELECT
1887      !                                     
1888      ! --- calving (removed from qns_tot) --- !
1889      IF( srcv(jpr_cal)%laction )   zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) * rLfus  ! remove latent heat of calving
1890                                                                                                     ! we suppose it melts at 0deg, though it should be temp. of surrounding ocean
1891      ! --- iceberg (removed from qns_tot) --- !
1892      IF( srcv(jpr_icb)%laction )   zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_icb)%z3(:,:,1) * rLfus  ! remove latent heat of iceberg melting
1893
1894#if defined key_si3     
1895      ! --- non solar flux over ocean --- !
1896      !         note: ziceld cannot be = 0 since we limit the ice concentration to amax
1897      zqns_oce = 0._wp
1898      WHERE( ziceld /= 0._wp )   zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / ziceld(:,:)
1899
1900      ! Heat content per unit mass of snow (J/kg)
1901      WHERE( SUM( a_i, dim=3 ) > 1.e-10 )   ;   zcptsnw(:,:) = rcpi * SUM( (tn_ice - rt0) * a_i, dim=3 ) / SUM( a_i, dim=3 )
1902      ELSEWHERE                             ;   zcptsnw(:,:) = zcptn(:,:)
1903      ENDWHERE
1904      ! Heat content per unit mass of rain (J/kg)
1905      zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * ziceld(:,:) ) 
1906
1907      ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- !
1908      zqprec_ice(:,:) = rhos * ( zcptsnw(:,:) - rLfus )
1909
1910      ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- !
1911      DO jl = 1, jpl
1912         zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * rcpi ) but atm. does not take it into account
1913      END DO
1914
1915      ! --- heat flux associated with emp (W/m2) --- !
1916      zqemp_oce(:,:) = -  zevap_oce(:,:)                                      *   zcptn   (:,:)   &        ! evap
1917         &             + ( ztprecip(:,:) - zsprecip(:,:) )                    *   zcptrain(:,:)   &        ! liquid precip
1918         &             +   zsprecip(:,:)                   * ( 1._wp - zsnw ) * ( zcptsnw (:,:) - rLfus )  ! solid precip over ocean + snow melting
1919      zqemp_ice(:,:) =     zsprecip(:,:)                   * zsnw             * ( zcptsnw (:,:) - rLfus )  ! solid precip over ice (qevap_ice=0 since atm. does not take it into account)
1920!!    zqemp_ice(:,:) = -   frcv(jpr_ievp)%z3(:,:,1)        * picefr(:,:)      *   zcptsnw (:,:)   &        ! ice evap
1921!!       &             +   zsprecip(:,:)                   * zsnw             * zqprec_ice(:,:) * r1_rhos  ! solid precip over ice
1922     
1923      ! --- total non solar flux (including evap/precip) --- !
1924      zqns_tot(:,:) = zqns_tot(:,:) + zqemp_ice(:,:) + zqemp_oce(:,:)
1925
1926      ! --- in case both coupled/forced are active, we must mix values --- !
1927      IF( ln_mixcpl ) THEN
1928         qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:)
1929         qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:)
1930         DO jl=1,jpl
1931            qns_ice  (:,:,jl) = qns_ice  (:,:,jl) * xcplmask(:,:,0) +  zqns_ice  (:,:,jl)* zmsk(:,:)
1932            qevap_ice(:,:,jl) = qevap_ice(:,:,jl) * xcplmask(:,:,0) +  zqevap_ice(:,:,jl)* zmsk(:,:)
1933         ENDDO
1934         qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:)
1935         qemp_oce (:,:) =  qemp_oce(:,:) * xcplmask(:,:,0) +  zqemp_oce(:,:)* zmsk(:,:)
1936         qemp_ice (:,:) =  qemp_ice(:,:) * xcplmask(:,:,0) +  zqemp_ice(:,:)* zmsk(:,:)
1937      ELSE
1938         qns_tot  (:,:  ) = zqns_tot  (:,:  )
1939         qns_oce  (:,:  ) = zqns_oce  (:,:  )
1940         qns_ice  (:,:,:) = zqns_ice  (:,:,:)
1941         qevap_ice(:,:,:) = zqevap_ice(:,:,:)
1942         qprec_ice(:,:  ) = zqprec_ice(:,:  )
1943         qemp_oce (:,:  ) = zqemp_oce (:,:  )
1944         qemp_ice (:,:  ) = zqemp_ice (:,:  )
1945      ENDIF
1946
1947#else
1948      zcptsnw (:,:) = zcptn(:,:)
1949      zcptrain(:,:) = zcptn(:,:)
1950     
1951      ! clem: this formulation is certainly wrong... but better than it was...
1952      zqns_tot(:,:) = zqns_tot(:,:)                             &          ! zqns_tot update over free ocean with:
1953         &          - (  ziceld(:,:) * zsprecip(:,:) * rLfus )  &          ! remove the latent heat flux of solid precip. melting
1954         &          - (  zemp_tot(:,:)                          &          ! remove the heat content of mass flux (assumed to be at SST)
1955         &             - zemp_ice(:,:) ) * zcptn(:,:) 
1956
1957     IF( ln_mixcpl ) THEN
1958         qns_tot(:,:) = qns(:,:) * ziceld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk
1959         qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) +  zqns_tot(:,:)* zmsk(:,:)
1960         DO jl=1,jpl
1961            qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) +  zqns_ice(:,:,jl)* zmsk(:,:)
1962         ENDDO
1963      ELSE
1964         qns_tot(:,:  ) = zqns_tot(:,:  )
1965         qns_ice(:,:,:) = zqns_ice(:,:,:)
1966      ENDIF
1967
1968#endif
1969      ! outputs
1970      IF ( srcv(jpr_cal)%laction ) CALL iom_put('hflx_cal_cea'    , - frcv(jpr_cal)%z3(:,:,1) * rLfus )   ! latent heat from calving
1971      IF ( srcv(jpr_icb)%laction ) CALL iom_put('hflx_icb_cea'    , - frcv(jpr_icb)%z3(:,:,1) * rLfus )   ! latent heat from icebergs melting
1972      IF ( iom_use(   'hflx_rain_cea') ) CALL iom_put('hflx_rain_cea' , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )        ! heat flux from rain (cell average)
1973      IF ( iom_use(   'hflx_evap_cea') ) CALL iom_put('hflx_evap_cea' , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) )  &
1974           &                         * zcptn(:,:) * tmask(:,:,1) )            ! heat flux from evap (cell average)
1975      IF ( iom_use(   'hflx_prec_cea') ) CALL iom_put('hflx_prec_cea' ,    sprecip(:,:) * ( zcptsnw(:,:) - rLfus )  &                    ! heat flux from all precip (cell avg)
1976         &                          + ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )
1977      IF ( iom_use(   'hflx_snow_cea') ) CALL iom_put('hflx_snow_cea'   , sprecip(:,:) * ( zcptsnw(:,:) - rLfus )  )               ! heat flux from snow (cell average)
1978      IF ( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) * ( 1._wp - zsnw(:,:) ) )   ! heat flux from snow (over ocean)
1979      IF ( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) *  zsnw(:,:) )              ! heat flux from snow (over ice)
1980      ! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp.
1981      !
1982      !                                                      ! ========================= !
1983      SELECT CASE( TRIM( sn_rcv_qsr%cldes ) )                !      solar heat fluxes    !   (qsr)
1984      !                                                      ! ========================= !
1985      CASE( 'oce only' )
1986         zqsr_tot(:,:  ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) )
1987         ! For Met Office sea ice solar fluxes are already delt with by JULES so setting to zero
1988         ! here so the only flux is the ocean only one.
1989         zqsr_ice(:,:,:) = 0._wp
1990      CASE( 'conservative' )
1991         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
1992         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
1993            zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl)
1994         ELSE
1995            ! Set all category values equal for the moment
1996            DO jl = 1, jpl
1997               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
1998            END DO
1999         ENDIF
2000      CASE( 'oce and ice' )
2001         zqsr_tot(:,:  ) =  ziceld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)
2002         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
2003            DO jl = 1, jpl
2004               zqsr_tot(:,:   ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)   
2005               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl)
2006            END DO
2007         ELSE
2008            zqsr_tot(:,:) = zqsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
2009            DO jl = 1, jpl
2010               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
2011            END DO
2012         ENDIF
2013      CASE( 'mixed oce-ice' )
2014         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
2015! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED **
2016!       Create solar heat flux over ice using incoming solar heat flux and albedos
2017!       ( see OASIS3 user guide, 5th edition, p39 )
2018         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
2019            DO jl = 1, jpl
2020               zqsr_ice(:,:,jl) = frcv(jpr_qsrmix)%z3(:,:,jl) * ( 1.- palbi(:,:,jl) )   &
2021                  &            / (  1.- ( alb_oce_mix(:,:   ) * ziceld(:,:)       &
2022                  &                     + palbi      (:,:,jl) * picefr(:,:) ) )
2023            END DO
2024         ELSE
2025            DO jl = 1, jpl
2026               zqsr_ice(:,:,jl) = frcv(jpr_qsrmix)%z3(:,:, 1) * ( 1.- palbi(:,:,jl) )   &
2027                  &            / (  1.- ( alb_oce_mix(:,:   ) * ziceld(:,:)       &
2028                  &                     + palbi      (:,:,jl) * picefr(:,:) ) )
2029            END DO
2030         ENDIF
2031      CASE( 'none'      )       ! Not available as for now: needs additional coding 
2032      !                         ! since fields received, here zqsr_tot,  are not defined with none option
2033         CALL ctl_stop( 'STOP', 'sbccpl/sbc_cpl_ice_flx: some fields are not defined. Change sn_rcv_qsr value in namelist namsbc_cpl' )
2034      END SELECT
2035      IF( ln_dm2dc .AND. ln_cpl ) THEN   ! modify qsr to include the diurnal cycle
2036         zqsr_tot(:,:  ) = sbc_dcy( zqsr_tot(:,:  ) )
2037         DO jl = 1, jpl
2038            zqsr_ice(:,:,jl) = sbc_dcy( zqsr_ice(:,:,jl) )
2039         END DO
2040      ENDIF
2041
2042#if defined key_si3
2043      ! --- solar flux over ocean --- !
2044      !         note: ziceld cannot be = 0 since we limit the ice concentration to amax
2045      zqsr_oce = 0._wp
2046      WHERE( ziceld /= 0._wp )  zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / ziceld(:,:)
2047
2048      IF( ln_mixcpl ) THEN   ;   qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) +  zqsr_oce(:,:)* zmsk(:,:)
2049      ELSE                   ;   qsr_oce(:,:) = zqsr_oce(:,:)   ;   ENDIF
2050#endif
2051
2052      IF( ln_mixcpl ) THEN
2053         qsr_tot(:,:) = qsr(:,:) * ziceld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk
2054         qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) +  zqsr_tot(:,:)* zmsk(:,:)
2055         DO jl = 1, jpl
2056            qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) +  zqsr_ice(:,:,jl)* zmsk(:,:)
2057         END DO
2058      ELSE
2059         qsr_tot(:,:  ) = zqsr_tot(:,:  )
2060         qsr_ice(:,:,:) = zqsr_ice(:,:,:)
2061      ENDIF
2062
2063      !                                                      ! ========================= !
2064      SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) )             !          d(qns)/dt        !
2065      !                                                      ! ========================= !
2066      CASE ('coupled')
2067         IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN
2068            zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)
2069         ELSE
2070            ! Set all category values equal for the moment
2071            DO jl=1,jpl
2072               zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)
2073            ENDDO
2074         ENDIF
2075      CASE( 'none' ) 
2076         zdqns_ice(:,:,:) = 0._wp
2077      END SELECT
2078     
2079      IF( ln_mixcpl ) THEN
2080         DO jl=1,jpl
2081            dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:)
2082         ENDDO
2083      ELSE
2084         dqns_ice(:,:,:) = zdqns_ice(:,:,:)
2085      ENDIF
2086
2087#if defined key_si3     
2088      !                                                      ! ========================= !
2089      SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) )             !  ice topmelt and botmelt  !
2090      !                                                      ! ========================= !
2091      CASE ('coupled')
2092         IF (ln_scale_ice_flux) THEN
2093            WHERE( a_i(:,:,:) > 1.e-10_wp )
2094               qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:)
2095               qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:)
2096            ELSEWHERE
2097               qml_ice(:,:,:) = 0.0_wp
2098               qcn_ice(:,:,:) = 0.0_wp
2099            END WHERE
2100         ELSE
2101            qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:)
2102            qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:)
2103         ENDIF
2104      END SELECT
2105      !                                                      ! ========================= !
2106      !                                                      !      Transmitted Qsr      !   [W/m2]
2107      !                                                      ! ========================= !
2108      IF( .NOT.ln_cndflx ) THEN                              !==  No conduction flux as surface forcing  ==!
2109         !
2110         IF( nn_qtrice == 0 ) THEN
2111            ! formulation derived from Grenfell and Maykut (1977), where transmission rate
2112            !    1) depends on cloudiness
2113            !       ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81)
2114            !       !      should be real cloud fraction instead (as in the bulk) but needs to be read from atm.
2115            !    2) is 0 when there is any snow
2116            !    3) tends to 1 for thin ice
2117            ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:)  ! surface transmission when hi>10cm
2118            DO jl = 1, jpl
2119               WHERE    ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) <  0.1_wp )       ! linear decrease from hi=0 to 10cm 
2120                  zqtr_ice_top(:,:,jl) = zqsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) )
2121               ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp )       ! constant (ztri) when hi>10cm
2122                  zqtr_ice_top(:,:,jl) = zqsr_ice(:,:,jl) * ztri(:,:)
2123               ELSEWHERE                                                           ! zero when hs>0
2124                  zqtr_ice_top(:,:,jl) = 0._wp 
2125               END WHERE
2126            ENDDO
2127         ELSEIF( nn_qtrice == 1 ) THEN
2128            ! formulation is derived from the thesis of M. Lebrun (2019).
2129            !    It represents the best fit using several sets of observations
2130            !    It comes with snow conductivities adapted to freezing/melting conditions (see icethd_zdf_bl99.F90)
2131            zqtr_ice_top(:,:,:) = 0.3_wp * zqsr_ice(:,:,:)
2132         ENDIF
2133         !     
2134      ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN      !==  conduction flux as surface forcing  ==!
2135         !
2136         !          ! ===> here we must receive the qtr_ice_top array from the coupler
2137         !                 for now just assume zero (fully opaque ice)
2138         zqtr_ice_top(:,:,:) = 0._wp
2139         !
2140      ENDIF
2141      !
2142      IF( ln_mixcpl ) THEN
2143         DO jl=1,jpl
2144            qtr_ice_top(:,:,jl) = qtr_ice_top(:,:,jl) * xcplmask(:,:,0) + zqtr_ice_top(:,:,jl) * zmsk(:,:)
2145         ENDDO
2146      ELSE
2147         qtr_ice_top(:,:,:) = zqtr_ice_top(:,:,:)
2148      ENDIF
2149      !                                                      ! ================== !
2150      !                                                      !   ice skin temp.   !
2151      !                                                      ! ================== !
2152      ! needed by Met Office
2153      IF( srcv(jpr_ts_ice)%laction ) THEN
2154         WHERE    ( frcv(jpr_ts_ice)%z3(:,:,:) > 0.0  )   ;   ztsu(:,:,:) =   0. + rt0 
2155         ELSEWHERE( frcv(jpr_ts_ice)%z3(:,:,:) < -60. )   ;   ztsu(:,:,:) = -60. + rt0
2156         ELSEWHERE                                        ;   ztsu(:,:,:) = frcv(jpr_ts_ice)%z3(:,:,:) + rt0
2157         END WHERE
2158         !
2159         IF( ln_mixcpl ) THEN
2160            DO jl=1,jpl
2161               pist(:,:,jl) = pist(:,:,jl) * xcplmask(:,:,0) + ztsu(:,:,jl) * zmsk(:,:)
2162            ENDDO
2163         ELSE
2164            pist(:,:,:) = ztsu(:,:,:)
2165         ENDIF
2166         !
2167      ENDIF
2168      !
2169#endif
2170      !
2171   END SUBROUTINE sbc_cpl_ice_flx
2172   
2173   
2174   SUBROUTINE sbc_cpl_snd( kt )
2175      !!----------------------------------------------------------------------
2176      !!             ***  ROUTINE sbc_cpl_snd  ***
2177      !!
2178      !! ** Purpose :   provide the ocean-ice informations to the atmosphere
2179      !!
2180      !! ** Method  :   send to the atmosphere through a call to cpl_snd
2181      !!              all the needed fields (as defined in sbc_cpl_init)
2182      !!----------------------------------------------------------------------
2183      INTEGER, INTENT(in) ::   kt
2184      !
2185      INTEGER ::   ji, jj, jl   ! dummy loop indices
2186      INTEGER ::   isec, info   ! local integer
2187      REAL(wp) ::   zumax, zvmax
2188      REAL(wp), DIMENSION(jpi,jpj)     ::   zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1
2189      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   ztmp3, ztmp4   
2190      !!----------------------------------------------------------------------
2191      !
2192      isec = ( kt - nit000 ) * NINT( rdt )        ! date of exchanges
2193      info = OASIS_idle
2194
2195      zfr_l(:,:) = 1.- fr_i(:,:)
2196      !                                                      ! ------------------------- !
2197      !                                                      !    Surface temperature    !   in Kelvin
2198      !                                                      ! ------------------------- !
2199      IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN
2200         
2201         IF ( nn_components == jp_iam_opa ) THEN
2202            ztmp1(:,:) = tsn(:,:,1,jp_tem)   ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part
2203         ELSE
2204            ! we must send the surface potential temperature
2205            IF( l_useCT )  THEN    ;   ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) )
2206            ELSE                   ;   ztmp1(:,:) = tsn(:,:,1,jp_tem)
2207            ENDIF
2208            !
2209            SELECT CASE( sn_snd_temp%cldes)
2210            CASE( 'oce only'             )   ;   ztmp1(:,:) =   ztmp1(:,:) + rt0
2211            CASE( 'oce and ice'          )   ;   ztmp1(:,:) =   ztmp1(:,:) + rt0
2212               SELECT CASE( sn_snd_temp%clcat )
2213               CASE( 'yes' )   
2214                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl)
2215               CASE( 'no' )
2216                  WHERE( SUM( a_i, dim=3 ) /= 0. )
2217                     ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 )
2218                  ELSEWHERE
2219                     ztmp3(:,:,1) = rt0
2220                  END WHERE
2221               CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
2222               END SELECT
2223            CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)   
2224               SELECT CASE( sn_snd_temp%clcat )
2225               CASE( 'yes' )   
2226                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
2227               CASE( 'no' )
2228                  ztmp3(:,:,:) = 0.0
2229                  DO jl=1,jpl
2230                     ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)
2231                  ENDDO
2232               CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
2233               END SELECT
2234            CASE( 'oce and weighted ice')    ;   ztmp1(:,:) =   tsn(:,:,1,jp_tem) + rt0 
2235               SELECT CASE( sn_snd_temp%clcat ) 
2236               CASE( 'yes' )   
2237                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
2238               CASE( 'no' ) 
2239                  ztmp3(:,:,:) = 0.0 
2240                  DO jl=1,jpl 
2241                     ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 
2242                  ENDDO 
2243               CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
2244               END SELECT
2245            CASE( 'mixed oce-ice'        )   
2246               ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) 
2247               DO jl=1,jpl
2248                  ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl)
2249               ENDDO
2250            CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' )
2251            END SELECT
2252         ENDIF
2253         IF( ssnd(jps_toce)%laction )   CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
2254         IF( ssnd(jps_tice)%laction )   CALL cpl_snd( jps_tice, isec, ztmp3, info )
2255         IF( ssnd(jps_tmix)%laction )   CALL cpl_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
2256      ENDIF
2257      !
2258      !                                                      ! ------------------------- !
2259      !                                                      ! 1st layer ice/snow temp.  !
2260      !                                                      ! ------------------------- !
2261#if defined key_si3
2262      ! needed by  Met Office
2263      IF( ssnd(jps_ttilyr)%laction) THEN
2264         SELECT CASE( sn_snd_ttilyr%cldes)
2265         CASE ('weighted ice')
2266            ztmp3(:,:,1:jpl) = t1_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
2267         CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ttilyr%cldes' )
2268         END SELECT
2269         IF( ssnd(jps_ttilyr)%laction )   CALL cpl_snd( jps_ttilyr, isec, ztmp3, info )
2270      ENDIF
2271#endif
2272      !                                                      ! ------------------------- !
2273      !                                                      !           Albedo          !
2274      !                                                      ! ------------------------- !
2275      IF( ssnd(jps_albice)%laction ) THEN                         ! ice
2276          SELECT CASE( sn_snd_alb%cldes )
2277          CASE( 'ice' )
2278             SELECT CASE( sn_snd_alb%clcat )
2279             CASE( 'yes' )   
2280                ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl)
2281             CASE( 'no' )
2282                WHERE( SUM( a_i, dim=3 ) /= 0. )
2283                   ztmp1(:,:) = SUM( alb_ice (:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) / SUM( a_i(:,:,1:jpl), dim=3 )
2284                ELSEWHERE
2285                   ztmp1(:,:) = alb_oce_mix(:,:)
2286                END WHERE
2287             CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%clcat' )
2288             END SELECT
2289          CASE( 'weighted ice' )   ;
2290             SELECT CASE( sn_snd_alb%clcat )
2291             CASE( 'yes' )   
2292                ztmp3(:,:,1:jpl) =  alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
2293             CASE( 'no' )
2294                WHERE( fr_i (:,:) > 0. )
2295                   ztmp1(:,:) = SUM (  alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 )
2296                ELSEWHERE
2297                   ztmp1(:,:) = 0.
2298                END WHERE
2299             CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ice%clcat' )
2300             END SELECT
2301          CASE default      ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' )
2302         END SELECT
2303
2304         SELECT CASE( sn_snd_alb%clcat )
2305            CASE( 'yes' )   
2306               CALL cpl_snd( jps_albice, isec, ztmp3, info )      !-> MV this has never been checked in coupled mode
2307            CASE( 'no'  )   
2308               CALL cpl_snd( jps_albice, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
2309         END SELECT
2310      ENDIF
2311
2312      IF( ssnd(jps_albmix)%laction ) THEN                         ! mixed ice-ocean
2313         ztmp1(:,:) = alb_oce_mix(:,:) * zfr_l(:,:)
2314         DO jl = 1, jpl
2315            ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl)
2316         END DO
2317         CALL cpl_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
2318      ENDIF
2319      !                                                      ! ------------------------- !
2320      !                                                      !  Ice fraction & Thickness !
2321      !                                                      ! ------------------------- !
2322      ! Send ice fraction field to atmosphere
2323      IF( ssnd(jps_fice)%laction ) THEN
2324         SELECT CASE( sn_snd_thick%clcat )
2325         CASE( 'yes' )   ;   ztmp3(:,:,1:jpl) =  a_i(:,:,1:jpl)
2326         CASE( 'no'  )   ;   ztmp3(:,:,1    ) = fr_i(:,:      )
2327         CASE default    ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
2328         END SELECT
2329         CALL cpl_snd( jps_fice, isec, ztmp3, info )
2330      ENDIF
2331
2332#if defined key_si3 || defined key_cice
2333      ! If this coupling was successful then save ice fraction for use between coupling points.
2334      ! This is needed for some calculations where the ice fraction at the last coupling point
2335      ! is needed.
2336      IF(  info == OASIS_Sent    .OR. info == OASIS_ToRest .OR. & 
2337         & info == OASIS_SentOut .OR. info == OASIS_ToRestOut ) THEN
2338         IF ( sn_snd_thick%clcat == 'yes' ) THEN
2339           a_i_last_couple(:,:,1:jpl) = a_i(:,:,1:jpl)
2340         ENDIF
2341      ENDIF
2342#endif
2343
2344      IF( ssnd(jps_fice1)%laction ) THEN
2345         SELECT CASE( sn_snd_thick1%clcat )
2346         CASE( 'yes' )   ;   ztmp3(:,:,1:jpl) =  a_i(:,:,1:jpl)
2347         CASE( 'no'  )   ;   ztmp3(:,:,1    ) = fr_i(:,:      )
2348         CASE default    ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick1%clcat' )
2349         END SELECT
2350         CALL cpl_snd( jps_fice1, isec, ztmp3, info )
2351      ENDIF
2352     
2353      ! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling)
2354      IF( ssnd(jps_fice2)%laction ) THEN
2355         ztmp3(:,:,1) = fr_i(:,:)
2356         IF( ssnd(jps_fice2)%laction )   CALL cpl_snd( jps_fice2, isec, ztmp3, info )
2357      ENDIF
2358
2359      ! Send ice and snow thickness field
2360      IF( ssnd(jps_hice)%laction .OR. ssnd(jps_hsnw)%laction ) THEN
2361         SELECT CASE( sn_snd_thick%cldes)
2362         CASE( 'none'                  )       ! nothing to do
2363         CASE( 'weighted ice and snow' )   
2364            SELECT CASE( sn_snd_thick%clcat )
2365            CASE( 'yes' )   
2366               ztmp3(:,:,1:jpl) =  h_i(:,:,1:jpl) * a_i(:,:,1:jpl)
2367               ztmp4(:,:,1:jpl) =  h_s(:,:,1:jpl) * a_i(:,:,1:jpl)
2368            CASE( 'no' )
2369               ztmp3(:,:,:) = 0.0   ;  ztmp4(:,:,:) = 0.0
2370               DO jl=1,jpl
2371                  ztmp3(:,:,1) = ztmp3(:,:,1) + h_i(:,:,jl) * a_i(:,:,jl)
2372                  ztmp4(:,:,1) = ztmp4(:,:,1) + h_s(:,:,jl) * a_i(:,:,jl)
2373               ENDDO
2374            CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
2375            END SELECT
2376         CASE( 'ice and snow'         )   
2377            SELECT CASE( sn_snd_thick%clcat )
2378            CASE( 'yes' )
2379               ztmp3(:,:,1:jpl) = h_i(:,:,1:jpl)
2380               ztmp4(:,:,1:jpl) = h_s(:,:,1:jpl)
2381            CASE( 'no' )
2382               WHERE( SUM( a_i, dim=3 ) /= 0. )
2383                  ztmp3(:,:,1) = SUM( h_i * a_i, dim=3 ) / SUM( a_i, dim=3 )
2384                  ztmp4(:,:,1) = SUM( h_s * a_i, dim=3 ) / SUM( a_i, dim=3 )
2385               ELSEWHERE
2386                 ztmp3(:,:,1) = 0.
2387                 ztmp4(:,:,1) = 0.
2388               END WHERE
2389            CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
2390            END SELECT
2391         CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' )
2392         END SELECT
2393         IF( ssnd(jps_hice)%laction )   CALL cpl_snd( jps_hice, isec, ztmp3, info )
2394         IF( ssnd(jps_hsnw)%laction )   CALL cpl_snd( jps_hsnw, isec, ztmp4, info )
2395      ENDIF
2396
2397#if defined key_si3
2398      !                                                      ! ------------------------- !
2399      !                                                      !      Ice melt ponds       !
2400      !                                                      ! ------------------------- !
2401      ! needed by Met Office: 1) fraction of ponded ice 2) local/actual pond depth
2402      IF( ssnd(jps_a_p)%laction .OR. ssnd(jps_ht_p)%laction ) THEN
2403         SELECT CASE( sn_snd_mpnd%cldes) 
2404         CASE( 'ice only' ) 
2405            SELECT CASE( sn_snd_mpnd%clcat ) 
2406            CASE( 'yes' ) 
2407               ztmp3(:,:,1:jpl) =  a_ip_eff(:,:,1:jpl)
2408               ztmp4(:,:,1:jpl) =  h_ip(:,:,1:jpl) 
2409            CASE( 'no' ) 
2410               ztmp3(:,:,:) = 0.0 
2411               ztmp4(:,:,:) = 0.0 
2412               DO jl=1,jpl 
2413                 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip_frac(:,:,jpl)
2414                 ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(:,:,jpl)
2415               ENDDO 
2416            CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%clcat' ) 
2417            END SELECT 
2418         CASE default      ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%cldes' )     
2419         END SELECT 
2420         IF( ssnd(jps_a_p)%laction  )   CALL cpl_snd( jps_a_p , isec, ztmp3, info )     
2421         IF( ssnd(jps_ht_p)%laction )   CALL cpl_snd( jps_ht_p, isec, ztmp4, info )     
2422      ENDIF 
2423      !
2424      !                                                      ! ------------------------- !
2425      !                                                      !     Ice conductivity      !
2426      !                                                      ! ------------------------- !
2427      ! needed by Met Office
2428      IF( ssnd(jps_kice)%laction ) THEN
2429         SELECT CASE( sn_snd_cond%cldes) 
2430         CASE( 'weighted ice' )   
2431            SELECT CASE( sn_snd_cond%clcat ) 
2432            CASE( 'yes' )   
2433          ztmp3(:,:,1:jpl) =  cnd_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
2434            CASE( 'no' ) 
2435               ztmp3(:,:,:) = 0.0 
2436               DO jl=1,jpl 
2437                 ztmp3(:,:,1) = ztmp3(:,:,1) + cnd_ice(:,:,jl) * a_i(:,:,jl) 
2438               ENDDO 
2439            CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%clcat' ) 
2440            END SELECT
2441         CASE( 'ice only' )   
2442           ztmp3(:,:,1:jpl) = cnd_ice(:,:,1:jpl) 
2443         CASE default      ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%cldes' )     
2444         END SELECT
2445         IF( ssnd(jps_kice)%laction )   CALL cpl_snd( jps_kice, isec, ztmp3, info ) 
2446      ENDIF 
2447#endif
2448
2449      !                                                      ! ------------------------- !
2450      !                                                      !  CO2 flux from PISCES     !
2451      !                                                      ! ------------------------- !
2452      IF( ssnd(jps_co2)%laction .AND. l_co2cpl )   THEN 
2453         ztmp1(:,:) = oce_co2(:,:) * 1000.  ! conversion in molC/m2/s
2454         CALL cpl_snd( jps_co2, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ) , info ) 
2455      ENDIF 
2456      !
2457      !                                                      ! ------------------------- !
2458      IF( ssnd(jps_ocx1)%laction ) THEN                      !      Surface current      !
2459         !                                                   ! ------------------------- !
2460         !   
2461         !                                                  j+1   j     -----V---F
2462         ! surface velocity always sent from T point                     !       |
2463         !                                                        j      |   T   U
2464         !                                                               |       |
2465         !                                                   j    j-1   -I-------|
2466         !                                               (for I)         |       |
2467         !                                                              i-1  i   i
2468         !                                                               i      i+1 (for I)
2469         IF( nn_components == jp_iam_opa ) THEN
2470            zotx1(:,:) = un(:,:,1) 
2471            zoty1(:,:) = vn(:,:,1) 
2472         ELSE       
2473            SELECT CASE( TRIM( sn_snd_crt%cldes ) )
2474            CASE( 'oce only'             )      ! C-grid ==> T
2475               DO jj = 2, jpjm1
2476                  DO ji = fs_2, fs_jpim1   ! vector opt.
2477                     zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) )
2478                     zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) ) 
2479                  END DO
2480               END DO
2481            CASE( 'weighted oce and ice' )      ! Ocean and Ice on C-grid ==> T 
2482               DO jj = 2, jpjm1
2483                  DO ji = fs_2, fs_jpim1   ! vector opt.
2484                     zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj) 
2485                     zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)
2486                     zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)
2487                     zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)
2488                  END DO
2489               END DO
2490               CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1., zity1, 'T', -1. )
2491            CASE( 'mixed oce-ice'        )      ! Ocean and Ice on C-grid ==> T
2492               DO jj = 2, jpjm1
2493                  DO ji = fs_2, fs_jpim1   ! vector opt.
2494                     zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   &
2495                        &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)
2496                     zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)   &
2497                        &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)
2498                  END DO
2499               END DO
2500            END SELECT
2501            CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1.,  zoty1, ssnd(jps_ocy1)%clgrid, -1. )
2502            !
2503         ENDIF
2504         !
2505         !
2506         IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN             ! Rotation of the components
2507            !                                                                     ! Ocean component
2508            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 )       ! 1st component
2509            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 )       ! 2nd component
2510            zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components
2511            zoty1(:,:) = ztmp2(:,:)
2512            IF( ssnd(jps_ivx1)%laction ) THEN                                     ! Ice component
2513               CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component
2514               CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component
2515               zitx1(:,:) = ztmp1(:,:)                                                ! overwrite the components
2516               zity1(:,:) = ztmp2(:,:)
2517            ENDIF
2518         ENDIF
2519         !
2520         ! spherical coordinates to cartesian -> 2 components to 3 components
2521         IF( TRIM( sn_snd_crt%clvref ) == 'cartesian' ) THEN
2522            ztmp1(:,:) = zotx1(:,:)                     ! ocean currents
2523            ztmp2(:,:) = zoty1(:,:)
2524            CALL oce2geo ( ztmp1, ztmp2, 'T', zotx1, zoty1, zotz1 )
2525            !
2526            IF( ssnd(jps_ivx1)%laction ) THEN           ! ice velocities
2527               ztmp1(:,:) = zitx1(:,:)
2528               ztmp1(:,:) = zity1(:,:)
2529               CALL oce2geo ( ztmp1, ztmp2, 'T', zitx1, zity1, zitz1 )
2530            ENDIF
2531         ENDIF
2532         !
2533         IF( ssnd(jps_ocx1)%laction )   CALL cpl_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info )   ! ocean x current 1st grid
2534         IF( ssnd(jps_ocy1)%laction )   CALL cpl_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info )   ! ocean y current 1st grid
2535         IF( ssnd(jps_ocz1)%laction )   CALL cpl_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info )   ! ocean z current 1st grid
2536         !
2537         IF( ssnd(jps_ivx1)%laction )   CALL cpl_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info )   ! ice   x current 1st grid
2538         IF( ssnd(jps_ivy1)%laction )   CALL cpl_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info )   ! ice   y current 1st grid
2539         IF( ssnd(jps_ivz1)%laction )   CALL cpl_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info )   ! ice   z current 1st grid
2540         !
2541      ENDIF
2542      !
2543      !                                                      ! ------------------------- !
2544      !                                                      !  Surface current to waves !
2545      !                                                      ! ------------------------- !
2546      IF( ssnd(jps_ocxw)%laction .OR. ssnd(jps_ocyw)%laction ) THEN 
2547          !     
2548          !                                                  j+1  j     -----V---F
2549          ! surface velocity always sent from T point                    !       |
2550          !                                                       j      |   T   U
2551          !                                                              |       |
2552          !                                                   j   j-1   -I-------|
2553          !                                               (for I)        |       |
2554          !                                                             i-1  i   i
2555          !                                                              i      i+1 (for I)
2556          SELECT CASE( TRIM( sn_snd_crtw%cldes ) ) 
2557          CASE( 'oce only'             )      ! C-grid ==> T
2558             DO jj = 2, jpjm1 
2559                DO ji = fs_2, fs_jpim1   ! vector opt.
2560                   zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) ) 
2561                   zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji , jj-1,1) ) 
2562                END DO
2563             END DO
2564          CASE( 'weighted oce and ice' )      ! Ocean and Ice on C-grid ==> T   
2565             DO jj = 2, jpjm1 
2566                DO ji = fs_2, fs_jpim1   ! vector opt.
2567                   zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   
2568                   zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj) 
2569                   zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
2570                   zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
2571                END DO
2572             END DO
2573             CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.,  zity1, 'T', -1. ) 
2574          CASE( 'mixed oce-ice'        )      ! Ocean and Ice on C-grid ==> T 
2575             DO jj = 2, jpjm1 
2576                DO ji = fs_2, fs_jpim1   ! vector opt.
2577                   zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   & 
2578                      &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
2579                   zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)   & 
2580                      &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
2581                END DO
2582             END DO
2583          END SELECT
2584         CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1., zoty1, ssnd(jps_ocyw)%clgrid, -1. ) 
2585         !
2586         !
2587         IF( TRIM( sn_snd_crtw%clvor ) == 'eastward-northward' ) THEN             ! Rotation of the components
2588         !                                                                        ! Ocean component
2589            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->e', ztmp1 )       ! 1st component 
2590            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->n', ztmp2 )       ! 2nd component 
2591            zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components 
2592            zoty1(:,:) = ztmp2(:,:) 
2593            IF( ssnd(jps_ivx1)%laction ) THEN                                     ! Ice component
2594               CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component 
2595               CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component 
2596               zitx1(:,:) = ztmp1(:,:)                                                ! overwrite the components 
2597               zity1(:,:) = ztmp2(:,:) 
2598            ENDIF
2599         ENDIF 
2600         !
2601!         ! spherical coordinates to cartesian -> 2 components to 3 components
2602!         IF( TRIM( sn_snd_crtw%clvref ) == 'cartesian' ) THEN
2603!            ztmp1(:,:) = zotx1(:,:)                     ! ocean currents
2604!            ztmp2(:,:) = zoty1(:,:)
2605!            CALL oce2geo ( ztmp1, ztmp2, 'T', zotx1, zoty1, zotz1 )
2606!            !
2607!            IF( ssnd(jps_ivx1)%laction ) THEN           ! ice velocities
2608!               ztmp1(:,:) = zitx1(:,:)
2609!               ztmp1(:,:) = zity1(:,:)
2610!               CALL oce2geo ( ztmp1, ztmp2, 'T', zitx1, zity1, zitz1 )
2611!            ENDIF
2612!         ENDIF
2613         !
2614         IF( ssnd(jps_ocxw)%laction )   CALL cpl_snd( jps_ocxw, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info )   ! ocean x current 1st grid
2615         IF( ssnd(jps_ocyw)%laction )   CALL cpl_snd( jps_ocyw, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info )   ! ocean y current 1st grid
2616         
2617      ENDIF 
2618      !
2619      IF( ssnd(jps_ficet)%laction ) THEN
2620         CALL cpl_snd( jps_ficet, isec, RESHAPE ( fr_i, (/jpi,jpj,1/) ), info ) 
2621      END IF 
2622      !                                                      ! ------------------------- !
2623      !                                                      !   Water levels to waves   !
2624      !                                                      ! ------------------------- !
2625      IF( ssnd(jps_wlev)%laction ) THEN
2626         IF( ln_apr_dyn ) THEN 
2627            IF( kt /= nit000 ) THEN 
2628               ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
2629            ELSE 
2630               ztmp1(:,:) = sshb(:,:) 
2631            ENDIF 
2632         ELSE 
2633            ztmp1(:,:) = sshn(:,:) 
2634         ENDIF 
2635         CALL cpl_snd( jps_wlev  , isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
2636      END IF 
2637      !
2638      !  Fields sent by OPA to SAS when doing OPA<->SAS coupling
2639      !                                                        ! SSH
2640      IF( ssnd(jps_ssh )%laction )  THEN
2641         !                          ! removed inverse barometer ssh when Patm
2642         !                          forcing is used (for sea-ice dynamics)
2643         IF( ln_apr_dyn ) THEN   ;   ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
2644         ELSE                    ;   ztmp1(:,:) = sshn(:,:)
2645         ENDIF
2646         CALL cpl_snd( jps_ssh   , isec, RESHAPE ( ztmp1            , (/jpi,jpj,1/) ), info )
2647
2648      ENDIF
2649      !                                                        ! SSS
2650      IF( ssnd(jps_soce  )%laction )  THEN
2651         CALL cpl_snd( jps_soce  , isec, RESHAPE ( tsn(:,:,1,jp_sal), (/jpi,jpj,1/) ), info )
2652      ENDIF
2653      !                                                        ! first T level thickness
2654      IF( ssnd(jps_e3t1st )%laction )  THEN
2655         CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t_n(:,:,1)   , (/jpi,jpj,1/) ), info )
2656      ENDIF
2657      !                                                        ! Qsr fraction
2658      IF( ssnd(jps_fraqsr)%laction )  THEN
2659         CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( fraqsr_1lev(:,:) , (/jpi,jpj,1/) ), info )
2660      ENDIF
2661      !
2662      !  Fields sent by SAS to OPA when OASIS coupling
2663      !                                                        ! Solar heat flux
2664      IF( ssnd(jps_qsroce)%laction )  CALL cpl_snd( jps_qsroce, isec, RESHAPE ( qsr , (/jpi,jpj,1/) ), info )
2665      IF( ssnd(jps_qnsoce)%laction )  CALL cpl_snd( jps_qnsoce, isec, RESHAPE ( qns , (/jpi,jpj,1/) ), info )
2666      IF( ssnd(jps_oemp  )%laction )  CALL cpl_snd( jps_oemp  , isec, RESHAPE ( emp , (/jpi,jpj,1/) ), info )
2667      IF( ssnd(jps_sflx  )%laction )  CALL cpl_snd( jps_sflx  , isec, RESHAPE ( sfx , (/jpi,jpj,1/) ), info )
2668      IF( ssnd(jps_otx1  )%laction )  CALL cpl_snd( jps_otx1  , isec, RESHAPE ( utau, (/jpi,jpj,1/) ), info )
2669      IF( ssnd(jps_oty1  )%laction )  CALL cpl_snd( jps_oty1  , isec, RESHAPE ( vtau, (/jpi,jpj,1/) ), info )
2670      IF( ssnd(jps_rnf   )%laction )  CALL cpl_snd( jps_rnf   , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info )
2671      IF( ssnd(jps_taum  )%laction )  CALL cpl_snd( jps_taum  , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info )
2672
2673#if defined key_si3
2674      !                                                      ! ------------------------- !
2675      !                                                      ! Sea surface freezing temp !
2676      !                                                      ! ------------------------- !
2677      ! needed by Met Office
2678      CALL eos_fzp(tsn(:,:,1,jp_sal), sstfrz)
2679      ztmp1(:,:) = sstfrz(:,:) + rt0
2680      IF( ssnd(jps_sstfrz)%laction )  CALL cpl_snd( jps_sstfrz, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info)
2681#endif
2682      !
2683   END SUBROUTINE sbc_cpl_snd
2684   
2685   !!======================================================================
2686END MODULE sbccpl
Note: See TracBrowser for help on using the repository browser.