Context Navigation

sbccpl.F90 @ 9679

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

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

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

Context Navigation

source: branches/UKMO/dev_merge_2017_GC_couple_pkg/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 9679

Download in other formats: