init.f90

Go to the documentation of this file.

!*********************************************************************
!
!*********************************************************************

MODULE init

  IMPLICIT none

  REAL*8, ALLOCATABLE :: q_init(:,:)
  
  REAL*8 :: riemann_interface  


  REAL*8 :: hB_L
  REAL*8 :: u_L
  
  REAL*8 :: hB_R
  REAL*8 :: u_R


CONTAINS


  !*********************************************************************
  !
  !*********************************************************************

  SUBROUTINE riemann_problem

    USE constitutive, ONLY : qp_to_qc

    USE geometry, ONLY : x0 , xn , x_comp , comp_cells , b_cent

    USE parameters, ONLY : n_vars , verbose_level, batimetry_function_flag

    USE solver, ONLY : q

    IMPLICIT none

    REAL*8 :: hb
    REAL*8 :: u

    !REAL*8 :: qp(n_vars) , qj(n_vars)
    REAL*8 :: qp(n_vars,comp_cells) , qj(n_vars)

    INTEGER :: i
    INTEGER :: i1

    REAL*8 :: eps

    riemann_int_search:DO i = 1,comp_cells

       IF ( x_comp(i) .LT. riemann_interface ) THEN

          i1 = i

       ELSE

          EXIT riemann_int_search

       END IF

    END DO riemann_int_search

    eps = 1.d-10

    DO i=1,i1

       qp(1,i) = hb_l

       qp(2,i) = u_l

    ENDDO

    DO i = 1,i1

       ! evaluate the vector of conservative variables
       !CALL qp_to_qc( qp , B_cent(i) , qj )
       CALL qp_to_qc( qp(:,i) , b_cent(i) , qj )

       q(1:n_vars,i) = qj

       IF ( verbose_level .GE. 1 ) WRITE(*,*) i,b_cent(i),qp

    END DO

    ! Right initial state

    DO i=i1+1,comp_cells

      qp(1,i) = hb_r

      qp(2,i) = u_r

    ENDDO

    DO i = i1+1,comp_cells

       ! evaluate the vector of conservative variables
       !CALL qp_to_qc( qp , B_cent(i) , qj )
       CALL qp_to_qc( qp(:,i) , b_cent(i) , qj )

       q(1:n_vars,i) = qj

       IF ( verbose_level .GE. 1 ) WRITE(*,*) i,b_cent(i),qp
    
    END DO

    IF ( verbose_level .GE. 1 ) READ(*,*)

    RETURN

  END SUBROUTINE riemann_problem

  !*********************************************************************
  !
  !*********************************************************************

  SUBROUTINE initial_conditions

    USE constitutive, ONLY : qp_to_qc

    USE geometry, ONLY : x0 , xn , x_comp , comp_cells , b_cent

    USE parameters, ONLY : n_vars , verbose_level, batimetry_function_flag

    USE solver, ONLY : q

    IMPLICIT none

    REAL*8 :: qp(n_vars,comp_cells) , qj(n_vars)

    INTEGER :: j

    REAL*8 :: eps

    DO j=1,comp_cells

         qp(1,j) = water_function(x_comp(j),b_cent(j))

         qp(2,j) = velocity_function(x_comp(j),b_cent(j))

    ENDDO

    DO j = 1,comp_cells

         ! evaluate the vector of conservative variables
         CALL qp_to_qc( qp(:,j) , b_cent(j) , qj )

         q(1:n_vars,j) = qj

         IF ( verbose_level .GE. 1 ) WRITE(*,*) j,b_cent(j),qp(:,j)

    ENDDO

    IF ( verbose_level .GE. 1 ) READ(*,*)

    RETURN

  END SUBROUTINE initial_conditions


!---------------------------------------------------------------------------
!
!---------------------------------------------------------------------------
  REAL*8 FUNCTION water_function(x,Bj)
    USE geometry, ONLY : batimetry_function

    IMPLICIT NONE
   
    REAL*8, INTENT(IN) :: x
    REAL*8, INTENT(IN) :: bj

    ! example from Kurganov and Petrova 2007   
    !water_function=batimetry_function(x)
    water_function=bj

    IF(x.LE.0.0)THEN
       water_function = water_function + 0.4d0
    ENDIF

  END FUNCTION water_function

!---------------------------------------------------------------------------
!
!---------------------------------------------------------------------------
  REAL*8 FUNCTION velocity_function(x,Bj)

    IMPLICIT NONE
    
    REAL*8, INTENT(IN) :: x
    REAL*8, INTENT(IN) :: bj
    
    ! example from Kurganov and Petrova 2007    
    velocity_function=0.d0

  END FUNCTION velocity_function


END MODULE init