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

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

sbccpl.F90 in NEMO/branches/UKMO/NEMO_4.0.1_NGMS_couple_stage3_spmd/src/OCE/SBC – NEMO

Context Navigation

source: NEMO/branches/UKMO/NEMO_4.0.1_NGMS_couple_stage3_spmd/src/OCE/SBC/sbccpl.F90 @ 15814

Last change on this file since 15814 was 15051, checked in by andmirek, 3 years ago
dissable wind stress temporary (until it's available in lfric trunk)
File size: 158.2 KB

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

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

Download in other formats: