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

Context Navigation

source: branches/UKMO/r6232_HZG_WAVE-coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 8553

Last change on this file since 8553 was 8553, checked in by jcastill, 7 years ago
Cap the value of tauoc as recieved via coupling or via forcing
File size: 145.7 KB

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

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

Download in other formats: