 SUBROUTINE friction(calc)
!=========================== DOCUMENTATION ============================= 
!DOCDEBh*    NUM/friction  *
!
!    NOM
!   friction(calc,lev)
!    DESCRIPTION  
!*
! Calcul de la penalisation de la vitesse par la friction 
! Calculation of speed penalty due to friction 
!* 
! 
!    ENTREES / INPUT
!   calc : objet calcul / Calcul object
!    SORTIES / OUTPUT
!   calc : objet calcul modifie / Modified calcul object
!
!    SOURCE
! Ce logiciel est regi par la licence [CeCILL-B]
! This software is governed by the [CeCILL-B] license
!=========================== DEBUT DES DECLARATIONS ==================== 
!.1-----  Implicit, Use
  use num_typ
  IMPLICIT NONE
!.2-----  Declaration
  type(calcul),intent(inout) :: calc !! Objet calcul / Calcul object

  integer                    :: ic
  real(kind=kind(0.d0))      :: alpha, beta, Uold, cf, h
!=========================== DEBUT DU CODE EXECUTABLE ==================
! calcul des termes sources par splitting
      select case (ifrict)
        case (0)
          return
        case (1,2)
        case default
           call print_err('FRICTION','Friction model not defined ')
      end select

! Terme source de frottements par la loi de Mannning pour Saint-Venant
      DO ic=1,calc%msh%nb_cell
          IF (calc%msh%list_cell(ic)%idom.ne.calc%msh%numdom) CYCLE   
              
              Uold  = dsqrt(calc%msh%list_cell(ic)%w%vprim%v(2)**2 + &
                      calc%msh%list_cell(ic)%w%vprim%v(3)**2)
              h     = calc%msh%list_cell(ic)%w%vprim%v(1)
              cf    = calc%msh%list_cell(ic)%w%vprim%v(6)
              alpha = 1.d0    
              beta  = 0.d0   
              if (h.lt.hzero_phy) cycle
              select case (ifrict)
                case (1)
                   beta=cf/(h**(4.d0/3.d0))*gpes_phy*calc%dt*Uold
                case (2)
                   beta=cf/h*gpes_phy*calc%dt*Uold
               end select
               alpha=2.d0/(1.d0+sqrt(1.d0+4.d0*beta))
              calc%msh%list_cell(ic)%w%vprim%v(2) = alpha*calc%msh%list_cell(ic)%w%vprim%v(2)
              calc%msh%list_cell(ic)%w%vprim%v(3) = alpha*calc%msh%list_cell(ic)%w%vprim%v(3)                     
              
              CALL prim2bal(calc%msh%list_cell(ic)%w)
                                  
      END DO
!===========================   FIN DE LA ROUTINE    ====================
END SUBROUTINE friction
!DOCFIN