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/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

Context Navigation

source: branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 8879

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

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

Download in other formats: