Context Navigation

sbccpl.F90 @ 15584

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

Download in other formats: