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_landice_fw_input_option2/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

Context Navigation

source: branches/UKMO/dev_r5518_GO6_package_landice_fw_input_option2/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 7919

Last change on this file since 7919 was 7919, checked in by davestorkey, 7 years ago
Commit changes to UKMO branch to implement updated scheme for freshwater input from icesheets for coupled models.
File size: 149.2 KB

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

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

Download in other formats: