Context Navigation

← Previous Revision
Next Revision →
Normal
Revision Log

sbccpl.F90

Last change on this file was 9383, checked in by andmirek, 6 years ago
#2050 fixes and changes
File size: 151.2 KB

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

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

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

Context Navigation

source: branches/UKMO/test_moci_test_suite_namelist_read/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

Download in other formats: