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

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

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

Context Navigation

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

Last change on this file since 14219 was 14219, checked in by mcastril, 4 years ago
Add Mixed Precision support by Oriol Tintó
Property svn:keywords set to `Id`
File size: 163.4 KB

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

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

Download in other formats: