subroutine ustsns &
!================

 ( nvar   , nscal  , ncepdp , ncesmp ,                            &
   ivar   ,                                                       &
   iscal  ,                                                       &
   icepdc , icetsm , itypsm ,                                     &
   dt     , rtpa   , rtp    , propce , propfa , propfb ,          &
   ckupdc , smacel ,                                              &
   crvexp , crvimp )
!================

use paramx
use numvar
use entsor
use optcal
use cstphy
use parall
use period
use mesh
!================

implicit none

! Arguments

integer          nvar   , nscal
integer          ncepdp , ncesmp
integer          ivar
integer          iscal

integer          icepdc(ncepdp)
integer          icetsm(ncesmp), itypsm(ncesmp,nvar)

double precision dt(ncelet), rtpa(ncelet,*)
double precision propce(ncelet,*)
double precision propfa(nfac,*), propfb(nfabor,*)
double precision ckupdc(ncepdp,6), smacel(ncesmp,nvar)
double precision crvexp(3,ncelet), crvimp(3,3,ncelet)

! Local variables

character*80     chaine
integer          iel, ipcrom, ipp
double precision beta, rho, Tref, gi

integer, allocatable, dimension(:) :: lstelt
!================

allocate(lstelt(ncel))

ipp    = ipprtp(ivar)

if (iwarni(ivar).ge.1) then
  chaine = nomvar(ipp)
  write(nfecra,1000) chaine(1:8)
endif

Temp = isca(iscal)
!================

if (ivar.eq.iv) then

  Tref  = 293.d0
  beta  = 0.000207
  gi    = 9.81
  rho   = 998.21

  do iel = 1, ncel
     crvexp(iel) =   volume(iel)*beta*rho*(Tref-Temp)*gi
  enddo

endif

deallocate(lstelt)

return
end subroutine ustsns