! 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 init_functions
  !Functions for topography and initial mass definition
  use parameters

contains

  function rho0(x,y)
    implicit double precision (a-h,o-z)
    !pi=2.d0*acos(0.D0)
    if (ipr.eq.5) then
       rr = (x - xv)**2
       rr = sqrt(rr)
       if (rr.le.av) then
          rho0 = zv - zv/av*rr
       else
          rho0 = 0.d0
       endif
       !c    Paraboloid-3D
       !c    ----------
    else if (ipr.eq.2) then
       rho0 = 1.d0 - (x - xv)**2/(av**2)
       rho0 = (rho0 - (y - yv)**2/(bv**2))*zv
       rho0 = max (0.d0, rho0)

       !c    Paraboloid-2D
    else if (ipr.eq.20) then
       rho0 = 1.d0 - (x - xv)**2/(av**2)
       rho0 = (rho0 )*zv
       rho0 = max (0.d0, rho0)

       !c    Cylinder
       !c    --------
    else if (ipr.eq.7) then
       rr = (x - xv)**2 + (y - yv)**2
       if (rr.le.av**2) then
          rho0 = zv
       else
          rho0 = 0.d0
       endif
       !c    Cylinder on conical topography
       !c    ------------------------------
    else if (ipr.eq.8) then
       !pi = 2.d0*acos(0.D0)
       tangle = theta0*pi/180.d0
       rr = (x - xv)**2 + (y - yv)**2
       drav = 0.d0 !drav = av/6.d0
       if ((rr.lt.av**2).and.(rr.gt.(av - drav)**2)) then
          rho0 = zv
       else if (rr.le.(av - drav)**2) then
          rho0 = abs(av - drav - sqrt(rr))/sin(tangle)
          rho0 = rho0 + drav/sin(tangle)
          ztilde = zv -  abs(av - drav - sqrt(rr))*tan(tangle)
          ztilde = ztilde/cos(tangle)
          rho0 = min(rho0, ztilde)
       else
          rho0 = 0.d0
       endif
       !c    Rectangle Standard
       !c    -----------
    else if (ipr.eq.1) then
       !rr = abs(x - xv/10)
       rr = abs(x - xv)
       if (rr.le.av) then
          rho0 = zv
       else
          rho0 = 0.d0
       endif

       !c    Rectangle avec Hi imposee = bv
       !c    -----------
    else if (ipr.eq.10) then
       rr = bv/rai
       if (x.le.rr) then
          rho0 = bv
       else
          rho0 = 0.d0
       endif

       !c    Rectangle avec Li imposee = av
       !c    -----------
    else if (ipr.eq.11) then
       if (x.le.av) then
          rho0 = rai*av
       else
          rho0 = 0.d0
       endif

    else
       rho0=0.

    endif

  end function rho0

  function z0()
    double precision :: z0(0:nx+1,0:ny+1)

    topography_type:select case (initz)
    case(1) ! Plan incline - 1 angle (theta0)
       do j = 0, ny + 1
          z0(nx+1,j) = delx*.5d0*tan(thetangle(grillex(nx) + .5d0*delx))
          do i = nx, 0, -1
             z0(i,j) = z0(i+1,j)-delx*tan(thetangle(grillex(nx) + .5d0*delx))
          enddo
       enddo


    case(2) ! 2 plans deux angles a xv.
       do j = 0, ny + 1
          z0(nx+1,j) = delx*.5d0*tan(thetangle2(grillex(nx) + .5d0*delx))
          do i = nx, 0, -1
             z0(i,j) = z0(i+1,j)-delx*tan(thetangle2(grillex(i)+.5d0*delx))
          enddo
       enddo

    case(3) ! Variation parabolique de la topo au debut
       do j = 0, ny + 1
          z0(nx+1,j) = delx*.5d0*tan(thetangle4(grillex(nx) + .5d0*delx))
          do i = nx, 0, -1
             z0(i,j) = z0(i+1,j)-delx*tan(thetangle4(grillex(i)+.5d0*delx))

          enddo
       enddo

    case(4) ! exponentielle theta
       !pi = 2.d0*acos(0.D0)
       do j = 0, ny + 1
          z0(nx+1,j) = delx*.5d0*tan(thetangle(grillex(nx) + .5d0*delx))
          do i = nx, 0, -1
             thetax = theta0*exp(-grillex(i)/theta1)*pi/180.d0
             z0(i,j) = z0(i+1,j)+4.d0*delx*tan(thetax) !z(i+1,j)
          enddo
       enddo

    case(5) ! Paraboloid
       do j = 0, ny+1
          do i=0,nx+1
             z0(i,j)=-(grillex(i)-xv)**2/av**2-(grilley(j)-yv)**2/bv**2+zv
          end do
       end do

    end select topography_type
  end function z0

  function u0(x,y)
    implicit double precision (a-h,o-z)
    u0=0.d0
  end function u0

  function ut0(x,y)
    implicit double precision (a-h,o-z)
    !pi=2.*acos(0.D0)
    ut0=0.d0
  end function ut0

  function thetangle(x)
    implicit double precision (a-h,o-z)
    thetangle=-theta0*pi/180.d0
  end function thetangle

  function thetangle2(x)    ! changement d'angle : a x=xv
    implicit double precision (a-h,o-z)
    if (x.lt.xv) then
       thetangle2=-theta0*pi/180.d0
    else
       thetangle2=-theta1*pi/180.d0
    endif
  end function thetangle2

  function thetangle3(x)   !variation exponentielle de l angle
    implicit double precision (a-h,o-z)
    thetangle3=-zv*exp(x)
  end function thetangle3


  function thetangle4(x)    ! changement variation d'angle : a x=xv
    ! cercle (varation lineaire)
    implicit double precision (a-h,o-z)
    Dtheta = abs(theta0 - theta1)
    dthet = Dtheta/xv
    if (x.lt.(xv)) then
       thetangle4=-((theta0-x*dthet)*pi/180.d0)
    else
       thetangle4=-theta1*pi/180.d0
    endif
  end function thetangle4

  function rayon(x,y)
    implicit double precision (a-h,o-z)
    rr = (x - xv)**2 + (y - yv)**2
    rayon = sqrt(rr)
  end function rayon

end module init_functions
