Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

sbccpl.F90 @ 13778

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

Download in other formats: