Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

sbccpl.F90 @ 11432

Last change on this file since 11432 was 11432, checked in by csanchez, 5 years ago
Added changes from Bijoy to set cpl_mslp in a namelist
File size: 149.8 KB

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

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

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

Context Navigation

source: branches/UKMO/r6232_coupling_CBIJ/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 11432

Download in other formats: