rflupick.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: Driver routine for rflupick.
!
! Description: None.
!
! Input: 
!   caseString  String with casename
!   stampString String with iteration or time stamp
!   verbLevel   Verbosity level
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************
!
! $Id: rflupick.F90,v 1.14 2008/12/06 08:45:04 mtcampbe Exp $
!
! Copyright: (c) 2003-2006 by the University of Illinois
!
! ******************************************************************************

SUBROUTINE rflupick(caseString,stampString,verbLevel)

  USE moddatatypes
  USE modglobal, ONLY: t_global 
  USE moderror
  USE moddatastruct, ONLY: t_level,t_region
  USE modbndpatch, ONLY: t_patch
  USE modmixture, ONLY: t_mixt_input
  USE modbndpatch, ONLY: t_patch
  USE modparameters
  USE modmpi
  
  USE rflu_modboundlists
  USE rflu_modcellmapping
  USE rflu_moddimensions
  USE rflu_modfacelist
  USE rflu_modgeometry
  USE rflu_modreadbcinputfile
  USE rflu_modreadwritegrid
  USE rflu_modregionmapping
  USE rflu_modstencilsbfaces
  USE rflu_modstencilscells
  USE rflu_modstencilsfaces
  USE rflu_modstencilsutils
  USE rflu_modstencilsvert
  USE rflu_modvertexlists
  
  USE modinterfaces, ONLY: rflu_builddatastruct, &
                           rflu_closepostinfo, &
                           rflu_creategrid, &
                           rflu_decideneedbgradface, &
                           rflu_destroygrid, &
                           rflu_getuserinput, &
                           rflu_initglobal, &
                           rflu_openpostinfo, &
                           rflu_pickregionscoord, &
                           rflu_pickregionsmanual, &
                           rflu_pickspecialcells, &
                           rflu_pickspecialfaces, &
                           rflu_printgridinfo, &
                           rflu_printheader, &
                           rflu_printwarninfo, &
                           rflu_readinputfile, & 
                           rflu_writepostinfo, & 
                           rflu_writeversionstring
  
  IMPLICIT NONE

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

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

  CHARACTER(*) :: casestring,stampstring
  INTEGER, INTENT(IN) :: verblevel
  
! ==============================================================================
! Local variables
! ==============================================================================

  LOGICAL :: fileexists
  CHARACTER(CHRLEN) :: casename,choice,nregions,rcsidentstring,stamp
  INTEGER :: errorflag,ipatch,ireg
  TYPE(t_global), POINTER :: global
  TYPE(t_mixt_input), POINTER :: pmixtinput
  TYPE(t_level), DIMENSION(:), POINTER :: levels  
  TYPE(t_patch), POINTER :: ppatch
  TYPE(t_region), POINTER :: pregion

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

  rcsidentstring = '$RCSfile: rflupick.F90,v $ $Revision: 1.14 $'

! ******************************************************************************
! Initialize global data
! ******************************************************************************
  
  ALLOCATE(global,stat=errorflag)
  IF ( errorflag /= err_none ) THEN 
    WRITE(stderr,'(A,1X,A)') solver_name,'ERROR - Pointer allocation failed.'
    stop
  END IF ! errorFlag   

  casename = casestring(1:len(casestring))
  stamp    = stampstring(1:len(stampstring))
  
  CALL rflu_initglobal(casename,verblevel,crazy_value_int,global)

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

! ******************************************************************************
! Print header and write version string
! ******************************************************************************

  IF ( global%myProcid == masterproc ) THEN
    CALL rflu_writeversionstring(global)     
    IF ( global%verbLevel /= verbose_none ) THEN
      CALL rflu_printheader(global)
    END IF ! global%verbLevel
  END IF ! global%myProcid

! ******************************************************************************
! Read mapping file and impose serial mapping
! ******************************************************************************

  CALL rflu_readregionmappingfile(global,mapfile_readmode_peek,global%myProcId)
  CALL rflu_setregionmappingserial(global)
  CALL rflu_createregionmapping(global,maptype_reg)
  CALL rflu_imposeregionmappingserial(global)

! ******************************************************************************
! Prepare data structure
! ******************************************************************************
  
  CALL rflu_builddatastruct(global,levels)
  CALL rflu_applyregionmapping(global,levels)
  CALL rflu_destroyregionmapping(global,maptype_reg)  
  
! ****************************************************************************** 
! Read input file
! ******************************************************************************

  CALL rflu_getuserinput(levels(1)%regions)  

  IF ( global%flowType == flow_steady ) THEN
    READ(stamp,*) global%currentIter
  ELSE
    READ(stamp,*) global%currentTime
  END IF ! global%flowType  

! ****************************************************************************** 
! Get additional input
! ******************************************************************************

  WRITE(stdout,'(A,1X,A)') solver_name,'Picking regions based on bounding box?'
  WRITE(stdout,'(A,3X,A)') solver_name,'n - No'
  WRITE(stdout,'(A,3X,A)') solver_name,'y - Yes'    
  WRITE(stdout,'(A,3X,A)') solver_name,'Enter choice:'
  READ(stdin,'(A)') choice
  
  SELECT CASE ( trim(choice) ) 
    CASE ( 'y' ) 
      global%pickCoordFlag = .true.
      
      WRITE(stdout,'(A,3X,A)') solver_name,'Enter coordinates of bounding box:'
      WRITE(stdout,'(A,5X,A)') solver_name,'Enter x-coordinate range (low,high):'
      READ(stdin,*) global%pickXCoordLow,global%pickXCoordUpp 
      WRITE(stdout,'(A,5X,A)') solver_name,'Enter y-coordinate range (low,high):'
      READ(stdin,*) global%pickYCoordLow,global%pickYCoordUpp 
      WRITE(stdout,'(A,5X,A)') solver_name,'Enter z-coordinate range (low,high):'
      READ(stdin,*) global%pickZCoordLow,global%pickZCoordUpp 
    CASE ( 'n' )
      global%pickCoordFlag = .false.
    CASE default
      global%warnCounter = global%warnCounter + 1
      
      WRITE(stdout,'(A,3X,A)')  solver_name,'*** WARNING *** Invalid input.'
      WRITE(stdout,'(A,17X,A)') solver_name,'Continuing assuming choice of no.'
      
      global%pickCoordFlag = .false.
  END SELECT ! TRIM(choice)      

! ******************************************************************************
! Pick regions based on bounding box
! ******************************************************************************
    
  IF ( global%nRegionsLocal > 1 ) THEN 
    IF ( global%pickCoordFlag .EQV. .true. ) THEN  
      DO ireg = 1,global%nRegionsLocal
        pregion => levels(1)%regions(ireg)

        CALL rflu_readdimensions(pregion)         
        CALL rflu_creategrid(pregion)
        
        IF ( pregion%grid%nPatches > 0 ) THEN      
          CALL rflu_readbcinputfilewrapper(pregion)    
        END IF ! pRegion%grid%nPatches        
        
        CALL rflu_readgridwrapper(pregion)
        
        IF ( global%verbLevel > verbose_none ) THEN 
          CALL rflu_printgridinfo(pregion)
        END IF ! global%verbLevel

        CALL rflu_pickregionscoord(pregion)

        CALL rflu_destroygrid(pregion)     
      END DO ! iReg  
    END IF ! global%pickCoordFlag    
  END IF ! global%nRegionsLocal    
      
! ******************************************************************************
! Pick regions based on manual input
! ******************************************************************************

  IF ( global%nRegionsLocal > 1 ) THEN 
    CALL rflu_pickregionsmanual(levels(1)%regions)
  END IF ! global%nRegions

! ******************************************************************************
! Open post-processing information file
! ******************************************************************************

  CALL rflu_openpostinfo(global,file_status_unknown,fileexists) 

! ******************************************************************************
! Pick special cells and write to file
! ******************************************************************************

  IF ( global%postSpecFlag .EQV. .true. ) THEN 
    DO ireg = 1,global%nRegionsLocal
      IF ( global%nRegionsLocal /= 1 ) THEN 
        pregion => levels(1)%regions(ireg)
      ELSE 
        pregion => levels(1)%regions(0)
      END IF ! global%nRegionsLocal

      pmixtinput => pregion%mixtInput
    
! ==============================================================================
!     If region active, proceed to allow user to pick cells
! ==============================================================================    
    
      IF ( pregion%postActiveFlag .EQV. .true. ) THEN
        CALL rflu_readdimensions(pregion) ! Must be done again
        CALL rflu_creategrid(pregion)
        
        IF ( pregion%grid%nPatches > 0 ) THEN      
          CALL rflu_readbcinputfilewrapper(pregion)    
        END IF ! pRegion%grid%nPatches          
        
        CALL rflu_readgridwrapper(pregion)

        IF ( global%verbLevel > verbose_none ) THEN 
          CALL rflu_printgridinfo(pregion)
        END IF ! global%verbLevel

! ------------------------------------------------------------------------------
!       Build data structure
! ------------------------------------------------------------------------------

        CALL rflu_createcellmapping(pregion)
        CALL rflu_readloc2globcellmapping(pregion)
        CALL rflu_buildglob2loccellmapping(pregion)
        
        CALL rflu_createbvertexlists(pregion)
        CALL rflu_buildbvertexlists(pregion)
        
        CALL rflu_createfacelist(pregion)       
        CALL rflu_buildfacelist(pregion)
        CALL rflu_renumberbfacelists(pregion) 

! ------------------------------------------------------------------------------
!       Build stencils. NOTE: Need geometry.
! ------------------------------------------------------------------------------

        CALL rflu_creategeometry(pregion)
        CALL rflu_buildgeometry(pregion)

        CALL rflu_createvert2celllist(pregion)
        CALL rflu_buildvert2celllist(pregion)

        CALL rflu_createcell2facelist(pregion)
        CALL rflu_buildcell2facelist(pregion)

        IF ( pmixtinput%spaceOrder > 1 ) THEN 
          CALL rflu_setinfoc2cstencilwrapper(pregion,pmixtinput%spaceOrder-1)        
          CALL rflu_createc2cstencilwrapper(pregion)
          CALL rflu_buildc2cstencilwrapper(pregion)
        END IF ! pMixtInput%spaceOrder      

        IF ( pmixtinput%flowModel == flow_navst ) THEN
          CALL rflu_setinfof2cstencilwrapper(pregion,pmixtinput%spaceOrder-1)        
          CALL rflu_createf2cstencilwrapper(pregion)
          CALL rflu_buildf2cstencilwrapper(pregion)
        END IF ! pMixtInput%flowModel 
          
        DO ipatch = 1,pregion%grid%nPatches
          ppatch => pregion%patches(ipatch)
          
          IF ( rflu_decideneedbgradface(pregion,ppatch) .EQV. .true. ) THEN
            CALL rflu_setinfobf2cstencilwrapper(pregion,ppatch,ppatch%spaceOrder)
            CALL rflu_createbf2cstencilwrapper(pregion,ppatch)
            CALL rflu_buildbf2cstencilwrapper(pregion,ppatch)          
          END IF ! RFLU_DecideNeedBGradFace

        END DO ! iPatch

        CALL rflu_setinfostencilvert2cell(pregion,global%postInterpOrder)
        CALL rflu_createstencilvert2cell(pregion)
        CALL rflu_buildstencilvert2cell(pregion)

        CALL rflu_destroycell2facelist(pregion)
        CALL rflu_destroyvert2celllist(pregion)

        CALL rflu_destroygeometry(pregion)    

! ------------------------------------------------------------------------------
!       Pick special cells and write to file
! ------------------------------------------------------------------------------

        CALL rflu_pickspecialcells(pregion) 
        CALL rflu_pickspecialfaces(pregion)          
        CALL rflu_writepostinfo(pregion)

! ------------------------------------------------------------------------------
!       Deallocate memory
! ------------------------------------------------------------------------------
      
        CALL rflu_destroystencilvert2cell(pregion)

        IF ( pmixtinput%flowModel == flow_navst ) THEN
          CALL rflu_destroyf2cstencilwrapper(pregion)
        END IF ! pMixtInput%flowModel
          
        DO ipatch = 1,pregion%grid%nPatches
          ppatch => pregion%patches(ipatch)

          IF ( rflu_decideneedbgradface(pregion,ppatch) .EQV. .true. ) THEN
            CALL rflu_destroybf2cstencilwrapper(pregion,ppatch)
          END IF ! RFLU_DecideNeedBGradFace
        END DO ! iPatch

        IF ( pmixtinput%spaceOrder > 1 ) THEN 
          CALL rflu_destroyc2cstencilwrapper(pregion)
        END IF ! pMixtInput%spaceOrder      

        CALL rflu_destroyfacelist(pregion)
        CALL rflu_destroybvertexlists(pregion)
        CALL rflu_destroycellmapping(pregion)              
      ELSE 
        CALL rflu_writepostinfo(pregion)
      END IF ! pRegion%postActiveFlag    
    END DO ! iReg
  ELSE 
    DO ireg = 1,global%nRegionsLocal
      IF ( global%nRegionsLocal /= 1 ) THEN 
        pregion => levels(1)%regions(ireg)
      ELSE 
        pregion => levels(1)%regions(0)
      END IF ! global%nRegionsLocal  
  
      CALL rflu_writepostinfo(pregion)
    END DO ! iReg      
  END IF ! global%postSpecFlag 

! ******************************************************************************
! Close post-processing information file
! ******************************************************************************

  CALL rflu_closepostinfo(global)
  
! *****************************************************************************
! Print info about warnings
! *****************************************************************************

  CALL rflu_printwarninfo(global)
  
! ******************************************************************************
! End
! ******************************************************************************

  CALL deregisterfunction(global)

END SUBROUTINE rflupick

! ******************************************************************************
!
! RCS Revision history:
!
! $Log: rflupick.F90,v $
! Revision 1.14  2008/12/06 08:45:04  mtcampbe
! Updated license.
!
! Revision 1.13  2008/11/19 22:18:15  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.12  2006/08/19 15:41:15  mparmar
! Used pPatch%spaceOrder, RFLU_NSCBC_DecideNeedBGradFace
!
! Revision 1.11  2006/04/07 14:57:17  haselbac
! Adapted to changes in bface stencil routines
!
! Revision 1.10  2006/03/09 14:11:06  haselbac
! Now call wrapper routine for F2C stencils
!
! Revision 1.9  2006/02/06 23:55:55  haselbac
! Added comm argument to RFLU_InitGlobal
!
! Revision 1.8  2006/01/06 22:18:36  haselbac
! Adapted to name changes
!
! Revision 1.7  2005/12/10 23:30:23  haselbac
! Added user input for bbox
!
! Revision 1.6  2005/10/27 19:21:49  haselbac
! Adapted to changes in stencil routine names
!
! Revision 1.5  2005/10/09 15:13:29  haselbac
! Bug fix: Added bc reading, needed for bface stencils
!
! Revision 1.4  2005/10/05 14:26:13  haselbac
! Adapted to changes in stencil modules, added use of vertex list module
!
! Revision 1.3  2005/07/19 19:17:48  haselbac
! Bug fix: Added calls to build c2f list for picking stencils
!
! Revision 1.2  2005/05/03 03:11:54  haselbac
! Converted to C++ reading of command-line
!
! Revision 1.1  2005/04/18 14:57:56  haselbac
! Initial revision
!
! ******************************************************************************