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

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

sbccpl.F90 in branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

Context Navigation

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

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

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

Download in other formats: