RFLU_ModVertexLists.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 vertex lists.
!
! Description: None.
!
! Notes: None.
!
! ******************************************************************************
!
! $Id: RFLU_ModVertexLists.F90,v 1.4 2008/12/06 08:44:24 mtcampbe Exp $
!
! Copyright: (c) 2005 by the University of Illinois
!
! ******************************************************************************

MODULE rflu_modvertexlists

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

  IMPLICIT NONE

  PRIVATE
  PUBLIC :: rflu_buildvert2celllist, &
            rflu_createvert2celllist, &   
            rflu_destroyvert2celllist, & 
            rflu_nullifyvert2celllist
            
        
! ******************************************************************************
! Declarations and definitions
! ******************************************************************************  
   
  CHARACTER(CHRLEN) :: RCSIdentString = & 
    '$RCSfile: RFLU_ModVertexLists.F90,v $ $Revision: 1.4 $'        
             
! ******************************************************************************
! Routines
! ******************************************************************************

  CONTAINS
  
  




! *******************************************************************************
!
! Purpose: Build vertex-to-cell list.
!
! Description: None.
!
! Input:
!   pRegion             Pointer to region
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************

  SUBROUTINE rflu_buildvert2celllist(pRegion)

    USE rflu_modcellfaceedgeinfo

    IMPLICIT NONE

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

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

    TYPE(t_region), POINTER :: pregion

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

    INTEGER :: errorflag,icg,icl,ict,ivg,ivl,v2cbeg,v2cdegrsum,v2cend,v2cindx
    INTEGER, DIMENSION(:), ALLOCATABLE :: v2cdegr
    TYPE(t_grid), POINTER :: pgrid        
    TYPE(t_global), POINTER :: global     

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

    global => pregion%global

    CALL registerfunction(global,'RFLU_BuildVert2CellList',&
  'RFLU_ModVertexLists.F90')

    IF ( global%myProcid == masterproc .AND. &
         global%verbLevel >= verbose_high ) THEN
      WRITE(stdout,'(A,1X,A)') solver_name, & 
                               'Building vertex-to-cell list...'            
    END IF ! global%verbLevel  

! ******************************************************************************
!   Set grid pointer and set constants
! ******************************************************************************

    pgrid => pregion%grid

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

    ALLOCATE(v2cdegr(pgrid%nVertTot),stat=errorflag)
    global%error = errorflag
    IF ( global%error /= err_none ) THEN 
      CALL errorstop(global,err_allocate,__line__,'v2cDegr')
    END IF ! global%error    

    DO ivg = 1,pgrid%nVertTot
      v2cdegr(ivg) = 0
    END DO ! ivg    

! ******************************************************************************
!   Loop over cells and determine degree of each vertex
! ******************************************************************************

    DO icg = 1,pgrid%nCellsTot
      ict = rflu_getglobalcelltype(global,pgrid,icg)
      icl = pgrid%cellGlob2Loc(2,icg)

      SELECT CASE ( ict ) 
        CASE ( cell_type_tet ) 
          DO ivl = 1,4
            ivg = pgrid%tet2v(ivl,icl)              
            v2cdegr(ivg) = v2cdegr(ivg) + 1 
          END DO ! ivl
        CASE ( cell_type_hex ) 
          DO ivl = 1,8
            ivg = pgrid%hex2v(ivl,icl)
            v2cdegr(ivg) = v2cdegr(ivg) + 1              
          END DO ! ivl
        CASE ( cell_type_pri )           
          DO ivl = 1,6
            ivg = pgrid%pri2v(ivl,icl)
            v2cdegr(ivg) = v2cdegr(ivg) + 1              
          END DO ! ivl                  
        CASE ( cell_type_pyr ) 
          DO ivl = 1,5
            ivg = pgrid%pyr2v(ivl,icl)
            v2cdegr(ivg) = v2cdegr(ivg) + 1              
          END DO ! ivl            
        CASE default 
          CALL errorstop(global,err_reached_default,__line__)                
      END SELECT ! ict
    END DO ! icg      

! ******************************************************************************
!   Build information array
! ******************************************************************************

    v2cdegrsum = 0      

    DO ivg = 1,pgrid%nVertTot
      IF ( ivg > 1 ) THEN 
        pgrid%v2cInfo(v2c_beg,ivg) = pgrid%v2cInfo(v2c_end,ivg-1) + 1
      ELSE 
        pgrid%v2cInfo(v2c_beg,ivg) = 1
      END IF ! ivg

      v2cdegrsum = v2cdegrsum + v2cdegr(ivg)

      pgrid%v2cInfo(v2c_end,ivg) = v2cdegrsum                                                                           
    END DO ! ivg          

! ******************************************************************************
!   Allocate actual v2c array
! ******************************************************************************

    ALLOCATE(pgrid%v2c(v2cdegrsum),stat=errorflag)
    global%error = errorflag
    IF ( global%error /= err_none ) THEN 
      CALL errorstop(global,err_allocate,__line__,'pGrid%v2c')
    END IF ! global%error              

! ******************************************************************************
!   Build actual array
! ******************************************************************************

    DO ivg = 1,pgrid%nVertTot ! Reinitialize degree counter     
      v2cdegr(ivg) = 0 
    END DO ! ivg

    DO icg = 1,pgrid%nCellsTot
      ict = rflu_getglobalcelltype(global,pgrid,icg)
      icl = pgrid%cellGlob2Loc(2,icg)

      SELECT CASE ( ict ) 
        CASE ( cell_type_tet ) 
          DO ivl = 1,4
            ivg = pgrid%tet2v(ivl,icl)
            v2cindx = pgrid%v2cInfo(v2c_beg,ivg) + v2cdegr(ivg)              
            pgrid%v2c(v2cindx) = icg 
            v2cdegr(ivg) = v2cdegr(ivg) + 1  
          END DO ! ivl
        CASE ( cell_type_hex ) 
          DO ivl = 1,8
            ivg = pgrid%hex2v(ivl,icl)
            v2cindx = pgrid%v2cInfo(v2c_beg,ivg) + v2cdegr(ivg)              
            pgrid%v2c(v2cindx) = icg 
            v2cdegr(ivg) = v2cdegr(ivg) + 1  
          END DO ! ivl
        CASE ( cell_type_pri )           
          DO ivl = 1,6
            ivg = pgrid%pri2v(ivl,icl)
            v2cindx = pgrid%v2cInfo(v2c_beg,ivg) + v2cdegr(ivg)              
            pgrid%v2c(v2cindx) = icg 
            v2cdegr(ivg) = v2cdegr(ivg) + 1  
          END DO ! ivl                  
        CASE ( cell_type_pyr ) 
          DO ivl = 1,5
            ivg = pgrid%pyr2v(ivl,icl)
            v2cindx = pgrid%v2cInfo(v2c_beg,ivg) + v2cdegr(ivg)              
            pgrid%v2c(v2cindx) = icg 
            v2cdegr(ivg) = v2cdegr(ivg) + 1  
          END DO ! ivl            
        CASE default 
          CALL errorstop(global,err_reached_default,__line__)                
      END SELECT ! ict
    END DO ! icg                     

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

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


#ifdef CHECK_DATASTRUCT
! ******************************************************************************
!   Data structure output for checking
! ******************************************************************************

    WRITE(stdout,'(A)') solver_name
    WRITE(stdout,'(A,1X,A)') solver_name,'### START CHECK OUTPUT ###'
    WRITE(stdout,'(A,1X,A)') solver_name,'Vertex-to-cell list'      

    DO ivg = 1,pgrid%nVertTot
      v2cbeg = pgrid%v2cInfo(v2c_beg,ivg)
      v2cend = pgrid%v2cInfo(v2c_end,ivg)

      WRITE(stdout,'(A,1X,I6,1X,I3,3X,20(1X,I6))') solver_name,ivg, & 
            v2cend-v2cbeg+1,pgrid%v2c(v2cbeg:v2cend)        
    END DO ! ivg          
#endif                  

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

    IF ( global%myProcid == masterproc .AND. &
         global%verbLevel >= verbose_high ) THEN
      WRITE(stdout,'(A,1X,A)') solver_name, & 
                               'Building vertex-to-cell list done.'
    END IF ! global%verbLevel    

    CALL deregisterfunction(global)  

  END SUBROUTINE rflu_buildvert2celllist  








! *******************************************************************************
!
! Purpose: Create vertex-to-cell list.
!
! Description: None.
!
! Input:
!   pRegion             Pointer to region
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************

  SUBROUTINE rflu_createvert2celllist(pRegion)

    IMPLICIT NONE

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

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

    TYPE(t_region), POINTER :: pregion

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

    INTEGER :: errorflag,ic
    TYPE(t_grid), POINTER :: pgrid        
    TYPE(t_global), POINTER :: global  

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

    global => pregion%global

    CALL registerfunction(global,'RFLU_CreateVert2CellList',&
  'RFLU_ModVertexLists.F90')

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

! ******************************************************************************
!   Nullify memory
! ******************************************************************************

    CALL rflu_nullifyvert2celllist(pregion)

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

    pgrid => pregion%grid

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

    ALLOCATE(pgrid%v2cInfo(v2c_beg:v2c_end,pgrid%nVertTot),stat=errorflag)
    global%error = errorflag
    IF ( global%error /= err_none ) THEN 
      CALL errorstop(global,err_allocate,__line__,'v2cInfo')
    END IF ! global%error                

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

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

    CALL deregisterfunction(global)  

  END SUBROUTINE rflu_createvert2celllist 
 
 
 
 
 


! *******************************************************************************
!
! Purpose: Destroy vertex-to-cell list.
!
! Description: None.
!
! Input:
!   pRegion             Pointer to region
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************

  SUBROUTINE rflu_destroyvert2celllist(pRegion)

    IMPLICIT NONE

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

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

    TYPE(t_region), POINTER :: pregion

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

    INTEGER :: errorflag
    TYPE(t_grid), POINTER :: pgrid        
    TYPE(t_global), POINTER :: global  

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

    global => pregion%global

    CALL registerfunction(global,'RFLU_DestroyVert2CellList',&
  'RFLU_ModVertexLists.F90')

    IF ( global%myProcid == masterproc .AND. &
         global%verbLevel >= verbose_high ) THEN
      WRITE(stdout,'(A,1X,A)') solver_name, & 
                               'Destroying vertex-to-cell list...'
    END IF ! global%verbLevel

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

    pgrid => pregion%grid

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

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

! ******************************************************************************
!   Nullify memory
! ******************************************************************************

    CALL rflu_nullifyvert2celllist(pregion)

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

    IF ( global%myProcid == masterproc .AND. &
         global%verbLevel >= verbose_high ) THEN
      WRITE(stdout,'(A,1X,A)') solver_name, &
                               'Destroying vertex-to-cell list done.'
    END IF ! global%verbLevel  

    CALL deregisterfunction(global)  

  END SUBROUTINE rflu_destroyvert2celllist 







! *******************************************************************************
!
! Purpose: Nullify vertex-to-cell list.
!
! Description: None.
!
! Input:
!   pRegion             Pointer to region
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************
  
  SUBROUTINE rflu_nullifyvert2celllist(pRegion)

    IMPLICIT NONE

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

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


    TYPE(t_region), POINTER :: pregion

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

    TYPE(t_grid), POINTER :: pgrid        
    TYPE(t_global), POINTER :: global  

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

    global => pregion%global

    CALL registerfunction(global,'RFLU_NullifyVert2CellList',&
  'RFLU_ModVertexLists.F90')

    IF ( global%myProcid == masterproc .AND. &
         global%verbLevel >= verbose_high ) THEN
      WRITE(stdout,'(A,1X,A)') solver_name, & 
                               'Nullifying vertex-to-cell list...'
    END IF ! global%verbLevel

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

    pgrid => pregion%grid

! ******************************************************************************
!   Nullify memory
! ******************************************************************************

    nullify(pgrid%v2c)
    nullify(pgrid%v2cInfo)   

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

    IF ( global%myProcid == masterproc .AND. &
         global%verbLevel >= verbose_high ) THEN
      WRITE(stdout,'(A,1X,A)') solver_name, &
                               'Nullifying vertex-to-cell list done.'
    END IF ! global%verbLevel  

    CALL deregisterfunction(global)  

  END SUBROUTINE rflu_nullifyvert2celllist 







! ******************************************************************************
! End
! ******************************************************************************
  
END MODULE rflu_modvertexlists


! ******************************************************************************
!
! RCS Revision history:
!
! $Log: RFLU_ModVertexLists.F90,v $
! Revision 1.4  2008/12/06 08:44:24  mtcampbe
! Updated license.
!
! Revision 1.3  2008/11/19 22:17:35  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.2  2006/04/07 15:19:21  haselbac
! Removed tabs
!
! Revision 1.1  2005/10/05 14:33:44  haselbac
! Initial revision
!
! ******************************************************************************