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

Context Navigation

source: branches/UKMO/dev_r5518_ww3_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 5847

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

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

Download in other formats: