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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

sbccpl.F90 in NEMO/releases/r4.0/r4.0-HEAD/src/OCE/SBC – NEMO

Context Navigation

source: NEMO/releases/r4.0/r4.0-HEAD/src/OCE/SBC/sbccpl.F90 @ 14717

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

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

Download in other formats: