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/src/OCE/SBC – NEMO

Context Navigation

source: NEMO/branches/UKMO/NEMO_4.0.1_NGMS_couple_stage3/src/OCE/SBC/sbccpl.F90 @ 15261

Last change on this file since 15261 was 15261, checked in by frrh, 3 years ago
Update with latest changes to ensure NEMO will run satnd alone AND in coupled mode from the same suite, subject to appropriate cpp key and other adjusted settings.
File size: 158.6 KB

Line
1	MODULE sbccpl
2	!!======================================================================
3	!! * MODULE sbccpl *
4	!! Surface Boundary Condition : momentum, heat and freshwater fluxes in coupled mode
5	!!======================================================================
6	!! History : 2.0 ! 2007-06 (R. Redler, N. Keenlyside, W. Park) Original code split into flxmod & taumod
7	!! 3.0 ! 2008-02 (G. Madec, C Talandier) surface module
8	!! 3.1 ! 2009_02 (G. Madec, S. Masson, E. Maisonave, A. Caubel) generic coupled interface
9	!! 3.4 ! 2011_11 (C. Harris) more flexibility + multi-category fields
10	!!----------------------------------------------------------------------
11
12	!!----------------------------------------------------------------------
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	! rain
740	srcv(jpr_rain)%laction = .TRUE.
741	! snow
742	srcv(jpr_snow)%laction = .TRUE.
743	! wind 10m
744	srcv(jpr_w10m)%laction = .TRUE.
745	! Set taux and tauy to be active or not
746	srcv(jpr_otx1)%laction = .TRUE. ! temporary until those variables are available in lfric trunk
747	srcv(jpr_oty1)%laction = .TRUE. ! temporary until those variables are available in lfric trunk
748	srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point
749	srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point
750	srcv(jpr_itx1:jpr_itz1)%clgrid = 'F' ! ice components given at F-point
751	! Various settings necessary when we call coupling from what is essentially a
752	! stand alone ocean model, i.e. when ln_cpl is still false.
753	sn_rcv_tau%clvgrd = 'U,V,F'
754	sn_rcv_tau%clvor = 'eastward-northward'
755	sn_rcv_tau%clvref = 'spherical'
756	!qsr
757	srcv(jpr_qsroce)%laction = .TRUE.
758	!qns
759	srcv(jpr_qnsoce)%laction = .TRUE.
760	ENDIF
761
762	! =================================================== !
763	! Allocate all parts of frcv used for received fields !
764	! =================================================== !
765	DO jn = 1, jprcv
766	IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) )
767	END DO
768	! Allocate taum part of frcv which is used even when not received as coupling field
769	IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) )
770	! Allocate w10m part of frcv which is used even when not received as coupling field
771	IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) )
772	! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field
773	IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) )
774	IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) )
775	! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE.
776	IF( k_ice /= 0 ) THEN
777	IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) )
778	IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) )
779	END IF
780
781
782
783
784
785	! ================================ !
786	! Define the send interface !
787	! ================================ !
788	! for each field: define the OASIS name (ssnd(:)%clname)
789	! define send or not from the namelist parameters (ssnd(:)%laction)
790	! define the north fold type of lbc (ssnd(:)%nsgn)
791
792	! default definitions of nsnd
793	ssnd(:)%laction = .FALSE. ; ssnd(:)%clgrid = 'T' ; ssnd(:)%nsgn = 1. ; ssnd(:)%nct = 1
794
795	! ! ------------------------- !
796	! ! Surface temperature !
797	! ! ------------------------- !
798	ssnd(jps_toce)%clname = 'O_SSTSST'
799	ssnd(jps_tice)%clname = 'O_TepIce'
800	ssnd(jps_ttilyr)%clname = 'O_TtiLyr'
801	ssnd(jps_tmix)%clname = 'O_TepMix'
802	SELECT CASE( TRIM( sn_snd_temp%cldes ) )
803	CASE( 'none' ) ! nothing to do
804	CASE( 'oce only' ) ; ssnd( jps_toce )%laction = .TRUE.
805	CASE( 'oce and ice' , 'weighted oce and ice' , 'oce and weighted ice' )
806	ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE.
807	IF ( TRIM( sn_snd_temp%clcat ) == 'yes' ) ssnd(jps_tice)%nct = nn_cats_cpl
808	CASE( 'mixed oce-ice' ) ; ssnd( jps_tmix )%laction = .TRUE.
809	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' )
810	END SELECT
811
812	! ! ------------------------- !
813	! ! Albedo !
814	! ! ------------------------- !
815	ssnd(jps_albice)%clname = 'O_AlbIce'
816	ssnd(jps_albmix)%clname = 'O_AlbMix'
817	SELECT CASE( TRIM( sn_snd_alb%cldes ) )
818	CASE( 'none' ) ! nothing to do
819	CASE( 'ice' , 'weighted ice' ) ; ssnd(jps_albice)%laction = .TRUE.
820	CASE( 'mixed oce-ice' ) ; ssnd(jps_albmix)%laction = .TRUE.
821	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_alb%cldes' )
822	END SELECT
823	!
824	! Need to calculate oceanic albedo if
825	! 1. sending mixed oce-ice albedo or
826	! 2. receiving mixed oce-ice solar radiation
827	IF ( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN
828	CALL oce_alb( zaos, zacs )
829	! Due to lack of information on nebulosity : mean clear/overcast sky
830	alb_oce_mix(:,:) = ( zacs(:,:) + zaos(:,:) ) * 0.5
831	ENDIF
832	! ! ------------------------- !
833	! ! Ice fraction & Thickness !
834	! ! ------------------------- !
835	ssnd(jps_fice)%clname = 'OIceFrc'
836	ssnd(jps_ficet)%clname = 'OIceFrcT'
837	ssnd(jps_hice)%clname = 'OIceTck'
838	ssnd(jps_a_p)%clname = 'OPndFrc'
839	ssnd(jps_ht_p)%clname = 'OPndTck'
840	ssnd(jps_hsnw)%clname = 'OSnwTck'
841	ssnd(jps_fice1)%clname = 'OIceFrd'
842	IF( k_ice /= 0 ) THEN
843	ssnd(jps_fice)%laction = .TRUE. ! if ice treated in the ocean (even in climato case)
844	ssnd(jps_fice1)%laction = .TRUE. ! First-order regridded ice concentration, to be used producing atmos-to-ice fluxes (Met Office requirement)
845	! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now
846	IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = nn_cats_cpl
847	IF ( TRIM( sn_snd_thick1%clcat ) == 'yes' ) ssnd(jps_fice1)%nct = nn_cats_cpl
848	ENDIF
849
850	IF (TRIM( sn_snd_ifrac%cldes ) == 'coupled') ssnd(jps_ficet)%laction = .TRUE.
851
852	SELECT CASE ( TRIM( sn_snd_thick%cldes ) )
853	CASE( 'none' ) ! nothing to do
854	CASE( 'ice and snow' )
855	ssnd(jps_hice:jps_hsnw)%laction = .TRUE.
856	IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN
857	ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl
858	ENDIF
859	CASE ( 'weighted ice and snow' )
860	ssnd(jps_hice:jps_hsnw)%laction = .TRUE.
861	IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl
862	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_thick%cldes' )
863	END SELECT
864
865	! ! ------------------------- !
866	! ! Ice Meltponds !
867	! ! ------------------------- !
868	! Needed by Met Office
869	ssnd(jps_a_p)%clname = 'OPndFrc'
870	ssnd(jps_ht_p)%clname = 'OPndTck'
871	SELECT CASE ( TRIM( sn_snd_mpnd%cldes ) )
872	CASE ( 'none' )
873	ssnd(jps_a_p)%laction = .FALSE.
874	ssnd(jps_ht_p)%laction = .FALSE.
875	CASE ( 'ice only' )
876	ssnd(jps_a_p)%laction = .TRUE.
877	ssnd(jps_ht_p)%laction = .TRUE.
878	IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN
879	ssnd(jps_a_p)%nct = nn_cats_cpl
880	ssnd(jps_ht_p)%nct = nn_cats_cpl
881	ELSE
882	IF ( nn_cats_cpl > 1 ) THEN
883	CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_mpnd%cldes if not exchanging category fields' )
884	ENDIF
885	ENDIF
886	CASE ( 'weighted ice' )
887	ssnd(jps_a_p)%laction = .TRUE.
888	ssnd(jps_ht_p)%laction = .TRUE.
889	IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN
890	ssnd(jps_a_p)%nct = nn_cats_cpl
891	ssnd(jps_ht_p)%nct = nn_cats_cpl
892	ENDIF
893	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_mpnd%cldes; '//sn_snd_mpnd%cldes )
894	END SELECT
895
896	! ! ------------------------- !
897	! ! Surface current !
898	! ! ------------------------- !
899	! ocean currents ! ice velocities
900	ssnd(jps_ocx1)%clname = 'O_OCurx1' ; ssnd(jps_ivx1)%clname = 'O_IVelx1'
901	ssnd(jps_ocy1)%clname = 'O_OCury1' ; ssnd(jps_ivy1)%clname = 'O_IVely1'
902	ssnd(jps_ocz1)%clname = 'O_OCurz1' ; ssnd(jps_ivz1)%clname = 'O_IVelz1'
903	ssnd(jps_ocxw)%clname = 'O_OCurxw'
904	ssnd(jps_ocyw)%clname = 'O_OCuryw'
905	!
906	ssnd(jps_ocx1:jps_ivz1)%nsgn = -1. ! vectors: change of the sign at the north fold
907
908	IF( sn_snd_crt%clvgrd == 'U,V' ) THEN
909	ssnd(jps_ocx1)%clgrid = 'U' ; ssnd(jps_ocy1)%clgrid = 'V'
910	ELSE IF( sn_snd_crt%clvgrd /= 'T' ) THEN
911	CALL ctl_stop( 'sn_snd_crt%clvgrd must be equal to T' )
912	ssnd(jps_ocx1:jps_ivz1)%clgrid = 'T' ! all oce and ice components on the same unique grid
913	ENDIF
914	ssnd(jps_ocx1:jps_ivz1)%laction = .TRUE. ! default: all are send
915	IF( TRIM( sn_snd_crt%clvref ) == 'spherical' ) ssnd( (/jps_ocz1, jps_ivz1/) )%laction = .FALSE.
916	IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) ssnd(jps_ocx1:jps_ivz1)%nsgn = 1.
917	SELECT CASE( TRIM( sn_snd_crt%cldes ) )
918	CASE( 'none' ) ; ssnd(jps_ocx1:jps_ivz1)%laction = .FALSE.
919	CASE( 'oce only' ) ; ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE.
920	CASE( 'weighted oce and ice' ) ! nothing to do
921	CASE( 'mixed oce-ice' ) ; ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE.
922	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_crt%cldes' )
923	END SELECT
924
925	ssnd(jps_ocxw:jps_ocyw)%nsgn = -1. ! vectors: change of the sign at the north fold
926
927	IF( sn_snd_crtw%clvgrd == 'U,V' ) THEN
928	ssnd(jps_ocxw)%clgrid = 'U' ; ssnd(jps_ocyw)%clgrid = 'V'
929	ELSE IF( sn_snd_crtw%clvgrd /= 'T' ) THEN
930	CALL ctl_stop( 'sn_snd_crtw%clvgrd must be equal to T' )
931	ENDIF
932	IF( TRIM( sn_snd_crtw%clvor ) == 'eastward-northward' ) ssnd(jps_ocxw:jps_ocyw)%nsgn = 1.
933	SELECT CASE( TRIM( sn_snd_crtw%cldes ) )
934	CASE( 'none' ) ; ssnd(jps_ocxw:jps_ocyw)%laction = .FALSE.
935	CASE( 'oce only' ) ; ssnd(jps_ocxw:jps_ocyw)%laction = .TRUE.
936	CASE( 'weighted oce and ice' ) ! nothing to do
937	CASE( 'mixed oce-ice' ) ; ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE.
938	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_crtw%cldes' )
939	END SELECT
940
941	! ! ------------------------- !
942	! ! CO2 flux !
943	! ! ------------------------- !
944	ssnd(jps_co2)%clname = 'O_CO2FLX' ; IF( TRIM(sn_snd_co2%cldes) == 'coupled' ) ssnd(jps_co2 )%laction = .TRUE.
945	!
946	! ! ------------------------- !
947	! ! Sea surface freezing temp !
948	! ! ------------------------- !
949	! needed by Met Office
950	ssnd(jps_sstfrz)%clname = 'O_SSTFrz' ; IF( TRIM(sn_snd_sstfrz%cldes) == 'coupled' ) ssnd(jps_sstfrz)%laction = .TRUE.
951	!
952	! ! ------------------------- !
953	! ! Ice conductivity !
954	! ! ------------------------- !
955	! needed by Met Office
956	! Note that ultimately we will move to passing an ocean effective conductivity as well so there
957	! will be some changes to the parts of the code which currently relate only to ice conductivity
958	ssnd(jps_ttilyr )%clname = 'O_TtiLyr'
959	SELECT CASE ( TRIM( sn_snd_ttilyr%cldes ) )
960	CASE ( 'none' )
961	ssnd(jps_ttilyr)%laction = .FALSE.
962	CASE ( 'ice only' )
963	ssnd(jps_ttilyr)%laction = .TRUE.
964	IF ( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) THEN
965	ssnd(jps_ttilyr)%nct = nn_cats_cpl
966	ELSE
967	IF ( nn_cats_cpl > 1 ) THEN
968	CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_ttilyr%cldes if not exchanging category fields' )
969	ENDIF
970	ENDIF
971	CASE ( 'weighted ice' )
972	ssnd(jps_ttilyr)%laction = .TRUE.
973	IF ( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) ssnd(jps_ttilyr)%nct = nn_cats_cpl
974	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_ttilyr%cldes;'//sn_snd_ttilyr%cldes )
975	END SELECT
976
977	ssnd(jps_kice )%clname = 'OIceKn'
978	SELECT CASE ( TRIM( sn_snd_cond%cldes ) )
979	CASE ( 'none' )
980	ssnd(jps_kice)%laction = .FALSE.
981	CASE ( 'ice only' )
982	ssnd(jps_kice)%laction = .TRUE.
983	IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN
984	ssnd(jps_kice)%nct = nn_cats_cpl
985	ELSE
986	IF ( nn_cats_cpl > 1 ) THEN
987	CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_cond%cldes if not exchanging category fields' )
988	ENDIF
989	ENDIF
990	CASE ( 'weighted ice' )
991	ssnd(jps_kice)%laction = .TRUE.
992	IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = nn_cats_cpl
993	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_cond%cldes;'//sn_snd_cond%cldes )
994	END SELECT
995	!
996	! ! ------------------------- !
997	! ! Sea surface height !
998	! ! ------------------------- !
999	ssnd(jps_wlev)%clname = 'O_Wlevel' ; IF( TRIM(sn_snd_wlev%cldes) == 'coupled' ) ssnd(jps_wlev)%laction = .TRUE.
1000
1001	! ! ------------------------------- !
1002	! ! OPA-SAS coupling - snd by opa !
1003	! ! ------------------------------- !
1004	ssnd(jps_ssh )%clname = 'O_SSHght'
1005	ssnd(jps_soce )%clname = 'O_SSSal'
1006	ssnd(jps_e3t1st)%clname = 'O_E3T1st'
1007	ssnd(jps_fraqsr)%clname = 'O_FraQsr'
1008	!
1009	IF( nn_components == jp_iam_opa ) THEN
1010	ssnd(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling
1011	ssnd( (/jps_toce, jps_soce, jps_ssh, jps_fraqsr, jps_ocx1, jps_ocy1/) )%laction = .TRUE.
1012	ssnd( jps_e3t1st )%laction = .NOT.ln_linssh
1013	! vector definition: not used but cleaner...
1014	ssnd(jps_ocx1)%clgrid = 'U' ! oce components given at U-point
1015	ssnd(jps_ocy1)%clgrid = 'V' ! and V-point
1016	sn_snd_crt%clvgrd = 'U,V'
1017	sn_snd_crt%clvor = 'local grid'
1018	sn_snd_crt%clvref = 'spherical'
1019	!
1020	IF(lwp) THEN ! control print
1021	WRITE(numout,*)
1022	WRITE(numout,*)' sent fields to SAS component '
1023	WRITE(numout,*)' sea surface temperature (T before, Celsius) '
1024	WRITE(numout,*)' sea surface salinity '
1025	WRITE(numout,*)' surface currents U,V on local grid and spherical coordinates'
1026	WRITE(numout,*)' sea surface height '
1027	WRITE(numout,*)' thickness of first ocean T level '
1028	WRITE(numout,*)' fraction of solar net radiation absorbed in the first ocean level'
1029	WRITE(numout,*)
1030	ENDIF
1031	ENDIF
1032	! ! ------------------------------- !
1033	! ! OPA-SAS coupling - snd by sas !
1034	! ! ------------------------------- !
1035	ssnd(jps_sflx )%clname = 'I_SFLX'
1036	ssnd(jps_fice2 )%clname = 'IIceFrc'
1037	ssnd(jps_qsroce)%clname = 'I_QsrOce'
1038	ssnd(jps_qnsoce)%clname = 'I_QnsOce'
1039	ssnd(jps_oemp )%clname = 'IOEvaMPr'
1040	ssnd(jps_otx1 )%clname = 'I_OTaux1'
1041	ssnd(jps_oty1 )%clname = 'I_OTauy1'
1042	ssnd(jps_rnf )%clname = 'I_Runoff'
1043	ssnd(jps_taum )%clname = 'I_TauMod'
1044	!
1045	IF( nn_components == jp_iam_sas ) THEN
1046	IF( .NOT. ln_cpl ) ssnd(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling
1047	ssnd( (/jps_qsroce, jps_qnsoce, jps_oemp, jps_fice2, jps_sflx, jps_otx1, jps_oty1, jps_taum/) )%laction = .TRUE.
1048	!
1049	! Change first letter to couple with atmosphere if already coupled with sea_ice
1050	! this is nedeed as each variable name used in the namcouple must be unique:
1051	! for example O_SSTSST sent by OPA to SAS and therefore S_SSTSST sent by SAS to the Atmosphere
1052	DO jn = 1, jpsnd
1053	IF ( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname))
1054	END DO
1055	!
1056	IF(lwp) THEN ! control print
1057	WRITE(numout,*)
1058	IF( .NOT. ln_cpl ) THEN
1059	WRITE(numout,*)' sent fields to OPA component '
1060	ELSE
1061	WRITE(numout,*)' Additional sent fields to OPA component : '
1062	ENDIF
1063	WRITE(numout,*)' ice cover '
1064	WRITE(numout,*)' oce only EMP '
1065	WRITE(numout,*)' salt flux '
1066	WRITE(numout,*)' mixed oce-ice solar flux '
1067	WRITE(numout,*)' mixed oce-ice non solar flux '
1068	WRITE(numout,*)' wind stress U,V components'
1069	WRITE(numout,*)' wind stress module'
1070	ENDIF
1071	ENDIF
1072
1073	IF (ln_couple_test) THEN
1074	! If we're just running a test coupled job then set all
1075	! actions to false for all fields apart from our test field(s)
1076	do jn = 1, nmaxfld
1077	if(ssnd(jn)%laction) then
1078	write(numout, *) jn, ssnd(jn)%clname,' Exchanged'
1079	endif
1080	enddo
1081	ssnd(:)%laction = .FALSE.
1082
1083	ssnd(jps_dummy_t)%clname = 'S_OC_DUMMY_T'
1084	ssnd(jps_dummy_t)%laction = .TRUE.
1085	ENDIF
1086
1087
1088	!
1089	! ================================ !
1090	! initialisation of the coupler !
1091	! ================================ !
1092
1093	! If ln_cpl is false, clearly we don't want to call cpl_dfine!
1094	IF (ln_cpl .OR. ln_couple_test) THEN
1095	write(numout,*) "RSRH call cpl_define", ln_cpl ,ln_couple_test ; flush(numout)
1096	CALL cpl_define(jprcv, jpsnd, nn_cplmodel)
1097
1098	ENDIF
1099	write(numout,*) "RSRH after cpl_define", ln_cpl ,ln_couple_test ; flush(numout)
1100
1101
1102	IF (ln_usecplmask) THEN
1103	xcplmask(:,:,:) = 0.
1104	CALL iom_open( 'cplmask', inum )
1105	CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(1:nlci,1:nlcj,1:nn_cplmodel), &
1106	& kstart = (/ mig(1),mjg(1),1 /), kcount = (/ nlci,nlcj,nn_cplmodel /) )
1107	CALL iom_close( inum )
1108	ELSE
1109	xcplmask(:,:,:) = 1.
1110	ENDIF
1111	xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 )
1112	!
1113	ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'I_QsrOce' ) + cpl_freq( 'I_QsrMix' )
1114	IF( ln_dm2dc .AND. ln_cpl .AND. ncpl_qsr_freq /= 86400 ) &
1115	& CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' )
1116	IF( ln_dm2dc .AND. ln_cpl ) ncpl_qsr_freq = 86400 / ncpl_qsr_freq
1117	!
1118	END SUBROUTINE sbc_cpl_init
1119
1120
1121	SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice )
1122	!!----------------------------------------------------------------------
1123	!! * ROUTINE sbc_cpl_rcv *
1124	!!
1125	!! ** Purpose : provide the stress over the ocean and, if no sea-ice,
1126	!! provide the ocean heat and freshwater fluxes.
1127	!!
1128	!! ** Method : - Receive all the atmospheric fields (stored in frcv array). called at each time step.
1129	!! OASIS controls if there is something do receive or not. nrcvinfo contains the info
1130	!! to know if the field was really received or not
1131	!!
1132	!! --> If ocean stress was really received:
1133	!!
1134	!! - transform the received ocean stress vector from the received
1135	!! referential and grid into an atmosphere-ocean stress in
1136	!! the (i,j) ocean referencial and at the ocean velocity point.
1137	!! The received stress are :
1138	!! - defined by 3 components (if cartesian coordinate)
1139	!! or by 2 components (if spherical)
1140	!! - oriented along geographical coordinate (if eastward-northward)
1141	!! or along the local grid coordinate (if local grid)
1142	!! - given at U- and V-point, resp. if received on 2 grids
1143	!! or at T-point if received on 1 grid
1144	!! Therefore and if necessary, they are successively
1145	!! processed in order to obtain them
1146	!! first as 2 components on the sphere
1147	!! second as 2 components oriented along the local grid
1148	!! third as 2 components on the U,V grid
1149	!!
1150	!! -->
1151	!!
1152	!! - In 'ocean only' case, non solar and solar ocean heat fluxes
1153	!! and total ocean freshwater fluxes
1154	!!
1155	!! ** Method : receive all fields from the atmosphere and transform
1156	!! them into ocean surface boundary condition fields
1157	!!
1158	!! ** Action : update utau, vtau ocean stress at U,V grid
1159	!! taum wind stress module at T-point
1160	!! wndm wind speed module at T-point over free ocean or leads in presence of sea-ice
1161	!! qns non solar heat fluxes including emp heat content (ocean only case)
1162	!! and the latent heat flux of solid precip. melting
1163	!! qsr solar ocean heat fluxes (ocean only case)
1164	!! emp upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case)
1165	!!----------------------------------------------------------------------
1166	USE zdf_oce, ONLY : ln_zdfswm
1167	!
1168	INTEGER, INTENT(in) :: kt ! ocean model time step index
1169	INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation
1170	INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3)
1171	!!
1172	LOGICAL :: llnewtx, llnewtau ! update wind stress components and module??
1173	INTEGER :: ji, jj, jn ! dummy loop indices
1174	INTEGER :: isec ! number of seconds since nit000 (assuming rdttra did not change since nit000)
1175	INTEGER :: ikchoix
1176	REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars
1177	REAL(wp) :: zcoef ! temporary scalar
1178	REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3
1179	REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient
1180	REAL(wp) :: zzx, zzy ! temporary variables
1181	REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2
1182	!!----------------------------------------------------------------------
1183	!
1184	IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0)
1185	!
1186	! ! ======================================================= !
1187	! ! Receive all the atmos. fields (including ice information)
1188	! ! ======================================================= !
1189	isec = ( kt - nit000 ) * NINT( rdt ) ! date of exchanges
1190
1191
1192	DO jn = 1, jprcv ! received fields sent by the atmosphere
1193
1194	IF( srcv(jn)%laction ) THEN
1195	CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) )
1196	WRITE(numout,*) "RSRH done cpl_rcv for field", jn, srcv(jn)%laction, nrcvinfo(jn) ;flush(numout)
1197	ENDIF
1198	END DO
1199
1200	! Do we want to overwrite our incoming tau
1201	IF (ln_couple_ow_tau) THEN
1202
1203	! ! ========================= !
1204	IF( srcv(jpr_otx1)%laction ) THEN ! ocean stress components !
1205	! ! ========================= !
1206	! define frcv(jpr_otx1)%z3(:,:,1) and frcv(jpr_oty1)%z3(:,:,1): stress at U/V point along model grid
1207	! => need to be done only when we receive the field
1208	IF( nrcvinfo(jpr_otx1) == OASIS_Rcv ) THEN
1209	!
1210	IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere
1211	! ! (cartesian to spherical -> 3 to 2 components)
1212	!
1213	CALL geo2oce( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), frcv(jpr_otz1)%z3(:,:,1), &
1214	& srcv(jpr_otx1)%clgrid, ztx, zty )
1215	frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid
1216	frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid
1217	!
1218	IF( srcv(jpr_otx2)%laction ) THEN
1219	CALL geo2oce( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), frcv(jpr_otz2)%z3(:,:,1), &
1220	& srcv(jpr_otx2)%clgrid, ztx, zty )
1221	frcv(jpr_otx2)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid
1222	frcv(jpr_oty2)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid
1223	ENDIF
1224	!
1225	ENDIF
1226	!
1227	IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid
1228	! ! (geographical to local grid -> rotate the components)
1229
1230	IF( srcv(jpr_otx1)%clgrid == 'U' .AND. (.NOT. srcv(jpr_otx2)%laction) ) THEN
1231	! Temporary code for HadGEM3 - will be removed eventually.
1232	! Only applies when we have only taux on U grid and tauy on V grid
1233	DO jj=2,jpjm1
1234	DO ji=2,jpim1
1235	ztx(ji,jj)=0.25*vmask(ji,jj,1) &
1236	*(frcv(jpr_otx1)%z3(ji,jj,1)+frcv(jpr_otx1)%z3(ji-1,jj,1) &
1237	+frcv(jpr_otx1)%z3(ji,jj+1,1)+frcv(jpr_otx1)%z3(ji-1,jj+1,1))
1238	zty(ji,jj)=0.25*umask(ji,jj,1) &
1239	*(frcv(jpr_oty1)%z3(ji,jj,1)+frcv(jpr_oty1)%z3(ji+1,jj,1) &
1240	+frcv(jpr_oty1)%z3(ji,jj-1,1)+frcv(jpr_oty1)%z3(ji+1,jj-1,1))
1241	ENDDO
1242	ENDDO
1243
1244	ikchoix = 1
1245	CALL repcmo (frcv(jpr_otx1)%z3(:,:,1),zty,ztx,frcv(jpr_oty1)%z3(:,:,1),ztx2,zty2,ikchoix)
1246	CALL lbc_lnk ('jpr_otx1', ztx2,'U', -1. )
1247	CALL lbc_lnk ('jpr_oty1', zty2,'V', -1. )
1248	frcv(jpr_otx1)%z3(:,:,1)=ztx2(:,:)
1249	frcv(jpr_oty1)%z3(:,:,1)=zty2(:,:)
1250	ELSE
1251	CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )
1252	frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid
1253	IF( srcv(jpr_otx2)%laction ) THEN
1254	CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty )
1255	ELSE
1256	CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty )
1257	ENDIF
1258	frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid
1259	ENDIF
1260	ENDIF
1261	!
1262	IF( srcv(jpr_otx1)%clgrid == 'T' ) THEN
1263	DO jj = 2, jpjm1 ! T ==> (U,V)
1264	DO ji = fs_2, fs_jpim1 ! vector opt.
1265	frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) )
1266	frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) )
1267	END DO
1268	END DO
1269	CALL lbc_lnk_multi( 'sbccpl', frcv(jpr_otx1)%z3(:,:,1), 'U', -1., frcv(jpr_oty1)%z3(:,:,1), 'V', -1. )
1270	ENDIF
1271	llnewtx = .TRUE.
1272	ELSE
1273	llnewtx = .FALSE.
1274	ENDIF
1275	! ! ========================= !
1276	ELSE ! No dynamical coupling !
1277	! ! ========================= !
1278	frcv(jpr_otx1)%z3(:,:,1) = 0.e0 ! here simply set to zero
1279	frcv(jpr_oty1)%z3(:,:,1) = 0.e0 ! an external read in a file can be added instead
1280	llnewtx = .TRUE.
1281	!
1282	ENDIF
1283
1284	! ! ========================= !
1285	! ! wind stress module ! (taum)
1286	! ! ========================= !
1287	IF( .NOT. srcv(jpr_taum)%laction ) THEN ! compute wind stress module from its components if not received
1288	! => need to be done only when otx1 was changed
1289	IF( llnewtx ) THEN
1290	DO jj = 2, jpjm1
1291	DO ji = fs_2, fs_jpim1 ! vect. opt.
1292	zzx = frcv(jpr_otx1)%z3(ji-1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1)
1293	zzy = frcv(jpr_oty1)%z3(ji ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1)
1294	frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy )
1295	END DO
1296	END DO
1297	CALL lbc_lnk( 'sbccpl', frcv(jpr_taum)%z3(:,:,1), 'T', 1. )
1298	llnewtau = .TRUE.
1299	ELSE
1300	llnewtau = .FALSE.
1301	ENDIF
1302	ELSE
1303	llnewtau = nrcvinfo(jpr_taum) == OASIS_Rcv
1304	! Stress module can be negative when received (interpolation problem)
1305	IF( llnewtau ) THEN
1306	frcv(jpr_taum)%z3(:,:,1) = MAX( 0._wp, frcv(jpr_taum)%z3(:,:,1) )
1307	ENDIF
1308	ENDIF
1309
1310	!
1311	! ! ========================= !
1312	! ! 10 m wind speed ! (wndm)
1313	! ! ========================= !
1314	IF( .NOT. srcv(jpr_w10m)%laction ) THEN ! compute wind spreed from wind stress module if not received
1315	! => need to be done only when taumod was changed
1316	IF( llnewtau ) THEN
1317	zcoef = 1. / ( zrhoa * zcdrag )
1318	DO jj = 1, jpj
1319	DO ji = 1, jpi
1320	frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )
1321	END DO
1322	END DO
1323	ENDIF
1324	ENDIF
1325
1326	! u(v)tau and taum will be modified by ice model
1327	! -> need to be reset before each call of the ice/fsbc
1328	IF( MOD( kt-1, k_fsbc ) == 0 ) THEN
1329	!
1330	IF( ln_mixcpl ) THEN
1331	utau(:,:) = utau(:,:) * xcplmask(:,:,0) + frcv(jpr_otx1)%z3(:,:,1) * zmsk(:,:)
1332	vtau(:,:) = vtau(:,:) * xcplmask(:,:,0) + frcv(jpr_oty1)%z3(:,:,1) * zmsk(:,:)
1333	taum(:,:) = taum(:,:) * xcplmask(:,:,0) + frcv(jpr_taum)%z3(:,:,1) * zmsk(:,:)
1334	wndm(:,:) = wndm(:,:) * xcplmask(:,:,0) + frcv(jpr_w10m)%z3(:,:,1) * zmsk(:,:)
1335	ELSE
1336	utau(:,:) = frcv(jpr_otx1)%z3(:,:,1)
1337	vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1)
1338	taum(:,:) = frcv(jpr_taum)%z3(:,:,1)
1339	wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1)
1340	ENDIF
1341	CALL iom_put( "taum_oce", taum ) ! output wind stress module
1342	!
1343	ENDIF
1344
1345	ENDIF ! use tau fields
1346
1347
1348
1349	! If we want to actually use other (non tau) incoming fields in the model then
1350	! we set ln_couple_ow = TRUE, otherwise, we're just running a test
1351	! of the coupling field exchange for these fields
1352	IF (ln_couple_ow_gen) THEN
1353
1354	! ! ================== !
1355	! ! atmosph. CO2 (ppm) !
1356	! ! ================== !
1357	IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1)
1358	!
1359	! ! ================== !
1360	! ! ice skin temp. !
1361	! ! ================== !
1362	#if defined key_si3
1363	! needed by Met Office
1364	IF( srcv(jpr_ts_ice)%laction ) THEN
1365	WHERE ( frcv(jpr_ts_ice)%z3(:,:,:) > 0.0 ) ; tsfc_ice(:,:,:) = 0.0
1366	ELSEWHERE( frcv(jpr_ts_ice)%z3(:,:,:) < -60. ) ; tsfc_ice(:,:,:) = -60.
1367	ELSEWHERE ; tsfc_ice(:,:,:) = frcv(jpr_ts_ice)%z3(:,:,:)
1368	END WHERE
1369	ENDIF
1370	#endif
1371	! ! ========================= !
1372	! ! Mean Sea Level Pressure ! (taum)
1373	! ! ========================= !
1374	IF( srcv(jpr_mslp)%laction ) THEN ! UKMO SHELF effect of atmospheric pressure on SSH
1375	IF( kt /= nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) !* Swap of ssh_ib fields
1376
1377	r1_grau = 1.e0 / (grav * rau0) !* constant for optimization
1378	ssh_ib(:,:) = - ( frcv(jpr_mslp)%z3(:,:,1) - rpref ) * r1_grau ! equivalent ssh (inverse barometer)
1379	apr (:,:) = frcv(jpr_mslp)%z3(:,:,1) !atmospheric pressure
1380
1381	IF( kt == nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) ! correct this later (read from restart if possible)
1382	END IF
1383	!
1384	IF( ln_sdw ) THEN ! Stokes Drift correction activated
1385	! ! ========================= !
1386	! ! Stokes drift u !
1387	! ! ========================= !
1388	IF( srcv(jpr_sdrftx)%laction ) ut0sd(:,:) = frcv(jpr_sdrftx)%z3(:,:,1)
1389	!
1390	! ! ========================= !
1391	! ! Stokes drift v !
1392	! ! ========================= !
1393	IF( srcv(jpr_sdrfty)%laction ) vt0sd(:,:) = frcv(jpr_sdrfty)%z3(:,:,1)
1394	!
1395	! ! ========================= !
1396	! ! Wave mean period !
1397	! ! ========================= !
1398	IF( srcv(jpr_wper)%laction ) wmp(:,:) = frcv(jpr_wper)%z3(:,:,1)
1399	!
1400	! ! ========================= !
1401	! ! Significant wave height !
1402	! ! ========================= !
1403	IF( srcv(jpr_hsig)%laction ) hsw(:,:) = frcv(jpr_hsig)%z3(:,:,1)
1404	!
1405	! ! ========================= !
1406	! ! Wave peak frequency !
1407	! ! ========================= !
1408	IF( srcv(jpr_wfreq)%laction ) wfreq(:,:) = frcv(jpr_wfreq)%z3(:,:,1)
1409	!
1410	! ! ========================= !
1411	! ! Vertical mixing Qiao !
1412	! ! ========================= !
1413	IF( srcv(jpr_wnum)%laction .AND. ln_zdfswm ) wnum(:,:) = frcv(jpr_wnum)%z3(:,:,1)
1414
1415	! Calculate the 3D Stokes drift both in coupled and not fully uncoupled mode
1416	IF( srcv(jpr_sdrftx)%laction .OR. srcv(jpr_sdrfty)%laction .OR. srcv(jpr_wper)%laction &
1417	.OR. srcv(jpr_hsig)%laction .OR. srcv(jpr_wfreq)%laction) THEN
1418	CALL sbc_stokes()
1419	ENDIF
1420	ENDIF
1421	! ! ========================= !
1422	! ! Stress adsorbed by waves !
1423	! ! ========================= !
1424	IF( srcv(jpr_tauwoc)%laction .AND. ln_tauwoc ) tauoc_wave(:,:) = frcv(jpr_tauwoc)%z3(:,:,1)
1425
1426	! ! ========================= !
1427	! ! Stress component by waves !
1428	! ! ========================= !
1429	IF( srcv(jpr_tauwx)%laction .AND. srcv(jpr_tauwy)%laction .AND. ln_tauw ) THEN
1430	tauw_x(:,:) = frcv(jpr_tauwx)%z3(:,:,1)
1431	tauw_y(:,:) = frcv(jpr_tauwy)%z3(:,:,1)
1432	ENDIF
1433
1434	! ! ========================= !
1435	! ! Wave drag coefficient !
1436	! ! ========================= !
1437	IF( srcv(jpr_wdrag)%laction .AND. ln_cdgw ) cdn_wave(:,:) = frcv(jpr_wdrag)%z3(:,:,1)
1438
1439	! Fields received by SAS when OASIS coupling
1440	! (arrays no more filled at sbcssm stage)
1441	! ! ================== !
1442	! ! SSS !
1443	! ! ================== !
1444	IF( srcv(jpr_soce)%laction ) THEN ! received by sas in case of opa <-> sas coupling
1445	sss_m(:,:) = frcv(jpr_soce)%z3(:,:,1)
1446	CALL iom_put( 'sss_m', sss_m )
1447	ENDIF
1448	!
1449	! ! ================== !
1450	! ! SST !
1451	! ! ================== !
1452	IF( srcv(jpr_toce)%laction ) THEN ! received by sas in case of opa <-> sas coupling
1453	sst_m(:,:) = frcv(jpr_toce)%z3(:,:,1)
1454	IF( srcv(jpr_soce)%laction .AND. l_useCT ) THEN ! make sure that sst_m is the potential temperature
1455	sst_m(:,:) = eos_pt_from_ct( sst_m(:,:), sss_m(:,:) )
1456	ENDIF
1457	ENDIF
1458	! ! ================== !
1459	! ! SSH !
1460	! ! ================== !
1461	IF( srcv(jpr_ssh )%laction ) THEN ! received by sas in case of opa <-> sas coupling
1462	ssh_m(:,:) = frcv(jpr_ssh )%z3(:,:,1)
1463	CALL iom_put( 'ssh_m', ssh_m )
1464	ENDIF
1465	! ! ================== !
1466	! ! surface currents !
1467	! ! ================== !
1468	IF( srcv(jpr_ocx1)%laction ) THEN ! received by sas in case of opa <-> sas coupling
1469	ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1)
1470	ub (:,:,1) = ssu_m(:,:) ! will be used in icestp in the call of ice_forcing_tau
1471	un (:,:,1) = ssu_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling
1472	CALL iom_put( 'ssu_m', ssu_m )
1473	ENDIF
1474	IF( srcv(jpr_ocy1)%laction ) THEN
1475	ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1)
1476	vb (:,:,1) = ssv_m(:,:) ! will be used in icestp in the call of ice_forcing_tau
1477	vn (:,:,1) = ssv_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling
1478	CALL iom_put( 'ssv_m', ssv_m )
1479	ENDIF
1480	! ! ======================== !
1481	! ! first T level thickness !
1482	! ! ======================== !
1483	IF( srcv(jpr_e3t1st )%laction ) THEN ! received by sas in case of opa <-> sas coupling
1484	e3t_m(:,:) = frcv(jpr_e3t1st )%z3(:,:,1)
1485	CALL iom_put( 'e3t_m', e3t_m(:,:) )
1486	ENDIF
1487	! ! ================================ !
1488	! ! fraction of solar net radiation !
1489	! ! ================================ !
1490	IF( srcv(jpr_fraqsr)%laction ) THEN ! received by sas in case of opa <-> sas coupling
1491	frq_m(:,:) = frcv(jpr_fraqsr)%z3(:,:,1)
1492	CALL iom_put( 'frq_m', frq_m )
1493	ENDIF
1494
1495	! ! ========================= !
1496	IF( k_ice <= 1 .AND. MOD( kt-1, k_fsbc ) == 0 ) THEN ! heat & freshwater fluxes ! (Ocean only case)
1497	! ! ========================= !
1498	!
1499	! ! total freshwater fluxes over the ocean (emp)
1500	IF( srcv(jpr_oemp)%laction .OR. srcv(jpr_rain)%laction ) THEN
1501	SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) ! evaporation - precipitation
1502	CASE( 'conservative' )
1503	zemp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) )
1504	CASE( 'oce only', 'oce and ice' )
1505	zemp(:,:) = frcv(jpr_oemp)%z3(:,:,1)
1506	CASE default
1507	CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' )
1508	END SELECT
1509	ELSE
1510	zemp(:,:) = 0._wp
1511	ENDIF
1512	!
1513	! ! runoffs and calving (added in emp)
1514	IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
1515	IF( srcv(jpr_cal)%laction ) zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1)
1516
1517	IF( srcv(jpr_icb)%laction ) THEN
1518	fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1)
1519	rnf(:,:) = rnf(:,:) + fwficb(:,:) ! iceberg added to runfofs
1520	ENDIF
1521	IF( srcv(jpr_isf)%laction ) fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1) ! fresh water flux from the isf (fwfisf <0 mean melting)
1522
1523	IF( ln_mixcpl ) THEN ; emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:)
1524	ELSE ; emp(:,:) = zemp(:,:)
1525	ENDIF
1526	!
1527	! ! non solar heat flux over the ocean (qns)
1528	IF( srcv(jpr_qnsoce)%laction ) THEN ; zqns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)
1529	ELSE IF( srcv(jpr_qnsmix)%laction ) THEN ; zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
1530	ELSE ; zqns(:,:) = 0._wp
1531	END IF
1532	! update qns over the free ocean with:
1533	IF( nn_components /= jp_iam_opa ) THEN
1534	zqns(:,:) = zqns(:,:) - zemp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST)
1535	IF( srcv(jpr_snow )%laction ) THEN
1536	zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * rLfus ! energy for melting solid precipitation over the free ocean
1537	ENDIF
1538	ENDIF
1539	!
1540	IF( srcv(jpr_icb)%laction ) zqns(:,:) = zqns(:,:) - frcv(jpr_icb)%z3(:,:,1) * rLfus ! remove heat content associated to iceberg melting
1541	!
1542	IF( ln_mixcpl ) THEN ; qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:)
1543	ELSE ; qns(:,:) = zqns(:,:)
1544	ENDIF
1545
1546	! ! solar flux over the ocean (qsr)
1547	IF ( srcv(jpr_qsroce)%laction ) THEN ; zqsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1)
1548	ELSE IF( srcv(jpr_qsrmix)%laction ) then ; zqsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1)
1549	ELSE ; zqsr(:,:) = 0._wp
1550	ENDIF
1551	IF( ln_dm2dc .AND. ln_cpl ) zqsr(:,:) = sbc_dcy( zqsr ) ! modify qsr to include the diurnal cycle
1552	IF( ln_mixcpl ) THEN ; qsr(:,:) = qsr(:,:) * xcplmask(:,:,0) + zqsr(:,:) * zmsk(:,:)
1553	ELSE ; qsr(:,:) = zqsr(:,:)
1554	ENDIF
1555	!
1556	! salt flux over the ocean (received by opa in case of opa <-> sas coupling)
1557	IF( srcv(jpr_sflx )%laction ) sfx(:,:) = frcv(jpr_sflx )%z3(:,:,1)
1558	! Ice cover (received by opa in case of opa <-> sas coupling)
1559	IF( srcv(jpr_fice )%laction ) fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1)
1560	!
1561	ENDIF
1562
1563	ENDIF ! Overwrite coupling fields? (ln_couple_ow_gen)
1564	!
1565	END SUBROUTINE sbc_cpl_rcv
1566
1567
1568	SUBROUTINE sbc_cpl_ice_tau( p_taui, p_tauj )
1569	!!----------------------------------------------------------------------
1570	!! * ROUTINE sbc_cpl_ice_tau *
1571	!!
1572	!! ** Purpose : provide the stress over sea-ice in coupled mode
1573	!!
1574	!! ** Method : transform the received stress from the atmosphere into
1575	!! an atmosphere-ice stress in the (i,j) ocean referencial
1576	!! and at the velocity point of the sea-ice model:
1577	!! 'C'-grid : i- (j-) components given at U- (V-) point
1578	!!
1579	!! The received stress are :
1580	!! - defined by 3 components (if cartesian coordinate)
1581	!! or by 2 components (if spherical)
1582	!! - oriented along geographical coordinate (if eastward-northward)
1583	!! or along the local grid coordinate (if local grid)
1584	!! - given at U- and V-point, resp. if received on 2 grids
1585	!! or at a same point (T or I) if received on 1 grid
1586	!! Therefore and if necessary, they are successively
1587	!! processed in order to obtain them
1588	!! first as 2 components on the sphere
1589	!! second as 2 components oriented along the local grid
1590	!! third as 2 components on the ice grid point
1591	!!
1592	!! Except in 'oce and ice' case, only one vector stress field
1593	!! is received. It has already been processed in sbc_cpl_rcv
1594	!! so that it is now defined as (i,j) components given at U-
1595	!! and V-points, respectively.
1596	!!
1597	!! ** Action : return ptau_i, ptau_j, the stress over the ice
1598	!!----------------------------------------------------------------------
1599	REAL(wp), INTENT(out), DIMENSION(:,:) :: p_taui ! i- & j-components of atmos-ice stress [N/m2]
1600	REAL(wp), INTENT(out), DIMENSION(:,:) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid)
1601	!!
1602	INTEGER :: ji, jj ! dummy loop indices
1603	INTEGER :: itx ! index of taux over ice
1604	REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty
1605	!!----------------------------------------------------------------------
1606	!
1607	IF( srcv(jpr_itx1)%laction ) THEN ; itx = jpr_itx1
1608	ELSE ; itx = jpr_otx1
1609	ENDIF
1610
1611	! do something only if we just received the stress from atmosphere
1612	IF( nrcvinfo(itx) == OASIS_Rcv ) THEN
1613	! ! ======================= !
1614	IF( srcv(jpr_itx1)%laction ) THEN ! ice stress received !
1615	! ! ======================= !
1616	!
1617	IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere
1618	! ! (cartesian to spherical -> 3 to 2 components)
1619	CALL geo2oce( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), frcv(jpr_itz1)%z3(:,:,1), &
1620	& srcv(jpr_itx1)%clgrid, ztx, zty )
1621	frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid
1622	frcv(jpr_ity1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid
1623	!
1624	IF( srcv(jpr_itx2)%laction ) THEN
1625	CALL geo2oce( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), frcv(jpr_itz2)%z3(:,:,1), &
1626	& srcv(jpr_itx2)%clgrid, ztx, zty )
1627	frcv(jpr_itx2)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid
1628	frcv(jpr_ity2)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid
1629	ENDIF
1630	!
1631	ENDIF
1632	!
1633	IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid
1634	! ! (geographical to local grid -> rotate the components)
1635	CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->i', ztx )
1636	IF( srcv(jpr_itx2)%laction ) THEN
1637	CALL rot_rep( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), srcv(jpr_itx2)%clgrid, 'en->j', zty )
1638	ELSE
1639	CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->j', zty )
1640	ENDIF
1641	frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid
1642	frcv(jpr_ity1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 1st grid
1643	ENDIF
1644	! ! ======================= !
1645	ELSE ! use ocean stress !
1646	! ! ======================= !
1647	frcv(jpr_itx1)%z3(:,:,1) = frcv(jpr_otx1)%z3(:,:,1)
1648	frcv(jpr_ity1)%z3(:,:,1) = frcv(jpr_oty1)%z3(:,:,1)
1649	!
1650	ENDIF
1651	! ! ======================= !
1652	! ! put on ice grid !
1653	! ! ======================= !
1654	!
1655	! j+1 j -----V---F
1656	! ice stress on ice velocity point ! \|
1657	! (C-grid ==>(U,V)) j \| T U
1658	! \| \|
1659	! j j-1 -I-------\|
1660	! (for I) \| \|
1661	! i-1 i i
1662	! i i+1 (for I)
1663	SELECT CASE ( srcv(jpr_itx1)%clgrid )
1664	CASE( 'U' )
1665	p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! (U,V) ==> (U,V)
1666	p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)
1667	CASE( 'F' )
1668	DO jj = 2, jpjm1 ! F ==> (U,V)
1669	DO ji = fs_2, fs_jpim1 ! vector opt.
1670	p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji ,jj-1,1) )
1671	p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji,jj,1) + frcv(jpr_ity1)%z3(ji-1,jj ,1) )
1672	END DO
1673	END DO
1674	CASE( 'T' )
1675	DO jj = 2, jpjm1 ! T ==> (U,V)
1676	DO ji = fs_2, fs_jpim1 ! vector opt.
1677	p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj ,1) + frcv(jpr_itx1)%z3(ji,jj,1) )
1678	p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) )
1679	END DO
1680	END DO
1681	CASE( 'I' )
1682	DO jj = 2, jpjm1 ! I ==> (U,V)
1683	DO ji = 2, jpim1 ! NO vector opt.
1684	p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj ,1) )
1685	p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji+1,jj+1,1) + frcv(jpr_ity1)%z3(ji ,jj+1,1) )
1686	END DO
1687	END DO
1688	END SELECT
1689	IF( srcv(jpr_itx1)%clgrid /= 'U' ) THEN
1690	CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U', -1., p_tauj, 'V', -1. )
1691	ENDIF
1692
1693	ENDIF
1694	!
1695	END SUBROUTINE sbc_cpl_ice_tau
1696
1697
1698	SUBROUTINE sbc_cpl_ice_flx( picefr, palbi, psst, pist, phs, phi )
1699	!!----------------------------------------------------------------------
1700	!! * ROUTINE sbc_cpl_ice_flx *
1701	!!
1702	!! ** Purpose : provide the heat and freshwater fluxes of the ocean-ice system
1703	!!
1704	!! ** Method : transform the fields received from the atmosphere into
1705	!! surface heat and fresh water boundary condition for the
1706	!! ice-ocean system. The following fields are provided:
1707	!! * total non solar, solar and freshwater fluxes (qns_tot,
1708	!! qsr_tot and emp_tot) (total means weighted ice-ocean flux)
1709	!! NB: emp_tot include runoffs and calving.
1710	!! * fluxes over ice (qns_ice, qsr_ice, emp_ice) where
1711	!! emp_ice = sublimation - solid precipitation as liquid
1712	!! precipitation are re-routed directly to the ocean and
1713	!! calving directly enter the ocean (runoffs are read but included in trasbc.F90)
1714	!! * solid precipitation (sprecip), used to add to qns_tot
1715	!! the heat lost associated to melting solid precipitation
1716	!! over the ocean fraction.
1717	!! * heat content of rain, snow and evap can also be provided,
1718	!! otherwise heat flux associated with these mass flux are
1719	!! guessed (qemp_oce, qemp_ice)
1720	!!
1721	!! - the fluxes have been separated from the stress as
1722	!! (a) they are updated at each ice time step compare to
1723	!! an update at each coupled time step for the stress, and
1724	!! (b) the conservative computation of the fluxes over the
1725	!! sea-ice area requires the knowledge of the ice fraction
1726	!! after the ice advection and before the ice thermodynamics,
1727	!! so that the stress is updated before the ice dynamics
1728	!! while the fluxes are updated after it.
1729	!!
1730	!! ** Details
1731	!! qns_tot = (1-a) * qns_oce + a * qns_ice => provided
1732	!! + qemp_oce + qemp_ice => recalculated and added up to qns
1733	!!
1734	!! qsr_tot = (1-a) * qsr_oce + a * qsr_ice => provided
1735	!!
1736	!! emp_tot = emp_oce + emp_ice => calving is provided and added to emp_tot (and emp_oce).
1737	!! runoff (which includes rivers+icebergs) and iceshelf
1738	!! are provided but not included in emp here. Only runoff will
1739	!! be included in emp in other parts of NEMO code
1740	!! ** Action : update at each nf_ice time step:
1741	!! qns_tot, qsr_tot non-solar and solar total heat fluxes
1742	!! qns_ice, qsr_ice non-solar and solar heat fluxes over the ice
1743	!! emp_tot total evaporation - precipitation(liquid and solid) (-calving)
1744	!! emp_ice ice sublimation - solid precipitation over the ice
1745	!! dqns_ice d(non-solar heat flux)/d(Temperature) over the ice
1746	!! sprecip solid precipitation over the ocean
1747	!!----------------------------------------------------------------------
1748	REAL(wp), INTENT(in), DIMENSION(:,:) :: picefr ! ice fraction [0 to 1]
1749	! !! ! optional arguments, used only in 'mixed oce-ice' case
1750	REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo
1751	REAL(wp), INTENT(in), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius]
1752	REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin]
1753	REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL :: phs ! snow depth [m]
1754	REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL :: phi ! ice thickness [m]
1755	!
1756	INTEGER :: ji, jj, jl ! dummy loop index
1757	REAL(wp) :: ztri ! local scalar
1758	REAL(wp), DIMENSION(jpi,jpj) :: zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw
1759	REAL(wp), DIMENSION(jpi,jpj) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip , zevap_oce, zdevap_ice
1760	REAL(wp), DIMENSION(jpi,jpj) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice
1761	REAL(wp), DIMENSION(jpi,jpj,jpl) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice !!gm , zfrqsr_tr_i
1762	!!----------------------------------------------------------------------
1763	!
1764	IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0)
1765	ziceld(:,:) = 1._wp - picefr(:,:)
1766	zcptn (:,:) = rcp * sst_m(:,:)
1767	!
1768	! ! ========================= !
1769	! ! freshwater budget ! (emp_tot)
1770	! ! ========================= !
1771	!
1772	! ! solid Precipitation (sprecip)
1773	! ! liquid + solid Precipitation (tprecip)
1774	! ! total Evaporation - total Precipitation (emp_tot)
1775	! ! sublimation - solid precipitation (cell average) (emp_ice)
1776	SELECT CASE( TRIM( sn_rcv_emp%cldes ) )
1777	CASE( 'conservative' ) ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp
1778	zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here
1779	ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here
1780	zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:)
1781	zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * picefr(:,:)
1782	CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp
1783	zemp_tot(:,:) = ziceld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + picefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1)
1784	zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * picefr(:,:)
1785	zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1)
1786	ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:)
1787	CASE( 'none' ) ! Not available as for now: needs additional coding below when computing zevap_oce
1788	! ! since fields received are not defined with none option
1789	CALL ctl_stop( 'STOP', 'sbccpl/sbc_cpl_ice_flx: some fields are not defined. Change sn_rcv_emp value in namelist namsbc_cpl' )
1790	END SELECT
1791
1792	#if defined key_si3
1793	! zsnw = snow fraction over ice after wind blowing (=picefr if no blowing)
1794	zsnw(:,:) = 0._wp ; CALL ice_thd_snwblow( ziceld, zsnw )
1795
1796	! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- !
1797	zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( picefr(:,:) - zsnw(:,:) ) ! emp_ice = A * sublimation - zsnw * sprecip
1798	zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:) ! emp_oce = emp_tot - emp_ice
1799
1800	! --- evaporation over ocean (used later for qemp) --- !
1801	zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:)
1802
1803	! --- evaporation over ice (kg/m2/s) --- !
1804	DO jl=1,jpl
1805	IF (sn_rcv_emp%clcat == 'yes') THEN ; zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl)
1806	ELSE ; zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,1 ) ; ENDIF
1807	ENDDO
1808
1809	! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0
1810	! therefore, sublimation is not redistributed over the ice categories when no subgrid scale fluxes are provided by atm.
1811	zdevap_ice(:,:) = 0._wp
1812
1813	! --- Continental fluxes --- !
1814	IF( srcv(jpr_rnf)%laction ) THEN ! runoffs (included in emp later on)
1815	rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
1816	ENDIF
1817	IF( srcv(jpr_cal)%laction ) THEN ! calving (put in emp_tot and emp_oce)
1818	zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
1819	zemp_oce(:,:) = zemp_oce(:,:) - frcv(jpr_cal)%z3(:,:,1)
1820	ENDIF
1821	IF( srcv(jpr_icb)%laction ) THEN ! iceberg added to runoffs
1822	fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1)
1823	rnf(:,:) = rnf(:,:) + fwficb(:,:)
1824	ENDIF
1825	IF( srcv(jpr_isf)%laction ) THEN ! iceshelf (fwfisf <0 mean melting)
1826	fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1)
1827	ENDIF
1828
1829	IF( ln_mixcpl ) THEN
1830	emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:)
1831	emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:)
1832	emp_oce(:,:) = emp_oce(:,:) * xcplmask(:,:,0) + zemp_oce(:,:) * zmsk(:,:)
1833	sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:)
1834	tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:)
1835	DO jl = 1, jpl
1836	evap_ice (:,:,jl) = evap_ice (:,:,jl) * xcplmask(:,:,0) + zevap_ice (:,:,jl) * zmsk(:,:)
1837	devap_ice(:,:,jl) = devap_ice(:,:,jl) * xcplmask(:,:,0) + zdevap_ice(:,:) * zmsk(:,:)
1838	END DO
1839	ELSE
1840	emp_tot (:,:) = zemp_tot (:,:)
1841	emp_ice (:,:) = zemp_ice (:,:)
1842	emp_oce (:,:) = zemp_oce (:,:)
1843	sprecip (:,:) = zsprecip (:,:)
1844	tprecip (:,:) = ztprecip (:,:)
1845	evap_ice(:,:,:) = zevap_ice(:,:,:)
1846	DO jl = 1, jpl
1847	devap_ice(:,:,jl) = zdevap_ice(:,:)
1848	END DO
1849	ENDIF
1850
1851	#else
1852	zsnw(:,:) = picefr(:,:)
1853	! --- Continental fluxes --- !
1854	IF( srcv(jpr_rnf)%laction ) THEN ! runoffs (included in emp later on)
1855	rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
1856	ENDIF
1857	IF( srcv(jpr_cal)%laction ) THEN ! calving (put in emp_tot)
1858	zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
1859	ENDIF
1860	IF( srcv(jpr_icb)%laction ) THEN ! iceberg added to runoffs
1861	fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1)
1862	rnf(:,:) = rnf(:,:) + fwficb(:,:)
1863	ENDIF
1864	IF( srcv(jpr_isf)%laction ) THEN ! iceshelf (fwfisf <0 mean melting)
1865	fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1)
1866	ENDIF
1867	!
1868	IF( ln_mixcpl ) THEN
1869	emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:)
1870	emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:)
1871	sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:)
1872	tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:)
1873	ELSE
1874	emp_tot(:,:) = zemp_tot(:,:)
1875	emp_ice(:,:) = zemp_ice(:,:)
1876	sprecip(:,:) = zsprecip(:,:)
1877	tprecip(:,:) = ztprecip(:,:)
1878	ENDIF
1879	!
1880	#endif
1881
1882	! outputs
1883	!! IF( srcv(jpr_rnf)%laction ) CALL iom_put( 'runoffs' , rnf(:,:) * tmask(:,:,1) ) ! runoff
1884	!! IF( srcv(jpr_isf)%laction ) CALL iom_put( 'iceshelf_cea', -fwfisf(:,:) * tmask(:,:,1) ) ! iceshelf
1885	IF( srcv(jpr_cal)%laction ) CALL iom_put( 'calving_cea' , frcv(jpr_cal)%z3(:,:,1) * tmask(:,:,1) ) ! calving
1886	IF( srcv(jpr_icb)%laction ) CALL iom_put( 'iceberg_cea' , frcv(jpr_icb)%z3(:,:,1) * tmask(:,:,1) ) ! icebergs
1887	IF( iom_use('snowpre') ) CALL iom_put( 'snowpre' , sprecip(:,:) ) ! Snow
1888	IF( iom_use('precip') ) CALL iom_put( 'precip' , tprecip(:,:) ) ! total precipitation
1889	IF( iom_use('rain') ) CALL iom_put( 'rain' , tprecip(:,:) - sprecip(:,:) ) ! liquid precipitation
1890	IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average)
1891	IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average)
1892	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)
1893	IF( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) &
1894	& - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average)
1895	! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf
1896	!
1897	! ! ========================= !
1898	SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) ! non solar heat fluxes ! (qns)
1899	! ! ========================= !
1900	CASE( 'oce only' ) ! the required field is directly provided
1901	zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)
1902	CASE( 'conservative' ) ! the required fields are directly provided
1903	zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
1904	IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
1905	zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl)
1906	ELSE
1907	DO jl = 1, jpl
1908	zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) ! Set all category values equal
1909	END DO
1910	ENDIF
1911	CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes
1912	zqns_tot(:,:) = ziceld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)
1913	IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
1914	DO jl=1,jpl
1915	zqns_tot(:,: ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)
1916	zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl)
1917	ENDDO
1918	ELSE
1919	qns_tot(:,:) = qns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
1920	DO jl = 1, jpl
1921	zqns_tot(:,: ) = zqns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
1922	zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)
1923	END DO
1924	ENDIF
1925	CASE( 'mixed oce-ice' ) ! the ice flux is cumputed from the total flux, the SST and ice informations
1926	! NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED
1927	zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1)
1928	zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) &
1929	& + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * ziceld(:,:) &
1930	& + pist(:,:,1) * picefr(:,:) ) )
1931	END SELECT
1932	!
1933	! --- calving (removed from qns_tot) --- !
1934	IF( srcv(jpr_cal)%laction ) zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) * rLfus ! remove latent heat of calving
1935	! we suppose it melts at 0deg, though it should be temp. of surrounding ocean
1936	! --- iceberg (removed from qns_tot) --- !
1937	IF( srcv(jpr_icb)%laction ) zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_icb)%z3(:,:,1) * rLfus ! remove latent heat of iceberg melting
1938
1939	#if defined key_si3
1940	! --- non solar flux over ocean --- !
1941	! note: ziceld cannot be = 0 since we limit the ice concentration to amax
1942	zqns_oce = 0._wp
1943	WHERE( ziceld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / ziceld(:,:)
1944
1945	! Heat content per unit mass of snow (J/kg)
1946	WHERE( SUM( a_i, dim=3 ) > 1.e-10 ) ; zcptsnw(:,:) = rcpi * SUM( (tn_ice - rt0) * a_i, dim=3 ) / SUM( a_i, dim=3 )
1947	ELSEWHERE ; zcptsnw(:,:) = zcptn(:,:)
1948	ENDWHERE
1949	! Heat content per unit mass of rain (J/kg)
1950	zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * ziceld(:,:) )
1951
1952	! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- !
1953	zqprec_ice(:,:) = rhos * ( zcptsnw(:,:) - rLfus )
1954
1955	! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- !
1956	DO jl = 1, jpl
1957	zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * rcpi ) but atm. does not take it into account
1958	END DO
1959
1960	! --- heat flux associated with emp (W/m2) --- !
1961	zqemp_oce(:,:) = - zevap_oce(:,:) * zcptn (:,:) & ! evap
1962	& + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptrain(:,:) & ! liquid precip
1963	& + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptsnw (:,:) - rLfus ) ! solid precip over ocean + snow melting
1964	zqemp_ice(:,:) = zsprecip(:,:) * zsnw * ( zcptsnw (:,:) - rLfus ) ! solid precip over ice (qevap_ice=0 since atm. does not take it into account)
1965	!! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * zcptsnw (:,:) & ! ice evap
1966	!! & + zsprecip(:,:) * zsnw * zqprec_ice(:,:) * r1_rhos ! solid precip over ice
1967
1968	! --- total non solar flux (including evap/precip) --- !
1969	zqns_tot(:,:) = zqns_tot(:,:) + zqemp_ice(:,:) + zqemp_oce(:,:)
1970
1971	! --- in case both coupled/forced are active, we must mix values --- !
1972	IF( ln_mixcpl ) THEN
1973	qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:)
1974	qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:)
1975	DO jl=1,jpl
1976	qns_ice (:,:,jl) = qns_ice (:,:,jl) * xcplmask(:,:,0) + zqns_ice (:,:,jl)* zmsk(:,:)
1977	qevap_ice(:,:,jl) = qevap_ice(:,:,jl) * xcplmask(:,:,0) + zqevap_ice(:,:,jl)* zmsk(:,:)
1978	ENDDO
1979	qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:)
1980	qemp_oce (:,:) = qemp_oce(:,:) * xcplmask(:,:,0) + zqemp_oce(:,:)* zmsk(:,:)
1981	qemp_ice (:,:) = qemp_ice(:,:) * xcplmask(:,:,0) + zqemp_ice(:,:)* zmsk(:,:)
1982	ELSE
1983	qns_tot (:,: ) = zqns_tot (:,: )
1984	qns_oce (:,: ) = zqns_oce (:,: )
1985	qns_ice (:,:,:) = zqns_ice (:,:,:)
1986	qevap_ice(:,:,:) = zqevap_ice(:,:,:)
1987	qprec_ice(:,: ) = zqprec_ice(:,: )
1988	qemp_oce (:,: ) = zqemp_oce (:,: )
1989	qemp_ice (:,: ) = zqemp_ice (:,: )
1990	ENDIF
1991
1992	#else
1993	zcptsnw (:,:) = zcptn(:,:)
1994	zcptrain(:,:) = zcptn(:,:)
1995
1996	! clem: this formulation is certainly wrong... but better than it was...
1997	zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with:
1998	& - ( ziceld(:,:) * zsprecip(:,:) * rLfus ) & ! remove the latent heat flux of solid precip. melting
1999	& - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST)
2000	& - zemp_ice(:,:) ) * zcptn(:,:)
2001
2002	IF( ln_mixcpl ) THEN
2003	qns_tot(:,:) = qns(:,:) * ziceld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk
2004	qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:)
2005	DO jl=1,jpl
2006	qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:)
2007	ENDDO
2008	ELSE
2009	qns_tot(:,: ) = zqns_tot(:,: )
2010	qns_ice(:,:,:) = zqns_ice(:,:,:)
2011	ENDIF
2012
2013	#endif
2014	! outputs
2015	IF ( srcv(jpr_cal)%laction ) CALL iom_put('hflx_cal_cea' , - frcv(jpr_cal)%z3(:,:,1) * rLfus ) ! latent heat from calving
2016	IF ( srcv(jpr_icb)%laction ) CALL iom_put('hflx_icb_cea' , - frcv(jpr_icb)%z3(:,:,1) * rLfus ) ! latent heat from icebergs melting
2017	IF ( iom_use('hflx_rain_cea') ) CALL iom_put('hflx_rain_cea' , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) ! heat flux from rain (cell average)
2018	IF ( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea' , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) &
2019	& * picefr(:,:) ) * zcptn(:,:) * tmask(:,:,1) ) ! heat flux from evap (cell average)
2020	IF ( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea' , sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) ) ! heat flux from snow (cell average)
2021	IF ( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) &
2022	& * ( 1._wp - zsnw(:,:) ) ) ! heat flux from snow (over ocean)
2023	IF ( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) &
2024	& * zsnw(:,:) ) ! heat flux from snow (over ice)
2025	! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp.
2026	!
2027	! ! ========================= !
2028	SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) ! solar heat fluxes ! (qsr)
2029	! ! ========================= !
2030	CASE( 'oce only' )
2031	zqsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) )
2032	CASE( 'conservative' )
2033	zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)
2034	IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
2035	zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl)
2036	ELSE
2037	! Set all category values equal for the moment
2038	DO jl = 1, jpl
2039	zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
2040	END DO
2041	ENDIF
2042	zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)
2043	zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1)
2044	CASE( 'oce and ice' )
2045	zqsr_tot(:,: ) = ziceld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)
2046	IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
2047	DO jl = 1, jpl
2048	zqsr_tot(:,: ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)
2049	zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl)
2050	END DO
2051	ELSE
2052	qsr_tot(:,: ) = qsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
2053	DO jl = 1, jpl
2054	zqsr_tot(:,: ) = zqsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
2055	zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
2056	END DO
2057	ENDIF
2058	CASE( 'mixed oce-ice' )
2059	zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)
2060	! NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED
2061	! Create solar heat flux over ice using incoming solar heat flux and albedos
2062	! ( see OASIS3 user guide, 5th edition, p39 )
2063	zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) &
2064	& / ( 1.- ( alb_oce_mix(:,: ) * ziceld(:,:) &
2065	& + palbi (:,:,1) * picefr(:,:) ) )
2066	CASE( 'none' ) ! Not available as for now: needs additional coding
2067	! ! since fields received, here zqsr_tot, are not defined with none option
2068	CALL ctl_stop( 'STOP', 'sbccpl/sbc_cpl_ice_flx: some fields are not defined. Change sn_rcv_qsr value in namelist namsbc_cpl' )
2069	END SELECT
2070	IF( ln_dm2dc .AND. ln_cpl ) THEN ! modify qsr to include the diurnal cycle
2071	zqsr_tot(:,: ) = sbc_dcy( zqsr_tot(:,: ) )
2072	DO jl = 1, jpl
2073	zqsr_ice(:,:,jl) = sbc_dcy( zqsr_ice(:,:,jl) )
2074	END DO
2075	ENDIF
2076
2077	#if defined key_si3
2078	! --- solar flux over ocean --- !
2079	! note: ziceld cannot be = 0 since we limit the ice concentration to amax
2080	zqsr_oce = 0._wp
2081	WHERE( ziceld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / ziceld(:,:)
2082
2083	IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:)
2084	ELSE ; qsr_oce(:,:) = zqsr_oce(:,:) ; ENDIF
2085	#endif
2086
2087	IF( ln_mixcpl ) THEN
2088	qsr_tot(:,:) = qsr(:,:) * ziceld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk
2089	qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) + zqsr_tot(:,:)* zmsk(:,:)
2090	DO jl = 1, jpl
2091	qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) + zqsr_ice(:,:,jl)* zmsk(:,:)
2092	END DO
2093	ELSE
2094	qsr_tot(:,: ) = zqsr_tot(:,: )
2095	qsr_ice(:,:,:) = zqsr_ice(:,:,:)
2096	ENDIF
2097
2098	! ! ========================= !
2099	SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) ! d(qns)/dt !
2100	! ! ========================= !
2101	CASE ('coupled')
2102	IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN
2103	zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)
2104	ELSE
2105	! Set all category values equal for the moment
2106	DO jl=1,jpl
2107	zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)
2108	ENDDO
2109	ENDIF
2110	END SELECT
2111
2112	IF( ln_mixcpl ) THEN
2113	DO jl=1,jpl
2114	dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:)
2115	ENDDO
2116	ELSE
2117	dqns_ice(:,:,:) = zdqns_ice(:,:,:)
2118	ENDIF
2119
2120	#if defined key_si3
2121	! ! ========================= !
2122	SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! ice topmelt and botmelt !
2123	! ! ========================= !
2124	CASE ('coupled')
2125	qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:)
2126	qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:)
2127	END SELECT
2128	!
2129	! ! ========================= !
2130	! ! Transmitted Qsr ! [W/m2]
2131	! ! ========================= !
2132	IF( .NOT.ln_cndflx ) THEN !== No conduction flux as surface forcing ==!
2133	!
2134	! ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81)
2135	ztri = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ! surface transmission parameter (Grenfell Maykut 77)
2136	!
2137	qtr_ice_top(:,:,:) = ztri * qsr_ice(:,:,:)
2138	WHERE( phs(:,:,:) >= 0.0_wp ) qtr_ice_top(:,:,:) = 0._wp ! snow fully opaque
2139	WHERE( phi(:,:,:) <= 0.1_wp ) qtr_ice_top(:,:,:) = qsr_ice(:,:,:) ! thin ice transmits all solar radiation
2140	!
2141	ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN !== conduction flux as surface forcing ==!
2142	!
2143	! ! ===> here we must receive the qtr_ice_top array from the coupler
2144	! for now just assume zero (fully opaque ice)
2145	qtr_ice_top(:,:,:) = 0._wp
2146	!
2147	ENDIF
2148	!
2149	#endif
2150	!
2151	END SUBROUTINE sbc_cpl_ice_flx
2152
2153
2154	SUBROUTINE sbc_cpl_snd( kt )
2155	!!----------------------------------------------------------------------
2156	!! * ROUTINE sbc_cpl_snd *
2157	!!
2158	!! ** Purpose : provide the ocean-ice informations to the atmosphere
2159	!!
2160	!! ** Method : send to the atmosphere through a call to cpl_snd
2161	!! all the needed fields (as defined in sbc_cpl_init)
2162	!!----------------------------------------------------------------------
2163	INTEGER, INTENT(in) :: kt
2164	!
2165	INTEGER :: ji, jj, jl ! dummy loop indices
2166	INTEGER :: ikchoix
2167	INTEGER :: isec, info ! local integer
2168	REAL(wp) :: zumax, zvmax
2169	REAL(wp), DIMENSION(jpi,jpj) :: zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1
2170	REAL(wp), DIMENSION(jpi,jpj,jpl) :: ztmp3, ztmp4
2171	!!----------------------------------------------------------------------
2172	!
2173	isec = ( kt - nit000 ) * NINT( rdt ) ! date of exchanges
2174
2175	zfr_l(:,:) = 1.- fr_i(:,:)
2176	! ! ------------------------- !
2177	! ! Surface temperature ! in Kelvin
2178	! ! ------------------------- !
2179	IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN
2180
2181	IF ( nn_components == jp_iam_opa ) THEN
2182	ztmp1(:,:) = tsn(:,:,1,jp_tem) ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part
2183	ELSE
2184	! we must send the surface potential temperature
2185	IF( l_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) )
2186	ELSE ; ztmp1(:,:) = tsn(:,:,1,jp_tem)
2187	ENDIF
2188	!
2189	SELECT CASE( sn_snd_temp%cldes)
2190	CASE( 'oce only' ) ; ztmp1(:,:) = ztmp1(:,:) + rt0
2191	CASE( 'oce and ice' ) ; ztmp1(:,:) = ztmp1(:,:) + rt0
2192	SELECT CASE( sn_snd_temp%clcat )
2193	CASE( 'yes' )
2194	ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl)
2195	CASE( 'no' )
2196	WHERE( SUM( a_i, dim=3 ) /= 0. )
2197	ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 )
2198	ELSEWHERE
2199	ztmp3(:,:,1) = rt0
2200	END WHERE
2201	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
2202	END SELECT
2203	CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)
2204	SELECT CASE( sn_snd_temp%clcat )
2205	CASE( 'yes' )
2206	ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
2207	CASE( 'no' )
2208	ztmp3(:,:,:) = 0.0
2209	DO jl=1,jpl
2210	ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)
2211	ENDDO
2212	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
2213	END SELECT
2214	CASE( 'oce and weighted ice') ; ztmp1(:,:) = tsn(:,:,1,jp_tem) + rt0
2215	SELECT CASE( sn_snd_temp%clcat )
2216	CASE( 'yes' )
2217	ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
2218	CASE( 'no' )
2219	ztmp3(:,:,:) = 0.0
2220	DO jl=1,jpl
2221	ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)
2222	ENDDO
2223	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
2224	END SELECT
2225	CASE( 'mixed oce-ice' )
2226	ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)
2227	DO jl=1,jpl
2228	ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl)
2229	ENDDO
2230	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' )
2231	END SELECT
2232	ENDIF
2233	IF( ssnd(jps_toce)%laction ) CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
2234	IF( ssnd(jps_tice)%laction ) CALL cpl_snd( jps_tice, isec, ztmp3, info )
2235	IF( ssnd(jps_tmix)%laction ) CALL cpl_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
2236	ENDIF
2237	!
2238	! ! ------------------------- !
2239	! ! 1st layer ice/snow temp. !
2240	! ! ------------------------- !
2241	#if defined key_si3
2242	! needed by Met Office
2243	IF( ssnd(jps_ttilyr)%laction) THEN
2244	SELECT CASE( sn_snd_ttilyr%cldes)
2245	CASE ('weighted ice')
2246	ztmp3(:,:,1:jpl) = t1_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
2247	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ttilyr%cldes' )
2248	END SELECT
2249	IF( ssnd(jps_ttilyr)%laction ) CALL cpl_snd( jps_ttilyr, isec, ztmp3, info )
2250	ENDIF
2251	#endif
2252	! ! ------------------------- !
2253	! ! Albedo !
2254	! ! ------------------------- !
2255	IF( ssnd(jps_albice)%laction ) THEN ! ice
2256	SELECT CASE( sn_snd_alb%cldes )
2257	CASE( 'ice' )
2258	SELECT CASE( sn_snd_alb%clcat )
2259	CASE( 'yes' )
2260	ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl)
2261	CASE( 'no' )
2262	WHERE( SUM( a_i, dim=3 ) /= 0. )
2263	ztmp1(:,:) = SUM( alb_ice (:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) / SUM( a_i(:,:,1:jpl), dim=3 )
2264	ELSEWHERE
2265	ztmp1(:,:) = alb_oce_mix(:,:)
2266	END WHERE
2267	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%clcat' )
2268	END SELECT
2269	CASE( 'weighted ice' ) ;
2270	SELECT CASE( sn_snd_alb%clcat )
2271	CASE( 'yes' )
2272	ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
2273	CASE( 'no' )
2274	WHERE( fr_i (:,:) > 0. )
2275	ztmp1(:,:) = SUM ( alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 )
2276	ELSEWHERE
2277	ztmp1(:,:) = 0.
2278	END WHERE
2279	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ice%clcat' )
2280	END SELECT
2281	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' )
2282	END SELECT
2283
2284	SELECT CASE( sn_snd_alb%clcat )
2285	CASE( 'yes' )
2286	CALL cpl_snd( jps_albice, isec, ztmp3, info ) !-> MV this has never been checked in coupled mode
2287	CASE( 'no' )
2288	CALL cpl_snd( jps_albice, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
2289	END SELECT
2290	ENDIF
2291
2292	IF( ssnd(jps_albmix)%laction ) THEN ! mixed ice-ocean
2293	ztmp1(:,:) = alb_oce_mix(:,:) * zfr_l(:,:)
2294	DO jl = 1, jpl
2295	ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl)
2296	END DO
2297	CALL cpl_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
2298	ENDIF
2299	! ! ------------------------- !
2300	! ! Ice fraction & Thickness !
2301	! ! ------------------------- !
2302	! Send ice fraction field to atmosphere
2303	IF( ssnd(jps_fice)%laction ) THEN
2304	SELECT CASE( sn_snd_thick%clcat )
2305	CASE( 'yes' ) ; ztmp3(:,:,1:jpl) = a_i(:,:,1:jpl)
2306	CASE( 'no' ) ; ztmp3(:,:,1 ) = fr_i(:,: )
2307	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
2308	END SELECT
2309	IF( ssnd(jps_fice)%laction ) CALL cpl_snd( jps_fice, isec, ztmp3, info )
2310	ENDIF
2311
2312	IF( ssnd(jps_fice1)%laction ) THEN
2313	SELECT CASE( sn_snd_thick1%clcat )
2314	CASE( 'yes' ) ; ztmp3(:,:,1:jpl) = a_i(:,:,1:jpl)
2315	CASE( 'no' ) ; ztmp3(:,:,1 ) = fr_i(:,: )
2316	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick1%clcat' )
2317	END SELECT
2318	CALL cpl_snd( jps_fice1, isec, ztmp3, info )
2319	ENDIF
2320
2321	! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling)
2322	IF( ssnd(jps_fice2)%laction ) THEN
2323	ztmp3(:,:,1) = fr_i(:,:)
2324	IF( ssnd(jps_fice2)%laction ) CALL cpl_snd( jps_fice2, isec, ztmp3, info )
2325	ENDIF
2326
2327	! Send ice and snow thickness field
2328	IF( ssnd(jps_hice)%laction .OR. ssnd(jps_hsnw)%laction ) THEN
2329	SELECT CASE( sn_snd_thick%cldes)
2330	CASE( 'none' ) ! nothing to do
2331	CASE( 'weighted ice and snow' )
2332	SELECT CASE( sn_snd_thick%clcat )
2333	CASE( 'yes' )
2334	ztmp3(:,:,1:jpl) = h_i(:,:,1:jpl) * a_i(:,:,1:jpl)
2335	ztmp4(:,:,1:jpl) = h_s(:,:,1:jpl) * a_i(:,:,1:jpl)
2336	CASE( 'no' )
2337	ztmp3(:,:,:) = 0.0 ; ztmp4(:,:,:) = 0.0
2338	DO jl=1,jpl
2339	ztmp3(:,:,1) = ztmp3(:,:,1) + h_i(:,:,jl) * a_i(:,:,jl)
2340	ztmp4(:,:,1) = ztmp4(:,:,1) + h_s(:,:,jl) * a_i(:,:,jl)
2341	ENDDO
2342	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
2343	END SELECT
2344	CASE( 'ice and snow' )
2345	SELECT CASE( sn_snd_thick%clcat )
2346	CASE( 'yes' )
2347	ztmp3(:,:,1:jpl) = h_i(:,:,1:jpl)
2348	ztmp4(:,:,1:jpl) = h_s(:,:,1:jpl)
2349	CASE( 'no' )
2350	WHERE( SUM( a_i, dim=3 ) /= 0. )
2351	ztmp3(:,:,1) = SUM( h_i * a_i, dim=3 ) / SUM( a_i, dim=3 )
2352	ztmp4(:,:,1) = SUM( h_s * a_i, dim=3 ) / SUM( a_i, dim=3 )
2353	ELSEWHERE
2354	ztmp3(:,:,1) = 0.
2355	ztmp4(:,:,1) = 0.
2356	END WHERE
2357	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
2358	END SELECT
2359	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' )
2360	END SELECT
2361	IF( ssnd(jps_hice)%laction ) CALL cpl_snd( jps_hice, isec, ztmp3, info )
2362	IF( ssnd(jps_hsnw)%laction ) CALL cpl_snd( jps_hsnw, isec, ztmp4, info )
2363	ENDIF
2364
2365	#if defined key_si3
2366	! ! ------------------------- !
2367	! ! Ice melt ponds !
2368	! ! ------------------------- !
2369	! needed by Met Office
2370	IF( ssnd(jps_a_p)%laction .OR. ssnd(jps_ht_p)%laction ) THEN
2371	SELECT CASE( sn_snd_mpnd%cldes)
2372	CASE( 'ice only' )
2373	SELECT CASE( sn_snd_mpnd%clcat )
2374	CASE( 'yes' )
2375	ztmp3(:,:,1:jpl) = a_ip(:,:,1:jpl)
2376	ztmp4(:,:,1:jpl) = v_ip(:,:,1:jpl)
2377	CASE( 'no' )
2378	ztmp3(:,:,:) = 0.0
2379	ztmp4(:,:,:) = 0.0
2380	DO jl=1,jpl
2381	ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip(:,:,jpl)
2382	ztmp4(:,:,1) = ztmp4(:,:,1) + v_ip(:,:,jpl)
2383	ENDDO
2384	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%clcat' )
2385	END SELECT
2386	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%cldes' )
2387	END SELECT
2388	IF( ssnd(jps_a_p)%laction ) CALL cpl_snd( jps_a_p , isec, ztmp3, info )
2389	IF( ssnd(jps_ht_p)%laction ) CALL cpl_snd( jps_ht_p, isec, ztmp4, info )
2390	ENDIF
2391	!
2392	! ! ------------------------- !
2393	! ! Ice conductivity !
2394	! ! ------------------------- !
2395	! needed by Met Office
2396	IF( ssnd(jps_kice)%laction ) THEN
2397	SELECT CASE( sn_snd_cond%cldes)
2398	CASE( 'weighted ice' )
2399	SELECT CASE( sn_snd_cond%clcat )
2400	CASE( 'yes' )
2401	ztmp3(:,:,1:jpl) = cnd_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
2402	CASE( 'no' )
2403	ztmp3(:,:,:) = 0.0
2404	DO jl=1,jpl
2405	ztmp3(:,:,1) = ztmp3(:,:,1) + cnd_ice(:,:,jl) * a_i(:,:,jl)
2406	ENDDO
2407	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%clcat' )
2408	END SELECT
2409	CASE( 'ice only' )
2410	ztmp3(:,:,1:jpl) = cnd_ice(:,:,1:jpl)
2411	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%cldes' )
2412	END SELECT
2413	IF( ssnd(jps_kice)%laction ) CALL cpl_snd( jps_kice, isec, ztmp3, info )
2414	ENDIF
2415	#endif
2416
2417	! ! ------------------------- !
2418	! ! CO2 flux from PISCES !
2419	! ! ------------------------- !
2420	IF( ssnd(jps_co2)%laction .AND. l_co2cpl ) CALL cpl_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info )
2421	!
2422	! ! ------------------------- !
2423	IF( ssnd(jps_ocx1)%laction ) THEN ! Surface current !
2424	! ! ------------------------- !
2425	!
2426	! j+1 j -----V---F
2427	! surface velocity always sent from T point ! \|
2428	! [except for HadGEM3] j \| T U
2429	! \| \|
2430	! j j-1 -I-------\|
2431	! (for I) \| \|
2432	! i-1 i i
2433	! i i+1 (for I)
2434	IF( nn_components == jp_iam_opa ) THEN
2435	zotx1(:,:) = un(:,:,1)
2436	zoty1(:,:) = vn(:,:,1)
2437	ELSE
2438	SELECT CASE( TRIM( sn_snd_crt%cldes ) )
2439	CASE( 'oce only' ) ! C-grid ==> T
2440	IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN
2441	DO jj = 2, jpjm1
2442	DO ji = fs_2, fs_jpim1 ! vector opt.
2443	zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) )
2444	zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) )
2445	END DO
2446	END DO
2447	ELSE
2448	! Temporarily Changed for UKV
2449	DO jj = 2, jpjm1
2450	DO ji = 2, jpim1
2451	zotx1(ji,jj) = un(ji,jj,1)
2452	zoty1(ji,jj) = vn(ji,jj,1)
2453	END DO
2454	END DO
2455	ENDIF
2456	CASE( 'weighted oce and ice' ) ! Ocean and Ice on C-grid ==> T
2457	DO jj = 2, jpjm1
2458	DO ji = fs_2, fs_jpim1 ! vector opt.
2459	zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj)
2460	zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj)
2461	zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj)
2462	zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj)
2463	END DO
2464	END DO
2465	CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1., zity1, 'T', -1. )
2466	CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T
2467	DO jj = 2, jpjm1
2468	DO ji = fs_2, fs_jpim1 ! vector opt.
2469	zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) &
2470	& + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj)
2471	zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) &
2472	& + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj)
2473	END DO
2474	END DO
2475	END SELECT
2476	CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1., zoty1, ssnd(jps_ocy1)%clgrid, -1. )
2477	!
2478	ENDIF
2479	!
2480	!
2481	IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components
2482	! ! Ocean component
2483	IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN
2484	CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component
2485	CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component
2486	zotx1(:,:) = ztmp1(:,:) ! overwrite the components
2487	zoty1(:,:) = ztmp2(:,:)
2488	IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component
2489	CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component
2490	CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component
2491	zitx1(:,:) = ztmp1(:,:) ! overwrite the components
2492	zity1(:,:) = ztmp2(:,:)
2493	ENDIF
2494	ELSE
2495	! Temporary code for HadGEM3 - will be removed eventually.
2496	! Only applies when we want uvel on U grid and vvel on V grid
2497	! Rotate U and V onto geographic grid before sending.
2498
2499	DO jj=2,jpjm1
2500	DO ji=2,jpim1
2501	ztmp1(ji,jj)=0.25*vmask(ji,jj,1) &
2502	*(zotx1(ji,jj)+zotx1(ji-1,jj) &
2503	+zotx1(ji,jj+1)+zotx1(ji-1,jj+1))
2504	ztmp2(ji,jj)=0.25*umask(ji,jj,1) &
2505	*(zoty1(ji,jj)+zoty1(ji+1,jj) &
2506	+zoty1(ji,jj-1)+zoty1(ji+1,jj-1))
2507	ENDDO
2508	ENDDO
2509
2510	! Ensure any N fold and wrap columns are updated
2511	CALL lbc_lnk('zotx1', ztmp1, 'V', -1.0)
2512	CALL lbc_lnk('zoty1', ztmp2, 'U', -1.0)
2513
2514	ikchoix = -1
2515	CALL repcmo (zotx1,ztmp2,ztmp1,zoty1,zotx1,zoty1,ikchoix)
2516	ENDIF
2517	ENDIF
2518	!
2519	! spherical coordinates to cartesian -> 2 components to 3 components
2520	IF( TRIM( sn_snd_crt%clvref ) == 'cartesian' ) THEN
2521	ztmp1(:,:) = zotx1(:,:) ! ocean currents
2522	ztmp2(:,:) = zoty1(:,:)
2523	CALL oce2geo ( ztmp1, ztmp2, 'T', zotx1, zoty1, zotz1 )
2524	!
2525	IF( ssnd(jps_ivx1)%laction ) THEN ! ice velocities
2526	ztmp1(:,:) = zitx1(:,:)
2527	ztmp1(:,:) = zity1(:,:)
2528	CALL oce2geo ( ztmp1, ztmp2, 'T', zitx1, zity1, zitz1 )
2529	ENDIF
2530	ENDIF
2531	!
2532	IF( ssnd(jps_ocx1)%laction ) CALL cpl_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info ) ! ocean x current 1st grid
2533	IF( ssnd(jps_ocy1)%laction ) CALL cpl_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info ) ! ocean y current 1st grid
2534	IF( ssnd(jps_ocz1)%laction ) CALL cpl_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info ) ! ocean z current 1st grid
2535	!
2536	IF( ssnd(jps_ivx1)%laction ) CALL cpl_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info ) ! ice x current 1st grid
2537	IF( ssnd(jps_ivy1)%laction ) CALL cpl_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info ) ! ice y current 1st grid
2538	IF( ssnd(jps_ivz1)%laction ) CALL cpl_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info ) ! ice z current 1st grid
2539	!
2540	ENDIF
2541	!
2542	! ! ------------------------- !
2543	! ! Surface current to waves !
2544	! ! ------------------------- !
2545	IF( ssnd(jps_ocxw)%laction .OR. ssnd(jps_ocyw)%laction ) THEN
2546	!
2547	! j+1 j -----V---F
2548	! surface velocity always sent from T point ! \|
2549	! j \| T U
2550	! \| \|
2551	! j j-1 -I-------\|
2552	! (for I) \| \|
2553	! i-1 i i
2554	! i i+1 (for I)
2555	SELECT CASE( TRIM( sn_snd_crtw%cldes ) )
2556	CASE( 'oce only' ) ! C-grid ==> T
2557	DO jj = 2, jpjm1
2558	DO ji = fs_2, fs_jpim1 ! vector opt.
2559	zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) )
2560	zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji , jj-1,1) )
2561	END DO
2562	END DO
2563	CASE( 'weighted oce and ice' ) ! Ocean and Ice on C-grid ==> T
2564	DO jj = 2, jpjm1
2565	DO ji = fs_2, fs_jpim1 ! vector opt.
2566	zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj)
2567	zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj)
2568	zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj)
2569	zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj)
2570	END DO
2571	END DO
2572	CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1., zity1, 'T', -1. )
2573	CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T
2574	DO jj = 2, jpjm1
2575	DO ji = fs_2, fs_jpim1 ! vector opt.
2576	zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) &
2577	& + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj)
2578	zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) &
2579	& + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj)
2580	END DO
2581	END DO
2582	END SELECT
2583	CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1., zoty1, ssnd(jps_ocyw)%clgrid, -1. )
2584	!
2585	!
2586	IF( TRIM( sn_snd_crtw%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components
2587	! ! Ocean component
2588	CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->e', ztmp1 ) ! 1st component
2589	CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->n', ztmp2 ) ! 2nd component
2590	zotx1(:,:) = ztmp1(:,:) ! overwrite the components
2591	zoty1(:,:) = ztmp2(:,:)
2592	IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component
2593	CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component
2594	CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component
2595	zitx1(:,:) = ztmp1(:,:) ! overwrite the components
2596	zity1(:,:) = ztmp2(:,:)
2597	ENDIF
2598	ENDIF
2599	!
2600	! ! spherical coordinates to cartesian -> 2 components to 3 components
2601	! IF( TRIM( sn_snd_crtw%clvref ) == 'cartesian' ) THEN
2602	! ztmp1(:,:) = zotx1(:,:) ! ocean currents
2603	! ztmp2(:,:) = zoty1(:,:)
2604	! CALL oce2geo ( ztmp1, ztmp2, 'T', zotx1, zoty1, zotz1 )
2605	! !
2606	! IF( ssnd(jps_ivx1)%laction ) THEN ! ice velocities
2607	! ztmp1(:,:) = zitx1(:,:)
2608	! ztmp1(:,:) = zity1(:,:)
2609	! CALL oce2geo ( ztmp1, ztmp2, 'T', zitx1, zity1, zitz1 )
2610	! ENDIF
2611	! ENDIF
2612	!
2613	IF( ssnd(jps_ocxw)%laction ) CALL cpl_snd( jps_ocxw, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info ) ! ocean x current 1st grid
2614	IF( ssnd(jps_ocyw)%laction ) CALL cpl_snd( jps_ocyw, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info ) ! ocean y current 1st grid
2615	!
2616	ENDIF
2617	!
2618	IF( ssnd(jps_ficet)%laction ) THEN
2619	CALL cpl_snd( jps_ficet, isec, RESHAPE ( fr_i, (/jpi,jpj,1/) ), info )
2620	END IF
2621	! ! ------------------------- !
2622	! ! Water levels to waves !
2623	! ! ------------------------- !
2624	IF( ssnd(jps_wlev)%laction ) THEN
2625	IF( ln_apr_dyn ) THEN
2626	IF( kt /= nit000 ) THEN
2627	ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
2628	ELSE
2629	ztmp1(:,:) = sshb(:,:)
2630	ENDIF
2631	ELSE
2632	ztmp1(:,:) = sshn(:,:)
2633	ENDIF
2634	CALL cpl_snd( jps_wlev , isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
2635	END IF
2636	!
2637	! Fields sent by OPA to SAS when doing OPA<->SAS coupling
2638	! ! SSH
2639	IF( ssnd(jps_ssh )%laction ) THEN
2640	! ! removed inverse barometer ssh when Patm
2641	! forcing is used (for sea-ice dynamics)
2642	IF( ln_apr_dyn ) THEN ; ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
2643	ELSE ; ztmp1(:,:) = sshn(:,:)
2644	ENDIF
2645	CALL cpl_snd( jps_ssh , isec, RESHAPE ( ztmp1 , (/jpi,jpj,1/) ), info )
2646
2647	ENDIF
2648	! ! SSS
2649	IF( ssnd(jps_soce )%laction ) THEN
2650	CALL cpl_snd( jps_soce , isec, RESHAPE ( tsn(:,:,1,jp_sal), (/jpi,jpj,1/) ), info )
2651	ENDIF
2652	! ! first T level thickness
2653	IF( ssnd(jps_e3t1st )%laction ) THEN
2654	CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t_n(:,:,1) , (/jpi,jpj,1/) ), info )
2655	ENDIF
2656	! ! Qsr fraction
2657	IF( ssnd(jps_fraqsr)%laction ) THEN
2658	CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( fraqsr_1lev(:,:) , (/jpi,jpj,1/) ), info )
2659	ENDIF
2660	!
2661	! Fields sent by SAS to OPA when OASIS coupling
2662	! ! Solar heat flux
2663	IF( ssnd(jps_qsroce)%laction ) CALL cpl_snd( jps_qsroce, isec, RESHAPE ( qsr , (/jpi,jpj,1/) ), info )
2664	IF( ssnd(jps_qnsoce)%laction ) CALL cpl_snd( jps_qnsoce, isec, RESHAPE ( qns , (/jpi,jpj,1/) ), info )
2665	IF( ssnd(jps_oemp )%laction ) CALL cpl_snd( jps_oemp , isec, RESHAPE ( emp , (/jpi,jpj,1/) ), info )
2666	IF( ssnd(jps_sflx )%laction ) CALL cpl_snd( jps_sflx , isec, RESHAPE ( sfx , (/jpi,jpj,1/) ), info )
2667	IF( ssnd(jps_otx1 )%laction ) CALL cpl_snd( jps_otx1 , isec, RESHAPE ( utau, (/jpi,jpj,1/) ), info )
2668	IF( ssnd(jps_oty1 )%laction ) CALL cpl_snd( jps_oty1 , isec, RESHAPE ( vtau, (/jpi,jpj,1/) ), info )
2669	IF( ssnd(jps_rnf )%laction ) CALL cpl_snd( jps_rnf , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info )
2670	IF( ssnd(jps_taum )%laction ) CALL cpl_snd( jps_taum , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info )
2671
2672	#if defined key_si3
2673	! ! ------------------------- !
2674	! ! Sea surface freezing temp !
2675	! ! ------------------------- !
2676	! needed by Met Office
2677	CALL eos_fzp(tsn(:,:,1,jp_sal), sstfrz)
2678	ztmp1(:,:) = sstfrz(:,:) + rt0
2679	IF( ssnd(jps_sstfrz)%laction ) CALL cpl_snd( jps_sstfrz, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info)
2680	#endif
2681
2682
2683	IF ( ssnd(jps_dummy_t)%laction ) THEN
2684	! RSRH Just set up some arbitrary test pattern for now
2685	ztmp1(:,:) = 1.e+20
2686	DO jj = 1, jpj
2687	DO ji = 1, jpi
2688	IF (tmask(ji,jj,1) > 0.5) THEN
2689	ztmp1(ji,jj) = kt + (glamt(ji,jj) * gphit(ji,jj))
2690	ENDIF
2691	ENDDO
2692	ENDDO
2693	CALL cpl_snd( jps_dummy_t, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
2694	ENDIF
2695
2696	!
2697	END SUBROUTINE sbc_cpl_snd
2698
2699	!!======================================================================
2700	END MODULE sbccpl

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

Download in other formats: