Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

sbccpl.F90

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

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

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

Context Navigation

source: branches/UKMO/test_moci_test_suite_namelist_read/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

Download in other formats: