RFLO_ReadTbcSection.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: read in user input related to time-dependent boundary conditions.
!
! Description: none.
!
! Input: type of TBC boundary condtion
!
! Output: regions will be updated with TBC data
!
! Notes:
!
!   Sample input sections for TBCs are given in the files updateTbc*.F90
!
!******************************************************************************
!
! $Id: RFLO_ReadTbcSection.F90,v 1.6 2008/12/06 08:44:07 mtcampbe Exp $
!
! Copyright: (c) 2001 by the University of Illinois
!
!******************************************************************************

SUBROUTINE rflo_readtbcsection( regions,tbcType )

  USE moddatatypes
  USE modbndpatch
  USE moddatastruct, ONLY : t_region
  USE modglobal, ONLY     : t_global
  USE moderror
  USE modparameters
#ifdef PEUL
  USE peul_modparameters
#endif
  USE modinterfaces, ONLY : readpatchsection
  IMPLICIT NONE

#include "Indexing.h"

! ... parameters
  TYPE(t_region), POINTER :: regions(:)
  INTEGER, INTENT(IN)     :: tbctype

! ... loop variables
  INTEGER :: ireg, ipatch, n

! ... local variables
  INTEGER, PARAMETER :: nvals_max = 10

  CHARACTER(10)  :: keys(nvals_max), bcvar, pwisestr
  CHARACTER(32)  :: bctitle
  CHARACTER(256) :: fname, line

  INTEGER :: nvals, brbeg, brend, prbeg, prend, distrib
  INTEGER :: n1, n2, ioff, ijbeg, ijend, errorflag
  INTEGER :: ftype, bccode, var, nswitches, nparams, nsvals, nbvals, ndata
  INTEGER :: switches(nvals_max), njumps

  LOGICAL :: defined(nvals_max)

  REAL(RFREAL)              :: vals(nvals_max)
  REAL(RFREAL), ALLOCATABLE :: holdvals(:), morevals(:)

  TYPE(t_patch),     POINTER :: patch
  TYPE(t_bcvalues),  POINTER :: bc
  TYPE(t_tbcvalues), POINTER :: tbc
  TYPE(t_global),    POINTER :: global

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

  global => regions(1)%global

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

  IF (global%flowType == flow_steady) &
    CALL errorstop( global,err_steady,__line__ )

! read BC type and variable name ----------------------------------------------

  DO ! find first non-blank line of section
    READ(if_input,'(A256)',err=10,end=10) line
    IF (len_trim(line) > 0) EXIT
  ENDDO

  READ(line,*) bctitle, bcvar

! find the integers describing module type and variable name

  bccode = -1
  ftype  = -1

  SELECT CASE(trim(bctitle))

! *** Mixture BCs *** : ftype = FTYPE_MIXT

  CASE ('SLIPW')
    ftype = ftype_mixt
    bccode = bc_slipwall
    CALL errorstop( global,err_bc_varname,__line__,'SLIPW' )

  CASE ('NOSLIP')
    ftype = ftype_mixt
    bccode = bc_noslipwall

    SELECT CASE(trim(bcvar))
    CASE ('TWALL')
      var = bcdat_noslip_twall
    CASE default
      CALL errorstop( global,err_bc_varname,__line__,'NOSLIP' )
    END SELECT

  CASE ('INFLOW_TOTANG')
    ftype = ftype_mixt
    bccode = bc_inflow

    SELECT CASE(trim(bcvar))
    CASE ('PTOT')
      var = bcdat_inflow_ptot
    CASE ('TTOT')
      var = bcdat_inflow_ttot
    CASE ('BETAH')
      var = bcdat_inflow_betah
    CASE ('BETAV')
      var = bcdat_inflow_betav
    CASE ('MACH')
      var = bcdat_inflow_mach
    CASE default
      CALL errorstop( global,err_bc_varname,__line__,'INFLOW' )
    END SELECT

  CASE ('INFLOW_VELTEMP')
    ftype = ftype_mixt
    bccode = bc_inflow

    SELECT CASE(trim(bcvar))
    CASE ('VELX')
      var = bcdat_inflow_u
    CASE ('VELY')
      var = bcdat_inflow_v
    CASE ('VELZ')
      var = bcdat_inflow_w
    CASE ('TEMP')
      var = bcdat_inflow_t
    CASE ('PRESS')
      var = bcdat_inflow_p
    CASE default
      CALL errorstop( global,err_bc_varname,__line__,'INFLOW_VELTEMP' )
    END SELECT

  CASE ('INFLOW_VELPRESS')
    ftype = ftype_mixt
    bccode = bc_inflow

    SELECT CASE(trim(bcvar))
    CASE ('VELX')
      var = bcdat_inflow_u
    CASE ('VELY')
      var = bcdat_inflow_v
    CASE ('VELZ')
      var = bcdat_inflow_w
    CASE ('TEMP')
      var = bcdat_inflow_t
    CASE ('PRESS')
      var = bcdat_inflow_p
    CASE default
      CALL errorstop( global,err_bc_varname,__line__,'INFLOW_VELPRESS' )
    END SELECT

  CASE ('OUTFLOW')
    ftype = ftype_mixt
    bccode = bc_outflow

    SELECT CASE(trim(bcvar))
    CASE ('PRESS')
      var = bcdat_outflow_press
    CASE default
      CALL errorstop( global,err_bc_varname,__line__,'OUTFLOW' )
    END SELECT

  CASE ('FARF')
    ftype = ftype_mixt
    bccode = bc_farfield

    SELECT CASE(trim(bcvar))
    CASE ('MACH')
      var = bcdat_farf_mach
    CASE ('ATTACK')
      var = bcdat_farf_attack
    CASE ('SLIP')
      var = bcdat_farf_slip
    CASE ('PRESS')
      var = bcdat_farf_press
    CASE ('TEMP')
      var = bcdat_farf_temp
    CASE default
      CALL errorstop( global,err_bc_varname,__line__,'FARF' )
    END SELECT

  CASE ('INJECT')
    ftype = ftype_mixt
    bccode = bc_injection

    SELECT CASE(trim(bcvar))
    CASE ('MFRATE')
      var = bcdat_inject_mfrate
    CASE ('TEMP')
      var = bcdat_inject_temp
    CASE ('RFVFU')
      var = bcdat_inject_rfvfu
    CASE ('RFVFV')
      var = bcdat_inject_rfvfv
    CASE ('RFVFW')
      var = bcdat_inject_rfvfw
    CASE default
      CALL errorstop( global,err_bc_varname,__line__,'INJECT' )
    END SELECT

! *** Turbulence BCs *** : ftype = FTYPE_TURB
! *** Species BCs *** : ftype = FTYPE_SPEC

! *** Eulerian Particle BCs *** : ftype = FTYPE_PEUL

#ifdef PEUL
  CASE ('PEUL_INFLOW')
    ftype = ftype_peul
    bccode = bc_inflow

    IF (bcvar(1:4) == 'DENS') THEN
      IF (len_trim(bcvar) == 4) THEN
        WRITE(*,*) '### WARNING: Improper specification in PEUL_INFLOW TBC'
        WRITE(*,*) '             assuming DENS to mean DENS1'
        var = 1
      ELSE
        READ(bcvar(5:),*) var
      END IF
    ELSE
      CALL errorstop( global,err_bc_varname,__line__,'PEUL_INFLOW' )
    END IF

  CASE ('PEUL_FARF')
    ftype = ftype_peul
    bccode = bc_farfield

    IF (bcvar(1:4) == 'DENS') THEN
      IF (len_trim(bcvar) == 4) THEN
        WRITE(*,*) '### WARNING: Improper specification in PEUL_FARF TBC'
        WRITE(*,*) '             assuming DENS to mean DENS1'
        var = 1
      ELSE
        READ(bcvar(5:),*) var
      END IF
    ELSE
      CALL errorstop( global,err_bc_varname,__line__,'PEUL_FARF' )
    END IF

  CASE ('PEUL_INJECT')
    ftype = ftype_peul
    bccode = bc_injection

    IF (bcvar(1:4) == 'FRAC') THEN
      IF (len_trim(bcvar) == 4) THEN
        WRITE(*,*) '### WARNING: Improper specification in PEUL_INJECT TBC'
        WRITE(*,*) '             assuming FRAC to mean FRAC1'
        var = 1
      ELSE
        READ(bcvar(5:),*) var
      END IF
    ELSE
      CALL errorstop( global,err_bc_varname,__line__,'PEUL_INJECT' )
    END IF
#endif

! *** Radiation BCs *** : ftype = FTYPE_RADI

  CASE default
    CALL errorstop( global,err_unknown_bc,__line__ )

  END SELECT

! specify keywords and search for them ----------------------------------------

  keys(tbcdat_ontime)  = 'ONTIME'
  keys(tbcdat_offtime) = 'OFFTIME'
  keys(tbcdat_amp)     = 'AMP'

  SELECT CASE ( tbctype )

  CASE ( tbc_sinusoidal )
    keys(tbcdat_freq)  = 'FREQ'
    keys(tbcdat_phase) = 'PHASE'
    nvals = 5

  CASE ( tbc_stochastic )
    keys(tbcdat_timecor) = 'TIMECOR'
    keys(tbcdat_shape)   = 'SHAPE'
    keys(tbcdat_mincut)  = 'MINCUT'
    keys(tbcdat_maxcut)  = 'MAXCUT'
    nvals = 7

  CASE ( tbc_whitenoise )
    keys(4) = 'SUBSTEP' ! becomes a switch
    nvals = 4

  CASE ( tbc_piecewise )
    keys(3) = 'ORDER'   ! becomes a switch (overwrites 'AMP')
    keys(4) = 'NJUMPS'  ! becomes a switch
    nvals = 4

  CASE default
    CALL errorstop( global,err_reached_default,__line__ )

  END SELECT ! tbcType

  CALL readpatchsection( global,if_input,nvals,keys,vals,brbeg,brend, &
                         prbeg,prend,distrib,fname,defined )

  IF (.NOT. defined(tbcdat_ontime))      vals(tbcdat_ontime)  = -1.e20_rfreal
  IF (vals(tbcdat_ontime) < 0.0_rfreal)  vals(tbcdat_ontime)  = -1.e20_rfreal

  IF (.NOT. defined(tbcdat_offtime))     vals(tbcdat_offtime) =  1.e20_rfreal
  IF (vals(tbcdat_offtime) < 0.0_rfreal) vals(tbcdat_offtime) =  1.e20_rfreal

  IF (tbctype /= tbc_piecewise) THEN
    IF (.NOT. defined(tbcdat_amp)) &
      CALL errorstop( global,err_bcval_missing,__line__ )

    IF (vals(tbcdat_amp) <= 0.0_rfreal) &
      CALL errorstop( global,err_val_bcval,__line__ )
  ENDIF ! tbcType

! set values of vals and switches ---------------------------------------------

  SELECT CASE ( tbctype )

  CASE ( tbc_sinusoidal )

    nswitches = 0
    nparams   = 5
    nsvals    = 1
    nbvals    = 0

    IF (.NOT. defined(tbcdat_freq)) &
      CALL errorstop( global,err_bcval_missing,__line__ )

    IF (.NOT. defined(tbcdat_phase)) vals(tbcdat_phase) = 0.0_rfreal
    vals(tbcdat_phase) = vals(tbcdat_phase)*global%rad

  CASE ( tbc_stochastic )

    nswitches = 0
    nparams   = 7
    nsvals    = 0
    nbvals    = 3

    IF (.NOT. defined(tbcdat_timecor)) &
      CALL errorstop( global,err_bcval_missing,__line__ )

    IF (vals(tbcdat_timecor) <= 0.0_rfreal) &
      CALL errorstop( global,err_val_bcval,__line__ )

    IF (.NOT. defined(tbcdat_shape)) vals(tbcdat_shape) = 1.0_rfreal

    IF (vals(tbcdat_shape) < 0.1_rfreal .OR. vals(tbcdat_shape) > 10.0_rfreal) &
      CALL errorstop( global,err_val_bcval,__line__ )

    IF (.NOT. defined(tbcdat_mincut)) vals(tbcdat_mincut) = -1.0_rfreal
    IF (.NOT. defined(tbcdat_maxcut)) vals(tbcdat_maxcut) = -1.0_rfreal

  CASE ( tbc_whitenoise )

    nswitches = 1
    nparams = 3
    nsvals = 0
    nbvals = 1

    IF (.NOT. defined(4)) switches(tbcswi_substep) = tbcopt_step
    IF (vals(4) < 0.1_rfreal) THEN
      switches(tbcswi_substep) = tbcopt_step
    ELSE
      switches(tbcswi_substep) = tbcopt_substep
    ENDIF

  CASE ( tbc_piecewise )

    nswitches = 2
    nsvals = 1
    nbvals = 0

    IF (.NOT. defined(3)) switches(tbcswi_order) = tbcopt_constant
    IF (vals(3) < 0.1_rfreal) THEN
      switches(tbcswi_order) = tbcopt_constant
    ELSE
      switches(tbcswi_order) = tbcopt_linear
    ENDIF

    IF (.NOT. defined(4)) &
      CALL errorstop( global,err_bcval_missing,__line__ )
    njumps = nint(vals(4))
    switches(tbcswi_njumps) = njumps
    IF (njumps < 1 .OR. njumps > 1000000) &
      CALL errorstop( global,err_val_bcval,__line__ )

    SELECT CASE (switches(tbcswi_order))
    CASE (tbcopt_constant)
      nparams = tbcdat_dat0 + 2*njumps+1
    CASE (tbcopt_linear)
      nparams = tbcdat_dat0 + 2*njumps
    END SELECT ! switches(TBCSWI_ORDER)

    ALLOCATE( morevals(nparams),stat=errorflag )
    global%error = errorflag
    IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )

    morevals(1:tbcdat_dat0) = vals(1:tbcdat_dat0)
    DO n=tbcdat_dat0+1,nparams
      DO ! find first non-blank line
        READ(if_input,'(A256)',err=10,end=10) line
        IF (len_trim(line) > 0) EXIT
      ENDDO
      IF (line(1:1) == '#') goto 10

      READ(line,*) pwisestr, morevals(n)
    ENDDO ! n

! - check that the times entered are increasing

    DO n=tbcdat_dat0+4,nparams,2
      IF (morevals(n) .le. morevals(n-2)) &
        CALL errorstop( global,err_val_bcval,__line__ )
    ENDDO ! n

    DO ! find end of section
      READ(if_input,'(A256)',err=10,end=10) line
      IF (line(1:1) == '#') EXIT
    ENDDO

  CASE default
    CALL errorstop( global,err_reached_default,__line__ )

  END SELECT

! copy values to variables -----------------------------------------------------

  DO ireg=brbeg,brend
    DO ipatch=prbeg,min(prend,regions(ireg)%nPatches)

      patch => regions(ireg)%levels(1)%patches(ipatch)

      IF ((patch%bcType>=bccode .AND. &
           patch%bcType<=bccode+bc_range)       .AND. &   ! my boundary type,
          regions(ireg)%procid==global%myProcid .AND. &   ! region active and
          regions(ireg)%active==active) THEN              ! on my processor

        n1    = abs(patch%l1end-patch%l1beg)
        n2    = abs(patch%l2end-patch%l2beg)
        ioff  = n1 + 1
        ijbeg = indij( 0, 0,ioff)
        ijend = indij(n1,n2,ioff)

        SELECT CASE (ftype)

        CASE (ftype_mixt)
          bc => patch%mixt
        CASE (ftype_turb)
          bc => patch%turb
        CASE (ftype_peul)
          bc => patch%peul
        CASE (ftype_spec)
          bc => patch%spec
        CASE (ftype_radi)
          bc => patch%valRadi
        CASE default
          CALL errorstop( global,err_reached_default,__line__ )

        END SELECT

        ndata = bc%nData
        tbc  => bc%tbcs(var)

        IF (.NOT. bc%bcSet) &
          CALL errorstop( global,err_no_bcspecified,__line__ )

        IF (var > ndata) THEN
          WRITE(*,*) 'ftype, bcCode, nData, var: ', ftype, bccode, ndata, var
          CALL errorstop( global,err_bc_varname,__line__ )
        ENDIF

        IF (tbc%tbcType /= tbc_none) &
          CALL errorstop( global,err_patch_overspec,__line__,'TBC' )

        tbc%tbcType = tbctype

        IF (nswitches > 0) THEN
          ALLOCATE( tbc%switches(nswitches),stat=errorflag )
          tbc%switches = switches(1:nswitches)
        ENDIF

        IF (nparams > 0) THEN
          ALLOCATE( tbc%params(nparams),stat=errorflag )
          IF (tbctype == tbc_piecewise) THEN
            tbc%params = morevals(1:nparams)
          ELSE
            tbc%params = vals(1:nparams)
          ENDIF
        ENDIF

        IF (nsvals > 0) THEN
          ALLOCATE( tbc%svals(nsvals),stat=errorflag )
          tbc%svals = 0.0_rfreal
        ENDIF

        IF (nbvals > 0) THEN
          ALLOCATE( tbc%bvals(nbvals,ijbeg:ijend),stat=errorflag )
          tbc%bvals = 0.0_rfreal
          IF (tbctype == tbc_stochastic) &
            tbc%bvals(tbcsto_val,:) = 0.5_rfreal * tbc%params(tbcdat_amp)**2
        ENDIF

        distrib = bc%distrib ! original value of bc%distrib

        IF (tbctype == tbc_stochastic .OR. & ! tbc types forcing BCDAT_DISTRIB
            tbctype == tbc_whitenoise) bc%distrib = bcdat_distrib

        IF (bc%distrib == bcdat_distrib) THEN
          ALLOCATE( tbc%mean(ijbeg:ijend),stat=errorflag )
        ELSE
          ALLOCATE( tbc%mean(0:1),stat=errorflag )
        ENDIF

        global%error = errorflag
        IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )

! ----- if distrib needs to change for BC, allocate and fill
!       expanded bc%vals arrays

        IF (bc%distrib == bcdat_distrib .AND. distrib == bcdat_constant) THEN

          ALLOCATE( holdvals(ndata),stat=errorflag )
          global%error = errorflag
          IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )
          holdvals = bc%vals(:,1)

          DEALLOCATE( bc%vals,stat=errorflag )
          global%error = errorflag
          IF (global%error /= 0) CALL errorstop(global,err_deallocate,__line__)

          ALLOCATE( bc%vals(ndata,ijbeg:ijend),stat=errorflag )
          global%error = errorflag
          IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )
          DO n = 1, ndata
            bc%vals(n,:) = holdvals(n)
          ENDDO

          DEALLOCATE ( holdvals,stat=errorflag )
          global%error = errorflag
          IF (global%error /= 0) CALL errorstop(global,err_deallocate,__line__)

        ENDIF

        tbc%mean = bc%vals(var,:)

      ENDIF    ! active region on my processor

    ENDDO      ! iPatch
  ENDDO        ! iReg

  IF (ALLOCATED(morevals)) THEN
    DEALLOCATE ( morevals,stat=errorflag )
    global%error = errorflag
    IF (global%error /= 0) CALL errorstop(global,err_deallocate,__line__)
  ENDIF

  goto 999

! error handling --------------------------------------------------------------

10  CONTINUE
  CALL errorstop( global,err_file_read,__line__ )

999 CONTINUE

  CALL deregisterfunction( global )

END SUBROUTINE rflo_readtbcsection

!******************************************************************************
!
! RCS Revision history:
!
! $Log: RFLO_ReadTbcSection.F90,v $
! Revision 1.6  2008/12/06 08:44:07  mtcampbe
! Updated license.
!
! Revision 1.5  2008/11/19 22:17:21  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.4  2007/08/07 16:32:08  rfiedler
! Set bcCode to BC_INFLOW for all inflow BCs so bcCode+BC_RANGE has desired value.
!
! Revision 1.3  2006/08/19 15:38:24  mparmar
! Renamed patch variables
!
! Revision 1.2  2005/04/28 05:45:56  wasistho
! added velocity based inflow BC
!
! Revision 1.1  2004/11/29 21:25:17  wasistho
! lower to upper case
!
! Revision 1.7  2003/11/20 16:40:34  mdbrandy
! Backing out RocfluidMP changes from 11-17-03
!
! Revision 1.4  2003/06/10 22:54:42  jferry
! Added Piecewise TBC
!
! Revision 1.3  2003/06/04 20:06:38  jferry
! added capability for PEUL BCs with TBCs
!
! Revision 1.2  2003/05/15 02:57:01  jblazek
! Inlined index function.
!
! Revision 1.1  2002/10/19 00:40:30  jblazek
! Added utility (rflosurf) to write out surface grids for GenX.
!
! Revision 1.7  2002/10/12 03:20:50  jblazek
! Replaced [io]stat=global%error with local errorFlag for Rocflo.
!
! Revision 1.6  2002/09/28 14:33:24  jferry
! added relative velocity to injection BC
!
! Revision 1.5  2002/09/27 00:57:10  jblazek
! Changed makefiles - no makelinks needed.
!
! Revision 1.4  2002/09/25 18:29:57  jferry
! simplified TBC parameter lists
!
! Revision 1.3  2002/09/20 22:22:36  jblazek
! Finalized integration into GenX.
!
! Revision 1.2  2002/09/18 21:50:49  jferry
! Streamlined inelegant coding
!
! Revision 1.1  2002/09/17 13:43:00  jferry
! Added Time-dependent boundary conditions
!
!******************************************************************************