RFLU_ModResidual.F90

Go to the documentation of this file.

! *********************************************************************
! * Rocstar Simulation Suite                                          *
! * Copyright@2015, Illinois Rocstar LLC. All rights reserved.        *
! *                                                                   *
! * Illinois Rocstar LLC                                              *
! * Champaign, IL                                                     *
! * www.illinoisrocstar.com                                           *
! * sales@illinoisrocstar.com                                         *
! *                                                                   *
! * License: See LICENSE file in top level of distribution package or *
! * http://opensource.org/licenses/NCSA                               *
! *********************************************************************
! *********************************************************************
! * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,   *
! * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES   *
! * OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND          *
! * NONINFRINGEMENT.  IN NO EVENT SHALL THE CONTRIBUTORS OR           *
! * COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER       *
! * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,   *
! * Arising FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE    *
! * USE OR OTHER DEALINGS WITH THE SOFTWARE.                          *
! *********************************************************************
! ******************************************************************************
!
! Purpose: Collection of routines related to residual computation.
!
! Description: None.
!
! Notes: None. 
!
! ******************************************************************************
!
! $Id: RFLU_ModResidual.F90,v 1.18 2008/12/06 08:44:24 mtcampbe Exp $
!
! Copyright: (c) 2005-2006 by the University of Illinois
!
! ******************************************************************************

MODULE rflu_modresidual

  USE moddatatypes
  USE modglobal, ONLY: t_global
  USE modparameters
  USE moderror
  USE modbndpatch, ONLY: t_patch
  USE moddatastruct, ONLY: t_region
  USE modgrid, ONLY: t_grid
  USE modbndpatch, ONLY: t_patch
  USE modmixture, ONLY: t_mixt,t_mixt_input
  USE modmpi

  USE modinterfaces, ONLY: rflu_decideneedbgradface

  IMPLICIT NONE

  PRIVATE
  PUBLIC :: rflu_res_computeresidual, &
            rflu_getresidualsupport1, & 
            rflu_getresidualsupport2, &  
            rflu_res_setcvold, & 
            rflu_res_setdiss, & 
            rflu_res_setrhs
  
! ******************************************************************************
! Declarations and definitions
! ******************************************************************************  
      
  CHARACTER(CHRLEN) :: & 
    RCSIdentString = '$RCSfile: RFLU_ModResidual.F90,v $ $Revision: 1.18 $' 
              
! ******************************************************************************
! Routines
! ******************************************************************************

  CONTAINS
  
  
  
  




! ******************************************************************************
!
! Purpose: Compute residual.
!
! Description: None.
!
! Input:
!   pRegion     Pointer to region
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************

SUBROUTINE rflu_res_computeresidual(pRegion)

  USE rflu_modconvertcv
  USE rflu_moddifferentiationbfaces  
  USE rflu_moddifferentiationcells
  USE rflu_moddifferentiationfaces  
  USE rflu_modlimiters
  USE rflu_modviscousflux
  USE rflu_modweno 

  USE modinterfaces, ONLY: rflu_computefluxinv

  IMPLICIT NONE

! ******************************************************************************
! Declarations and definitions
! ******************************************************************************  

! ==============================================================================
! Arguments
! ==============================================================================

  TYPE(t_region), POINTER :: pregion

! ==============================================================================
! Locals
! ==============================================================================

  INTEGER :: ipatch
  INTEGER :: varinfogradcells(cv_mixt_dens:cv_mixt_pres), & 
             varinfogradfaces(cv_mixt_xvel:cv_mixt_temp)
  TYPE(t_global), POINTER :: global
  TYPE(t_mixt), POINTER :: pmixt
  TYPE(t_mixt_input), POINTER :: pmixtinput
  TYPE(t_patch), POINTER :: ppatch

! ******************************************************************************
! Start
! ******************************************************************************

  global => pregion%global

  CALL registerfunction(global,'RFLU_RES_ComputeResidual',&
  'RFLU_ModResidual.F90')

! ******************************************************************************
! Set pointers
! ******************************************************************************

  pmixt      => pregion%mixt
  pmixtinput => pregion%mixtInput

! ******************************************************************************
! Set dissipation array
! ******************************************************************************

  CALL rflu_res_setdiss(pregion)

! ******************************************************************************
! Compute cell gradients. NOTE need to be done here so that back-up viscous 
! flux computation can make use of them.
! ******************************************************************************

  IF ( pmixtinput%spaceOrder > discr_order_1 ) THEN
    CALL rflu_convertcvcons2prim(pregion,cv_mixt_state_duvwp)                            

    varinfogradcells(cv_mixt_dens) = v_mixt_dens
    varinfogradcells(cv_mixt_xvel) = v_mixt_xvel
    varinfogradcells(cv_mixt_yvel) = v_mixt_yvel
    varinfogradcells(cv_mixt_zvel) = v_mixt_zvel
    varinfogradcells(cv_mixt_pres) = v_mixt_pres
                               
    CALL rflu_computegradcellswrapper(pregion,cv_mixt_dens,cv_mixt_pres, &
                                      grc_mixt_dens,grc_mixt_pres, &
                                      varinfogradcells,pmixt%cv,pmixt%gradCell)
                               
    SELECT CASE ( pregion%mixtInput%reconst ) 
      CASE ( reconst_none )
      CASE ( reconst_weno_simple )       
        CALL rflu_wenogradcellswrapper(pregion,grc_mixt_dens,grc_mixt_pres, &
                                       pregion%mixt%gradCell)
        CALL rflu_limitgradcellssimple(pregion,cv_mixt_dens,cv_mixt_pres, &
                                      grc_mixt_dens,grc_mixt_pres, & 
                                      pregion%mixt%cv,pregion%mixt%cvInfo, &
                                      pregion%mixt%gradCell)
      CASE ( reconst_weno_xyz ) 
        CALL rflu_wenogradcellsxyzwrapper(pregion,grc_mixt_dens,grc_mixt_pres, &
                                          pregion%mixt%gradCell)
        CALL rflu_limitgradcellssimple(pregion,cv_mixt_dens,cv_mixt_pres, &
                                      grc_mixt_dens,grc_mixt_pres, & 
                                      pregion%mixt%cv,pregion%mixt%cvInfo, &
                                      pregion%mixt%gradCell)
      CASE ( reconst_lim_barthjesp )  
        CALL rflu_createlimiter(pregion,grc_mixt_dens,grc_mixt_pres, &
                                pregion%mixt%lim)
        CALL rflu_computelimiterbarthjesp(pregion,cv_mixt_dens,cv_mixt_pres, &
                                          grc_mixt_dens,grc_mixt_pres, &
                                          pregion%mixt%cv, &
                                          pregion%mixt%gradCell, &
                                          pregion%mixt%lim)
        CALL rflu_limitgradcells(pregion,grc_mixt_dens,grc_mixt_pres, &
                                 pregion%mixt%gradCell,pregion%mixt%lim)
        CALL rflu_destroylimiter(pregion,pregion%mixt%lim)
      CASE ( reconst_lim_venkat )  
        CALL rflu_createlimiter(pregion,grc_mixt_dens,grc_mixt_pres, &
                                pregion%mixt%lim)
        CALL rflu_computelimitervenkat(pregion,cv_mixt_dens,cv_mixt_pres, &
                                       grc_mixt_dens,grc_mixt_pres, &
                                       pregion%mixt%cv,pregion%mixt%gradCell, &
                                       pregion%mixt%lim)
        CALL rflu_limitgradcells(pregion,grc_mixt_dens,grc_mixt_pres, &
                                 pregion%mixt%gradCell,pregion%mixt%lim)
        CALL rflu_destroylimiter(pregion,pregion%mixt%lim)
      CASE default 
        CALL errorstop(global,err_reached_default,__line__)
    END SELECT ! pRegion%mixtInput%reconst
    
    CALL rflu_convertcvprim2cons(pregion,cv_mixt_state_cons)
  END IF ! pMixtInput%spaceOrder

! ******************************************************************************
! Viscous fluxes
! ******************************************************************************

  IF ( pmixtinput%flowModel == flow_navst ) THEN 
    CALL rflu_convertcvcons2prim(pregion,cv_mixt_state_duvwt)                                

    varinfogradfaces(cv_mixt_xvel) = v_mixt_xvel
    varinfogradfaces(cv_mixt_yvel) = v_mixt_yvel
    varinfogradfaces(cv_mixt_zvel) = v_mixt_zvel
    varinfogradfaces(cv_mixt_temp) = v_mixt_temp      
    
    CALL rflu_computegradfaceswrapper(pregion,cv_mixt_xvel,cv_mixt_temp, & 
                                      grf_mixt_xvel,grf_mixt_temp, &
                                      pregion%mixt%cv,pregion%mixt%gradFace)                              

    IF ( pregion%grid%nFacesConstr > 0 ) THEN                                  
      CALL rflu_computegradfacesconstr(pregion,cv_mixt_xvel,cv_mixt_temp, & 
                                       grf_mixt_xvel,grf_mixt_temp, &
                                       varinfogradfaces,pregion%mixt%cv, &
                                       pregion%mixt%gradFace) 
    END IF ! pRegion%grid%nFacesConstr  

    DO ipatch = 1,pregion%grid%nPatches
      ppatch => pregion%patches(ipatch)
      
      IF ( rflu_decideneedbgradface(pregion,ppatch) .EQV. .true. ) THEN
        CALL rflu_computegradbfaceswrapper(pregion,ppatch,cv_mixt_xvel, &
                                           cv_mixt_temp,grbf_mixt_xvel, &
                                           grbf_mixt_temp,pregion%mixt%cv, &
                                           ppatch%mixt%gradFace)
        IF ( ppatch%cReconst /= constr_none ) THEN                                          
          CALL rflu_computebfgradconstrwrapper(pregion,ppatch,cv_mixt_xvel, &
                                               cv_mixt_temp,grbf_mixt_xvel, & 
                                               grbf_mixt_temp,varinfogradfaces, &
                                               pregion%mixt%cv, &
                                               ppatch%mixt%gradFace)
        END IF ! pPatch%cReconst                                             
      END IF ! RFLU_DecideNeedBGradFace
    END DO ! iPatch                                       

    IF ( pmixtinput%turbModel == turb_model_none ) THEN ! Only laminar 
      CALL rflu_enforceheatflux(pregion,pregion%mixt%tv,tv_mixt_tcol)                                       
      CALL rflu_viscousfluxes(pregion,pregion%mixt%tv,tv_mixt_muel,tv_mixt_tcol)
      CALL rflu_viscousfluxespatches(pregion,pregion%mixt%tv,tv_mixt_muel, &
                                     tv_mixt_tcol)
    ELSE 
      CALL errorstop(global,err_reached_default,__line__)
    END IF ! pMixtInput%turbModel                                                          

    CALL rflu_convertcvprim2cons(pregion,cv_mixt_state_cons)
  END IF ! pMixtInput%flowModel

! ******************************************************************************
! Set right-hand side array
! ******************************************************************************

  CALL rflu_res_setrhs(pregion)

! ******************************************************************************
! Inviscid fluxes
! ******************************************************************************

  CALL rflu_computefluxinv(pregion,flux_part_both)

! ******************************************************************************
! End
! ****************************************************************************** 

  CALL deregisterfunction(global)

END SUBROUTINE rflu_res_computeresidual

  









! ******************************************************************************
!
! Purpose: Determine support of residual for first-order scheme
!
! Description: None.
!
! Input:
!   pRegion             Pointer to region data
!   icg                 Cell index 
!   rsSizeMax           Maximum allowed size of residual support
!
! Output: 
!   rs                  Residual support
!   rsSize              Actual size of residual support
!
! Notes: 
!   1. At present, only take into account cell-to-cell stencil.
!
! ******************************************************************************

SUBROUTINE rflu_getresidualsupport1(pRegion,icg,rs,rsSizeMax,rsSize)
  
  USE moddatatypes
  USE modparameters
  USE moddatastruct, ONLY: t_region 
  USE modglobal, ONLY: t_global  
  USE modgrid, ONLY: t_grid
  USE modbndpatch, ONLY: t_patch
  USE moderror
  
  IMPLICIT NONE

! ******************************************************************************
! Declarations and definitions
! ******************************************************************************  

! ==============================================================================
! Arguments
! ==============================================================================

  INTEGER, INTENT(IN) :: icg
  INTEGER, INTENT(INOUT) :: rssizemax
  INTEGER, INTENT(OUT) :: rssize
  INTEGER, DIMENSION(:) :: rs
  TYPE(t_region), POINTER :: pregion
  
! ==============================================================================
! Locals
! ==============================================================================
    
  INTEGER :: c1,c2,errorflag,icl,ict,ifg,ifl,ipatch,nfaces   
  INTEGER, DIMENSION(:,:), POINTER :: pc2f
  TYPE(t_global), POINTER :: global
  TYPE(t_grid), POINTER :: pgrid
  TYPE(t_patch), POINTER :: ppatch  

! ******************************************************************************
! Start
! ******************************************************************************

  global => pregion%global

  CALL registerfunction(global,'RFLU_GetResidualSupport1',&
  'RFLU_ModResidual.F90')

  pgrid => pregion%grid

! ******************************************************************************
! Set up cell-to-face pointer
! ******************************************************************************

  ict = pgrid%cellGlob2Loc(1,icg)
  icl = pgrid%cellGlob2Loc(2,icg)

  SELECT CASE ( ict ) 
    CASE ( cell_type_tet )
      pc2f => pgrid%tet2f(:,:,icl)
    CASE ( cell_type_hex ) 
      pc2f => pgrid%hex2f(:,:,icl)
    CASE ( cell_type_pri ) 
      pc2f => pgrid%pri2f(:,:,icl)      
    CASE ( cell_type_pyr ) 
      pc2f => pgrid%pyr2f(:,:,icl)          
    CASE default 
      CALL errorstop(global,err_reached_default,__line__)      
  END SELECT ! ict
  
  nfaces = SIZE(pc2f,2)

! ******************************************************************************
! Initialize
! ******************************************************************************

  rssize = 1
  
  rs(rssize) = icg

! ******************************************************************************
! Add face neighbors
! ******************************************************************************

  DO ifl = 1,nfaces
    ipatch = pc2f(1,ifl)
    ifg    = pc2f(2,ifl)

    IF ( ipatch == 0 ) THEN ! Interior face
      c1 = pgrid%f2c(1,ifg)
      c2 = pgrid%f2c(2,ifg)

      IF ( c1 == icg ) THEN
        IF ( rssize < rssizemax ) THEN       
          rssize = rssize + 1
        ELSE 
! TEMPORARY
          WRITE(*,*) 'ERROR - About to exceed size of array rs!'
          stop
! END TEMPORARY          
        END IF ! rsSize
      
        rs(rssize) = c2
      ELSE IF ( c2 == icg ) THEN
        IF ( rssize < rssizemax ) THEN       
          rssize = rssize + 1
        ELSE 
! TEMPORARY
          WRITE(*,*) 'ERROR - About to exceed size of array rs!'
          stop
! END TEMPORARY          
        END IF ! rsSize

        rs(rssize) = c1  
      ELSE ! defensive programming
        CALL errorstop(global,err_reached_default,__line__)
      END IF ! c1                          
    END IF ! iPatch
  END DO ! ifl

! ******************************************************************************
! End
! ****************************************************************************** 

  CALL deregisterfunction(global)

END SUBROUTINE rflu_getresidualsupport1









! ******************************************************************************
!
! Purpose: Determine support of residual for second-order scheme
!
! Description: None.
!
! Input:
!   pRegion             Pointer to region data
!   icg                 Cell index 
!   rsSizeMax           Maximum allowed size of residual support
!
! Output: 
!   rs                  Residual support
!   rsSize              Actual size of residual support
!
! Notes: 
!   1. At present, only take into account cell-to-cell stencil, i.e., only
!      inviscid flux contribution. This is because cell-to-cell stencil is 
!      typically larger than face-to-cell stenci, at least for WENO scheme.
!
! ******************************************************************************

SUBROUTINE rflu_getresidualsupport2(pRegion,icg,rs,rsSizeMax,rsSize)
  
  USE moddatatypes
  USE modparameters
  USE moddatastruct, ONLY: t_region 
  USE modglobal, ONLY: t_global  
  USE modgrid, ONLY: t_grid
  USE moderror
  
  USE modsortsearch

  IMPLICIT NONE

! ******************************************************************************
! Declarations and definitions
! ******************************************************************************  

! ==============================================================================
! Arguments
! ==============================================================================

  INTEGER, INTENT(IN) :: icg
  INTEGER, INTENT(INOUT) :: rssizemax
  INTEGER, INTENT(OUT) :: rssize
  INTEGER, DIMENSION(:) :: rs
  TYPE(t_region), POINTER :: pregion
  
! ==============================================================================
! Locals
! ==============================================================================
    
  INTEGER :: errorflag,icg2,icg3,ilevel,iloc,irs,isl,nlevels,rssavesize, & 
             rssavesizemax,rstempsize,rstempsizemax  
  INTEGER, DIMENSION(:), ALLOCATABLE :: rssave,rstemp  
  TYPE(t_global), POINTER :: global
  TYPE(t_grid), POINTER :: pgrid  

! ******************************************************************************
! Start
! ******************************************************************************

  global => pregion%global

  CALL registerfunction(global,'RFLU_GetResidualSupport2',&
  'RFLU_ModResidual.F90')

  pgrid => pregion%grid

! ******************************************************************************
! Allocate temporary memory
! ******************************************************************************

  rssavesizemax = 1000
  rstempsizemax = 1000 ! Must be equal to or larger than <rsSaveSizeMax>

  ALLOCATE(rssave(rssavesizemax),stat=errorflag)
  global%error = errorflag
  IF ( global%error /= err_none ) THEN 
    CALL errorstop(global,err_allocate,__line__,'rsSave')
  END IF ! global%errorFlag

  ALLOCATE(rstemp(rstempsizemax),stat=errorflag)
  global%error = errorflag
  IF ( global%error /= err_none ) THEN 
    CALL errorstop(global,err_allocate,__line__,'rsTemp')
  END IF ! global%errorFlag

! ******************************************************************************
! Initialize
! ******************************************************************************

! TEMPORARY
  nlevels = 3
! END TEMPORARY

  rssize = 1
  
  rs(rssize) = icg

! ******************************************************************************
! Cell-to-cell stencil for cell icg itself
! ******************************************************************************

  DO isl = 1,pgrid%c2cs(icg)%nCellMembs
    IF ( rssize < rssizemax ) THEN 
      rssize = rssize + 1
       
      rs(rssize) = pgrid%c2cs(icg)%cellMembs(isl)  
    ELSE 
! TEMPORARY
      WRITE(*,*) 'ERROR - About to exceed size of array rs!'
      stop
! END TEMPORARY    
    END IF ! rsSize
  END DO ! isl

! ==============================================================================
! Save initial stencil and sort for searching 
! ==============================================================================

  rssavesize = rssize  
  
  DO irs = 1,rssavesize
    rssave(irs) = rs(irs)
  END DO ! irs
  
  CALL quicksortinteger(rs(1:rssize),rssize)

! ******************************************************************************
! Loop over levels
! ******************************************************************************

  DO ilevel = 2,nlevels
    rstempsize = 0  
  
! ==============================================================================
!   Loop over members in saved stencil 
! ==============================================================================  
  
    DO irs = 1,rssavesize
      icg2 = rssave(irs)
      
! ------------------------------------------------------------------------------
!     Loop over stencil members
! ------------------------------------------------------------------------------
      
      DO isl = 1,pgrid%c2cs(icg2)%nCellMembs
        icg3 = pgrid%c2cs(icg2)%cellMembs(isl) 
        
! ----- Add to temporary stencil if not already in original or saved stencil ---     
        
        CALL binarysearchinteger(rs(1:rssize),rssize,icg3,iloc)
                
        IF ( iloc == element_not_found ) THEN
          IF ( rstempsize > 1 ) THEN 
            CALL binarysearchinteger(rstemp(1:rstempsize),rstempsize,icg3,iloc)
          ELSE 
            iloc = element_not_found
          END IF ! rsTempSize
                
          IF ( iloc == element_not_found ) THEN 
            IF ( rstempsize < rstempsizemax ) THEN
              rstempsize = rstempsize + 1

              rstemp(rstempsize) = icg3

              IF ( rstempsize > 1 ) THEN 
                CALL quicksortinteger(rstemp(1:rstempsize),rstempsize)
              END IF ! rsTempSize
            ELSE 
! TEMPORARY
              WRITE(*,*) 'ERROR - About to exceed size of array rsTemp!'
              stop
! END TEMPORARY            
            END IF ! rsTempSize
          END IF ! iLoc
        END IF ! iLoc 
      END DO ! isl      
    END DO ! irs

! ==============================================================================
!   Loop over members in saved stencil, add to original stencil and sort 
! ==============================================================================  
  
    DO irs = 1,rstempsize
      rssave(irs) = rstemp(irs)
    
      IF ( rssize < rssizemax ) THEN 
        rssize = rssize + 1

        rs(rssize) = rstemp(irs)
      ELSE 
! TEMPORARY
        WRITE(*,*) 'ERROR - About to exceed size of array rs!'
        stop
! END TEMPORARY       
      END IF ! rsSize
    END DO ! irs
   
    rssavesize = rstempsize
  
    CALL quicksortinteger(rs(1:rssize),rssize)
  END DO ! iLevel

! DEBUG
!  WRITE(*,*) rs(1:rsSize)
! END DEBUG

! ******************************************************************************
! Deallocate temporary memory
! ******************************************************************************

  DEALLOCATE(rssave,stat=errorflag)
  global%error = errorflag
  IF ( global%error /= err_none ) THEN 
    CALL errorstop(global,err_deallocate,__line__,'rsSave')
  END IF ! global%errorFlag

  DEALLOCATE(rstemp,stat=errorflag)
  global%error = errorflag
  IF ( global%error /= err_none ) THEN 
    CALL errorstop(global,err_deallocate,__line__,'rsTemp')
  END IF ! global%errorFlag

! ******************************************************************************
! End
! ****************************************************************************** 

  CALL deregisterfunction(global)

END SUBROUTINE rflu_getresidualsupport2













! ******************************************************************************
!
! Purpose: Set old values of conserved variables.
!
! Description: None.
!
! Input: 
!   pRegion     Pointer to region
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************

SUBROUTINE rflu_res_setcvold(pRegion)

  IMPLICIT NONE

! ******************************************************************************
! Declarations
! ******************************************************************************

! ==============================================================================
! Arguments
! ==============================================================================

  TYPE (t_region), POINTER :: pregion

! ==============================================================================
! Locals
! ==============================================================================

  INTEGER :: icg
  TYPE(t_global), POINTER :: global
  TYPE(t_grid), POINTER :: pgrid
  TYPE(t_mixt), POINTER :: pmixt

! ******************************************************************************
! Start
! ******************************************************************************

  global => pregion%global

  CALL registerfunction(global,'RFLU_RES_SetCvOld',&
  'RFLU_ModResidual.F90')

! ******************************************************************************
! Set pointers
! ******************************************************************************

  pgrid => pregion%grid
  pmixt => pregion%mixt

! ******************************************************************************
! Set old values
! ******************************************************************************

  DO icg = 1,pgrid%nCellsTot
    pmixt%cvOld(cv_mixt_dens,icg) = pmixt%cv(cv_mixt_dens,icg)
    pmixt%cvOld(cv_mixt_xmom,icg) = pmixt%cv(cv_mixt_xmom,icg)
    pmixt%cvOld(cv_mixt_ymom,icg) = pmixt%cv(cv_mixt_ymom,icg)
    pmixt%cvOld(cv_mixt_zmom,icg) = pmixt%cv(cv_mixt_zmom,icg)
    pmixt%cvOld(cv_mixt_ener,icg) = pmixt%cv(cv_mixt_ener,icg)
  END DO ! icg  

! ******************************************************************************
! End
! ******************************************************************************

  CALL deregisterfunction(global)

END SUBROUTINE rflu_res_setcvold
  
  
  






! ******************************************************************************
!
! Purpose: Set dissipation array.
!
! Description: None.
!
! Input: 
!   pRegion     Pointer to region
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************

SUBROUTINE rflu_res_setdiss(pRegion)

  IMPLICIT NONE

! ******************************************************************************
! Declarations
! ******************************************************************************

! ==============================================================================
! Arguments
! ==============================================================================

  TYPE (t_region), POINTER :: pregion

! ==============================================================================
! Locals
! ==============================================================================

  INTEGER :: icg
  TYPE(t_global), POINTER :: global
  TYPE(t_grid), POINTER :: pgrid
  TYPE(t_mixt), POINTER :: pmixt

! ******************************************************************************
! Start
! ******************************************************************************

  global => pregion%global

  CALL registerfunction(global,'RFLU_RES_SetDiss',&
  'RFLU_ModResidual.F90')

! ******************************************************************************
! Set pointers
! ******************************************************************************

  pgrid => pregion%grid
  pmixt => pregion%mixt

! ******************************************************************************
! Set old values
! ******************************************************************************

  IF ( pregion%irkStep == 1 ) THEN 
    DO icg = 1,pgrid%nCellsTot
      pmixt%diss(cv_mixt_dens,icg) = 0.0_rfreal
      pmixt%diss(cv_mixt_xmom,icg) = 0.0_rfreal
      pmixt%diss(cv_mixt_ymom,icg) = 0.0_rfreal
      pmixt%diss(cv_mixt_zmom,icg) = 0.0_rfreal
      pmixt%diss(cv_mixt_ener,icg) = 0.0_rfreal
    END DO ! icg 
  END IF ! pRegion%irkStep 

! ******************************************************************************
! End
! ******************************************************************************

  CALL deregisterfunction(global)

END SUBROUTINE rflu_res_setdiss

  
  
 
  
  



! ******************************************************************************
!
! Purpose: Set right-hand side.
!
! Description: None.
!
! Input: 
!   pRegion     Pointer to region
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************

SUBROUTINE rflu_res_setrhs(pRegion)

  IMPLICIT NONE

! ******************************************************************************
! Declarations
! ******************************************************************************

! ==============================================================================
! Arguments
! ==============================================================================

  TYPE (t_region), POINTER :: pregion

! ==============================================================================
! Locals
! ==============================================================================

  INTEGER :: icg
  TYPE(t_global), POINTER :: global
  TYPE(t_grid), POINTER :: pgrid
  TYPE(t_mixt), POINTER :: pmixt

! ******************************************************************************
! Start
! ******************************************************************************

  global => pregion%global

  CALL registerfunction(global,'RFLU_RES_SetRhs',&
  'RFLU_ModResidual.F90')

! ******************************************************************************
! Set pointers
! ******************************************************************************

  pgrid => pregion%grid
  pmixt => pregion%mixt

! ******************************************************************************
! Set right-hand side
! ******************************************************************************

  DO icg = 1,pgrid%nCellsTot
    pmixt%rhs(cv_mixt_dens,icg) = -pmixt%diss(cv_mixt_dens,icg)
    pmixt%rhs(cv_mixt_xmom,icg) = -pmixt%diss(cv_mixt_xmom,icg)
    pmixt%rhs(cv_mixt_ymom,icg) = -pmixt%diss(cv_mixt_ymom,icg)
    pmixt%rhs(cv_mixt_zmom,icg) = -pmixt%diss(cv_mixt_zmom,icg)
    pmixt%rhs(cv_mixt_ener,icg) = -pmixt%diss(cv_mixt_ener,icg)
  END DO ! icg

! ******************************************************************************
! End
! ******************************************************************************

  CALL deregisterfunction(global)

END SUBROUTINE rflu_res_setrhs



  
  
  
  
! ******************************************************************************
! End
! ******************************************************************************
  
END MODULE rflu_modresidual


! ******************************************************************************
!
! RCS Revision history:
!
! $Log: RFLU_ModResidual.F90,v $
! Revision 1.18  2008/12/06 08:44:24  mtcampbe
! Updated license.
!
! Revision 1.17  2008/11/19 22:17:35  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.16  2006/08/19 15:39:16  mparmar
! Moved region%mixt%bGradFace to patch%mixt%gradFace
!
! Revision 1.15  2006/05/01 21:02:07  haselbac
! Converted to new flux routine
!
! Revision 1.14  2006/04/27 15:10:32  haselbac
! Added VENKAT limiter option
!
! Revision 1.13  2006/04/15 17:00:38  haselbac
! Added RECONST_NONE and cReconst IF for bf grads
!
! Revision 1.12  2006/04/07 15:19:20  haselbac
! Removed tabs
!
! Revision 1.11  2006/04/07 14:49:42  haselbac
! Adapted to changes in f and bf diff modules and new WENO module
!
! Revision 1.10  2006/01/06 22:13:11  haselbac
! Added call to cell grad wrapper routine
!
! Revision 1.9  2005/11/14 16:59:29  haselbac
! Added support for pseudo-gas model
!
! Revision 1.8  2005/11/10 02:28:34  haselbac
! Adapted to changes in AUSM flux module
!
! Revision 1.7  2005/10/27 19:18:46  haselbac
! Adapted to changes in gradient routines
!
! Revision 1.6  2005/10/14 14:08:09  haselbac
! Added call to RFLU_EnforceHeatFlux
!
! Revision 1.5  2005/10/05 14:05:51  haselbac
! Adapted to changes in gradient computation
!
! Revision 1.4  2005/08/17 20:25:22  hdewey2
! Moved RFLU_GetResidualSupport2 from RFLU_ModPETScNewtonKrylov, added RFLU_GetResidualSupport1
!
! Revision 1.3  2005/07/14 21:44:28  haselbac
! Added limiters, new ENO scheme, and AUSM flux function
!
! Revision 1.2  2005/07/11 19:32:40  mparmar
! Adapted call to RFLU_LimitGradCells to changes in modules
!
! Revision 1.1  2005/05/19 18:17:52  haselbac
! Initial revision
!
! ******************************************************************************