Context Navigation

sbccpl.F90 @ 14643

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

Download in other formats: