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

MODULE rflu_modtopologyutils

  USE modglobal, ONLY: t_global
  USE moddatatypes
  USE modparameters
  USE moderror
  USE modgrid, ONLY: t_grid
  USE modmpi

  USE modsortsearch

  IMPLICIT NONE
  
  PRIVATE
  PUBLIC :: rflu_buildcellvertlist, & 
            rflu_buildconnvertlist, & 
            rflu_buildfacevertlist, & 
            rflu_buildvertcellnghblist

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

  CHARACTER(CHRLEN) :: & 
    RCSIdentString = '$RCSfile: RFLU_ModTopologyUtils.F90,v $ $Revision: 1.9 $'


! ******************************************************************************
! Routines
! ******************************************************************************

  CONTAINS





! ******************************************************************************
!
! Purpose: Build list of vertices given list of cells.
!
! Description: None.
!
! Input: 
!   global              Pointer to global data
!   pGrid               Pointer to grid 
!   cList               List of cells
!   cListDim            Number of cells
!   vListDimMax         Maximum number of vertices
!
! Output: 
!   vList               List of vertices
!   vListDim            Actual number of vertices
!
! Notes: None.
!
! ******************************************************************************

  SUBROUTINE rflu_buildcellvertlist(global,pGrid,cList,cListDim,vList, & 
                                    vlistdimmax,vlistdim)

    USE rflu_modhashtable

    IMPLICIT NONE
      
! ******************************************************************************
!   Declarations and definitions
! ******************************************************************************

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

    INTEGER, INTENT(IN) :: clistdim,vlistdimmax
    INTEGER, INTENT(OUT) :: vlistdim
    INTEGER, INTENT(IN) :: clist(clistdim)
    INTEGER, INTENT(OUT) :: vlist(vlistdimmax)
    TYPE(t_grid), POINTER :: pgrid 
    TYPE(t_global), POINTER :: global     
      
! ==============================================================================
!   Locals
! ==============================================================================

    INTEGER :: i,icg,icl,ict,ivl,key,errorflag
      
! ******************************************************************************
!   Start
! ******************************************************************************

    CALL registerfunction(global,'RFLU_BuildCellVertList',&
  'RFLU_ModTopologyUtils.F90')

! ******************************************************************************
!   Initialize
! ******************************************************************************
           
    vlistdim = 0   
    
    DO i = 1,vlistdimmax 
      vlist(i) = 0
    END DO ! i     

! ******************************************************************************
!   Create hash table
! ******************************************************************************

    CALL rflu_createhashtable(global,vlistdimmax) 
    
! ******************************************************************************
!   Build vertex list
! ******************************************************************************
                
    DO i = 1,clistdim
      icg = clist(i)
      
      ict = pgrid%cellGlob2Loc(1,icg)
      icl = pgrid%cellGlob2Loc(2,icg)
      
      SELECT CASE ( ict ) 
        CASE ( cell_type_tet ) 
          DO ivl = 1,4
            CALL rflu_hashbuildkey(pgrid%tet2v(ivl:ivl,icl),1,key)          
            CALL rflu_hashvertex(global,key,pgrid%tet2v(ivl,icl),vlistdim, & 
                                 vlist)             
          END DO ! ivl
        CASE ( cell_type_hex ) 
          DO ivl = 1,8
            CALL rflu_hashbuildkey(pgrid%hex2v(ivl:ivl,icl),1,key)          
            CALL rflu_hashvertex(global,key,pgrid%hex2v(ivl,icl),vlistdim, & 
                                 vlist)           
          END DO ! ivl
        CASE ( cell_type_pri ) 
          DO ivl = 1,6
            CALL rflu_hashbuildkey(pgrid%pri2v(ivl:ivl,icl),1,key)          
            CALL rflu_hashvertex(global,key,pgrid%pri2v(ivl,icl),vlistdim, & 
                                 vlist)      
          END DO ! ivl
        CASE ( cell_type_pyr ) 
          DO ivl = 1,5
            CALL rflu_hashbuildkey(pgrid%pyr2v(ivl:ivl,icl),1,key)          
            CALL rflu_hashvertex(global,key,pgrid%pyr2v(ivl,icl),vlistdim, & 
                                 vlist)       
          END DO ! ivl
        CASE default 
          CALL errorstop(global,err_reached_default,__line__)
      END SELECT ! ict    
    END DO ! i
                                
! ******************************************************************************
!   Destroy hash table
! ******************************************************************************
       
    CALL rflu_destroyhashtable(global)         

! ******************************************************************************
!   Sort list of vertices
! ******************************************************************************

    CALL quicksortinteger(vlist(1:vlistdim),vlistdim)
                                
! ******************************************************************************
!   End
! ******************************************************************************

    CALL deregisterfunction(global)

  END SUBROUTINE rflu_buildcellvertlist








! ******************************************************************************
!
! Purpose: Build list of vertices given list of cells.
!
! Description: None.
!
! Input: 
!   global              Pointer to global data
!   connList            List of entities in connectivity list
!   connListDim1        Number of entries per entity
!   connListDim2        Number of entities in connectivity 
!   vListDimMax         Maximum number of vertices
!
! Output: 
!   vList               List of vertices
!   vListDim            Actual number of vertices
!
! Notes: None.
!
! ******************************************************************************

  SUBROUTINE rflu_buildconnvertlist(global,connList,connListDim1,connListDim2, & 
                                    vlist,vlistdimmax,vlistdim)

    USE rflu_modhashtable

    IMPLICIT NONE
      
! ******************************************************************************
!   Declarations and definitions
! ******************************************************************************

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

    INTEGER, INTENT(IN) :: connlistdim1,connlistdim2,vlistdimmax
    INTEGER, INTENT(OUT) :: vlistdim
    INTEGER, INTENT(IN) :: connlist(connlistdim1,connlistdim2)
    INTEGER, INTENT(OUT) :: vlist(vlistdimmax)
    TYPE(t_global), POINTER :: global     
      
! ==============================================================================
!   Locals
! ==============================================================================

    INTEGER :: i,i1,i2,ivl,key
      
! ******************************************************************************
!   Start
! ******************************************************************************

    CALL registerfunction(global,'RFLU_BuildConnVertList',&
  'RFLU_ModTopologyUtils.F90')

! ******************************************************************************
!   Initialize
! ******************************************************************************
           
    vlistdim = 0   
    
    DO i = 1,vlistdimmax 
      vlist(i) = 0
    END DO ! i     

! ******************************************************************************
!   Create hash table
! ******************************************************************************

    CALL rflu_createhashtable(global,vlistdimmax) 
    
! ******************************************************************************
!   Build vertex list
! ******************************************************************************
                
    DO i2 = 1,connlistdim2
      DO i1 = 1,connlistdim1
        CALL rflu_hashbuildkey(connlist(i1:i1,i2),1,key)          
        CALL rflu_hashvertex(global,key,connlist(i1,i2),vlistdim,vlist)             
      END DO ! i1
    END DO ! i2
                                
! ******************************************************************************
!   Destroy hash table
! ******************************************************************************
       
    CALL rflu_destroyhashtable(global)         

! ******************************************************************************
!   Sort list of vertices
! ******************************************************************************

    CALL quicksortinteger(vlist(1:vlistdim),vlistdim)
                                
! ******************************************************************************
!   End
! ******************************************************************************

    CALL deregisterfunction(global)

  END SUBROUTINE rflu_buildconnvertlist









! ******************************************************************************
!
! Purpose: Build list of vertices given list of faces.
!
! Description: None.
!
! Input: 
!   global              Pointer to global data
!   pGrid               Pointer to grid 
!   fList               List of faces
!   fListDim            Number of faces
!   vListDimMax         Maximum number of vertices
!
! Output: 
!   vList               List of vertices
!   vListDim            Actual number of vertices
!   errorFlag           Error flag 
!
! Notes: None.
!
! ******************************************************************************

  SUBROUTINE rflu_buildfacevertlist(global,pGrid,fList,fListDim,vList, & 
                                    vlistdimmax,vlistdim,errorflag)

    USE rflu_modhashtable

    IMPLICIT NONE
      
! ******************************************************************************
!   Declarations and definitions
! ******************************************************************************

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

    INTEGER, INTENT(IN) :: flistdim,vlistdimmax
    INTEGER, INTENT(OUT) :: errorflag,vlistdim
    INTEGER, INTENT(IN) :: flist(flistdim)
    INTEGER, INTENT(OUT) :: vlist(vlistdimmax)
    TYPE(t_grid), POINTER :: pgrid 
    TYPE(t_global), POINTER :: global     
      
! ==============================================================================
!   Locals
! ==============================================================================

    INTEGER :: i,ifg,key
      
! ******************************************************************************
!   Start
! ******************************************************************************

    CALL registerfunction(global,'RFLU_BuildFaceVertList',&
  'RFLU_ModTopologyUtils.F90')

! ******************************************************************************
!   Initialize
! ******************************************************************************
           
    vlistdim = 0   
    
    DO i = 1,vlistdimmax 
      vlist(i) = 0
    END DO ! i     

! ******************************************************************************
!   Create hash table
! ******************************************************************************

    CALL rflu_createhashtable(global,vlistdimmax) 
    
! ******************************************************************************
!   Build vertex list
! ******************************************************************************
                
    iloop: DO i = 1,flistdim
      ifg = flist(i)
      
      CALL rflu_hashbuildkey(pgrid%f2v(1,ifg:ifg),1,key)          
      CALL rflu_hashvertex(global,key,pgrid%f2v(1,ifg),vlistdim,vlist,errorflag)       

      IF ( errorflag /= err_none ) THEN 
        EXIT iloop
      END IF ! errorFlag

      CALL rflu_hashbuildkey(pgrid%f2v(2,ifg:ifg),1,key)          
      CALL rflu_hashvertex(global,key,pgrid%f2v(2,ifg),vlistdim,vlist,errorflag)
      
      IF ( errorflag /= err_none ) THEN 
        EXIT iloop
      END IF ! errorFlag

      CALL rflu_hashbuildkey(pgrid%f2v(3,ifg:ifg),1,key)          
      CALL rflu_hashvertex(global,key,pgrid%f2v(3,ifg),vlistdim,vlist,errorflag)
            
      IF ( errorflag /= err_none ) THEN 
        EXIT iloop
      END IF ! errorFlag

      IF ( pgrid%f2v(4,ifg) /= vert_none ) THEN 
        CALL rflu_hashbuildkey(pgrid%f2v(4,ifg:ifg),1,key)          
        CALL rflu_hashvertex(global,key,pgrid%f2v(4,ifg),vlistdim,vlist, & 
                             errorflag)                

        IF ( errorflag /= err_none ) THEN 
          EXIT iloop
        END IF ! errorFlag
      END IF ! pGrid%f2v
    END DO iloop
                                
! ******************************************************************************
!   Destroy hash table
! ******************************************************************************
       
    CALL rflu_destroyhashtable(global)         

! ******************************************************************************
!   Sort list of vertices
! ******************************************************************************

    IF ( errorflag == err_none ) THEN
      CALL quicksortinteger(vlist(1:vlistdim),vlistdim)
    END IF ! errorFlag
                                
! ******************************************************************************
!   End
! ******************************************************************************

    CALL deregisterfunction(global)

  END SUBROUTINE rflu_buildfacevertlist









! ******************************************************************************
!
! Purpose: Build list of cell neighbors given list of vertices.
!
! Description: None.
!
! Input: 
!   global              Pointer to global data  
!   pGrid               Pointer to grid
!   vListOrig           List of vertices
!   vListOrigDim        Number of vertices in list
!   nLayers             Number of cell layers to be added
!   iReg                Target region (see notes)
!   cList               List of cells (empty)
!   cListDimMax         Dimension of list of cells
!
! Output: 
!   cList               List of cells
!   cListDim            Actual number of cells in list
!
! Notes: 
!    1. Cells are added in a different way depending on the value of iReg:
!       - If iReg = 0 add cell in any case.
!       - If iReg > 0 add cell only if region index of cell after partitioning 
!         is EQUAL to iReg.
!       - If iReg < 0 add cell only if region index of cell after partitioning
!         is NOT EQUAL to iReg.  
!    2. Routine must work even if sc2r mapping not existent, so have special
!       treatment for this case, which can arise if this routine is called 
!       in connection with building sype virtual cells.    
!
! ******************************************************************************

  SUBROUTINE rflu_buildvertcellnghblist(global,pGrid,vListOrig,vListOrigDim, &
                                        nlayers,ireg,clist,clistdimmax,clistdim)

    IMPLICIT NONE
      
! ******************************************************************************
!   Declarations and definitions
! ******************************************************************************

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

    INTEGER, INTENT(IN) :: clistdimmax,ireg,nlayers,vlistorigdim
    INTEGER, INTENT(OUT) :: clistdim
    INTEGER, INTENT(IN) :: vlistorig(vlistorigdim)
    INTEGER, INTENT(OUT) :: clist(clistdimmax)
    TYPE(t_grid), POINTER :: pgrid 
    TYPE(t_global), POINTER :: global     
      
! ==============================================================================
!   Locals
! ==============================================================================

    LOGICAL :: check1,check2,check3
    INTEGER :: clistdimnew,clisttempdim,clisttempdimmax,errorflag,icg,icl, & 
               ilayer,iloc,ivg,ivl,iv2c,vlistdim,vlisttempdim,vlisttempdim2, & 
               vlisttempdimmax
    INTEGER, DIMENSION(:), ALLOCATABLE :: clisttemp,vlist,vlisttemp
      
! ******************************************************************************
!   Start
! ******************************************************************************

    CALL registerfunction(global,'RFLU_BuildVertCellNghbList',&
  'RFLU_ModTopologyUtils.F90')

! ******************************************************************************
!   Allocate temporary memory
! ******************************************************************************
                
    clisttempdimmax = clistdimmax/nlayers
    
    ALLOCATE(clisttemp(clisttempdimmax),stat=errorflag)
    global%error = errorflag
    IF ( global%error /= err_none ) THEN 
      CALL errorstop(global,err_allocate,__line__,'cListTemp')
    END IF ! global%error        

    vlistdim = vlistorigdim

    ALLOCATE(vlist(vlistdim),stat=errorflag)
    global%error = errorflag
    IF ( global%error /= err_none ) THEN 
      CALL errorstop(global,err_allocate,__line__,'vList')
    END IF ! global%error    

! ******************************************************************************
!   Initialize
! ******************************************************************************             
                
    clistdim = 0
    
    DO icl = 1,clistdimmax
      clist(icl) = 0 
    END DO ! icl         

    DO ivl = 1,vlistdim
      vlist(ivl) = vlistorig(ivl)
    END DO ! ivl

! ******************************************************************************
!   Loop over layers of cells to be added
! ******************************************************************************             
                                 
    DO ilayer = 1,nlayers    

! ==============================================================================
!     Initialize temporary cell list
! ==============================================================================              

      clisttempdim = 0
      
      DO icl = 1,clisttempdimmax
        clisttemp(icl) = 0
      END DO ! icl  

! ==============================================================================
!     Loop through vertex list and build list of new cells
! ==============================================================================              
        
      DO ivl = 1,vlistdim
        ivg = vlist(ivl)

! ------------------------------------------------------------------------------
!       For given vertex, loop through adjacent cells
! ------------------------------------------------------------------------------

        DO iv2c = pgrid%v2cInfo(v2c_beg,ivg),pgrid%v2cInfo(v2c_end,ivg)
          icg = pgrid%v2c(iv2c)

          IF ( ireg == 0 ) THEN 
            check1 = .true.
          ELSE 
            check1 = .false.
          END IF ! iReg
                    
          IF ( ASSOCIATED(pgrid%sc2r) .EQV. .true. ) THEN 
            IF ( (ireg > 0) .AND. (pgrid%sc2r(icg) == ireg) ) THEN
              check2 = .true.
            ELSE 
              check2 = .false.
            END IF ! iReg
            
            IF ( (ireg < 0) .AND. (pgrid%sc2r(icg) /= abs(ireg)) ) THEN
              check3 = .true.
            ELSE 
              check3 = .false.
            END IF ! iReg            
          ELSE
            check2 = .false.
            check3 = .false.
          END IF ! ASSOCIATED(pGrid%sc2r)

! ------- Check whether cell is in target region -------------------------------

          IF ( (check1 .EQV. .true.) .OR. & 
               (check2 .EQV. .true.) .OR. &
               (check3 .EQV. .true.) ) THEN 

! --------- Add cell to temporary cell list if not already in lists 
      
            IF ( clistdim > 0 ) THEN                             
              CALL binarysearchinteger(clist(1:clistdim),clistdim,icg,iloc)
            ELSE 
              iloc = element_not_found
            END IF ! cListDim

            IF ( iloc == element_not_found ) THEN
              IF ( clisttempdim > 0 ) THEN 
                CALL binarysearchinteger(clisttemp(1:clisttempdim), & 
                                         clisttempdim,icg,iloc)
              ELSE 
                iloc = element_not_found
              END IF ! cListTempDim

              IF ( iloc == element_not_found ) THEN 
                IF ( clisttempdim < clisttempdimmax ) THEN                                                                                      
                  clisttempdim = clisttempdim + 1

                  clisttemp(clisttempdim) = icg

                  IF ( clisttempdim > 1 ) THEN 
                    CALL quicksortinteger(clisttemp(1:clisttempdim), & 
                                          clisttempdim)
                  END IF ! cListTempDim
                ELSE 
                  CALL errorstop(global,err_exceed_dimens,__line__,'cListTemp')
                END IF ! cListTempDim
              END IF ! iLoc            
            END IF ! iLoc
                                  
          END IF ! iReg          
        END DO ! iv2c
      END DO ! ivl    
 
! ==============================================================================
!     Merge cell lists
! ==============================================================================              
      
      IF ( clistdim + clisttempdim <= clistdimmax ) THEN
        DO icl = clistdim+1,clistdim+clisttempdim
          clist(icl) = clisttemp(icl-clistdim)
        END DO ! icl
        
        clistdim = clistdim + clisttempdim
        
        IF ( clistdim /= clisttempdim ) THEN ! Added cells, so need to sort
          CALL quicksortinteger(clist(1:clistdim),clistdim)
        END IF ! cListDim
      ELSE 
        CALL errorstop(global,err_exceed_dimens,__line__,'cList')              
      END IF ! cListDim 
      
! ==============================================================================
!     Build new list of vertices from which cells can be added 
! ==============================================================================              
      
      IF( ilayer < nlayers ) THEN 

! ------------------------------------------------------------------------------
!       Allocate temporary memory
! ------------------------------------------------------------------------------

        vlisttempdimmax = 8*clisttempdim ! TEMPORARY
        
        ALLOCATE(vlisttemp(vlisttempdimmax),stat=errorflag)
        global%error = errorflag
        IF ( global%error /= err_none ) THEN 
          CALL errorstop(global,err_allocate,__line__,'vListTemp')
        END IF ! global%error

! ------------------------------------------------------------------------------
!       Build list of vertices from last layer of cells
! ------------------------------------------------------------------------------

        CALL rflu_buildcellvertlist(global,pgrid,clisttemp(1:clisttempdim), & 
                                    clisttempdim,vlisttemp,vlisttempdimmax, & 
                                    vlisttempdim)

! ------------------------------------------------------------------------------
!       Remove vertices which are shared with current list of vertices
! ------------------------------------------------------------------------------

        CALL removecommonsortedintegers(vlist,vlistdim, & 
                                        vlisttemp(1:vlisttempdim), & 
                                        vlisttempdim,vlisttempdim2)

! ------------------------------------------------------------------------------
!       Build new list of vertices
! ------------------------------------------------------------------------------

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

        vlistdim = vlisttempdim2

        ALLOCATE(vlist(vlistdim),stat=errorflag)
        global%error = errorflag
        IF ( global%error /= err_none ) THEN 
          CALL errorstop(global,err_allocate,__line__,'vList')
        END IF ! global%error   

        DO ivl = 1,vlistdim
          vlist(ivl) = vlisttemp(ivl)
        END DO ! ivl

! ------------------------------------------------------------------------------
!       Deallocate temporary memory
! ------------------------------------------------------------------------------

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

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

    DEALLOCATE(vlist,stat=errorflag)
    global%error = errorflag
    IF ( global%error /= err_none ) THEN 
      CALL errorstop(global,err_deallocate,__line__,'vList')
    END IF ! global%error
        
    DEALLOCATE(clisttemp,stat=errorflag)
    global%error = errorflag
    IF ( global%error /= err_none ) THEN 
      CALL errorstop(global,err_deallocate,__line__,'cListTemp')
    END IF ! global%error                    
          
! ******************************************************************************
!   End
! ******************************************************************************

    CALL deregisterfunction(global)

  END SUBROUTINE rflu_buildvertcellnghblist





! ******************************************************************************
! End
! ******************************************************************************
  
END MODULE rflu_modtopologyutils


! ******************************************************************************
!
! RCS Revision history:
!
! $Log: RFLU_ModTopologyUtils.F90,v $
! Revision 1.9  2008/12/06 08:44:24  mtcampbe
! Updated license.
!
! Revision 1.8  2008/11/19 22:17:35  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.7  2006/04/07 15:19:20  haselbac
! Removed tabs
!
! Revision 1.6  2006/03/25 21:59:46  haselbac
! Modified building of vert cell nghb list bcos of sype changes
!
! Revision 1.5  2005/10/05 20:09:32  haselbac
! Added fn for building vert list from conn table
!
! Revision 1.4  2005/06/15 20:49:23  haselbac
! Bug fix: Duplicate declaration of errorFlag in RFLU_BuildFaceVertList
!
! Revision 1.3  2005/06/14 17:47:24  haselbac
! Adapted RFLU_BuildFaceVertList for adaptive memory allocation
!
! Revision 1.2  2005/01/17 19:55:20  haselbac
! Added routine to build list of vertices from list of faces, cosmetics
!
! Revision 1.1  2004/12/29 20:58:17  haselbac
! Initial revision
!
! ******************************************************************************