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/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/OCE/SBC – NEMO

Context Navigation

source: NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/OCE/SBC/sbccpl.F90 @ 12811

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

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

Download in other formats: