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

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

sbccpl.F90 in NEMO/branches/2020/dev_r2052_ENHANCE-09_rbourdal_massfluxconvection/src/OCE/SBC – NEMO

Context Navigation

source: NEMO/branches/2020/dev_r2052_ENHANCE-09_rbourdal_massfluxconvection/src/OCE/SBC/sbccpl.F90 @ 14009

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

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

Download in other formats: