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

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

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

Context Navigation

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

Last change on this file since 5924 was 5924, checked in by jcastill, 8 years ago
Add sea surface height to the list of fields that can be passed to waves (done independently of OPA->SAS coupling, which should not be affected)
File size: 134.3 KB

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

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

Download in other formats: