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

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

sbccpl.F90 in NEMO/branches/UKMO/NEMO_4.0.1_icesheet_and_river_coupling/src/OCE/SBC – NEMO

Context Navigation

source: NEMO/branches/UKMO/NEMO_4.0.1_icesheet_and_river_coupling/src/OCE/SBC/sbccpl.F90 @ 12675

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

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

Download in other formats: