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

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

sbccpl.F90 in NEMO/branches/2020/temporary_r4_trunk/src/OCE/SBC – NEMO

Context Navigation

source: NEMO/branches/2020/temporary_r4_trunk/src/OCE/SBC/sbccpl.F90 @ 13469

Last change on this file since 13469 was 13469, checked in by smasson, 4 years ago
r4_trunk: first change of DO loops for routines to be merged, see #2523
Property svn:keywords set to `Id`
File size: 158.4 KB

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

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

Download in other formats: