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

Context Navigation

source: branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 10395

Last change on this file since 10395 was 10395, checked in by jcastill, 5 years ago
Merge branch r6232_hadgem3_cplfld@7463
File size: 126.4 KB

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

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

Download in other formats: