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

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

sbccpl.F90 in NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/src/OCE/SBC – NEMO

Context Navigation

source: NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/src/OCE/SBC/sbccpl.F90 @ 12937

Last change on this file since 12937 was 12937, checked in by dancopsey, 4 years ago

Merge in Clem's branch. It was originally here:

svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/UKMO/NEMO_4.0.1_dan_test_clems_branch

File size: 156.9 KB

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

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

Download in other formats: