SURF_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: provide grid coordinates for all surfaces which interact
!          with GenX.
!
! Description: none.
!
! Input: case name from the list of arguments
!
! Output: none
!
! Notes: none
!
!******************************************************************************
!
! $Id: SURF_Main.F90,v 1.4 2008/12/06 08:44:52 mtcampbe Exp $
!
! Copyright: (c) 2002 by the University of Illinois
!
!******************************************************************************

#ifdef CHARM
SUBROUTINE mpi_main
#else
PROGRAM rocflo_surf
#endif

  USE moddatatypes
  USE moderror
  USE moddatastruct, ONLY : t_region
  USE modglobal, ONLY     : t_global
  USE surf_modinterfaces, ONLY : buildversionstring, &
          rflo_readregiontopology, rflo_readbcinputfile, &
          rflo_copytopologylevels, rflo_readgridregion, &
          rflo_generatecoarsegrids, rflo_copygeometrydummy, &
          countinteractingpatches, writesurfacegrid
  USE modmpi
  USE modparameters
  IMPLICIT NONE

#include "Indexing.h"

! ... loop variables
  INTEGER :: ireg, ilev

! ... local variables
  CHARACTER(CHRLEN) :: level, gridformat, msg, versionstring, headerstring

  INTEGER :: ipc, jpc, kpc, ibn, ien, ninteract
  INTEGER :: idnbeg, idnend, jdnbeg, jdnend, kdnbeg, kdnend, inoff, ijnoff
  INTEGER :: margin, versionwidth, errorflag
  INTEGER, PARAMETER :: headerwidth = 53

  TYPE(t_global), POINTER :: global
  TYPE(t_region), POINTER :: regions(:)

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

  ALLOCATE( global )

  global%nFunTree = 0
  CALL registerfunction( global,'ROCFLO_Surf',&
  'SURF_Main.F90' )

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

  global%verbLevel = verbose_none

  global%flowType    = flow_steady  ! stationary flow
  global%currentTime = 0._rfreal    ! no physical time set
  global%timeStamp   = 0._rfreal
  global%currentIter = 0            ! no iteration yet
  global%resInit     = 1._rfreal

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

  global%nProcAlloc = 1
  global%myProcid   = masterproc    ! default process number (if not MPI)
  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: Surface Grid for GenX          *'
  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 argument list ----------------------------------------------------------

  CALL getarg(1,global%casename)
  CALL getarg(2,level)
  CALL getarg(3,gridformat)

  IF (len_trim(global%casename)==0 .OR. &
      len_trim(level)==0           .OR. &
      len_trim(gridformat)==0) THEN
    WRITE(stdout,'(/,A,/,5(A,/))')  &
      solver_name//' Usage: rflosurf <casename> <level> <grid>', &
      solver_name, &
      solver_name//'        level = grid level (>0)', &
      solver_name, &
      solver_name//'        grid  = 0 - ASCII format', &
      solver_name//'              = 1 - binary format'
#ifdef MPI
    CALL mpi_finalize( global%mpierr )
#endif
    stop
  ENDIF

  READ(level     ,*) global%startLevel
  READ(gridformat,*) global%gridFormat

! 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
    IF (regions(ireg)%nGridLevels < regions(ireg)%currLevel) THEN
      WRITE(msg,1000) solver_name,ireg,global%startLevel
      CALL errorstop( global,err_grid_level,__line__,msg )
    ENDIF
    DO ilev=2,regions(ireg)%nGridLevels
      ipc = regions(ireg)%levels(ilev-1)%grid%ipc
      jpc = regions(ireg)%levels(ilev-1)%grid%jpc
      kpc = regions(ireg)%levels(ilev-1)%grid%kpc
      regions(ireg)%levels(ilev)%grid%ipc = ipc/2
      regions(ireg)%levels(ilev)%grid%jpc = jpc/2
      regions(ireg)%levels(ilev)%grid%kpc = kpc/2
    ENDDO
  ENDDO

! read boundary conditions

  CALL rflo_readbcinputfile( regions )

! copy topology and BCs to all grid levels

  CALL rflo_copytopologylevels( regions )

! count number of interacting patches

  CALL countinteractingpatches( regions,ninteract )

! output surface grid (regionwise) --------------------------------------------

  WRITE(stdout,'(A)') solver_name//' Generating and storing surface grid ...'

! open file

  OPEN(if_plot,file=trim(global%casename)//'.im',form='formatted', &
       status='unknown',iostat=errorflag)
  global%error = errorflag
  IF (global%error /= 0) CALL errorstop( global,err_file_open,__line__ )

  WRITE(if_plot,*) ninteract,'  2'

! loop over all regions

  DO ireg=1,global%nregions
    WRITE(stdout,'(A,I5.5)') solver_name//'   - region ',ireg

    regions(ireg)%currLevel = global%startLevel

! - allocate memory for grid

    DO ilev=1,regions(ireg)%nGridLevels
      CALL rflo_getdimensdummynodes( regions(ireg),ilev,idnbeg,idnend, &
                                     jdnbeg,jdnend,kdnbeg,kdnend )
      CALL rflo_getnodeoffset( regions(ireg),ilev,inoff,ijnoff )
      ibn = indijk(idnbeg,jdnbeg,kdnbeg,inoff,ijnoff)
      ien = indijk(idnend,jdnend,kdnend,inoff,ijnoff)
      ALLOCATE( regions(ireg)%levels(ilev)%grid%xyz(3,ibn:ien),stat=errorflag )
      global%error = errorflag
      IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )
    ENDDO

! - read grid

    CALL rflo_readgridregion( ireg,regions )
    CALL rflo_generatecoarsegrids( regions(ireg) )
    CALL rflo_copygeometrydummy( regions(ireg) )

! - write out surface grid

    ilev = global%startLevel

    CALL writesurfacegrid( ireg,regions(ireg) )

! - deallocate memory

    DO ilev=1,regions(ireg)%nGridLevels
      DEALLOCATE( regions(ireg)%levels(ilev)%grid%xyz,stat=errorflag )
      global%error = errorflag
      IF (global%error /= 0) CALL errorstop( global,err_deallocate,__line__ )
    ENDDO
  ENDDO     ! iReg

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

  CLOSE(if_plot,iostat=errorflag)
  global%error = errorflag
  IF (global%error /= 0) CALL errorstop( global,err_file_close,__line__ )

  CALL deregisterfunction( global )

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

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

1000 FORMAT(a,' Region ',i5,', grid level= ',i2,'.')

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

!******************************************************************************
!
! RCS Revision history:
!
! $Log: SURF_Main.F90,v $
! Revision 1.4  2008/12/06 08:44:52  mtcampbe
! Updated license.
!
! Revision 1.3  2008/11/19 22:18:02  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.2  2004/12/03 03:35:43  wasistho
! rflo_modinterfacessurf to surf_modinterfaces
!
! Revision 1.1  2004/12/03 02:47:00  wasistho
! added prefix
!
! Revision 1.1  2004/12/03 00:49:09  wasistho
! lower to upper case
!
! Revision 1.5  2003/05/25 18:11:30  jiao
! Added support for Charm.
!
! Revision 1.4  2003/05/15 02:57:07  jblazek
! Inlined index function.
!
! Revision 1.3  2003/03/20 22:35:02  haselbac
! Renamed ModInterfaces
!
! Revision 1.2  2003/03/20 19:48:09  haselbac
! Corrected mistake in phased check-in
!
! Revision 1.1  2002/10/19 00:40:31  jblazek
! Added utility (rflosurf) to write out surface grids for GenX.
!
!******************************************************************************