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 branches/UKMO/r6232_HZG_WAVE-coupling/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

Context Navigation

source: branches/UKMO/r6232_HZG_WAVE-coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 8756

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

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

Download in other formats: