Context Navigation

sbccpl.F90 @ 9283

Last change on this file since 9283 was 9283, checked in by jcastill, 6 years ago
Remove svn keywords
File size: 122.3 KB

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

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

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

Context Navigation

source: branches/UKMO/r6232_rnf_cplmask/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 9283

Download in other formats: