source: NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/OCE/SBC/sbccpl.F90 @ 12894

Last change on this file since 12894 was 12894, checked in by clem, 6 months ago

add parameterization of radiation from Marion Lebrun (2019)

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