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

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

sbccpl.F90 in branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

Context Navigation

source: branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 6920

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

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

Download in other formats: