RFLU_ModEdgeList.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 to build edge list.
!
! Description: None.
!
! Notes:
!   1. There is no routine called RFLU_CreateEdgeList - as might be expected - 
!      because the sizes of the various arrays is not known in advance and 
!      splitting the routine becomes cumbersome.
!
! ******************************************************************************
!
! $Id: RFLU_ModEdgeList.F90,v 1.13 2008/12/06 08:44:21 mtcampbe Exp $
!
! Copyright: (c) 2002-2005 by the University of Illinois
!
! ******************************************************************************

MODULE rflu_modedgelist

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

  IMPLICIT NONE

  PRIVATE
  PUBLIC :: rflu_nullifyedgelist, & 
            rflu_nullifyedge2celllist, &          
            rflu_createedgelist, & 
            rflu_createedge2celllist, &  
            rflu_buildedgelist, & 
            rflu_buildedge2celllist, & 
            rflu_destroyedgelist, &  
            rflu_destroyedge2celllist
  
  SAVE
  
! ******************************************************************************
! Declarations and definitions
! ******************************************************************************  
    
  CHARACTER(CHRLEN) :: & 
    RCSIdentString = '$RCSfile: RFLU_ModEdgeList.F90,v $ $Revision: 1.13 $' 
  INTEGER, PRIVATE :: ekCntr(EDGE_KIND_AA:EDGE_KIND_VV), & 
                      ekOffs(EDGE_KIND_AA:EDGE_KIND_VV), & 
                      ekStrt(EDGE_KIND_AA:EDGE_KIND_VV)
  INTEGER, DIMENSION(:,:), ALLOCATABLE, PRIVATE :: degr,strt                       
                                   
! ******************************************************************************
! Routines
! ******************************************************************************

  CONTAINS
  


! ******************************************************************************
!
! Purpose: Nullify edge list.
!
! Description: None.
!
! Input:
!   pRegion     Pointer to region
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************
    
  SUBROUTINE rflu_nullifyedgelist(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_NullifyEdgeList',&
  'RFLU_ModEdgeList.F90')

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

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

    pgrid => pregion%grid  
  
! ******************************************************************************
!   Nullify memory
! ******************************************************************************

    nullify(pgrid%e2v)

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

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

  END SUBROUTINE rflu_nullifyedgelist  





! ******************************************************************************
!
! Purpose: Nullify edge-to-cell list.
!
! Description: None.
!
! Input:
!   pRegion     Pointer to region
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************
    
  SUBROUTINE rflu_nullifyedge2celllist(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_NullifyEdge2CellList',&
  'RFLU_ModEdgeList.F90')

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

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

    pgrid => pregion%grid                               
  
! ******************************************************************************  
!   Nullify memory
! ******************************************************************************  

    nullify(pgrid%e2cStrt)
    nullify(pgrid%e2cDegr)
        
! ******************************************************************************  
!   End
! ******************************************************************************  

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

    CALL deregisterfunction(global)

  END SUBROUTINE rflu_nullifyedge2celllist   








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

  SUBROUTINE rflu_createedgelist(pRegion) 

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

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

    TYPE(t_region), POINTER :: pregion 

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

    INTEGER :: errorflag,ieg,ipatch,nbfaces,nfacesest
    TYPE(t_grid), POINTER :: pgrid
    TYPE(t_patch), POINTER :: ppatch  
    TYPE(t_global), POINTER :: global

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

    global => pregion%global

    CALL registerfunction(global,'RFLU_CreateEdgeList',&
  'RFLU_ModEdgeList.F90')

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

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

    CALL rflu_nullifyedgelist(pregion)

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

    pgrid => pregion%grid  
  
! ******************************************************************************
!   Estimate number of edges for allocation of hash table. The estimation 
!   formula shown below assumes that boundary effects are negligible, so for 
!   very small grids, where boundary edges dominate the total number of edges, 
!   need a kludge. Kludge is also needed if running in parallel and boundary
!   edges become a significant fraction of total number of edges, and when 
!   running code with periodic hack, where the missing boundaries mean that 
!   number of edges is underestimated.
! ******************************************************************************

    nbfaces = 0

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

      nbfaces = nbfaces + ppatch%nBTrisTot + ppatch%nBQuadsTot       
    END DO ! iPatch

    nfacesest  = nbfaces + 2*pgrid%nTetsTot + 3*pgrid%nHexsTot & 
               + 5*pgrid%nPrisTot/2

    pgrid%nEdgesEst = nbfaces + pgrid%nTetsTot + 2*pgrid%nHexsTot + & 
                      3*pgrid%nPrisTot/2 + pgrid%nVertTot - pgrid%nPyrsTot

    IF ( nbfaces/REAL(nFacesEst,KIND=RFREAL) > 0.8_rfreal .OR. & 
         nbfaces/REAL(nFacesEst,KIND=RFREAL) < 0.2_rfreal ) then 
      pgrid%nEdgesEst = 2*pgrid%nEdgesEst

      IF ( global%myProcid == masterproc .AND. & 
           global%verbLevel >= verbose_high) THEN
        WRITE(stdout,'(A,3X,A)') solver_name,'Corrected estimate of '// & 
                                 'number of edges.' 
      END IF ! global%verbLevel       
    END IF ! nBFaces

    IF ( global%myProcid == masterproc .AND. & 
         global%verbLevel >= verbose_high ) THEN
      WRITE(stdout,'(A,3X,A,3X,I9)') solver_name,'Estimated number of '// & 
                                     'edges: ',pgrid%nEdgesEst        
    END IF ! global%verbLevel  

    ALLOCATE(pgrid%e2v(2,pgrid%nEdgesEst),stat=errorflag) 
    global%error = errorflag   
    IF ( global%error /= err_none ) THEN 
      CALL errorstop(global,err_allocate,__line__,'pGrid%e2vTemp')
    END IF ! global%error  

    DO ieg = 1,pgrid%nEdgesEst ! Explicit loop because of ASCI White
      pgrid%e2v(1,ieg) = 0 
      pgrid%e2v(2,ieg) = 0               
    END DO ! ieg                        
      
! ******************************************************************************
!   End
! ******************************************************************************

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

    CALL deregisterfunction(global)

  END SUBROUTINE rflu_createedgelist  
  
  
  


! ******************************************************************************
!
! Purpose: Create edge-to-cell list.
!
! Description: None.
!
! Input:
!   pRegion     Pointer to region
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************
  
  SUBROUTINE rflu_createedge2celllist(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_CreateEdge2CellList',&
  'RFLU_ModEdgeList.F90')

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

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

    pgrid => pregion%grid                               
  
! ******************************************************************************  
!   Nullify memory
! ******************************************************************************  

    CALL rflu_nullifyedge2celllist(pregion)

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

    ALLOCATE(pgrid%e2cStrt(pgrid%nEdgesTot),stat=errorflag)
    global%error = errorflag
    IF ( global%error /= err_none ) THEN 
      CALL errorstop(global,err_allocate,__line__,'pGrid%e2cStrt')
    END IF ! global%error
      
    pgrid%e2cStrt(1) = 1 ! Initial value important

    ALLOCATE(pgrid%e2cDegr(pgrid%nEdgesTot),stat=errorflag)
    global%error = errorflag
    IF ( global%error /= err_none ) THEN 
      CALL errorstop(global,err_allocate,__line__,'pGrid%e2cDegr')
    END IF ! global%error     
        
! ******************************************************************************  
!   End
! ******************************************************************************  

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

    CALL deregisterfunction(global)

  END SUBROUTINE rflu_createedge2celllist      
  
  





! ******************************************************************************
!
! Purpose: Build edge list.
!
! Description: None.
!
! Input:
!   pRegion     Pointer to region
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************
      
  SUBROUTINE rflu_buildedgelist(pRegion) 

    USE modsortsearch

    USE rflu_modcellfaceedgeinfo
    USE rflu_modgrid
    USE rflu_modhashtable

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

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

    TYPE(t_region), POINTER :: pregion 

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

    INTEGER :: ecntr,edgetype,eksum,errorflag,ieg,iegb,iege,iek,iel,icl, & 
               ivg,key,nedges,vsize,v1,v2
    INTEGER :: v(2)

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

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

    global => pregion%global

    CALL registerfunction(global,'RFLU_BuildEdgeList',&
  'RFLU_ModEdgeList.F90')

    IF ( global%myProcid == masterproc .AND. & 
         global%verbLevel >= verbose_high ) THEN
      WRITE(stdout,'(A,1X,A)') solver_name,'Building edge list...' 
      WRITE(stdout,'(A,3X,A)') solver_name,'Building hash table...'         
    END IF ! global%verbLevel

! ******************************************************************************
!   Set grid pointer and initialize nEdgesTot
! ******************************************************************************

    pgrid => pregion%grid

    pgrid%nEdgesTot = 0

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

    CALL rflu_createhashtable(global,pgrid%nEdgesEst)

    IF ( global%myProcid == masterproc .AND. & 
         global%verbLevel >= verbose_high ) THEN                            
      WRITE(stdout,'(A,5X,A,1X,I9)') solver_name,'Hash table size:    '// &
                                     '       ',hashtablesize
    END IF ! global%verbLevel

! ******************************************************************************
!   Loop over cell types, construct hash table of faces
! ******************************************************************************

    vsize  = 2 ! Edges have only two vertices
    nedges = 0

    IF ( global%myProcid == masterproc .AND. & 
         global%verbLevel >= verbose_high) THEN                              
      WRITE(stdout,'(A,5X,A)') solver_name,'Looping over cell types...'
    END IF ! global%verbLevel  

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

    IF ( pgrid%nTetsTot /= 0 ) THEN
      IF ( global%myProcid == masterproc .AND. &
           global%verbLevel >= verbose_high) THEN   
        WRITE(stdout,'(A,7X,A)') solver_name,'Tetrahedra...'
      END IF ! global%verbLevel
    END IF ! pGrid%nTetsTot

    DO icl = 1,pgrid%nTetsTot            
      DO iel = 1,6    
        v(1) = pgrid%tet2v(ce2vtet(1,iel),icl)
        v(2) = pgrid%tet2v(ce2vtet(2,iel),icl)         

        CALL quicksortinteger(v(1:vsize),vsize)
        CALL rflu_hashbuildkey(v(1:2),2,key)              
        CALL rflu_hashedge(global,key,pgrid,v(1:2),edgetype) 

        IF ( edgetype == edge_type_new ) THEN 
          nedges = nedges + 1
        END IF ! edgeType
      END DO ! iel
    END DO ! icl

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

    IF ( pgrid%nHexsTot /= 0 ) THEN
      IF ( global%myProcid == masterproc .AND. & 
           global%verbLevel >= verbose_high) THEN   
        WRITE(stdout,'(A,7X,A)') solver_name,'Hexahedra...'
      END IF ! global%verbLevel
    END IF ! pGrid%nHexsTot

    DO icl = 1,pgrid%nHexsTot
      DO iel = 1,12
        v(1) = pgrid%hex2v(ce2vhex(1,iel),icl)
        v(2) = pgrid%hex2v(ce2vhex(2,iel),icl)   

        CALL quicksortinteger(v(1:vsize),vsize)
        CALL rflu_hashbuildkey(v(1:2),2,key)    
        CALL rflu_hashedge(global,key,pgrid,v(1:2),edgetype)  

        IF ( edgetype == edge_type_new ) THEN 
          nedges = nedges + 1
        END IF ! edgeType
      END DO ! ifl
    END DO ! icl

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

    IF ( pgrid%nPrisTot /= 0 ) THEN
      IF ( global%myProcid == masterproc .AND. & 
           global%verbLevel >= verbose_high) THEN   
        WRITE(stdout,'(A,7X,A)') solver_name,'Prisms...'
      END IF ! global%verbLevel
    END IF ! pGrid%nPrisTot

    DO icl = 1,pgrid%nPrisTot
      DO iel = 1,9
        v(1) = pgrid%pri2v(ce2vpri(1,iel),icl) 
        v(2) = pgrid%pri2v(ce2vpri(2,iel),icl)     

        CALL quicksortinteger(v(1:vsize),vsize)
        CALL rflu_hashbuildkey(v(1:2),2,key)    
        CALL rflu_hashedge(global,key,pgrid,v(1:2),edgetype)  

        IF ( edgetype == edge_type_new ) THEN 
          nedges = nedges + 1
        END IF ! edgeType    
      END DO ! ifl
    END DO ! icl  

! ==============================================================================
!   Pyramids
! ==============================================================================

    IF ( pgrid%nPyrsTot /= 0 ) THEN
      IF ( global%myProcid == masterproc .AND. &
           global%verbLevel >= verbose_high) THEN   
        WRITE(stdout,'(A,7X,A)') solver_name,'Pyramids...'
      END IF ! global%verbLevel
    END IF ! pGrid%nPyrsTot

    DO icl = 1,pgrid%nPyrsTot
      DO iel = 1,8
        v(1) = pgrid%pyr2v(ce2vpyr(1,iel),icl) 
        v(2) = pgrid%pyr2v(ce2vpyr(2,iel),icl)    

        CALL quicksortinteger(v(1:vsize),vsize)
        CALL rflu_hashbuildkey(v(1:2),2,key)    
        CALL rflu_hashedge(global,key,pgrid,v(1:2),edgetype)  

        IF ( edgetype == edge_type_new ) THEN 
          nedges = nedges + 1
        END IF ! edgeType    
      END DO ! ifl
    END DO ! icl    

! ******************************************************************************
!   Set number of edges, print some info, and destroy hash table
! ******************************************************************************

    pgrid%nEdgesTot = nedges

    IF ( global%myProcid == masterproc .AND. &
         global%verbLevel >= verbose_high) THEN
      WRITE(stdout,'(A,5X,A,6X,I9)') solver_name,'Hash table collisions:', & 
                                     hashtablecollisions  
    END IF ! global%verbLevel

    CALL rflu_destroyhashtable(global)

! ******************************************************************************
!   Determine edge kinds and set counter offsets
! ******************************************************************************

    ekcntr(edge_kind_aa) = 0
    ekcntr(edge_kind_av) = 0
    ekcntr(edge_kind_vv) = 0    

    DO ieg = 1,pgrid%nEdgesTot
      v1 = pgrid%e2v(1,ieg)
      v2 = pgrid%e2v(2,ieg)

      SELECT CASE (rflu_getedgekind(global,pgrid,v1,v2))         
        CASE (edge_kind_aa) 
          ekcntr(edge_kind_aa) = ekcntr(edge_kind_aa) + 1
        CASE (edge_kind_av)
          ekcntr(edge_kind_av) = ekcntr(edge_kind_av) + 1
        CASE (edge_kind_vv) 
          ekcntr(edge_kind_vv) = ekcntr(edge_kind_vv) + 1          
        CASE default
          CALL errorstop(global,err_reached_default,__line__)     
      END SELECT ! RFLU_GetEdgeKind      
    END DO ! ie        

    ekoffs(edge_kind_aa) = 0
    ekoffs(edge_kind_av) = ekcntr(edge_kind_aa)
    ekoffs(edge_kind_vv) = ekcntr(edge_kind_av) + ekoffs(edge_kind_av)

! ==============================================================================
!   Set nEdges. NOTE that it contains only those edges which link two actual
!   vertices. This is done for parallel grid motion, in which each region only
!   smooths by looping over the edges linking actual vertices. 
! ==============================================================================

!    pGrid%nEdges = ekCntr(EDGE_KIND_AA) + ekCntr(EDGE_KIND_AV)
    pgrid%nEdges = ekcntr(edge_kind_aa)

! ==============================================================================
!   Print info 
! ==============================================================================

    IF ( global%myProcid == masterproc .AND. &
         global%verbLevel >= verbose_high ) THEN
      !IF ( global%verbLevel >= VERBOSE_LOW ) THEN   
        WRITE(stdout,'(A,5X,A)')       solver_name,'Edge-type statistics:' 
        WRITE(stdout,'(A,7X,A,4X,I9)') solver_name,'Total edges:          ', & 
                                       pgrid%nEdgesTot        
        WRITE(stdout,'(A,5X,A)')       solver_name,'Edge-kind statistics:' 
        WRITE(stdout,'(A,7X,A,4X,I9)') solver_name,'Actual-actual edges:  ', & 
                                       ekcntr(edge_kind_aa)
        WRITE(stdout,'(A,7X,A,4X,I9)') solver_name,'Actual-virtual edges: ', & 
                                       ekcntr(edge_kind_av)
        WRITE(stdout,'(A,7X,A,4X,I9)') solver_name,'Virtual-virtual edges:', & 
                                       ekcntr(edge_kind_vv)
      !END IF ! global%verbLevel
    END IF ! global%myProcid     

! ******************************************************************************
!   Build actual edgelist
! ******************************************************************************

! ==============================================================================
!   Allocate and build helper arrays for sorting. The helper arrays are needed
!   so that within each edge kind, have edges sorted according to increasing
!   origination vertices and increasing destination vertices.
! ==============================================================================

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

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

    DO ivg = 1,pgrid%nVertTot ! Explicit loop because of ASCI White problems
      degr(edge_kind_aa,ivg) = 0
      degr(edge_kind_av,ivg) = 0
      degr(edge_kind_vv,ivg) = 0        
    END DO ! ivg

    DO ieg = 1,pgrid%nEdgesTot
      v1 = pgrid%e2v(1,ieg)
      v2 = pgrid%e2v(2,ieg)

      iek = rflu_getedgekind(global,pgrid,v1,v2)

      degr(iek,v1) = degr(iek,v1) + 1
    END DO ! ieg      

    strt(edge_kind_aa:edge_kind_vv,1) = 1

    DO ivg = 2,pgrid%nVertTot
      strt(edge_kind_aa,ivg) = strt(edge_kind_aa,ivg-1) & 
                             + degr(edge_kind_aa,ivg-1)
      strt(edge_kind_av,ivg) = strt(edge_kind_av,ivg-1) & 
                             + degr(edge_kind_av,ivg-1)
      strt(edge_kind_vv,ivg) = strt(edge_kind_vv,ivg-1) & 
                             + degr(edge_kind_vv,ivg-1)
    END DO ! ivg

! ==============================================================================
!   Transfer provisional edge-array into temporary array. Sort so edge kinds 
!   actual-actual and actual-virtual are listed before virtual-virtual ones. 
!   Within each edge-kind segment, sort according to increasing origination
!   vertices. 
! ==============================================================================

    ekcntr(edge_kind_aa) = 0 ! Reinitialize
    ekcntr(edge_kind_av) = 0
    ekcntr(edge_kind_vv) = 0    

    DO ivg = 1,pgrid%nVertTot ! Explicit loop because of ASCI White 
      degr(edge_kind_aa,ivg) = 0
      degr(edge_kind_av,ivg) = 0
      degr(edge_kind_vv,ivg) = 0        
    END DO ! ivg

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

    DO ieg = 1,pgrid%nEdgesTot
      v1 = pgrid%e2v(1,ieg)
      v2 = pgrid%e2v(2,ieg)

      iek = rflu_getedgekind(global,pgrid,v1,v2)

      ecntr = strt(iek,v1) + degr(iek,v1) + ekoffs(iek)        
      degr(iek,v1) = degr(iek,v1) + 1        
      ekcntr(iek)  = ekcntr(iek)  + 1 ! used below for consistency check     

      pgrid%e2vTemp(1,ecntr) = pgrid%e2v(1,ieg)
      pgrid%e2vTemp(2,ecntr) = pgrid%e2v(2,ieg) 
    END DO ! ieg

    eksum = ekcntr(edge_kind_aa) + ekcntr(edge_kind_av) + ekcntr(edge_kind_vv)

    IF ( eksum /= pgrid%nEdgesTot ) THEN ! Consistency check
      CALL errorstop(global,err_nedges_wrong,__line__) 
    END IF ! ekSum

! ==============================================================================
!   Finally sort within each edge-kind segment and each origination vertex
!   segment so that destination vertices are listed in increasing order. Note
!   because edges within each segment are already sorted according to 
!   origination vertices, need to sort here only according to destination
!   vertices for each range of origination vertices.
! ==============================================================================

    DO ivg = 1,pgrid%nVertTot
      
! ------------------------------------------------------------------------------
!     Actual-actual edges
! ------------------------------------------------------------------------------
      
      iek  = edge_kind_aa      
      iegb = ekoffs(iek) + strt(iek,ivg)                      
      iege = ekoffs(iek) + strt(iek,ivg) + degr(iek,ivg) - 1          

      IF ( iege > iegb ) THEN 
        CALL quicksortinteger(pgrid%e2vTemp(2,iegb:iege),iege-iegb+1)
      END IF ! iege

! ------------------------------------------------------------------------------
!     Actual-virtual edges 
! ------------------------------------------------------------------------------
      
      iek  = edge_kind_av
      iegb = ekoffs(iek) + strt(iek,ivg)                      
      iege = ekoffs(iek) + strt(iek,ivg) + degr(iek,ivg) - 1   

      IF ( iege > iegb ) THEN 
        CALL quicksortinteger(pgrid%e2vTemp(2,iegb:iege),iege-iegb+1)
      END IF ! iege
        
! ------------------------------------------------------------------------------
!      Virtual-virtual edges        
! ------------------------------------------------------------------------------
        
      iek  = edge_kind_vv
      iegb = ekoffs(iek) + strt(iek,ivg)                      
      iege = ekoffs(iek) + strt(iek,ivg) + degr(iek,ivg) - 1   

      IF ( iege > iegb ) THEN 
        CALL quicksortinteger(pgrid%e2vTemp(2,iegb:iege),iege-iegb+1)
      END IF ! iege                            
    END DO ! ivg

! ==============================================================================
!   Deallocate helper arrays
! ==============================================================================

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

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

! ==============================================================================
!   Allocate actual edge array and copy from temporary array
! ==============================================================================

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

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

    DO ieg = 1,pgrid%nEdgesTot ! Explicit loop because of ASCI White
      pgrid%e2v(1,ieg) = pgrid%e2vTemp(1,ieg)
      pgrid%e2v(2,ieg) = pgrid%e2vTemp(2,ieg)
    END DO ! ieg

! ==============================================================================
!   Deallocate temporary array
! ==============================================================================

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

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

    CALL deregisterfunction(global)

  END SUBROUTINE rflu_buildedgelist
  
  
  






! ******************************************************************************
!
! Purpose: Build edge-to-cell list.
!
! Description: None.
!
! Input:
!   pRegion     Pointer to region
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************
  
  SUBROUTINE rflu_buildedge2celllist(pRegion)
      
    USE modsortsearch

    USE rflu_modcellfaceedgeinfo
    USE rflu_modgrid      
      
    IMPLICIT NONE 
      
! ******************************************************************************
!   Declarations and definitions
! ******************************************************************************  

! ==============================================================================
!   Arguments
! ==============================================================================
  
    TYPE(t_region), POINTER :: pregion
      
! ==============================================================================
!   Locals
! ==============================================================================
  
    INTEGER :: errorflag,e2csize,icl,ieg,iegb,iege,iek,iel,iloc,ipass, & 
               ivg,vsize,v1,v2
    INTEGER :: v(2)
    TYPE(t_grid), POINTER :: pgrid
    TYPE(t_global), POINTER :: global

! ******************************************************************************  
!   Start
! ******************************************************************************  
      
    global => pregion%global

    CALL registerfunction(global,'RFLU_BuildEdge2CellList',&
  'RFLU_ModEdgeList.F90')

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

    pgrid => pregion%grid
      
! ******************************************************************************  
!   Build access lists for edge kinds, allows easy access of e2v list based on
!   edge kinds
! ******************************************************************************  
      
    ekcntr(edge_kind_aa) = 0
    ekcntr(edge_kind_av) = 0
    ekcntr(edge_kind_vv) = 0    

    DO ieg = 1,pgrid%nEdgesTot
      v1 = pgrid%e2v(1,ieg)
      v2 = pgrid%e2v(2,ieg)

      SELECT CASE (rflu_getedgekind(global,pgrid,v1,v2))         
        CASE (edge_kind_aa) 
          ekcntr(edge_kind_aa) = ekcntr(edge_kind_aa) + 1
        CASE (edge_kind_av)
          ekcntr(edge_kind_av) = ekcntr(edge_kind_av) + 1
        CASE (edge_kind_vv) 
          ekcntr(edge_kind_vv) = ekcntr(edge_kind_vv) + 1          
        CASE default
          CALL errorstop(global,err_reached_default,__line__)     
      END SELECT ! RFLU_GetEdgeKind      
    END DO ! ie        

    ekoffs(edge_kind_aa) = 0
    ekoffs(edge_kind_av) = ekcntr(edge_kind_aa)
    ekoffs(edge_kind_vv) = ekcntr(edge_kind_av) + ekoffs(edge_kind_av)

    ekstrt(edge_kind_aa) = 1
    ekstrt(edge_kind_av) = ekstrt(edge_kind_aa) + ekcntr(edge_kind_aa)
    ekstrt(edge_kind_vv) = ekstrt(edge_kind_av) + ekcntr(edge_kind_av)     
      
! ******************************************************************************  
!   Allocate and build helper arrays for sorting. The helper arrays are needed
!   so that within each edge kind, have edges sorted according to increasing
!   origination vertices and increasing destination vertices.
! ******************************************************************************  

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

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

    DO ivg = 1,pgrid%nVertTot ! Explicit loop because of ASCI White
      degr(edge_kind_aa,ivg) = 0
      degr(edge_kind_av,ivg) = 0
      degr(edge_kind_vv,ivg) = 0        
    END DO ! ivg

    DO ieg = 1,pgrid%nEdgesTot
      v1 = pgrid%e2v(1,ieg)
      v2 = pgrid%e2v(2,ieg)

      iek = rflu_getedgekind(global,pgrid,v1,v2)

      degr(iek,v1) = degr(iek,v1) + 1
    END DO ! ieg      

    strt(edge_kind_aa,1) = 1
    strt(edge_kind_av,1) = 1
    strt(edge_kind_vv,1) = 1

    DO ivg = 2,pgrid%nVertTot
      strt(edge_kind_aa,ivg) = strt(edge_kind_aa,ivg-1) & 
                             + degr(edge_kind_aa,ivg-1)
      strt(edge_kind_av,ivg) = strt(edge_kind_av,ivg-1) & 
                             + degr(edge_kind_av,ivg-1)
      strt(edge_kind_vv,ivg) = strt(edge_kind_vv,ivg-1) & 
                             + degr(edge_kind_vv,ivg-1)
    END DO ! ivg

! ******************************************************************************  
!   Loop over passes. In first pass, determine how many cells meet at a given
!   edge, and use this information to allocate the properly dimensioned e2c
!   array. In the second pass, fill the e2c array.
! ******************************************************************************  

    DO ipass = 1,2
      IF ( global%myProcid == masterproc .AND. &
           global%verbLevel >= verbose_high) THEN   
        WRITE(stdout,'(A,3X,A,1X,I1)') solver_name,'Pass:',ipass
      END IF ! global%verbLevel

! ==============================================================================
!     Loop over cell types
! ==============================================================================

      vsize = 2

      DO ieg = 1,pgrid%nEdgesTot ! Explicit loop because of ASCI White
        pgrid%e2cDegr(ieg) = 0
      END DO ! ieg

! ------------------------------------------------------------------------------
!     Tetrahedra
! ------------------------------------------------------------------------------
    
      IF ( pgrid%nTetsTot /= 0 ) THEN
        IF ( global%myProcid == masterproc .AND. &
             global%verbLevel >= verbose_high) THEN   
          WRITE(stdout,'(A,5X,A)') solver_name,'Tetrahedra...'
        END IF ! global%verbLevel
      END IF ! pGrid%nTetsTot

      DO icl = 1,pgrid%nTetsTot            
        DO iel = 1,6    
          v(1) = pgrid%tet2v(ce2vtet(1,iel),icl)
          v(2) = pgrid%tet2v(ce2vtet(2,iel),icl)         

          CALL quicksortinteger(v(1:vsize),vsize)

          iek  = rflu_getedgekind(global,pgrid,v(1),v(2))          
          iegb = ekoffs(iek) + strt(iek,v(1))                      
          iege = ekoffs(iek) + strt(iek,v(1)) + degr(iek,v(1)) - 1    

          CALL binarysearchinteger(pgrid%e2v(2,iegb:iege),iege-iegb+1,v(2), &
                                   iloc)

          IF ( iloc /= element_not_found ) THEN 
            ieg = iloc + iegb - 1

            IF ( pgrid%e2v(1,ieg) /= v(1) .OR. pgrid%e2v(2,ieg) /= v(2) ) THEN
              CALL errorstop(global,err_edgelist_invalid,__line__)
            END IF ! pGrid%e2v

            pgrid%e2cDegr(ieg) = pgrid%e2cDegr(ieg) + 1

            IF ( ipass == 2 ) THEN 
              iloc = pgrid%e2cStrt(ieg) + pgrid%e2cDegr(ieg) - 1                            
              pgrid%e2c(iloc) = pgrid%tet2CellGlob(icl)
            END IF ! iPass   
          ELSE 
            CALL errorstop(global,err_edgelist_invalid,__line__)                
          END IF ! iloc
        END DO ! iel
      END DO ! icl      
    
! ------------------------------------------------------------------------------
!     Hexahedra 
! ------------------------------------------------------------------------------
    
      IF ( pgrid%nHexsTot /= 0 ) THEN
        IF ( global%myProcid == masterproc .AND. &
             global%verbLevel >= verbose_high) THEN   
          WRITE(stdout,'(A,5X,A)') solver_name,'Hexahedra...'
        END IF ! global%verbLevel
      END IF ! pGrid%nHexsTot

      DO icl = 1,pgrid%nHexsTot            
        DO iel = 1,12    
          v(1) = pgrid%hex2v(ce2vhex(1,iel),icl)
          v(2) = pgrid%hex2v(ce2vhex(2,iel),icl)         

          CALL quicksortinteger(v(1:vsize),vsize)

          iek  = rflu_getedgekind(global,pgrid,v(1),v(2))         
          iegb = ekoffs(iek) + strt(iek,v(1))                      
          iege = ekoffs(iek) + strt(iek,v(1)) + degr(iek,v(1)) - 1    

          CALL binarysearchinteger(pgrid%e2v(2,iegb:iege),iege-iegb+1,v(2), &
                                   iloc)

          IF ( iloc /= element_not_found ) THEN 
            ieg = iloc + iegb - 1

            IF ( pgrid%e2v(1,ieg) /= v(1) .OR. pgrid%e2v(2,ieg) /= v(2) ) THEN
              CALL errorstop(global,err_edgelist_invalid,__line__)
            END IF ! pGrid%e2v

            pgrid%e2cDegr(ieg) = pgrid%e2cDegr(ieg) + 1

            IF ( ipass == 2 ) THEN               
              iloc = pgrid%e2cStrt(ieg) + pgrid%e2cDegr(ieg) - 1                            
              pgrid%e2c(iloc) = pgrid%hex2CellGlob(icl)
            END IF ! iPass                               
          ELSE 
            CALL errorstop(global,err_edgelist_invalid,__line__)                
          END IF ! iloc
        END DO ! iel
      END DO ! icl          

! ------------------------------------------------------------------------------
!     Prisms
! ------------------------------------------------------------------------------
    
      IF ( pgrid%nPrisTot /= 0 ) THEN
        IF ( global%myProcid == masterproc .AND. &
             global%verbLevel >= verbose_high) THEN   
          WRITE(stdout,'(A,5X,A)') solver_name,'Prisms...'
        END IF ! global%verbLevel
      END IF ! pGrid%nPrisTot

      DO icl = 1,pgrid%nPrisTot            
        DO iel = 1,9    
          v(1) = pgrid%pri2v(ce2vpri(1,iel),icl)
          v(2) = pgrid%pri2v(ce2vpri(2,iel),icl)         

          CALL quicksortinteger(v(1:vsize),vsize)

          iek  = rflu_getedgekind(global,pgrid,v(1),v(2))         
          iegb = ekoffs(iek) + strt(iek,v(1))                      
          iege = ekoffs(iek) + strt(iek,v(1)) + degr(iek,v(1)) - 1    

          CALL binarysearchinteger(pgrid%e2v(2,iegb:iege),iege-iegb+1,v(2), &
                                   iloc)

          IF ( iloc /= element_not_found ) THEN 
            ieg = iloc + iegb - 1

            IF ( pgrid%e2v(1,ieg) /= v(1) .OR. pgrid%e2v(2,ieg) /= v(2) ) THEN
              CALL errorstop(global,err_edgelist_invalid,__line__)
            END IF ! pGrid%e2v

            pgrid%e2cDegr(ieg) = pgrid%e2cDegr(ieg) + 1              

            IF ( ipass == 2 ) THEN               
              iloc = pgrid%e2cStrt(ieg) + pgrid%e2cDegr(ieg) - 1                            
              pgrid%e2c(iloc) = pgrid%pri2CellGlob(icl)
            END IF ! iPass            
          ELSE 
            CALL errorstop(global,err_edgelist_invalid,__line__)                
          END IF ! iloc
        END DO ! iel
      END DO ! icl     
    
! ------------------------------------------------------------------------------
!     Pyramids 
! ------------------------------------------------------------------------------
    
      IF ( pgrid%nPyrsTot /= 0 ) THEN
        IF ( global%myProcid == masterproc .AND. &
             global%verbLevel >= verbose_high) THEN   
          WRITE(stdout,'(A,5X,A)') solver_name,'Pyramids...'
        END IF ! global%verbLevel
      END IF ! pGrid%nPyrTot

      DO icl = 1,pgrid%nPyrsTot            
        DO iel = 1,8
          v(1) = pgrid%pyr2v(ce2vpyr(1,iel),icl)
          v(2) = pgrid%pyr2v(ce2vpyr(2,iel),icl)         

          CALL quicksortinteger(v(1:vsize),vsize)

          iek  = rflu_getedgekind(global,pgrid,v(1),v(2))         
          iegb = ekoffs(iek) + strt(iek,v(1))                      
          iege = ekoffs(iek) + strt(iek,v(1)) + degr(iek,v(1)) - 1    

          CALL binarysearchinteger(pgrid%e2v(2,iegb:iege),iege-iegb+1,v(2), & 
                                   iloc)

          IF ( iloc /= element_not_found ) THEN 
            ieg = iloc + iegb - 1

            IF ( pgrid%e2v(1,ieg) /= v(1) .OR. pgrid%e2v(2,ieg) /= v(2) ) THEN
              CALL errorstop(global,err_edgelist_invalid,__line__)
            END IF ! pGrid%e2v

            pgrid%e2cDegr(ieg) = pgrid%e2cDegr(ieg) + 1              

            IF ( ipass == 2 ) THEN               
              iloc = pgrid%e2cStrt(ieg) + pgrid%e2cDegr(ieg) - 1                            
              pgrid%e2c(iloc) = pgrid%pyr2CellGlob(icl)
            END IF ! iPass
          ELSE 
            CALL errorstop(global,err_edgelist_invalid,__line__)                
          END IF ! iloc
        END DO ! iel
      END DO ! icl         
    
! ==============================================================================
!     Determine total size of e2c array, build e2cStrt array
! ==============================================================================
      
      IF ( ipass == 1 ) THEN
        e2csize = 0

        DO ieg = 1,pgrid%nEdgesTot
          e2csize = e2csize + pgrid%e2cDegr(ieg)

          IF ( ieg > 1 ) THEN 
            pgrid%e2cStrt(ieg) = pgrid%e2cStrt(ieg-1) + pgrid%e2cDegr(ieg-1)
          END IF ! ieg
        END DO ! ieg

        IF ( global%myProcid == masterproc .AND. & 
             global%verbLevel >= verbose_high) THEN 
          WRITE(stdout,'(A,5X,A,1X,I9)') solver_name,'Size:',e2csize
        END IF ! global%myProcid

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

        pgrid%e2c(1:e2csize) = 0                   
      END IF ! iPass    
    END DO ! iPass

! ******************************************************************************  
!   Deallocate helper arrays
! ******************************************************************************  
    
    DEALLOCATE(strt,stat=errorflag)
    global%error = errorflag
    IF ( global%error /= err_none ) THEN 
      CALL errorstop(global,err_deallocate,__line__,'strt')
    END IF ! global%error

    DEALLOCATE(degr,stat=errorflag)
    global%error = errorflag
    IF ( global%error /= err_none ) THEN 
      CALL errorstop(global,err_deallocate,__line__,'degr')
    END IF ! global%error    
    
! ******************************************************************************  
!   End 
! ******************************************************************************  
    
    IF ( global%myProcid == masterproc .AND. &
         global%verbLevel >= verbose_high ) THEN   
      WRITE(stdout,'(A,1X,A)') solver_name,'Building edge-to-cell list done.'
    END IF ! global%verbLevel

    CALL deregisterfunction(global)    

  END SUBROUTINE rflu_buildedge2celllist

  
  
     
  
  


! ******************************************************************************
!
! Purpose: Destroy edge list.
!
! Description: None.
!
! Input:
!   pRegion     Pointer to region
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************
  
  SUBROUTINE rflu_destroyedgelist(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_DestroyEdgeList',&
  'RFLU_ModEdgeList.F90')

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

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

    pgrid => pregion%grid  
  
! ******************************************************************************  
!   Deallocate memory
! ******************************************************************************  

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

    CALL rflu_nullifyedgelist(pregion)

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

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

    CALL deregisterfunction(global)

  END SUBROUTINE rflu_destroyedgelist     
  





! ******************************************************************************
!
! Purpose: Destroy edge-to-cell list.
!
! Description: None.
!
! Input:
!   pRegion     Pointer to region
!
! Output: None.
!
! Notes: 
!   1. Test for association status of e2c because it is not created with other 
!      arrays in RFLU_CreateEdge2CellList, but simply allocated in 
!      RFLU_BuildEdge2CellList. This is done because the size is not known at 
!      time of creation.
!
! ******************************************************************************
    
  SUBROUTINE rflu_destroyedge2celllist(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_DestroyEdge2CellList',&
  'RFLU_ModEdgeList.F90')

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

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

      pgrid => pregion%grid  
  
! ******************************************************************************
!   Deallocate memory
! ******************************************************************************

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

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

    IF ( ASSOCIATED(pgrid%e2c) .EQV. .true. ) THEN 
      DEALLOCATE(pgrid%e2c,stat=errorflag) 
      global%error = errorflag   
      IF ( global%error /= err_none ) THEN 
        CALL errorstop(global,err_deallocate,__line__,'pGrid%e2c')
      END IF ! global%error                 
    END IF ! ASSOCIATED
       
! ******************************************************************************
!   Nullify memory
! ******************************************************************************

    CALL rflu_nullifyedge2celllist(pregion)

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

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

    CALL deregisterfunction(global)

  END SUBROUTINE rflu_destroyedge2celllist    





! ******************************************************************************
! End
! ******************************************************************************
  
END MODULE rflu_modedgelist


! ******************************************************************************
!
! RCS Revision history:
!
! $Log: RFLU_ModEdgeList.F90,v $
! Revision 1.13  2008/12/06 08:44:21  mtcampbe
! Updated license.
!
! Revision 1.12  2008/11/19 22:17:32  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.11  2005/04/15 15:06:51  haselbac
! Removed Charm/FEM stuff and RFLU_XyzEdge2RegionDegrList routines
!
! Revision 1.10  2004/10/19 19:27:52  haselbac
! Substantial clean-up
!
! Revision 1.9  2004/07/06 15:14:36  haselbac
! Adapted to changes in libflu and modflu, cosmetics
!                                                         
! Revision 1.8  2004/01/22 16:03:59  haselbac                                            
! Made contents of modules PRIVATE, only procs PUBLIC, to avoid errors on ALC 
! and titan  
!
! Revision 1.7  2004/01/11 02:17:35  jiao                                                
! Eliminated some redundant trailing spaces that made some lines too long.               
! This changed was necessary to compile with NAG F90 compiler.                           
!
! Revision 1.6  2003/08/18 15:30:36  haselbac                                            
! Changed initialization to solve possible problem on Frost                              
!
! Revision 1.5  2003/06/04 22:08:30  haselbac                                            
! Added Nullify routines, some cosmetics                                                 
!
! Revision 1.4  2003/04/02 17:27:35  haselbac                                            
! Changed limits of modified estimate of no of edges                                     
!
! Revision 1.3  2003/03/15 18:05:15  haselbac                                            
! New routines (|| gm), deleted params, bug fix for pyrs                                 
!
! Revision 1.2  2003/01/28 16:27:58  haselbac                                            
! Added creation and destruction, removed renumbering (bcos of                           
! RFLU_InitFlowSolver changes)                                                           
!
! Revision 1.1  2002/10/27 19:08:52  haselbac                                            
! Initial revision                                                                       
!
! ******************************************************************************