RFLU_ModRenumberList.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 renumber and denumber lists.
!
! Description: None.
!
! Notes: None.
!
! ******************************************************************************
!
! $Id: RFLU_ModRenumberList.F90,v 1.6 2008/12/06 08:44:23 mtcampbe Exp $
!
! Copyright: (c) 2004-2005 by the University of Illinois
!
! ******************************************************************************

MODULE rflu_modrenumberlist

  USE moddatatypes
  USE modparameters
  USE moderror
  USE modglobal, ONLY: t_global

  USE modsortsearch

  IMPLICIT NONE
  
  PRIVATE
  PUBLIC :: rflu_denumberlist, & 
            rflu_renumberlist, & 
            rflu_renumberlist2       
  
! ******************************************************************************
! Declarations and definitions
! ******************************************************************************  
        
  CHARACTER(CHRLEN) :: & 
    RCSIdentString = '$RCSfile: RFLU_ModRenumberList.F90,v $ $Revision: 1.6 $' 
              
! ******************************************************************************
! Routines
! ******************************************************************************

  CONTAINS





! ******************************************************************************
!
! Purpose: Denumber list.
!
! Description: None.
!
! Input:
!   global      Global pointer
!   listDim1    Leading dimension of list
!   listDim2    Trailing dimension of list
!   list        List to be denumbered
!   keyDim      Dimension of key
!   key         Key for renumbering
!
! Output: 
!   list        Denumbered list
!
! Notes: None.
!
! ******************************************************************************

  SUBROUTINE rflu_denumberlist(global,listDim1,listDim2,list,keyDim,key)    

    IMPLICIT NONE

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

! ==============================================================================
!   Arguments
! ==============================================================================
  
    INTEGER, INTENT(IN) :: listdim1,listdim2,keydim
    INTEGER, INTENT(INOUT) :: list(listdim1,listdim2)
    INTEGER, INTENT(IN) :: key(keydim)
    TYPE(t_global), POINTER :: global
  
! ==============================================================================
!   Locals
! ==============================================================================

    INTEGER :: i,j,k

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

    CALL registerfunction(global,'RFLU_DenumberList',&
  'RFLU_ModRenumberList.F90')

! ******************************************************************************
!   Denumber list
! ******************************************************************************  

    DO j = 1,listdim2
      DO i = 1,listdim1
        k = list(i,j)

        IF ( k /= vert_none ) THEN         
          IF ( k > keydim ) THEN 
            CALL errorstop(global,err_denumber_list,__line__)
          ELSE         
            list(i,j) = key(k)
          END IF ! k
        END IF ! k
      END DO ! i 
    END DO ! j

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

    CALL deregisterfunction(global)

  END SUBROUTINE rflu_denumberlist




! ******************************************************************************
!
! Purpose: Renumber list.
!
! Description: None.
!
! Input:
!   global      Global pointer
!   listDim1    Leading dimension of list
!   listDim2    Trailing dimension of list
!   list        List to be renumbered
!   keyDim      Dimension of key
!   key         Key for renumbering
!
! Output: 
!   list        Renumbered list
!
! Notes: 
!   1. IMPORTANT: key is assumed to be in ascending order - otherwise binary
!      search will fail.
!
! ******************************************************************************

  SUBROUTINE rflu_renumberlist(global,listDim1,listDim2,list,keyDim,key)    

    IMPLICIT NONE

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

! ==============================================================================
!   Arguments
! ==============================================================================
  
    INTEGER, INTENT(IN) :: listdim1,listdim2,keydim
    INTEGER, INTENT(INOUT) :: list(listdim1,listdim2)
    INTEGER, INTENT(IN) :: key(keydim)
    TYPE(t_global), POINTER :: global
  
! ==============================================================================
!   Locals
! ==============================================================================

    INTEGER :: i,iloc,j,k

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

    CALL registerfunction(global,'RFLU_RenumberList',&
  'RFLU_ModRenumberList.F90')

! ******************************************************************************
!   Renumber list
! ******************************************************************************  

    DO j = 1,listdim2
      DO i = 1,listdim1
        k = list(i,j)

        IF ( k /= vert_none ) THEN 
          CALL binarysearchinteger(key,keydim,k,iloc)

          IF ( iloc /= element_not_found ) THEN 
            list(i,j) = iloc
          ELSE 
            CALL errorstop(global,err_binary_search,__line__)
          END IF ! iLoc  
        END IF ! k
      END DO ! i 
    END DO ! j

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

    CALL deregisterfunction(global)

  END SUBROUTINE rflu_renumberlist








! ******************************************************************************
!
! Purpose: Renumber list based on two keys.
!
! Description: None.
!
! Input:
!   global      Global pointer
!   listDim1    Leading dimension of list
!   listDim2    Trailing dimension of list
!   list        List to be renumbered
!   keyDim      Dimension of key
!   key1        Key for renumbering
!   key2        Second key for renumbering
!
! Output: 
!   list        Renumbered list
!
! Notes: 
!   1. IMPORTANT: key1 is assumed to be in ascending order - otherwise binary
!      search will fail.
!
! ******************************************************************************

  SUBROUTINE rflu_renumberlist2(global,listDim1,listDim2,list,keyDim,key1, & 
                                key2)    

    IMPLICIT NONE

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

! ==============================================================================
!   Arguments
! ==============================================================================
  
    INTEGER, INTENT(IN) :: listdim1,listdim2,keydim
    INTEGER, INTENT(INOUT) :: list(listdim1,listdim2)
    INTEGER, INTENT(IN) :: key1(keydim),key2(keydim)
    TYPE(t_global), POINTER :: global
  
! ==============================================================================
!   Locals
! ==============================================================================

    INTEGER :: i,iloc,j,k

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

    CALL registerfunction(global,'RFLU_RenumberList',&
  'RFLU_ModRenumberList.F90')

! ******************************************************************************
!   Renumber list
! ******************************************************************************  

    DO j = 1,listdim2
      DO i = 1,listdim1
        k = list(i,j)

        IF ( k /= vert_none ) THEN                 
          CALL binarysearchinteger(key1,keydim,k,iloc)

          IF ( iloc /= element_not_found ) THEN 
            list(i,j) = key2(iloc)
          ELSE 
            CALL errorstop(global,err_binary_search,__line__)
          END IF ! iLoc  
        END IF ! k
      END DO ! i 
    END DO ! j

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

    CALL deregisterfunction(global)

  END SUBROUTINE rflu_renumberlist2








! ******************************************************************************
! End
! ******************************************************************************
  
END MODULE rflu_modrenumberlist


! ******************************************************************************
!
! RCS Revision history:
!
! $Log: RFLU_ModRenumberList.F90,v $
! Revision 1.6  2008/12/06 08:44:23  mtcampbe
! Updated license.
!
! Revision 1.5  2008/11/19 22:17:34  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.4  2006/04/07 15:19:20  haselbac
! Removed tabs
!
! Revision 1.3  2006/03/25 21:56:15  haselbac
! Cosmetics only
!
! Revision 1.2  2004/12/04 03:32:20  haselbac
! Added new renumbering routine, used for partitioning
!
! Revision 1.1  2004/10/19 19:27:02  haselbac
! Initial revision
!
! ******************************************************************************