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_CICE_coupling_GSI7_GSI8/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

Context Navigation

source: branches/UKMO/dev_r5518_CICE_coupling_GSI7_GSI8/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 5668

Last change on this file since 5668 was 5668, checked in by dancopsey, 9 years ago
Added sn_snd_thick1 to list of namelist variables expected from namsbc_cpl
File size: 131.2 KB

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

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

Download in other formats: