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

Context Navigation

source: branches/UKMO/dev_r5518_ukv_mslp/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 5826

Last change on this file since 5826 was 5826, checked in by jcastill, 9 years ago
Allocate mslp variables independently in case the albedo is not coupled
File size: 122.5 KB

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

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

Download in other formats: