Nodes of different colours represent the following:
Solid arrows point from a parent (sub)module to the submodule which is descended from it. Dashed arrows point from a module being used to the module or program unit using it. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
SUBROUTINE GetMixerInput
! SUBROUTINE INFORMATION:
! AUTHOR Richard J. Liesen
! DATE WRITTEN March 2000
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is the main routine to call other input routines and Get routines
! METHODOLOGY EMPLOYED:
! Uses the status flags to trigger events.
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: GetNumObjectsFound,GetObjectItem,VerifyName,GetObjectDefMaxArgs
USE NodeInputManager, ONLY: GetOnlySingleNode
USE General, ONLY: TrimSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER (len=*), PARAMETER :: RoutineName='GetMixerInput: ' ! include trailing blank space
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: MixerNum ! The Mixer that you are currently loading input into
INTEGER :: NumAlphas
INTEGER :: NumNums
INTEGER :: NodeNum
INTEGER :: IOSTAT
LOGICAL :: ErrorsFound=.false.
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
INTEGER :: NumParams
INTEGER :: InNodeNum1
INTEGER :: InNodeNum2
CHARACTER (len=MaxNameLength) :: CurrentModuleObject ! for ease in getting objects
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: AlphArray ! Alpha input items for object
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: cAlphaFields ! Alpha field names
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: cNumericFields ! Numeric field names
REAL(r64), ALLOCATABLE, DIMENSION(:) :: NumArray ! Numeric input items for object
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lAlphaBlanks ! Logical array, alpha field input BLANK = .true.
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lNumericBlanks ! Logical array, numeric field input BLANK = .true.
! Flow
CurrentModuleObject = 'AirLoopHVAC:ZoneMixer'
NumMixers = GetNumObjectsFound(CurrentModuleObject)
IF (NumMixers.GT.0) ALLOCATE(MixerCond(NumMixers))
ALLOCATE(CheckEquipName(NumMixers))
CheckEquipName=.true.
CALL GetObjectDefMaxArgs(CurrentModuleObject,NumParams,NumAlphas,NumNums)
ALLOCATE(AlphArray(NumAlphas))
AlphArray=' '
ALLOCATE(cAlphaFields(NumAlphas))
cAlphaFields=' '
ALLOCATE(lAlphaBlanks(NumAlphas))
lAlphaBlanks=.TRUE.
ALLOCATE(cNumericFields(NumNums))
cNumericFields=' '
ALLOCATE(lNumericBlanks(NumNums))
lNumericBlanks=.TRUE.
ALLOCATE(NumArray(NumNums))
NumArray=0.0d0
DO MixerNum = 1, NumMixers
CALL GetObjectItem(CurrentModuleObject,MixerNum,AlphArray,NumAlphas, &
NumArray,NumNums,IOSTAT, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(AlphArray(1),MixerCond%MixerName,MixerNum-1,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) AlphArray(1)='xxxxx'
ENDIF
MixerCond(MixerNum)%MixerName = AlphArray(1)
MixerCond(MixerNum)%OutletNode = &
GetOnlySingleNode(AlphArray(2),ErrorsFound,TRIM(CurrentModuleObject),AlphArray(1), &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsNotParent)
MixerCond(MixerNum)%NumInletNodes = NumAlphas -2
MixerCond%InitFlag = .TRUE.
ALLOCATE(MixerCond(MixerNum)%InletNode(MixerCond(MixerNum)%NumInletNodes))
ALLOCATE(MixerCond(MixerNum)%InletMassFlowRate(MixerCond(MixerNum)%NumInletNodes))
ALLOCATE(MixerCond(MixerNum)%InletMassFlowRateMaxAvail(MixerCond(MixerNum)%NumInletNodes))
ALLOCATE(MixerCond(MixerNum)%InletMassFlowRateMinAvail(MixerCond(MixerNum)%NumInletNodes))
ALLOCATE(MixerCond(MixerNum)%InletTemp(MixerCond(MixerNum)%NumInletNodes))
ALLOCATE(MixerCond(MixerNum)%InletHumRat(MixerCond(MixerNum)%NumInletNodes))
ALLOCATE(MixerCond(MixerNum)%InletEnthalpy(MixerCond(MixerNum)%NumInletNodes))
ALLOCATE(MixerCond(MixerNum)%InletPressure(MixerCond(MixerNum)%NumInletNodes))
MixerCond(MixerNum)%InletNode = 0
MixerCond(MixerNum)%InletMassFlowRate = 0.0d0
MixerCond(MixerNum)%InletMassFlowRateMaxAvail = 0.0d0
MixerCond(MixerNum)%InletMassFlowRateMinAvail = 0.0d0
MixerCond(MixerNum)%InletTemp = 0.0d0
MixerCond(MixerNum)%InletHumRat = 0.0d0
MixerCond(MixerNum)%InletEnthalpy = 0.0d0
MixerCond(MixerNum)%InletPressure = 0.0d0
MixerCond(MixerNum)%OutletMassFlowRate = 0.0d0
MixerCond(MixerNum)%OutletMassFlowRateMaxAvail = 0.0d0
MixerCond(MixerNum)%OutletMassFlowRateMinAvail = 0.0d0
MixerCond(MixerNum)%OutletTemp = 0.0d0
MixerCond(MixerNum)%OutletHumRat = 0.0d0
MixerCond(MixerNum)%OutletEnthalpy = 0.0d0
MixerCond(MixerNum)%OutletPressure = 0.0d0
DO NodeNum = 1, MixerCond(MixerNum)%NumInletNodes
MixerCond(MixerNum)%InletNode(NodeNum) = &
GetOnlySingleNode(AlphArray(2+NodeNum),ErrorsFound,TRIM(CurrentModuleObject),AlphArray(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsNotParent)
IF (lAlphaBlanks(2+NodeNum)) THEN
CALL ShowSevereError(TRIM(cAlphaFields(2+NodeNum))//' is Blank, '//TRIM(CurrentModuleObject)//' = '//TRIM(AlphArray(1)))
ErrorsFound=.true.
ENDIF
END DO
END DO ! end Number of Mixer Loop
! Check for duplicate names specified in Zone Mixer
DO MixerNum=1,NumMixers
NodeNum=MixerCond(MixerNum)%OutletNode
DO InNodeNum1=1,MixerCond(MixerNum)%NumInletNodes
IF (NodeNum /= MixerCond(MixerNum)%InletNode(InNodeNum1)) CYCLE
CALL ShowSevereError(TRIM(CurrentModuleObject)//' = '//TRIM(MixerCond(MixerNum)%MixerName)// &
' specifies an inlet node name the same as the outlet node.')
CALL ShowContinueError('..'//TRIM(cAlphaFields(2))//' = '//TRIM(NodeID(NodeNum)))
CALL ShowContinueError('..Inlet Node #'//TRIM(TrimSigDigits(InNodeNum1))// &
' is duplicate.')
ErrorsFound=.true.
ENDDO
DO InNodeNum1=1,MixerCond(MixerNum)%NumInletNodes
DO InNodeNum2=InNodeNum1+1,MixerCond(MixerNum)%NumInletNodes
IF (MixerCond(MixerNum)%InletNode(InNodeNum1) /= MixerCond(MixerNum)%InletNode(InNodeNum2)) CYCLE
CALL ShowSevereError(TRIM(CurrentModuleObject)//' = '//TRIM(MixerCond(MixerNum)%MixerName)// &
' specifies duplicate inlet nodes in its inlet node list.')
CALL ShowContinueError('..Inlet Node #'//TRIM(TrimSigDigits(InNodeNum1))// &
' Name='//TRIM(NodeID(InNodeNum1)))
CALL ShowContinueError('..Inlet Node #'//TRIM(TrimSigDigits(InNodeNum2))// &
' is duplicate.')
ErrorsFound=.true.
ENDDO
ENDDO
ENDDO
DEALLOCATE(AlphArray)
DEALLOCATE(NumArray)
DEALLOCATE(cAlphaFields)
DEALLOCATE(lAlphaBlanks)
DEALLOCATE(cNumericFields)
DEALLOCATE(lNumericBlanks)
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//'Errors found in getting input.')
ENDIF
RETURN
END SUBROUTINE GetMixerInput