remove_extrema Subroutine

  1. ppm.f90
  2. ppm
  3. remove_extrema

private subroutine remove_extrema(qp, f_qp_left, f_qp_right, flags, dims)

Remove extrema from the state estimated. Limiting the value in case of PPM

Arguments

Type IntentOptional AttributesName
real(kind=wp), intent(in), dimension(-2:dims%imx+2, -2:dims%jmx+2, -2:dims%kmx+2, 1:dims%n_var):: qp

Store primitive variable at cell center
real(kind=wp), intent(inout), dimension(1-flags(1):dims%imx-1+2*flags(1), 1-flags(2):dims%jmx-1+2*flags(2), 1-flags(3):dims%kmx-1+2*flags(3),1:dims%n_var):: f_qp_left

primitve state variable at faces
real(kind=wp), intent(inout), dimension(1-flags(1):dims%imx-1+2*flags(1), 1-flags(2):dims%jmx-1+2*flags(2), 1-flags(3):dims%kmx-1+2*flags(3),1:dims%n_var):: f_qp_right

primitve state variable at faces
integer, intent(in), dimension(3):: flags

flags for direction switch
type(extent), intent(in) :: dims

Extent of the domain:imx,jmx,kmx

Calls

proc~~remove_extrema~~CallsGraph proc~remove_extrema remove_extrema debugcall debugcall proc~remove_extrema->debugcall

Called by

proc~~remove_extrema~~CalledByGraph proc~remove_extrema remove_extrema proc~compute_ppm_states compute_ppm_states proc~compute_ppm_states->proc~remove_extrema proc~compute_face_interpolant compute_face_interpolant proc~compute_face_interpolant->proc~compute_ppm_states proc~get_total_conservative_residue get_total_conservative_Residue proc~get_total_conservative_residue->proc~compute_face_interpolant proc~get_next_solution get_next_solution proc~get_next_solution->proc~get_total_conservative_residue proc~iterate_one_more_time_step iterate_one_more_time_step proc~iterate_one_more_time_step->proc~get_next_solution program~main main program~main->proc~iterate_one_more_time_step

Contents

Source Code

remove_extrema

Source Code

        subroutine remove_extrema(qp, f_qp_left, f_qp_right, flags, dims)
          !< Remove extrema from the state estimated. 
          !< Limiting the value in case of PPM

            implicit none
            type(extent), intent(in) :: dims
            !< Extent of the domain:imx,jmx,kmx
            integer, dimension(3), intent(in) :: flags
            !< flags for direction switch
            real(wp), dimension(-2:dims%imx+2, -2:dims%jmx+2, -2:dims%kmx+2, 1:dims%n_var), intent(in):: qp
            !< Store primitive variable at cell center
            real(wp), dimension(1-flags(1):dims%imx-1+2*flags(1), 1-flags(2):dims%jmx-1+2*flags(2),&
            1-flags(3):dims%kmx-1+2*flags(3),1:dims%n_var), intent(inout) :: f_qp_left, f_qp_right
            !< primitve state variable at faces
            integer :: i, j, k, l
            integer :: i_f, j_f, k_f ! Flags to determine face direction
            real(wp) :: dqrl, dq6

            DebugCall('remove_extrema')
            
            i_f = flags(1)
            j_f = flags(2)
            k_f = flags(3)
            
            ! Loop over cells (including ghost cells)
            do l = 1, dims%n_var            
             do k = 1 - k_f, dims%kmx - 1 + k_f
              do j = 1 - j_f, dims%jmx - 1 + j_f
               do i = 1 - i_f, dims%imx - 1 + i_f
                if ((f_qp_left(i+i_f, j+j_f, k+k_f, l) - qp(i, j, k, l)) * &
                    (qp(i, j, k, l) - f_qp_right(i, j, k, l)) <= 0) then
                    f_qp_left(i+i_f, j+j_f, k+k_f, l) = qp(i, j, k, l)
                    f_qp_right(i, j, k, l) = qp(i, j, k, l)
                else      
                    dqrl = f_qp_left(i+i_f, j+j_f, k+k_f, l) - f_qp_right(i, j, k, l)
                    dq6 = 6. * (qp(i, j, k, l) - 0.5*(f_qp_left(i+i_f, j+j_f, k+k_f, l) + &
                                                      f_qp_right(i, j, k, l)))
                    if (dqrl * dq6 > dqrl*dqrl) then
                        f_qp_right(i, j, k, l) = 3.*qp(i, j, k, l) - &
                                                 2.*f_qp_left(i+i_f, j+j_f, k+k_f, l)
                    else if (-dqrl*dqrl > dqrl * dq6) then
                        f_qp_left(i+i_f, j+j_f, k+k_f, l) = 3.*qp(i, j, k, l) - &
                                                 2.*f_qp_right(i, j, k, l)
                    end if
                end if
               end do
              end do 
             end do
            end do

        end subroutine remove_extrema