Rocstar-legacy/RFLU__ModHashTable_8F90_source.html

 ! *********************************************************************

 ! * 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 carry out hash table operations.

 !

 ! Description: None.

 !

 ! Notes: To create and use a hash table, one has to take the following steps:

 !   1. Allocate a table of the appropriate size by calling CreateHashTable.

 !      This routine will automatically make the table larger in order to

 !      reduce the number of collisions.

 !   2. Provide a routine which computes a key and call hashKey.

 !   3. Deallocate the table by calling DestroyHashTable.

 !

 ! ******************************************************************************

 !

 ! $Id: RFLU_ModHashTable.F90,v 1.17 2008/12/06 08:44:22 mtcampbe Exp $

 !

 ! Copyright: (c) 2002-2005 by the University of Illinois

 !

 ! ******************************************************************************


 MODULE rflu_modhashtable


   USE moddatatypes

   USE modparameters

   USE moderror

   USE modglobal, ONLY: t_global

   USE modgrid, ONLY: t_grid

   USE modbndpatch, ONLY: t_patch


   IMPLICIT NONE


   PRIVATE :: rflu_findnearestprime, &

              rflu_hashfuncprimary, &

              rflu_hashfuncsecondary


   PUBLIC :: rflu_createhashtable, &

             rflu_destroyhashtable, &

             rflu_hashbuildkey, &

             rflu_hashedge, &

             rflu_hashface, &

             rflu_hashvertex, &

             rflu_hashvertexfancy, &

             rflu_unhashbface


   SAVE


 ! ******************************************************************************

 ! Declarations and definitions

 ! ******************************************************************************


 ! ==============================================================================

 ! Public

 ! ==============================================================================


   INTEGER, PARAMETER, PUBLIC :: HASHTABLE_ENTRYSTATUS_OLD = 0, &

                                 HASHTABLE_ENTRYSTATUS_NEW = 1


   INTEGER, PUBLIC :: hashTableCollisions,hashTableSize

   INTEGER, ALLOCATABLE, DIMENSION(:), PUBLIC :: hashTable


 ! ==============================================================================

 ! Private

 ! ==============================================================================


   INTEGER, PARAMETER, PRIVATE :: HASHTABLE_INIT = 0 ! must be <= 0

   INTEGER, PARAMETER, PRIVATE :: NPRIMES = 48


   INTEGER, PRIVATE :: primeNumbers(NPRIMES) = &

              (/         1,        251,        379,        509, &

                       761,       1021,       1531,       2039, &

                      3067,       4093,       6143,       8191, &

                     12289,      16381,      24571,      32749, &

                     49139,      65521,      98297,     131071, &

                    196613,     262139,     393209,     524287, &

                    786431,    1048573,    1572853,    2097143, &

                   3145721,    4194301,    6291449,    8388593, &

                  12582917,   16777213,   25165807,   33554393, &

                  50331599,   67108859,  100663261,  134217689, &

                 201326549,  268435399,  402653171,  536870909, &

                 805306349, 1073741789, 1610612711, 2147483647   /)


 ! *****************************************************************************

 ! Routines

 ! *****************************************************************************


   CONTAINS


 ! ******************************************************************************

 !

 ! Purpose: Create hash table.

 !

 ! Description: None.

 !

 ! Input:

 !   global      Global pointer

 !   size        Size of hash table

 !

 ! Output: None.

 !

 ! Notes: None.

 !

 ! ******************************************************************************


   SUBROUTINE rflu_createhashtable(global,size)


     IMPLICIT NONE


 ! ******************************************************************************

 !   Declarations and definitions

 ! ******************************************************************************


 ! ==============================================================================

 !   Arguments

 ! ==============================================================================


     INTEGER, INTENT(IN) :: size

     TYPE(t_global), POINTER :: global


 ! ==============================================================================

 !   Local variables

 ! ==============================================================================


     INTEGER :: errorflag,ih


 ! ******************************************************************************

 !   Start

 ! ******************************************************************************


     CALL registerfunction(global,'RFLU_CreateHashTable',&

   'RFLU_ModHashTable.F90')


 ! ******************************************************************************

 !   Find nearest prime

 ! ******************************************************************************


     CALL rflu_findnearestprime(2*size,hashtablesize)


 ! ******************************************************************************

 !   Allocate memory and initialize

 ! ******************************************************************************


     ALLOCATE(hashtable(hashtablesize),stat=errorflag)

     global%error = errorflag

     IF ( global%error /= err_none ) THEN

       CALL errorstop(global,err_allocate,__line__,'hashTable')

     END IF ! global%error


     DO ih = 1,hashtablesize

       hashtable(ih) = hashtable_init

     END DO ! ih


     hashtablecollisions = 0


 ! ******************************************************************************

 !   End

 ! ******************************************************************************


     CALL deregisterfunction(global)


   END SUBROUTINE rflu_createhashtable


 ! ******************************************************************************

 !

 ! Purpose: Destroy hash table

 !

 ! Description: None.

 !

 ! Input:

 !   global      Global pointer

 !

 ! Output: None.

 !

 ! Notes: None.

 !

 ! ******************************************************************************


   SUBROUTINE rflu_destroyhashtable(global)


     IMPLICIT NONE


 ! ******************************************************************************

 !   Declarations and definitions

 ! ******************************************************************************


 ! ==============================================================================

 !   Arguments

 ! ==============================================================================


     TYPE(t_global), POINTER :: global


 ! ==============================================================================

 !   Local variables

 ! ==============================================================================


     INTEGER :: errorflag


 ! ******************************************************************************

 !   Start

 ! ******************************************************************************


     CALL registerfunction(global,'RFLU_DestroyHashTable',&

   'RFLU_ModHashTable.F90')


 ! ******************************************************************************

 !   Deallocate memory

 ! ******************************************************************************


     DEALLOCATE(hashtable,stat=errorflag)

     global%error = errorflag

     IF ( global%error /= err_none ) THEN

       CALL errorstop(global,err_deallocate,__line__,'hashTable')

     END IF ! global%error


 ! ******************************************************************************

 !   End

 ! ******************************************************************************


     CALL deregisterfunction(global)


   END SUBROUTINE rflu_destroyhashtable


 ! ******************************************************************************

 !

 ! Purpose: Find nearest prime for hash table size.

 !

 ! Description: None.

 !

 ! Input:

 !   size        Original size

 !

 ! Output:

 !   primeSize   Nearest prime to original size

 !

 ! Notes: None.

 !

 ! ******************************************************************************


   SUBROUTINE rflu_findnearestprime(size,primeSize)


     IMPLICIT NONE


 ! ******************************************************************************

 !   Declarations and definitions

 ! ******************************************************************************


 ! ==============================================================================

 !   Arguments

 ! ==============================================================================


     INTEGER, INTENT(IN) :: size

     INTEGER, INTENT(OUT) :: primesize


 ! ==============================================================================

 !   Local variables

 ! ==============================================================================


     INTEGER :: i


 ! ******************************************************************************

 !   Start, find nearest prime

 ! ******************************************************************************


     DO i = 1,nprimes-1

       IF ( size >= primenumbers(i) .AND. size < primenumbers(i+1) ) THEN

         primesize = primenumbers(i+1)

         EXIT

       END IF ! size

     END DO ! i


 ! ******************************************************************************

 !   End

 ! ******************************************************************************


   END SUBROUTINE rflu_findnearestprime


 ! ******************************************************************************

 !

 ! Purpose: Compute key from series of integers.

 !

 ! Description: None.

 !

 ! Input:

 !   a           Set of integers

 !   aSize       Size of set of integers

 !

 ! Output:

 !   key         Key

 !

 ! Notes: None.

 !

 ! ******************************************************************************


   SUBROUTINE rflu_hashbuildkey(a,aSize,key)


     IMPLICIT NONE


 ! ******************************************************************************

 !   Declarations and definitions

 ! ******************************************************************************


 ! ==============================================================================

 !   Arguments

 ! ==============================================================================


     INTEGER, INTENT(IN) :: asize

     INTEGER, INTENT(IN) :: a(1:asize)

     INTEGER, INTENT(OUT) :: key


 ! ==============================================================================

 !   Local variables

 ! ==============================================================================


     INTEGER :: i,term

     INTEGER, PARAMETER :: a_rand = 31415, b_rand = 27183


 ! ******************************************************************************

 !   Start, compute key

 ! ******************************************************************************


 !    key = MOD(MOD(A_RAND*B_RAND,hashTableSize)*v1 + v2,HUGE(1)/10)

 !    key = MOD(A_RAND*v1 + B_RAND*v2,hashTableSize)


 ! - ABS function used to guard against negative keys from integer overflow

 !    key = ABS(ABS(A_RAND*v1) + ABS(MOD(A_RAND*B_RAND,hashTableSize)*v2))


     term = a_rand

     key  = 0


     DO i = 1,asize

       term = mod(term*b_rand,hashtablesize)


       IF ( term < 0 ) THEN

         term = term + huge(1) + 1

       END IF ! term


       key  = mod((term*key + a(i)),huge(1))


       IF ( key < 0 ) THEN

         key = key + huge(1) + 1

       END IF ! key

     END DO ! i


 ! ******************************************************************************

 !   End

 ! ******************************************************************************


   END SUBROUTINE rflu_hashbuildkey


 ! ******************************************************************************

 !

 ! Purpose: Compute key from integer.

 !

 ! Description: None.

 !

 ! Input:

 !   a           Integer

 !

 ! Output:

 !   key         Key

 !

 ! Notes: Added as separate function because passing single-element arrays lead

 !   to warnings from Intel f90 compiler.

 !

 ! ******************************************************************************


   SUBROUTINE rflu_hashbuildkey1(a,key)


     IMPLICIT NONE


 ! ******************************************************************************

 !   Declarations and definitions

 ! ******************************************************************************


 ! ==============================================================================

 !   Arguments

 ! ==============================================================================


     INTEGER, INTENT(IN) :: a

     INTEGER, INTENT(OUT) :: key


 ! ==============================================================================

 !   Local variables

 ! ==============================================================================


 ! ******************************************************************************

 !   Start, compute key

 ! ******************************************************************************


     key = mod(a,huge(1))


     IF ( key < 0 ) THEN

       key = key + huge(1) + 1

     END IF ! key


 ! ******************************************************************************

 !   End

 ! ******************************************************************************


   END SUBROUTINE rflu_hashbuildkey1


 ! ******************************************************************************

 !

 ! Purpose: Hash edge.

 !

 ! Description: None.

 !

 ! Input:

 !   key         Key from which address is computed

 !   pGrid       Pointer to grid

 !   v           Edge vertices

 !

 ! Output:

 !   edgeType    Flag indicating whether edge is new or not

 !

 ! Notes: None.

 !

 ! ******************************************************************************


   SUBROUTINE rflu_hashedge(global,key,pGrid,v,edgeType)


     IMPLICIT NONE


 ! ******************************************************************************

 !   Declarations and definitions

 ! ******************************************************************************


 ! ==============================================================================

 !   Arguments

 ! ==============================================================================


     INTEGER, INTENT(IN) :: key

     INTEGER, INTENT(IN) :: v(1:2)

     INTEGER, INTENT(OUT) :: edgetype

     TYPE(t_grid), POINTER :: pgrid

     TYPE(t_global), POINTER :: global


 ! ==============================================================================

 !   Local variables

 ! ==============================================================================


     INTEGER :: addr,collcntr,incr


 ! ******************************************************************************

 !   Start

 ! ******************************************************************************


     CALL registerfunction(global,'RFLU_HashEdge',&

   'RFLU_ModHashTable.F90')


 ! ******************************************************************************

 !   Construct address from key based on sorted edge vertices

 ! ******************************************************************************


     CALL rflu_hashfuncprimary(key,addr)


 ! ******************************************************************************

 !   Insert edge into hash table

 ! ******************************************************************************


     collcntr = 0


     DO

       IF ( hashtable(addr) == hashtable_init ) THEN

         IF ( pgrid%nEdgesTot == pgrid%nEdgesEst ) THEN

           CALL errorstop(global,err_nedges_estimate,__line__)

         END IF ! pGrid%nEdgesTot


         edgetype = edge_type_new


         pgrid%nEdgesTot = pgrid%nEdgesTot + 1

         hashtable(addr) = pgrid%nEdgesTot


         pgrid%e2v(1,pgrid%nEdgesTot) = v(1)

         pgrid%e2v(2,pgrid%nEdgesTot) = v(2)


         EXIT

       ELSE

         IF ( v(1) == pgrid%e2v(1,hashtable(addr)) .AND. &

              v(2) == pgrid%e2v(2,hashtable(addr)) ) THEN

           edgetype = edge_type_old


           EXIT

         ELSE

           hashtablecollisions = hashtablecollisions + 1


           IF ( collcntr == 0 ) THEN

             CALL rflu_hashfuncsecondary(key,incr)

           END IF ! collCntr


           collcntr = collcntr + 1

           addr = mod(addr + incr,hashtablesize)


           IF ( addr == 0 ) THEN

             addr = 1

           END IF

         END IF ! fv


       END IF ! hashTable

     END DO ! <empty>


 ! ******************************************************************************

 !   End

 ! ******************************************************************************


     CALL deregisterfunction(global)


   END SUBROUTINE rflu_hashedge


 ! ******************************************************************************

 !

 ! Purpose: Hash face.

 !

 ! Description: None.

 !

 ! Input:

 !   key         Key from which address is computed

 !   pGrid       Pointer to grid

 !   icg         Global cell number

 !   ifl         Local face number

 !   fv          Face vertices (only three are needed)

 !   nVert       Number of vertices in face (3 = triangle, 4 = quadrilateral)

 !

 ! Output:

 !   faceType    Flag indicating whether face is new or not

 !

 ! Notes: None.

 !

 ! ******************************************************************************


   SUBROUTINE rflu_hashface(global,key,pGrid,icg,ifl,fv,nVert,faceType)


     IMPLICIT NONE


 ! ******************************************************************************

 !   Declarations and definitions

 ! ******************************************************************************


 ! ==============================================================================

 !   Arguments

 ! ==============================================================================


     INTEGER, INTENT(IN) :: icg,ifl,key,nvert

     INTEGER, INTENT(IN) :: fv(1:3)

     INTEGER, INTENT(OUT) :: facetype

     TYPE(t_grid), POINTER :: pgrid

     TYPE(t_global), POINTER :: global


 ! ==============================================================================

 !   Local variables

 ! ==============================================================================


     INTEGER :: addr,collcntr,incr


 ! ******************************************************************************

 !   Start

 ! ******************************************************************************


     CALL registerfunction(global,'RFLU_HashFace',&

   'RFLU_ModHashTable.F90')


 ! ******************************************************************************

 !   Construct address from key based on sorted face vertices

 ! ******************************************************************************


     CALL rflu_hashfuncprimary(key,addr)


 ! ******************************************************************************

 !   Insert face into hash table

 ! ******************************************************************************


     collcntr = 0


     DO


 ! ==============================================================================

 !     Entry not yet occupied

 ! ==============================================================================


       IF ( hashtable(addr) == hashtable_init ) THEN

         IF ( pgrid%nFacesTot == pgrid%nFacesEst ) THEN

           CALL errorstop(global,err_nfaces_estimate,__line__)

         END IF ! pGrid%nFacesTot


         facetype = face_type_new


         pgrid%nFacesTot = pgrid%nFacesTot + 1

         hashtable(addr) = pgrid%nFacesTot


         pgrid%f2c(1  ,pgrid%nFacesTot) = icg

         pgrid%f2c(3  ,pgrid%nFacesTot) = ifl

         pgrid%f2c(4  ,pgrid%nFacesTot) = nvert

         pgrid%f2v(1:3,pgrid%nFacesTot) = fv(1:3)


         EXIT


 ! ==============================================================================

 !     Entry already occupied

 ! ==============================================================================


       ELSE


 ! ------------------------------------------------------------------------------

 !       Entry occupied by same face

 ! ------------------------------------------------------------------------------


         IF ( fv(1) == pgrid%f2v(1,hashtable(addr)) .AND. &

              fv(2) == pgrid%f2v(2,hashtable(addr)) .AND. &

              fv(3) == pgrid%f2v(3,hashtable(addr)) ) THEN

           facetype = face_type_old


           pgrid%f2c(2,hashtable(addr)) = icg


           IF ( pgrid%f2c(4,hashtable(addr)) /= nvert ) THEN

             CALL errorstop(global,err_face_nvert_invalid,__line__)

           END IF ! pGrid%f2c


           EXIT


 ! ------------------------------------------------------------------------------

 !       Entry occupied by some other face: COLLISION

 ! ------------------------------------------------------------------------------


         ELSE

           hashtablecollisions = hashtablecollisions + 1


           IF ( collcntr == 0 ) THEN

             CALL rflu_hashfuncsecondary(key,incr)

           END IF ! collCntr


           collcntr = collcntr + 1

           addr = mod(addr + incr,hashtablesize)


           IF ( addr == 0 ) THEN

             addr = 1

           END IF ! addr

         END IF ! fv


       END IF ! hashTable

     END DO ! <empty>


 ! ******************************************************************************

 !   End

 ! ******************************************************************************


     CALL deregisterfunction(global)


   END SUBROUTINE rflu_hashface


 ! ******************************************************************************

 !

 ! Purpose: Primary hash function: Compute address from key value.

 !

 ! Description: None.

 !

 ! Input:

 !   key         Key from which address is computed

 !

 ! Output:

 !   addr        Address

 !

 ! Notes: None.

 !

 ! ******************************************************************************


   SUBROUTINE rflu_hashfuncprimary(key,addr)


     IMPLICIT NONE


 ! ******************************************************************************

 !   Declarations and definitions

 ! ******************************************************************************


 ! ==============================================================================

 !   Arguments

 ! ==============================================================================


     INTEGER, INTENT(IN) :: key

     INTEGER, INTENT(OUT) :: addr


 ! ******************************************************************************

 !   Start, compute address

 ! ******************************************************************************


 !      addr = 1 ! simple test, will lead to many collisions, but works

     addr = 1 + mod(key,hashtablesize)


 ! ******************************************************************************

 !   End

 ! ******************************************************************************


   END SUBROUTINE rflu_hashfuncprimary


 ! ******************************************************************************

 !

 ! Purpose: Secondary hash function: Compute address from key value

 !

 ! Description: None.

 !

 ! Input:

 !   key         Key from which address is computed

 !

 ! Output:

 !   addr        Address

 !

 ! Notes: None.

 !

 ! ******************************************************************************


   SUBROUTINE rflu_hashfuncsecondary(key,addr)


     IMPLICIT NONE


 ! ******************************************************************************

 !   Declarations and definitions

 ! ******************************************************************************


 ! ==============================================================================

 !   Arguments

 ! ==============================================================================


     INTEGER, INTENT(IN) :: key

     INTEGER, INTENT(OUT) :: addr


 ! ******************************************************************************

 !   Start, compute address

 ! ******************************************************************************


 !      addr = 1 ! simple test, will lead to many collisions, but works

     addr = 1 + mod(key,hashtablesize-2)


 ! ******************************************************************************

 !   End

 ! ******************************************************************************


   END SUBROUTINE rflu_hashfuncsecondary


 ! ******************************************************************************

 !

 ! Purpose: Hash vertex.

 !

 ! Description: None.

 !

 ! Input:

 !   global      Pointer to global type

 !   key         Key from which address is computed

 !   ivg         Global boundary vertex number

 !   nVert       Number of vertices

 !   vert        List of vertices

 !

 ! Output:

 !   nVert       Number of vertices

 !   vert        List of vertices

 !   errorFlag   Error flag (optional)

 !

 ! Notes: None.

 !

 ! ******************************************************************************


   SUBROUTINE rflu_hashvertex(global,key,ivg,nVert,vert,errorFlag)


     IMPLICIT NONE


 ! ******************************************************************************

 !   Declarations and definitions

 ! ******************************************************************************


 ! ==============================================================================

 !   Arguments

 ! ==============================================================================


     INTEGER, INTENT(IN) :: ivg,key

     INTEGER, INTENT(INOUT) :: nvert

     INTEGER, INTENT(OUT), OPTIONAL :: errorflag

     INTEGER, DIMENSION(:), INTENT(INOUT) :: vert

     TYPE(t_patch), POINTER :: ppatch

     TYPE(t_global), POINTER :: global


 ! ==============================================================================

 !   Local variables

 ! ==============================================================================


     INTEGER :: addr,collcntr,incr


 ! ******************************************************************************

 !   Start

 ! ******************************************************************************


     CALL registerfunction(global,'RFLU_HashVertex',&

   'RFLU_ModHashTable.F90')


     IF ( present(errorflag) ) THEN

       errorflag = err_none

     END IF ! PRESENT


 ! ******************************************************************************

 !   Construct address from key

 ! ******************************************************************************


     CALL rflu_hashfuncprimary(key,addr)


 ! ******************************************************************************

 !   Insert vertex into hash table

 ! ******************************************************************************


     collcntr = 0


     emptyloop: DO

       IF ( hashtable(addr) == hashtable_init ) THEN

         IF ( nvert == SIZE(vert,1) ) THEN

           IF ( .NOT. present(errorflag) ) THEN

             CALL errorstop(global,err_nvert_estimate,__line__)

           ELSE

             errorflag = err_none + 1 ! Any value other than ERR_NONE

             EXIT emptyloop

           END IF ! errorFlag

         END IF ! nVert


         hashtable(addr) = ivg

         nvert = nvert + 1


         vert(nvert) = ivg


         EXIT emptyloop

       ELSE

         IF ( hashtable(addr) == ivg ) THEN

           EXIT emptyloop

         ELSE

           hashtablecollisions = hashtablecollisions + 1


           IF ( collcntr == 0 ) THEN

             CALL rflu_hashfuncsecondary(key,incr)

           END IF ! collCntr


           collcntr = collcntr + 1

           addr = mod(addr + incr,hashtablesize)


           IF ( addr == 0 ) THEN

             addr = 1

           END IF

         END IF ! hashTable


       END IF ! hashTable

     END DO emptyloop


 ! ******************************************************************************

 !   End

 ! ******************************************************************************


     CALL deregisterfunction(global)


   END SUBROUTINE rflu_hashvertex


 ! ******************************************************************************

 !

 ! Purpose: Hash vertex and return some information about entry.

 !

 ! Description: None.

 !

 ! Input:

 !   global      Pointer to global type

 !   key         Key from which address is computed

 !   ivg         Global boundary vertex number

 !   nVert       Number of vertices

 !   vert        List of vertices

 !   indx        List of vertex indices

 !

 ! Output:

 !   nVert       Number of vertices

 !   vert        List of vertices

 !   indx        List of vertex indices

 !   ivgStat     Status of vertex entry

 !   ivgIndx     Index of vertex entry

 !

 ! Notes: None.

 !

 ! ******************************************************************************


   SUBROUTINE rflu_hashvertexfancy(global,key,ivg,nVert,vert,indx,ivgStat, &

                                   ivgindx)


     IMPLICIT NONE


 ! ******************************************************************************

 !   Declarations and definitions

 ! ******************************************************************************


 ! ==============================================================================

 !   Arguments

 ! ==============================================================================


     INTEGER, INTENT(IN) :: ivg,key

     INTEGER, INTENT(INOUT) :: nvert

     INTEGER, INTENT(OUT) :: ivgindx,ivgstat

     INTEGER, DIMENSION(:), INTENT(INOUT) :: indx,vert

     TYPE(t_patch), POINTER :: ppatch

     TYPE(t_global), POINTER :: global


 ! ==============================================================================

 !   Local variables

 ! ==============================================================================


     INTEGER :: addr,collcntr,incr


 ! ******************************************************************************

 !   Start

 ! ******************************************************************************


     CALL registerfunction(global,'RFLU_HashVertexFancy',&

   'RFLU_ModHashTable.F90')


 ! ******************************************************************************

 !   Construct address from key

 ! ******************************************************************************


     CALL rflu_hashfuncprimary(key,addr)


 ! ******************************************************************************

 !   Insert vertex into hash table

 ! ******************************************************************************


     collcntr = 0


     DO

       IF ( hashtable(addr) == hashtable_init ) THEN

         IF ( nvert == SIZE(vert,1) ) THEN

           CALL errorstop(global,err_nvert_estimate,__line__)

         END IF ! nVert


         hashtable(addr) = ivg

         nvert = nvert + 1


         vert(nvert) = ivg


         indx(addr) = nvert


         ivgstat = hashtable_entrystatus_new

         ivgindx = crazy_value_int


         EXIT

       ELSE

         IF ( hashtable(addr) == ivg ) THEN

           ivgstat = hashtable_entrystatus_old

           ivgindx = indx(addr)


           EXIT

         ELSE

           hashtablecollisions = hashtablecollisions + 1


           IF ( collcntr == 0 ) THEN

             CALL rflu_hashfuncsecondary(key,incr)

           END IF ! collCntr


           collcntr = collcntr + 1

           addr = mod(addr + incr,hashtablesize)


           IF ( addr == 0 ) THEN

             addr = 1

           END IF

         END IF ! hashTable


       END IF ! hashTable

     END DO ! <empty>


 ! ******************************************************************************

 !   End

 ! ******************************************************************************


     CALL deregisterfunction(global)


   END SUBROUTINE rflu_hashvertexfancy


 ! ******************************************************************************

 !

 ! Purpose: Unhash boundary face to find the global cell number to which the

 !   face is attached.

 !

 ! Description: None.

 !

 ! Input:

 !   key         Key from which address is computed

 !   pGrid       Pointer to grid

 !   fv          Face vertices (only three are needed)

 !   nVert       Number of vertices in face (3 = triangle, 4 = quadrilateral)

 !   bcType      Boundary-condition type assigned to face

 !

 ! Output:

 !   icg         Global cell number to which boundary face is attached

 !   ifg         Global face number

 !

 ! Notes: None.

 !

 ! ******************************************************************************


   SUBROUTINE rflu_unhashbface(global,key,pGrid,fv,nVert,bcType,icg,ifg)


     IMPLICIT NONE


 ! ******************************************************************************

 !   Declarations and definitions

 ! ******************************************************************************


 ! ==============================================================================

 !   Arguments

 ! ==============================================================================


     INTEGER, INTENT(IN) :: bctype,key,nvert

     INTEGER, INTENT(IN) :: fv(1:3)

     INTEGER, INTENT(OUT) :: icg,ifg

     TYPE(t_grid), POINTER :: pgrid

     TYPE(t_global), POINTER :: global


 ! ==============================================================================

 !   Local variables

 ! ==============================================================================


     INTEGER :: addr,collcntr,fvsize,incr


 ! ******************************************************************************

 !   Start

 ! ******************************************************************************


     CALL registerfunction(global,'RFLU_UnHashBFace',&

   'RFLU_ModHashTable.F90')


 ! ******************************************************************************

 !   Construct address from key based on sorted face vertices

 ! ******************************************************************************


     CALL rflu_hashfuncprimary(key,addr)


 ! ******************************************************************************

 !   Insert face into hash table

 ! ******************************************************************************


     collcntr = 0


     DO

       ifg = hashtable(addr)


 ! ==============================================================================

 !     Entry not occupied, must have error in hash table

 ! ==============================================================================


       IF ( ifg == hashtable_init ) THEN

         CALL errorstop(global,err_hashtable,__line__)


 ! ==============================================================================

 !     Entry occupied

 ! ==============================================================================


       ELSE


 ! ------------------------------------------------------------------------------

 !       No collision if vertices match

 ! ------------------------------------------------------------------------------


         IF ( fv(1) == pgrid%f2v(1,ifg) .AND. &

              fv(2) == pgrid%f2v(2,ifg) .AND. &

              fv(3) == pgrid%f2v(3,ifg) ) THEN

           icg = pgrid%f2c(1,ifg)


 ! ------- If second entry IS NOT exterior cell (as initialized), then have error

 !         unless face is on symmetry or periodic patch, because there have

 !         virtual cells adjacent to patch


           IF ( pgrid%f2c(2,ifg) /= cell_type_ext ) THEN

             IF ( bctype /= bc_symmetry .AND. bctype /= bc_periodic ) THEN

               CALL errorstop(global,err_hashtable,__line__)

             END IF ! bcType


 ! ------- If second entry IS interior cell (as initialized), then only set to

 !         boundary cell type if face is not symmetry or periodic patch. This is

 !         done to make sure this boundary face shows up as a VX face in the

 !         final face list which is has to to get geometry correct. In the

 !         sketch below, the face in question is marked by '+'. This face MUST

 !         show up as a VX face. If it is marked as a VB face, it does not show

 !         up in the main facelist, and is then eliminated from the geometry

 !         computation because any faces (actual and virtual) are ignored

 !         (this is done because the AV and VV faces associated with sype

 !         patches appear on the patch face list AND in the volume face list).

 !         But by ignoring these faces, also do not get contribution of face

 !         marked below and geometry is incorrect. With the treatment below,

 !         have this face appear twice also, and this treatment thus not only

 !         fixes geometry computation problem, but is also more consistent with

 !         existing treatment.

 !

 !                |         |         |

 !                | virtual |  real   |  real

 !               vx  cell  av  cell  aa  cell

 !                |         |         |

 !                |         |         |

 !                |+++vx++++|---av----|------   <--- sype patch

 !                          |         |

 !                          | virtual | virtual

 !                          |  cell  vv  cell

 !                          |         |

 !                          |---vx----|------

 !


           ELSE

             IF ( bctype /= bc_symmetry .AND. bctype /= bc_periodic ) THEN

               pgrid%f2c(2,ifg) = cell_type_bnd

             ELSE

               IF ( icg <= pgrid%nCells ) THEN

                 pgrid%f2c(2,ifg) = cell_type_bnd

               END IF ! icg

             END IF ! bcType

           END IF ! pGrid%f2c


           IF ( pgrid%f2c(4,ifg) /= nvert ) THEN

             CALL errorstop(global,err_face_nvert_invalid,__line__)

           END IF ! pGrid%f2c


           EXIT


 ! ------------------------------------------------------------------------------

 !       Collision if vertices do not match, generate new key and address

 ! ------------------------------------------------------------------------------


         ELSE

           IF ( collcntr == 0 ) THEN

             CALL rflu_hashfuncsecondary(key,incr)

           END IF ! collCntr


           collcntr = collcntr + 1

           addr = mod(addr + incr,hashtablesize)


           IF ( addr == 0 ) THEN

             addr = 1

           END IF

         END IF ! fv


       END IF ! hashTable

     END DO ! <empty>


 ! ******************************************************************************

 !   End

 ! ******************************************************************************


     CALL deregisterfunction(global)


   END SUBROUTINE rflu_unhashbface


 ! ******************************************************************************

 ! End

 ! ******************************************************************************


 END MODULE rflu_modhashtable


 ! ******************************************************************************

 !

 ! RCS Revision history:

 !

 ! $Log: RFLU_ModHashTable.F90,v $

 ! Revision 1.17  2008/12/06 08:44:22  mtcampbe

 ! Updated license.

 !

 ! Revision 1.16  2008/11/19 22:17:33  mtcampbe

 ! Added Illinois Open Source License/Copyright

 !

 ! Revision 1.15  2007/07/08 21:45:03  gzheng

 ! changed the PRESENT is used for PGI compiler

 !

 ! Revision 1.14  2006/12/15 13:24:20  haselbac

 ! Added new RFLU_HashBuildKey1 for single integers to avoid ifort warnings

 !

 ! Revision 1.13  2006/04/17 19:53:37  haselbac

 ! Bug fix: For serial cells, opposite cell should be BND, not EXT

 !

 ! Revision 1.12  2006/04/13 18:09:19  haselbac

 ! Bug fix: Treatment of virtual faces on sype patches

 !

 ! Revision 1.11  2006/04/07 15:19:19  haselbac

 ! Removed tabs

 !

 ! Revision 1.10  2006/03/25 21:53:29  haselbac

 ! Changes because of sype patches

 !

 ! Revision 1.9  2005/06/14 17:46:56  haselbac

 ! Adapted RFLU_HashVertex to return optional error flag

 !

 ! Revision 1.8  2005/04/21 01:36:26  haselbac

 ! Added routine which returns info, in particular if element already hashed

 !

 ! Revision 1.7  2004/12/04 03:31:04  haselbac

 ! Changed RFLU_HashBVertex so can be used for any type of vertex list

 !

 ! Revision 1.6  2004/07/06 15:14:42  haselbac

 ! Added subroutines for hashing objects, cosmetics

 !

 ! Revision 1.5  2004/01/22 16:03:59  haselbac

 ! Made contents of modules PRIVATE, only procs PUBLIC, to avoid errors on ALC   and titan

 !

 ! Revision 1.4  2003/12/04 03:28:48  haselbac

 ! Increase size of hash table to avoid degeneracy for one case

 !

 ! Revision 1.3  2002/10/08 15:49:21  haselbac

 ! {IO}STAT=global%error replaced by {IO}STAT=errorFlag - SGI problem

 !

 ! Revision 1.2  2002/09/09 15:08:11  haselbac

 ! global now under regions

 !

 ! Revision 1.1  2002/03/01 16:31:21  haselbac

 ! Initial revision

 !

 ! ******************************************************************************


modglobal
Definition: ModGlobal.F90:39

rflu_modhashtable::rflu_hashfuncprimary
subroutine, private rflu_hashfuncprimary(key, addr)
Definition: RFLU_ModHashTable.F90:732

modparameters
Definition: ModParameters.F90:42

rflu_modhashtable::rflu_createhashtable
subroutine, public rflu_createhashtable(global, size)
Definition: RFLU_ModHashTable.F90:131

rflu_modhashtable::rflu_hashedge
subroutine, public rflu_hashedge(global, key, pGrid, v, edgeType)
Definition: RFLU_ModHashTable.F90:474

rflu_modhashtable::rflu_destroyhashtable
subroutine, public rflu_destroyhashtable(global)
Definition: RFLU_ModHashTable.F90:210

Kdtree_d::ExtPoint::term
void term()
Definition: kdtree_d.h:237

rflu_modhashtable::rflu_hashbuildkey1
subroutine rflu_hashbuildkey1(a, key)
Definition: RFLU_ModHashTable.F90:416

modbndpatch
Definition: ModBndPatch.F90:39

moderror::registerfunction
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449

rflu_modhashtable::rflu_hashbuildkey
subroutine, public rflu_hashbuildkey(a, aSize, key)
Definition: RFLU_ModHashTable.F90:339

Roccom_map::size
int size() const
Definition: maps.h:78

rflu_modhashtable::rflu_unhashbface
subroutine, public rflu_unhashbface(global, key, pGrid, fv, nVert, bcType, icg, ifg)
Definition: RFLU_ModHashTable.F90:1084

modgrid::t_grid
Definition: ModGrid.F90:56

rflu_modhashtable::rflu_hashfuncsecondary
subroutine, private rflu_hashfuncsecondary(key, addr)
Definition: RFLU_ModHashTable.F90:782

v
*********************************************************************Illinois Open Source License ****University of Illinois NCSA **Open Source License University of Illinois All rights reserved ****Developed free of to any person **obtaining a copy of this software and associated documentation to deal with the Software without including without limitation the rights to and or **sell copies of the and to permit persons to whom the **Software is furnished to do subject to the following this list of conditions and the following disclaimers ****Redistributions in binary form must reproduce the above **copyright this list of conditions and the following **disclaimers in the documentation and or other materials **provided with the distribution ****Neither the names of the Center for Simulation of Advanced the University of nor the names of its **contributors may be used to endorse or promote products derived **from this Software without specific prior written permission ****THE SOFTWARE IS PROVIDED AS WITHOUT WARRANTY OF ANY **EXPRESS OR INCLUDING BUT NOT LIMITED TO THE WARRANTIES **OF FITNESS FOR A PARTICULAR PURPOSE AND **NONINFRINGEMENT IN NO EVENT SHALL THE CONTRIBUTORS OR **COPYRIGHT HOLDERS BE LIABLE FOR ANY DAMAGES OR OTHER WHETHER IN AN ACTION OF TORT OR **ARISING OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE **USE OR OTHER DEALINGS WITH THE SOFTWARE v
Definition: roccomf90.h:20

rflu_modhashtable::rflu_hashvertexfancy
subroutine, public rflu_hashvertexfancy(global, key, ivg, nVert, vert, indx, ivgStat, ivgIndx)
Definition: RFLU_ModHashTable.F90:962

i
blockLoc i
Definition: read.cpp:79

rflu_modhashtable::rflu_findnearestprime
subroutine, private rflu_findnearestprime(size, primeSize)
Definition: RFLU_ModHashTable.F90:279

Node::addr
const void * addr(const COM::Attribute *attr) const
Obtain the address of an attribute associated with the node.
Definition: Manifold_2.C:1191

modglobal::t_global
Definition: ModGlobal.F90:50

moderror::errorstop
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483

rflu_modhashtable
Definition: RFLU_ModHashTable.F90:44

key
static T_Key key
Definition: vinci_lass.c:76

moderror::deregisterfunction
subroutine deregisterfunction(global)
Definition: ModError.F90:469

rflu_modhashtable::rflu_hashface
subroutine, public rflu_hashface(global, key, pGrid, icg, ifl, fv, nVert, faceType)
Definition: RFLU_ModHashTable.F90:591

moddatatypes
Definition: ModDataTypes.F90:40

moderror
Definition: ModError.F90:39

rflu_modhashtable::rflu_hashvertex
subroutine, public rflu_hashvertex(global, key, ivg, nVert, vert, errorFlag)
Definition: RFLU_ModHashTable.F90:838

Line_2::a
RT a() const
Definition: Line_2.h:140

Mesh::GenericCell_2::nvert
IndexType nvert() const
Definition: Mesh.H:565

modgrid
Definition: ModGrid.F90:39

modbndpatch::t_patch
Definition: ModBndPatch.F90:91