! Copyright 2022, Francois BOUCHUT, Anne MANGENEY, Marc PERUZZETTO, Antoine LUCAS,  Jacques SAINTE-MARIE
! This program is distributed under the terms of the Lesser GPL v3
! This file is part of SHALTOP.


module rheology_functions

  use parameters

  implicit double precision (a-h,o-z)
  
contains
  
  !cdefinition de la friction----------------------------------------------------
  function fric(rho,unorm,courb,thet,filt)
    
    implicit double precision (a-h,o-z)
    double precision :: filt
    
    dist = wlong*diam

    basal_rheology:select case(icomp)
       
    case(1)!Simple Coulomb
       fricmain =  tan(delta1)

    case(2)!Pouliquen 1999
       hstop= beta*rho*sqrt(grav*rho)/unorm
       fricmain=tan(delta1)+(tan(delta2)-tan(delta1))*exp(-hstop/dist)
       
    case(21)
       if (unorm.gt.beta*sqrt(grav*rho)) then
          hstop = beta*rho*sqrt(grav*rho)/unorm
          fricmain = tan(delta1)+(tan(delta2)-tan(delta1))  *exp(-hstop/dist)
       else
          if (rho.le.0.d0) then
             froude=0.d0
          else
             froude=unorm/sqrt(grav*rho)
          endif
          fricmain=tan(delta3) + (tan(delta4) - tan(delta3))    *exp(-rho/dist)
          tmp = tan(delta1) + (tan(delta2) - tan(delta1))    *exp(-rho/dist)
          fricmain = fricmain + ((froude/beta)**power* (tmp - fricmain))
       endif

    case(3)!Pouliquen and Forterre 2002
       !if (unorm.gt.beta*sqrt(grav*rho)) then
       !   hstop = beta*rho/(unorm/sqrt(grav*rho)+alpha)
       !   !hstop = beta*rho*sqrt(grav*rho)/unorm
       !   fricmain = tan(delta1) + (tan(delta2) - tan(delta1))  /(hstop/wlong + 1.d0)
       !else
       !   if (rho.le.0.d0) then
       !      froude=0.d0
       !   else
       !      froude=unorm/sqrt(grav*rho)
       !   endif
       !   fricmain = tan(delta3) + (tan(delta2) - tan(delta1)) /(rho/wlong + 1.d0)
       !   mustop = tan(delta1) + (tan(delta2) - tan(delta1))  /(rho/wlong + 1.d0)
       !   fricmain = fricmain + (froude/beta)**power* (mustop - fricmain)
       !endif
       if (unorm.gt.beta*sqrt(grav*rho)) then
          hstop = beta*rho*sqrt(grav*rho)/unorm
          fricmain = tan(delta1) + (tan(delta2) - tan(delta1))  /(hstop/wlong + 1.d0)
       else
          if (rho.le.0.d0) then
             froude=0.d0
          else
             froude=unorm/sqrt(grav*rho)
          endif
          fricmain = tan(delta3) + (tan(delta2) - tan(delta1)) /(rho/wlong + 1.d0)
          tmp = tan(delta1) + (tan(delta2) - tan(delta1))  /(rho/wlong + 1.d0)
          fricmain = fricmain + (froude/beta)**power* (tmp - fricmain)
       endif

    case(31)
       if (unorm.gt.beta*sqrt(grav*rho)) then
          hstop = beta*rho*sqrt(grav*rho)/unorm
          fricmain = tan(delta1) + (tan(delta2) - tan(delta1))  /(hstop/wlong + 1.d0)
       else
          if (rho.le.0.d0) then
             froude=0.d0
          else
             froude=unorm/sqrt(grav*rho)
          endif
          fricmain = tan(delta3) + (tan(delta4) - tan(delta3)) /(rho/wlong + 1.d0)
          hstart = tan(delta1) + (tan(delta2) - tan(delta1))  /(rho/wlong + 1.d0)
          fricmain = fricmain + (froude/beta)**power* (hstart - fricmain)
       endif

    case(32)
       !Edwards et al 2018, JFM, Pouliquen modified. !! Froude number is defined with rho*cos(theta), and not just rho as above.
       if (rho.le.0.d0) then
          froude=0.d0
       else
          froude=unorm/sqrt(grav*rho*thet)
       endif
       beta2=lambda*beta-alpha
       if (froude.ge.beta2) then
          hstop = beta*rho/(froude+alpha)
          fricmain = tan(delta1) + (tan(delta2) - tan(delta1))  /(hstop/wlong + 1.d0)
       else
          fricmain = tan(delta3) + (tan(delta2) - tan(delta1)) /(rho/wlong + 1.d0)
          if (froude.gt.0.d0) then
             hstop = beta*rho/(froude+alpha)
             tmp=tan(delta1) + (tan(delta2) - tan(delta1))  /(hstop/wlong + 1.d0) - fricmain
             fricmain=(froude/beta2)**power*tmp+fricmain
          endif
       endif
       
    case(4)!Simple Coulomb with spatial filtering
       filter_value:select case(int(filt))
       case(1)
          fricmain=tan(delta1)
       case(2)
          fricmain=tan(delta2)
       case(3)
          fricmain=tan(delta3)
       case(4)
          fricmain=tan(delta4)
       end select filter_value
       
    case(41)!Simple Coulomb with spatial filtering, read value directly in filt
      fricmain=tan(filt*pi/180.d0)

    case(5)!Coulomb + Bingham
       !delta2 : yield stress
       !delta3 : viscosity
       fricmain = tan(delta1)*max(0.d0,1.d0+courb/thet)+(1.5*tau+3*eta*unorm/rho)/(density*grav*rho*thet)

    case(6)!Bingham
       !delta2 : yield stress
       !delta3 : viscosity
       fricmain = (1.5*tau+3*eta*unorm/rho)/(density*grav*rho*thet)

    case(7)!mu(I)
       !delta1 : First angle
       !delta2 : Second angle
       !diam : Particle diameter
       !I0 : I0
       
       if (rho.eq.0) then
          fricmain=tan(delta2)
       else
          !See Cassar et al 2005 for the expression of the inertial number (tmp)
          !I is given by eq. 8 and is constant over thickness. Given velocity profile
          !given in  (11), taking pressure and shear velocity at the bottom yields
          !eq. 14, particularly the 5/2 coefficient
          tmp=5*unorm*diam/(2*rho*sqrt(grav*rho*vol_frac*thet))
          !write(*,*),'Gravity',unorm*diam/(rho*sqrt(grav*rho*thet))
          !Itmp=unorm*diam/(rho*sqrt(grav*rho*thet))
          if (tmp.gt.0) then
             fricmain=tan(delta1)+(tan(delta2)-tan(delta1))/(1+I0/tmp)
          else
             fricmain=tan(delta1)
          endif
       endif

    case(8)!Voellmy
       !ksi : Voellmy coefficient

       fricmain=tan(delta1)*max(0.d0,1.d0+courb/thet)+(unorm**2)/(rho*thet*ksi)
       
    case(9)!frictional velocity weakening
      !see Lucas et al., 2014 for the details and see Rice 2006 for the initial expression
      !delta0=delta1 (refers to mu_0)
      !deltaw=delta2 (refers to mu_w)
      !uw=Uw (refers to Uw)
      if (unorm.gt.uw) then
          fricmain=(tan(delta1)-tan(delta2))/unorm/uw + tan(delta2)
      else
          fricmain=tan(delta1)
      endif
      

    end select basal_rheology
    
    if ((icomp.ne.6).and.(icomp.ne.5).and.(icomp.ne.8)) then
       fric=fricmain*max(0.d0,1.d0+courb/thet) ! facteur de courbure
    else
       fric=fricmain
    end if

  end function fric

end module rheology_functions
