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

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

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

Context Navigation

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

Last change on this file since 7905 was 7905, checked in by jcastill, 7 years ago

Series of small bug fixes and stetic changes:

-Fix possible bug in the calculation of Stokes-Coriolis
-Move all the wave control variables to namelist namsbc_wave
-Use one namelist variable instead of two to set Stokes drift velocity coupling
-Cap the values of the Craig and Banner constant as calculated from wave input fields to take into account small values of the friction velocity
-Add new Phillips parametrization for Stokes drift vertical velocity, using the inverse depth scale as in Breivik 2015, instead of the peak wave number as calculated from wave input fields
-Better control of the wave fields that are read from file depending on the wave parameters

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

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

Download in other formats: