Context Navigation

sbccpl.F90 @ 8847

Last change on this file since 8847 was 8847, checked in by alexwestmohc, 6 years ago

Implementing new logicals to control coupling:

ln_meto_cpl - .TRUE. if Met Office style coupling is being used, i.e. if the
surface exchange is in the atmosphere. .FALSE. by default

nn_cats_cpl - the number of sea ice categories over which the coupling is being
carried out. 5 by default

In addition, the calculation of meltpond area, depth, top layer ice/snow temp
and sea surface freezing temperature has been corrected to be appropriate to LIM
variable names.

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

Download in other formats: