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

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

sbccpl.F90 in NEMO/branches/UKMO/r14075_ukmo_shelf/src/OCE/SBC – NEMO

Context Navigation

source: NEMO/branches/UKMO/r14075_ukmo_shelf/src/OCE/SBC/sbccpl.F90 @ 15455

Last change on this file since 15455 was 15455, checked in by jcastill, 3 years ago
Code for uncoupled configurations, some changes for coupling may be needed yet - merged branch branches/UKMO/r14075_cpl-pressure@15423
File size: 161.1 KB

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

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

Download in other formats: