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

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

sbccpl.F90 in branches/UKMO/r6232_INGV1_WAVE-coupling/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

Context Navigation

source: branches/UKMO/r6232_INGV1_WAVE-coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 7481

Last change on this file since 7481 was 7481, checked in by jcastill, 7 years ago
Changes as in branches/2016/dev_INGV_UKMO_2016@7451
File size: 143.0 KB

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

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

Download in other formats: