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/dev_r12377_KERNEL-06_techene_e3/src/OCE/SBC – NEMO

Context Navigation

source: NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/SBC/sbccpl.F90 @ 12724

Last change on this file since 12724 was 12724, checked in by techene, 4 years ago
branch KERNEL-06 : merge with trunk@12698 #2385 - in duplcated files : changes to comply to the new trunk variables and some loop bug fixes
Property svn:keywords set to `Id`
File size: 153.8 KB

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

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

Download in other formats: