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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

sbccpl.F90 in NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC – NEMO

Context Navigation

source: NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbccpl.F90 @ 14644

Last change on this file since 14644 was 14644, checked in by sparonuz, 3 years ago
Merge trunk -r14642:HEAD
Property svn:keywords set to `Id`
File size: 166.6 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats: