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

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

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

Context Navigation

source: branches/UKMO/dev_r5518_coupling_GSI7_GSI8_landice/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 5680

Last change on this file since 5680 was 5680, checked in by dancopsey, 9 years ago
Fixed typo in initialtion of jpr_grnm variable.
File size: 132.4 KB

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

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

Download in other formats: