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_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC – NEMO

Context Navigation

source: NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbccpl.F90 @ 13655

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

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

Download in other formats: