Context Navigation

sbccpl.F90 @ 14643

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

Download in other formats: