Context Navigation

sbccpl.F90 @ 6252

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

Merge branches/UKMO/dev_r5107_hadgem3_cplseq@5646

Again this was not at all straightforward because it reported
conflicts in:
DOC/TexFiles/Chapters/Chap_STO.tex
DOC/TexFiles/Namelist/namcfg_orca1
and
DOC/TexFiles/Namelist/namsbc_isf

I dont care about those for the purposes of this so I've run
fcm conflicts and in each case selected (y) to "accept the local delete"!

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

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

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

Context Navigation

source: branches/UKMO/nemo_v3_6_STABLE_pkg/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 6252

Download in other formats: