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

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

sbccpl.F90 in NEMO/branches/UKMO/NEMO_4.0.4_GO8_paquage_branch/src/OCE/SBC – NEMO

Context Navigation

source: NEMO/branches/UKMO/NEMO_4.0.4_GO8_paquage_branch/src/OCE/SBC/sbccpl.F90 @ 15662

Last change on this file since 15662 was 15662, checked in by jpalmier, 2 years ago
6th and 7th merge : fix a ip and icesheet-river coupling
File size: 171.6 KB

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

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

Download in other formats: