Context Navigation

sbccpl.F90 @ 12940

Last change on this file since 12940 was 12940, checked in by dancopsey, 4 years ago
Merge in changeset #12388 from NEMO_4.0.1_fix_cpl
File size: 157.5 KB

Line
1	MODULE sbccpl
2	!!======================================================================
3	!! * MODULE sbccpl *
4	!! Surface Boundary Condition : momentum, heat and freshwater fluxes in coupled mode
5	!!======================================================================
6	!! History : 2.0 ! 2007-06 (R. Redler, N. Keenlyside, W. Park) Original code split into flxmod & taumod
7	!! 3.0 ! 2008-02 (G. Madec, C Talandier) surface module
8	!! 3.1 ! 2009_02 (G. Madec, S. Masson, E. Maisonave, A. Caubel) generic coupled interface
9	!! 3.4 ! 2011_11 (C. Harris) more flexibility + multi-category fields
10	!!----------------------------------------------------------------------
11
12	!!----------------------------------------------------------------------
13	!! namsbc_cpl : coupled formulation namlist
14	!! sbc_cpl_init : initialisation of the coupled exchanges
15	!! sbc_cpl_rcv : receive fields from the atmosphere over the ocean (ocean only)
16	!! receive stress from the atmosphere over the ocean (ocean-ice case)
17	!! sbc_cpl_ice_tau : receive stress from the atmosphere over ice
18	!! sbc_cpl_ice_flx : receive fluxes from the atmosphere over ice
19	!! sbc_cpl_snd : send fields to the atmosphere
20	!!----------------------------------------------------------------------
21	USE dom_oce ! ocean space and time domain
22	USE sbc_oce ! Surface boundary condition: ocean fields
23	USE trc_oce ! share SMS/Ocean variables
24	USE sbc_ice ! Surface boundary condition: ice fields
25	USE sbcapr ! Stochastic param. : ???
26	USE sbcdcy ! surface boundary condition: diurnal cycle
27	USE sbcwave ! surface boundary condition: waves
28	USE phycst ! physical constants
29	#if defined key_si3
30	USE ice ! ice variables
31	#endif
32	USE cpl_oasis3 ! OASIS3 coupling
33	USE geo2ocean !
34	USE oce , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev
35	USE ocealb !
36	USE eosbn2 !
37	USE sbcrnf , ONLY : l_rnfcpl
38	USE sbcisf , ONLY : l_isfcpl
39	#if defined key_cice
40	USE ice_domain_size, only: ncat
41	#endif
42	#if defined key_si3
43	USE icethd_dh ! for CALL ice_thd_snwblow
44	#endif
45	!
46	USE in_out_manager ! I/O manager
47	USE iom ! NetCDF library
48	USE lib_mpp ! distribued memory computing library
49	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
50
51	#if defined key_oasis3
52	USE mod_oasis, ONLY : OASIS_Sent, OASIS_ToRest, OASIS_SentOut, OASIS_ToRestOut
53	#endif
54
55	IMPLICIT NONE
56	PRIVATE
57
58	PUBLIC sbc_cpl_init ! routine called by sbcmod.F90
59	PUBLIC sbc_cpl_rcv ! routine called by icestp.F90
60	PUBLIC sbc_cpl_snd ! routine called by step.F90
61	PUBLIC sbc_cpl_ice_tau ! routine called by icestp.F90
62	PUBLIC sbc_cpl_ice_flx ! routine called by icestp.F90
63	PUBLIC sbc_cpl_alloc ! routine called in sbcice_cice.F90
64
65	INTEGER, PARAMETER :: jpr_otx1 = 1 ! 3 atmosphere-ocean stress components on grid 1
66	INTEGER, PARAMETER :: jpr_oty1 = 2 !
67	INTEGER, PARAMETER :: jpr_otz1 = 3 !
68	INTEGER, PARAMETER :: jpr_otx2 = 4 ! 3 atmosphere-ocean stress components on grid 2
69	INTEGER, PARAMETER :: jpr_oty2 = 5 !
70	INTEGER, PARAMETER :: jpr_otz2 = 6 !
71	INTEGER, PARAMETER :: jpr_itx1 = 7 ! 3 atmosphere-ice stress components on grid 1
72	INTEGER, PARAMETER :: jpr_ity1 = 8 !
73	INTEGER, PARAMETER :: jpr_itz1 = 9 !
74	INTEGER, PARAMETER :: jpr_itx2 = 10 ! 3 atmosphere-ice stress components on grid 2
75	INTEGER, PARAMETER :: jpr_ity2 = 11 !
76	INTEGER, PARAMETER :: jpr_itz2 = 12 !
77	INTEGER, PARAMETER :: jpr_qsroce = 13 ! Qsr above the ocean
78	INTEGER, PARAMETER :: jpr_qsrice = 14 ! Qsr above the ice
79	INTEGER, PARAMETER :: jpr_qsrmix = 15
80	INTEGER, PARAMETER :: jpr_qnsoce = 16 ! Qns above the ocean
81	INTEGER, PARAMETER :: jpr_qnsice = 17 ! Qns above the ice
82	INTEGER, PARAMETER :: jpr_qnsmix = 18
83	INTEGER, PARAMETER :: jpr_rain = 19 ! total liquid precipitation (rain)
84	INTEGER, PARAMETER :: jpr_snow = 20 ! solid precipitation over the ocean (snow)
85	INTEGER, PARAMETER :: jpr_tevp = 21 ! total evaporation
86	INTEGER, PARAMETER :: jpr_ievp = 22 ! solid evaporation (sublimation)
87	INTEGER, PARAMETER :: jpr_sbpr = 23 ! sublimation - liquid precipitation - solid precipitation
88	INTEGER, PARAMETER :: jpr_semp = 24 ! solid freshwater budget (sublimation - snow)
89	INTEGER, PARAMETER :: jpr_oemp = 25 ! ocean freshwater budget (evap - precip)
90	INTEGER, PARAMETER :: jpr_w10m = 26 ! 10m wind
91	INTEGER, PARAMETER :: jpr_dqnsdt = 27 ! d(Q non solar)/d(temperature)
92	INTEGER, PARAMETER :: jpr_rnf = 28 ! runoffs
93	INTEGER, PARAMETER :: jpr_cal = 29 ! calving
94	INTEGER, PARAMETER :: jpr_taum = 30 ! wind stress module
95	INTEGER, PARAMETER :: jpr_co2 = 31
96	INTEGER, PARAMETER :: jpr_topm = 32 ! topmeltn
97	INTEGER, PARAMETER :: jpr_botm = 33 ! botmeltn
98	INTEGER, PARAMETER :: jpr_sflx = 34 ! salt flux
99	INTEGER, PARAMETER :: jpr_toce = 35 ! ocean temperature
100	INTEGER, PARAMETER :: jpr_soce = 36 ! ocean salinity
101	INTEGER, PARAMETER :: jpr_ocx1 = 37 ! ocean current on grid 1
102	INTEGER, PARAMETER :: jpr_ocy1 = 38 !
103	INTEGER, PARAMETER :: jpr_ssh = 39 ! sea surface height
104	INTEGER, PARAMETER :: jpr_fice = 40 ! ice fraction
105	INTEGER, PARAMETER :: jpr_e3t1st = 41 ! first T level thickness
106	INTEGER, PARAMETER :: jpr_fraqsr = 42 ! fraction of solar net radiation absorbed in the first ocean level
107	INTEGER, PARAMETER :: jpr_mslp = 43 ! mean sea level pressure
108	INTEGER, PARAMETER :: jpr_hsig = 44 ! Hsig
109	INTEGER, PARAMETER :: jpr_phioc = 45 ! Wave=>ocean energy flux
110	INTEGER, PARAMETER :: jpr_sdrftx = 46 ! Stokes drift on grid 1
111	INTEGER, PARAMETER :: jpr_sdrfty = 47 ! Stokes drift on grid 2
112	INTEGER, PARAMETER :: jpr_wper = 48 ! Mean wave period
113	INTEGER, PARAMETER :: jpr_wnum = 49 ! Mean wavenumber
114	INTEGER, PARAMETER :: jpr_tauwoc = 50 ! Stress fraction adsorbed by waves
115	INTEGER, PARAMETER :: jpr_wdrag = 51 ! Neutral surface drag coefficient
116	INTEGER, PARAMETER :: jpr_isf = 52
117	INTEGER, PARAMETER :: jpr_icb = 53
118	INTEGER, PARAMETER :: jpr_wfreq = 54 ! Wave peak frequency
119	INTEGER, PARAMETER :: jpr_tauwx = 55 ! x component of the ocean stress from waves
120	INTEGER, PARAMETER :: jpr_tauwy = 56 ! y component of the ocean stress from waves
121	INTEGER, PARAMETER :: jpr_ts_ice = 57 ! Sea ice surface temp
122
123	INTEGER, PARAMETER :: jprcv = 57 ! total number of fields received
124
125	INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere
126	INTEGER, PARAMETER :: jps_toce = 2 ! ocean temperature
127	INTEGER, PARAMETER :: jps_tice = 3 ! ice temperature
128	INTEGER, PARAMETER :: jps_tmix = 4 ! mixed temperature (ocean+ice)
129	INTEGER, PARAMETER :: jps_albice = 5 ! ice albedo
130	INTEGER, PARAMETER :: jps_albmix = 6 ! mixed albedo
131	INTEGER, PARAMETER :: jps_hice = 7 ! ice thickness
132	INTEGER, PARAMETER :: jps_hsnw = 8 ! snow thickness
133	INTEGER, PARAMETER :: jps_ocx1 = 9 ! ocean current on grid 1
134	INTEGER, PARAMETER :: jps_ocy1 = 10 !
135	INTEGER, PARAMETER :: jps_ocz1 = 11 !
136	INTEGER, PARAMETER :: jps_ivx1 = 12 ! ice current on grid 1
137	INTEGER, PARAMETER :: jps_ivy1 = 13 !
138	INTEGER, PARAMETER :: jps_ivz1 = 14 !
139	INTEGER, PARAMETER :: jps_co2 = 15
140	INTEGER, PARAMETER :: jps_soce = 16 ! ocean salinity
141	INTEGER, PARAMETER :: jps_ssh = 17 ! sea surface height
142	INTEGER, PARAMETER :: jps_qsroce = 18 ! Qsr above the ocean
143	INTEGER, PARAMETER :: jps_qnsoce = 19 ! Qns above the ocean
144	INTEGER, PARAMETER :: jps_oemp = 20 ! ocean freshwater budget (evap - precip)
145	INTEGER, PARAMETER :: jps_sflx = 21 ! salt flux
146	INTEGER, PARAMETER :: jps_otx1 = 22 ! 2 atmosphere-ocean stress components on grid 1
147	INTEGER, PARAMETER :: jps_oty1 = 23 !
148	INTEGER, PARAMETER :: jps_rnf = 24 ! runoffs
149	INTEGER, PARAMETER :: jps_taum = 25 ! wind stress module
150	INTEGER, PARAMETER :: jps_fice2 = 26 ! ice fraction sent to OPA (by SAS when doing SAS-OPA coupling)
151	INTEGER, PARAMETER :: jps_e3t1st = 27 ! first level depth (vvl)
152	INTEGER, PARAMETER :: jps_fraqsr = 28 ! fraction of solar net radiation absorbed in the first ocean level
153	INTEGER, PARAMETER :: jps_ficet = 29 ! total ice fraction
154	INTEGER, PARAMETER :: jps_ocxw = 30 ! currents on grid 1
155	INTEGER, PARAMETER :: jps_ocyw = 31 ! currents on grid 2
156	INTEGER, PARAMETER :: jps_wlev = 32 ! water level
157	INTEGER, PARAMETER :: jps_fice1 = 33 ! first-order ice concentration (for semi-implicit coupling of atmos-ice fluxes)
158	INTEGER, PARAMETER :: jps_a_p = 34 ! meltpond area fraction
159	INTEGER, PARAMETER :: jps_ht_p = 35 ! meltpond thickness
160	INTEGER, PARAMETER :: jps_kice = 36 ! sea ice effective conductivity
161	INTEGER, PARAMETER :: jps_sstfrz = 37 ! sea surface freezing temperature
162	INTEGER, PARAMETER :: jps_ttilyr = 38 ! sea ice top layer temp
163
164	INTEGER, PARAMETER :: jpsnd = 38 ! total number of fields sent
165
166	#if ! defined key_oasis3
167	! Dummy variables to enable compilation when oasis3 is not being used
168	INTEGER :: OASIS_Sent = -1
169	INTEGER :: OASIS_SentOut = -1
170	INTEGER :: OASIS_ToRest = -1
171	INTEGER :: OASIS_ToRestOut = -1
172	#endif
173
174	! !! namelist namsbc_cpl
175	TYPE :: FLD_C !
176	CHARACTER(len = 32) :: cldes ! desciption of the coupling strategy
177	CHARACTER(len = 32) :: clcat ! multiple ice categories strategy
178	CHARACTER(len = 32) :: clvref ! reference of vector ('spherical' or 'cartesian')
179	CHARACTER(len = 32) :: clvor ! orientation of vector fields ('eastward-northward' or 'local grid')
180	CHARACTER(len = 32) :: clvgrd ! grids on which is located the vector fields
181	END TYPE FLD_C
182	! ! Send to the atmosphere
183	TYPE(FLD_C) :: sn_snd_temp , sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2, &
184	& sn_snd_thick1, sn_snd_cond, sn_snd_mpnd , sn_snd_sstfrz, sn_snd_ttilyr
185	! ! Received from the atmosphere
186	TYPE(FLD_C) :: sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_tauw, sn_rcv_dqnsdt, sn_rcv_qsr, &
187	& sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf, sn_rcv_ts_ice
188	TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_mslp, sn_rcv_icb, sn_rcv_isf
189	! Send to waves
190	TYPE(FLD_C) :: sn_snd_ifrac, sn_snd_crtw, sn_snd_wlev
191	! Received from waves
192	TYPE(FLD_C) :: sn_rcv_hsig, sn_rcv_phioc, sn_rcv_sdrfx, sn_rcv_sdrfy, sn_rcv_wper, sn_rcv_wnum, sn_rcv_tauwoc, &
193	sn_rcv_wdrag, sn_rcv_wfreq
194	! ! Other namelist parameters
195	INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data
196	LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models
197	! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel)
198	LOGICAL :: ln_scale_ice_flux ! use ice fluxes that are already "ice weighted" ( i.e. multiplied ice concentration)
199
200	TYPE :: DYNARR
201	REAL(wp), POINTER, DIMENSION(:,:,:) :: z3
202	END TYPE DYNARR
203
204	TYPE( DYNARR ), SAVE, DIMENSION(jprcv) :: frcv ! all fields recieved from the atmosphere
205
206	REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: alb_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky)
207
208	REAL(wp) :: rpref = 101000._wp ! reference atmospheric pressure[N/m2]
209	REAL(wp) :: r1_grau ! = 1.e0 / (grav * rau0)
210
211	INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) :: nrcvinfo ! OASIS info argument
212
213	!! Substitution
214	# include "vectopt_loop_substitute.h90"
215	!!----------------------------------------------------------------------
216	!! NEMO/OCE 4.0 , NEMO Consortium (2018)
217	!! $Id$
218	!! Software governed by the CeCILL license (see ./LICENSE)
219	!!----------------------------------------------------------------------
220	CONTAINS
221
222	INTEGER FUNCTION sbc_cpl_alloc()
223	!!----------------------------------------------------------------------
224	!! * FUNCTION sbc_cpl_alloc *
225	!!----------------------------------------------------------------------
226	INTEGER :: ierr(4)
227	!!----------------------------------------------------------------------
228	ierr(:) = 0
229	!
230	ALLOCATE( alb_oce_mix(jpi,jpj), nrcvinfo(jprcv), STAT=ierr(1) )
231
232	#if ! defined key_si3 && ! defined key_cice
233	ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) ) ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init)
234	#endif
235	ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) )
236	!
237	IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(4) )
238
239	sbc_cpl_alloc = MAXVAL( ierr )
240	CALL mpp_sum ( 'sbccpl', sbc_cpl_alloc )
241	IF( sbc_cpl_alloc > 0 ) CALL ctl_warn('sbc_cpl_alloc: allocation of arrays failed')
242	!
243	END FUNCTION sbc_cpl_alloc
244
245
246	SUBROUTINE sbc_cpl_init( k_ice )
247	!!----------------------------------------------------------------------
248	!! * ROUTINE sbc_cpl_init *
249	!!
250	!! ** Purpose : Initialisation of send and received information from
251	!! the atmospheric component
252	!!
253	!! ** Method : * Read namsbc_cpl namelist
254	!! * define the receive interface
255	!! * define the send interface
256	!! * initialise the OASIS coupler
257	!!----------------------------------------------------------------------
258	INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3)
259	!
260	INTEGER :: jn ! dummy loop index
261	INTEGER :: ios, inum ! Local integer
262	REAL(wp), DIMENSION(jpi,jpj) :: zacs, zaos
263	!!
264	NAMELIST/namsbc_cpl/ nn_cplmodel , ln_usecplmask, nn_cats_cpl , ln_scale_ice_flux, &
265	& sn_snd_temp , sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2 , &
266	& sn_snd_ttilyr, sn_snd_cond , sn_snd_mpnd , sn_snd_sstfrz, sn_snd_thick1, &
267	& sn_snd_ifrac , sn_snd_crtw , sn_snd_wlev , sn_rcv_hsig , sn_rcv_phioc , &
268	& sn_rcv_w10m , sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr , &
269	& sn_rcv_sdrfx , sn_rcv_sdrfy , sn_rcv_wper , sn_rcv_wnum , sn_rcv_tauwoc, &
270	& sn_rcv_wdrag , sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , &
271	& sn_rcv_iceflx, sn_rcv_co2 , sn_rcv_mslp , &
272	& sn_rcv_icb , sn_rcv_isf , sn_rcv_wfreq, sn_rcv_tauw , &
273	& sn_rcv_ts_ice
274	!!---------------------------------------------------------------------
275	!
276	! ================================ !
277	! Namelist informations !
278	! ================================ !
279	!
280	REWIND( numnam_ref ) ! Namelist namsbc_cpl in reference namelist : Variables for OASIS coupling
281	READ ( numnam_ref, namsbc_cpl, IOSTAT = ios, ERR = 901)
282	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in reference namelist' )
283	!
284	REWIND( numnam_cfg ) ! Namelist namsbc_cpl in configuration namelist : Variables for OASIS coupling
285	READ ( numnam_cfg, namsbc_cpl, IOSTAT = ios, ERR = 902 )
286	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in configuration namelist' )
287	IF(lwm) WRITE ( numond, namsbc_cpl )
288	!
289	IF(lwp) THEN ! control print
290	WRITE(numout,*)
291	WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist '
292	WRITE(numout,*)'~~~~~~~~~~~~'
293	ENDIF
294	IF( lwp .AND. ln_cpl ) THEN ! control print
295	WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel
296	WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask
297	WRITE(numout,*)' ln_scale_ice_flux = ', ln_scale_ice_flux
298	WRITE(numout,*)' nn_cats_cpl = ', nn_cats_cpl
299	WRITE(numout,*)' received fields (mutiple ice categogies)'
300	WRITE(numout,*)' 10m wind module = ', TRIM(sn_rcv_w10m%cldes ), ' (', TRIM(sn_rcv_w10m%clcat ), ')'
301	WRITE(numout,*)' stress module = ', TRIM(sn_rcv_taumod%cldes), ' (', TRIM(sn_rcv_taumod%clcat), ')'
302	WRITE(numout,*)' surface stress = ', TRIM(sn_rcv_tau%cldes ), ' (', TRIM(sn_rcv_tau%clcat ), ')'
303	WRITE(numout,*)' - referential = ', sn_rcv_tau%clvref
304	WRITE(numout,*)' - orientation = ', sn_rcv_tau%clvor
305	WRITE(numout,*)' - mesh = ', sn_rcv_tau%clvgrd
306	WRITE(numout,*)' non-solar heat flux sensitivity = ', TRIM(sn_rcv_dqnsdt%cldes), ' (', TRIM(sn_rcv_dqnsdt%clcat), ')'
307	WRITE(numout,*)' solar heat flux = ', TRIM(sn_rcv_qsr%cldes ), ' (', TRIM(sn_rcv_qsr%clcat ), ')'
308	WRITE(numout,*)' non-solar heat flux = ', TRIM(sn_rcv_qns%cldes ), ' (', TRIM(sn_rcv_qns%clcat ), ')'
309	WRITE(numout,*)' freshwater budget = ', TRIM(sn_rcv_emp%cldes ), ' (', TRIM(sn_rcv_emp%clcat ), ')'
310	WRITE(numout,*)' runoffs = ', TRIM(sn_rcv_rnf%cldes ), ' (', TRIM(sn_rcv_rnf%clcat ), ')'
311	WRITE(numout,*)' calving = ', TRIM(sn_rcv_cal%cldes ), ' (', TRIM(sn_rcv_cal%clcat ), ')'
312	WRITE(numout,*)' iceberg = ', TRIM(sn_rcv_icb%cldes ), ' (', TRIM(sn_rcv_icb%clcat ), ')'
313	WRITE(numout,*)' ice shelf = ', TRIM(sn_rcv_isf%cldes ), ' (', TRIM(sn_rcv_isf%clcat ), ')'
314	WRITE(numout,*)' sea ice heat fluxes = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')'
315	WRITE(numout,*)' atm co2 = ', TRIM(sn_rcv_co2%cldes ), ' (', TRIM(sn_rcv_co2%clcat ), ')'
316	WRITE(numout,*)' significant wave heigth = ', TRIM(sn_rcv_hsig%cldes ), ' (', TRIM(sn_rcv_hsig%clcat ), ')'
317	WRITE(numout,*)' wave to oce energy flux = ', TRIM(sn_rcv_phioc%cldes ), ' (', TRIM(sn_rcv_phioc%clcat ), ')'
318	WRITE(numout,*)' Surface Stokes drift grid u = ', TRIM(sn_rcv_sdrfx%cldes ), ' (', TRIM(sn_rcv_sdrfx%clcat ), ')'
319	WRITE(numout,*)' Surface Stokes drift grid v = ', TRIM(sn_rcv_sdrfy%cldes ), ' (', TRIM(sn_rcv_sdrfy%clcat ), ')'
320	WRITE(numout,*)' Mean wave period = ', TRIM(sn_rcv_wper%cldes ), ' (', TRIM(sn_rcv_wper%clcat ), ')'
321	WRITE(numout,*)' Mean wave number = ', TRIM(sn_rcv_wnum%cldes ), ' (', TRIM(sn_rcv_wnum%clcat ), ')'
322	WRITE(numout,*)' Wave peak frequency = ', TRIM(sn_rcv_wfreq%cldes ), ' (', TRIM(sn_rcv_wfreq%clcat ), ')'
323	WRITE(numout,*)' Stress frac adsorbed by waves = ', TRIM(sn_rcv_tauwoc%cldes), ' (', TRIM(sn_rcv_tauwoc%clcat ), ')'
324	WRITE(numout,*)' Stress components by waves = ', TRIM(sn_rcv_tauw%cldes ), ' (', TRIM(sn_rcv_tauw%clcat ), ')'
325	WRITE(numout,*)' Neutral surf drag coefficient = ', TRIM(sn_rcv_wdrag%cldes ), ' (', TRIM(sn_rcv_wdrag%clcat ), ')'
326	WRITE(numout,*)' Sea ice surface skin temperature= ', TRIM(sn_rcv_ts_ice%cldes), ' (', TRIM(sn_rcv_ts_ice%clcat), ')'
327	WRITE(numout,*)' sent fields (multiple ice categories)'
328	WRITE(numout,*)' surface temperature = ', TRIM(sn_snd_temp%cldes ), ' (', TRIM(sn_snd_temp%clcat ), ')'
329	WRITE(numout,*)' top ice layer temperature = ', TRIM(sn_snd_ttilyr%cldes), ' (', TRIM(sn_snd_ttilyr%clcat), ')'
330	WRITE(numout,*)' albedo = ', TRIM(sn_snd_alb%cldes ), ' (', TRIM(sn_snd_alb%clcat ), ')'
331	WRITE(numout,*)' ice/snow thickness = ', TRIM(sn_snd_thick%cldes ), ' (', TRIM(sn_snd_thick%clcat ), ')'
332	WRITE(numout,*)' total ice fraction = ', TRIM(sn_snd_ifrac%cldes ), ' (', TRIM(sn_snd_ifrac%clcat ), ')'
333	WRITE(numout,*)' surface current = ', TRIM(sn_snd_crt%cldes ), ' (', TRIM(sn_snd_crt%clcat ), ')'
334	WRITE(numout,*)' - referential = ', sn_snd_crt%clvref
335	WRITE(numout,*)' - orientation = ', sn_snd_crt%clvor
336	WRITE(numout,*)' - mesh = ', sn_snd_crt%clvgrd
337	WRITE(numout,*)' oce co2 flux = ', TRIM(sn_snd_co2%cldes ), ' (', TRIM(sn_snd_co2%clcat ), ')'
338	WRITE(numout,*)' ice effective conductivity = ', TRIM(sn_snd_cond%cldes ), ' (', TRIM(sn_snd_cond%clcat ), ')'
339	WRITE(numout,*)' meltponds fraction and depth = ', TRIM(sn_snd_mpnd%cldes ), ' (', TRIM(sn_snd_mpnd%clcat ), ')'
340	WRITE(numout,*)' sea surface freezing temp = ', TRIM(sn_snd_sstfrz%cldes), ' (', TRIM(sn_snd_sstfrz%clcat), ')'
341	WRITE(numout,*)' water level = ', TRIM(sn_snd_wlev%cldes ), ' (', TRIM(sn_snd_wlev%clcat ), ')'
342	WRITE(numout,*)' mean sea level pressure = ', TRIM(sn_rcv_mslp%cldes ), ' (', TRIM(sn_rcv_mslp%clcat ), ')'
343	WRITE(numout,*)' surface current to waves = ', TRIM(sn_snd_crtw%cldes ), ' (', TRIM(sn_snd_crtw%clcat ), ')'
344	WRITE(numout,*)' - referential = ', sn_snd_crtw%clvref
345	WRITE(numout,*)' - orientation = ', sn_snd_crtw%clvor
346	WRITE(numout,*)' - mesh = ', sn_snd_crtw%clvgrd
347	ENDIF
348
349	! ! allocate sbccpl arrays
350	IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' )
351
352	! ================================ !
353	! Define the receive interface !
354	! ================================ !
355	nrcvinfo(:) = OASIS_idle ! needed by nrcvinfo(jpr_otx1) if we do not receive ocean stress
356
357	! for each field: define the OASIS name (srcv(:)%clname)
358	! define receive or not from the namelist parameters (srcv(:)%laction)
359	! define the north fold type of lbc (srcv(:)%nsgn)
360
361	! default definitions of srcv
362	srcv(:)%laction = .FALSE. ; srcv(:)%clgrid = 'T' ; srcv(:)%nsgn = 1. ; srcv(:)%nct = 1
363
364	! ! ------------------------- !
365	! ! ice and ocean wind stress !
366	! ! ------------------------- !
367	! ! Name
368	srcv(jpr_otx1)%clname = 'O_OTaux1' ! 1st ocean component on grid ONE (T or U)
369	srcv(jpr_oty1)%clname = 'O_OTauy1' ! 2nd - - - -
370	srcv(jpr_otz1)%clname = 'O_OTauz1' ! 3rd - - - -
371	srcv(jpr_otx2)%clname = 'O_OTaux2' ! 1st ocean component on grid TWO (V)
372	srcv(jpr_oty2)%clname = 'O_OTauy2' ! 2nd - - - -
373	srcv(jpr_otz2)%clname = 'O_OTauz2' ! 3rd - - - -
374	!
375	srcv(jpr_itx1)%clname = 'O_ITaux1' ! 1st ice component on grid ONE (T, F, I or U)
376	srcv(jpr_ity1)%clname = 'O_ITauy1' ! 2nd - - - -
377	srcv(jpr_itz1)%clname = 'O_ITauz1' ! 3rd - - - -
378	srcv(jpr_itx2)%clname = 'O_ITaux2' ! 1st ice component on grid TWO (V)
379	srcv(jpr_ity2)%clname = 'O_ITauy2' ! 2nd - - - -
380	srcv(jpr_itz2)%clname = 'O_ITauz2' ! 3rd - - - -
381	!
382	! Vectors: change of sign at north fold ONLY if on the local grid
383	IF( TRIM( sn_rcv_tau%cldes ) == 'oce only' .OR. TRIM(sn_rcv_tau%cldes ) == 'oce and ice') THEN ! avoid working with the atmospheric fields if they are not coupled
384	IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) srcv(jpr_otx1:jpr_itz2)%nsgn = -1.
385
386	! ! Set grid and action
387	SELECT CASE( TRIM( sn_rcv_tau%clvgrd ) ) ! 'T', 'U,V', 'U,V,I', 'U,V,F', 'T,I', 'T,F', or 'T,U,V'
388	CASE( 'T' )
389	srcv(jpr_otx1:jpr_itz2)%clgrid = 'T' ! oce and ice components given at T-point
390	srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1
391	srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1
392	CASE( 'U,V' )
393	srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point
394	srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point
395	srcv(jpr_itx1:jpr_itz1)%clgrid = 'U' ! ice components given at U-point
396	srcv(jpr_itx2:jpr_itz2)%clgrid = 'V' ! and V-point
397	srcv(jpr_otx1:jpr_itz2)%laction = .TRUE. ! receive oce and ice components on both grid 1 & 2
398	CASE( 'U,V,T' )
399	srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point
400	srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point
401	srcv(jpr_itx1:jpr_itz1)%clgrid = 'T' ! ice components given at T-point
402	srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2
403	srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only
404	CASE( 'U,V,I' )
405	srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point
406	srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point
407	srcv(jpr_itx1:jpr_itz1)%clgrid = 'I' ! ice components given at I-point
408	srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2
409	srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only
410	CASE( 'U,V,F' )
411	srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point
412	srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point
413	srcv(jpr_itx1:jpr_itz1)%clgrid = 'F' ! ice components given at F-point
414	srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2
415	srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only
416	CASE( 'T,I' )
417	srcv(jpr_otx1:jpr_itz2)%clgrid = 'T' ! oce and ice components given at T-point
418	srcv(jpr_itx1:jpr_itz1)%clgrid = 'I' ! ice components given at I-point
419	srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1
420	srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1
421	CASE( 'T,F' )
422	srcv(jpr_otx1:jpr_itz2)%clgrid = 'T' ! oce and ice components given at T-point
423	srcv(jpr_itx1:jpr_itz1)%clgrid = 'F' ! ice components given at F-point
424	srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1
425	srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1
426	CASE( 'T,U,V' )
427	srcv(jpr_otx1:jpr_otz1)%clgrid = 'T' ! oce components given at T-point
428	srcv(jpr_itx1:jpr_itz1)%clgrid = 'U' ! ice components given at U-point
429	srcv(jpr_itx2:jpr_itz2)%clgrid = 'V' ! and V-point
430	srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1 only
431	srcv(jpr_itx1:jpr_itz2)%laction = .TRUE. ! receive ice components on grid 1 & 2
432	CASE default
433	CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_tau%clvgrd' )
434	END SELECT
435	!
436	IF( TRIM( sn_rcv_tau%clvref ) == 'spherical' ) & ! spherical: 3rd component not received
437	& srcv( (/jpr_otz1, jpr_otz2, jpr_itz1, jpr_itz2/) )%laction = .FALSE.
438	!
439	IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) THEN ! already on local grid -> no need of the second grid
440	srcv(jpr_otx2:jpr_otz2)%laction = .FALSE.
441	srcv(jpr_itx2:jpr_itz2)%laction = .FALSE.
442	srcv(jpr_oty1)%clgrid = srcv(jpr_oty2)%clgrid ! not needed but cleaner...
443	srcv(jpr_ity1)%clgrid = srcv(jpr_ity2)%clgrid ! not needed but cleaner...
444	ENDIF
445	!
446	IF( TRIM( sn_rcv_tau%cldes ) /= 'oce and ice' ) THEN ! 'oce and ice' case ocean stress on ocean mesh used
447	srcv(jpr_itx1:jpr_itz2)%laction = .FALSE. ! ice components not received
448	srcv(jpr_itx1)%clgrid = 'U' ! ocean stress used after its transformation
449	srcv(jpr_ity1)%clgrid = 'V' ! i.e. it is always at U- & V-points for i- & j-comp. resp.
450	ENDIF
451	ENDIF
452
453	! ! ------------------------- !
454	! ! freshwater budget ! E-P
455	! ! ------------------------- !
456	! we suppose that atmosphere modele do not make the difference between precipiration (liquide or solid)
457	! over ice of free ocean within the same atmospheric cell.cd
458	srcv(jpr_rain)%clname = 'OTotRain' ! Rain = liquid precipitation
459	srcv(jpr_snow)%clname = 'OTotSnow' ! Snow = solid precipitation
460	srcv(jpr_tevp)%clname = 'OTotEvap' ! total evaporation (over oce + ice sublimation)
461	srcv(jpr_ievp)%clname = 'OIceEvap' ! evaporation over ice = sublimation
462	srcv(jpr_sbpr)%clname = 'OSubMPre' ! sublimation - liquid precipitation - solid precipitation
463	srcv(jpr_semp)%clname = 'OISubMSn' ! ice solid water budget = sublimation - solid precipitation
464	srcv(jpr_oemp)%clname = 'OOEvaMPr' ! ocean water budget = ocean Evap - ocean precip
465	SELECT CASE( TRIM( sn_rcv_emp%cldes ) )
466	CASE( 'none' ) ! nothing to do
467	CASE( 'oce only' ) ; srcv(jpr_oemp)%laction = .TRUE.
468	CASE( 'conservative' )
469	srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE.
470	IF ( k_ice <= 1 ) srcv(jpr_ievp)%laction = .FALSE.
471	CASE( 'oce and ice' ) ; srcv( (/jpr_ievp, jpr_sbpr, jpr_semp, jpr_oemp/) )%laction = .TRUE.
472	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' )
473	END SELECT
474	!
475	! ! ------------------------- !
476	! ! Runoffs & Calving !
477	! ! ------------------------- !
478	srcv(jpr_rnf )%clname = 'O_Runoff'
479	IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN
480	srcv(jpr_rnf)%laction = .TRUE.
481	l_rnfcpl = .TRUE. ! -> no need to read runoffs in sbcrnf
482	ln_rnf = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas
483	IF(lwp) WRITE(numout,*)
484	IF(lwp) WRITE(numout,*) ' runoffs received from oasis -> force ln_rnf = ', ln_rnf
485	ENDIF
486	!
487	srcv(jpr_cal)%clname = 'OCalving' ; IF( TRIM( sn_rcv_cal%cldes) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE.
488	srcv(jpr_isf)%clname = 'OIcshelf' ; IF( TRIM( sn_rcv_isf%cldes) == 'coupled' ) srcv(jpr_isf)%laction = .TRUE.
489	srcv(jpr_icb)%clname = 'OIceberg' ; IF( TRIM( sn_rcv_icb%cldes) == 'coupled' ) srcv(jpr_icb)%laction = .TRUE.
490
491	IF( srcv(jpr_isf)%laction .AND. ln_isf ) THEN
492	l_isfcpl = .TRUE. ! -> no need to read isf in sbcisf
493	IF(lwp) WRITE(numout,*)
494	IF(lwp) WRITE(numout,*) ' iceshelf received from oasis '
495	ENDIF
496	!
497	! ! ------------------------- !
498	! ! non solar radiation ! Qns
499	! ! ------------------------- !
500	srcv(jpr_qnsoce)%clname = 'O_QnsOce'
501	srcv(jpr_qnsice)%clname = 'O_QnsIce'
502	srcv(jpr_qnsmix)%clname = 'O_QnsMix'
503	SELECT CASE( TRIM( sn_rcv_qns%cldes ) )
504	CASE( 'none' ) ! nothing to do
505	CASE( 'oce only' ) ; srcv( jpr_qnsoce )%laction = .TRUE.
506	CASE( 'conservative' ) ; srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE.
507	CASE( 'oce and ice' ) ; srcv( (/jpr_qnsice, jpr_qnsoce/) )%laction = .TRUE.
508	CASE( 'mixed oce-ice' ) ; srcv( jpr_qnsmix )%laction = .TRUE.
509	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qns%cldes' )
510	END SELECT
511	IF( TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' .AND. nn_cats_cpl > 1 ) &
512	CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qns%cldes not currently allowed to be mixed oce-ice for multi-category ice' )
513	!
514	! ! ------------------------- !
515	! ! solar radiation ! Qsr
516	! ! ------------------------- !
517	srcv(jpr_qsroce)%clname = 'O_QsrOce'
518	srcv(jpr_qsrice)%clname = 'O_QsrIce'
519	srcv(jpr_qsrmix)%clname = 'O_QsrMix'
520	SELECT CASE( TRIM( sn_rcv_qsr%cldes ) )
521	CASE( 'none' ) ! nothing to do
522	CASE( 'oce only' ) ; srcv( jpr_qsroce )%laction = .TRUE.
523	CASE( 'conservative' ) ; srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE.
524	CASE( 'oce and ice' ) ; srcv( (/jpr_qsrice, jpr_qsroce/) )%laction = .TRUE.
525	CASE( 'mixed oce-ice' ) ; srcv( jpr_qsrmix )%laction = .TRUE.
526	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qsr%cldes' )
527	END SELECT
528	IF( TRIM( sn_rcv_qsr%cldes ) == 'mixed oce-ice' .AND. nn_cats_cpl > 1 ) &
529	CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qsr%cldes not currently allowed to be mixed oce-ice for multi-category ice' )
530	!
531	! ! ------------------------- !
532	! ! non solar sensitivity ! d(Qns)/d(T)
533	! ! ------------------------- !
534	srcv(jpr_dqnsdt)%clname = 'O_dQnsdT'
535	IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'coupled' ) srcv(jpr_dqnsdt)%laction = .TRUE.
536	!
537	! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique
538	IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' ) &
539	& CALL ctl_stop( 'sbc_cpl_init: namsbc_cpl namelist mismatch between sn_rcv_qns%cldes and sn_rcv_dqnsdt%cldes' )
540	!
541	! ! ------------------------- !
542	! ! 10m wind module !
543	! ! ------------------------- !
544	srcv(jpr_w10m)%clname = 'O_Wind10' ; IF( TRIM(sn_rcv_w10m%cldes ) == 'coupled' ) srcv(jpr_w10m)%laction = .TRUE.
545	!
546	! ! ------------------------- !
547	! ! wind stress module !
548	! ! ------------------------- !
549	srcv(jpr_taum)%clname = 'O_TauMod' ; IF( TRIM(sn_rcv_taumod%cldes) == 'coupled' ) srcv(jpr_taum)%laction = .TRUE.
550	lhftau = srcv(jpr_taum)%laction
551	!
552	! ! ------------------------- !
553	! ! Atmospheric CO2 !
554	! ! ------------------------- !
555	srcv(jpr_co2 )%clname = 'O_AtmCO2'
556	IF( TRIM(sn_rcv_co2%cldes ) == 'coupled' ) THEN
557	srcv(jpr_co2 )%laction = .TRUE.
558	l_co2cpl = .TRUE.
559	IF(lwp) WRITE(numout,*)
560	IF(lwp) WRITE(numout,*) ' Atmospheric pco2 received from oasis '
561	IF(lwp) WRITE(numout,*)
562	ENDIF
563	!
564	! ! ------------------------- !
565	! ! Mean Sea Level Pressure !
566	! ! ------------------------- !
567	srcv(jpr_mslp)%clname = 'O_MSLP' ; IF( TRIM(sn_rcv_mslp%cldes ) == 'coupled' ) srcv(jpr_mslp)%laction = .TRUE.
568	!
569	! ! ------------------------- !
570	! ! ice topmelt and botmelt !
571	! ! ------------------------- !
572	srcv(jpr_topm )%clname = 'OTopMlt'
573	srcv(jpr_botm )%clname = 'OBotMlt'
574	IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN
575	IF ( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN
576	srcv(jpr_topm:jpr_botm)%nct = nn_cats_cpl
577	ELSE
578	CALL ctl_stop( 'sbc_cpl_init: sn_rcv_iceflx%clcat should always be set to yes currently' )
579	ENDIF
580	srcv(jpr_topm:jpr_botm)%laction = .TRUE.
581	ENDIF
582	! ! ------------------------- !
583	! ! ice skin temperature !
584	! ! ------------------------- !
585	srcv(jpr_ts_ice)%clname = 'OTsfIce' ! needed by Met Office
586	IF ( TRIM( sn_rcv_ts_ice%cldes ) == 'ice' ) srcv(jpr_ts_ice)%laction = .TRUE.
587	IF ( TRIM( sn_rcv_ts_ice%clcat ) == 'yes' ) srcv(jpr_ts_ice)%nct = nn_cats_cpl
588	IF ( TRIM( sn_rcv_emp%clcat ) == 'yes' ) srcv(jpr_ievp)%nct = nn_cats_cpl
589
590	! ! ------------------------- !
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 (needed by Met-Office)
833	#if defined key_si3 \|\| defined key_cice
834	a_i_last_couple(:,:,:) = 0._wp
835	#endif
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), DIMENSION(jpi,jpj) :: zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw
1649	REAL(wp), DIMENSION(jpi,jpj) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip , zevap_oce, zdevap_ice
1650	REAL(wp), DIMENSION(jpi,jpj) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice
1651	REAL(wp), DIMENSION(jpi,jpj) :: zevap_ice_total
1652	REAL(wp), DIMENSION(jpi,jpj,jpl) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice, zqtr_ice_top, ztsu
1653	REAL(wp), DIMENSION(jpi,jpj) :: ztri, zcloud_fra
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	IF (ln_scale_ice_flux) THEN ! typically met-office requirements
1687	IF (sn_rcv_emp%clcat == 'yes') THEN
1688	WHERE( a_i(:,:,:) > 1.e-10 ) ; zevap_ice(:,:,:) = frcv(jpr_ievp)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:)
1689	ELSEWHERE ; zevap_ice(:,:,:) = 0._wp
1690	END WHERE
1691	WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) / picefr(:,:)
1692	ELSEWHERE ; zevap_ice_total(:,:) = 0._wp
1693	END WHERE
1694	ELSE
1695	WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1) * SUM( a_i_last_couple, dim=3 ) / picefr(:,:)
1696	ELSEWHERE ; zevap_ice(:,:,1) = 0._wp
1697	END WHERE
1698	zevap_ice_total(:,:) = zevap_ice(:,:,1)
1699	DO jl = 2, jpl
1700	zevap_ice(:,:,jl) = zevap_ice(:,:,1)
1701	ENDDO
1702	ENDIF
1703	ELSE
1704	IF (sn_rcv_emp%clcat == 'yes') THEN
1705	zevap_ice(:,:,1:jpl) = frcv(jpr_ievp)%z3(:,:,1:jpl)
1706	WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) / picefr(:,:)
1707	ELSEWHERE ; zevap_ice_total(:,:) = 0._wp
1708	END WHERE
1709	ELSE
1710	zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1)
1711	zevap_ice_total(:,:) = zevap_ice(:,:,1)
1712	DO jl = 2, jpl
1713	zevap_ice(:,:,jl) = zevap_ice(:,:,1)
1714	ENDDO
1715	ENDIF
1716	ENDIF
1717
1718	IF ( TRIM( sn_rcv_emp%cldes ) == 'conservative' ) THEN
1719	! For conservative case zemp_ice has not been defined yet. Do it now.
1720	zemp_ice(:,:) = zevap_ice_total(:,:) * picefr(:,:) - frcv(jpr_snow)%z3(:,:,1) * picefr(:,:)
1721	ENDIF
1722
1723	! zsnw = snow fraction over ice after wind blowing (=picefr if no blowing)
1724	zsnw(:,:) = 0._wp ; CALL ice_thd_snwblow( ziceld, zsnw )
1725
1726	! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- !
1727	zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( picefr(:,:) - zsnw(:,:) ) ! emp_ice = A * sublimation - zsnw * sprecip
1728	zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:) ! emp_oce = emp_tot - emp_ice
1729
1730	! --- evaporation over ocean (used later for qemp) --- !
1731	zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - zevap_ice_total(:,:) * picefr(:,:)
1732
1733	! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0
1734	! therefore, sublimation is not redistributed over the ice categories when no subgrid scale fluxes are provided by atm.
1735	zdevap_ice(:,:) = 0._wp
1736
1737	! --- Continental fluxes --- !
1738	IF( srcv(jpr_rnf)%laction ) THEN ! runoffs (included in emp later on)
1739	rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
1740	ENDIF
1741	IF( srcv(jpr_cal)%laction ) THEN ! calving (put in emp_tot and emp_oce)
1742	zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
1743	zemp_oce(:,:) = zemp_oce(:,:) - frcv(jpr_cal)%z3(:,:,1)
1744	ENDIF
1745	IF( srcv(jpr_icb)%laction ) THEN ! iceberg added to runoffs
1746	fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1)
1747	rnf(:,:) = rnf(:,:) + fwficb(:,:)
1748	ENDIF
1749	IF( srcv(jpr_isf)%laction ) THEN ! iceshelf (fwfisf <0 mean melting)
1750	fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1)
1751	ENDIF
1752
1753	IF( ln_mixcpl ) THEN
1754	emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:)
1755	emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:)
1756	emp_oce(:,:) = emp_oce(:,:) * xcplmask(:,:,0) + zemp_oce(:,:) * zmsk(:,:)
1757	sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:)
1758	tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:)
1759	DO jl = 1, jpl
1760	evap_ice (:,:,jl) = evap_ice (:,:,jl) * xcplmask(:,:,0) + zevap_ice (:,:,jl) * zmsk(:,:)
1761	devap_ice(:,:,jl) = devap_ice(:,:,jl) * xcplmask(:,:,0) + zdevap_ice(:,:) * zmsk(:,:)
1762	END DO
1763	ELSE
1764	emp_tot (:,:) = zemp_tot (:,:)
1765	emp_ice (:,:) = zemp_ice (:,:)
1766	emp_oce (:,:) = zemp_oce (:,:)
1767	sprecip (:,:) = zsprecip (:,:)
1768	tprecip (:,:) = ztprecip (:,:)
1769	evap_ice(:,:,:) = zevap_ice(:,:,:)
1770	DO jl = 1, jpl
1771	devap_ice(:,:,jl) = zdevap_ice(:,:)
1772	END DO
1773	ENDIF
1774
1775	#else
1776	zsnw(:,:) = picefr(:,:)
1777	! --- Continental fluxes --- !
1778	IF( srcv(jpr_rnf)%laction ) THEN ! runoffs (included in emp later on)
1779	rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
1780	ENDIF
1781	IF( srcv(jpr_cal)%laction ) THEN ! calving (put in emp_tot)
1782	zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
1783	ENDIF
1784	IF( srcv(jpr_icb)%laction ) THEN ! iceberg added to runoffs
1785	fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1)
1786	rnf(:,:) = rnf(:,:) + fwficb(:,:)
1787	ENDIF
1788	IF( srcv(jpr_isf)%laction ) THEN ! iceshelf (fwfisf <0 mean melting)
1789	fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1)
1790	ENDIF
1791	!
1792	IF( ln_mixcpl ) THEN
1793	emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:)
1794	emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:)
1795	sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:)
1796	tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:)
1797	ELSE
1798	emp_tot(:,:) = zemp_tot(:,:)
1799	emp_ice(:,:) = zemp_ice(:,:)
1800	sprecip(:,:) = zsprecip(:,:)
1801	tprecip(:,:) = ztprecip(:,:)
1802	ENDIF
1803	!
1804	#endif
1805
1806	! outputs
1807	!! IF( srcv(jpr_rnf)%laction ) CALL iom_put( 'runoffs' , rnf(:,:) * tmask(:,:,1) ) ! runoff
1808	!! IF( srcv(jpr_isf)%laction ) CALL iom_put( 'iceshelf_cea', -fwfisf(:,:) * tmask(:,:,1) ) ! iceshelf
1809	IF( srcv(jpr_cal)%laction ) CALL iom_put( 'calving_cea' , frcv(jpr_cal)%z3(:,:,1) * tmask(:,:,1) ) ! calving
1810	IF( srcv(jpr_icb)%laction ) CALL iom_put( 'iceberg_cea' , frcv(jpr_icb)%z3(:,:,1) * tmask(:,:,1) ) ! icebergs
1811	IF( iom_use('snowpre') ) CALL iom_put( 'snowpre' , sprecip(:,:) ) ! Snow
1812	IF( iom_use('precip') ) CALL iom_put( 'precip' , tprecip(:,:) ) ! total precipitation
1813	IF( iom_use('rain') ) CALL iom_put( 'rain' , tprecip(:,:) - sprecip(:,:) ) ! liquid precipitation
1814	IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average)
1815	IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average)
1816	IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * tmask(:,:,1) ) ! Sublimation over sea-ice (cell average)
1817	IF( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) &
1818	& - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average)
1819	! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf
1820	!
1821	! ! ========================= !
1822	SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) ! non solar heat fluxes ! (qns)
1823	! ! ========================= !
1824	CASE( 'oce only' ) ! the required field is directly provided
1825	zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)
1826	! For Met Office sea ice non-solar fluxes are already delt with by JULES so setting to zero
1827	! here so the only flux is the ocean only one.
1828	zqns_ice(:,:,:) = 0._wp
1829	CASE( 'conservative' ) ! the required fields are directly provided
1830	zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
1831	IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
1832	zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl)
1833	ELSE
1834	DO jl = 1, jpl
1835	zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) ! Set all category values equal
1836	END DO
1837	ENDIF
1838	CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes
1839	zqns_tot(:,:) = ziceld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)
1840	IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
1841	DO jl=1,jpl
1842	zqns_tot(:,: ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)
1843	zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl)
1844	ENDDO
1845	ELSE
1846	qns_tot(:,:) = qns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
1847	DO jl = 1, jpl
1848	zqns_tot(:,: ) = zqns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
1849	zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)
1850	END DO
1851	ENDIF
1852	CASE( 'mixed oce-ice' ) ! the ice flux is cumputed from the total flux, the SST and ice informations
1853	! NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED
1854	zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1)
1855	zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) &
1856	& + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * ziceld(:,:) &
1857	& + pist(:,:,1) * picefr(:,:) ) )
1858	END SELECT
1859	!
1860	! --- calving (removed from qns_tot) --- !
1861	IF( srcv(jpr_cal)%laction ) zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) * rLfus ! remove latent heat of calving
1862	! we suppose it melts at 0deg, though it should be temp. of surrounding ocean
1863	! --- iceberg (removed from qns_tot) --- !
1864	IF( srcv(jpr_icb)%laction ) zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_icb)%z3(:,:,1) * rLfus ! remove latent heat of iceberg melting
1865
1866	#if defined key_si3
1867	! --- non solar flux over ocean --- !
1868	! note: ziceld cannot be = 0 since we limit the ice concentration to amax
1869	zqns_oce = 0._wp
1870	WHERE( ziceld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / ziceld(:,:)
1871
1872	! Heat content per unit mass of snow (J/kg)
1873	WHERE( SUM( a_i, dim=3 ) > 1.e-10 ) ; zcptsnw(:,:) = rcpi * SUM( (tn_ice - rt0) * a_i, dim=3 ) / SUM( a_i, dim=3 )
1874	ELSEWHERE ; zcptsnw(:,:) = zcptn(:,:)
1875	ENDWHERE
1876	! Heat content per unit mass of rain (J/kg)
1877	zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * ziceld(:,:) )
1878
1879	! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- !
1880	zqprec_ice(:,:) = rhos * ( zcptsnw(:,:) - rLfus )
1881
1882	! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- !
1883	DO jl = 1, jpl
1884	zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * rcpi ) but atm. does not take it into account
1885	END DO
1886
1887	! --- heat flux associated with emp (W/m2) --- !
1888	zqemp_oce(:,:) = - zevap_oce(:,:) * zcptn (:,:) & ! evap
1889	& + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptrain(:,:) & ! liquid precip
1890	& + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptsnw (:,:) - rLfus ) ! solid precip over ocean + snow melting
1891	zqemp_ice(:,:) = zsprecip(:,:) * zsnw * ( zcptsnw (:,:) - rLfus ) ! solid precip over ice (qevap_ice=0 since atm. does not take it into account)
1892	!! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * zcptsnw (:,:) & ! ice evap
1893	!! & + zsprecip(:,:) * zsnw * zqprec_ice(:,:) * r1_rhos ! solid precip over ice
1894
1895	! --- total non solar flux (including evap/precip) --- !
1896	zqns_tot(:,:) = zqns_tot(:,:) + zqemp_ice(:,:) + zqemp_oce(:,:)
1897
1898	! --- in case both coupled/forced are active, we must mix values --- !
1899	IF( ln_mixcpl ) THEN
1900	qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:)
1901	qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:)
1902	DO jl=1,jpl
1903	qns_ice (:,:,jl) = qns_ice (:,:,jl) * xcplmask(:,:,0) + zqns_ice (:,:,jl)* zmsk(:,:)
1904	qevap_ice(:,:,jl) = qevap_ice(:,:,jl) * xcplmask(:,:,0) + zqevap_ice(:,:,jl)* zmsk(:,:)
1905	ENDDO
1906	qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:)
1907	qemp_oce (:,:) = qemp_oce(:,:) * xcplmask(:,:,0) + zqemp_oce(:,:)* zmsk(:,:)
1908	qemp_ice (:,:) = qemp_ice(:,:) * xcplmask(:,:,0) + zqemp_ice(:,:)* zmsk(:,:)
1909	ELSE
1910	qns_tot (:,: ) = zqns_tot (:,: )
1911	qns_oce (:,: ) = zqns_oce (:,: )
1912	qns_ice (:,:,:) = zqns_ice (:,:,:)
1913	qevap_ice(:,:,:) = zqevap_ice(:,:,:)
1914	qprec_ice(:,: ) = zqprec_ice(:,: )
1915	qemp_oce (:,: ) = zqemp_oce (:,: )
1916	qemp_ice (:,: ) = zqemp_ice (:,: )
1917	ENDIF
1918
1919	#else
1920	zcptsnw (:,:) = zcptn(:,:)
1921	zcptrain(:,:) = zcptn(:,:)
1922
1923	! clem: this formulation is certainly wrong... but better than it was...
1924	zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with:
1925	& - ( ziceld(:,:) * zsprecip(:,:) * rLfus ) & ! remove the latent heat flux of solid precip. melting
1926	& - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST)
1927	& - zemp_ice(:,:) ) * zcptn(:,:)
1928
1929	IF( ln_mixcpl ) THEN
1930	qns_tot(:,:) = qns(:,:) * ziceld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk
1931	qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:)
1932	DO jl=1,jpl
1933	qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:)
1934	ENDDO
1935	ELSE
1936	qns_tot(:,: ) = zqns_tot(:,: )
1937	qns_ice(:,:,:) = zqns_ice(:,:,:)
1938	ENDIF
1939
1940	#endif
1941	! outputs
1942	IF ( srcv(jpr_cal)%laction ) CALL iom_put('hflx_cal_cea' , - frcv(jpr_cal)%z3(:,:,1) * rLfus ) ! latent heat from calving
1943	IF ( srcv(jpr_icb)%laction ) CALL iom_put('hflx_icb_cea' , - frcv(jpr_icb)%z3(:,:,1) * rLfus ) ! latent heat from icebergs melting
1944	IF ( iom_use('hflx_rain_cea') ) CALL iom_put('hflx_rain_cea' , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) ! heat flux from rain (cell average)
1945	IF ( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea' , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) &
1946	& * picefr(:,:) ) * zcptn(:,:) * tmask(:,:,1) ) ! heat flux from evap (cell average)
1947	IF ( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea' , sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) ) ! heat flux from snow (cell average)
1948	IF ( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) &
1949	& * ( 1._wp - zsnw(:,:) ) ) ! heat flux from snow (over ocean)
1950	IF ( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) &
1951	& * zsnw(:,:) ) ! heat flux from snow (over ice)
1952	! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp.
1953	!
1954	! ! ========================= !
1955	SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) ! solar heat fluxes ! (qsr)
1956	! ! ========================= !
1957	CASE( 'oce only' )
1958	zqsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) )
1959	! For Met Office sea ice solar fluxes are already delt with by JULES so setting to zero
1960	! here so the only flux is the ocean only one.
1961	zqsr_ice(:,:,:) = 0._wp
1962	CASE( 'conservative' )
1963	zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)
1964	IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
1965	zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl)
1966	ELSE
1967	! Set all category values equal for the moment
1968	DO jl = 1, jpl
1969	zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
1970	END DO
1971	ENDIF
1972	zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)
1973	zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1)
1974	CASE( 'oce and ice' )
1975	zqsr_tot(:,: ) = ziceld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)
1976	IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
1977	DO jl = 1, jpl
1978	zqsr_tot(:,: ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)
1979	zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl)
1980	END DO
1981	ELSE
1982	qsr_tot(:,: ) = qsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
1983	DO jl = 1, jpl
1984	zqsr_tot(:,: ) = zqsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
1985	zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
1986	END DO
1987	ENDIF
1988	CASE( 'mixed oce-ice' )
1989	zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)
1990	! NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED
1991	! Create solar heat flux over ice using incoming solar heat flux and albedos
1992	! ( see OASIS3 user guide, 5th edition, p39 )
1993	zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) &
1994	& / ( 1.- ( alb_oce_mix(:,: ) * ziceld(:,:) &
1995	& + palbi (:,:,1) * picefr(:,:) ) )
1996	CASE( 'none' ) ! Not available as for now: needs additional coding
1997	! ! since fields received, here zqsr_tot, are not defined with none option
1998	CALL ctl_stop( 'STOP', 'sbccpl/sbc_cpl_ice_flx: some fields are not defined. Change sn_rcv_qsr value in namelist namsbc_cpl' )
1999	END SELECT
2000	IF( ln_dm2dc .AND. ln_cpl ) THEN ! modify qsr to include the diurnal cycle
2001	zqsr_tot(:,: ) = sbc_dcy( zqsr_tot(:,: ) )
2002	DO jl = 1, jpl
2003	zqsr_ice(:,:,jl) = sbc_dcy( zqsr_ice(:,:,jl) )
2004	END DO
2005	ENDIF
2006
2007	#if defined key_si3
2008	! --- solar flux over ocean --- !
2009	! note: ziceld cannot be = 0 since we limit the ice concentration to amax
2010	zqsr_oce = 0._wp
2011	WHERE( ziceld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / ziceld(:,:)
2012
2013	IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:)
2014	ELSE ; qsr_oce(:,:) = zqsr_oce(:,:) ; ENDIF
2015	#endif
2016
2017	IF( ln_mixcpl ) THEN
2018	qsr_tot(:,:) = qsr(:,:) * ziceld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk
2019	qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) + zqsr_tot(:,:)* zmsk(:,:)
2020	DO jl = 1, jpl
2021	qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) + zqsr_ice(:,:,jl)* zmsk(:,:)
2022	END DO
2023	ELSE
2024	qsr_tot(:,: ) = zqsr_tot(:,: )
2025	qsr_ice(:,:,:) = zqsr_ice(:,:,:)
2026	ENDIF
2027
2028	! ! ========================= !
2029	SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) ! d(qns)/dt !
2030	! ! ========================= !
2031	CASE ('coupled')
2032	IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN
2033	zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)
2034	ELSE
2035	! Set all category values equal for the moment
2036	DO jl=1,jpl
2037	zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)
2038	ENDDO
2039	ENDIF
2040	CASE( 'none' )
2041	zdqns_ice(:,:,:) = 0._wp
2042	END SELECT
2043
2044	IF( ln_mixcpl ) THEN
2045	DO jl=1,jpl
2046	dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:)
2047	ENDDO
2048	ELSE
2049	dqns_ice(:,:,:) = zdqns_ice(:,:,:)
2050	ENDIF
2051
2052	#if defined key_si3
2053	! ! ========================= !
2054	SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! ice topmelt and botmelt !
2055	! ! ========================= !
2056	CASE ('coupled')
2057	IF (ln_scale_ice_flux) THEN
2058	WHERE( a_i(:,:,:) > 1.e-10_wp )
2059	qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:)
2060	qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:)
2061	ELSEWHERE
2062	qml_ice(:,:,:) = 0.0_wp
2063	qcn_ice(:,:,:) = 0.0_wp
2064	END WHERE
2065	ELSE
2066	qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:)
2067	qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:)
2068	ENDIF
2069	END SELECT
2070	!!$ ! ! ========================= !
2071	!!$ SELECT CASE( TRIM( sn_rcv_clouds%cldes ) ) ! cloud fraction !
2072	!!$ ! ! ========================= !
2073	!!$ cloud_fra(:,:) = frcv(jpr_clfra)*z3(:,:,1)
2074	!!$ END SELECT
2075	zcloud_fra(:,:) = cldf_ice ! should be real cloud fraction instead (as in the bulk) but needs to be read from atm.
2076	IF( ln_mixcpl ) THEN
2077	cloud_fra(:,:) = cloud_fra(:,:) * xcplmask(:,:,0) + zcloud_fra(:,:)* zmsk(:,:)
2078	ELSE
2079	cloud_fra(:,:) = zcloud_fra(:,:)
2080	ENDIF
2081	! ! ========================= !
2082	! ! Transmitted Qsr ! [W/m2]
2083	! ! ========================= !
2084	IF( .NOT.ln_cndflx ) THEN !== No conduction flux as surface forcing ==!
2085	!
2086	! ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81)
2087	! ! should be real cloud fraction instead (as in the bulk) but needs to be read from atm.
2088	ztri(:,:) = 0.18 * ( 1.0 - zcloud_fra(:,:) ) + 0.35 * zcloud_fra(:,:) ! surface transmission when hi>10cm (Grenfell Maykut 77)
2089	!
2090	DO jl = 1, jpl
2091	WHERE ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) < 0.1_wp ) ! linear decrease from hi=0 to 10cm
2092	zqtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) )
2093	ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp ) ! constant (ztri) when hi>10cm
2094	zqtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ztri(:,:)
2095	ELSEWHERE ! zero when hs>0
2096	zqtr_ice_top(:,:,jl) = 0._wp
2097	END WHERE
2098	ENDDO
2099	!
2100	ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN !== conduction flux as surface forcing ==!
2101	!
2102	! ! ===> here we must receive the qtr_ice_top array from the coupler
2103	! for now just assume zero (fully opaque ice)
2104	zqtr_ice_top(:,:,:) = 0._wp
2105	!
2106	ENDIF
2107	!
2108	IF( ln_mixcpl ) THEN
2109	DO jl=1,jpl
2110	qtr_ice_top(:,:,jl) = qtr_ice_top(:,:,jl) * xcplmask(:,:,0) + zqtr_ice_top(:,:,jl) * zmsk(:,:)
2111	ENDDO
2112	ELSE
2113	qtr_ice_top(:,:,:) = zqtr_ice_top(:,:,:)
2114	ENDIF
2115	! ! ================== !
2116	! ! ice skin temp. !
2117	! ! ================== !
2118	! needed by Met Office
2119	IF( srcv(jpr_ts_ice)%laction ) THEN
2120	WHERE ( frcv(jpr_ts_ice)%z3(:,:,:) > 0.0 ) ; ztsu(:,:,:) = 0.0 + rt0
2121	ELSEWHERE( frcv(jpr_ts_ice)%z3(:,:,:) < -60. ) ; ztsu(:,:,:) = -60. + rt0
2122	ELSEWHERE ; ztsu(:,:,:) = frcv(jpr_ts_ice)%z3(:,:,:) + rt0
2123	END WHERE
2124	!
2125	IF( ln_mixcpl ) THEN
2126	DO jl=1,jpl
2127	pist(:,:,jl) = pist(:,:,jl) * xcplmask(:,:,0) + ztsu(:,:,jl) * zmsk(:,:)
2128	ENDDO
2129	ELSE
2130	pist(:,:,:) = ztsu(:,:,:)
2131	ENDIF
2132	!
2133	ENDIF
2134	!
2135	#endif
2136	!
2137	END SUBROUTINE sbc_cpl_ice_flx
2138
2139
2140	SUBROUTINE sbc_cpl_snd( kt )
2141	!!----------------------------------------------------------------------
2142	!! * ROUTINE sbc_cpl_snd *
2143	!!
2144	!! ** Purpose : provide the ocean-ice informations to the atmosphere
2145	!!
2146	!! ** Method : send to the atmosphere through a call to cpl_snd
2147	!! all the needed fields (as defined in sbc_cpl_init)
2148	!!----------------------------------------------------------------------
2149	INTEGER, INTENT(in) :: kt
2150	!
2151	INTEGER :: ji, jj, jl ! dummy loop indices
2152	INTEGER :: isec, info ! local integer
2153	REAL(wp) :: zumax, zvmax
2154	REAL(wp), DIMENSION(jpi,jpj) :: zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1
2155	REAL(wp), DIMENSION(jpi,jpj,jpl) :: ztmp3, ztmp4
2156	!!----------------------------------------------------------------------
2157	!
2158	isec = ( kt - nit000 ) * NINT( rdt ) ! date of exchanges
2159
2160	zfr_l(:,:) = 1.- fr_i(:,:)
2161	! ! ------------------------- !
2162	! ! Surface temperature ! in Kelvin
2163	! ! ------------------------- !
2164	IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN
2165
2166	IF ( nn_components == jp_iam_opa ) THEN
2167	ztmp1(:,:) = tsn(:,:,1,jp_tem) ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part
2168	ELSE
2169	! we must send the surface potential temperature
2170	IF( l_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) )
2171	ELSE ; ztmp1(:,:) = tsn(:,:,1,jp_tem)
2172	ENDIF
2173	!
2174	SELECT CASE( sn_snd_temp%cldes)
2175	CASE( 'oce only' ) ; ztmp1(:,:) = ztmp1(:,:) + rt0
2176	CASE( 'oce and ice' ) ; ztmp1(:,:) = ztmp1(:,:) + rt0
2177	SELECT CASE( sn_snd_temp%clcat )
2178	CASE( 'yes' )
2179	ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl)
2180	CASE( 'no' )
2181	WHERE( SUM( a_i, dim=3 ) /= 0. )
2182	ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 )
2183	ELSEWHERE
2184	ztmp3(:,:,1) = rt0
2185	END WHERE
2186	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
2187	END SELECT
2188	CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)
2189	SELECT CASE( sn_snd_temp%clcat )
2190	CASE( 'yes' )
2191	ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
2192	CASE( 'no' )
2193	ztmp3(:,:,:) = 0.0
2194	DO jl=1,jpl
2195	ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)
2196	ENDDO
2197	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
2198	END SELECT
2199	CASE( 'oce and weighted ice') ; ztmp1(:,:) = tsn(:,:,1,jp_tem) + rt0
2200	SELECT CASE( sn_snd_temp%clcat )
2201	CASE( 'yes' )
2202	ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
2203	CASE( 'no' )
2204	ztmp3(:,:,:) = 0.0
2205	DO jl=1,jpl
2206	ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)
2207	ENDDO
2208	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
2209	END SELECT
2210	CASE( 'mixed oce-ice' )
2211	ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)
2212	DO jl=1,jpl
2213	ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl)
2214	ENDDO
2215	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' )
2216	END SELECT
2217	ENDIF
2218	IF( ssnd(jps_toce)%laction ) CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
2219	IF( ssnd(jps_tice)%laction ) CALL cpl_snd( jps_tice, isec, ztmp3, info )
2220	IF( ssnd(jps_tmix)%laction ) CALL cpl_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
2221	ENDIF
2222	!
2223	! ! ------------------------- !
2224	! ! 1st layer ice/snow temp. !
2225	! ! ------------------------- !
2226	#if defined key_si3
2227	! needed by Met Office
2228	IF( ssnd(jps_ttilyr)%laction) THEN
2229	SELECT CASE( sn_snd_ttilyr%cldes)
2230	CASE ('weighted ice')
2231	ztmp3(:,:,1:jpl) = t1_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
2232	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ttilyr%cldes' )
2233	END SELECT
2234	IF( ssnd(jps_ttilyr)%laction ) CALL cpl_snd( jps_ttilyr, isec, ztmp3, info )
2235	ENDIF
2236	#endif
2237	! ! ------------------------- !
2238	! ! Albedo !
2239	! ! ------------------------- !
2240	IF( ssnd(jps_albice)%laction ) THEN ! ice
2241	SELECT CASE( sn_snd_alb%cldes )
2242	CASE( 'ice' )
2243	SELECT CASE( sn_snd_alb%clcat )
2244	CASE( 'yes' )
2245	ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl)
2246	CASE( 'no' )
2247	WHERE( SUM( a_i, dim=3 ) /= 0. )
2248	ztmp1(:,:) = SUM( alb_ice (:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) / SUM( a_i(:,:,1:jpl), dim=3 )
2249	ELSEWHERE
2250	ztmp1(:,:) = alb_oce_mix(:,:)
2251	END WHERE
2252	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%clcat' )
2253	END SELECT
2254	CASE( 'weighted ice' ) ;
2255	SELECT CASE( sn_snd_alb%clcat )
2256	CASE( 'yes' )
2257	ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
2258	CASE( 'no' )
2259	WHERE( fr_i (:,:) > 0. )
2260	ztmp1(:,:) = SUM ( alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 )
2261	ELSEWHERE
2262	ztmp1(:,:) = 0.
2263	END WHERE
2264	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ice%clcat' )
2265	END SELECT
2266	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' )
2267	END SELECT
2268
2269	SELECT CASE( sn_snd_alb%clcat )
2270	CASE( 'yes' )
2271	CALL cpl_snd( jps_albice, isec, ztmp3, info ) !-> MV this has never been checked in coupled mode
2272	CASE( 'no' )
2273	CALL cpl_snd( jps_albice, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
2274	END SELECT
2275	ENDIF
2276
2277	IF( ssnd(jps_albmix)%laction ) THEN ! mixed ice-ocean
2278	ztmp1(:,:) = alb_oce_mix(:,:) * zfr_l(:,:)
2279	DO jl = 1, jpl
2280	ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl)
2281	END DO
2282	CALL cpl_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
2283	ENDIF
2284	! ! ------------------------- !
2285	! ! Ice fraction & Thickness !
2286	! ! ------------------------- !
2287	! Send ice fraction field to atmosphere
2288	IF( ssnd(jps_fice)%laction ) THEN
2289	SELECT CASE( sn_snd_thick%clcat )
2290	CASE( 'yes' ) ; ztmp3(:,:,1:jpl) = a_i(:,:,1:jpl)
2291	CASE( 'no' ) ; ztmp3(:,:,1 ) = fr_i(:,: )
2292	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
2293	END SELECT
2294	IF( ssnd(jps_fice)%laction ) CALL cpl_snd( jps_fice, isec, ztmp3, info )
2295	ENDIF
2296
2297	#if defined key_si3 \|\| defined key_cice
2298	! If this coupling was successful then save ice fraction for use between coupling points.
2299	! This is needed for some calculations where the ice fraction at the last coupling point
2300	! is needed.
2301	IF( info == OASIS_Sent .OR. info == OASIS_ToRest .OR. &
2302	& info == OASIS_SentOut .OR. info == OASIS_ToRestOut ) THEN
2303	IF ( sn_snd_thick%clcat == 'yes' ) THEN
2304	a_i_last_couple(:,:,1:jpl) = a_i(:,:,1:jpl)
2305	ENDIF
2306	ENDIF
2307	#endif
2308
2309	IF( ssnd(jps_fice1)%laction ) THEN
2310	SELECT CASE( sn_snd_thick1%clcat )
2311	CASE( 'yes' ) ; ztmp3(:,:,1:jpl) = a_i(:,:,1:jpl)
2312	CASE( 'no' ) ; ztmp3(:,:,1 ) = fr_i(:,: )
2313	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick1%clcat' )
2314	END SELECT
2315	CALL cpl_snd( jps_fice1, isec, ztmp3, info )
2316	ENDIF
2317
2318	! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling)
2319	IF( ssnd(jps_fice2)%laction ) THEN
2320	ztmp3(:,:,1) = fr_i(:,:)
2321	IF( ssnd(jps_fice2)%laction ) CALL cpl_snd( jps_fice2, isec, ztmp3, info )
2322	ENDIF
2323
2324	! Send ice and snow thickness field
2325	IF( ssnd(jps_hice)%laction .OR. ssnd(jps_hsnw)%laction ) THEN
2326	SELECT CASE( sn_snd_thick%cldes)
2327	CASE( 'none' ) ! nothing to do
2328	CASE( 'weighted ice and snow' )
2329	SELECT CASE( sn_snd_thick%clcat )
2330	CASE( 'yes' )
2331	ztmp3(:,:,1:jpl) = h_i(:,:,1:jpl) * a_i(:,:,1:jpl)
2332	ztmp4(:,:,1:jpl) = h_s(:,:,1:jpl) * a_i(:,:,1:jpl)
2333	CASE( 'no' )
2334	ztmp3(:,:,:) = 0.0 ; ztmp4(:,:,:) = 0.0
2335	DO jl=1,jpl
2336	ztmp3(:,:,1) = ztmp3(:,:,1) + h_i(:,:,jl) * a_i(:,:,jl)
2337	ztmp4(:,:,1) = ztmp4(:,:,1) + h_s(:,:,jl) * a_i(:,:,jl)
2338	ENDDO
2339	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
2340	END SELECT
2341	CASE( 'ice and snow' )
2342	SELECT CASE( sn_snd_thick%clcat )
2343	CASE( 'yes' )
2344	ztmp3(:,:,1:jpl) = h_i(:,:,1:jpl)
2345	ztmp4(:,:,1:jpl) = h_s(:,:,1:jpl)
2346	CASE( 'no' )
2347	WHERE( SUM( a_i, dim=3 ) /= 0. )
2348	ztmp3(:,:,1) = SUM( h_i * a_i, dim=3 ) / SUM( a_i, dim=3 )
2349	ztmp4(:,:,1) = SUM( h_s * a_i, dim=3 ) / SUM( a_i, dim=3 )
2350	ELSEWHERE
2351	ztmp3(:,:,1) = 0.
2352	ztmp4(:,:,1) = 0.
2353	END WHERE
2354	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
2355	END SELECT
2356	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' )
2357	END SELECT
2358	IF( ssnd(jps_hice)%laction ) CALL cpl_snd( jps_hice, isec, ztmp3, info )
2359	IF( ssnd(jps_hsnw)%laction ) CALL cpl_snd( jps_hsnw, isec, ztmp4, info )
2360	ENDIF
2361
2362	#if defined key_si3
2363	! ! ------------------------- !
2364	! ! Ice melt ponds !
2365	! ! ------------------------- !
2366	! needed by Met Office
2367	IF( ssnd(jps_a_p)%laction .OR. ssnd(jps_ht_p)%laction ) THEN
2368	SELECT CASE( sn_snd_mpnd%cldes)
2369	CASE( 'ice only' )
2370	SELECT CASE( sn_snd_mpnd%clcat )
2371	CASE( 'yes' )
2372	ztmp3(:,:,1:jpl) = a_ip_eff(:,:,1:jpl)
2373	ztmp4(:,:,1:jpl) = h_ip(:,:,1:jpl)
2374	CASE( 'no' )
2375	ztmp3(:,:,:) = 0.0
2376	ztmp4(:,:,:) = 0.0
2377	DO jl=1,jpl
2378	ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip_frac(:,:,jpl)
2379	ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(:,:,jpl)
2380	ENDDO
2381	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%clcat' )
2382	END SELECT
2383	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%cldes' )
2384	END SELECT
2385	IF( ssnd(jps_a_p)%laction ) CALL cpl_snd( jps_a_p , isec, ztmp3, info )
2386	IF( ssnd(jps_ht_p)%laction ) CALL cpl_snd( jps_ht_p, isec, ztmp4, info )
2387	ENDIF
2388	!
2389	! ! ------------------------- !
2390	! ! Ice conductivity !
2391	! ! ------------------------- !
2392	! needed by Met Office
2393	IF( ssnd(jps_kice)%laction ) THEN
2394	SELECT CASE( sn_snd_cond%cldes)
2395	CASE( 'weighted ice' )
2396	SELECT CASE( sn_snd_cond%clcat )
2397	CASE( 'yes' )
2398	ztmp3(:,:,1:jpl) = cnd_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
2399	CASE( 'no' )
2400	ztmp3(:,:,:) = 0.0
2401	DO jl=1,jpl
2402	ztmp3(:,:,1) = ztmp3(:,:,1) + cnd_ice(:,:,jl) * a_i(:,:,jl)
2403	ENDDO
2404	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%clcat' )
2405	END SELECT
2406	CASE( 'ice only' )
2407	ztmp3(:,:,1:jpl) = cnd_ice(:,:,1:jpl)
2408	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%cldes' )
2409	END SELECT
2410	IF( ssnd(jps_kice)%laction ) CALL cpl_snd( jps_kice, isec, ztmp3, info )
2411	ENDIF
2412	#endif
2413
2414	! ! ------------------------- !
2415	! ! CO2 flux from PISCES !
2416	! ! ------------------------- !
2417	IF( ssnd(jps_co2)%laction .AND. l_co2cpl ) CALL cpl_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info )
2418	!
2419	! ! ------------------------- !
2420	IF( ssnd(jps_ocx1)%laction ) THEN ! Surface current !
2421	! ! ------------------------- !
2422	!
2423	! j+1 j -----V---F
2424	! surface velocity always sent from T point ! \|
2425	! j \| T U
2426	! \| \|
2427	! j j-1 -I-------\|
2428	! (for I) \| \|
2429	! i-1 i i
2430	! i i+1 (for I)
2431	IF( nn_components == jp_iam_opa ) THEN
2432	zotx1(:,:) = un(:,:,1)
2433	zoty1(:,:) = vn(:,:,1)
2434	ELSE
2435	SELECT CASE( TRIM( sn_snd_crt%cldes ) )
2436	CASE( 'oce only' ) ! C-grid ==> T
2437	DO jj = 2, jpjm1
2438	DO ji = fs_2, fs_jpim1 ! vector opt.
2439	zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) )
2440	zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) )
2441	END DO
2442	END DO
2443	CASE( 'weighted oce and ice' ) ! Ocean and Ice on C-grid ==> T
2444	DO jj = 2, jpjm1
2445	DO ji = fs_2, fs_jpim1 ! vector opt.
2446	zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj)
2447	zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj)
2448	zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj)
2449	zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj)
2450	END DO
2451	END DO
2452	CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1., zity1, 'T', -1. )
2453	CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T
2454	DO jj = 2, jpjm1
2455	DO ji = fs_2, fs_jpim1 ! vector opt.
2456	zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) &
2457	& + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj)
2458	zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) &
2459	& + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj)
2460	END DO
2461	END DO
2462	END SELECT
2463	CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1., zoty1, ssnd(jps_ocy1)%clgrid, -1. )
2464	!
2465	ENDIF
2466	!
2467	!
2468	IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components
2469	! ! Ocean component
2470	CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component
2471	CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component
2472	zotx1(:,:) = ztmp1(:,:) ! overwrite the components
2473	zoty1(:,:) = ztmp2(:,:)
2474	IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component
2475	CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component
2476	CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component
2477	zitx1(:,:) = ztmp1(:,:) ! overwrite the components
2478	zity1(:,:) = ztmp2(:,:)
2479	ENDIF
2480	ENDIF
2481	!
2482	! spherical coordinates to cartesian -> 2 components to 3 components
2483	IF( TRIM( sn_snd_crt%clvref ) == 'cartesian' ) THEN
2484	ztmp1(:,:) = zotx1(:,:) ! ocean currents
2485	ztmp2(:,:) = zoty1(:,:)
2486	CALL oce2geo ( ztmp1, ztmp2, 'T', zotx1, zoty1, zotz1 )
2487	!
2488	IF( ssnd(jps_ivx1)%laction ) THEN ! ice velocities
2489	ztmp1(:,:) = zitx1(:,:)
2490	ztmp1(:,:) = zity1(:,:)
2491	CALL oce2geo ( ztmp1, ztmp2, 'T', zitx1, zity1, zitz1 )
2492	ENDIF
2493	ENDIF
2494	!
2495	IF( ssnd(jps_ocx1)%laction ) CALL cpl_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info ) ! ocean x current 1st grid
2496	IF( ssnd(jps_ocy1)%laction ) CALL cpl_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info ) ! ocean y current 1st grid
2497	IF( ssnd(jps_ocz1)%laction ) CALL cpl_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info ) ! ocean z current 1st grid
2498	!
2499	IF( ssnd(jps_ivx1)%laction ) CALL cpl_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info ) ! ice x current 1st grid
2500	IF( ssnd(jps_ivy1)%laction ) CALL cpl_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info ) ! ice y current 1st grid
2501	IF( ssnd(jps_ivz1)%laction ) CALL cpl_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info ) ! ice z current 1st grid
2502	!
2503	ENDIF
2504	!
2505	! ! ------------------------- !
2506	! ! Surface current to waves !
2507	! ! ------------------------- !
2508	IF( ssnd(jps_ocxw)%laction .OR. ssnd(jps_ocyw)%laction ) THEN
2509	!
2510	! j+1 j -----V---F
2511	! surface velocity always sent from T point ! \|
2512	! j \| T U
2513	! \| \|
2514	! j j-1 -I-------\|
2515	! (for I) \| \|
2516	! i-1 i i
2517	! i i+1 (for I)
2518	SELECT CASE( TRIM( sn_snd_crtw%cldes ) )
2519	CASE( 'oce only' ) ! C-grid ==> T
2520	DO jj = 2, jpjm1
2521	DO ji = fs_2, fs_jpim1 ! vector opt.
2522	zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) )
2523	zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji , jj-1,1) )
2524	END DO
2525	END DO
2526	CASE( 'weighted oce and ice' ) ! Ocean and Ice on C-grid ==> T
2527	DO jj = 2, jpjm1
2528	DO ji = fs_2, fs_jpim1 ! vector opt.
2529	zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj)
2530	zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj)
2531	zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj)
2532	zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj)
2533	END DO
2534	END DO
2535	CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1., zity1, 'T', -1. )
2536	CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T
2537	DO jj = 2, jpjm1
2538	DO ji = fs_2, fs_jpim1 ! vector opt.
2539	zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) &
2540	& + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj)
2541	zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) &
2542	& + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj)
2543	END DO
2544	END DO
2545	END SELECT
2546	CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1., zoty1, ssnd(jps_ocyw)%clgrid, -1. )
2547	!
2548	!
2549	IF( TRIM( sn_snd_crtw%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components
2550	! ! Ocean component
2551	CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->e', ztmp1 ) ! 1st component
2552	CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->n', ztmp2 ) ! 2nd component
2553	zotx1(:,:) = ztmp1(:,:) ! overwrite the components
2554	zoty1(:,:) = ztmp2(:,:)
2555	IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component
2556	CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component
2557	CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component
2558	zitx1(:,:) = ztmp1(:,:) ! overwrite the components
2559	zity1(:,:) = ztmp2(:,:)
2560	ENDIF
2561	ENDIF
2562	!
2563	! ! spherical coordinates to cartesian -> 2 components to 3 components
2564	! IF( TRIM( sn_snd_crtw%clvref ) == 'cartesian' ) THEN
2565	! ztmp1(:,:) = zotx1(:,:) ! ocean currents
2566	! ztmp2(:,:) = zoty1(:,:)
2567	! CALL oce2geo ( ztmp1, ztmp2, 'T', zotx1, zoty1, zotz1 )
2568	! !
2569	! IF( ssnd(jps_ivx1)%laction ) THEN ! ice velocities
2570	! ztmp1(:,:) = zitx1(:,:)
2571	! ztmp1(:,:) = zity1(:,:)
2572	! CALL oce2geo ( ztmp1, ztmp2, 'T', zitx1, zity1, zitz1 )
2573	! ENDIF
2574	! ENDIF
2575	!
2576	IF( ssnd(jps_ocxw)%laction ) CALL cpl_snd( jps_ocxw, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info ) ! ocean x current 1st grid
2577	IF( ssnd(jps_ocyw)%laction ) CALL cpl_snd( jps_ocyw, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info ) ! ocean y current 1st grid
2578	!
2579	ENDIF
2580	!
2581	IF( ssnd(jps_ficet)%laction ) THEN
2582	CALL cpl_snd( jps_ficet, isec, RESHAPE ( fr_i, (/jpi,jpj,1/) ), info )
2583	END IF
2584	! ! ------------------------- !
2585	! ! Water levels to waves !
2586	! ! ------------------------- !
2587	IF( ssnd(jps_wlev)%laction ) THEN
2588	IF( ln_apr_dyn ) THEN
2589	IF( kt /= nit000 ) THEN
2590	ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
2591	ELSE
2592	ztmp1(:,:) = sshb(:,:)
2593	ENDIF
2594	ELSE
2595	ztmp1(:,:) = sshn(:,:)
2596	ENDIF
2597	CALL cpl_snd( jps_wlev , isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
2598	END IF
2599	!
2600	! Fields sent by OPA to SAS when doing OPA<->SAS coupling
2601	! ! SSH
2602	IF( ssnd(jps_ssh )%laction ) THEN
2603	! ! removed inverse barometer ssh when Patm
2604	! forcing is used (for sea-ice dynamics)
2605	IF( ln_apr_dyn ) THEN ; ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
2606	ELSE ; ztmp1(:,:) = sshn(:,:)
2607	ENDIF
2608	CALL cpl_snd( jps_ssh , isec, RESHAPE ( ztmp1 , (/jpi,jpj,1/) ), info )
2609
2610	ENDIF
2611	! ! SSS
2612	IF( ssnd(jps_soce )%laction ) THEN
2613	CALL cpl_snd( jps_soce , isec, RESHAPE ( tsn(:,:,1,jp_sal), (/jpi,jpj,1/) ), info )
2614	ENDIF
2615	! ! first T level thickness
2616	IF( ssnd(jps_e3t1st )%laction ) THEN
2617	CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t_n(:,:,1) , (/jpi,jpj,1/) ), info )
2618	ENDIF
2619	! ! Qsr fraction
2620	IF( ssnd(jps_fraqsr)%laction ) THEN
2621	CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( fraqsr_1lev(:,:) , (/jpi,jpj,1/) ), info )
2622	ENDIF
2623	!
2624	! Fields sent by SAS to OPA when OASIS coupling
2625	! ! Solar heat flux
2626	IF( ssnd(jps_qsroce)%laction ) CALL cpl_snd( jps_qsroce, isec, RESHAPE ( qsr , (/jpi,jpj,1/) ), info )
2627	IF( ssnd(jps_qnsoce)%laction ) CALL cpl_snd( jps_qnsoce, isec, RESHAPE ( qns , (/jpi,jpj,1/) ), info )
2628	IF( ssnd(jps_oemp )%laction ) CALL cpl_snd( jps_oemp , isec, RESHAPE ( emp , (/jpi,jpj,1/) ), info )
2629	IF( ssnd(jps_sflx )%laction ) CALL cpl_snd( jps_sflx , isec, RESHAPE ( sfx , (/jpi,jpj,1/) ), info )
2630	IF( ssnd(jps_otx1 )%laction ) CALL cpl_snd( jps_otx1 , isec, RESHAPE ( utau, (/jpi,jpj,1/) ), info )
2631	IF( ssnd(jps_oty1 )%laction ) CALL cpl_snd( jps_oty1 , isec, RESHAPE ( vtau, (/jpi,jpj,1/) ), info )
2632	IF( ssnd(jps_rnf )%laction ) CALL cpl_snd( jps_rnf , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info )
2633	IF( ssnd(jps_taum )%laction ) CALL cpl_snd( jps_taum , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info )
2634
2635	#if defined key_si3
2636	! ! ------------------------- !
2637	! ! Sea surface freezing temp !
2638	! ! ------------------------- !
2639	! needed by Met Office
2640	CALL eos_fzp(tsn(:,:,1,jp_sal), sstfrz)
2641	ztmp1(:,:) = sstfrz(:,:) + rt0
2642	IF( ssnd(jps_sstfrz)%laction ) CALL cpl_snd( jps_sstfrz, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info)
2643	#endif
2644	!
2645	END SUBROUTINE sbc_cpl_snd
2646
2647	!!======================================================================
2648	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_v2/src/OCE/SBC/sbccpl.F90 @ 12940

Download in other formats: