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/releases/r4.0/r4.0-HEAD/src/OCE/SBC – NEMO

Context Navigation

source: NEMO/releases/r4.0/r4.0-HEAD/src/OCE/SBC/sbccpl.F90 @ 13444

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

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

Download in other formats: