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

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

sbccpl.F90 in NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/OCE/SBC – NEMO

Context Navigation

source: NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/OCE/SBC/sbccpl.F90 @ 12733

Last change on this file since 12733 was 12733, checked in by clem, 4 years ago
change sbccpl.F90 to fulfill Met-Office requirements (hopefully)
Property svn:keywords set to `Id`
File size: 157.4 KB

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

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

Download in other formats: