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

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

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

Context Navigation

source: branches/UKMO/r5518_rm_um_cpl/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 7142

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

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

Download in other formats: