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/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/SBC – NEMO

Context Navigation

source: NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/SBC/sbccpl.F90 @ 12606

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

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

Download in other formats: