Context Navigation

source: CONFIG/UNIFORM/v6/IPSLCM6.3/SOURCES/NEMO/sbccpl.F90 @ 6793

Last change on this file since 6793 was 6793, checked in by acosce, 6 weeks ago
Add sbccpl routine need for coupling n2o between ocean and atmosphere
File size: 133.2 KB

Line
1	MODULE sbccpl
2	!!======================================================================
3	!! * MODULE sbccpl *
4	!! Surface Boundary Condition : momentum, heat and freshwater fluxes in coupled mode
5	!!======================================================================
6	!! History : 2.0 ! 2007-06 (R. Redler, N. Keenlyside, W. Park) Original code split into flxmod & taumod
7	!! 3.0 ! 2008-02 (G. Madec, C Talandier) surface module
8	!! 3.1 ! 2009_02 (G. Madec, S. Masson, E. Maisonave, A. Caubel) generic coupled interface
9	!! 3.4 ! 2011_11 (C. Harris) more flexibility + multi-category fields
10	!!----------------------------------------------------------------------
11	!!----------------------------------------------------------------------
12	!! namsbc_cpl : coupled formulation namlist
13	!! sbc_cpl_init : initialisation of the coupled exchanges
14	!! sbc_cpl_rcv : receive fields from the atmosphere over the ocean (ocean only)
15	!! receive stress from the atmosphere over the ocean (ocean-ice case)
16	!! sbc_cpl_ice_tau : receive stress from the atmosphere over ice
17	!! sbc_cpl_ice_flx : receive fluxes from the atmosphere over ice
18	!! sbc_cpl_snd : send fields to the atmosphere
19	!!----------------------------------------------------------------------
20	USE dom_oce ! ocean space and time domain
21	USE sbc_oce ! Surface boundary condition: ocean fields
22	USE sbc_ice ! Surface boundary condition: ice fields
23	USE sbcapr
24	USE sbcdcy ! surface boundary condition: diurnal cycle
25	USE phycst ! physical constants
26	#if defined key_lim3
27	USE ice ! ice variables
28	#endif
29	#if defined key_lim2
30	USE par_ice_2 ! ice parameters
31	USE ice_2 ! ice variables
32	#endif
33	USE cpl_oasis3 ! OASIS3 coupling
34	USE geo2ocean !
35	USE oce , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev
36	USE albedo !
37	USE in_out_manager ! I/O manager
38	USE iom ! NetCDF library
39	USE lib_mpp ! distribued memory computing library
40	USE wrk_nemo ! work arrays
41	USE timing ! Timing
42	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
43	USE eosbn2
44	USE sbcrnf , ONLY : l_rnfcpl
45	USE sbcisf , ONLY : l_isfcpl
46	#if defined key_cpl_carbon_cycle
47	USE p4zflx, ONLY : oce_co2
48	#endif
49	USE p4zflx, ONLY : oce_dms, oce_n2o
50	#if defined key_cice
51	USE ice_domain_size, only: ncat
52	#endif
53	#if defined key_lim3
54	USE limthd_dh ! for CALL lim_thd_snwblow
55	#endif
56	USE closea
57
58	IMPLICIT NONE
59	PRIVATE
60
61	PUBLIC sbc_cpl_init ! routine called by sbcmod.F90
62	PUBLIC sbc_cpl_rcv ! routine called by sbc_ice_lim(_2).F90
63	PUBLIC sbc_cpl_snd ! routine called by step.F90
64	PUBLIC sbc_cpl_ice_tau ! routine called by sbc_ice_lim(_2).F90
65	PUBLIC sbc_cpl_ice_flx ! routine called by sbc_ice_lim(_2).F90
66	PUBLIC sbc_cpl_alloc ! routine called in sbcice_cice.F90
67
68	INTEGER, PARAMETER :: jpr_otx1 = 1 ! 3 atmosphere-ocean stress components on grid 1
69	INTEGER, PARAMETER :: jpr_oty1 = 2 !
70	INTEGER, PARAMETER :: jpr_otz1 = 3 !
71	INTEGER, PARAMETER :: jpr_otx2 = 4 ! 3 atmosphere-ocean stress components on grid 2
72	INTEGER, PARAMETER :: jpr_oty2 = 5 !
73	INTEGER, PARAMETER :: jpr_otz2 = 6 !
74	INTEGER, PARAMETER :: jpr_itx1 = 7 ! 3 atmosphere-ice stress components on grid 1
75	INTEGER, PARAMETER :: jpr_ity1 = 8 !
76	INTEGER, PARAMETER :: jpr_itz1 = 9 !
77	INTEGER, PARAMETER :: jpr_itx2 = 10 ! 3 atmosphere-ice stress components on grid 2
78	INTEGER, PARAMETER :: jpr_ity2 = 11 !
79	INTEGER, PARAMETER :: jpr_itz2 = 12 !
80	INTEGER, PARAMETER :: jpr_qsroce = 13 ! Qsr above the ocean
81	INTEGER, PARAMETER :: jpr_qsrice = 14 ! Qsr above the ice
82	INTEGER, PARAMETER :: jpr_qsrmix = 15
83	INTEGER, PARAMETER :: jpr_qnsoce = 16 ! Qns above the ocean
84	INTEGER, PARAMETER :: jpr_qnsice = 17 ! Qns above the ice
85	INTEGER, PARAMETER :: jpr_qnsmix = 18
86	INTEGER, PARAMETER :: jpr_rain = 19 ! total liquid precipitation (rain)
87	INTEGER, PARAMETER :: jpr_snow = 20 ! solid precipitation over the ocean (snow)
88	INTEGER, PARAMETER :: jpr_tevp = 21 ! total evaporation
89	INTEGER, PARAMETER :: jpr_ievp = 22 ! solid evaporation (sublimation)
90	INTEGER, PARAMETER :: jpr_sbpr = 23 ! sublimation - liquid precipitation - solid precipitation
91	INTEGER, PARAMETER :: jpr_semp = 24 ! solid freshwater budget (sublimation - snow)
92	INTEGER, PARAMETER :: jpr_oemp = 25 ! ocean freshwater budget (evap - precip)
93	INTEGER, PARAMETER :: jpr_w10m = 26 ! 10m wind
94	INTEGER, PARAMETER :: jpr_dqnsdt = 27 ! d(Q non solar)/d(temperature)
95	INTEGER, PARAMETER :: jpr_rnf = 28 ! runoffs
96	INTEGER, PARAMETER :: jpr_cal = 29 ! calving
97	INTEGER, PARAMETER :: jpr_taum = 30 ! wind stress module
98	INTEGER, PARAMETER :: jpr_co2 = 31
99	INTEGER, PARAMETER :: jpr_topm = 32 ! topmeltn
100	INTEGER, PARAMETER :: jpr_botm = 33 ! botmeltn
101	INTEGER, PARAMETER :: jpr_sflx = 34 ! salt flux
102	INTEGER, PARAMETER :: jpr_toce = 35 ! ocean temperature
103	INTEGER, PARAMETER :: jpr_soce = 36 ! ocean salinity
104	INTEGER, PARAMETER :: jpr_ocx1 = 37 ! ocean current on grid 1
105	INTEGER, PARAMETER :: jpr_ocy1 = 38 !
106	INTEGER, PARAMETER :: jpr_ssh = 39 ! sea surface height
107	INTEGER, PARAMETER :: jpr_fice = 40 ! ice fraction
108	INTEGER, PARAMETER :: jpr_e3t1st = 41 ! first T level thickness
109	INTEGER, PARAMETER :: jpr_fraqsr = 42 ! fraction of solar net radiation absorbed in the first ocean level
110	INTEGER, PARAMETER :: jpr_isf = 43
111	INTEGER, PARAMETER :: jpr_icb = 44
112	INTEGER, PARAMETER :: jprcv = 44 ! total number of fields received
113
114	INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere
115	INTEGER, PARAMETER :: jps_toce = 2 ! ocean temperature
116	INTEGER, PARAMETER :: jps_tice = 3 ! ice temperature
117	INTEGER, PARAMETER :: jps_tmix = 4 ! mixed temperature (ocean+ice)
118	INTEGER, PARAMETER :: jps_albice = 5 ! ice albedo
119	INTEGER, PARAMETER :: jps_albmix = 6 ! mixed albedo
120	INTEGER, PARAMETER :: jps_hice = 7 ! ice thickness
121	INTEGER, PARAMETER :: jps_hsnw = 8 ! snow thickness
122	INTEGER, PARAMETER :: jps_ocx1 = 9 ! ocean current on grid 1
123	INTEGER, PARAMETER :: jps_ocy1 = 10 !
124	INTEGER, PARAMETER :: jps_ocz1 = 11 !
125	INTEGER, PARAMETER :: jps_ivx1 = 12 ! ice current on grid 1
126	INTEGER, PARAMETER :: jps_ivy1 = 13 !
127	INTEGER, PARAMETER :: jps_ivz1 = 14 !
128	INTEGER, PARAMETER :: jps_co2 = 15
129	INTEGER, PARAMETER :: jps_soce = 16 ! ocean salinity
130	INTEGER, PARAMETER :: jps_ssh = 17 ! sea surface height
131	INTEGER, PARAMETER :: jps_qsroce = 18 ! Qsr above the ocean
132	INTEGER, PARAMETER :: jps_qnsoce = 19 ! Qns above the ocean
133	INTEGER, PARAMETER :: jps_oemp = 20 ! ocean freshwater budget (evap - precip)
134	INTEGER, PARAMETER :: jps_sflx = 21 ! salt flux
135	INTEGER, PARAMETER :: jps_otx1 = 22 ! 2 atmosphere-ocean stress components on grid 1
136	INTEGER, PARAMETER :: jps_oty1 = 23 !
137	INTEGER, PARAMETER :: jps_rnf = 24 ! runoffs
138	INTEGER, PARAMETER :: jps_taum = 25 ! wind stress module
139	INTEGER, PARAMETER :: jps_fice2 = 26 ! ice fraction sent to OPA (by SAS when doing SAS-OPA coupling)
140	INTEGER, PARAMETER :: jps_e3t1st = 27 ! first level depth (vvl)
141	INTEGER, PARAMETER :: jps_fraqsr = 28 ! fraction of solar net radiation absorbed in the first ocean level
142	INTEGER, PARAMETER :: jps_dms = 29 ! Ocean DMS
143	INTEGER, PARAMETER :: jps_n2o = 30 ! Ocean N2O
144	INTEGER, PARAMETER :: jpsnd = 30 ! total number of fields sent
145
146	! !! namelist namsbc_cpl
147	TYPE :: FLD_C
148	CHARACTER(len = 32) :: cldes ! desciption of the coupling strategy
149	CHARACTER(len = 32) :: clcat ! multiple ice categories strategy
150	CHARACTER(len = 32) :: clvref ! reference of vector ('spherical' or 'cartesian')
151	CHARACTER(len = 32) :: clvor ! orientation of vector fields ('eastward-northward' or 'local grid')
152	CHARACTER(len = 32) :: clvgrd ! grids on which is located the vector fields
153	END TYPE FLD_C
154	! Sent to the atmosphere !
155	TYPE(FLD_C) :: sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2, sn_snd_dms, sn_snd_n2o
156	! Received from the atmosphere !
157	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
158	TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_icb, sn_rcv_isf
159	! Other namelist parameters !
160	INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data
161	LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models
162	! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel)
163	TYPE :: DYNARR
164	REAL(wp), POINTER, DIMENSION(:,:,:) :: z3
165	END TYPE DYNARR
166
167	TYPE( DYNARR ), SAVE, DIMENSION(jprcv) :: frcv ! all fields recieved from the atmosphere
168
169	REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: albedo_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky)
170
171	INTEGER , ALLOCATABLE, SAVE, DIMENSION( :) :: nrcvinfo ! OASIS info argument
172
173	!! Substitution
174	# include "domzgr_substitute.h90"
175	# include "vectopt_loop_substitute.h90"
176	!!----------------------------------------------------------------------
177	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
178	!! $Id: sbccpl.F90 9429 2018-03-26 14:42:05Z nicolasmartin $
179	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
180	!!----------------------------------------------------------------------
181
182	CONTAINS
183
184	INTEGER FUNCTION sbc_cpl_alloc()
185	!!----------------------------------------------------------------------
186	!! * FUNCTION sbc_cpl_alloc *
187	!!----------------------------------------------------------------------
188	INTEGER :: ierr(3)
189	!!----------------------------------------------------------------------
190	ierr(:) = 0
191	!
192	ALLOCATE( albedo_oce_mix(jpi,jpj), nrcvinfo(jprcv), STAT=ierr(1) )
193
194	#if ! defined key_lim3 && ! defined key_lim2 && ! defined key_cice
195	ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) ) ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init)
196	#endif
197	ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) )
198	!
199	sbc_cpl_alloc = MAXVAL( ierr )
200	IF( lk_mpp ) CALL mpp_sum ( sbc_cpl_alloc )
201	IF( sbc_cpl_alloc > 0 ) CALL ctl_warn('sbc_cpl_alloc: allocation of arrays failed')
202	!
203	END FUNCTION sbc_cpl_alloc
204
205
206	SUBROUTINE sbc_cpl_init( k_ice )
207	!!----------------------------------------------------------------------
208	!! * ROUTINE sbc_cpl_init *
209	!!
210	!! ** Purpose : Initialisation of send and received information from
211	!! the atmospheric component
212	!!
213	!! ** Method : * Read namsbc_cpl namelist
214	!! * define the receive interface
215	!! * define the send interface
216	!! * initialise the OASIS coupler
217	!!----------------------------------------------------------------------
218	INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3)
219	!!
220	INTEGER :: jn ! dummy loop index
221	INTEGER :: ios ! Local integer output status for namelist read
222	INTEGER :: inum
223	REAL(wp), POINTER, DIMENSION(:,:) :: zacs, zaos
224	!!
225	NAMELIST/namsbc_cpl/ sn_snd_temp, sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2, &
226	& sn_snd_dms, sn_snd_n2o, &
227	& sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau ,sn_rcv_dqnsdt, sn_rcv_qsr, &
228	& sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf ,sn_rcv_cal , sn_rcv_iceflx, &
229	& sn_rcv_co2 , sn_rcv_icb , sn_rcv_isf, nn_cplmodel, ln_usecplmask
230	!!---------------------------------------------------------------------
231	!
232	IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_init')
233	!
234	CALL wrk_alloc( jpi,jpj, zacs, zaos )
235
236	! ================================ !
237	! Namelist informations !
238	! ================================ !
239
240	REWIND( numnam_ref ) ! Namelist namsbc_cpl in reference namelist : Variables for OASIS coupling
241	READ ( numnam_ref, namsbc_cpl, IOSTAT = ios, ERR = 901)
242	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in reference namelist', lwp )
243
244	REWIND( numnam_cfg ) ! Namelist namsbc_cpl in configuration namelist : Variables for OASIS coupling
245	READ ( numnam_cfg, namsbc_cpl, IOSTAT = ios, ERR = 902 )
246	902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in configuration namelist', lwp )
247	IF(lwm) WRITE ( numond, namsbc_cpl )
248
249	IF(lwp) THEN ! control print
250	WRITE(numout,*)
251	WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist '
252	WRITE(numout,*)'~~~~~~~~~~~~'
253	ENDIF
254	IF( lwp .AND. ln_cpl ) THEN ! control print
255	WRITE(numout,*)' received fields (mutiple ice categogies)'
256	WRITE(numout,*)' 10m wind module = ', TRIM(sn_rcv_w10m%cldes ), ' (', TRIM(sn_rcv_w10m%clcat ), ')'
257	WRITE(numout,*)' stress module = ', TRIM(sn_rcv_taumod%cldes), ' (', TRIM(sn_rcv_taumod%clcat), ')'
258	WRITE(numout,*)' surface stress = ', TRIM(sn_rcv_tau%cldes ), ' (', TRIM(sn_rcv_tau%clcat ), ')'
259	WRITE(numout,*)' - referential = ', sn_rcv_tau%clvref
260	WRITE(numout,*)' - orientation = ', sn_rcv_tau%clvor
261	WRITE(numout,*)' - mesh = ', sn_rcv_tau%clvgrd
262	WRITE(numout,*)' non-solar heat flux sensitivity = ', TRIM(sn_rcv_dqnsdt%cldes), ' (', TRIM(sn_rcv_dqnsdt%clcat), ')'
263	WRITE(numout,*)' solar heat flux = ', TRIM(sn_rcv_qsr%cldes ), ' (', TRIM(sn_rcv_qsr%clcat ), ')'
264	WRITE(numout,*)' non-solar heat flux = ', TRIM(sn_rcv_qns%cldes ), ' (', TRIM(sn_rcv_qns%clcat ), ')'
265	WRITE(numout,*)' freshwater budget = ', TRIM(sn_rcv_emp%cldes ), ' (', TRIM(sn_rcv_emp%clcat ), ')'
266	WRITE(numout,*)' runoffs = ', TRIM(sn_rcv_rnf%cldes ), ' (', TRIM(sn_rcv_rnf%clcat ), ')'
267	WRITE(numout,*)' calving = ', TRIM(sn_rcv_cal%cldes ), ' (', TRIM(sn_rcv_cal%clcat ), ')'
268	WRITE(numout,*)' iceberg = ', TRIM(sn_rcv_icb%cldes ), ' (', TRIM(sn_rcv_icb%clcat ), ')'
269	WRITE(numout,*)' ice shelf = ', TRIM(sn_rcv_isf%cldes ), ' (', TRIM(sn_rcv_isf%clcat ), ')'
270	WRITE(numout,*)' sea ice heat fluxes = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')'
271	WRITE(numout,*)' atm co2 = ', TRIM(sn_rcv_co2%cldes ), ' (', TRIM(sn_rcv_co2%clcat ), ')'
272	WRITE(numout,*)' sent fields (multiple ice categories)'
273	WRITE(numout,*)' surface temperature = ', TRIM(sn_snd_temp%cldes ), ' (', TRIM(sn_snd_temp%clcat ), ')'
274	WRITE(numout,*)' albedo = ', TRIM(sn_snd_alb%cldes ), ' (', TRIM(sn_snd_alb%clcat ), ')'
275	WRITE(numout,*)' ice/snow thickness = ', TRIM(sn_snd_thick%cldes ), ' (', TRIM(sn_snd_thick%clcat ), ')'
276	WRITE(numout,*)' surface current = ', TRIM(sn_snd_crt%cldes ), ' (', TRIM(sn_snd_crt%clcat ), ')'
277	WRITE(numout,*)' - referential = ', sn_snd_crt%clvref
278	WRITE(numout,*)' - orientation = ', sn_snd_crt%clvor
279	WRITE(numout,*)' - mesh = ', sn_snd_crt%clvgrd
280	WRITE(numout,*)' oce co2 flux = ', TRIM(sn_snd_co2%cldes ), ' (', TRIM(sn_snd_co2%clcat ), ')'
281	WRITE(numout,*)' oce dms flux = ', TRIM(sn_snd_dms%cldes ), ' (', TRIM(sn_snd_dms%clcat ), ')'
282	WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel
283	WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask
284	ENDIF
285
286	! ! allocate sbccpl arrays
287	IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' )
288
289	! ================================ !
290	! Define the receive interface !
291	! ================================ !
292	nrcvinfo(:) = OASIS_idle ! needed by nrcvinfo(jpr_otx1) if we do not receive ocean stress
293
294	! for each field: define the OASIS name (srcv(:)%clname)
295	! define receive or not from the namelist parameters (srcv(:)%laction)
296	! define the north fold type of lbc (srcv(:)%nsgn)
297
298	! default definitions of srcv
299	srcv(:)%laction = .FALSE. ; srcv(:)%clgrid = 'T' ; srcv(:)%nsgn = 1. ; srcv(:)%nct = 1
300
301	! ! ------------------------- !
302	! ! ice and ocean wind stress !
303	! ! ------------------------- !
304	! ! Name
305	srcv(jpr_otx1)%clname = 'O_OTaux1' ! 1st ocean component on grid ONE (T or U)
306	srcv(jpr_oty1)%clname = 'O_OTauy1' ! 2nd - - - -
307	srcv(jpr_otz1)%clname = 'O_OTauz1' ! 3rd - - - -
308	srcv(jpr_otx2)%clname = 'O_OTaux2' ! 1st ocean component on grid TWO (V)
309	srcv(jpr_oty2)%clname = 'O_OTauy2' ! 2nd - - - -
310	srcv(jpr_otz2)%clname = 'O_OTauz2' ! 3rd - - - -
311	!
312	srcv(jpr_itx1)%clname = 'O_ITaux1' ! 1st ice component on grid ONE (T, F, I or U)
313	srcv(jpr_ity1)%clname = 'O_ITauy1' ! 2nd - - - -
314	srcv(jpr_itz1)%clname = 'O_ITauz1' ! 3rd - - - -
315	srcv(jpr_itx2)%clname = 'O_ITaux2' ! 1st ice component on grid TWO (V)
316	srcv(jpr_ity2)%clname = 'O_ITauy2' ! 2nd - - - -
317	srcv(jpr_itz2)%clname = 'O_ITauz2' ! 3rd - - - -
318	!
319	! Vectors: change of sign at north fold ONLY if on the local grid
320	IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) srcv(jpr_otx1:jpr_itz2)%nsgn = -1.
321
322	! ! Set grid and action
323	SELECT CASE( TRIM( sn_rcv_tau%clvgrd ) ) ! 'T', 'U,V', 'U,V,I', 'U,V,F', 'T,I', 'T,F', or 'T,U,V'
324	CASE( 'T' )
325	srcv(jpr_otx1:jpr_itz2)%clgrid = 'T' ! oce and ice components given at T-point
326	srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1
327	srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1
328	CASE( 'U,V' )
329	srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point
330	srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point
331	srcv(jpr_itx1:jpr_itz1)%clgrid = 'U' ! ice components given at U-point
332	srcv(jpr_itx2:jpr_itz2)%clgrid = 'V' ! and V-point
333	srcv(jpr_otx1:jpr_itz2)%laction = .TRUE. ! receive oce and ice components on both grid 1 & 2
334	CASE( 'U,V,T' )
335	srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point
336	srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point
337	srcv(jpr_itx1:jpr_itz1)%clgrid = 'T' ! ice components given at T-point
338	srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2
339	srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only
340	CASE( 'U,V,I' )
341	srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point
342	srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point
343	srcv(jpr_itx1:jpr_itz1)%clgrid = 'I' ! ice components given at I-point
344	srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2
345	srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only
346	CASE( 'U,V,F' )
347	srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point
348	srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point
349	srcv(jpr_itx1:jpr_itz1)%clgrid = 'F' ! ice components given at F-point
350	srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2
351	srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only
352	CASE( 'T,I' )
353	srcv(jpr_otx1:jpr_itz2)%clgrid = 'T' ! oce and ice components given at T-point
354	srcv(jpr_itx1:jpr_itz1)%clgrid = 'I' ! ice components given at I-point
355	srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1
356	srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1
357	CASE( 'T,F' )
358	srcv(jpr_otx1:jpr_itz2)%clgrid = 'T' ! oce and ice components given at T-point
359	srcv(jpr_itx1:jpr_itz1)%clgrid = 'F' ! ice components given at F-point
360	srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1
361	srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1
362	CASE( 'T,U,V' )
363	srcv(jpr_otx1:jpr_otz1)%clgrid = 'T' ! oce components given at T-point
364	srcv(jpr_itx1:jpr_itz1)%clgrid = 'U' ! ice components given at U-point
365	srcv(jpr_itx2:jpr_itz2)%clgrid = 'V' ! and V-point
366	srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1 only
367	srcv(jpr_itx1:jpr_itz2)%laction = .TRUE. ! receive ice components on grid 1 & 2
368	CASE default
369	CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_tau%clvgrd' )
370	END SELECT
371	!
372	IF( TRIM( sn_rcv_tau%clvref ) == 'spherical' ) & ! spherical: 3rd component not received
373	& srcv( (/jpr_otz1, jpr_otz2, jpr_itz1, jpr_itz2/) )%laction = .FALSE.
374	!
375	IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) THEN ! already on local grid -> no need of the second grid
376	srcv(jpr_otx2:jpr_otz2)%laction = .FALSE.
377	srcv(jpr_itx2:jpr_itz2)%laction = .FALSE.
378	srcv(jpr_oty1)%clgrid = srcv(jpr_oty2)%clgrid ! not needed but cleaner...
379	srcv(jpr_ity1)%clgrid = srcv(jpr_ity2)%clgrid ! not needed but cleaner...
380	ENDIF
381	!
382	IF( TRIM( sn_rcv_tau%cldes ) /= 'oce and ice' ) THEN ! 'oce and ice' case ocean stress on ocean mesh used
383	srcv(jpr_itx1:jpr_itz2)%laction = .FALSE. ! ice components not received
384	srcv(jpr_itx1)%clgrid = 'U' ! ocean stress used after its transformation
385	srcv(jpr_ity1)%clgrid = 'V' ! i.e. it is always at U- & V-points for i- & j-comp. resp.
386	ENDIF
387
388	! ! ------------------------- !
389	! ! freshwater budget ! E-P
390	! ! ------------------------- !
391	! we suppose that atmosphere modele do not make the difference between precipiration (liquide or solid)
392	! over ice of free ocean within the same atmospheric cell.cd
393	srcv(jpr_rain)%clname = 'OTotRain' ! Rain = liquid precipitation
394	srcv(jpr_snow)%clname = 'OTotSnow' ! Snow = solid precipitation
395	srcv(jpr_tevp)%clname = 'OTotEvap' ! total evaporation (over oce + ice sublimation)
396	srcv(jpr_ievp)%clname = 'OIceEvap' ! evaporation over ice = sublimation
397	srcv(jpr_sbpr)%clname = 'OSubMPre' ! sublimation - liquid precipitation - solid precipitation
398	srcv(jpr_semp)%clname = 'OISubMSn' ! ice solid water budget = sublimation - solid precipitation
399	srcv(jpr_oemp)%clname = 'OOEvaMPr' ! ocean water budget = ocean Evap - ocean precip
400	SELECT CASE( TRIM( sn_rcv_emp%cldes ) )
401	CASE( 'none' ) ! nothing to do
402	CASE( 'oce only' ) ; srcv( jpr_oemp )%laction = .TRUE.
403	CASE( 'conservative' )
404	srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE.
405	IF ( k_ice <= 1 ) srcv(jpr_ievp)%laction = .FALSE.
406	CASE( 'oce and ice' ) ; srcv( (/jpr_ievp, jpr_sbpr, jpr_semp, jpr_oemp/) )%laction = .TRUE.
407	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' )
408	END SELECT
409
410
411	! ! ---------------------------------------------------- !
412	! ! Runoffs, Calving, Iceberg, Iceshelf cavities !
413	! ! ---------------------------------------------------- !
414	srcv(jpr_rnf )%clname = 'O_Runoff'
415	IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN
416	srcv(jpr_rnf)%laction = .TRUE.
417	l_rnfcpl = .TRUE. ! -> no need to read runoffs in sbcrnf
418	ln_rnf = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas
419	IF(lwp) WRITE(numout,*)
420	IF(lwp) WRITE(numout,*) ' runoffs received from oasis -> force ln_rnf = ', ln_rnf
421	ENDIF
422	!
423	srcv(jpr_cal)%clname = 'OCalving' ; IF( TRIM( sn_rcv_cal%cldes) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE.
424	srcv(jpr_isf)%clname = 'OIcshelf' ; IF( TRIM( sn_rcv_isf%cldes) == 'coupled' ) srcv(jpr_isf)%laction = .TRUE.
425	srcv(jpr_icb)%clname = 'OIceberg' ; IF( TRIM( sn_rcv_icb%cldes) == 'coupled' ) srcv(jpr_icb)%laction = .TRUE.
426
427	IF( srcv(jpr_isf)%laction .AND. nn_isf > 0 ) THEN
428	l_isfcpl = .TRUE. ! -> no need to read isf in sbcisf
429	IF(lwp) WRITE(numout,*)
430	IF(lwp) WRITE(numout,*) ' iceshelf received from oasis '
431	ENDIF
432
433	! ! ------------------------- !
434	! ! non solar radiation ! Qns
435	! ! ------------------------- !
436	srcv(jpr_qnsoce)%clname = 'O_QnsOce'
437	srcv(jpr_qnsice)%clname = 'O_QnsIce'
438	srcv(jpr_qnsmix)%clname = 'O_QnsMix'
439	SELECT CASE( TRIM( sn_rcv_qns%cldes ) )
440	CASE( 'none' ) ! nothing to do
441	CASE( 'oce only' ) ; srcv( jpr_qnsoce )%laction = .TRUE.
442	CASE( 'conservative' ) ; srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE.
443	CASE( 'oce and ice' ) ; srcv( (/jpr_qnsice, jpr_qnsoce/) )%laction = .TRUE.
444	CASE( 'mixed oce-ice' ) ; srcv( jpr_qnsmix )%laction = .TRUE.
445	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qns%cldes' )
446	END SELECT
447	IF( TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) &
448	CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qns%cldes not currently allowed to be mixed oce-ice for multi-category ice' )
449	! ! ------------------------- !
450	! ! solar radiation ! Qsr
451	! ! ------------------------- !
452	srcv(jpr_qsroce)%clname = 'O_QsrOce'
453	srcv(jpr_qsrice)%clname = 'O_QsrIce'
454	srcv(jpr_qsrmix)%clname = 'O_QsrMix'
455	SELECT CASE( TRIM( sn_rcv_qsr%cldes ) )
456	CASE( 'none' ) ! nothing to do
457	CASE( 'oce only' ) ; srcv( jpr_qsroce )%laction = .TRUE.
458	CASE( 'conservative' ) ; srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE.
459	CASE( 'oce and ice' ) ; srcv( (/jpr_qsrice, jpr_qsroce/) )%laction = .TRUE.
460	CASE( 'mixed oce-ice' ) ; srcv( jpr_qsrmix )%laction = .TRUE.
461	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qsr%cldes' )
462	END SELECT
463	IF( TRIM( sn_rcv_qsr%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) &
464	CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qsr%cldes not currently allowed to be mixed oce-ice for multi-category ice' )
465	! ! ------------------------- !
466	! ! non solar sensitivity ! d(Qns)/d(T)
467	! ! ------------------------- !
468	srcv(jpr_dqnsdt)%clname = 'O_dQnsdT'
469	IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'coupled' ) srcv(jpr_dqnsdt)%laction = .TRUE.
470	!
471	! non solar sensitivity mandatory for LIM ice model
472	IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4 .AND. nn_components /= jp_iam_sas ) &
473	CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' )
474	! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique
475	IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' ) &
476	CALL ctl_stop( 'sbc_cpl_init: namsbc_cpl namelist mismatch between sn_rcv_qns%cldes and sn_rcv_dqnsdt%cldes' )
477	! ! ------------------------- !
478	! ! 10m wind module !
479	! ! ------------------------- !
480	srcv(jpr_w10m)%clname = 'O_Wind10' ; IF( TRIM(sn_rcv_w10m%cldes ) == 'coupled' ) srcv(jpr_w10m)%laction = .TRUE.
481	!
482	! ! ------------------------- !
483	! ! wind stress module !
484	! ! ------------------------- !
485	srcv(jpr_taum)%clname = 'O_TauMod' ; IF( TRIM(sn_rcv_taumod%cldes) == 'coupled' ) srcv(jpr_taum)%laction = .TRUE.
486	lhftau = srcv(jpr_taum)%laction
487
488	! ! ------------------------- !
489	! ! Atmospheric CO2 !
490	! ! ------------------------- !
491	srcv(jpr_co2 )%clname = 'O_AtmCO2' ; IF( TRIM(sn_rcv_co2%cldes ) == 'coupled' ) srcv(jpr_co2 )%laction = .TRUE.
492	! ! ------------------------- !
493	! ! topmelt and botmelt !
494	! ! ------------------------- !
495	srcv(jpr_topm )%clname = 'OTopMlt'
496	srcv(jpr_botm )%clname = 'OBotMlt'
497	IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN
498	IF ( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN
499	srcv(jpr_topm:jpr_botm)%nct = jpl
500	ELSE
501	CALL ctl_stop( 'sbc_cpl_init: sn_rcv_iceflx%clcat should always be set to yes currently' )
502	ENDIF
503	srcv(jpr_topm:jpr_botm)%laction = .TRUE.
504	ENDIF
505	! ! ------------------------------- !
506	! ! OPA-SAS coupling - rcv by opa !
507	! ! ------------------------------- !
508	srcv(jpr_sflx)%clname = 'O_SFLX'
509	srcv(jpr_fice)%clname = 'RIceFrc'
510	!
511	IF( nn_components == jp_iam_opa ) THEN ! OPA coupled to SAS via OASIS: force received field by OPA (sent by SAS)
512	srcv(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling
513	srcv(:)%clgrid = 'T' ! force default definition in case of opa <-> sas coupling
514	srcv(:)%nsgn = 1. ! force default definition in case of opa <-> sas coupling
515	srcv( (/jpr_qsroce, jpr_qnsoce, jpr_oemp, jpr_sflx, jpr_fice, jpr_otx1, jpr_oty1, jpr_taum/) )%laction = .TRUE.
516	srcv(jpr_otx1)%clgrid = 'U' ! oce components given at U-point
517	srcv(jpr_oty1)%clgrid = 'V' ! and V-point
518	! Vectors: change of sign at north fold ONLY if on the local grid
519	srcv( (/jpr_otx1,jpr_oty1/) )%nsgn = -1.
520	sn_rcv_tau%clvgrd = 'U,V'
521	sn_rcv_tau%clvor = 'local grid'
522	sn_rcv_tau%clvref = 'spherical'
523	sn_rcv_emp%cldes = 'oce only'
524	!
525	IF(lwp) THEN ! control print
526	WRITE(numout,*)
527	WRITE(numout,*)' Special conditions for SAS-OPA coupling '
528	WRITE(numout,*)' OPA component '
529	WRITE(numout,*)
530	WRITE(numout,*)' received fields from SAS component '
531	WRITE(numout,*)' ice cover '
532	WRITE(numout,*)' oce only EMP '
533	WRITE(numout,*)' salt flux '
534	WRITE(numout,*)' mixed oce-ice solar flux '
535	WRITE(numout,*)' mixed oce-ice non solar flux '
536	WRITE(numout,*)' wind stress U,V on local grid and sperical coordinates '
537	WRITE(numout,*)' wind stress module'
538	WRITE(numout,*)
539	ENDIF
540	ENDIF
541	! ! -------------------------------- !
542	! ! OPA-SAS coupling - rcv by sas !
543	! ! -------------------------------- !
544	srcv(jpr_toce )%clname = 'I_SSTSST'
545	srcv(jpr_soce )%clname = 'I_SSSal'
546	srcv(jpr_ocx1 )%clname = 'I_OCurx1'
547	srcv(jpr_ocy1 )%clname = 'I_OCury1'
548	srcv(jpr_ssh )%clname = 'I_SSHght'
549	srcv(jpr_e3t1st)%clname = 'I_E3T1st'
550	srcv(jpr_fraqsr)%clname = 'I_FraQsr'
551	!
552	IF( nn_components == jp_iam_sas ) THEN
553	IF( .NOT. ln_cpl ) srcv(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling
554	IF( .NOT. ln_cpl ) srcv(:)%clgrid = 'T' ! force default definition in case of opa <-> sas coupling
555	IF( .NOT. ln_cpl ) srcv(:)%nsgn = 1. ! force default definition in case of opa <-> sas coupling
556	srcv( (/jpr_toce, jpr_soce, jpr_ssh, jpr_fraqsr, jpr_ocx1, jpr_ocy1/) )%laction = .TRUE.
557	srcv( jpr_e3t1st )%laction = lk_vvl
558	srcv(jpr_ocx1)%clgrid = 'U' ! oce components given at U-point
559	srcv(jpr_ocy1)%clgrid = 'V' ! and V-point
560	! Vectors: change of sign at north fold ONLY if on the local grid
561	srcv(jpr_ocx1:jpr_ocy1)%nsgn = -1.
562	! Change first letter to couple with atmosphere if already coupled OPA
563	! this is nedeed as each variable name used in the namcouple must be unique:
564	! for example O_Runoff received by OPA from SAS and therefore O_Runoff received by SAS from the Atmosphere
565	DO jn = 1, jprcv
566	IF ( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname))
567	END DO
568	!
569	IF(lwp) THEN ! control print
570	WRITE(numout,*)
571	WRITE(numout,*)' Special conditions for SAS-OPA coupling '
572	WRITE(numout,*)' SAS component '
573	WRITE(numout,*)
574	IF( .NOT. ln_cpl ) THEN
575	WRITE(numout,*)' received fields from OPA component '
576	ELSE
577	WRITE(numout,*)' Additional received fields from OPA component : '
578	ENDIF
579	WRITE(numout,*)' sea surface temperature (Celcius) '
580	WRITE(numout,*)' sea surface salinity '
581	WRITE(numout,*)' surface currents '
582	WRITE(numout,*)' sea surface height '
583	WRITE(numout,*)' thickness of first ocean T level '
584	WRITE(numout,*)' fraction of solar net radiation absorbed in the first ocean level'
585	WRITE(numout,*)
586	ENDIF
587	ENDIF
588
589	! =================================================== !
590	! Allocate all parts of frcv used for received fields !
591	! =================================================== !
592	DO jn = 1, jprcv
593	IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) )
594	END DO
595	! Allocate taum part of frcv which is used even when not received as coupling field
596	IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) )
597	! Allocate w10m part of frcv which is used even when not received as coupling field
598	IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) )
599	! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field
600	IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) )
601	IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) )
602	! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE.
603	IF( k_ice /= 0 ) THEN
604	IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) )
605	IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) )
606	END IF
607
608	! ================================ !
609	! Define the send interface !
610	! ================================ !
611	! for each field: define the OASIS name (ssnd(:)%clname)
612	! define send or not from the namelist parameters (ssnd(:)%laction)
613	! define the north fold type of lbc (ssnd(:)%nsgn)
614
615	! default definitions of nsnd
616	ssnd(:)%laction = .FALSE. ; ssnd(:)%clgrid = 'T' ; ssnd(:)%nsgn = 1. ; ssnd(:)%nct = 1
617
618	! ! ------------------------- !
619	! ! Surface temperature !
620	! ! ------------------------- !
621	ssnd(jps_toce)%clname = 'O_SSTSST'
622	ssnd(jps_tice)%clname = 'O_TepIce'
623	ssnd(jps_tmix)%clname = 'O_TepMix'
624	SELECT CASE( TRIM( sn_snd_temp%cldes ) )
625	CASE( 'none' ) ! nothing to do
626	CASE( 'oce only' ) ; ssnd( jps_toce )%laction = .TRUE.
627	CASE( 'oce and ice' , 'weighted oce and ice' )
628	ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE.
629	IF ( TRIM( sn_snd_temp%clcat ) == 'yes' ) ssnd(jps_tice)%nct = jpl
630	CASE( 'mixed oce-ice' ) ; ssnd( jps_tmix )%laction = .TRUE.
631	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' )
632	END SELECT
633
634	! ! ------------------------- !
635	! ! Albedo !
636	! ! ------------------------- !
637	ssnd(jps_albice)%clname = 'O_AlbIce'
638	ssnd(jps_albmix)%clname = 'O_AlbMix'
639	SELECT CASE( TRIM( sn_snd_alb%cldes ) )
640	CASE( 'none' ) ! nothing to do
641	CASE( 'ice' , 'weighted ice' ) ; ssnd(jps_albice)%laction = .TRUE.
642	CASE( 'mixed oce-ice' ) ; ssnd(jps_albmix)%laction = .TRUE.
643	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_alb%cldes' )
644	END SELECT
645	!
646	! Need to calculate oceanic albedo if
647	! 1. sending mixed oce-ice albedo or
648	! 2. receiving mixed oce-ice solar radiation
649	IF ( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN
650	CALL albedo_oce( zaos, zacs )
651	! Due to lack of information on nebulosity : mean clear/overcast sky
652	albedo_oce_mix(:,:) = ( zacs(:,:) + zaos(:,:) ) * 0.5
653	ENDIF
654
655	! ! ------------------------- !
656	! ! Ice fraction & Thickness !
657	! ! ------------------------- !
658	ssnd(jps_fice)%clname = 'OIceFrc'
659	ssnd(jps_hice)%clname = 'OIceTck'
660	ssnd(jps_hsnw)%clname = 'OSnwTck'
661	IF( k_ice /= 0 ) THEN
662	ssnd(jps_fice)%laction = .TRUE. ! if ice treated in the ocean (even in climato case)
663	! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now
664	IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl
665	ENDIF
666
667	SELECT CASE ( TRIM( sn_snd_thick%cldes ) )
668	CASE( 'none' ) ! nothing to do
669	CASE( 'ice and snow' )
670	ssnd(jps_hice:jps_hsnw)%laction = .TRUE.
671	IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN
672	ssnd(jps_hice:jps_hsnw)%nct = jpl
673	ENDIF
674	CASE ( 'weighted ice and snow' )
675	ssnd(jps_hice:jps_hsnw)%laction = .TRUE.
676	IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = jpl
677	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_thick%cldes' )
678	END SELECT
679
680	! ! ------------------------- !
681	! ! Surface current !
682	! ! ------------------------- !
683	! ocean currents ! ice velocities
684	ssnd(jps_ocx1)%clname = 'O_OCurx1' ; ssnd(jps_ivx1)%clname = 'O_IVelx1'
685	ssnd(jps_ocy1)%clname = 'O_OCury1' ; ssnd(jps_ivy1)%clname = 'O_IVely1'
686	ssnd(jps_ocz1)%clname = 'O_OCurz1' ; ssnd(jps_ivz1)%clname = 'O_IVelz1'
687	!
688	ssnd(jps_ocx1:jps_ivz1)%nsgn = -1. ! vectors: change of the sign at the north fold
689
690	IF( sn_snd_crt%clvgrd == 'U,V' ) THEN
691	ssnd(jps_ocx1)%clgrid = 'U' ; ssnd(jps_ocy1)%clgrid = 'V'
692	ELSE IF( sn_snd_crt%clvgrd /= 'T' ) THEN
693	CALL ctl_stop( 'sn_snd_crt%clvgrd must be equal to T' )
694	ssnd(jps_ocx1:jps_ivz1)%clgrid = 'T' ! all oce and ice components on the same unique grid
695	ENDIF
696	ssnd(jps_ocx1:jps_ivz1)%laction = .TRUE. ! default: all are send
697	IF( TRIM( sn_snd_crt%clvref ) == 'spherical' ) ssnd( (/jps_ocz1, jps_ivz1/) )%laction = .FALSE.
698	IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) ssnd(jps_ocx1:jps_ivz1)%nsgn = 1.
699	SELECT CASE( TRIM( sn_snd_crt%cldes ) )
700	CASE( 'none' ) ; ssnd(jps_ocx1:jps_ivz1)%laction = .FALSE.
701	CASE( 'oce only' ) ; ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE.
702	CASE( 'weighted oce and ice' ) ! nothing to do
703	CASE( 'mixed oce-ice' ) ; ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE.
704	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_crt%cldes' )
705	END SELECT
706
707	! ! ------------------------- !
708	! ! CO2 flux !
709	! ! ------------------------- !
710	ssnd(jps_co2)%clname = 'O_CO2FLX' ; IF( TRIM(sn_snd_co2%cldes) == 'coupled' ) ssnd(jps_co2 )%laction = .TRUE.
711
712	! ! ------------------------- !
713	! ! DMS flux !
714	! ! ------------------------- !
715	ssnd(jps_dms)%clname = 'O_DMSFLX' ; IF( TRIM(sn_snd_dms%cldes) == 'coupled' ) ssnd(jps_dms )%laction = .TRUE.
716
717	! ! ------------------------- !
718	! ! N2O flux !
719	! ! ------------------------- !
720	ssnd(jps_n2o)%clname = 'O_N2OFLX' ; IF( TRIM(sn_snd_n2o%cldes) == 'coupled' ) ssnd(jps_n2o )%laction = .TRUE.
721
722	! ! ------------------------------- !
723	! ! OPA-SAS coupling - snd by opa !
724	! ! ------------------------------- !
725	ssnd(jps_ssh )%clname = 'O_SSHght'
726	ssnd(jps_soce )%clname = 'O_SSSal'
727	ssnd(jps_e3t1st)%clname = 'O_E3T1st'
728	ssnd(jps_fraqsr)%clname = 'O_FraQsr'
729	!
730	IF( nn_components == jp_iam_opa ) THEN
731	ssnd(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling
732	ssnd( (/jps_toce, jps_soce, jps_ssh, jps_fraqsr, jps_ocx1, jps_ocy1/) )%laction = .TRUE.
733	ssnd( jps_e3t1st )%laction = lk_vvl
734	! vector definition: not used but cleaner...
735	ssnd(jps_ocx1)%clgrid = 'U' ! oce components given at U-point
736	ssnd(jps_ocy1)%clgrid = 'V' ! and V-point
737	sn_snd_crt%clvgrd = 'U,V'
738	sn_snd_crt%clvor = 'local grid'
739	sn_snd_crt%clvref = 'spherical'
740	!
741	IF(lwp) THEN ! control print
742	WRITE(numout,*)
743	WRITE(numout,*)' sent fields to SAS component '
744	WRITE(numout,*)' sea surface temperature (T before, Celcius) '
745	WRITE(numout,*)' sea surface salinity '
746	WRITE(numout,*)' surface currents U,V on local grid and spherical coordinates'
747	WRITE(numout,*)' sea surface height '
748	WRITE(numout,*)' thickness of first ocean T level '
749	WRITE(numout,*)' fraction of solar net radiation absorbed in the first ocean level'
750	WRITE(numout,*)
751	ENDIF
752	ENDIF
753	! ! ------------------------------- !
754	! ! OPA-SAS coupling - snd by sas !
755	! ! ------------------------------- !
756	ssnd(jps_sflx )%clname = 'I_SFLX'
757	ssnd(jps_fice2 )%clname = 'IIceFrc'
758	ssnd(jps_qsroce)%clname = 'I_QsrOce'
759	ssnd(jps_qnsoce)%clname = 'I_QnsOce'
760	ssnd(jps_oemp )%clname = 'IOEvaMPr'
761	ssnd(jps_otx1 )%clname = 'I_OTaux1'
762	ssnd(jps_oty1 )%clname = 'I_OTauy1'
763	ssnd(jps_rnf )%clname = 'I_Runoff'
764	ssnd(jps_taum )%clname = 'I_TauMod'
765	!
766	IF( nn_components == jp_iam_sas ) THEN
767	IF( .NOT. ln_cpl ) ssnd(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling
768	ssnd( (/jps_qsroce, jps_qnsoce, jps_oemp, jps_fice2, jps_sflx, jps_otx1, jps_oty1, jps_taum/) )%laction = .TRUE.
769	!
770	! Change first letter to couple with atmosphere if already coupled with sea_ice
771	! this is nedeed as each variable name used in the namcouple must be unique:
772	! for example O_SSTSST sent by OPA to SAS and therefore S_SSTSST sent by SAS to the Atmosphere
773	DO jn = 1, jpsnd
774	IF ( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname))
775	END DO
776	!
777	IF(lwp) THEN ! control print
778	WRITE(numout,*)
779	IF( .NOT. ln_cpl ) THEN
780	WRITE(numout,*)' sent fields to OPA component '
781	ELSE
782	WRITE(numout,*)' Additional sent fields to OPA component : '
783	ENDIF
784	WRITE(numout,*)' ice cover '
785	WRITE(numout,*)' oce only EMP '
786	WRITE(numout,*)' salt flux '
787	WRITE(numout,*)' mixed oce-ice solar flux '
788	WRITE(numout,*)' mixed oce-ice non solar flux '
789	WRITE(numout,*)' wind stress U,V components'
790	WRITE(numout,*)' wind stress module'
791	ENDIF
792	ENDIF
793
794	!
795	! ================================ !
796	! initialisation of the coupler !
797	! ================================ !
798
799	CALL cpl_define(jprcv, jpsnd, nn_cplmodel)
800
801	IF (ln_usecplmask) THEN
802	xcplmask(:,:,:) = 0.
803	CALL iom_open( 'cplmask', inum )
804	CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(1:nlci,1:nlcj,1:nn_cplmodel), &
805	& kstart = (/ mig(1),mjg(1),1 /), kcount = (/ nlci,nlcj,nn_cplmodel /) )
806	CALL iom_close( inum )
807	ELSE
808	xcplmask(:,:,:) = 1.
809	ENDIF
810	xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 )
811	!
812	ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'I_QsrOce' ) + cpl_freq( 'I_QsrMix' )
813	IF( ln_dm2dc .AND. ln_cpl .AND. ncpl_qsr_freq /= 86400 ) &
814	& CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' )
815
816	CALL wrk_dealloc( jpi,jpj, zacs, zaos )
817	!
818	IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_init')
819	!
820	END SUBROUTINE sbc_cpl_init
821
822
823	SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice )
824	!!----------------------------------------------------------------------
825	!! * ROUTINE sbc_cpl_rcv *
826	!!
827	!! ** Purpose : provide the stress over the ocean and, if no sea-ice,
828	!! provide the ocean heat and freshwater fluxes.
829	!!
830	!! ** Method : - Receive all the atmospheric fields (stored in frcv array). called at each time step.
831	!! OASIS controls if there is something do receive or not. nrcvinfo contains the info
832	!! to know if the field was really received or not
833	!!
834	!! --> If ocean stress was really received:
835	!!
836	!! - transform the received ocean stress vector from the received
837	!! referential and grid into an atmosphere-ocean stress in
838	!! the (i,j) ocean referencial and at the ocean velocity point.
839	!! The received stress are :
840	!! - defined by 3 components (if cartesian coordinate)
841	!! or by 2 components (if spherical)
842	!! - oriented along geographical coordinate (if eastward-northward)
843	!! or along the local grid coordinate (if local grid)
844	!! - given at U- and V-point, resp. if received on 2 grids
845	!! or at T-point if received on 1 grid
846	!! Therefore and if necessary, they are successively
847	!! processed in order to obtain them
848	!! first as 2 components on the sphere
849	!! second as 2 components oriented along the local grid
850	!! third as 2 components on the U,V grid
851	!!
852	!! -->
853	!!
854	!! - In 'ocean only' case, non solar and solar ocean heat fluxes
855	!! and total ocean freshwater fluxes
856	!!
857	!! ** Method : receive all fields from the atmosphere and transform
858	!! them into ocean surface boundary condition fields
859	!!
860	!! ** Action : update utau, vtau ocean stress at U,V grid
861	!! taum wind stress module at T-point
862	!! wndm wind speed module at T-point over free ocean or leads in presence of sea-ice
863	!! qns non solar heat fluxes including emp heat content (ocean only case)
864	!! and the latent heat flux of solid precip. melting
865	!! qsr solar ocean heat fluxes (ocean only case)
866	!! emp upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case)
867	!!----------------------------------------------------------------------
868	INTEGER, INTENT(in) :: kt ! ocean model time step index
869	INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation
870	INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3)
871
872	!!
873	LOGICAL :: llnewtx, llnewtau ! update wind stress components and module??
874	INTEGER :: ji, jj, jn ! dummy loop indices
875	INTEGER :: isec ! number of seconds since nit000 (assuming rdttra did not change since nit000)
876	REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars
877	REAL(wp) :: zcoef ! temporary scalar
878	REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3
879	REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient
880	REAL(wp) :: zzx, zzy ! temporary variables
881	REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, zmsk, zemp, zqns, zqsr
882	!!----------------------------------------------------------------------
883	!
884	IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv')
885	!
886	CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr )
887	!
888	IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0)
889	!
890	! ! ======================================================= !
891	! ! Receive all the atmos. fields (including ice information)
892	! ! ======================================================= !
893	isec = ( kt - nit000 ) * NINT( rdttra(1) ) ! date of exchanges
894	DO jn = 1, jprcv ! received fields sent by the atmosphere
895	IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) )
896	END DO
897
898	! ! ========================= !
899	IF( srcv(jpr_otx1)%laction ) THEN ! ocean stress components !
900	! ! ========================= !
901	! define frcv(jpr_otx1)%z3(:,:,1) and frcv(jpr_oty1)%z3(:,:,1): stress at U/V point along model grid
902	! => need to be done only when we receive the field
903	IF( nrcvinfo(jpr_otx1) == OASIS_Rcv ) THEN
904	!
905	IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere
906	! ! (cartesian to spherical -> 3 to 2 components)
907	!
908	CALL geo2oce( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), frcv(jpr_otz1)%z3(:,:,1), &
909	& srcv(jpr_otx1)%clgrid, ztx, zty )
910	frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid
911	frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid
912	!
913	IF( srcv(jpr_otx2)%laction ) THEN
914	CALL geo2oce( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), frcv(jpr_otz2)%z3(:,:,1), &
915	& srcv(jpr_otx2)%clgrid, ztx, zty )
916	frcv(jpr_otx2)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid
917	frcv(jpr_oty2)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid
918	ENDIF
919	!
920	ENDIF
921	!
922	IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid
923	! ! (geographical to local grid -> rotate the components)
924	CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )
925	IF( srcv(jpr_otx2)%laction ) THEN
926	CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty )
927	ELSE
928	CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty )
929	ENDIF
930	frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid
931	frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid
932	ENDIF
933	!
934	IF( srcv(jpr_otx1)%clgrid == 'T' ) THEN
935	DO jj = 2, jpjm1 ! T ==> (U,V)
936	DO ji = fs_2, fs_jpim1 ! vector opt.
937	frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) )
938	frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) )
939	END DO
940	END DO
941	CALL lbc_lnk( frcv(jpr_otx1)%z3(:,:,1), 'U', -1. ) ; CALL lbc_lnk( frcv(jpr_oty1)%z3(:,:,1), 'V', -1. )
942	ENDIF
943	llnewtx = .TRUE.
944	ELSE
945	llnewtx = .FALSE.
946	ENDIF
947	! ! ========================= !
948	ELSE ! No dynamical coupling !
949	! ! ========================= !
950	frcv(jpr_otx1)%z3(:,:,1) = 0.e0 ! here simply set to zero
951	frcv(jpr_oty1)%z3(:,:,1) = 0.e0 ! an external read in a file can be added instead
952	llnewtx = .TRUE.
953	!
954	ENDIF
955	! ! ========================= !
956	! ! wind stress module ! (taum)
957	! ! ========================= !
958	!
959	IF( .NOT. srcv(jpr_taum)%laction ) THEN ! compute wind stress module from its components if not received
960	! => need to be done only when otx1 was changed
961	IF( llnewtx ) THEN
962	!CDIR NOVERRCHK
963	DO jj = 2, jpjm1
964	!CDIR NOVERRCHK
965	DO ji = fs_2, fs_jpim1 ! vect. opt.
966	zzx = frcv(jpr_otx1)%z3(ji-1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1)
967	zzy = frcv(jpr_oty1)%z3(ji ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1)
968	frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy )
969	END DO
970	END DO
971	CALL lbc_lnk( frcv(jpr_taum)%z3(:,:,1), 'T', 1. )
972	llnewtau = .TRUE.
973	ELSE
974	llnewtau = .FALSE.
975	ENDIF
976	ELSE
977	llnewtau = nrcvinfo(jpr_taum) == OASIS_Rcv
978	! Stress module can be negative when received (interpolation problem)
979	IF( llnewtau ) THEN
980	frcv(jpr_taum)%z3(:,:,1) = MAX( 0._wp, frcv(jpr_taum)%z3(:,:,1) )
981	ENDIF
982	ENDIF
983	!
984	! ! ========================= !
985	! ! 10 m wind speed ! (wndm)
986	! ! ========================= !
987	!
988	IF( .NOT. srcv(jpr_w10m)%laction ) THEN ! compute wind spreed from wind stress module if not received
989	! => need to be done only when taumod was changed
990	IF( llnewtau ) THEN
991	zcoef = 1. / ( zrhoa * zcdrag )
992	!CDIR NOVERRCHK
993	DO jj = 1, jpj
994	!CDIR NOVERRCHK
995	DO ji = 1, jpi
996	frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )
997	END DO
998	END DO
999	ENDIF
1000	ENDIF
1001
1002	! u(v)tau and taum will be modified by ice model
1003	! -> need to be reset before each call of the ice/fsbc
1004	IF( MOD( kt-1, k_fsbc ) == 0 ) THEN
1005	!
1006	IF( ln_mixcpl ) THEN
1007	utau(:,:) = utau(:,:) * xcplmask(:,:,0) + frcv(jpr_otx1)%z3(:,:,1) * zmsk(:,:)
1008	vtau(:,:) = vtau(:,:) * xcplmask(:,:,0) + frcv(jpr_oty1)%z3(:,:,1) * zmsk(:,:)
1009	taum(:,:) = taum(:,:) * xcplmask(:,:,0) + frcv(jpr_taum)%z3(:,:,1) * zmsk(:,:)
1010	wndm(:,:) = wndm(:,:) * xcplmask(:,:,0) + frcv(jpr_w10m)%z3(:,:,1) * zmsk(:,:)
1011	ELSE
1012	utau(:,:) = frcv(jpr_otx1)%z3(:,:,1)
1013	vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1)
1014	taum(:,:) = frcv(jpr_taum)%z3(:,:,1)
1015	wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1)
1016	ENDIF
1017	CALL iom_put( "taum_oce", taum ) ! output wind stress module
1018	!
1019	ENDIF
1020
1021	#if defined key_cpl_carbon_cycle
1022	! ! ================== !
1023	! ! atmosph. CO2 (ppm) !
1024	! ! ================== !
1025	IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1)
1026	#endif
1027
1028	! Fields received by SAS when OASIS coupling
1029	! (arrays no more filled at sbcssm stage)
1030	! ! ================== !
1031	! ! SSS !
1032	! ! ================== !
1033	IF( srcv(jpr_soce)%laction ) THEN ! received by sas in case of opa <-> sas coupling
1034	sss_m(:,:) = frcv(jpr_soce)%z3(:,:,1)
1035	CALL iom_put( 'sss_m', sss_m )
1036	ENDIF
1037	!
1038	! ! ================== !
1039	! ! SST !
1040	! ! ================== !
1041	IF( srcv(jpr_toce)%laction ) THEN ! received by sas in case of opa <-> sas coupling
1042	sst_m(:,:) = frcv(jpr_toce)%z3(:,:,1)
1043	IF( srcv(jpr_soce)%laction .AND. ln_useCT ) THEN ! make sure that sst_m is the potential temperature
1044	sst_m(:,:) = eos_pt_from_ct( sst_m(:,:), sss_m(:,:) )
1045	ENDIF
1046	ENDIF
1047	! ! ================== !
1048	! ! SSH !
1049	! ! ================== !
1050	IF( srcv(jpr_ssh )%laction ) THEN ! received by sas in case of opa <-> sas coupling
1051	ssh_m(:,:) = frcv(jpr_ssh )%z3(:,:,1)
1052	CALL iom_put( 'ssh_m', ssh_m )
1053	ENDIF
1054	! ! ================== !
1055	! ! surface currents !
1056	! ! ================== !
1057	IF( srcv(jpr_ocx1)%laction ) THEN ! received by sas in case of opa <-> sas coupling
1058	ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1)
1059	ub (:,:,1) = ssu_m(:,:) ! will be used in sbcice_lim in the call of lim_sbc_tau
1060	un (:,:,1) = ssu_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling
1061	CALL iom_put( 'ssu_m', ssu_m )
1062	ENDIF
1063	IF( srcv(jpr_ocy1)%laction ) THEN
1064	ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1)
1065	vb (:,:,1) = ssv_m(:,:) ! will be used in sbcice_lim in the call of lim_sbc_tau
1066	vn (:,:,1) = ssv_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling
1067	CALL iom_put( 'ssv_m', ssv_m )
1068	ENDIF
1069	! ! ======================== !
1070	! ! first T level thickness !
1071	! ! ======================== !
1072	IF( srcv(jpr_e3t1st )%laction ) THEN ! received by sas in case of opa <-> sas coupling
1073	e3t_m(:,:) = frcv(jpr_e3t1st )%z3(:,:,1)
1074	CALL iom_put( 'e3t_m', e3t_m(:,:) )
1075	ENDIF
1076	! ! ================================ !
1077	! ! fraction of solar net radiation !
1078	! ! ================================ !
1079	IF( srcv(jpr_fraqsr)%laction ) THEN ! received by sas in case of opa <-> sas coupling
1080	frq_m(:,:) = frcv(jpr_fraqsr)%z3(:,:,1)
1081	CALL iom_put( 'frq_m', frq_m )
1082	ENDIF
1083
1084	! ! ========================= !
1085	IF( k_ice <= 1 .AND. MOD( kt-1, k_fsbc ) == 0 ) THEN ! heat & freshwater fluxes ! (Ocean only case)
1086	! ! ========================= !
1087	!
1088	! ! total freshwater fluxes over the ocean (emp)
1089	IF( srcv(jpr_oemp)%laction .OR. srcv(jpr_rain)%laction ) THEN
1090	SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) ! evaporation - precipitation
1091	CASE( 'conservative' )
1092	zemp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) )
1093	CASE( 'oce only', 'oce and ice' )
1094	zemp(:,:) = frcv(jpr_oemp)%z3(:,:,1)
1095	CASE default
1096	CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' )
1097	END SELECT
1098	ELSE
1099	zemp(:,:) = 0._wp
1100	ENDIF
1101	!
1102	!
1103	! ! runoffs and calving (added in emp)
1104	IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
1105	IF( srcv(jpr_cal)%laction ) zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1)
1106
1107	IF( srcv(jpr_icb)%laction ) THEN
1108	fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1)
1109	rnf(:,:) = rnf(:,:) + fwficb(:,:) ! iceberg added to runfofs
1110	ENDIF
1111	IF( srcv(jpr_isf)%laction ) fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1) ! fresh water flux from the isf (fwfisf <0 mean melting)
1112
1113	IF( ln_mixcpl ) THEN ; emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:)
1114	ELSE ; emp(:,:) = zemp(:,:)
1115	ENDIF
1116	!
1117	! ! non solar heat flux over the ocean (qns)
1118	IF( srcv(jpr_qnsoce)%laction ) THEN ; zqns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)
1119	ELSE IF( srcv(jpr_qnsmix)%laction ) THEN ; zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
1120	ELSE ; zqns(:,:) = 0._wp
1121	END IF
1122	! update qns over the free ocean with:
1123	IF( nn_components /= jp_iam_opa ) THEN
1124	zqns(:,:) = zqns(:,:) - zemp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST)
1125	IF( srcv(jpr_snow )%laction ) THEN
1126	zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus ! energy for melting solid precipitation over the free ocean
1127	ENDIF
1128	ENDIF
1129	!
1130	IF( srcv(jpr_icb)%laction ) zqns(:,:) = zqns(:,:) - frcv(jpr_icb)%z3(:,:,1) * lfus ! remove heat content associated to iceberg melting
1131	!
1132	IF( ln_mixcpl ) THEN ; qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:)
1133	ELSE ; qns(:,:) = zqns(:,:)
1134	ENDIF
1135
1136	! ! solar flux over the ocean (qsr)
1137	IF ( srcv(jpr_qsroce)%laction ) THEN ; zqsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1)
1138	ELSE IF( srcv(jpr_qsrmix)%laction ) then ; zqsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1)
1139	ELSE ; zqsr(:,:) = 0._wp
1140	ENDIF
1141	IF( ln_dm2dc .AND. ln_cpl ) zqsr(:,:) = sbc_dcy( zqsr ) ! modify qsr to include the diurnal cycle
1142	IF( ln_mixcpl ) THEN ; qsr(:,:) = qsr(:,:) * xcplmask(:,:,0) + zqsr(:,:) * zmsk(:,:)
1143	ELSE ; qsr(:,:) = zqsr(:,:)
1144	ENDIF
1145	!
1146	! salt flux over the ocean (received by opa in case of opa <-> sas coupling)
1147	IF( srcv(jpr_sflx )%laction ) sfx(:,:) = frcv(jpr_sflx )%z3(:,:,1)
1148	! Ice cover (received by opa in case of opa <-> sas coupling)
1149	IF( srcv(jpr_fice )%laction ) fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1)
1150	!
1151
1152	ENDIF
1153	!
1154	CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr )
1155	!
1156	IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_rcv')
1157	!
1158	END SUBROUTINE sbc_cpl_rcv
1159
1160
1161	SUBROUTINE sbc_cpl_ice_tau( p_taui, p_tauj )
1162	!!----------------------------------------------------------------------
1163	!! * ROUTINE sbc_cpl_ice_tau *
1164	!!
1165	!! ** Purpose : provide the stress over sea-ice in coupled mode
1166	!!
1167	!! ** Method : transform the received stress from the atmosphere into
1168	!! an atmosphere-ice stress in the (i,j) ocean referencial
1169	!! and at the velocity point of the sea-ice model (cp_ice_msh):
1170	!! 'C'-grid : i- (j-) components given at U- (V-) point
1171	!! 'I'-grid : B-grid lower-left corner: both components given at I-point
1172	!!
1173	!! The received stress are :
1174	!! - defined by 3 components (if cartesian coordinate)
1175	!! or by 2 components (if spherical)
1176	!! - oriented along geographical coordinate (if eastward-northward)
1177	!! or along the local grid coordinate (if local grid)
1178	!! - given at U- and V-point, resp. if received on 2 grids
1179	!! or at a same point (T or I) if received on 1 grid
1180	!! Therefore and if necessary, they are successively
1181	!! processed in order to obtain them
1182	!! first as 2 components on the sphere
1183	!! second as 2 components oriented along the local grid
1184	!! third as 2 components on the cp_ice_msh point
1185	!!
1186	!! Except in 'oce and ice' case, only one vector stress field
1187	!! is received. It has already been processed in sbc_cpl_rcv
1188	!! so that it is now defined as (i,j) components given at U-
1189	!! and V-points, respectively. Therefore, only the third
1190	!! transformation is done and only if the ice-grid is a 'I'-grid.
1191	!!
1192	!! ** Action : return ptau_i, ptau_j, the stress over the ice at cp_ice_msh point
1193	!!----------------------------------------------------------------------
1194	REAL(wp), INTENT(out), DIMENSION(:,:) :: p_taui ! i- & j-components of atmos-ice stress [N/m2]
1195	REAL(wp), INTENT(out), DIMENSION(:,:) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid)
1196	!!
1197	INTEGER :: ji, jj ! dummy loop indices
1198	INTEGER :: itx ! index of taux over ice
1199	REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty
1200	!!----------------------------------------------------------------------
1201	!
1202	IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_tau')
1203	!
1204	CALL wrk_alloc( jpi,jpj, ztx, zty )
1205
1206	IF( srcv(jpr_itx1)%laction ) THEN ; itx = jpr_itx1
1207	ELSE ; itx = jpr_otx1
1208	ENDIF
1209
1210	! do something only if we just received the stress from atmosphere
1211	IF( nrcvinfo(itx) == OASIS_Rcv ) THEN
1212
1213	! ! ======================= !
1214	IF( srcv(jpr_itx1)%laction ) THEN ! ice stress received !
1215	! ! ======================= !
1216	!
1217	IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere
1218	! ! (cartesian to spherical -> 3 to 2 components)
1219	CALL geo2oce( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), frcv(jpr_itz1)%z3(:,:,1), &
1220	& srcv(jpr_itx1)%clgrid, ztx, zty )
1221	frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid
1222	frcv(jpr_ity1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid
1223	!
1224	IF( srcv(jpr_itx2)%laction ) THEN
1225	CALL geo2oce( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), frcv(jpr_itz2)%z3(:,:,1), &
1226	& srcv(jpr_itx2)%clgrid, ztx, zty )
1227	frcv(jpr_itx2)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid
1228	frcv(jpr_ity2)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid
1229	ENDIF
1230	!
1231	ENDIF
1232	!
1233	IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid
1234	! ! (geographical to local grid -> rotate the components)
1235	CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->i', ztx )
1236	IF( srcv(jpr_itx2)%laction ) THEN
1237	CALL rot_rep( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), srcv(jpr_itx2)%clgrid, 'en->j', zty )
1238	ELSE
1239	CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->j', zty )
1240	ENDIF
1241	frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid
1242	frcv(jpr_ity1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 1st grid
1243	ENDIF
1244	! ! ======================= !
1245	ELSE ! use ocean stress !
1246	! ! ======================= !
1247	frcv(jpr_itx1)%z3(:,:,1) = frcv(jpr_otx1)%z3(:,:,1)
1248	frcv(jpr_ity1)%z3(:,:,1) = frcv(jpr_oty1)%z3(:,:,1)
1249	!
1250	ENDIF
1251	! ! ======================= !
1252	! ! put on ice grid !
1253	! ! ======================= !
1254	!
1255	! j+1 j -----V---F
1256	! ice stress on ice velocity point (cp_ice_msh) ! \|
1257	! (C-grid ==>(U,V) or B-grid ==> I or F) j \| T U
1258	! \| \|
1259	! j j-1 -I-------\|
1260	! (for I) \| \|
1261	! i-1 i i
1262	! i i+1 (for I)
1263	SELECT CASE ( cp_ice_msh )
1264	!
1265	CASE( 'I' ) ! B-grid ==> I
1266	SELECT CASE ( srcv(jpr_itx1)%clgrid )
1267	CASE( 'U' )
1268	DO jj = 2, jpjm1 ! (U,V) ==> I
1269	DO ji = 2, jpim1 ! NO vector opt.
1270	p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji-1,jj ,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) )
1271	p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji ,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) )
1272	END DO
1273	END DO
1274	CASE( 'F' )
1275	DO jj = 2, jpjm1 ! F ==> I
1276	DO ji = 2, jpim1 ! NO vector opt.
1277	p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji-1,jj-1,1)
1278	p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji-1,jj-1,1)
1279	END DO
1280	END DO
1281	CASE( 'T' )
1282	DO jj = 2, jpjm1 ! T ==> I
1283	DO ji = 2, jpim1 ! NO vector opt.
1284	p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj ,1) + frcv(jpr_itx1)%z3(ji-1,jj ,1) &
1285	& + frcv(jpr_itx1)%z3(ji,jj-1,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) )
1286	p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj ,1) + frcv(jpr_ity1)%z3(ji-1,jj ,1) &
1287	& + frcv(jpr_ity1)%z3(ji,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) )
1288	END DO
1289	END DO
1290	CASE( 'I' )
1291	p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! I ==> I
1292	p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)
1293	END SELECT
1294	IF( srcv(jpr_itx1)%clgrid /= 'I' ) THEN
1295	CALL lbc_lnk( p_taui, 'I', -1. ) ; CALL lbc_lnk( p_tauj, 'I', -1. )
1296	ENDIF
1297	!
1298	CASE( 'F' ) ! B-grid ==> F
1299	SELECT CASE ( srcv(jpr_itx1)%clgrid )
1300	CASE( 'U' )
1301	DO jj = 2, jpjm1 ! (U,V) ==> F
1302	DO ji = fs_2, fs_jpim1 ! vector opt.
1303	p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji ,jj+1,1) )
1304	p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji,jj,1) + frcv(jpr_ity1)%z3(ji+1,jj ,1) )
1305	END DO
1306	END DO
1307	CASE( 'I' )
1308	DO jj = 2, jpjm1 ! I ==> F
1309	DO ji = 2, jpim1 ! NO vector opt.
1310	p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji+1,jj+1,1)
1311	p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji+1,jj+1,1)
1312	END DO
1313	END DO
1314	CASE( 'T' )
1315	DO jj = 2, jpjm1 ! T ==> F
1316	DO ji = 2, jpim1 ! NO vector opt.
1317	p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj ,1) + frcv(jpr_itx1)%z3(ji+1,jj ,1) &
1318	& + frcv(jpr_itx1)%z3(ji,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj+1,1) )
1319	p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj ,1) + frcv(jpr_ity1)%z3(ji+1,jj ,1) &
1320	& + frcv(jpr_ity1)%z3(ji,jj+1,1) + frcv(jpr_ity1)%z3(ji+1,jj+1,1) )
1321	END DO
1322	END DO
1323	CASE( 'F' )
1324	p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! F ==> F
1325	p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)
1326	END SELECT
1327	IF( srcv(jpr_itx1)%clgrid /= 'F' ) THEN
1328	CALL lbc_lnk( p_taui, 'F', -1. ) ; CALL lbc_lnk( p_tauj, 'F', -1. )
1329	ENDIF
1330	!
1331	CASE( 'C' ) ! C-grid ==> U,V
1332	SELECT CASE ( srcv(jpr_itx1)%clgrid )
1333	CASE( 'U' )
1334	p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! (U,V) ==> (U,V)
1335	p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)
1336	CASE( 'F' )
1337	DO jj = 2, jpjm1 ! F ==> (U,V)
1338	DO ji = fs_2, fs_jpim1 ! vector opt.
1339	p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji ,jj-1,1) )
1340	p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(jj,jj,1) + frcv(jpr_ity1)%z3(ji-1,jj ,1) )
1341	END DO
1342	END DO
1343	CASE( 'T' )
1344	DO jj = 2, jpjm1 ! T ==> (U,V)
1345	DO ji = fs_2, fs_jpim1 ! vector opt.
1346	p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj ,1) + frcv(jpr_itx1)%z3(ji,jj,1) )
1347	p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) )
1348	END DO
1349	END DO
1350	CASE( 'I' )
1351	DO jj = 2, jpjm1 ! I ==> (U,V)
1352	DO ji = 2, jpim1 ! NO vector opt.
1353	p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj ,1) )
1354	p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji+1,jj+1,1) + frcv(jpr_ity1)%z3(ji ,jj+1,1) )
1355	END DO
1356	END DO
1357	END SELECT
1358	IF( srcv(jpr_itx1)%clgrid /= 'U' ) THEN
1359	CALL lbc_lnk( p_taui, 'U', -1. ) ; CALL lbc_lnk( p_tauj, 'V', -1. )
1360	ENDIF
1361	END SELECT
1362
1363	ENDIF
1364	!
1365	CALL wrk_dealloc( jpi,jpj, ztx, zty )
1366	!
1367	IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_tau')
1368	!
1369	END SUBROUTINE sbc_cpl_ice_tau
1370
1371
1372	SUBROUTINE sbc_cpl_ice_flx( p_frld, palbi, psst, pist )
1373	!!----------------------------------------------------------------------
1374	!! * ROUTINE sbc_cpl_ice_flx *
1375	!!
1376	!! ** Purpose : provide the heat and freshwater fluxes of the ocean-ice system
1377	!!
1378	!! ** Method : transform the fields received from the atmosphere into
1379	!! surface heat and fresh water boundary condition for the
1380	!! ice-ocean system. The following fields are provided:
1381	!! * total non solar, solar and freshwater fluxes (qns_tot,
1382	!! qsr_tot and emp_tot) (total means weighted ice-ocean flux)
1383	!! NB: emp_tot include runoffs and calving.
1384	!! * fluxes over ice (qns_ice, qsr_ice, emp_ice) where
1385	!! emp_ice = sublimation - solid precipitation as liquid
1386	!! precipitation are re-routed directly to the ocean and
1387	!! calving directly enter the ocean (runoffs are read but included in trasbc.F90)
1388	!! * solid precipitation (sprecip), used to add to qns_tot
1389	!! the heat lost associated to melting solid precipitation
1390	!! over the ocean fraction.
1391	!! * heat content of rain, snow and evap can also be provided,
1392	!! otherwise heat flux associated with these mass flux are
1393	!! guessed (qemp_oce, qemp_ice)
1394	!!
1395	!! - the fluxes have been separated from the stress as
1396	!! (a) they are updated at each ice time step compare to
1397	!! an update at each coupled time step for the stress, and
1398	!! (b) the conservative computation of the fluxes over the
1399	!! sea-ice area requires the knowledge of the ice fraction
1400	!! after the ice advection and before the ice thermodynamics,
1401	!! so that the stress is updated before the ice dynamics
1402	!! while the fluxes are updated after it.
1403	!!
1404	!! ** Details
1405	!! qns_tot = pfrld * qns_oce + ( 1 - pfrld ) * qns_ice => provided
1406	!! + qemp_oce + qemp_ice => recalculated and added up to qns
1407	!!
1408	!! qsr_tot = pfrld * qsr_oce + ( 1 - pfrld ) * qsr_ice => provided
1409	!!
1410	!! emp_tot = emp_oce + emp_ice => calving is provided and added to emp_tot (and emp_oce).
1411	!! runoff (which includes rivers+icebergs) and iceshelf
1412	!! are provided but not included in emp here. Only runoff will
1413	!! be included in emp in other parts of NEMO code
1414	!! ** Action : update at each nf_ice time step:
1415	!! qns_tot, qsr_tot non-solar and solar total heat fluxes
1416	!! qns_ice, qsr_ice non-solar and solar heat fluxes over the ice
1417	!! emp_tot total evaporation - precipitation(liquid and solid) (-calving)
1418	!! emp_ice ice sublimation - solid precipitation over the ice
1419	!! dqns_ice d(non-solar heat flux)/d(Temperature) over the ice
1420	!! sprecip solid precipitation over the ocean
1421	!!----------------------------------------------------------------------
1422	REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction [0 to 1]
1423	! optional arguments, used only in 'mixed oce-ice' case
1424	REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo
1425	REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius]
1426	REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin]
1427	!
1428	INTEGER :: jl ! dummy loop index
1429	REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, zcptrain, zcptsnw, zicefr, zmsk, zsnw
1430	REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice
1431	REAL(wp), POINTER, DIMENSION(:,: ) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice
1432	REAL(wp), POINTER, DIMENSION(:,:,:) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice
1433	!!----------------------------------------------------------------------
1434	!
1435	IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_flx')
1436	!
1437	CALL wrk_alloc( jpi,jpj, zcptn, zcptrain, zcptsnw, zicefr, zmsk, zsnw )
1438	CALL wrk_alloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice )
1439	CALL wrk_alloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice )
1440	CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice )
1441
1442	IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0)
1443	zicefr(:,:) = 1.- p_frld(:,:)
1444	zcptn(:,:) = rcp * sst_m(:,:)
1445	!
1446	! ! ========================= !
1447	! ! freshwater budget ! (emp_tot)
1448	! ! ========================= !
1449	!
1450	! ! solid Precipitation (sprecip)
1451	! ! liquid + solid Precipitation (tprecip)
1452	! ! total Evaporation - total Precipitation (emp_tot)
1453	! ! sublimation - solid precipitation (cell average) (emp_ice)
1454	SELECT CASE( TRIM( sn_rcv_emp%cldes ) )
1455	CASE( 'conservative' ) ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp
1456	zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here
1457	ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here
1458	zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:)
1459	zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * zicefr(:,:)
1460	CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp
1461	zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1)
1462	zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * zicefr(:,:)
1463	zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1)
1464	ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:)
1465	END SELECT
1466
1467	#if defined key_lim3
1468	! zsnw = snow fraction over ice after wind blowing (=zicefr if no blowing)
1469	zsnw(:,:) = 0._wp ; CALL lim_thd_snwblow( p_frld, zsnw )
1470
1471	! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- !
1472	zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( zicefr(:,:) - zsnw(:,:) ) ! emp_ice = A * sublimation - zsnw * sprecip
1473	zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:) ! emp_oce = emp_tot - emp_ice
1474
1475	! --- evaporation over ocean (used later for qemp) --- !
1476	zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:)
1477
1478	! --- evaporation over ice (kg/m2/s) --- !
1479	zevap_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1)
1480	! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0
1481	! therefore, sublimation is not redistributed over the ice categories when no subgrid scale fluxes are provided by atm.
1482	zdevap_ice(:,:) = 0._wp
1483
1484	! --- Continental fluxes --- !
1485	IF( srcv(jpr_rnf)%laction ) THEN ! runoffs (included in emp later on)
1486	rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
1487	ENDIF
1488	IF( srcv(jpr_cal)%laction ) THEN ! calving (put in emp_tot and emp_oce)
1489	zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
1490	zemp_oce(:,:) = zemp_oce(:,:) - frcv(jpr_cal)%z3(:,:,1)
1491	ENDIF
1492	IF( srcv(jpr_icb)%laction ) THEN ! iceberg added to runoffs
1493	fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1)
1494	rnf(:,:) = rnf(:,:) + fwficb(:,:)
1495	ENDIF
1496	IF( srcv(jpr_isf)%laction ) THEN ! iceshelf (fwfisf <0 mean melting)
1497	fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1)
1498	ENDIF
1499
1500	IF( ln_mixcpl ) THEN
1501	emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:)
1502	emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:)
1503	emp_oce(:,:) = emp_oce(:,:) * xcplmask(:,:,0) + zemp_oce(:,:) * zmsk(:,:)
1504	sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:)
1505	tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:)
1506	DO jl=1,jpl
1507	evap_ice (:,:,jl) = evap_ice (:,:,jl) * xcplmask(:,:,0) + zevap_ice (:,:) * zmsk(:,:)
1508	devap_ice(:,:,jl) = devap_ice(:,:,jl) * xcplmask(:,:,0) + zdevap_ice(:,:) * zmsk(:,:)
1509	ENDDO
1510	ELSE
1511	emp_tot(:,:) = zemp_tot(:,:)
1512	emp_ice(:,:) = zemp_ice(:,:)
1513	emp_oce(:,:) = zemp_oce(:,:)
1514	sprecip(:,:) = zsprecip(:,:)
1515	tprecip(:,:) = ztprecip(:,:)
1516	DO jl=1,jpl
1517	evap_ice (:,:,jl) = zevap_ice (:,:)
1518	devap_ice(:,:,jl) = zdevap_ice(:,:)
1519	ENDDO
1520	ENDIF
1521
1522	#else
1523	zsnw(:,:) = zicefr(:,:)
1524	! --- Continental fluxes --- !
1525	IF( srcv(jpr_rnf)%laction ) THEN ! runoffs (included in emp later on)
1526	rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
1527	ENDIF
1528	IF( srcv(jpr_cal)%laction ) THEN ! calving (put in emp_tot)
1529	zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
1530	ENDIF
1531	IF( srcv(jpr_icb)%laction ) THEN ! iceberg added to runoffs
1532	fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1)
1533	rnf(:,:) = rnf(:,:) + fwficb(:,:)
1534	ENDIF
1535	IF( srcv(jpr_isf)%laction ) THEN ! iceshelf (fwfisf <0 mean melting)
1536	fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1)
1537	ENDIF
1538
1539	IF( ln_mixcpl ) THEN
1540	emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:)
1541	emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:)
1542	sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:)
1543	tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:)
1544	ELSE
1545	emp_tot(:,:) = zemp_tot(:,:)
1546	emp_ice(:,:) = zemp_ice(:,:)
1547	sprecip(:,:) = zsprecip(:,:)
1548	tprecip(:,:) = ztprecip(:,:)
1549	ENDIF
1550
1551	#endif
1552	! outputs
1553	!! IF( srcv(jpr_rnf)%laction ) CALL iom_put( 'runoffs' , rnf(:,:) * tmask(:,:,1) ) ! runoff
1554	!! IF( srcv(jpr_isf)%laction ) CALL iom_put( 'iceshelf_cea', -fwfisf(:,:) * tmask(:,:,1) ) ! iceshelf
1555	IF( srcv(jpr_cal)%laction ) CALL iom_put( 'calving_cea' , frcv(jpr_cal)%z3(:,:,1) * tmask(:,:,1) ) ! calving
1556	IF( srcv(jpr_icb)%laction ) CALL iom_put( 'iceberg_cea' , frcv(jpr_icb)%z3(:,:,1) * tmask(:,:,1) ) ! icebergs
1557	IF( iom_use('snowpre') ) CALL iom_put( 'snowpre' , sprecip(:,:) ) ! Snow
1558	IF( iom_use('precip') ) CALL iom_put( 'precip' , tprecip(:,:) ) ! total precipitation
1559	IF( iom_use('rain') ) CALL iom_put( 'rain' , tprecip(:,:) - sprecip(:,:) ) ! liquid precipitation
1560	IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average)
1561	IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average)
1562	IF( iom_use('rain_ao_cea') ) CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * p_frld(:,:) ) ! liquid precipitation over ocean (cell average)
1563	IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * tmask(:,:,1) ) ! Sublimation over sea-ice (cell average)
1564	IF( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) &
1565	& - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average)
1566	! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf
1567	!
1568	! ! ========================= !
1569	SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) ! non solar heat fluxes ! (qns)
1570	! ! ========================= !
1571	CASE( 'oce only' ) ! the required field is directly provided
1572	zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)
1573	CASE( 'conservative' ) ! the required fields are directly provided
1574	zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
1575	IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
1576	zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl)
1577	ELSE
1578	DO jl=1,jpl
1579	zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) ! Set all category values equal
1580	ENDDO
1581	ENDIF
1582	CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes
1583	zqns_tot(:,:) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)
1584	IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
1585	DO jl=1,jpl
1586	zqns_tot(:,: ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)
1587	zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl)
1588	ENDDO
1589	ELSE
1590	qns_tot(:,:) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
1591	DO jl=1,jpl
1592	zqns_tot(:,: ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
1593	zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)
1594	ENDDO
1595	ENDIF
1596	CASE( 'mixed oce-ice' ) ! the ice flux is cumputed from the total flux, the SST and ice informations
1597	! NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED
1598	zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1)
1599	zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) &
1600	& + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:) &
1601	& + pist(:,:,1) * zicefr(:,:) ) )
1602	END SELECT
1603	!
1604	! --- calving (removed from qns_tot) --- !
1605	IF( srcv(jpr_cal)%laction ) zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) * lfus ! remove latent heat of calving
1606	! we suppose it melts at 0deg, though it should be temp. of surrounding ocean
1607	! --- iceberg (removed from qns_tot) --- !
1608	IF( srcv(jpr_icb)%laction ) zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_icb)%z3(:,:,1) * lfus ! remove latent heat of iceberg melting
1609
1610	#if defined key_lim3
1611	! --- non solar flux over ocean --- !
1612	! note: p_frld cannot be = 0 since we limit the ice concentration to amax
1613	zqns_oce = 0._wp
1614	WHERE( p_frld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:)
1615
1616	! Heat content per unit mass of snow (J/kg)
1617	WHERE( SUM( a_i, dim=3 ) > 1.e-10 ) ; zcptsnw(:,:) = cpic * SUM( (tn_ice - rt0) * a_i, dim=3 ) / SUM( a_i, dim=3 )
1618	ELSEWHERE ; zcptsnw(:,:) = zcptn(:,:)
1619	ENDWHERE
1620	! Heat content per unit mass of rain (J/kg)
1621	zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * p_frld(:,:) )
1622
1623	! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- !
1624	zqprec_ice(:,:) = rhosn * ( zcptsnw(:,:) - lfus )
1625
1626	! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- !
1627	DO jl = 1, jpl
1628	zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * cpic ) but atm. does not take it into account
1629	END DO
1630
1631	! --- heat flux associated with emp (W/m2) --- !
1632	zqemp_oce(:,:) = - zevap_oce(:,:) * zcptn (:,:) & ! evap
1633	& + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptrain(:,:) & ! liquid precip
1634	& + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptsnw (:,:) - lfus ) ! solid precip over ocean + snow melting
1635	zqemp_ice(:,:) = zsprecip(:,:) * zsnw * ( zcptsnw (:,:) - lfus ) ! solid precip over ice (qevap_ice=0 since atm. does not take it into account)
1636	!! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptsnw (:,:) & ! ice evap
1637	!! & + zsprecip(:,:) * zsnw * zqprec_ice(:,:) * r1_rhosn ! solid precip over ice
1638
1639	! --- total non solar flux (including evap/precip) --- !
1640	zqns_tot(:,:) = zqns_tot(:,:) + zqemp_ice(:,:) + zqemp_oce(:,:)
1641
1642	! --- in case both coupled/forced are active, we must mix values --- !
1643	IF( ln_mixcpl ) THEN
1644	qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:)
1645	qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:)
1646	DO jl=1,jpl
1647	qns_ice (:,:,jl) = qns_ice (:,:,jl) * xcplmask(:,:,0) + zqns_ice (:,:,jl)* zmsk(:,:)
1648	qevap_ice(:,:,jl) = qevap_ice(:,:,jl) * xcplmask(:,:,0) + zqevap_ice(:,:,jl)* zmsk(:,:)
1649	ENDDO
1650	qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:)
1651	qemp_oce (:,:) = qemp_oce(:,:) * xcplmask(:,:,0) + zqemp_oce(:,:)* zmsk(:,:)
1652	qemp_ice (:,:) = qemp_ice(:,:) * xcplmask(:,:,0) + zqemp_ice(:,:)* zmsk(:,:)
1653	ELSE
1654	qns_tot (:,: ) = zqns_tot (:,: )
1655	qns_oce (:,: ) = zqns_oce (:,: )
1656	qns_ice (:,:,:) = zqns_ice (:,:,:)
1657	qevap_ice(:,:,:) = zqevap_ice(:,:,:)
1658	qprec_ice(:,: ) = zqprec_ice(:,: )
1659	qemp_oce (:,: ) = zqemp_oce (:,: )
1660	qemp_ice (:,: ) = zqemp_ice (:,: )
1661	ENDIF
1662
1663	#else
1664	zcptsnw (:,:) = zcptn(:,:)
1665	zcptrain(:,:) = zcptn(:,:)
1666
1667	! clem: this formulation is certainly wrong... but better than it was...
1668	zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with:
1669	& - ( p_frld(:,:) * zsprecip(:,:) * lfus ) & ! remove the latent heat flux of solid precip. melting
1670	& - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST)
1671	& - zemp_ice(:,:) ) * zcptn(:,:)
1672
1673	IF( ln_mixcpl ) THEN
1674	qns_tot(:,:) = qns(:,:) * p_frld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk
1675	qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:)
1676	DO jl=1,jpl
1677	qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:)
1678	ENDDO
1679	ELSE
1680	qns_tot(:,: ) = zqns_tot(:,: )
1681	qns_ice(:,:,:) = zqns_ice(:,:,:)
1682	ENDIF
1683
1684	#endif
1685	! outputs
1686	IF( srcv(jpr_cal)%laction ) CALL iom_put('hflx_cal_cea' , - frcv(jpr_cal)%z3(:,:,1) * lfus ) ! latent heat from calving
1687	IF( srcv(jpr_icb)%laction ) CALL iom_put('hflx_icb_cea' , - frcv(jpr_icb)%z3(:,:,1) * lfus ) ! latent heat from icebergs melting
1688	IF( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea', sprecip(:,:) * ( zcptsnw(:,:) - Lfus ) ) ! heat flux from snow (cell average)
1689	IF( iom_use('hflx_rain_cea') ) CALL iom_put('hflx_rain_cea',( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) ! heat flux from rain (cell average)
1690	IF( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea',(frcv(jpr_tevp)%z3(:,:,1)-frcv(jpr_ievp)%z3(:,:,1)*zicefr(:,:)) & ! heat flux from from evap (cell average)
1691	& * zcptn(:,:) * tmask(:,:,1) )
1692	IF( iom_use('hflx_prec_cea') ) CALL iom_put('hflx_prec_cea', sprecip(:,:) * ( zcptsnw(:,:) - Lfus ) + & ! heat flux from all precip (cell avg)
1693	& ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )
1694	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)
1695	IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea',sprecip(:,:) * (zcptsnw(:,:) - Lfus) * zsnw(:,:) ) ! heat flux from snow (over ice)
1696	! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp.
1697	!
1698	! ! ========================= !
1699	SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) ! solar heat fluxes ! (qsr)
1700	! ! ========================= !
1701	CASE( 'oce only' )
1702	zqsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) )
1703	CASE( 'conservative' )
1704	zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)
1705	IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
1706	zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl)
1707	ELSE
1708	! Set all category values equal for the moment
1709	DO jl=1,jpl
1710	zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
1711	ENDDO
1712	ENDIF
1713	zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)
1714	zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1)
1715	CASE( 'oce and ice' )
1716	zqsr_tot(:,: ) = p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)
1717	IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
1718	DO jl=1,jpl
1719	zqsr_tot(:,: ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)
1720	zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl)
1721	ENDDO
1722	ELSE
1723	qsr_tot(:,: ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
1724	DO jl=1,jpl
1725	zqsr_tot(:,: ) = zqsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
1726	zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
1727	ENDDO
1728	ENDIF
1729	CASE( 'mixed oce-ice' )
1730	zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)
1731	! NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED
1732	! Create solar heat flux over ice using incoming solar heat flux and albedos
1733	! ( see OASIS3 user guide, 5th edition, p39 )
1734	zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) &
1735	& / ( 1.- ( albedo_oce_mix(:,: ) * p_frld(:,:) &
1736	& + palbi (:,:,1) * zicefr(:,:) ) )
1737	END SELECT
1738	IF( ln_dm2dc .AND. ln_cpl ) THEN ! modify qsr to include the diurnal cycle
1739	zqsr_tot(:,: ) = sbc_dcy( zqsr_tot(:,: ) )
1740	DO jl=1,jpl
1741	zqsr_ice(:,:,jl) = sbc_dcy( zqsr_ice(:,:,jl) )
1742	ENDDO
1743	ENDIF
1744
1745	#if defined key_lim3
1746	! --- solar flux over ocean --- !
1747	! note: p_frld cannot be = 0 since we limit the ice concentration to amax
1748	zqsr_oce = 0._wp
1749	WHERE( p_frld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / p_frld(:,:)
1750
1751	IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:)
1752	ELSE ; qsr_oce(:,:) = zqsr_oce(:,:) ; ENDIF
1753	#endif
1754
1755	IF( ln_mixcpl ) THEN
1756	qsr_tot(:,:) = qsr(:,:) * p_frld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk
1757	qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) + zqsr_tot(:,:)* zmsk(:,:)
1758	DO jl=1,jpl
1759	qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) + zqsr_ice(:,:,jl)* zmsk(:,:)
1760	ENDDO
1761	ELSE
1762	qsr_tot(:,: ) = zqsr_tot(:,: )
1763	qsr_ice(:,:,:) = zqsr_ice(:,:,:)
1764	ENDIF
1765
1766	! ! ========================= !
1767	SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) ! d(qns)/dt !
1768	! ! ========================= !
1769	CASE ('coupled')
1770	IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN
1771	zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)
1772	ELSE
1773	! Set all category values equal for the moment
1774	DO jl=1,jpl
1775	zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)
1776	ENDDO
1777	ENDIF
1778	END SELECT
1779
1780	IF( ln_mixcpl ) THEN
1781	DO jl=1,jpl
1782	dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:)
1783	ENDDO
1784	ELSE
1785	dqns_ice(:,:,:) = zdqns_ice(:,:,:)
1786	ENDIF
1787
1788	! ! ========================= !
1789	SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! topmelt and botmelt !
1790	! ! ========================= !
1791	CASE ('coupled')
1792	topmelt(:,:,:)=frcv(jpr_topm)%z3(:,:,:)
1793	botmelt(:,:,:)=frcv(jpr_botm)%z3(:,:,:)
1794	END SELECT
1795
1796	! Surface transimission parameter io (Maykut Untersteiner , 1971 ; Ebert and Curry, 1993 )
1797	! Used for LIM2 and LIM3
1798	! Coupled case: since cloud cover is not received from atmosphere
1799	! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81)
1800	fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )
1801	fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )
1802
1803	CALL wrk_dealloc( jpi,jpj, zcptn, zcptrain, zcptsnw, zicefr, zmsk, zsnw )
1804	CALL wrk_dealloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice )
1805	CALL wrk_dealloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice )
1806	CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice )
1807	!
1808	IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_flx')
1809	!
1810	END SUBROUTINE sbc_cpl_ice_flx
1811
1812
1813	SUBROUTINE sbc_cpl_snd( kt )
1814	!!----------------------------------------------------------------------
1815	!! * ROUTINE sbc_cpl_snd *
1816	!!
1817	!! ** Purpose : provide the ocean-ice informations to the atmosphere
1818	!!
1819	!! ** Method : send to the atmosphere through a call to cpl_snd
1820	!! all the needed fields (as defined in sbc_cpl_init)
1821	!!----------------------------------------------------------------------
1822	INTEGER, INTENT(in) :: kt
1823	!
1824	INTEGER :: ji, jj, jl ! dummy loop indices
1825	INTEGER :: isec, info ! local integer
1826	REAL(wp) :: zumax, zvmax
1827	REAL(wp), POINTER, DIMENSION(:,:) :: zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1
1828	REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmp3, ztmp4
1829	!!----------------------------------------------------------------------
1830	!
1831	IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_snd')
1832	!
1833	CALL wrk_alloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )
1834	CALL wrk_alloc( jpi,jpj,jpl, ztmp3, ztmp4 )
1835
1836	isec = ( kt - nit000 ) * NINT(rdttra(1)) ! date of exchanges
1837
1838	zfr_l(:,:) = 1.- fr_i(:,:)
1839	! ! ------------------------- !
1840	! ! Surface temperature ! in Kelvin
1841	! ! ------------------------- !
1842	IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN
1843
1844	IF ( nn_components == jp_iam_opa ) THEN
1845	ztmp1(:,:) = tsn(:,:,1,jp_tem) ! send temperature as it is (potential or conservative) -> use of ln_useCT on the received part
1846	ELSE
1847	! we must send the surface potential temperature
1848	IF( ln_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) )
1849	ELSE ; ztmp1(:,:) = tsn(:,:,1,jp_tem)
1850	ENDIF
1851	!
1852	SELECT CASE( sn_snd_temp%cldes)
1853	CASE( 'oce only' ) ; ztmp1(:,:) = ztmp1(:,:) + rt0
1854	CASE( 'oce and ice' ) ; ztmp1(:,:) = ztmp1(:,:) + rt0
1855	SELECT CASE( sn_snd_temp%clcat )
1856	CASE( 'yes' )
1857	ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl)
1858	CASE( 'no' )
1859	WHERE( SUM( a_i, dim=3 ) /= 0. )
1860	ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 )
1861	ELSEWHERE
1862	ztmp3(:,:,1) = rt0
1863	END WHERE
1864	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
1865	END SELECT
1866	CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)
1867	SELECT CASE( sn_snd_temp%clcat )
1868	CASE( 'yes' )
1869	ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
1870	CASE( 'no' )
1871	ztmp3(:,:,:) = 0.0
1872	DO jl=1,jpl
1873	ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)
1874	ENDDO
1875	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
1876	END SELECT
1877	CASE( 'mixed oce-ice' )
1878	ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)
1879	DO jl=1,jpl
1880	ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl)
1881	ENDDO
1882	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' )
1883	END SELECT
1884	ENDIF
1885	IF( ssnd(jps_toce)%laction ) CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
1886	IF( ssnd(jps_tice)%laction ) CALL cpl_snd( jps_tice, isec, ztmp3, info )
1887	IF( ssnd(jps_tmix)%laction ) CALL cpl_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
1888	ENDIF
1889	! ! ------------------------- !
1890	! ! Albedo !
1891	! ! ------------------------- !
1892	IF( ssnd(jps_albice)%laction ) THEN ! ice
1893	SELECT CASE( sn_snd_alb%cldes )
1894	CASE( 'ice' )
1895	SELECT CASE( sn_snd_alb%clcat )
1896	CASE( 'yes' )
1897	ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl)
1898	CASE( 'no' )
1899	WHERE( SUM( a_i, dim=3 ) /= 0. )
1900	ztmp1(:,:) = SUM( alb_ice (:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) / SUM( a_i(:,:,1:jpl), dim=3 )
1901	ELSEWHERE
1902	ztmp1(:,:) = albedo_oce_mix(:,:)
1903	END WHERE
1904	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%clcat' )
1905	END SELECT
1906	CASE( 'weighted ice' ) ;
1907	SELECT CASE( sn_snd_alb%clcat )
1908	CASE( 'yes' )
1909	ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
1910	CASE( 'no' )
1911	WHERE( fr_i (:,:) > 0. )
1912	ztmp1(:,:) = SUM ( alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 )
1913	ELSEWHERE
1914	ztmp1(:,:) = 0.
1915	END WHERE
1916	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ice%clcat' )
1917	END SELECT
1918	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' )
1919	END SELECT
1920
1921	SELECT CASE( sn_snd_alb%clcat )
1922	CASE( 'yes' )
1923	CALL cpl_snd( jps_albice, isec, ztmp3, info ) !-> MV this has never been checked in coupled mode
1924	CASE( 'no' )
1925	CALL cpl_snd( jps_albice, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
1926	END SELECT
1927	ENDIF
1928
1929	IF( ssnd(jps_albmix)%laction ) THEN ! mixed ice-ocean
1930	ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:)
1931	DO jl=1,jpl
1932	ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl)
1933	ENDDO
1934	CALL cpl_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
1935	ENDIF
1936	! ! ------------------------- !
1937	! ! Ice fraction & Thickness !
1938	! ! ------------------------- !
1939	! Send ice fraction field to atmosphere
1940	IF( ssnd(jps_fice)%laction ) THEN
1941	SELECT CASE( sn_snd_thick%clcat )
1942	CASE( 'yes' ) ; ztmp3(:,:,1:jpl) = a_i(:,:,1:jpl)
1943	CASE( 'no' ) ; ztmp3(:,:,1 ) = fr_i(:,: )
1944	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
1945	END SELECT
1946	IF( ssnd(jps_fice)%laction ) CALL cpl_snd( jps_fice, isec, ztmp3, info )
1947	ENDIF
1948
1949	! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling)
1950	IF( ssnd(jps_fice2)%laction ) THEN
1951	ztmp3(:,:,1) = fr_i(:,:)
1952	IF( ssnd(jps_fice2)%laction ) CALL cpl_snd( jps_fice2, isec, ztmp3, info )
1953	ENDIF
1954
1955	! Send ice and snow thickness field
1956	IF( ssnd(jps_hice)%laction .OR. ssnd(jps_hsnw)%laction ) THEN
1957	SELECT CASE( sn_snd_thick%cldes)
1958	CASE( 'none' ) ! nothing to do
1959	CASE( 'weighted ice and snow' )
1960	SELECT CASE( sn_snd_thick%clcat )
1961	CASE( 'yes' )
1962	ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) * a_i(:,:,1:jpl)
1963	ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) * a_i(:,:,1:jpl)
1964	CASE( 'no' )
1965	ztmp3(:,:,:) = 0.0 ; ztmp4(:,:,:) = 0.0
1966	DO jl=1,jpl
1967	ztmp3(:,:,1) = ztmp3(:,:,1) + ht_i(:,:,jl) * a_i(:,:,jl)
1968	ztmp4(:,:,1) = ztmp4(:,:,1) + ht_s(:,:,jl) * a_i(:,:,jl)
1969	ENDDO
1970	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
1971	END SELECT
1972	CASE( 'ice and snow' )
1973	SELECT CASE( sn_snd_thick%clcat )
1974	CASE( 'yes' )
1975	ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl)
1976	ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl)
1977	CASE( 'no' )
1978	WHERE( SUM( a_i, dim=3 ) /= 0. )
1979	ztmp3(:,:,1) = SUM( ht_i * a_i, dim=3 ) / SUM( a_i, dim=3 )
1980	ztmp4(:,:,1) = SUM( ht_s * a_i, dim=3 ) / SUM( a_i, dim=3 )
1981	ELSEWHERE
1982	ztmp3(:,:,1) = 0.
1983	ztmp4(:,:,1) = 0.
1984	END WHERE
1985	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
1986	END SELECT
1987	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' )
1988	END SELECT
1989	IF( ssnd(jps_hice)%laction ) CALL cpl_snd( jps_hice, isec, ztmp3, info )
1990	IF( ssnd(jps_hsnw)%laction ) CALL cpl_snd( jps_hsnw, isec, ztmp4, info )
1991	ENDIF
1992	!
1993	#if defined key_cpl_carbon_cycle
1994	! ! ------------------------- !
1995	! ! CO2 flux from PISCES !
1996	! ! ------------------------- !
1997	IF( nn_closea == 1 ) THEN ! No carbon flux on closed seas
1998	DO jl = 1, jpncs
1999	DO jj = ncsj1(jl), ncsj2(jl)
2000	DO ji = ncsi1(jl), ncsi2(jl)
2001	oce_co2(ji,jj) = 0.
2002	END DO
2003	END DO
2004	END DO
2005	ENDIF
2006	IF( ssnd(jps_co2)%laction ) CALL cpl_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info )
2007	!
2008	#endif
2009
2010	! ! ------------------------- !
2011	! ! DMS flux from PISCES !
2012	! ! ------------------------- !
2013	IF( ssnd(jps_dms)%laction ) THEN
2014	IF( nn_closea == 1 ) THEN ! No DMS flux on closed seas
2015	DO jl = 1, jpncs
2016	DO jj = ncsj1(jl), ncsj2(jl)
2017	DO ji = ncsi1(jl), ncsi2(jl)
2018	oce_dms(ji,jj) = 0.
2019	END DO
2020	END DO
2021	END DO
2022	ENDIF
2023	!
2024	oce_dms(:,:) = 1000. * oce_dms(:,:) ! factor 1e3 to have molS.m-2.s-1
2025	!
2026	CALL cpl_snd( jps_dms , isec, RESHAPE ( oce_dms, (/jpi,jpj,1/) ) , info )
2027	ENDIF
2028	! ! ------------------------- !
2029	! ! N2O flux from PISCES !
2030	! ! ------------------------- !
2031	IF( ssnd(jps_n2o)%laction ) THEN
2032	IF( nn_closea == 1 ) THEN ! No N2O flux on closed seas
2033	DO jl = 1, jpncs
2034	DO jj = ncsj1(jl), ncsj2(jl)
2035	DO ji = ncsi1(jl), ncsi2(jl)
2036	oce_n2o(ji,jj) = 0.
2037	END DO
2038	END DO
2039	END DO
2040	ENDIF
2041	!
2042	oce_n2o(:,:) = 1000. * oce_n2o(:,:) ! factor 1e3 to have molS.m-2.s-1
2043	!!! ATTENTION, vÃ©rification ici Ã faire pour unitÃ© ! -- ThL.
2044	CALL cpl_snd( jps_n2o , isec, RESHAPE ( oce_n2o, (/jpi,jpj,1/) ) , info )
2045	ENDIF
2046	! ! ------------------------- !
2047	IF( ssnd(jps_ocx1)%laction ) THEN ! Surface current !
2048	! ! ------------------------- !
2049	!
2050	! j+1 j -----V---F
2051	! surface velocity always sent from T point ! \|
2052	! j \| T U
2053	! \| \|
2054	! j j-1 -I-------\|
2055	! (for I) \| \|
2056	! i-1 i i
2057	! i i+1 (for I)
2058	IF( nn_components == jp_iam_opa ) THEN
2059	zotx1(:,:) = un(:,:,1)
2060	zoty1(:,:) = vn(:,:,1)
2061	ELSE
2062	SELECT CASE( TRIM( sn_snd_crt%cldes ) )
2063	CASE( 'oce only' ) ! C-grid ==> T
2064	DO jj = 2, jpjm1
2065	DO ji = fs_2, fs_jpim1 ! vector opt.
2066	zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) )
2067	zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) )
2068	END DO
2069	END DO
2070	CASE( 'weighted oce and ice' )
2071	SELECT CASE ( cp_ice_msh )
2072	CASE( 'C' ) ! Ocean and Ice on C-grid ==> T
2073	DO jj = 2, jpjm1
2074	DO ji = fs_2, fs_jpim1 ! vector opt.
2075	zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj)
2076	zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj)
2077	zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj)
2078	zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj)
2079	END DO
2080	END DO
2081	CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T
2082	DO jj = 2, jpjm1
2083	DO ji = 2, jpim1 ! NO vector opt.
2084	zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj)
2085	zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj)
2086	zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) &
2087	& + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj)
2088	zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) &
2089	& + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj)
2090	END DO
2091	END DO
2092	CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T
2093	DO jj = 2, jpjm1
2094	DO ji = 2, jpim1 ! NO vector opt.
2095	zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj)
2096	zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj)
2097	zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) &
2098	& + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj)
2099	zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) &
2100	& + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj)
2101	END DO
2102	END DO
2103	END SELECT
2104	CALL lbc_lnk( zitx1, 'T', -1. ) ; CALL lbc_lnk( zity1, 'T', -1. )
2105	CASE( 'mixed oce-ice' )
2106	SELECT CASE ( cp_ice_msh )
2107	CASE( 'C' ) ! Ocean and Ice on C-grid ==> T
2108	DO jj = 2, jpjm1
2109	DO ji = fs_2, fs_jpim1 ! vector opt.
2110	zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) &
2111	& + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj)
2112	zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) &
2113	& + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj)
2114	END DO
2115	END DO
2116	CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T
2117	DO jj = 2, jpjm1
2118	DO ji = 2, jpim1 ! NO vector opt.
2119	zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) &
2120	& + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) &
2121	& + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj)
2122	zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) &
2123	& + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) &
2124	& + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj)
2125	END DO
2126	END DO
2127	CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T
2128	DO jj = 2, jpjm1
2129	DO ji = 2, jpim1 ! NO vector opt.
2130	zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) &
2131	& + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) &
2132	& + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj)
2133	zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) &
2134	& + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) &
2135	& + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj)
2136	END DO
2137	END DO
2138	END SELECT
2139	END SELECT
2140	CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. ) ; CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. )
2141	!
2142	ENDIF
2143	!
2144	!
2145	IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components
2146	! ! Ocean component
2147	CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component
2148	CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component
2149	zotx1(:,:) = ztmp1(:,:) ! overwrite the components
2150	zoty1(:,:) = ztmp2(:,:)
2151	IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component
2152	CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component
2153	CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component
2154	zitx1(:,:) = ztmp1(:,:) ! overwrite the components
2155	zity1(:,:) = ztmp2(:,:)
2156	ENDIF
2157	ENDIF
2158	!
2159	! spherical coordinates to cartesian -> 2 components to 3 components
2160	IF( TRIM( sn_snd_crt%clvref ) == 'cartesian' ) THEN
2161	ztmp1(:,:) = zotx1(:,:) ! ocean currents
2162	ztmp2(:,:) = zoty1(:,:)
2163	CALL oce2geo ( ztmp1, ztmp2, 'T', zotx1, zoty1, zotz1 )
2164	!
2165	IF( ssnd(jps_ivx1)%laction ) THEN ! ice velocities
2166	ztmp1(:,:) = zitx1(:,:)
2167	ztmp1(:,:) = zity1(:,:)
2168	CALL oce2geo ( ztmp1, ztmp2, 'T', zitx1, zity1, zitz1 )
2169	ENDIF
2170	ENDIF
2171	!
2172	IF( ssnd(jps_ocx1)%laction ) CALL cpl_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info ) ! ocean x current 1st grid
2173	IF( ssnd(jps_ocy1)%laction ) CALL cpl_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info ) ! ocean y current 1st grid
2174	IF( ssnd(jps_ocz1)%laction ) CALL cpl_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info ) ! ocean z current 1st grid
2175	!
2176	IF( ssnd(jps_ivx1)%laction ) CALL cpl_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info ) ! ice x current 1st grid
2177	IF( ssnd(jps_ivy1)%laction ) CALL cpl_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info ) ! ice y current 1st grid
2178	IF( ssnd(jps_ivz1)%laction ) CALL cpl_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info ) ! ice z current 1st grid
2179	!
2180	ENDIF
2181	!
2182	!
2183	! Fields sent by OPA to SAS when doing OPA<->SAS coupling
2184	! ! SSH
2185	IF( ssnd(jps_ssh )%laction ) THEN
2186	! ! removed inverse barometer ssh when Patm
2187	! forcing is used (for sea-ice dynamics)
2188	IF( ln_apr_dyn ) THEN ; ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
2189	ELSE ; ztmp1(:,:) = sshn(:,:)
2190	ENDIF
2191	CALL cpl_snd( jps_ssh , isec, RESHAPE ( ztmp1 , (/jpi,jpj,1/) ), info )
2192
2193	ENDIF
2194	! ! SSS
2195	IF( ssnd(jps_soce )%laction ) THEN
2196	CALL cpl_snd( jps_soce , isec, RESHAPE ( tsn(:,:,1,jp_sal), (/jpi,jpj,1/) ), info )
2197	ENDIF
2198	! ! first T level thickness
2199	IF( ssnd(jps_e3t1st )%laction ) THEN
2200	CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( fse3t_n(:,:,1) , (/jpi,jpj,1/) ), info )
2201	ENDIF
2202	! ! Qsr fraction
2203	IF( ssnd(jps_fraqsr)%laction ) THEN
2204	CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( fraqsr_1lev(:,:) , (/jpi,jpj,1/) ), info )
2205	ENDIF
2206	!
2207	! Fields sent by SAS to OPA when OASIS coupling
2208	! ! Solar heat flux
2209	IF( ssnd(jps_qsroce)%laction ) CALL cpl_snd( jps_qsroce, isec, RESHAPE ( qsr , (/jpi,jpj,1/) ), info )
2210	IF( ssnd(jps_qnsoce)%laction ) CALL cpl_snd( jps_qnsoce, isec, RESHAPE ( qns , (/jpi,jpj,1/) ), info )
2211	IF( ssnd(jps_oemp )%laction ) CALL cpl_snd( jps_oemp , isec, RESHAPE ( emp , (/jpi,jpj,1/) ), info )
2212	IF( ssnd(jps_sflx )%laction ) CALL cpl_snd( jps_sflx , isec, RESHAPE ( sfx , (/jpi,jpj,1/) ), info )
2213	IF( ssnd(jps_otx1 )%laction ) CALL cpl_snd( jps_otx1 , isec, RESHAPE ( utau, (/jpi,jpj,1/) ), info )
2214	IF( ssnd(jps_oty1 )%laction ) CALL cpl_snd( jps_oty1 , isec, RESHAPE ( vtau, (/jpi,jpj,1/) ), info )
2215	IF( ssnd(jps_rnf )%laction ) CALL cpl_snd( jps_rnf , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info )
2216	IF( ssnd(jps_taum )%laction ) CALL cpl_snd( jps_taum , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info )
2217
2218	CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )
2219	CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 )
2220	!
2221	IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_snd')
2222	!
2223	END SUBROUTINE sbc_cpl_snd
2224
2225	!!======================================================================
2226	END MODULE sbccpl

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

Download in other formats: