RFLU_ModProbes.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: Collection of routines related to probes.
!
! Description: None.
!
! Notes: None. 
!
! ******************************************************************************
!
! $Id: RFLU_ModProbes.F90,v 1.6 2008/12/06 08:44:23 mtcampbe Exp $
!
! Copyright: (c) 2005 by the University of Illinois
!
! ******************************************************************************

MODULE rflu_modprobes

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

  IMPLICIT NONE

  PRIVATE
  PUBLIC :: rflu_closeprobefiles, &
            rflu_decidewriteprobes, & 
            rflu_findprobecells, & 
            rflu_openprobefiles, & 
            rflu_printprobeinfo
  
! ******************************************************************************
! Declarations and definitions
! ******************************************************************************  
      
  CHARACTER(CHRLEN) :: & 
    RCSIdentString = '$RCSfile: RFLU_ModProbes.F90,v $ $Revision: 1.6 $' 
              
! *****************************************************************************
! Routines
! *****************************************************************************

  CONTAINS
  
  
  
  
  


! ******************************************************************************
!
! Purpose: Close probe files. 
!
! Description: None.
!
! Input: 
!   pRegion     Pointer to region
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************

SUBROUTINE rflu_closeprobefiles(pRegion)

  IMPLICIT NONE

! ******************************************************************************
! Declarations
! ******************************************************************************

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

  TYPE (t_region), POINTER :: pregion

! ******************************************************************************
! Locals
! ******************************************************************************

  INTEGER :: errorflag,iprobe
  TYPE(t_global), POINTER :: global

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

  global => pregion%global

  CALL registerfunction(global,'RFLU_CloseProbeFiles',&
  'RFLU_ModProbes.F90')

! ******************************************************************************
! Loop over probes
! ******************************************************************************

  DO iprobe = 1,global%nProbes

! ==============================================================================
!   Check if probe region on current processor
! ==============================================================================

    IF ( global%probePos(iprobe,probe_region) == pregion%iRegionGlobal ) THEN
      CLOSE(if_probe+iprobe-1,iostat=errorflag)
      global%error = errorflag
      IF ( global%error /= err_none ) THEN 
        CALL errorstop(global,err_file_close,__line__)
      END IF ! global%error
    END IF ! global
  END DO ! iProbe

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

  CALL deregisterfunction(global)

END SUBROUTINE rflu_closeprobefiles
  
  
  
  
  
  
  
  
  
! ******************************************************************************
!
! Purpose: Determine whether to write probe data to files.
!
! Description: None.
!
! Input:
!   global                      Pointer to global data
!
! Output: 
!   RFLU_DecideWrite = .TRUE.   If should write probe data to files
!   RFLU_DecideWrite = .FALSE.  If should not write probe data to files
!
! Notes: None.
!
! ******************************************************************************

LOGICAL FUNCTION rflu_decidewriteprobes(global)
      
  IMPLICIT NONE

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

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

  TYPE(t_global), POINTER :: global

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

  LOGICAL :: logical1,logical2,logical3

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

  CALL registerfunction(global,'RFLU_DecideWriteProbes',&
  'RFLU_ModProbes.F90')

! ******************************************************************************
! Initialize
! ******************************************************************************

  rflu_decidewriteprobes = .false.
  
! ******************************************************************************
! Determine whether should print to screen
! ******************************************************************************

! ==============================================================================
! Unsteady flow
! ==============================================================================

  IF ( global%flowType == flow_unsteady ) THEN
    logical1 = abs(global%timeSinceProbe-global%probeSaveTime) & 
             < 0.1_rfreal*global%dtMin  
    logical2 = (global%timeSinceProbe > global%probeSaveTime)    
    logical3 = (global%iterSinceRestart == 1)
  
    IF ( logical1 .OR. logical2 .OR. logical3 ) THEN    
      rflu_decidewriteprobes = .true.
    END IF ! logical1

! ==============================================================================
! Steady flow
! ==============================================================================

  ELSE    
    rflu_decidewriteprobes = (mod(global%currentIter,global%probeSaveIter) == 0)

    IF ( global%currentIter == 1 ) THEN 
      rflu_decidewriteprobes = .true.
    END IF ! global%currentIter
  END IF ! global%flowType

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

  CALL deregisterfunction(global)

END FUNCTION rflu_decidewriteprobes 
  
  
  
  
  
  
  
  
! ******************************************************************************
!
! Purpose: Determine cell centroids which are closest to probe coordinates.
!
! Description: None.
!
! Input: 
!  pRegion      Pointer to region
!
! Output: None.
!
! Notes: 
!   1. It is not enough to simply get closest cell from Octree, because 
!      proximity to cell centroid does not guarantee that the specified 
!      location is actually inside the cell.
!   2. If the probe location is very close to a vertex, a very large number
!      of cells may have to be searched for tetrahedral grids...
!
! ******************************************************************************

SUBROUTINE rflu_findprobecells(pRegion)

  USE rflu_modgeometrytools, ONLY: rflu_testinboundbox
  USE rflu_modincelltest, ONLY: rflu_ict_testincell
  USE rflu_modoctree
   
  IMPLICIT NONE

! ******************************************************************************
! Declarations
! ******************************************************************************

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

  TYPE(t_region), POINTER :: pregion

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

  INTEGER :: ccsize,errorflag,icg,iprobe
  INTEGER, DIMENSION(:), ALLOCATABLE :: cc
  REAL(RFREAL) :: delfrac,xdel,xp,xmax,xmin,ydel,yp,ymax,ymin,zdel,zp,zmax,zmin
  TYPE(t_global), POINTER :: global
  TYPE(t_grid), POINTER :: pgrid

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

  global => pregion%global

  CALL registerfunction(global,'RFLU_FindProbeCells',&
  'RFLU_ModProbes.F90')

  IF ( global%myProcid == masterproc .AND. &
       global%verbLevel >= verbose_high ) THEN   
    WRITE(stdout,'(A,1X,A)') solver_name,'Finding cells containing probes...'    
  END IF ! global%verbLevel

! ******************************************************************************
! Set variables and pointers
! ******************************************************************************

  pgrid => pregion%grid

  delfrac = 0.01_rfreal
  
  ccsize = min(100,pgrid%nCells) ! Must be larger than unity 

  ALLOCATE(cc(ccsize),stat=errorflag)
  global%error = errorflag
  IF ( global%error /= err_none ) THEN 
    CALL errorstop(global,err_allocate,__line__,'cc')
  END IF ! global%error

! ******************************************************************************  
! Build bounding box
! ******************************************************************************

  xmin = minval(pgrid%xyz(xcoord,1:pgrid%nVert))
  xmax = maxval(pgrid%xyz(xcoord,1:pgrid%nVert))
  ymin = minval(pgrid%xyz(ycoord,1:pgrid%nVert))
  ymax = maxval(pgrid%xyz(ycoord,1:pgrid%nVert))
  zmin = minval(pgrid%xyz(zcoord,1:pgrid%nVert))
  zmax = maxval(pgrid%xyz(zcoord,1:pgrid%nVert))

  xdel = xmax - xmin 
  ydel = ymax - ymin
  zdel = zmax - zmin

  xmin = xmin - delfrac*xdel
  xmax = xmax + delfrac*xdel 
  ymin = ymin - delfrac*ydel
  ymax = ymax + delfrac*ydel 
  zmin = zmin - delfrac*zdel
  zmax = zmax + delfrac*zdel  

! ******************************************************************************  
! Build Octree with cell centroids: NOTE only for actual cells
! ******************************************************************************

  CALL rflu_createoctree(global,pgrid%nCells)
  
  CALL rflu_buildoctree(pgrid%cofg(xcoord,1:pgrid%nCells), & 
                        pgrid%cofg(ycoord,1:pgrid%nCells), & 
                        pgrid%cofg(zcoord,1:pgrid%nCells), & 
                        xmin,xmax,ymin,ymax,zmin,zmax)

! ******************************************************************************
! Loop over probes
! ******************************************************************************

  DO iprobe = 1,global%nProbes

! ==============================================================================  
!   Test probe location against bounding box of partition
! ==============================================================================  
  
    xp = global%probeXyz(iprobe,1)
    yp = global%probeXyz(iprobe,2)
    zp = global%probeXyz(iprobe,3)

    IF ( rflu_testinboundbox(global,xp,yp,zp,xmin,xmax,ymin,ymax, & 
                             zmin,zmax) .EQV. .true. ) THEN  
                               
! ------------------------------------------------------------------------------  
!     Query octree to get closest cells  
! ------------------------------------------------------------------------------ 
    
      CALL rflu_queryoctree(xp,yp,zp,ccsize,cc)
        
! ------------------------------------------------------------------------------
!     Test cells obtained from Octree if they contain specified location
! ------------------------------------------------------------------------------        
           
      cellloop: DO icg = 1,ccsize                 
        IF ( rflu_ict_testincell(pregion,xp,yp,zp,cc(icg)) .EQV. .true. ) THEN
          global%probePos(iprobe,probe_region) = pregion%iRegionGlobal
          global%probePos(iprobe,probe_cell)   = cc(icg)

          EXIT cellloop
        END IF ! RFLU_ICT_TestInCell        
      END DO cellloop
    END IF ! RFLU_TestInBoundNox 
  END DO ! iProbe

! ******************************************************************************
! Destroy Octree and deallocate temporary memory
! ******************************************************************************

  CALL rflu_destroyoctree(global)

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

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

  IF ( global%myProcid == masterproc .AND. &
       global%verbLevel >= verbose_high ) THEN          
    WRITE(stdout,'(A,1X,A)') solver_name,'Finding cells containing probes done.'
  END IF ! global%verbLevel

  CALL deregisterfunction(global)

END SUBROUTINE rflu_findprobecells  
  
  
  
  
  
  
  
  
  
  
! ******************************************************************************
!
! Purpose: Open probe files and position files at right line when restarting. 
!
! Description: None.
!
! Input: 
!   pRegion     Pointer to region
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************

SUBROUTINE rflu_openprobefiles(pRegion)

  USE modbuildfilenames, ONLY: buildfilenameplain
  USE modtools, ONLY: floatless

  IMPLICIT NONE

! ******************************************************************************
! Declarations
! ******************************************************************************

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

  TYPE (t_region), POINTER :: pregion

! ******************************************************************************
! Locals
! ******************************************************************************

  LOGICAL :: fileappend,fileexists
  CHARACTER(CHRLEN+9) :: fname
  INTEGER :: errorflag,iprobe,probeiter
  REAL(RFREAL) :: probetime
  TYPE(t_global), POINTER :: global

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

  global => pregion%global

  CALL registerfunction(global,'RFLU_OpenProbeFiles',&
  'RFLU_ModProbes.F90')

! ******************************************************************************
! Initialize
! ******************************************************************************
  
  probetime = huge(1.0_rfreal)

! ******************************************************************************
! Loop over probes
! ******************************************************************************

  DO iprobe = 1,global%nProbes

! ==============================================================================
!   Check if probe region on current processor
! ==============================================================================

    IF ( global%probePos(iprobe,probe_region) == pregion%iRegionGlobal ) THEN

! ------------------------------------------------------------------------------
!     Generate file name
! ------------------------------------------------------------------------------

      WRITE(fname,'(A,I4.4)') trim(global%outDir)// & 
                              trim(global%casename)//'.prb_',iprobe

! ------------------------------------------------------------------------------
!     Open file with appropriate options
! ------------------------------------------------------------------------------

      IF ( (global%flowType    == flow_unsteady .AND. &
            global%currentTime > 0.0_rfreal) .OR.  &
           (global%flowType    == flow_steady .AND. & 
            global%currentIter > 1) ) THEN
        INQUIRE(file=fname,exist=fileexists)

        IF ( fileexists .EQV. .true. ) THEN
          fileappend = .true.

          OPEN(if_probe+iprobe-1,file=fname,form='FORMATTED',status='OLD', &
               position='APPEND',iostat=errorflag)
        ELSE
          fileappend = .false.
        
          OPEN(if_probe+iprobe-1,file=fname,form='FORMATTED',status='UNKNOWN', &
               iostat=errorflag)
        END IF ! fileExists
      ELSE
        fileappend = .false.

        OPEN(if_probe+iprobe-1,file=fname,form='FORMATTED',status='UNKNOWN', &
             iostat=errorflag)
      END IF ! global

      global%error = errorflag
      IF (global%error /= err_none ) THEN
        CALL errorstop(global,err_file_open,__line__,'File: '//trim(fname))
      END IF ! global%error
 
! ------------------------------------------------------------------------------
!     Back up to right time when appending to existing file. NOTE if encounter
!     errors when backspacing or reading file (for example because it may be 
!     empty), just quit loop instead of treating error properly.
! ------------------------------------------------------------------------------

      IF ( fileappend .EQV. .true. ) THEN
      
! ----- Unsteady flow ----------------------------------------------------------
      
        IF ( global%flowType == flow_unsteady ) THEN 
          emptyloopunsteady: DO 
            backspace(if_probe+iprobe-1,iostat=errorflag)
            IF ( errorflag /= err_none ) THEN 
              EXIT emptyloopunsteady
            END IF ! errorFlag
          
            READ(if_probe+iprobe-1,*,iostat=errorflag) probetime
            IF ( errorflag /= err_none ) THEN 
              EXIT emptyloopunsteady
            END IF ! errorFlag

            IF ( floatless(probetime,global%currentTime) .EQV. .true. ) THEN           
              EXIT emptyloopunsteady
            ELSE 
              backspace(if_probe+iprobe-1,iostat=errorflag)
              IF ( errorflag /= err_none ) THEN 
                EXIT emptyloopunsteady
              END IF ! errorFlag              
            END IF ! probeTime
          END DO emptyloopunsteady

! ----- Steady flow ------------------------------------------------------------

        ELSE 
          emptyloopsteady: DO 
            backspace(if_probe+iprobe-1,iostat=errorflag)
            IF ( errorflag /= err_none ) THEN 
              EXIT emptyloopsteady
            END IF ! errorFlag
          
            READ(if_probe+iprobe-1,*,iostat=errorflag) probeiter
            IF ( errorflag /= err_none ) THEN 
              EXIT emptyloopsteady
            END IF ! errorFlag

            IF ( probeiter < global%currentIter ) THEN           
              EXIT emptyloopsteady
            ELSE 
              backspace(if_probe+iprobe-1,iostat=errorflag)
              IF ( errorflag /= err_none ) THEN 
                EXIT emptyloopsteady
              END IF ! errorFlag
            END IF ! probeTime
          END DO emptyloopsteady         
        END IF ! global%flowType 
      END IF ! fileAppend
    END IF ! global
  END DO ! iProbe

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

  CALL deregisterfunction(global)

END SUBROUTINE rflu_openprobefiles
  
  
  
  
  
  
  
! ******************************************************************************
!
! Purpose: Print information on probe cells.
!
! Description: None.
!
! Input: 
!  global               Pointer to global data
!
! Output: None.
!
! Notes: 
!   1. It is important to note that the use of the max reduction requires the 
!      global%probePos array to be initialized with negative integers (see 
!      readProbeSection.F90). Hence if the entries of a given probe are still
!      equal to the initial values, know that probe was not located in any of
!      the regions.
!
! ******************************************************************************

SUBROUTINE rflu_printprobeinfo(global)

  IMPLICIT NONE

! ******************************************************************************
! Declarations
! ******************************************************************************

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

  TYPE(t_global), POINTER :: global

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

  CHARACTER(CHRLEN) :: errorstring
  INTEGER :: errorflag,iprobe
  INTEGER, DIMENSION(:), ALLOCATABLE :: globalvals,localvals

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

  CALL registerfunction(global,'RFLU_PrintProbeInfo',&
  'RFLU_ModProbes.F90')

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

! ******************************************************************************
! Gather information
! ******************************************************************************

! ==============================================================================
! Allocate temporary memory
! ==============================================================================

  ALLOCATE(localvals(global%nProbes),stat=errorflag)
  global%error = errorflag
  IF ( global%error /= err_none ) THEN 
    CALL errorstop(global,err_allocate,__line__,'localVals')
  END IF ! global%error

  ALLOCATE(globalvals(global%nProbes),stat=errorflag)
  global%error = errorflag
  IF ( global%error /= err_none ) THEN 
    CALL errorstop(global,err_allocate,__line__,'globalVals')
  END IF ! global%error

! ==============================================================================
! Peform reduction operations
! ==============================================================================
  
  DO iprobe = 1,global%nProbes
    localvals(iprobe) = global%probePos(iprobe,probe_region)
  END DO ! iProbe
   
  CALL mpi_allreduce(localvals,globalvals,global%nProbes,mpi_integer,mpi_max, &
                     global%mpiComm,errorflag)
  global%error = errorflag
  IF ( global%error /= err_none ) THEN 
    CALL errorstop(global,err_mpi_trouble,__line__)
  END IF ! global%errorFlag
   
  DO iprobe = 1,global%nProbes
    global%probePos(iprobe,probe_region) = globalvals(iprobe)
  END DO ! iProbe   

  DO iprobe = 1,global%nProbes
    localvals(iprobe) = global%probePos(iprobe,probe_cell)
  END DO ! iProbe
   
  CALL mpi_allreduce(localvals,globalvals,global%nProbes,mpi_integer,mpi_max, &
                     global%mpiComm,errorflag)
  global%error = errorflag
  IF ( global%error /= err_none ) THEN 
    CALL errorstop(global,err_mpi_trouble,__line__)
  END IF ! global%errorFlag
  
  DO iprobe = 1,global%nProbes
    global%probePos(iprobe,probe_cell) = globalvals(iprobe)
  END DO ! iProbe 

! ==============================================================================
! Deallocate temporary memory
! ==============================================================================

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

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

! ******************************************************************************
! If probe position values are still equal to initial values, could not find 
! a cell containing probe position
! ******************************************************************************

  IF ( global%myProcid == masterproc ) THEN 
    DO iprobe = 1,global%nProbes    
      IF ( (global%probePos(iprobe,probe_region) == crazy_value_int) .OR. & 
           (global%probePos(iprobe,probe_cell  ) == crazy_value_int) ) THEN
        WRITE(errorstring,'(A,1X,I3)') 'Probe:',iprobe
        CALL errorstop(global,err_probe_location,__line__,trim(errorstring))
      END IF ! global%probePos
    END DO ! iProbe
  END IF ! global%myProcid

! ******************************************************************************
! Print information
! ******************************************************************************

  IF ( global%myProcid == masterproc .AND. & 
       global%verbLevel >= verbose_high ) THEN
    WRITE(stdout,'(A,5X,A,3X,A,8X,A)') solver_name,'#','Region','Cell'
       
    DO iprobe = 1,global%nProbes
      WRITE(stdout,'(A,3X,I3,3X,I6,3X,I9)') solver_name,iprobe, &
        global%probePos(iprobe,probe_region),global%probePos(iprobe,probe_cell)         
    END DO ! iProbe
  END IF ! global%myProcid  

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

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

  CALL deregisterfunction(global)

END SUBROUTINE rflu_printprobeinfo  
  
  
  
  
  
  
! ******************************************************************************
! End
! ******************************************************************************
  
END MODULE rflu_modprobes


! ******************************************************************************
!
! RCS Revision history:
!
! $Log: RFLU_ModProbes.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/12/15 13:25:08  haselbac
! Fixed bug in format statement, found by ifort
!
! Revision 1.3  2006/04/07 15:19:20  haselbac
! Removed tabs
!
! Revision 1.2  2005/12/24 21:30:45  haselbac
! Adapted to changes in ICT
!
! Revision 1.1  2005/04/29 12:41:04  haselbac
! Initial revision
!
! ******************************************************************************