Context Navigation

sbccpl.F90 @ 6681

Last change on this file since 6681 was 6681, checked in by frrh, 8 years ago

Add changes for compatibility with main MEDUSA branch and to enable
coupling of true DMS, CO2 flux, CO2 from atmos and Dust from atmos.

This places responsibility for populating outgoing arrays and
employing incoming arrays on the MEDUSA branch rather than the
coupling interface branch.

NOTE: This revision contains a temporary fix for testing
to ensure coupling fields are initialised in the absence of
a clear mechanism for obtaining initial start-up values. Remove
the lines labelled RSRH in oce.F90 when this is resolved in the
MEDUSA code.

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

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

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

Context Navigation

source: branches/UKMO/dev_r5518_GSI7_GSI8_landice_bitcomp_medusa/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 6681

Download in other formats: