RFLU_PrintLocInfo.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: Print out locations of cells (in terms of coordinates and whether
!   they are interior or boundary cells)
!
! Description: None.
!
! Input: 
!   pRegion             Pointer to region
!   locUnsorted         Unsorted location array
!   nLocUnsorted        First dimension of locUnsorted array
!   locInfoMode         Indicating verbosity of output 
!   outputMode          Indicating who may write to screen
! 
! Output: N/A.
!
! Notes: 
!   1. Yes yes yes, GOTO is not very nice, but it does the job here...
!   2. Introduced additional argument so that do not get a lot of information 
!      on cell connectivity and vertex coordinates every time this routine 
!      is called. The additional information is mainly interesting if running 
!      with grid motion.
!   3. The additional information on cell connectivity and vertex coordinates
!      can be useful because a cell may not a boundary cell, but still contain
!      vertices which are on boundary...
!
! ******************************************************************************
!
! $Id: RFLU_PrintLocInfo.F90,v 1.18 2008/12/06 08:44:12 mtcampbe Exp $
!
! Copyright: (c) 2000-2004 by the University of Illinois
!
! ******************************************************************************

SUBROUTINE rflu_printlocinfo(pRegion,locUnsorted,nLocUnsorted,locInfoMode, & 
                             outputmode)

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

  USE modbndpatch, ONLY: t_patch
  USE moddatastruct, ONLY: t_region
  USE modgrid, ONLY: t_grid
  USE modsortsearch

  IMPLICIT NONE
  
! ******************************************************************************
! Declarations and definitions
! ******************************************************************************  
  
! ==============================================================================
! Parameters
! ==============================================================================   
  
  INTEGER, INTENT(IN) :: locinfomode,nlocunsorted,outputmode
  INTEGER, INTENT(INOUT) :: locunsorted(1:nlocunsorted,min_val:max_val)
  TYPE(t_region), POINTER :: pregion
  
! ==============================================================================
! Local variables
! ==============================================================================

  LOGICAL :: outputflag
  CHARACTER(CHRLEN) :: celltypestring,locstring,rcsidentstring,tempstring
  INTEGER :: errorflag,il,ib,ic,iccntr,icflag,icl,ict,id,ipatch,iv,ivcntr, &
             ivflag,ivg,jl,nlocsorted,nlocsortedest,nvertsimplified, &
             nvertunsorted,vlen
  INTEGER :: v(8)
  INTEGER, DIMENSION(:), ALLOCATABLE :: bf2csorted,locsorted,locbound, & 
                                        vertsorted,vertunsorted
  TYPE(t_patch), POINTER :: ppatch
  TYPE(t_global), POINTER :: global
  TYPE(t_grid), POINTER :: pgrid

  rcsidentstring = '$RCSfile: RFLU_PrintLocInfo.F90,v $ $Revision: 1.18 $'

! ******************************************************************************
! Start, set output flag
! ******************************************************************************

  global => pregion%global

  CALL registerfunction(global,'RFLU_PrintLocInfo',&
  'RFLU_PrintLocInfo.F90')

  IF ( outputmode == output_mode_master_only ) THEN 
    outputflag = (global%myProcid == masterproc)
  ELSE IF ( outputmode == output_mode_anybody ) THEN 
    outputflag = .true.
  ELSE 
    CALL errorstop(global,err_reached_default,__line__)
  END IF ! outputMode

  IF ( (outputflag .EQV. .true.) .AND. &
       global%verbLevel >= verbose_high ) THEN        
    WRITE(stdout,'(A,1X,A)') solver_name,'Printing location information...'
    WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', & 
                                     pregion%iRegionGlobal 
  END IF ! global

! ==============================================================================
! Set grid pointer
! ==============================================================================

  pgrid => pregion%grid

! ==============================================================================
! Check whether cell centroids allocated and computed
! ==============================================================================

  IF ( ASSOCIATED(pgrid%cofg) .EQV. .false. ) THEN
    global%warnCounter = global%warnCounter + 1  
  
    IF ( (outputflag .EQV. .true.) .AND. &
         global%verbLevel >= verbose_none ) THEN 
      WRITE(stdout,'(A,3X,A,1X,A,1X,A)') solver_name, & 
                   '*** WARNING *** Array cofg not allocated.', &
                   'Returning to calling procedure.'
    END IF ! global

    goto 1
  END IF ! ASSOCIATED
  
  IF ( (minval(pgrid%cofg) == 0.0_rfreal) .AND. & 
       (maxval(pgrid%cofg) == 0.0_rfreal) ) THEN
    global%warnCounter = global%warnCounter + 1       
        
    IF ( (outputflag .EQV. .true.) .AND. &
         global%verbLevel >= verbose_none ) THEN        
      WRITE(stdout,'(A,3X,A,1X,A,1X,A)') solver_name,'*** WARNING ***', & 
                   'Geometry apparently not computed yet.', & 
                   'Returning to calling procedure.'
    END IF ! global 
    
    goto 1         
  END IF ! MINVAL

! ==============================================================================
! Check whether boundary face data structure allocated and meaningful
! ==============================================================================
  
  DO ipatch = 1,pgrid%nPatches
    ppatch => pregion%patches(ipatch)      
    
    IF ( ASSOCIATED(ppatch%bf2c) .EQV. .false. ) THEN
      global%warnCounter = global%warnCounter + 1    
    
      IF ( (outputflag .EQV. .true.) .AND. &
           global%verbLevel >= verbose_none ) THEN        
        WRITE(stdout,'(A,3X,A,1X,A)') solver_name, &
                     '*** WARNING *** Array bf2c not allocated.', & 
                     'Returning to calling procedure.'
      END IF ! global
      
      goto 1      
    END IF ! ASSOCIATED
    
    IF ( (minval(ppatch%bf2c) == 0) .AND. (maxval(ppatch%bf2c) == 0) ) THEN
      global%warnCounter = global%warnCounter + 1    
    
      IF ( (outputflag .EQV. .true.) .AND. &
           global%verbLevel >= verbose_none ) THEN        
        WRITE(stdout,'(A,3X,A,1X,A)') solver_name, &
                     '*** WARNING *** Array bf2c apparently not yet filled.', & 
                     'Returning to calling procedure.'
      END IF ! global
      
      goto 1   
    END IF ! ASSOCIATED    
  END DO ! iPatch

! ******************************************************************************
! Sort and merge array of extrema locations
! ******************************************************************************

  CALL quicksortinteger(locunsorted(1:nlocunsorted,min_val),nlocunsorted)
  CALL quicksortinteger(locunsorted(1:nlocunsorted,max_val),nlocunsorted)

  nlocsortedest = 2*nlocunsorted

  ALLOCATE(locsorted(nlocsortedest),stat=errorflag)
  global%error = errorflag    
  IF ( global%error /= err_none ) THEN 
    CALL errorstop(global,err_allocate,__line__,'locSorted')
  END IF ! global%error
  
  locsorted(:) = 0
     
  CALL mergesortedintegers(global,nlocunsorted,nlocunsorted, & 
                           locunsorted(1:nlocunsorted,min_val), & 
                           locunsorted(1:nlocunsorted,max_val), & 
                           nlocsortedest,nlocsorted,locsorted)
                                                 
  IF ( (outputflag .EQV. .true.) .AND. &
       global%verbLevel >= verbose_high ) THEN  
    WRITE(stdout,'(A,3X,A)') solver_name,'Cell location information:'                                 
    WRITE(stdout,'(A,6X,A,6X,A,3X,A,2(4X,A),3X,A)') solver_name,'#','Cell', & 
                 'x-coordinate','y-coordinate','z-coordinate','Location'
  END IF ! global
  
! ******************************************************************************
! Loop over locations, determine more information on cells
! ******************************************************************************

  ALLOCATE(locbound(pgrid%nPatches),stat=errorflag)
  global%error = errorflag    
  IF ( global%error /= err_none ) THEN 
    CALL errorstop(global,err_allocate,__line__,'locBound')
  END IF ! global%error

  DO il = 1,nlocsorted
    ic = locsorted(il)
    
    iccntr = 0
    
! ==============================================================================
!   Loop over boundary face-to-cell lists and search for cell. NOTE bf2c list 
!   is not sorted, so need to sort first for binary search to work.
! ==============================================================================    
        
    DO ipatch = 1,pgrid%nPatches
      ppatch => pregion%patches(ipatch)
            
      IF ( ppatch%nBFaces > 0 ) THEN 
        ALLOCATE(bf2csorted(ppatch%nBFaces),stat=errorflag)
        global%error = errorflag
        IF ( global%error /= err_none ) THEN 
          CALL errorstop(global,err_allocate,__line__,'bf2cSorted')
        END IF ! global%error

        bf2csorted(1:ppatch%nBFaces) = ppatch%bf2c(1:ppatch%nBFaces)

        CALL quicksortinteger(bf2csorted,ppatch%nBFaces)      
        CALL binarysearchinteger(bf2csorted,ppatch%nBFaces,ic,icflag)

        IF ( icflag /= element_not_found ) THEN ! vertex found
          iccntr = iccntr + 1 
          locbound(iccntr) = ppatch%iPatchGlobal        
        END IF ! ivFlag
        
        DEALLOCATE(bf2csorted,stat=errorflag)
        global%error = errorflag
        IF ( global%error /= err_none ) THEN 
          CALL errorstop(global,err_deallocate,__line__,'bf2cSorted')
        END IF ! global%error        
      END IF ! pPatch%nBFaces
    END DO ! iPatch  
          
! ==============================================================================
!   Cell found, write out information
! ==============================================================================          
          
    IF ( iccntr == 0 ) THEN ! interior cell
      WRITE(locstring,'(A)') 'Interior'
    ELSE ! cell adjacent to patch
      IF ( iccntr == 1 ) THEN 
        WRITE(locstring,'(A,1X,I3)') 'Global patch:',locbound(iccntr)
      ELSE
        WRITE(locstring,'(A)') 'Global patches: '
        DO jl = 1,iccntr
          WRITE(tempstring,'(1X,I3)') locbound(jl)
          locstring = trim(locstring)//trim(tempstring)
        END DO ! jl
      END IF ! icCntr
    END IF ! icCntr       
          
    IF ( (outputflag .EQV. .true.) .AND. &
         global%verbLevel >= verbose_high ) THEN       
      WRITE(stdout,'(A,4X,I3,1X,I9,3(1X,E15.8),2X,A)') solver_name,il,ic, & 
                   pgrid%cofg(xcoord:zcoord,ic),trim(locstring)
    END IF ! global
  END DO ! il

! ******************************************************************************
! If in verbose mode, print more information
! ******************************************************************************

  IF ( locinfomode == locinfo_mode_verbose ) THEN 

! ==============================================================================
!   Determine more information on vertices which make up cells
! ==============================================================================

    IF ( (outputflag .EQV. .true.) .AND. &
         global%verbLevel >= verbose_high ) THEN 
      WRITE(stdout,'(A,3X,A,2(1X,A))') solver_name,'Cell connectivity', &
                                       'information:'
      WRITE(stdout,'(A,6X,A,6X,A,2X,A,24X,A)') solver_name,'#','Cell', & 
                                               'Type','Vertices'                                 
    END IF ! global

    ALLOCATE(vertunsorted(8*nlocsorted),stat=errorflag)
    global%error = errorflag    
    IF ( global%error /= err_none ) THEN 
      CALL errorstop(global,err_allocate,__line__,'vertUnsorted')
    END IF ! global%error

    nvertunsorted = 0

    DO il = 1,nlocsorted
      ic = locsorted(il)

      ict = pgrid%cellGlob2Loc(1,ic)
      icl = pgrid%cellGlob2Loc(2,ic) 

      SELECT CASE ( ict ) 
        CASE ( cell_type_tet ) 
          celltypestring = 'Tetrahedron'
          vlen = 4
          v(1:vlen) = pgrid%tet2v(1:vlen,icl)

          IF ( (outputflag .EQV. .true.) .AND. &
               global%verbLevel >= verbose_high ) THEN       
            WRITE(stdout,'(A,4X,I3,1X,I9,2X,A11,4(1X,I9))') solver_name,il, & 
                  ic,celltypestring,v(1:vlen)
          END IF ! global  

          vertunsorted(nvertunsorted+1:nvertunsorted + vlen) = v(1:vlen)
          nvertunsorted = nvertunsorted + vlen                                
        CASE ( cell_type_hex )
          celltypestring = 'Hexahedron' 
          vlen = 8 
          v(1:vlen) = pgrid%hex2v(1:vlen,icl) 

          IF ( (outputflag .EQV. .true.) .AND. &
               global%verbLevel >= verbose_high ) THEN       
            WRITE(stdout,'(A,4X,I3,1X,I9,2X,A11,8(1X,I9))') solver_name,il, & 
                  ic,celltypestring,v(1:vlen)
          END IF ! global    

          vertunsorted(nvertunsorted+1:nvertunsorted + vlen) = v(1:vlen)
          nvertunsorted = nvertunsorted + vlen                          
        CASE ( cell_type_pri ) 
          celltypestring = 'Prism'

          vlen = 6 
          v(1:vlen) = pgrid%pri2v(1:vlen,icl) 

          IF ( (outputflag .EQV. .true.) .AND. &
               global%verbLevel >= verbose_high ) THEN       
            WRITE(stdout,'(A,4X,I3,1X,I9,2X,A11,6(1X,I9))') solver_name,il, & 
                  ic,celltypestring,v(1:vlen)
          END IF ! global        

          vertunsorted(nvertunsorted+1:nvertunsorted + vlen) = v(1:vlen)
          nvertunsorted = nvertunsorted + vlen                              
        CASE ( cell_type_pyr ) 
          celltypestring = 'Pyramid'          

          vlen = 5
          v(1:vlen) = pgrid%pyr2v(1:vlen,icl) 

          IF ( (outputflag .EQV. .true.) .AND. &
               global%verbLevel >= verbose_high ) THEN       
            WRITE(stdout,'(A,4X,I3,1X,I9,2X,A11,5(1X,I9))') solver_name,il, & 
                  ic,celltypestring,v(1:vlen)
          END IF ! global                

          vertunsorted(nvertunsorted+1:nvertunsorted + vlen) = v(1:vlen)
          nvertunsorted = nvertunsorted + vlen          
        CASE default
          CALL errorstop(global,err_reached_default,__line__)
      END SELECT ! ict
    END DO ! il

! ==============================================================================
!   Printing vertex information
! ==============================================================================

    IF ( (outputflag .EQV. .true.) .AND. &
         global%verbLevel >= verbose_high ) THEN 
      WRITE(stdout,'(A,3X,A,2(1X,A))') solver_name,'Vertex location', & 
                                       'information:'       
      WRITE(stdout,'(A,6X,A,4X,A,3X,A,2(4X,A),3X,A)') solver_name,'#', & 
            'Vertex','x-coordinate','y-coordinate','z-coordinate','Location'
    END IF ! global

    CALL quicksortinteger(vertunsorted,nvertunsorted)
    CALL simplifysortedintegers(vertunsorted,nvertunsorted,nvertsimplified)

    DO iv = 1,nvertsimplified
      ivg = vertunsorted(iv)

! ------------------------------------------------------------------------------
!     Loop over boundary vertex lists and search for vertex
! ------------------------------------------------------------------------------    
     
      ivcntr = 0 

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

        IF ( ppatch%nBVert > 0 ) THEN
          CALL binarysearchinteger(ppatch%bv,ppatch%nBVert,ivg,ivflag)
        ELSE 
          ivflag = element_not_found
        END IF ! pPatch%nBVert

        IF ( ivflag /= element_not_found ) THEN ! vertex found
          ivcntr = ivcntr + 1 
          locbound(ivcntr) = ipatch
        END IF ! ivFlag
      END DO ! iPatch  

! ------------------------------------------------------------------------------    
!     Vertex found, write out information
! ------------------------------------------------------------------------------    
          
      IF ( ivcntr == 0 ) THEN ! interior vertex
        WRITE(locstring,'(A)') 'Interior'
      ELSE ! boundary vertex
        IF ( ivcntr == 1 ) THEN 
          WRITE(locstring,'(A,1X,I3)') 'Boundary:',locbound(ivcntr)
        ELSE
          WRITE(locstring,'(A)') 'Boundaries: '
          DO jl = 1,ivcntr
            WRITE(tempstring,'(1X,I3)') locbound(jl)
            locstring = trim(locstring)//trim(tempstring)
          END DO ! jl
        END IF ! ivCntr
      END IF ! ivCntr       

      IF ( (outputflag .EQV. .true.) .AND. &
           global%verbLevel >= verbose_high ) THEN       
        WRITE(stdout,'(A,4X,I3,1X,I9,3(1X,E15.8),2X,A)') solver_name,iv, & 
              ivg,pgrid%xyz(xcoord:zcoord,ivg),trim(locstring)
      END IF ! global
    END DO ! iv  

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

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

  DEALLOCATE(locsorted,stat=errorflag)
  global%error = errorflag  
  IF ( global%error /= err_none ) THEN 
    CALL errorstop(global,err_deallocate,__line__,'locSorted')
  END IF ! global%error  
  
1 CONTINUE    
  
! ******************************************************************************
! End
! ******************************************************************************
  
  IF ( (outputflag .EQV. .true.) .AND. &
       global%verbLevel >= verbose_high ) THEN   
    WRITE(stdout,'(A,1X,A)') solver_name,'Printing location information done.'  
  END IF ! global
  
  CALL deregisterfunction(global)    
  
END SUBROUTINE rflu_printlocinfo

! ******************************************************************************
!
! RCS Revision history:
!
! $Log: RFLU_PrintLocInfo.F90,v $
! Revision 1.18  2008/12/06 08:44:12  mtcampbe
! Updated license.
!
! Revision 1.17  2008/11/19 22:17:25  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.16  2006/04/07 15:19:16  haselbac
! Removed tabs
!
! Revision 1.15  2005/03/23 17:08:02  haselbac
! Bug fix: Only call search when have nonzero vertices
!
! Revision 1.14  2004/10/19 19:25:12  haselbac
! Cosmetics only
!                                     
! Revision 1.13  2003/12/04 03:23:57  haselbac                        
! Changed formatting of output                                        
!
! Revision 1.12  2003/07/22 01:57:21  haselbac                        
! Added global%warnCounter and changed ip to iPatch                   
!
! Revision 1.11  2003/06/04 22:42:08  haselbac                        
! Added argument to indicate who can write to screen                  
!
! Revision 1.10  2003/04/28 22:40:26  haselbac                        
! Changed region to pRegion, was actually a bug                       
!
! Revision 1.9  2003/03/15 17:05:58  haselbac                         
! Added argument, 2 bug fixes, increased output                       
!
! Revision 1.8  2003/01/28 15:40:00  haselbac                         
! Cosmetics only                                                      
!
! Revision 1.7  2002/10/27 18:53:41  haselbac                         
! Changed declaration of locUnsorted                                  
!
! Revision 1.6  2002/10/17 19:57:57  haselbac                         
! Cosmetic changes to output                                          
!
! Revision 1.5  2002/10/08 15:48:56  haselbac                         
! {IO}STAT=global%error replaced by {IO}STAT=errorFlag - SGI problem  
!
! Revision 1.4  2002/10/05 18:48:20  haselbac                         
! Cosmetic changes to output formatting                               
!
! Revision 1.3  2002/09/09 14:15:01  haselbac                         
! global now under regions, changed interface to MergeSortedIntegers  
!
! Revision 1.2  2002/06/17 13:31:22  haselbac                         
! Prefixed SOLVER_NAME to all screen output                           
!
! Revision 1.1  2002/05/04 16:09:00  haselbac                         
! Initial revision                                                    
!
! ******************************************************************************