Context Navigation

sbccpl.F90 @ 15551

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

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

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

Context Navigation

source: NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/OCE/SBC/sbccpl.F90 @ 15551

Download in other formats: