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

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

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

Context Navigation

source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 7179

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

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

Download in other formats: