Context Navigation

sbccpl.F90 @ 8962

Last change on this file since 8962 was 8962, checked in by clem, 6 years ago
changes to improve test case SASBIPER
Property svn:keywords set to `Id`
File size: 160.8 KB

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

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

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

Context Navigation

source: branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 8962

Download in other formats: