Context Navigation

sbccpl.F90 @ 13388

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

Download in other formats: