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

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

sbccpl.F90 in branches/UKMO/r6232_HZG_WAVE-coupling/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

Context Navigation

source: branches/UKMO/r6232_HZG_WAVE-coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 8553

Last change on this file since 8553 was 8553, checked in by jcastill, 7 years ago
Cap the value of tauoc as recieved via coupling or via forcing
File size: 145.7 KB

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

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

Download in other formats: