RFLU_ModRelatedPatches.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: Suite of routines for transforming data on related patches.
!
! Description: None.
!
! Notes: None. 
!
! ******************************************************************************
!
! $Id: RFLU_ModRelatedPatches.F90,v 1.5 2008/12/06 08:44:23 mtcampbe Exp $
!
! Copyright: (c) 2006 by the University of Illinois
!
! ******************************************************************************

MODULE rflu_modrelatedpatches

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

  IMPLICIT NONE

  PRIVATE
  PUBLIC :: rflu_relp_transformvector, & 
            rflu_relp_transformwrapper
            
    
! ******************************************************************************
! Declarations and definitions
! ******************************************************************************  
      
  CHARACTER(CHRLEN) :: & 
    RCSIdentString = '$RCSfile: RFLU_ModRelatedPatches.F90,v $ $Revision: 1.5 $' 
                      
! ******************************************************************************
! Routines
! ******************************************************************************

  CONTAINS





! ******************************************************************************
!
! Purpose: Wrapper for transforming data for virtual cells associated with
!   periodic patches.
!
! Description: None.
!
! Input:
!   pRegion     Pointer to region
!   pPatch      Pointer to patch
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************

  SUBROUTINE rflu_relp_periodicwrapper(pRegion,pPatch)

    IMPLICIT NONE
  
! ******************************************************************************
!   Declarations and definitions
! ******************************************************************************  
  
! ==============================================================================
!   Arguments
! ==============================================================================

    TYPE(t_patch), POINTER :: ppatch
    TYPE(t_region), POINTER :: pregion
       
! ==============================================================================
!   Local variables
! ==============================================================================

    INTEGER :: errorflag,icg,icl
    REAL(RFREAL) :: ct,ex,ey,ez,st,theta
    REAL(RFREAL) :: v(3),vr(3)
    REAL(RFREAL) :: rotmat(3,3)
    REAL(RFREAL), DIMENSION(:,:), POINTER :: pvar    
    TYPE(t_global), POINTER :: global  
    TYPE(t_grid), POINTER :: pgrid
  
! ******************************************************************************
!   Start
! ******************************************************************************

    global => pregion%global

    CALL registerfunction(global,'RFLU_RELP_PeriodicWrapper',&
  'RFLU_ModRelatedPatches.F90')

! ******************************************************************************
!   Set pointers and variables
! ******************************************************************************

    pgrid => pregion%grid
        
! ******************************************************************************
!   Check boundary condition - defensive coding
! ******************************************************************************

    IF ( ppatch%bcType /= bc_periodic ) THEN 
      CALL errorstop(global,err_bc_invalid,__line__)
    END IF ! pPatch%bcType

! ******************************************************************************
!   Define rotation matrix
! ******************************************************************************
    
    theta = ppatch%angleRelated

    ct = cos(theta)
    st = sin(theta)

    SELECT CASE ( ppatch%axisRelated ) 
      CASE ( 1 ) 
        ex = 1.0_rfreal
        ey = 0.0_rfreal
        ez = 0.0_rfreal
      CASE ( 2 ) 
        ex = 0.0_rfreal
        ey = 1.0_rfreal
        ez = 0.0_rfreal
      CASE ( 3 ) 
        ex = 0.0_rfreal
        ey = 0.0_rfreal
        ez = 1.0_rfreal
      CASE default
        CALL errorstop(global,err_reached_default,__line__)
    END SELECT ! pPatch%axisRelated
    
    rotmat(1,1) = ct + (1.0_rfreal-ct)*ex*ex
    rotmat(1,2) =      (1.0_rfreal-ct)*ex*ey - st*ez
    rotmat(1,3) =      (1.0_rfreal-ct)*ex*ez + st*ey
    
    rotmat(2,1) =      (1.0_rfreal-ct)*ey*ex + st*ez
    rotmat(2,2) = ct + (1.0_rfreal-ct)*ey*ey
    rotmat(2,3) =      (1.0_rfreal-ct)*ey*ez - st*ex
    
    rotmat(3,1) =      (1.0_rfreal-ct)*ez*ex - st*ey
    rotmat(3,2) =      (1.0_rfreal-ct)*ez*ey + st*ex
    rotmat(3,3) = ct + (1.0_rfreal-ct)*ez*ez        

! ******************************************************************************
!   Mixture
! ******************************************************************************
    
    pvar => pregion%mixt%cv
    
    DO icl = 1,ppatch%nBCellsVirt
      icg = ppatch%bvc(icl)
      
      v(1) = pvar(cv_mixt_xmom,icg)
      v(2) = pvar(cv_mixt_ymom,icg)
      v(3) = pvar(cv_mixt_zmom,icg)      
      
      vr = matmul(rotmat,v)
            
      pvar(cv_mixt_xmom,icg) = vr(1)
      pvar(cv_mixt_ymom,icg) = vr(2)
      pvar(cv_mixt_zmom,icg) = vr(3)   
    END DO ! icl

! ******************************************************************************
!   Physical modules
! ******************************************************************************

! TO DO 
!
! END TO DO 

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

    CALL deregisterfunction(global)
  
  END SUBROUTINE rflu_relp_periodicwrapper






! ******************************************************************************
!
! Purpose: Wrapper for transforming data for virtual cells associated with
!   symmetry patches.
!
! Description: None.
!
! Input:
!   pRegion     Pointer to region
!   pPatch      Pointer to patch
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************

  SUBROUTINE rflu_relp_symmetrywrapper(pRegion,pPatch)

    USE modinterfaces, ONLY: reflectvector

    IMPLICIT NONE
  
! ******************************************************************************
!   Declarations and definitions
! ******************************************************************************  
  
! ==============================================================================
!   Arguments
! ==============================================================================

    TYPE(t_patch), POINTER :: ppatch
    TYPE(t_region), POINTER :: pregion   
       
! ==============================================================================
!   Local variables
! ==============================================================================

    INTEGER :: icg,icl
    REAL(RFREAL) :: nx,ny,nz,vx,vy,vz
    REAL(RFREAL), DIMENSION(:,:), POINTER :: pvar
    TYPE(t_global), POINTER :: global  
    TYPE(t_grid), POINTER :: pgrid             
  
! ******************************************************************************
!   Start
! ******************************************************************************

    global => pregion%global

    CALL registerfunction(global,'RFLU_RELP_SymmetryWrapper',&
  'RFLU_ModRelatedPatches.F90')
        
! ******************************************************************************
!   Check boundary condition - defensive coding
! ******************************************************************************

    IF ( ppatch%bcType /= bc_symmetry ) THEN 
      CALL errorstop(global,err_bc_invalid,__line__)
    END IF ! pPatch%bcType

! ******************************************************************************
!   Get patch normal
! ******************************************************************************
    
    nx = ppatch%pn(xcoord)
    ny = ppatch%pn(ycoord)
    nz = ppatch%pn(zcoord)

! ******************************************************************************
!   Mixture
! ******************************************************************************
    
    pvar => pregion%mixt%cv
    
    DO icl = 1,ppatch%nBCellsVirt
      icg = ppatch%bvc(icl)
      
      vx = pvar(cv_mixt_xmom,icg)
      vy = pvar(cv_mixt_ymom,icg)
      vz = pvar(cv_mixt_zmom,icg)      
      
      CALL reflectvector(nx,ny,nz,vx,vy,vz)
      
      pvar(cv_mixt_xmom,icg) = vx
      pvar(cv_mixt_ymom,icg) = vy
      pvar(cv_mixt_zmom,icg) = vz   
    END DO ! icl

! ******************************************************************************
!   Physical modules
! ******************************************************************************

! TO DO 
!
! END TO DO 

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

    CALL deregisterfunction(global)
  
  END SUBROUTINE rflu_relp_symmetrywrapper







! ******************************************************************************
!
! Purpose: Transform vector.
!
! Description: None.
!
! Input:
!   pRegion     Pointer to region
!   pPatch      Pointer to patch
!   vx          x-component of vector
!   vy          y-component of vector
!   vz          z-component of vector
!
! Output: 
!   vx          x-component of transformed vector
!   vy          y-component of transformed vector
!   vz          z-component of transformed vector
!
! Notes: None.
!
! ******************************************************************************

  SUBROUTINE rflu_relp_transformvector(pRegion,pPatch,vx,vy,vz)

    IMPLICIT NONE
  
! ******************************************************************************
!   Declarations and definitions
! ******************************************************************************  
  
! ==============================================================================
!   Arguments
! ==============================================================================

    REAL(RFREAL), INTENT(INOUT) :: vx,vy,vz 
    TYPE(t_patch), POINTER :: ppatch
    TYPE(t_region), POINTER :: pregion
       
! ==============================================================================
!   Local variables
! ==============================================================================

    REAL(RFREAL) :: v(4),vt(4)    
    TYPE(t_global), POINTER :: global  

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

    global => pregion%global

    CALL registerfunction(global,'RFLU_RELP_TransformVector',&
  'RFLU_ModRelatedPatches.F90')

! ******************************************************************************
!   Check boundary condition - defensive coding
! ******************************************************************************

    IF ( ppatch%bcType /= bc_periodic ) THEN 
      CALL errorstop(global,err_bc_invalid,__line__)
    END IF ! pPatch%bcType

! ******************************************************************************
!   Transform vector
! ******************************************************************************
    
    v(1) = vx
    v(2) = vy
    v(3) = vz
    v(4) = 1.0_rfreal
           
    vt = matmul(ppatch%tm,v)
      
    vx = vt(1)
    vy = vt(2)
    vz = vt(3)        

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

    CALL deregisterfunction(global)
  
  END SUBROUTINE rflu_relp_transformvector






! ******************************************************************************
!
! Purpose: Wrapper for transforming data for virtual cells associated with
!   periodic patches.
!
! Description: None.
!
! Input:
!   pRegion     Pointer to region
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************

  SUBROUTINE rflu_relp_transformwrapper(pRegion)

    IMPLICIT NONE
  
! ******************************************************************************
!   Declarations and definitions
! ******************************************************************************  
  
! ==============================================================================
!   Arguments
! ==============================================================================

    TYPE(t_region), POINTER :: pregion
       
! ==============================================================================
!   Local variables
! ==============================================================================

    INTEGER :: errorflag,ipatch
    TYPE(t_global), POINTER :: global  
    TYPE(t_grid), POINTER :: pgrid             
    TYPE(t_patch), POINTER :: ppatch
  
! ******************************************************************************
!   Start
! ******************************************************************************

    global => pregion%global

    CALL registerfunction(global,'RFLU_RELP_TransformWrapper',&
  'RFLU_ModRelatedPatches.F90')

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

    pgrid => pregion%grid
    
! ******************************************************************************
!   Loop over patches
! ******************************************************************************

    DO ipatch = 1,pgrid%nPatches
      ppatch => pregion%patches(ipatch)
    
      IF ( ppatch%nBCellsVirt > 0 ) THEN 
        SELECT CASE ( ppatch%bcType ) 
          CASE ( bc_periodic ) 
            CALL rflu_relp_periodicwrapper(pregion,ppatch)
          CASE ( bc_symmetry ) 
            CALL rflu_relp_symmetrywrapper(pregion,ppatch)          
          CASE default
            CALL errorstop(global,err_reached_default,__line__)
        END SELECT ! pPatch%bcType      
      END IF ! pPatch%nBCellsVirt
    END DO ! iPatch

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

    CALL deregisterfunction(global)
  
  END SUBROUTINE rflu_relp_transformwrapper









! ******************************************************************************
! End
! ******************************************************************************
  
END MODULE rflu_modrelatedpatches


! ******************************************************************************
!
! RCS Revision history:
!
! $Log: RFLU_ModRelatedPatches.F90,v $
! Revision 1.5  2008/12/06 08:44:23  mtcampbe
! Updated license.
!
! Revision 1.4  2008/11/19 22:17:34  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.3  2006/08/19 16:09:51  fnajjar
! Added routine to transform vector
!
! Revision 1.2  2006/04/07 15:19:20  haselbac
! Removed tabs
!
! Revision 1.1  2006/03/25 21:38:54  haselbac
! Initial revision
!
! ******************************************************************************