Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

sbccpl.F90

Last change on this file was 13387, checked in by dancopsey, 4 years ago
Fix conflicts with penetrating_solar branch.
File size: 156.0 KB

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

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

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

Context Navigation

source: NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl/src/OCE/SBC/sbccpl.F90

Download in other formats: