Context Navigation

sbccpl.F90 @ 15814

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

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

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

Context Navigation

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

Download in other formats: