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/2015/dev_r5936_INGV1_WAVE/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

Context Navigation

source: branches/2015/dev_r5936_INGV1_WAVE/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 7346

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

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

Download in other formats: