Context Navigation

sbccpl.F90 @ 8892

Last change on this file since 8892 was 8892, checked in by frrh, 7 years ago
Commit updates with debugging write statements.
File size: 170.2 KB

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

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

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

Context Navigation

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

Download in other formats: