Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

sbccpl.F90

Last change on this file was 9313, checked in by dancopsey, 6 years ago
Changed number of rivers to be nn_cpl_river which is fed in from the nam_cpl_rnf_1d namelist. Made new scheme turn on and off by setting sn_rcv_rnf%cldes = 'coupled1d'
File size: 121.4 KB

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

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

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

Context Navigation

source: branches/UKMO/dev_r5518_new_runoff_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

Download in other formats: