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_ukmo_shelf/src/OCE/SBC – NEMO

source: NEMO/branches/UKMO/r14075_ukmo_shelf/src/OCE/SBC/sbccpl.F90 @ 15492

Last change on this file since 15492 was 15492, checked in by jcastill, 8 months ago

Fix to coupled runs: solar radiation coupling

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