PEUL_ReadBcInjectSection.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 inflow boundary condition for
!          Eulerian particles
!
! Description: none.
!
! Input: boundary condition file.
!
! Output: regions = BC data.
!
! Notes: none.
!
!******************************************************************************
!
! $Id: PEUL_ReadBcInjectSection.F90,v 1.4 2008/12/06 08:44:39 mtcampbe Exp $
!
! Copyright: (c) 2002 by the University of Illinois
!
!******************************************************************************

SUBROUTINE peul_readbcinjectsection( regions )

  USE moddatatypes
  USE modbndpatch,   ONLY : t_patch
  USE moddatastruct, ONLY : t_region
  USE modglobal,     ONLY : t_global
  USE moderror
  USE modparameters
  USE peul_modparameters

  USE modinterfaces, ONLY : readpatchsection, makenumberedkeys, &
                            rflo_getpatchindices
  IMPLICIT NONE

#include "Indexing.h"

! ... parameters
  TYPE(t_region), POINTER :: regions(:)

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

! ... local variables
  INTEGER, PARAMETER :: nkeys_max  = 20
  INTEGER, PARAMETER :: npeul_keys = 10

  CHARACTER(CHRLEN) :: rcsidentstring
  CHARACTER(10)     :: keys(nkeys_max)
  CHARACTER(256)    :: fname

  INTEGER :: nkeys, brbeg, brend, prbeg, prend, distrib
  INTEGER :: n1, n2, ioff, ijbeg, ijend, errorflag
  INTEGER :: ikeyfrac,ikeyfrac0

  LOGICAL :: defined(nkeys_max), alldef

  REAL(RFREAL) :: vals(nkeys_max)

  TYPE(t_patch),  POINTER :: patch
  TYPE(t_global), POINTER :: global

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

  rcsidentstring = &
    '$RCSfile: PEUL_ReadBcInjectSection.F90,v $ $Revision: 1.4 $'

  global => regions(1)%global

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

! begin -----------------------------------------------------------------------

! define keys

  ikeyfrac  = 1
  ikeyfrac0 = ikeyfrac

  keys(ikeyfrac) = 'FRAC_'
  CALL makenumberedkeys(keys,ikeyfrac0+1,'FRAC',1,npeul_keys,1)

  nkeys = ikeyfrac0 + npeul_keys

  IF (nkeys > nkeys_max) CALL errorstop( global,err_exceeds_decl_mem,__line__ )

! Read smoke BC section from BC input file

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

! check if all necessary values defined ---------------------------------------

  DO ireg=brbeg,brend

    IF (regions(ireg)%peulInput%nPtypes > npeul_keys) &
      CALL errorstop( global,err_exceeds_decl_mem,__line__ )

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

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

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

        IF (patch%peul%bcSet) &
          CALL errorstop( global,err_patch_overspec,__line__, &
            'PEUL Injection boundary.' )

!        IF (patch%bcCoupled == BC_EXTERNAL) THEN   ! data from outside
!          patch%peul%distrib = BCDAT_DISTRIB    ! => always distribution
!          CALL ErrorStop( global,ERR_PEUL_EXTERNAL,__LINE__ )
!        ELSE
!          patch%peul%distrib = distrib
!        END IF ! bcCoupled
          patch%peul%distrib = distrib

! ----- check if appropriate values specified
        IF ( patch%peul%distrib == bcdat_constant ) THEN
          IF (.NOT. defined(ikeyfrac)) THEN
            alldef = .true.
            DO ipt = 1, regions(ireg)%peulInput%nPtypes
              alldef = alldef .AND. defined(ikeyfrac0+ipt)
            END DO ! ipt
            IF (.NOT. alldef) CALL errorstop(global,err_bcval_missing,__line__)
          END IF
        ELSE
          CALL errorstop( global,err_peul_distrib,__line__ )
        END IF

! ----- check if extra values specified

        DO ipt = 1, npeul_keys
          IF (defined(ikeyfrac0+ipt)) THEN
            IF (ipt > regions(ireg)%peulInput%nPtypes) THEN
              CALL errorstop(global,err_peul_bcval_extra,__line__)
            END IF ! ipt
          END IF   ! defined
        END DO     ! ipt

! ----- set flag to BC specified
        patch%peul%bcSet = .true.

      END IF   ! my BC & processor, active

    END DO     ! iPatch
  END DO       ! iReg

! copy values/distribution to variables ---------------------------------------

  DO ireg=brbeg,brend

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

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

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

        patch%peul%nData = regions(ireg)%peulInput%nPtypes

! ----- allocate memory for the values

        IF (patch%peul%distrib == bcdat_distrib) THEN
          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)
        ELSE
          ijbeg = 0
          ijend = 1
        END IF

        nullify(patch%peul%vals)
        IF (patch%peul%nData > 0) THEN
          ALLOCATE( patch%peul%vals(patch%peul%nData,ijbeg:ijend), &
                    stat=errorflag )
          global%error = errorflag
          IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )
        END IF

! ----- distribution from file

        IF (patch%peul%distrib==bcdat_distrib .AND. &
            patch%bcCoupled      /=bc_external  ) THEN

          CALL errorstop( global,err_peul_distrib,__line__ )

! ----- distribution from external source / constant value

        ELSE

          IF (ASSOCIATED(patch%peul%vals)) THEN
            IF (defined(ikeyfrac)) patch%peul%vals(:,:) = vals(ikeyfrac)
            DO ipt = 1, patch%peul%nData
              IF (defined(ikeyfrac0+ipt)) patch%peul%vals(ipt,:) = &
                vals(ikeyfrac0+ipt)
            END DO ! ipt
          END IF

        END IF  ! distribution?

      END IF    ! bcType, active region on my processor

    END DO      ! iPatch
  END DO        ! iReg

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

  CALL deregisterfunction( global )

END SUBROUTINE peul_readbcinjectsection

!******************************************************************************
!
! RCS Revision history:
!
! $Log: PEUL_ReadBcInjectSection.F90,v $
! Revision 1.4  2008/12/06 08:44:39  mtcampbe
! Updated license.
!
! Revision 1.3  2008/11/19 22:17:51  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.2  2006/08/19 15:40:24  mparmar
! Renamed patch variables
!
! Revision 1.1  2004/12/01 21:09:42  haselbac
! Initial revision after changing case
!
! Revision 1.10  2004/03/05 22:09:04  jferry
! created global variables for peul, plag, and inrt use
!
! Revision 1.9  2004/03/02 21:45:12  jferry
! Added check on number of keys
!
! Revision 1.8  2003/11/21 23:20:03  jferry
! Turned off error trap for BC_EXTERNAL
!
! Revision 1.7  2003/09/19 20:34:44  jferry
! Added underscore character to default keys to make key set prefix-free
!
! Revision 1.6  2003/05/15 02:57:05  jblazek
! Inlined index function.
!
! Revision 1.5  2003/04/09 22:51:45  jferry
! removed peul_save and peul_verify structures
!
! Revision 1.4  2003/03/24 23:30:53  jferry
! overhauled rocinteract to allow interaction design to use user input
!
! Revision 1.3  2003/03/04 19:26:47  jferry
! Cleaned up routines that read sections of input files
!
! Revision 1.2  2003/02/12 23:34:48  jferry
! Replaced [io]stat=global%error with local errorFlag
!
! Revision 1.1  2003/02/11 22:52:51  jferry
! Initial import of Rocsmoke
!
!******************************************************************************