INRT_CheckUserInput.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: check interaction information provided by the user
!
! Description: none.
!
! Input: region = data of current region.
!
! Output: none.
!
! Notes: none.
!
!******************************************************************************
!
! $Id: INRT_CheckUserInput.F90,v 1.5 2008/12/06 08:44:31 mtcampbe Exp $
!
! Copyright: (c) 2003 by the University of Illinois
!
!******************************************************************************

SUBROUTINE inrt_checkuserinput( region )

  USE moddatatypes
  USE moddatastruct, ONLY : t_region
  USE modglobal,     ONLY : t_global
  USE modinteract
  USE moderror
  USE modtools,      ONLY : floatequal
  USE modparameters
  USE modmpi
  USE inrt_modparameters

  IMPLICIT NONE

! ... parameters
  TYPE (t_region), INTENT(INOUT) :: region

! ... loop variables
  INTEGER :: iinrt,iedge,inod,iplag,ipeul,ipeuloutedge

! ... local variables
  CHARACTER(CHRLEN) :: rcsidentstring

  LOGICAL :: errorflag,maxconedgesfound,maxdisedgesfound

  INTEGER :: nplag,npeul,nnodes,nusednodes,npeuloutedges,npeuloxedges
  INTEGER :: ind,indmixt,indplag0,indpeul0,indintl,indplagjoint,indpeulox
  INTEGER :: indplagvapor,loclactdiff,maxconedges,maxdisedges,globactdiff
  INTEGER :: iwrite

  REAL(RFREAL) :: outmass,coef

  TYPE(t_inrt_input),    POINTER :: input
  TYPE(t_inrt_interact), POINTER :: inrt
  TYPE(t_inrt_edge),     POINTER :: edge
  TYPE(t_global),        POINTER :: global

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

  rcsidentstring = '$RCSfile: INRT_CheckUserInput.F90,v $ $Revision: 1.5 $'

  global => region%global

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

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

  IF (inrt_perm_pmass - inrt_perm_block /= 1 .OR. &
      inrt_perm_pmome - inrt_perm_pmass /= 1 .OR. &
      inrt_perm_pall  - inrt_perm_pmome /= 1)     &
    CALL errorstop( global,err_inrt_parameter,__line__ )

  input => region%inrtInput

  IF (.NOT. input%defaultRead) &
    CALL errorstop( global,err_inrt_defunread,__line__ )

  nplag  = input%nPlag
  npeul  = input%nPeul
  nnodes = input%nNodes

  indmixt  = input%indMixt
  indplag0 = input%indPlag0
  indpeul0 = input%indPeul0
  indintl  = input%indIntl

  indplagjoint = input%indPlagJoint
  indplagvapor = input%indPlagVapor

  maxconedges = input%maxConEdges
  maxdisedges = input%maxDisEdges
  maxconedgesfound = .false.
  maxdisedgesfound = .false.

  iwrite = 1   ! option to write (1) or not (0) warnings

! Check that arrays are allocated an have the correct size

  errorflag = .false.

  IF (ASSOCIATED(input%globActiveness)) THEN
    IF (ubound(input%globActiveness,1) /= nnodes) errorflag = .true.
  ELSE
    IF (nnodes /= 0) errorflag = .true.
  END IF ! input%globActiveness

  IF (ASSOCIATED(input%globPermission)) THEN
    IF (ubound(input%globPermission,1) /= nnodes) errorflag = .true.
  ELSE
    IF (nnodes /= 0) errorflag = .true.
  END IF ! input%globPermission

  IF (ASSOCIATED(input%inrts)) THEN
    IF (ubound(input%inrts,1) /= inrt_type_total) errorflag = .true.
  ELSE
    IF (inrt_type_total /= 0) errorflag = .true.
  END IF ! input%inrts

  IF (errorflag) CALL errorstop( global,err_inrt_allocrange,__line__ )

! Active smoke not implemented for Rocflo
#ifdef RFLO
  DO ind = indpeul0+1,indpeul0+npeul
    IF (input%globActiveness(ind) == inrt_act_active) THEN
      CALL errorstop( global,err_inrt_badactv,__line__, &
        'Active smoke not implemented for Rocflo' )
    END IF
  END DO ! ind
#endif

! Active species not implemented for Rocflu (but soon?)
#ifdef RFLU
  DO ind = indpeul0+1,indpeul0+npeul
    IF (input%globActiveness(ind) == inrt_act_active) THEN
      CALL errorstop( global,err_inrt_badactv,__line__, &
        'Active species not implemented for Rocflu' )
    END IF
  END DO ! ind
#endif

! Check that indPlagJoint refers to a particle index

  IF (nplag > 0) THEN

    IF (indplagjoint < indplag0+1 .OR. indplagjoint > indplag0+nplag) &
      CALL errorstop( global,err_inrt_indexrange,__line__ )

  END IF ! nPlag

! Check that indPlagVapor is assigned correctly

  IF (indplagvapor /= indplag0+nplag+1) &
      CALL errorstop( global,err_inrt_indexrange,__line__ )

  DO iinrt = 1,inrt_type_total

    inrt => input%inrts(iinrt)

    IF (ASSOCIATED(inrt%switches)) THEN
      IF (ubound(inrt%switches,1) /= inrt%nSwitches) errorflag = .true.
    ELSE
      IF (inrt%nSwitches /= 0) errorflag = .true.
    END IF ! switches

    IF (ASSOCIATED(inrt%data)) THEN
      IF (ubound(inrt%data,1) /= inrt%nData) errorflag = .true.
    ELSE
      IF (inrt%nData /= 0) errorflag = .true.
    END IF ! data

    IF (ASSOCIATED(inrt%activeness)) THEN
      IF (ubound(inrt%activeness,1) /= nnodes) errorflag = .true.
    ELSE
      IF (nnodes /= 0) errorflag = .true.
    END IF ! inrt%activeness

    IF (ASSOCIATED(inrt%permission)) THEN
      IF (ubound(inrt%permission,1) /= nnodes) errorflag = .true.
    ELSE
      IF (nnodes /= 0) errorflag = .true.
    END IF ! inrt%permission

    IF (ASSOCIATED(inrt%edges)) THEN
      IF (ubound(inrt%edges,1) /= inrt%nEdges) errorflag = .true.
    ELSE
      IF (inrt%nEdges /= 0) errorflag = .true.
    END IF ! edges

    IF (errorflag) CALL errorstop( global,err_inrt_allocrange,__line__ )

    IF (.NOT. inrt%used) cycle ! do not worry about undefined interactions

! - Check that number of Edges is within proper range

    IF (inrt%pclsUsed) THEN
      IF (inrt%nEdges > maxdisedges) THEN
        CALL errorstop( global,err_illegal_value,__line__, &
          'Number of Edges more than maximal number of Edges')
      ELSE IF (inrt%nEdges == maxdisedges) THEN
        maxdisedgesfound = .true.
      END IF
    ELSE
      IF (inrt%nEdges > maxconedges) THEN
        CALL errorstop( global,err_illegal_value,__line__, &
          'Number of Edges more than maximal number of Edges')
      ELSE IF (inrt%nEdges == maxconedges) THEN
        maxconedgesfound = .true.
      END IF
    END IF

! - Check that number of internal Nodes is valid

    IF (inrt%nIntl < 0 .OR. inrt%nIntl > 1) &
      CALL errorstop( global,err_inrt_nintl,__line__ )

! - Check various things if there is an Internal Node

    IF (inrt%nIntl == 1) THEN

! --- Check that Permission level is 3 (Permit All)

      IF (inrt%permission(indintl) /= inrt_perm_pall) &
        CALL errorstop( global,err_inrt_permlevintl,__line__ )

! --- Check that there is at least one input and one output Edge

      IF (inrt%nInputEdges <= 0 .OR. inrt%nInputEdges >= inrt%nEdges) &
        CALL errorstop( global,err_inrt_ninputedges,__line__ )

      DO iedge = 1,inrt%nInputEdges

        edge => inrt%edges(iedge)

! ----- Check that input Edge is correctly connected to Internal Node

        IF (edge%iNode(1) == indintl .OR. edge%iNode(2) /= indintl) &
          CALL errorstop( global,err_inrt_connectintl,__line__ )

! ----- Check that input Edge has correct permission Token at Internal Node

        IF (edge%tEdge == inrt_edge_mome_dum .OR. &
            edge%tEdge == inrt_edge_mass_gho) THEN

          IF (edge%token(2) /= inrt_perm_block) &
            CALL errorstop( global,err_inrt_permintl,__line__ )

        ELSE

          IF (edge%token(2) /= inrt_perm_pall) &
            CALL errorstop( global,err_inrt_permintl,__line__ )

        END IF ! edge%tEdge

      END DO ! iEdge

      DO iedge = inrt%nInputEdges+1,inrt%nEdges

        edge => inrt%edges(iedge)

! ----- Check that output Edge is correctly connected to Internal Node

        IF (edge%iNode(1) /= indintl .OR. edge%iNode(2) == indintl) &
          CALL errorstop( global,err_inrt_connectintl,__line__ )

! ----- Check that output Edge has correct permission Token at Internal Node

        IF (edge%token(1) /= inrt_perm_block) &
          CALL errorstop( global,err_inrt_permintl,__line__ )

      END DO ! iEdge

    END IF ! inrt%nIntl

    nusednodes = nnodes - 1 + inrt%nIntl

    DO inod = 1,nusednodes

! --- Check that Activeness of Node has valid value

      IF (inrt%activeness(inod) > inrt_act_active) &
        CALL errorstop( global,err_inrt_badactv,__line__ )

! --- Warn if Node has been changed from active to passive, or vice-versa
! --- (unless Node is Internal or not the first Lagranigan particle type)

      IF ( inod /= indintl .AND. &
          (inod <= indplag0+1 .OR. inod > indplag0+nplag+1) ) THEN

        IF (inrt%activeness(inod)      == inrt_act_active .NEQV. &
            input%globActiveness(inod) == inrt_act_active) THEN

          IF (input%globActiveness(inod) == inrt_act_active) THEN
            IF (global%myProcid==masterproc .AND. iwrite==1) &
            WRITE(stdout,1030) solver_name//'### INRT_WARNING: Node has '// &
              'been changed from active to passive for '//trim(inrt%name)
          ELSE
            IF (global%myProcid==masterproc .AND. iwrite==1) &
            WRITE(stdout,1030) solver_name//'### INRT_WARNING: Node has '// &
              'been changed from passive to active for '//trim(inrt%name)
          END IF ! input%globActiveness(iNod)

          IF (global%myProcid==masterproc .AND. iwrite==1) &
          WRITE(stdout,1040)   solver_name//'### INRT_WARNING:   '// &
            'Node number',inod

          IF (input%consistent) THEN
            IF (global%myProcid==masterproc .AND. iwrite==1)  &
            WRITE(stdout,1030) &
            solver_name//'### INRT_WARNING: *** Consistency ruined! ***'
          ENDIF
          input%consistent = .false.
    

        END IF ! inrt%activeness(iNod)

      END IF ! iNod

! --- Check that Permission level of Node has valid value

      IF (inrt%permission(inod) < inrt_perm_block .OR. &
          inrt%permission(inod) > inrt_perm_pall)      &
        CALL errorstop( global,err_inrt_badperm,__line__ )

! --- Warn if Permission level less than 3 (Permit All) is on active Node

      IF (inrt%activeness(inod) == inrt_act_active .AND. &
          inrt%permission(inod) /= inrt_perm_pall) THEN

        IF (global%myProcid==masterproc .AND. iwrite==1 ) &
        WRITE(stdout,1030) solver_name//'### INRT_WARNING: Permission '// &
          'restricted for '//trim(inrt%name)
        IF (global%myProcid==masterproc .AND. iwrite==1 ) &
        WRITE(stdout,1040) solver_name//'### INRT_WARNING:   on (active) '// &
          'Node number',inod

        IF (input%consistent) THEN
          IF (global%myProcid==masterproc .AND. iwrite==1 ) &
          WRITE(stdout,1030) &
          solver_name//'### INRT_WARNING: *** Consistency ruined! ***'
        ENDIF
        input%consistent = .false.

      END IF ! inrt%activeness(iNod)

    END DO ! iNod

! - Check that all Lagrangian particle constituents have the same Activeness
! - (Do not require Vapor Energy to have same Activeness as others, however)

    DO iplag=1,nplag

      IF (inrt%activeness(indplag0+iplag) /= inrt%activeness(indplag0+1)) &
        CALL errorstop( global,err_inrt_actvplag,__line__ )

    END DO ! iPlag

! - Interaction-specific checks

    SELECT CASE (iinrt)

    CASE (inrt_type_burning)

      npeuloxedges = 0
      IF (inrt%switches(inrt_swi_burning_oxused) /= 0) THEN

        npeuloxedges = 1

! ----- Extract index of oxidizer smoke type

        indpeulox = inrt%edges(inrt_burning_s_mass_x0 + npeuloxedges)%iNode(1)

! ----- Check that index is in the smoke range

        IF (indpeulox < indpeul0 + 1 .OR. indpeulox > indpeul0 + npeul) &
          CALL errorstop( global,err_inrt_indexrange,__line__ )

! ----- Check that if oxidizer is used, it is less active than gas

        IF (input%globActiveness(indpeulox) >= input%globActiveness(indmixt)) &
          CALL errorstop( global,err_inrt_ox_actv,__line__ )

      END IF ! INRT_SWI_BURNING_OXUSED

      IF (inrt%activeness(indintl) == inrt_act_active) THEN

! ----- Check that Gas and Lagrangian particles are active

        IF (inrt%activeness(indmixt)    /= inrt_act_active .OR. &
            inrt%activeness(indplag0+1) /= inrt_act_active)     &
          CALL errorstop( global,err_inrt_burning1,__line__ )

! ----- Warn if active smoke output has incorrect mass (within a tolerance)

        outmass = 0._rfreal
        npeuloutedges = inrt%nEdges - npeuloxedges - inrt_burning_nedges0

        DO ipeuloutedge = 1,npeuloutedges ! loop over edges that output smoke

          iedge = inrt_burning_x_mass_s0 + npeuloxedges + ipeuloutedge

          ipeul = inrt%edges(iedge)%iNode(2) - indpeul0

          IF (ipeul < 1 .OR. ipeul > npeul) &
            CALL errorstop( global,err_inrt_indexrange,__line__ )

          IF (inrt%activeness(indpeul0+ipeul) == inrt_act_active) THEN

            ind = inrt_dat_burning_mfrc_peul0 + ipeuloutedge

            outmass = outmass + inrt%data(ind)

          END IF ! inrt%activeness

        END DO ! iPeulOutEdge

        coef = inrt%data(inrt_dat_burning_mfrc_plag)
        outmass = coef + (1._rfreal - coef)*outmass

        IF (.NOT.floatequal(outmass,1._rfreal)) THEN

          IF (global%myProcid==masterproc .AND. iwrite==1) &
          WRITE(stdout,1030) solver_name//'### INRT_WARNING: active output '// &
            'mass for '//trim(inrt%name)
          IF (global%myProcid==masterproc .AND. iwrite==1) &
          WRITE(stdout,1050) solver_name//'### INRT_WARNING:   sums not '// &
            'to 1, but to',outmass

          IF (input%consistent) THEN
            IF (global%myProcid==masterproc .AND. iwrite==1) &
            WRITE(stdout,1030) &
            solver_name//'### INRT_WARNING: *** Consistency ruined! ***'
          ENDIF
          input%consistent = .false.

        END IF ! outmass

      END IF ! inrt%activeness(indIntl)

    END SELECT ! iInrt

  END DO ! iInrt

! Check that maximal number of Edges is correct

  IF (maxconedges > 0 .AND. .NOT.maxconedgesfound) THEN
    CALL errorstop( global,err_illegal_value,__line__, &
      'Inconsistency in maximal number of Edges')
  ENDIF

  IF (maxdisedges > 0 .AND. .NOT.maxdisedgesfound) THEN
    CALL errorstop( global,err_illegal_value,__line__, &
      'Inconsistency in maximal number of Edges')
  ENDIF

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

  CALL deregisterfunction( global )

1030 FORMAT(a)
1040 FORMAT(a,i3)
1050 FORMAT(a,es14.6)

END SUBROUTINE inrt_checkuserinput

!******************************************************************************
!
! RCS Revision history:
!
! $Log: INRT_CheckUserInput.F90,v $
! Revision 1.5  2008/12/06 08:44:31  mtcampbe
! Updated license.
!
! Revision 1.4  2008/11/19 22:17:44  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.3  2005/03/06 18:13:44  wasistho
! added parameter iwrite to control printing warnings to stdout
!
! Revision 1.2  2005/03/06 00:18:38  wasistho
! refrain from writing WARNING from each processor
!
! Revision 1.1  2004/12/01 21:56:18  fnajjar
! Initial revision after changing case
!
! Revision 1.9  2004/07/28 15:42:12  jferry
! deleted defunct constructs: useDetangle, useSmokeDrag, useSmokeHeatTransfer
!
! Revision 1.8  2004/07/27 21:30:00  jferry
! integrated maxConEdges and maxDisEdges variables more fully
!
! Revision 1.7  2004/03/03 23:55:40  jferry
! Allowed particles to be run with Euler case
!
! Revision 1.6  2004/03/02 21:47:29  jferry
! Added After Update interactions
!
! Revision 1.5  2003/09/25 15:48:43  jferry
! implemented Boiling Regulation interaction
!
! Revision 1.4  2003/09/19 20:35:26  jferry
! Implemented oxidizer species for burning interaction
!
! Revision 1.3  2003/04/03 21:10:18  jferry
! implemented additional safety checks for rocinteract
!
! Revision 1.2  2003/04/02 22:32:03  jferry
! codified Activeness and Permission structures for rocinteract
!
! Revision 1.1  2003/03/11 15:55:02  jferry
! Implemented routine to check user input for Rocinteract
!
!******************************************************************************