Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

sbccpl.F90 @ 14289

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

Download in other formats: