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

Context Navigation

source: branches/UKMO/dev_r5518_GSI7_GSI8_landice_bitcomp_medusa/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 6682

Last change on this file since 6682 was 6682, checked in by frrh, 8 years ago
Remove redundant USE statement now that MEDUSA code has to USE the main ocean routines (content from oce.F90 specifically)
File size: 141.3 KB

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

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

Download in other formats: