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/UKMO/NEMO_4.0.1_penetrating_solar/src/OCE/SBC – NEMO

Context Navigation

source: NEMO/branches/UKMO/NEMO_4.0.1_penetrating_solar/src/OCE/SBC/sbccpl.F90 @ 13376

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

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

Download in other formats: