RFLU_ModExtractFlowDataUtils.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: Collect utility routines for extraction of data from flow solution.
!
! Description: None.
!
! Input: None.
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************
!
! $Id: RFLU_ModExtractFlowDataUtils.F90,v 1.4 2008/12/06 08:45:06 mtcampbe Exp $
!
! Copyright: (c) 2007 by the University of Illinois
!
! ******************************************************************************

MODULE rflu_modextractflowdatautils

  USE moddatatypes
  USE modparameters
  USE moderror
  USE modglobal, ONLY: t_global
  USE modgrid, ONLY: t_grid
  USE modbndpatch, ONLY: t_patch
  USE moddatastruct, ONLY: t_region

#ifdef PLAG
  USE plag_modparameters
#endif

  IMPLICIT NONE

! ******************************************************************************
! Definitions and declarations
! ******************************************************************************

! ==============================================================================
! Private data
! ==============================================================================

  CHARACTER(CHRLEN), PARAMETER, PRIVATE :: &
    RCSIdentString = '$RCSfile: RFLU_ModExtractFlowDataUtils.F90,v $ $Revision: 1.4 $'

! ==============================================================================
! Public functions
! ==============================================================================

  PUBLIC :: rflu_extractshocklocation1d

! ==============================================================================
! Private functions
! ==============================================================================



! ******************************************************************************
! Subroutines and functions
! ******************************************************************************

  CONTAINS




! ******************************************************************************
!
! Purpose: Extract shock location for 1D cases.
!
! Description: Look for location of largest density gradient and then, 
!   starting from this position, determine position of zero second derivative, 
!   which is then taken to be shock location.
!
! Input:
!   pRegion             Pointer to region
!   icgBeg              Beginning cell index
!   icgEnd              Ending cell index
!   nCellsX             Number of cells in x-direction
!
! Output: 
!   xs                  Shock location
!
! Notes: 
!   1. This routine can be used for 2d cases, but then the array numbering must
!      be such that the indices follow the longest direction.
!
! ******************************************************************************

SUBROUTINE rflu_extractshocklocation1d(pRegion,icgBeg,icgEnd,nCellsX,xs)

  IMPLICIT NONE

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

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

  INTEGER, INTENT(IN) :: icgbeg,icgend,ncellsx
  REAL(RFREAL), INTENT(OUT) :: xs  
  TYPE(t_region), POINTER :: pregion

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

  INTEGER :: errorflag,icg,icl,icloffs,iclshock
  INTEGER :: dummy(1)
  REAL(RFREAL) :: idx,r,rm1,rp1,rxx,rxxp1,x,xp1
  REAL(RFREAL), DIMENSION(:), ALLOCATABLE :: gradx,gradxx
  REAL(RFREAL), DIMENSION(:,:), POINTER :: pcv
  TYPE(t_global), POINTER :: global
  TYPE(t_grid), POINTER :: pgrid

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

  global => pregion%global

  CALL registerfunction(global,'RFLU_ExtractShockLocation1D', &
                        'RFLU_ModExtractFlowDataUtils.F90')

! ******************************************************************************
! Set 
! ******************************************************************************

  pgrid => pregion%grid
  pcv   => pregion%mixt%cv

  icloffs = 4

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

  ALLOCATE(gradx(ncellsx-2),stat=errorflag)
  global%error = errorflag
  IF ( global%error /= err_none ) THEN 
    CALL errorstop(global,err_allocate,__line__,'gradx')
  END IF ! global%error

  ALLOCATE(gradxx(ncellsx-2),stat=errorflag)
  global%error = errorflag
  IF ( global%error /= err_none ) THEN 
    CALL errorstop(global,err_allocate,__line__,'gradxx')
  END IF ! global%error

! ******************************************************************************
! Compute first and second density derivatives and find location of maximum 
! (absolute) value of first derivative
! ******************************************************************************

  DO icl = 1,ncellsx-2
    icg = icgbeg + icl 

    rp1 = pcv(cv_mixt_dens,icg+1)       
    r   = pcv(cv_mixt_dens,icg  )
    rm1 = pcv(cv_mixt_dens,icg-1)       

    gradx(icl)  = 0.5_rfreal*(rp1-rm1)
    gradxx(icl) = rp1-2.0_rfreal*r+rm1
  END DO ! icl    

  dummy = maxloc(abs(gradx(1:ncellsx-2)))
  iclshock = dummy(1) 

! ******************************************************************************
! Starting from this location, search for zero crossing of second derivative 
! and then use linear approximation to compute location of zero crossing. NOTE 
! this search is carried out for iclOffs points on either side of location of 
! maximum (absolute) value of first derivative, so need to make sure do not step 
! out of bounds. If that is the case, simply pick shock location to be that cell
! with maximum (absolute) value of first derivative.
! ******************************************************************************

  IF ( (iclshock <= (ncellsx-icloffs-2)) .AND. & 
       (iclshock >= (icloffs+1)) ) THEN  
    DO icl = iclshock-icloffs,iclshock+icloffs-1
      icg = icgbeg + icl

      IF ( sign(1.0_rfreal,gradxx(icl)) /= sign(1.0_rfreal,gradxx(icl+1)) ) THEN 
        rxxp1 = gradxx(icl+1)
        rxx   = gradxx(icl)
  
        xp1 = pgrid%cofg(xcoord,icg+1)
        x   = pgrid%cofg(xcoord,icg)
  
        xs = (x*rxxp1-xp1*rxx)/(rxxp1-rxx)
      END IF ! SIGN  
    END DO ! icl
  ELSE 
    xs = pgrid%cofg(xcoord,icgbeg+iclshock)
  END IF ! icl

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

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

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

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

  CALL deregisterfunction(global)

END SUBROUTINE rflu_extractshocklocation1d





END MODULE rflu_modextractflowdatautils

! ******************************************************************************
!
! RCS Revision history:
!
! $Log: RFLU_ModExtractFlowDataUtils.F90,v $
! Revision 1.4  2008/12/06 08:45:06  mtcampbe
! Updated license.
!
! Revision 1.3  2008/11/19 22:18:16  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.2  2007/04/12 00:27:49  haselbac
! Changed to use zero of 2nd derivative to find shock location
!
! Revision 1.1  2007/04/05 01:38:07  haselbac
! Initial revision
!
! ******************************************************************************