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

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

sbccpl.F90 in branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

Context Navigation

source: branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 10473

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

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

Download in other formats: