Context Navigation

sbccpl.F90 @ 15677

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

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

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

Context Navigation

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

Download in other formats: