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

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

sbccpl.F90 in branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

Context Navigation

source: branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 5530

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

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

Download in other formats: