Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

sbccpl.F90

Last change on this file was 15433, checked in by dancopsey, 3 years ago
Add evap only option
File size: 159.3 KB

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

Download in other formats: