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/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

Context Navigation

source: branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 7380

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

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

Download in other formats: