BLCK_Main.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: write out numbers of blocks being contained in a given
!          box in the physical space.
!
! Description: none.
!
! Input: case name from the list of arguments
!
! Output: to screen.
!
! Notes: none.
!
!******************************************************************************
!
! $Id: BLCK_Main.F90,v 1.3 2008/12/06 08:44:46 mtcampbe Exp $
!
! Copyright: (c) 2002 by the University of Illinois
!
!******************************************************************************

#ifdef CHARM
SUBROUTINE mpi_main
#else
PROGRAM rocflo_blocks
#endif

  USE moddatatypes
  USE moderror
  USE moddatastruct, ONLY : t_region
  USE modglobal, ONLY     : t_global
  USE modgrid, ONLY       : t_grid
  USE modmixture, ONLY    : t_mixt
  USE blck_modinterfaces, ONLY : rflo_readregiontopology, &
        rflo_getdimensdummynodes, rflo_getdimensphysnodes, &
        rflo_getnodeoffset, rflo_readgridregion, buildversionstring
  USE modmpi
  USE modparameters
  IMPLICIT NONE

#include "Indexing.h"

! ... loop variables
  INTEGER :: ireg, i, j, k, ijkn

! ... local variables
  CHARACTER(CHRLEN) :: gridfmt, msg, xmin, xmax, ymin, ymax, &
                       zmin, zmax, versionstring, headerstring

  INTEGER :: ibn, ien, inoff, ijnoff, regnum, regnumbeg, regnumend
  INTEGER :: idnbeg, idnend, jdnbeg, jdnend, kdnbeg, kdnend
  INTEGER :: ipnbeg, ipnend, jpnbeg, jpnend, kpnbeg, kpnend
  INTEGER :: margin, versionwidth, errorflag
  INTEGER, PARAMETER :: headerwidth = 53

  REAL(RFREAL) :: xminbox, xmaxbox, yminbox, ymaxbox, zminbox, zmaxbox
  REAL(RFREAL), POINTER :: xyz(:,:)
  
  TYPE(t_global), POINTER :: global
  TYPE(t_region), POINTER :: regions(:)

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

  ALLOCATE( global )

  global%nFunTree = 0
  CALL registerfunction( global,'ROCFLO_Blocks',&
  'BLCK_Main.F90' )

! initialize global parameters ------------------------------------------------

  global%verbLevel = verbose_none

  global%flowType    = flow_steady  ! stationary flow
  global%currentTime = -1._rfreal   ! no physical time set
  global%currentIter = -1           ! no iteration
  global%startLevel  = 1            ! always finest grid only

  global%inDir  = './'              ! directory path
  global%outDir = './'

  global%nProcAlloc = 1
  global%myProcid   = masterproc    ! default process number (not an MPI code)
  global%mpierr     = err_none
  global%error      = err_none

  global%pi  = 4._rfreal*atan(1._rfreal)
  global%rad = global%pi/180._rfreal

! print header ----------------------------------------------------------------

#ifdef MPI
  CALL mpi_init( global%mpierr )
  IF (global%mpierr /=0 ) CALL errorstop( global,err_mpi_trouble,__line__ )
#endif

  CALL buildversionstring( versionstring )

  headerstring = ' '
  versionwidth = len_trim(versionstring)
  margin       = (headerwidth-versionwidth)/2
  headerstring(margin+1:margin+versionwidth) = versionstring(1:versionwidth)
  headerstring(1:1) = '*'
  headerstring(headerwidth:headerwidth) = '*'

  WRITE(stdout,'(/,A)') solver_name//'  *****************************************************'
  WRITE(stdout,  '(A)') solver_name//'  *                                                   *'
  WRITE(stdout,  '(A)') solver_name//'  *         ROCFLO-MP: Block Counting Utility         *'
  WRITE(stdout,  '(A)') solver_name//'  *         =================================         *'
  WRITE(stdout,  '(A)') solver_name//'  *                                                   *'
  WRITE(stdout,  '(A)') solver_name//'  '//trim(headerstring)
  WRITE(stdout,  '(A)') solver_name//'  *    Copyright (c) by the University of Illinois    *'
  WRITE(stdout,  '(A)') solver_name//'  *                                                   *'
  WRITE(stdout,'(A,/)') solver_name//'  *****************************************************'

! read user input ----------------------------------------------------------

  CALL getarg(1,global%casename)
  CALL getarg(2,gridfmt)
  CALL getarg(3,xmin)
  CALL getarg(4,xmax)
  CALL getarg(5,ymin)
  CALL getarg(6,ymax)
  CALL getarg(7,zmin)
  CALL getarg(8,zmax)

  IF (len_trim(global%casename)==0 .OR. &
      len_trim(gridfmt)==0         .OR. &
      len_trim(xmin)==0            .OR. &
      len_trim(xmax)==0            .OR. &
      len_trim(ymin)==0            .OR. &
      len_trim(ymax)==0            .OR. &
      len_trim(zmin)==0            .OR. &
      len_trim(zmax)==0) THEN
    WRITE(stdout,'(/,A,/,A,/,2(A,/))') &
      solver_name//' Usage: rfloblocks <casename> <format> <xmin xmax> <ymin ymax> <zmin zmax>', &
      solver_name, &
      solver_name//'        format = 0 - ASCII grid', &
      solver_name//'                 1 - binary grid'
#ifdef MPI
    CALL mpi_finalize( global%mpierr )
#endif
    stop
  ENDIF

  READ(gridfmt ,*) global%gridFormat
  READ(xmin    ,*) xminbox
  READ(xmax    ,*) xmaxbox
  READ(ymin    ,*) yminbox
  READ(ymax    ,*) ymaxbox
  READ(zmin    ,*) zminbox
  READ(zmax    ,*) zmaxbox

  IF (global%gridFormat <= 0) THEN
    global%gridFormat = format_ascii
  ELSE
    global%gridFormat = format_binary
  ENDIF

! read region topology --------------------------------------------------------

  WRITE(stdout,'(/,A)') solver_name//' Reading region topology ...'

  CALL rflo_readregiontopology( global,regions )

  DO ireg=1,global%nRegions
    regions(ireg)%startLevel = global%startLevel
    regions(ireg)%currLevel  = global%startLevel
  ENDDO

! loop over regions -----------------------------------------------------------

  WRITE(stdout,'(/,A,/)') solver_name//' Searching for blocks ...'

  regnumbeg = -99
  regnumend = -99

  DO ireg=1,global%nRegions

! - allocate memory for the grid (all grid levels)

    CALL rflo_getdimensdummynodes( regions(ireg),1,idnbeg,idnend, &
                                   jdnbeg,jdnend,kdnbeg,kdnend )
    CALL rflo_getdimensphysnodes( regions(ireg),1,ipnbeg,ipnend, &
                                  jpnbeg,jpnend,kpnbeg,kpnend )
    CALL rflo_getnodeoffset( regions(ireg),1,inoff,ijnoff )
    ibn = indijk(idnbeg,jdnbeg,kdnbeg,inoff,ijnoff)
    ien = indijk(idnend,jdnend,kdnend,inoff,ijnoff)
    ALLOCATE( regions(ireg)%levels(1)%grid%xyz(3,ibn:ien),stat=errorflag )
    global%error = errorflag
    IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )

! - read grid

    CALL rflo_readgridregion( ireg,regions )

! - find regions contained in the box

    xyz => regions(ireg)%levels(1)%grid%xyz

    regnum = 0
    DO k=kpnbeg,kpnend
      DO j=jpnbeg,jpnend
        DO i=ipnbeg,ipnend
          ijkn = indijk(i,j,k,inoff,ijnoff)
          IF ((xyz(xcoord,ijkn)>xminbox .AND. xyz(xcoord,ijkn)<xmaxbox) .AND. &
              (xyz(ycoord,ijkn)>yminbox .AND. xyz(ycoord,ijkn)<ymaxbox) .AND. &
              (xyz(zcoord,ijkn)>zminbox .AND. xyz(zcoord,ijkn)<zmaxbox)) THEN
            regnum = ireg
          ENDIF
        ENDDO
      ENDDO
    ENDDO

    IF (regnum == regnumend+1) THEN
      regnumend = regnum
    ELSE
      IF (regnum/=0 .AND. regnumend<0) THEN
        regnumbeg = regnum
        regnumend = regnum
      ELSE IF (regnum/=0 .AND. regnumend>0) THEN
        WRITE(stdout,1000) solver_name,regnumbeg,regnumend
        regnumbeg = regnum
        regnumend = regnum
      ENDIF
    ENDIF

! - deallocate memory

    DEALLOCATE( regions(ireg)%levels(1)%grid%xyz,stat=errorflag )
    global%error = errorflag
    IF (global%error /= 0) CALL errorstop( global,err_deallocate,__line__ )

  ENDDO   ! iReg

  IF (regnumbeg>0 .AND. regnumend>0) THEN
    WRITE(stdout,1000) solver_name,regnumbeg,regnumend
  ELSE
    WRITE(stdout,1005) solver_name
  ENDIF

! finalize --------------------------------------------------------------------

  CALL deregisterfunction( global )

  WRITE(stdout,'(/,A)') solver_name//' Finished.'

#ifdef MPI
  CALL mpi_finalize( global%mpierr )
#endif

1000 FORMAT(a,' From block ',i5,' to ',i5)
1005 FORMAT(a,' No blocks found.')

#ifdef CHARM
END SUBROUTINE mpi_main
#else
END PROGRAM rocflo_blocks
#endif

!******************************************************************************
!
! RCS Revision history:
!
! $Log: BLCK_Main.F90,v $
! Revision 1.3  2008/12/06 08:44:46  mtcampbe
! Updated license.
!
! Revision 1.2  2008/11/19 22:17:57  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.1  2004/12/03 03:13:06  wasistho
! bloc to blck
!
! Revision 1.1  2004/12/03 01:55:08  wasistho
! add prefix
!
! Revision 1.1  2004/12/03 00:26:14  wasistho
! lower to upper case
!
! Revision 1.6  2003/05/25 18:11:30  jiao
! Added support for Charm.
!
! Revision 1.5  2003/05/15 02:57:06  jblazek
! Inlined index function.
!
! Revision 1.4  2003/03/20 22:20:21  haselbac
! Renamed ModInterfaces
!
! Revision 1.3  2003/03/20 19:39:01  haselbac
! Corrected mistake in phased check-in
!
! Revision 1.2  2003/03/20 19:33:08  haselbac
! Modified RegFun call to avoid probs with long 'BLCK_Main.F90' names
!
! Revision 1.1  2002/12/20 19:38:02  jblazek
! Added tool to count blocks in a box.
!
!******************************************************************************