Context Navigation

sbccpl.F90 @ 12287

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

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

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

Context Navigation

source: branches/UKMO/r8395_cpl_tauwav/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 12287

Download in other formats: