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

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

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

Context Navigation

source: branches/UKMO/dev_r5518_GO6_package_r8356_plus_form_drag/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 8449

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

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

Download in other formats: