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

Context Navigation

source: branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 5866

Last change on this file since 5866 was 5866, checked in by gm, 8 years ago
#1613: vvl by default: add ln_linssh and remove key_vvl
Property svn:keywords set to `Id`
File size: 120.7 KB

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

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

Download in other formats: