RFLU_CreateGrid.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: Create grid.
!
! Description: None.
!
! Input:
!   pRegion             Region pointer
!
! Output: None.
!
! Notes: 
!   1. This routine creates the basic grid arrays only, i.e., those read in
!      by RFLU_ReadGrid{ASCII/Binary}.F90. Other grid-associated arrays
!      are created in other routines. One exception is the local boundary 
!      face connectivity arrays required for GENX runs. These arrays are 
!      created by the call to RFLU_CreateBFaceLocLists. 
!   2. The dimensions of the various arrays MUST have been previously read 
!      by a call to RFLU_ReadDimensions.F90.
!
! ******************************************************************************
!
! $Id: RFLU_CreateGrid.F90,v 1.25 2008/12/06 08:44:12 mtcampbe Exp $
!
! Copyright: (c) 2002-2006 by the University of Illinois
!
! ******************************************************************************

SUBROUTINE rflu_creategrid(pRegion)

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

  IMPLICIT NONE
  
! ******************************************************************************
! Definitions and declarations
! ******************************************************************************

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

  TYPE(t_region), POINTER :: pregion

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

  CHARACTER(CHRLEN) :: rcsidentstring
  INTEGER :: errorflag,ipatch
  TYPE(t_grid), POINTER :: pgrid
  TYPE(t_patch), POINTER :: ppatch
  TYPE(t_global), POINTER :: global

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

  rcsidentstring = '$RCSfile: RFLU_CreateGrid.F90,v $ $Revision: 1.25 $'

  global => pregion%global

  CALL registerfunction(global,'RFLU_CreateGrid',&
  'RFLU_CreateGrid.F90')

  IF ( global%myProcid == masterproc .AND. & 
       global%verbLevel >= verbose_high ) THEN 
    WRITE(stdout,'(A,1X,A)') solver_name,'Creating grid...'
  END IF ! global%verbLevel

! ******************************************************************************
! Set grid pointer
! ******************************************************************************

  pgrid => pregion%grid

! ******************************************************************************
! Coordinates and vertex flags
! ******************************************************************************

  ALLOCATE(pgrid%xyz(3,pgrid%nVertMax),stat=errorflag)
  global%error = errorflag         
  IF ( global%error /= err_none ) THEN 
    CALL errorstop(global,err_allocate,__line__,'region%grid%xyz')
  END IF ! global%error
  
! ******************************************************************************
! Connectivity
! ******************************************************************************

! ==============================================================================
! Tetrahedra
! ==============================================================================

  IF ( pgrid%nTetsMax > 0 ) THEN 
    ALLOCATE(pgrid%tet2v(4,pgrid%nTetsMax),stat=errorflag) 
    global%error = errorflag         
    IF ( global%error /= err_none ) THEN 
      CALL errorstop(global,err_allocate,__line__,'region%grid%tet2v')
    END IF ! global%error  
  ELSE 
    nullify(pgrid%tet2v) 
  END IF ! pGrid%nTetsMax

! ==============================================================================
! Hexahedra
! ==============================================================================

  IF ( pgrid%nHexsMax > 0 ) THEN 
    ALLOCATE(pgrid%hex2v(8,pgrid%nHexsMax),stat=errorflag) 
    global%error = errorflag 
    IF ( global%error /= err_none ) THEN 
      CALL errorstop(global,err_allocate,__line__,'region%grid%hex2v')
    END IF ! global%error  
  ELSE 
    nullify(pgrid%hex2v) 
  END IF ! pGrid%nHexsTot

! ==============================================================================
! Prisms
! ==============================================================================

  IF ( pgrid%nPrisMax > 0 ) THEN 
    ALLOCATE(pgrid%pri2v(6,pgrid%nPrisMax),stat=errorflag)
    global%error = errorflag          
    IF ( global%error /= err_none ) THEN 
      CALL errorstop(global,err_allocate,__line__,'region%grid%pri2v')
    END IF ! global%error 
  ELSE 
    nullify(pgrid%pri2v)  
  END IF ! pGrid%nPrisTot               
        
! ==============================================================================
! Pyramids 
! ==============================================================================

  IF ( pgrid%nPyrsMax > 0 ) THEN 
    ALLOCATE(pgrid%pyr2v(5,pgrid%nPyrsMax),stat=errorflag)
    global%error = errorflag          
    IF ( global%error /= err_none ) THEN 
      CALL errorstop(global,err_allocate,__line__,'region%grid%pyr2v')
    END IF ! global%error
  ELSE 
    nullify(pgrid%pyr2v)  
  END IF ! pGrid%nPyrsTot

! ==============================================================================
! Initialize some dimensions
! ==============================================================================

  pgrid%nCellsSpecial = 0
  pgrid%nFacesSpecial = 0

  pgrid%nBFaces    = 0 
  pgrid%nBFacesTot = 0 
  
  pgrid%nCellsConstr = 0
  pgrid%nFacesConstr = 0  

! ******************************************************************************
! Patches
! ******************************************************************************

  IF ( pgrid%nPatches > 0 ) THEN 
    ALLOCATE(pregion%patches(pgrid%nPatches),stat=errorflag)  
    global%error = errorflag         
    IF ( global%error /= err_none ) THEN 
      CALL errorstop(global,err_allocate,__line__,'pRegion%patches')
    END IF ! global%error
  ELSE 
    nullify(pregion%patches)
  END IF ! pGrid%nPatches

! ==============================================================================
! Loop over patches
! ==============================================================================

  DO ipatch = 1,pgrid%nPatches
    ppatch => pregion%patches(ipatch)

! ------------------------------------------------------------------------------
!   Copy data read in from dimension file into patch type
! ------------------------------------------------------------------------------

    ppatch%iPatchLocal  = ipatch
    ppatch%iPatchGlobal = pgrid%patchDimens(patch_dimens_ipglobal,ipatch)
    
    ppatch%nBTris      = pgrid%patchDimens(patch_dimens_nbtris     ,ipatch)
    ppatch%nBTrisTot   = pgrid%patchDimens(patch_dimens_nbtristot  ,ipatch)
    ppatch%nBTrisMax   = pgrid%patchDimens(patch_dimens_nbtrismax  ,ipatch) 
       
    ppatch%nBQuads     = pgrid%patchDimens(patch_dimens_nbquads    ,ipatch)    
    ppatch%nBQuadsTot  = pgrid%patchDimens(patch_dimens_nbquadstot ,ipatch)
    ppatch%nBQuadsMax  = pgrid%patchDimens(patch_dimens_nbquadsmax ,ipatch)    

    ppatch%nBCellsVirt = pgrid%patchDimens(patch_dimens_nbcellsvirt,ipatch) 

    ppatch%nBFaces    = ppatch%nBTris    + ppatch%nBQuads 
    ppatch%nBFacesTot = ppatch%nBTrisTot + ppatch%nBQuadsTot
    ppatch%nBFacesMax = ppatch%nBTrisMax + ppatch%nBQuadsMax    

    pgrid%nBFaces     = pgrid%nBFaces    + ppatch%nBFaces
    pgrid%nBFacesTot  = pgrid%nBFacesTot + ppatch%nBFacesTot 

    ppatch%nBVert     = 0     
    ppatch%nBVertTot  = 0 
                
! ------------------------------------------------------------------------------
!   Set variables
! ------------------------------------------------------------------------------

    ppatch%plotFlag      = .true. 
    ppatch%renumFlag     = .false.
    ppatch%flatFlag      = .false.
    ppatch%transformFlag = .false.

    ppatch%movePatchDir = 0

! ------------------------------------------------------------------------------
!   Allocate remaining arrays (see also note above)  
! ------------------------------------------------------------------------------

! - Face arrays ----------------------------------------------------------------

    IF ( ppatch%nBTrisMax > 0 ) THEN 
      ALLOCATE(ppatch%bTri2v(3,ppatch%nBTrisMax),stat=errorflag)
      global%error = errorflag             
      IF ( global%error /= err_none ) THEN 
        CALL errorstop(global,err_allocate,__line__,'region%patches%bTri2v')
      END IF ! global%error
    ELSE 
      nullify(ppatch%bTri2v) 
    END IF ! pPatch%nBTrisTot

    IF ( ppatch%nBQuadsMax > 0 ) THEN 
      ALLOCATE(ppatch%bQuad2v(4,ppatch%nBQuadsMax),stat=errorflag)
      global%error = errorflag             
      IF ( global%error /= err_none ) THEN 
        CALL errorstop(global,err_allocate,__line__,'region%patch%bQuad2v')
      END IF ! global%error    
    ELSE 
      nullify(ppatch%bQuad2v)
    END IF ! pPatch%nBQuadsTot

! - Virtual cell array ---------------------------------------------------------
    
    IF ( ppatch%nBCellsVirt > 0 ) THEN                                                                          
      ALLOCATE(ppatch%bvc(ppatch%nBCellsVirt),stat=errorflag)
      global%error = errorflag
      IF ( global%error /= err_none ) THEN
        CALL errorstop(global,err_allocate,__line__,'pPatch%bvc')
      END IF ! global%error
    ELSE 
      nullify(ppatch%bvc)        
    END IF ! pPatch%nBCellsVirt
    
! ------------------------------------------------------------------------------
!   Initialize transformation matrix  
! ------------------------------------------------------------------------------
    
    ppatch%tm(xcoord,xcoord) = REAL(crazy_value_int,kind=rfreal)
    ppatch%tm(xcoord,ycoord) = REAL(crazy_value_int,kind=rfreal)
    ppatch%tm(xcoord,zcoord) = REAL(crazy_value_int,kind=rfreal)
    ppatch%tm(xcoord,xyzmag) = REAL(crazy_value_int,kind=rfreal)
    ppatch%tm(ycoord,xcoord) = REAL(crazy_value_int,kind=rfreal)
    ppatch%tm(ycoord,ycoord) = REAL(crazy_value_int,kind=rfreal)
    ppatch%tm(ycoord,zcoord) = REAL(crazy_value_int,kind=rfreal)
    ppatch%tm(ycoord,xyzmag) = REAL(crazy_value_int,kind=rfreal)
    ppatch%tm(zcoord,xcoord) = REAL(crazy_value_int,kind=rfreal)
    ppatch%tm(zcoord,ycoord) = REAL(crazy_value_int,kind=rfreal)
    ppatch%tm(zcoord,zcoord) = REAL(crazy_value_int,kind=rfreal)
    ppatch%tm(zcoord,xyzmag) = REAL(crazy_value_int,kind=rfreal)
    ppatch%tm(xyzmag,xcoord) = REAL(crazy_value_int,kind=rfreal)
    ppatch%tm(xyzmag,ycoord) = REAL(crazy_value_int,kind=rfreal)
    ppatch%tm(xyzmag,zcoord) = REAL(crazy_value_int,kind=rfreal)
    ppatch%tm(xyzmag,xyzmag) = REAL(crazy_value_int,kind=rfreal)
  END DO ! iPatch

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

  IF ( global%myProcid == masterproc .AND. & 
       global%verbLevel >= verbose_high ) THEN 
    WRITE(stdout,'(A,1X,A)') solver_name,'Creating grid done.'
  END IF ! global%verbLevel

  CALL deregisterfunction(global)

END SUBROUTINE rflu_creategrid

! ******************************************************************************
!
! RCS Revision history:
!
! $Log: RFLU_CreateGrid.F90,v $
! Revision 1.25  2008/12/06 08:44:12  mtcampbe
! Updated license.
!
! Revision 1.24  2008/11/19 22:17:25  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.23  2006/08/18 13:59:01  haselbac
! Added init of transform flag and tm
!
! Revision 1.22  2006/04/07 15:19:16  haselbac
! Removed tabs
!
! Revision 1.21  2006/04/07 14:42:00  haselbac
! Added setting of pPatch%iPatchLocal
!
! Revision 1.20  2006/03/25 21:41:48  haselbac
! Changes made bcos of sype boundaries
!
! Revision 1.19  2005/10/27 18:55:36  haselbac
! Added init of nCellsConstr and nFacesConstr
!
! Revision 1.18  2005/08/09 00:53:33  haselbac
! Added init of plotFlag for patches
!
! Revision 1.17  2005/06/13 22:42:40  haselbac
! Removed setting of cnstrType
!
! Revision 1.16  2005/06/10 19:44:12  haselbac
! Bug fix: Wrong module
!
! Revision 1.15  2005/06/10 18:04:38  haselbac
! Bug fix for backward-compatibility in GENx with cnstr_type
!
! Revision 1.14  2005/01/14 21:09:18  haselbac
! Removed init of nBorders, otherwise cannot read comm maps in solver
!
! Revision 1.13  2004/12/29 21:01:14  haselbac
! Added setting of pGrid%nBFaces and pGrid%nBFacesTot
!
! Revision 1.12  2004/12/04 03:21:37  haselbac
! Added initialization of nBorders
!
! Revision 1.11  2004/11/09 00:27:04  haselbac
! Bug fix: Used nTetsTot instead of nTetsMax
!
! Revision 1.10  2004/11/03 16:58:39  haselbac
! Removed allocation of vertex and cell flags
!
! Revision 1.9  2004/10/19 19:24:13  haselbac
! Introduced Max dims, removed bf arrays and derived dims
!
! Revision 1.8  2004/10/08 21:08:00  fnajjar
! ACH: Bug fix: Added initialization of nFacesSpecial
!
! Revision 1.7  2004/07/06 15:14:13  haselbac
! Bug fix: patchDimens now under grid type, cosmetics
!
! Revision 1.6  2003/11/03 03:48:53  haselbac
! Cosmetic changes only
!
! Revision 1.5  2003/06/04 22:01:16  haselbac
! Added NULLIFY for patches
!
! Revision 1.4  2003/04/01 19:37:14  haselbac
! Added initialization of nCellsSpecial
!
! Revision 1.3  2003/03/25 19:11:52  haselbac
! Added setting of patch renumbering flag
!
! Revision 1.2  2003/03/15 16:52:04  haselbac
! Added vertex arrays, allocate based on *Tot
!
! Revision 1.1  2003/01/28 15:53:31  haselbac
! Initial revision
!
! ******************************************************************************