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

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

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

Context Navigation

source: branches/UKMO/dev_r5518_coupling_GSI7_GSI8_landice/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 5708

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

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

Download in other formats: