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

Context Navigation

source: branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 9119

Last change on this file since 9119 was 9119, checked in by nicolasmartin, 6 years ago
Fix longer lines so should be harmless (passed SETTE compilations)
Property svn:keywords set to `Id`
File size: 163.2 KB

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

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

Download in other formats: